/* Copyright (C) 2000  The PARI group.

This file is part of the PARI/GP package.

PARI/GP is free software; you can redistribute it and/or modify it under the
terms of the GNU General Public License as published by the Free Software
Foundation; either version 2 of the License, or (at your option) any later
version. It is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY WHATSOEVER.

Check the License for details. You should have received a copy of it, along
with the package; see the file 'COPYING'. If not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */

/*******************************************************************/
/*                                                                 */
/*                      KUMMER EXTENSIONS                          */
/*                                                                 */
/*******************************************************************/
#include "pari.h"
#include "paripriv.h"

#define DEBUGLEVEL DEBUGLEVEL_bnrclassfield

typedef struct {
  GEN R; /* nf.pol */
  GEN x; /* tau ( Mod(x, R) ) */
  GEN zk;/* action of tau on nf.zk (as t_MAT) */
} tau_s;

typedef struct {
  GEN polnf, invexpoteta1, powg;
  tau_s *tau;
  long m;
} toK_s;

typedef struct {
  GEN R; /* ZX, compositum(P,Q) */
  GEN p; /* QX, Mod(p,R) root of P */
  GEN q; /* QX, Mod(q,R) root of Q */
  long k; /* Q[X]/R generated by q + k p */
  GEN rev;
} compo_s;

/* REDUCTION MOD ell-TH POWERS */
/* make b integral by multiplying by t in (Q^*)^ell */
static GEN
reduce_mod_Qell(GEN nf, GEN b, ulong ell)
{
  GEN c;
  b = nf_to_scalar_or_basis(nf, b);
  b = Q_primitive_part(b, &c);
  if (c)
  {
    GEN d, fa = Q_factor_limit(c, 1000000);
    d = factorback2(gel(fa,1), ZV_to_Flv(gel(fa,2), ell));
    b = typ(b) == t_INT? mulii(b,d): ZC_Z_mul(b, d);
  }
  return b;
}

static GEN
reducebeta(GEN bnfz, GEN b, long ell)
{
  GEN t, cb, fu, nf = bnf_get_nf(bnfz);

  if (DEBUGLEVEL>1) err_printf("reducing beta = %Ps\n",b);
  b = reduce_mod_Qell(nf, b, ell);
  t = idealredmodpower(nf, b, ell, 1000000);
  if (!isint1(t)) b = nfmul(nf, b, nfpow_u(nf, t, ell));
  if (DEBUGLEVEL>1) err_printf("beta reduced via ell-th root = %Ps\n",b);
  b = Q_primitive_part(b, &cb);
  if (cb && nfispower(nf, b, ell, NULL)) return cb;
  if ((fu = bnf_build_cheapfu(bnfz)))
  { /* log. embeddings of fu^ell */
    GEN elllogfu = gmulgs(real_i(bnf_get_logfu(bnfz)), ell);
    long prec = nf_get_prec(nf);
    for (;;)
    {
      GEN ex, y, z = nflogembed(nf, b, NULL, prec);
      if (z && (ex = RgM_Babai(elllogfu, z)))
      {
        if (ZV_equal0(ex)) break;
        y = nffactorback(nf, fu, ZC_z_mul(ex,ell));
        b = nfdiv(nf, b, y); break;
      }
      prec = precdbl(prec);
      if (DEBUGLEVEL) pari_warn(warnprec,"reducebeta",prec);
      nf = nfnewprec_shallow(nf,prec);
    }
  }
  return cb? gmul(b, cb): b;
}

struct rnfkummer
{
  GEN bnfz, cycgenmod, u, vecC, tQ, vecW;
  ulong mgi, g, ell;
  long rc;
  compo_s COMPO;
  tau_s tau;
  toK_s T;
};

/* set kum->tau; compute Gal(K(\zeta_l)/K) */
static void
get_tau(struct rnfkummer *kum)
{ /* compute action of tau: q^g + kp */
  compo_s *C = &kum->COMPO;
  GEN U = RgX_add(RgXQ_powu(C->q, kum->g, C->R), RgX_muls(C->p, C->k));
  kum->tau.x  = RgX_RgXQ_eval(C->rev, U, C->R);
  kum->tau.R  = C->R;
  kum->tau.zk = nfgaloismatrix(bnf_get_nf(kum->bnfz), kum->tau.x);
}

static GEN tauofvec(GEN x, tau_s *tau);
static GEN
tauofelt(GEN x, tau_s *tau)
{
  switch(typ(x))
  {
    case t_INT: case t_FRAC: return x;
    case t_COL: return RgM_RgC_mul(tau->zk, x);
    case t_MAT: return mkmat2(tauofvec(gel(x,1), tau), gel(x,2));
    default: pari_err_TYPE("tauofelt",x); return NULL;/*LCOV_EXCL_LINE*/
  }
}
static GEN
tauofvec(GEN x, tau_s *tau)
{
  long i, l;
  GEN y = cgetg_copy(x, &l);
  for (i=1; i<l; i++) gel(y,i) = tauofelt(gel(x,i), tau);
  return y;
}
/* [x, tau(x), ..., tau^(m-1)(x)] */
static GEN
powtau(GEN x, long m, tau_s *tau)
{
  GEN y = cgetg(m+1, t_VEC);
  long i;
  gel(y,1) = x;
  for (i=2; i<=m; i++) gel(y,i) = tauofelt(gel(y,i-1), tau);
  return y;
}
/* x^lambda */
static GEN
lambdaofelt(GEN x, toK_s *T)
{
  tau_s *tau = T->tau;
  long i, m = T->m;
  GEN y = trivial_fact(), powg = T->powg; /* powg[i] = g^i */
  for (i=1; i<m; i++)
  {
    y = famat_mulpows_shallow(y, x, uel(powg,m-i+1));
    x = tauofelt(x, tau);
  }
  return famat_mul_shallow(y, x);
}
static GEN
lambdaofvec(GEN x, toK_s *T)
{
  long i, l;
  GEN y = cgetg_copy(x, &l);
  for (i=1; i<l; i++) gel(y,i) = lambdaofelt(gel(x,i), T);
  return y;
}

static GEN
tauofideal(GEN id, tau_s *tau)
{
  return ZM_hnfmodid(RgM_mul(tau->zk, id), gcoeff(id, 1,1));
}

static int
prconj(GEN P, GEN Q, tau_s *tau)
{
  GEN p = pr_get_p(P), x = pr_get_gen(P);
  for(;;)
  {
    if (ZC_prdvd(x,Q)) return 1;
    x = FpC_red(tauofelt(x, tau), p);
    if (ZC_prdvd(x,P)) return 0;
  }
}
static int
prconj_in_list(GEN S, GEN P, tau_s *tau)
{
  long i, l, e, f;
  GEN p, x;
  if (!tau) return 0;
  p = pr_get_p(P); x = pr_get_gen(P);
  e = pr_get_e(P); f = pr_get_f(P); l = lg(S);
  for (i = 1; i < l; i++)
  {
    GEN Q = gel(S, i);
    if (equalii(p, pr_get_p(Q)) && e == pr_get_e(Q) && f == pr_get_f(Q))
      if (ZV_equal(x, pr_get_gen(Q)) || prconj(gel(S,i), P, tau)) return 1;
  }
  return 0;
}

/* >= ell */
static long
get_z(GEN pr, long ell) { return ell * (pr_get_e(pr) / (ell-1)); }
/* zeta_ell in nfz */
static void
list_Hecke(GEN *pSp, GEN *pvsprk, GEN nfz, GEN fa, GEN gell, tau_s *tau)
{
  GEN P = gel(fa,1), E = gel(fa,2), faell, Sl, S, Sl1, Sl2, Vl, Vl2;
  long i, l = lg(P), ell = gell[2];

  S  = vectrunc_init(l);
  Sl1= vectrunc_init(l);
  Sl2= vectrunc_init(l);
  Vl2= vectrunc_init(l);
  for (i = 1; i < l; i++)
  {
    GEN pr = gel(P,i);
    if (!equaliu(pr_get_p(pr), ell))
    { if (!prconj_in_list(S,pr,tau)) vectrunc_append(S,pr); }
    else
    { /* pr | ell */
      long a = get_z(pr, ell) + 1 - itou(gel(E,i));
      if (!a)
      { if (!prconj_in_list(Sl1,pr,tau)) vectrunc_append(Sl1, pr); }
      else if (a != 1 && !prconj_in_list(Sl2,pr,tau))
      {
        vectrunc_append(Sl2, pr);
        vectrunc_append(Vl2, log_prk_init(nfz, pr, a, gell));
      }
    }
  }
  faell = idealprimedec(nfz, gell); l = lg(faell);
  Vl = vectrunc_init(l);
  Sl = vectrunc_init(l);
  for (i = 1; i < l; i++)
  {
    GEN pr = gel(faell,i);
    if (!tablesearch(P, pr, cmp_prime_ideal) && !prconj_in_list(Sl, pr, tau))
    {
      vectrunc_append(Sl, pr);
      vectrunc_append(Vl, log_prk_init(nfz, pr, get_z(pr,ell), gell));
    }
  }
  *pvsprk = shallowconcat(Vl2, Vl); /* divide ell */
  *pSp = shallowconcat(S, Sl1);
}

/* Return a Flm, sprk mod pr^k, pr | ell, k >= 2 */
static GEN
logall(GEN nf, GEN v, long lW, long mgi, GEN gell, GEN sprk)
{
  long i, ell = gell[2], l = lg(v);
  GEN M = cgetg(l,t_MAT);
  for (i = 1; i < l; i++)
  {
    GEN c = log_prk(nf, gel(v,i), sprk, gell); /* ell-rank = #c */
    c = ZV_to_Flv(c, ell);
    if (i < lW) c = Flv_Fl_mul(c, mgi, ell);
    gel(M,i) = c;
  }
  return M;
}
static GEN
matlogall(GEN nf, GEN v, long lW, long mgi, GEN gell, GEN vsprk)
{
  GEN M = NULL;
  long i, l = lg(vsprk);
  for (i = 1; i < l; i++)
    M = vconcat(M, logall(nf, v, lW, mgi, gell, gel(vsprk,i)));
  return M;
}

/* id = (b) prod_{i <= rc} bnfz.gen[i]^v[i] (mod K^*)^ell,
 * - i <= rc: gen[i]^cyc[i] = (cycgenmod[i]); ell | cyc[i]
 * - i > rc: gen[i]^(u[i]*cyc[i]) = (cycgenmod[i]); u[i] cyc[i] = 1 mod ell */
static void
isprincipalell(GEN bnfz, GEN id, GEN cycgenmod, ulong ell, long rc,
               GEN *pv, GEN *pb)
{
  long i, l = lg(cycgenmod);
  GEN y = bnfisprincipal0(bnfz, id, nf_FORCE|nf_GENMAT);
  GEN v = ZV_to_Flv(gel(y,1), ell), b = gel(y,2);
  for (i = rc+1; i < l; i++)
    b = famat_mulpows_shallow(b, gel(cycgenmod,i), v[i]);
  setlg(v,rc+1); *pv = v; *pb = b;
}

static GEN
compute_beta(GEN X, GEN vecWB, GEN ell, GEN bnfz)
{
  GEN be = famat_reduce(famatV_zv_factorback(vecWB, X));
  if (typ(be) == t_MAT)
  {
    gel(be,2) = centermod(gel(be,2), ell);
    be = nffactorback(bnfz, be, NULL);
  }
  be = reducebeta(bnfz, be, itou(ell));
  if (DEBUGLEVEL>1) err_printf("beta reduced = %Ps\n",be);
  return be;
}

GEN
lift_if_rational(GEN x)
{
  long lx, i;
  GEN y;

  switch(typ(x))
  {
    default: break;

    case t_POLMOD:
      y = gel(x,2);
      if (typ(y) == t_POL)
      {
        long d = degpol(y);
        if (d > 0) return x;
        return (d < 0)? gen_0: gel(y,2);
      }
      return y;

    case t_POL: lx = lg(x);
      for (i=2; i<lx; i++) gel(x,i) = lift_if_rational(gel(x,i));
      break;
    case t_VEC: case t_COL: case t_MAT: lx = lg(x);
      for (i=1; i<lx; i++) gel(x,i) = lift_if_rational(gel(x,i));
  }
  return x;
}

/* lift elt t in nf to nfz, algebraic form */
static GEN
lifttoKz(GEN nf, GEN t, compo_s *C)
{
  GEN x = nf_to_scalar_or_alg(nf, t);
  if (typ(x) != t_POL) return x;
  return RgX_RgXQ_eval(x, C->p, C->R);
}
/* lift ideal id in nf to nfz */
static GEN
ideallifttoKz(GEN nfz, GEN nf, GEN id, compo_s *C)
{
  GEN I = idealtwoelt(nf,id);
  GEN x = nf_to_scalar_or_alg(nf, gel(I,2));
  if (typ(x) != t_POL) return gel(I,1);
  gel(I,2) = algtobasis(nfz, RgX_RgXQ_eval(x, C->p, C->R));
  return idealhnf_two(nfz,I);
}

static GEN
prlifttoKz_i(GEN nfz, GEN nf, GEN pr, compo_s *C)
{
  GEN p = pr_get_p(pr), T = nf_get_pol(nfz);
  if (nf_get_degree(nf) != 1)
  { /* restrict to primes above pr */
    GEN t = pr_get_gen(pr);
    t = Q_primpart( lifttoKz(nf,t,C) );
    T = FpX_gcd(FpX_red(T,p), FpX_red(t,p), p);
    T = FpX_normalize(T, p);
  }
  return gel(FpX_factor(T, p), 1);
}
/* lift ideal pr in nf to ONE prime in nfz (the others are conjugate under tau
 * and bring no further information on e_1 W). Assume pr coprime to
 * index of both nf and nfz, and unramified in Kz/K (minor simplification) */
static GEN
prlifttoKz(GEN nfz, GEN nf, GEN pr, compo_s *C)
{
  GEN P = prlifttoKz_i(nfz, nf, pr, C);
  return idealprimedec_kummer(nfz, gel(P,1), pr_get_e(pr), pr_get_p(pr));
}
static GEN
prlifttoKzall(GEN nfz, GEN nf, GEN pr, compo_s *C)
{
  GEN P = prlifttoKz_i(nfz, nf, pr, C), p = pr_get_p(pr), vP;
  long l = lg(P), e = pr_get_e(pr), i;
  vP = cgetg(l, t_VEC);
  for (i = 1; i < l; i++)
    gel(vP,i) = idealprimedec_kummer(nfz,gel(P,i), e, p);
  return vP;
}

static GEN
get_badbnf(GEN bnf)
{
  long i, l;
  GEN bad = gen_1, gen = bnf_get_gen(bnf);
  l = lg(gen);
  for (i = 1; i < l; i++)
  {
    GEN g = gel(gen,i);
    bad = lcmii(bad, gcoeff(g,1,1));
  }
  return bad;
}
/* test whether H has index p */
static int
H_is_good(GEN H, GEN p)
{
  long l = lg(H), status = 0, i;
  for (i = 1; i < l; i++)
    if (equalii(gcoeff(H,i,i), p) && ++status > 1) return 0;
  return status == 1;
}
static GEN
bid_primes(GEN bid) { return prV_primes(gel(bid_get_fact(bid),1)); }
/* Let K base field, L/K described by bnr (conductor F) + H. Return a list of
 * primes coprime to f*ell of degree 1 in K whose images in Cl_f(K) together
 * with ell*Cl_f(K), generate H:
 * thus they all split in Lz/Kz; t in Kz is such that
 * t^(1/p) generates Lz => t is an ell-th power in k(pr) for all such primes.
 * Restrict to primes not dividing
 * - the index of the polynomial defining Kz,
 * - the modulus,
 * - ell,
 * - a generator in bnf.gen or bnfz.gen.
 * If ell | F and Kz != K, set compute the congruence group Hz over Kz
 * and set *pfa to the conductor factorization. */
static GEN
get_prlist(GEN bnr, GEN H, GEN gell, GEN *pfa, struct rnfkummer *kum)
{
  pari_sp av0 = avma;
  GEN Hz = NULL, bnrz = NULL, cycz = NULL, nfz = NULL;
  GEN cyc = bnr_get_cyc(bnr), nf = bnr_get_nf(bnr), F = gel(bnr_get_mod(bnr),1);
  GEN bad, Hsofar, L = cgetg(1, t_VEC);
  forprime_t T;
  ulong p, ell = gell[2];
  int Ldone = 0;

  bad = get_badbnf(bnr_get_bnf(bnr));
  if (kum)
  {
    GEN bnfz = kum->bnfz, ideal = gel(bnr_get_mod(bnr), 1);
    GEN badz = lcmii(get_badbnf(bnfz), nf_get_index(bnf_get_nf(bnfz)));
    bad = lcmii(bad,badz);
    nfz = bnf_get_nf(bnfz);
    ideal = ideallifttoKz(nfz, nf, ideal, &kum->COMPO);
    *pfa = idealfactor_partial(nfz, ideal, bid_primes(bnr_get_bid(bnr)));
    if (dvdiu(idealdown(nf, ideal), ell))
    { /* ell | N(ideal), need Hz = Ker N: Cl_Kz(bothz) -> Cl_K(ideal)/H
       * to update conductor */
      bnrz = Buchraymod(bnfz, *pfa, nf_INIT, gell);
      cycz = bnr_get_cyc(bnrz);
      Hz = diagonal_shallow(ZV_snf_gcd(cycz, gell));
      if (H_is_good(Hz, gell))
      {
        *pfa = gel(bnrconductor_factored(bnrz, Hz), 2);
        return gc_all(av0, 2, &L, pfa);
      }
    }
  }
  bad = lcmii(gcoeff(F,1,1), bad);
  cyc = ZV_snf_gcd(cyc, gell);
  Hsofar = diagonal_shallow(cyc);
  if (H_is_good(Hsofar, gell))
  {
    if (!Hz) return gc_all(av0, pfa? 2: 1, &L, pfa);
    Ldone = 1;
  }
  /* restrict to primes not dividing bad and 1 mod ell */
  u_forprime_arith_init(&T, 2, ULONG_MAX, 1, ell);
  while ((p = u_forprime_next(&T)))
  {
    GEN LP;
    long i, l;
    if (!umodiu(bad, p)) continue;
    LP = idealprimedec_limit_f(nf, utoipos(p), 1);
    l = lg(LP);
    for (i = 1; i < l; i++)
    {
      pari_sp av = avma;
      GEN M, P = gel(LP,i), v = bnrisprincipalmod(bnr, P, gell, 0);
      if (!hnf_invimage(H, v)) { set_avma(av); continue; }
      /* P in H */
      M = ZM_hnfmodid(shallowconcat(Hsofar, v), cyc);
      if (Hz)
      { /* N_{Kz/K} P in H hence P in Hz */
        GEN vP = prlifttoKzall(nfz, nf, P, &kum->COMPO);
        long j, lv = lg(vP);
        for (j = 1; j < lv; j++)
        {
          v = bnrisprincipalmod(bnrz, gel(vP,j), gell, 0);
          if (!ZV_equal0(v))
          {
            Hz = ZM_hnfmodid(shallowconcat(Hz,v), cycz);
            if (H_is_good(Hz, gell))
            {
              *pfa = gel(bnrconductor_factored(bnrz, Hz), 2);
              if (!Ldone) L = vec_append(L, gel(vP,1));
              return gc_all(av0, 2, &L, pfa);
            }
          }
        }
        P = gel(vP,1);
      }
      else if (kum) P = prlifttoKz(nfz, nf, P, &kum->COMPO);
      if (Ldone || ZM_equal(M, Hsofar)) continue;
      L = vec_append(L, P);
      Hsofar = M;
      if (H_is_good(Hsofar, gell))
      {
        if (!Hz) return gc_all(av0, pfa? 2: 1, &L, pfa);
        Ldone = 1;
      }
    }
  }
  pari_err_BUG("rnfkummer [get_prlist]"); return NULL;/*LCOV_EXCL_LINE*/
}
/*Lprz list of prime ideals in Kz that must split completely in Lz/Kz, vecWA
 * generators for the S-units used to build the Kummer generators. Return
 * matsmall M such that \prod WA[j]^x[j] ell-th power mod pr[i] iff
 * \sum M[i,j] x[j] = 0 (mod ell) */
static GEN
subgroup_info(GEN bnfz, GEN Lprz, GEN gell, GEN vecWA)
{
  GEN M, nfz = bnf_get_nf(bnfz), Lell = mkvec(gell);
  long i, j, ell = gell[2], l = lg(vecWA), lz = lg(Lprz);
  M = cgetg(l, t_MAT);
  for (j=1; j<l; j++) gel(M,j) = cgetg(lz, t_VECSMALL);
  for (i=1; i < lz; i++)
  {
    GEN pr = gel(Lprz,i), EX = subiu(pr_norm(pr), 1);
    GEN N, g,T,p, prM = idealhnf_shallow(nfz, pr);
    GEN modpr = zk_to_Fq_init(nfz, &pr,&T,&p);
    long v = Z_lvalrem(divis(EX,ell), ell, &N) + 1; /* Norm(pr)-1 = N * ell^v */
    GEN ellv = powuu(ell, v);
    g = gener_Fq_local(T,p, Lell);
    g = Fq_pow(g,N, T,p); /* order ell^v */
    for (j=1; j < l; j++)
    {
      GEN logc, c = gel(vecWA,j);
      if (typ(c) == t_MAT) /* famat */
        c = famat_makecoprime(nfz, gel(c,1), gel(c,2), pr, prM, EX);
      c = nf_to_Fq(nfz, c, modpr);
      c = Fq_pow(c, N, T,p);
      logc = Fq_log(c, g, ellv, T,p);
      ucoeff(M, i,j) = umodiu(logc, ell);
    }
  }
  return M;
}

static GEN
futu(GEN bnf)
{
  GEN fu, tu, SUnits = bnf_get_sunits(bnf);
  if (SUnits)
  {
    tu = nf_to_scalar_or_basis(bnf_get_nf(bnf), bnf_get_tuU(bnf));
    fu = bnf_compactfu(bnf);
  }
  else
  {
    GEN U = bnf_build_units(bnf);
    tu = gel(U,1); fu = vecslice(U, 2, lg(U)-1);
  }
  return vec_append(fu, tu);
}
static GEN
bnf_cycgenmod(GEN bnf, long ell, GEN *pselmer, long *prc)
{
  GEN gen = bnf_get_gen(bnf), cyc = bnf_get_cyc(bnf), nf = bnf_get_nf(bnf);
  GEN B, r = ZV_to_Flv(cyc, ell);
  long i, rc, l = lg(gen);
  B = cgetg(l, t_VEC);
  for (i = 1; i < l && !r[i]; i++);
  *prc = rc = i-1; /* ell-rank */
  for (i = 1; i < l; i++)
  {
    GEN G, q, c = gel(cyc,i), g = gel(gen,i);
    if (i > rc && r[i] != 1) c  = muliu(c, Fl_inv(r[i], ell));
    q = divis(c, ell); /* remainder = 0 (i <= rc) or 1 */
    /* compute (b) = g^c mod ell-th powers */
    G = equali1(q)? g: idealpowred(nf, g, q); /* lose principal part */
    G = idealpows(nf, G, ell);
    if (i > rc) G = idealmul(nf, G, g);
    gel(B,i) = gel(bnfisprincipal0(bnf, G, nf_GENMAT|nf_FORCE), 2);
  }
  *pselmer = shallowconcat(futu(bnf), vecslice(B,1,rc));
  return B;
}

static GEN
rnfkummersimple(GEN bnr, GEN H, long ell)
{
  long j, lSp, rc;
  GEN bnf, nf,bid, cycgenmod, Sp, vsprk, matP;
  GEN be, M, K, vecW, vecWB, vecBp, gell = utoipos(ell);
  /* primes landing in H must be totally split */
  GEN Lpr = get_prlist(bnr, H, gell, NULL, NULL);

  bnf = bnr_get_bnf(bnr); if (!bnf_get_sunits(bnf)) bnf_build_units(bnf);
  nf  = bnf_get_nf(bnf);
  bid = bnr_get_bid(bnr);
  list_Hecke(&Sp, &vsprk, nf, bid_get_fact2(bid), gell, NULL);

  cycgenmod = bnf_cycgenmod(bnf, ell, &vecW, &rc);
  lSp = lg(Sp);
  vecBp = cgetg(lSp, t_VEC);
  matP  = cgetg(lSp, t_MAT);
  for (j = 1; j < lSp; j++)
    isprincipalell(bnf,gel(Sp,j), cycgenmod,ell,rc, &gel(matP,j),&gel(vecBp,j));
  vecWB = shallowconcat(vecW, vecBp);

  M = matlogall(nf, vecWB, 0, 0, gell, vsprk);
  M = vconcat(M, shallowconcat(zero_Flm(rc,lg(vecW)-1), matP));
  M = vconcat(M, subgroup_info(bnf, Lpr, gell, vecWB));
  K = Flm_ker(M, ell);
  if (ell == 2)
  {
    GEN msign = nfsign(nf, vecWB), y;
    GEN arch = ZV_to_zv(bid_get_arch(bid)); /* the conductor */
    msign = Flm_mul(msign, K, 2);
    y = Flm_ker(msign, 2);
    y = zv_equal0(arch)? gel(y,1): Flm_Flc_invimage(msign, arch, 2);
    K = Flm_Flc_mul(K, y, 2);
  }
  else
    K = gel(K,1);
  be = compute_beta(K, vecWB, gell, bnf);
  be = nf_to_scalar_or_alg(nf, be);
  if (typ(be) == t_POL) be = mkpolmod(be, nf_get_pol(nf));
  return gsub(pol_xn(ell, 0), be);
}

static ulong
nf_to_logFl(GEN nf, GEN x, GEN modpr, ulong g, ulong q, ulong ell, ulong p)
{
  x = nf_to_Fp_coprime(nf, x, modpr);
  return Fl_log(Fl_powu(umodiu(x, p), q, p), g, ell, p);
}
static GEN
nfV_to_logFlv(GEN nf, GEN x, GEN modpr, ulong g, ulong q, ulong ell, ulong p)
{ pari_APPLY_long(nf_to_logFl(nf, gel(x,i), modpr, g, q, ell, p)); }

/* Compute e_1 Cl(K)/Cl(K)^ell. If u = w^ell a virtual unit, compute
 * discrete log mod ell on units.gen + bnf.gen (efficient variant of algo
 * 5.3.11) by finding ru degree 1 primes Pj coprime to everything, and gj
 * in k(Pj)^* of order ell such that
 *      log_gj(u_i^((Pj.p - 1) / ell) mod Pj), j = 1..ru
 * has maximal F_ell rank ru then solve linear system */
static GEN
kervirtualunit(struct rnfkummer *kum, GEN vselmer)
{
  GEN bnf = kum->bnfz, cyc = bnf_get_cyc(bnf), nf = bnf_get_nf(bnf);
  GEN W, B, vy, vz, M, U1, U2, vtau, vell, SUnits = bnf_get_sunits(bnf);
  long i, j, r, l = lg(vselmer), rc = kum->rc, ru = l-1 - rc, ell = kum->ell;
  long LIMC = SUnits? itou(gel(SUnits,4)): 1;
  ulong p;
  forprime_t T;

  vtau = cgetg(l, t_VEC);
  vell = cgetg(l, t_VEC);
  for (j = 1; j < l; j++)
  {
    GEN t = gel(vselmer,j);
    if (typ(t) == t_MAT)
    {
      GEN ct;
      t = nffactorback(bnf, gel(t,1), ZV_to_Flv(gel(t,2), ell));
      t = Q_primitive_part(t, &ct);
      if (ct)
      {
        GEN F = Q_factor(ct);
        ct = factorback2(gel(F,1), ZV_to_Flv(gel(F,2), ell));
        t = (typ(t) == t_INT)? ct: ZC_Z_mul(t, ct);
      }
    }
    gel(vell,j) = t; /* integral, not too far from primitive */
    gel(vtau,j) = tauofelt(t, &kum->tau);
  }
  U1 = vecslice(vell, 1, ru); /* units */
  U2 = vecslice(vell, ru+1, ru+rc); /* cycgen (mod ell-th powers) */
  B = nf_get_index(nf); /* bad primes; from 1 to ru are LIMC-units */
  for (i = 1; i <= rc; i++) B = mulii(B, nfnorm(nf, gel(U2,i)));
  if (LIMC > 1)
  {
    GEN U, fa = absZ_factor_limit_strict(B, LIMC, &U), P = gel(fa,1);
    long lP = lg(P);
    B = U? gel(U,1): gen_1;
    if (lP > 1 && cmpiu(gel(P,lP-1), LIMC) >= 0) B = mulii(B, gel(P,lP-1));
  }
  if (is_pm1(B)) B = NULL;
  vy = cgetg(l, t_MAT);
  for (j = 1; j <= ru; j++) gel(vy,j) = zero_Flv(rc); /* units */
  for (     ; j < l; j++)
  {
    GEN y, w, u = gel(vtau, j); /* virtual unit */
    if (!idealispower(nf, u, ell, &w)) pari_err_BUG("kervirtualunit");
    y = isprincipal(bnf, w); setlg(y, rc+1);
    if (!ZV_equal0(y))
      for (i = 1; i <= rc; i++)
        gel(y,i) = diviiexact(mului(ell,gel(y,i)), gel(cyc,i));
    gel(vy,j) = ZV_to_Flv(y, ell);
  }
  u_forprime_arith_init(&T, LIMC+1, ULONG_MAX, 1, ell);
  M = cgetg(ru+1, t_MAT); r = 1; setlg(M,2);
  vz = cgetg(ru+1, t_MAT);
  while ((p = u_forprime_next(&T))) if (!B || umodiu(B,p))
  {
    GEN P = idealprimedec_limit_f(nf, utoipos(p), 1);
    long nP = lg(P)-1;
    ulong g = rootsof1_Fl(ell, p), q = p / ell; /* (p-1) / ell */
    for (i = 1; i <= nP; i++)
    {
      GEN modpr = zkmodprinit(nf, gel(P,i));
      GEN z, v2;
      gel(M, r) = nfV_to_logFlv(nf, U1, modpr, g, q, ell, p); /* log futu */
      if (Flm_rank(M, ell) < r) continue; /* discard */

      v2 = nfV_to_logFlv(nf, U2, modpr, g, q, ell, p); /* log alpha[1..rc] */
      gel(vz, r) = z = nfV_to_logFlv(nf, vtau, modpr, g, q, ell, p);
      for (j = ru+1; j < l; j++)
        uel(z,j) = Fl_sub(uel(z,j), Flv_dotproduct(v2, gel(vy,j), ell), ell);
      if (r == ru) break;
      r++; setlg(M, r+1);
    }
    if (i < nP) break;
  }
  if (r != ru) pari_err_BUG("kervirtualunit");
  /* Solve prod_k U[k]^x[j,k] = vtau[j] / prod_i alpha[i]^vy[j,i] mod (K^*)^ell
   * for 1 <= j <= #vtau. I.e. for a fixed j: M x[j] = vz[j] (mod ell) */
  M = Flm_inv(Flm_transpose(M), ell);
  vz = Flm_transpose(vz); /* now ru x #vtau */
  for (j = 1; j < l; j++)
    gel(vy,j) = shallowconcat(Flm_Flc_mul(M, gel(vz,j), ell), gel(vy,j));
  W = Flm_ker(Flm_Fl_sub(vy, kum->g, ell), ell); l = lg(W);
  for (j = 1; j < l; j++)
    gel(W,j) = famat_reduce(famatV_zv_factorback(vselmer, gel(W,j)));
  settyp(W, t_VEC); return W;
}

/* - mu_b = sum_{0 <= i < m} floor(r_b r_{m-1-i} / ell) tau^i.
 * Note that i is in fact restricted to i < m-1 */
static GEN
get_mmu(long b, GEN r, long ell)
{
  long i, m = lg(r)-1;
  GEN M = cgetg(m, t_VECSMALL);
  for (i = 0; i < m-1; i++) M[i+1] = (r[b + 1] * r[m - i]) / ell;
  return M;
}
/* max_b zv_sum(mu_b) < m ell */
static long
max_smu(GEN r, long ell)
{
  long i, s = 0, z = vecsmall_max(r), l = lg(r);
  for (i = 2; i < l; i++) s += (z * r[i]) / ell;
  return s;
}

/* coeffs(x, a..b) in variable 0 >= varn(x) */
static GEN
split_pol(GEN x, long a, long b)
{
  long i, l = degpol(x);
  GEN y = x + a, z;

  if (l < b) b = l;
  if (a > b || varn(x) != 0) return pol_0(0);
  l = b-a + 3;
  z = cgetg(l, t_POL); z[1] = x[1];
  for (i = 2; i < l; i++) gel(z,i) = gel(y,i);
  return normalizepol_lg(z, l);
}

/* return (ad * z) mod (T^ell - an/ad), assuming deg_T(z) < 2*ell
 * allow ad to be NULL (= 1) */
static GEN
mod_Xell_a(GEN z, long ell, GEN an, GEN ad, GEN T)
{
  GEN z1 = split_pol(z, ell, degpol(z));
  GEN z0 = split_pol(z, 0,   ell-1); /* z = v^ell z1 + z0*/
  if (ad) z0 = ZXX_Z_mul(z0, ad);
  return gadd(z0, ZXQX_ZXQ_mul(z1, an, T));
}
/* D*basistoalg(nfz, c), in variable v. Result is integral */
static GEN
to_alg(GEN nfz, GEN c, GEN D)
{
  if (typ(c) != t_COL) return D? mulii(D,c): c;
  return RgV_dotproduct(nf_get_zkprimpart(nfz), c);
}
/* assume x in alg form */
static GEN
downtoK(toK_s *T, GEN x)
{
  if (typ(x) != t_POL) return x;
  x = RgM_RgC_mul(T->invexpoteta1, RgX_to_RgC(x, lg(T->invexpoteta1) - 1));
  return mkpolmod(RgV_to_RgX(x, varn(T->polnf)), T->polnf);
}

/* th. 5.3.5. and prop. 5.3.9. */
static GEN
compute_polrel(struct rnfkummer *kum, GEN be)
{
  toK_s *T = &kum->T;
  long i, k, MU = 0, ell = kum->ell, m = T->m;
  GEN r = Fl_powers(kum->g, m-1, ell); /* r[i+1] = g^i mod ell */
  GEN D, S, root, numa, powtau_Ninvbe, Ninvbe, Dinvbe;
  GEN C, prim_Rk, C_Rk, prim_root, C_root, mell = utoineg(ell);
  GEN nfz = bnf_get_nf(kum->bnfz), Tz = nf_get_pol(nfz), Dz = nf_get_zkden(nfz);
  pari_timer ti;

  if (DEBUGLEVEL>1) { err_printf("Computing Newton sums: "); timer_start(&ti); }
  if (equali1(Dz)) Dz = NULL;
  D = Dz;
  Ninvbe = Q_remove_denom(nfinv(nfz, be), &Dinvbe);
  powtau_Ninvbe = powtau(Ninvbe, m-1, T->tau);
  if (Dinvbe)
  {
    MU = max_smu(r, ell);
    D = mul_denom(Dz, powiu(Dinvbe, MU));
  }

  root = cgetg(ell + 2, t_POL); /* compute D*root, will correct at the end */
  root[1] = evalsigne(1) | evalvarn(0);
  gel(root,2) = gen_0;
  gel(root,3) = D? D: gen_1;
  for (i = 2; i < ell; i++) gel(root,2+i) = gen_0;
  for (i = 1; i < m; i++)
  { /* compute (1/be) ^ (-mu) instead of be^mu [mu < 0].
     * 1/be = Ninvbe / Dinvbe */
    GEN mmu = get_mmu(i, r, ell), t;
    t = to_alg(nfz, nffactorback(nfz, powtau_Ninvbe, mmu), Dz);/* Ninvbe^-mu */
    if (Dinvbe)
    {
      long a = MU - zv_sum(mmu);
      if (a) t = gmul(t, powiu(Dinvbe, a));
    }
    gel(root, 2 + r[i+1]) = t; /* root += D * (z_ell*T)^{r_i} be^mu_i */
  }
  root = ZXX_renormalize(root, ell+2);
  /* Other roots are as above with z_ell -> z_ell^j.
   * Treat all contents (C_*) and principal parts (prim_*) separately */
  prim_root = Q_primitive_part(root, &C_root);
  C_root = div_content(C_root, D);

  /* theta^ell = be^( sum tau^a r_{d-1-a} ) = a = numa / Dz */
  numa = to_alg(nfz, nffactorback(nfz, powtau(be, m, T->tau),
                                  vecsmall_reverse(r)), Dz);
  if (DEBUGLEVEL>1) err_printf("root(%ld) ", timer_delay(&ti));

  /* Compute mod (X^ell - t, nfz.pol) */
  C_Rk = C_root; prim_Rk = prim_root;
  C = div_content(C_root, Dz);
  S = cgetg(ell+3, t_POL); /* Newton sums */
  S[1] = evalsigne(1) | evalvarn(0);
  gel(S,2) = gen_0;
  for (k = 2; k <= ell; k++)
  { /* compute the k-th Newton sum; here C_Rk ~ C_root  */
    pari_sp av = avma;
    GEN z, C_z, d, Rk = ZXQX_mul(prim_Rk, prim_root, Tz);
    Rk = mod_Xell_a(Rk, ell, numa, Dz, Tz); /* (mod X^ell - a, nfz.pol) */
    prim_Rk = Q_primitive_part(Rk, &d); /* d C_root ~ 1 */
    C_Rk = mul_content(C_Rk, mul_content(d, C));
    /* root^k = prim_Rk * C_Rk */
    z = Q_primitive_part(gel(prim_Rk,2), &C_z); /* C_z ~ 1/C_root ~ 1/C_Rk */
    z = downtoK(T, z);
    C_z = mul_content(mul_content(C_z, C_Rk), mell);
    z = gmul(z, C_z); /* C_z ~ 1 */
    gerepileall(av, C_Rk? 3: 2, &z, &prim_Rk, &C_Rk);
    if (DEBUGLEVEL>1) err_printf("%ld(%ld) ", k, timer_delay(&ti));
    gel(S,k+1) = z; /* - Newton sum */
  }
  gel(S,ell+2) = gen_m1; if (DEBUGLEVEL>1) err_printf("\n");
  return RgX_recip(RgXn_expint(S,ell+1));
}

static void
compositum_red(compo_s *C, GEN P, GEN Q)
{
  GEN p, q, a, z = gel(compositum2(P, Q),1);
  a = gel(z,1);
  p = gel(gel(z,2), 2);
  q = gel(gel(z,3), 2);
  C->k = itos( gel(z,4) );
  z = polredbest(a, nf_ORIG);
  C->R = gel(z,1);
  a = gel(gel(z,2), 2);
  C->p = RgX_RgXQ_eval(p, a, C->R);
  C->q = RgX_RgXQ_eval(q, a, C->R);
  C->rev = QXQ_reverse(a, C->R);
}

/* replace P->C^(-deg P) P(xC) for the largest integer C such that coefficients
 * remain algebraic integers. Lift *rational* coefficients */
static void
nfX_Z_normalize(GEN nf, GEN P)
{
  long i, l;
  GEN C, Cj, PZ = cgetg_copy(P, &l);
  PZ[1] = P[1];
  for (i = 2; i < l; i++) /* minor variation on RgX_to_nfX (create PZ) */
  {
    GEN z = nf_to_scalar_or_basis(nf, gel(P,i));
    if (typ(z) == t_INT)
      gel(PZ,i) = gel(P,i) = z;
    else
      gel(PZ,i) = ZV_content(z);
  }
  (void)ZX_Z_normalize(PZ, &C);

  if (C == gen_1) return;
  Cj = C;
  for (i = l-2; i > 1; i--)
  {
    if (i != l-2) Cj = mulii(Cj, C);
    gel(P,i) = gdiv(gel(P,i), Cj);
  }
}

/* set kum->vecC, kum->tQ */
static void
_rnfkummer_step4(struct rnfkummer *kum, long d, long m)
{
  long i, j, rc = kum->rc;
  GEN Q, vT, vB, vC, vz, B = cgetg(rc+1,t_VEC), T = cgetg(rc+1,t_MAT);
  GEN gen = bnf_get_gen(kum->bnfz), cycgenmod = kum->cycgenmod;
  ulong ell = kum->ell;

  for (j = 1; j <= rc; j++)
  {
    GEN t = tauofideal(gel(gen,j), &kum->tau);
    isprincipalell(kum->bnfz, t, cycgenmod,ell,rc, &gel(T,j), &gel(B,j));
  }
  Q = Flm_ker(Flm_Fl_sub(Flm_transpose(T), kum->g, ell), ell);
  kum->tQ = lg(Q) == 1? NULL: Flm_transpose(Q);
  kum->vecC = vC = cgetg(rc+1, t_VEC);
  /* T = rc x rc matrix */
  vT = Flm_powers(T, m-2, ell);
  vB = cgetg(m, t_VEC);
  vz = cgetg(rc+1, t_VEC);
  for (i = 1; i <= rc; i++) gel(vz, i) = cgetg(m, t_VEC);
  for (j = 1; j < m; j++)
  {
    GEN Tj = Flm_Fl_mul(gel(vT,m-j), Fl_mul(j,d,ell), ell);
    gel(vB, j) = tauofvec(j == 1? B: gel(vB, j-1), &kum->tau);
    for (i = 1; i <= rc; i++) gmael(vz, i, j) = gel(Tj, i);
  }
  vB = shallowconcat1(vB);
  for (i = 1; i <= rc; i++)
  {
    GEN z = shallowconcat1(gel(vz,i));
    gel(vC,i) = famat_reduce(famatV_zv_factorback(vB, z));
  }
}

/* alg 5.3.5 */
static void
rnfkummer_init(struct rnfkummer *kum, GEN bnf, GEN P, ulong ell, long prec)
{
  compo_s *COMPO = &kum->COMPO;
  toK_s *T = &kum->T;
  GEN nf  = bnf_get_nf(bnf), polnf = nf_get_pol(nf), vselmer, bnfz, nfz;
  long degK, degKz, m, d;
  ulong g;
  pari_timer ti;
  if (DEBUGLEVEL>2) err_printf("Step 1\n");
  if (DEBUGLEVEL) timer_start(&ti);
  compositum_red(COMPO, polnf, polcyclo(ell, varn(polnf)));
  if (DEBUGLEVEL)
  {
    timer_printf(&ti, "[rnfkummer] compositum");
    if (DEBUGLEVEL>1) err_printf("polred(compositum) = %Ps\n",COMPO->R);
  }
  if (DEBUGLEVEL>2) err_printf("Step 2\n");
  degK  = degpol(polnf);
  degKz = degpol(COMPO->R);
  m = degKz / degK; /* > 1 */
  d = (ell-1) / m;
  g = Fl_powu(pgener_Fl(ell), d, ell);
  if (Fl_powu(g, m, ell*ell) == 1) g += ell;
  /* ord(g) = m in all (Z/ell^k)^* */
  if (DEBUGLEVEL>2) err_printf("Step 3\n");
  nfz = nfinit(mkvec2(COMPO->R, P), prec);
  if (lg(nfcertify(nfz)) > 1) nfz = nfinit(COMPO->R, prec); /* paranoia */
  kum->bnfz = bnfz = Buchall(nfz, nf_FORCE, prec);
  if (DEBUGLEVEL) timer_printf(&ti, "[rnfkummer] bnfinit(Kz)");
  kum->cycgenmod = bnf_cycgenmod(bnfz, ell, &vselmer, &kum->rc);
  kum->ell = ell;
  kum->g = g;
  kum->mgi = Fl_div(m, g, ell);
  get_tau(kum);
  if (DEBUGLEVEL>2) err_printf("Step 4\n");
  if (kum->rc)
    _rnfkummer_step4(kum, d, m);
  else
  { kum->vecC = cgetg(1, t_VEC); kum->tQ = NULL; }
  if (DEBUGLEVEL>2) err_printf("Step 5\n");
  kum->vecW = kervirtualunit(kum, vselmer);
  if (DEBUGLEVEL>2) err_printf("Step 8\n");
  /* left inverse */
  T->invexpoteta1 = QM_inv(RgXQ_matrix_pow(COMPO->p, degKz, degK, COMPO->R));
  T->polnf = polnf;
  T->tau = &kum->tau;
  T->m = m;
  T->powg = Fl_powers(g, m, ell);
}

static GEN
rnfkummer_ell(struct rnfkummer *kum, GEN bnr, GEN H)
{
  ulong ell = kum->ell;
  GEN bnfz = kum->bnfz, nfz = bnf_get_nf(bnfz), gell = utoipos(ell);
  GEN vecC = kum->vecC, vecW = kum->vecW, cycgenmod = kum->cycgenmod;
  long lW = lg(vecW), rc = kum->rc, j, lSp;
  toK_s *T = &kum->T;
  GEN K, be, P, faFz, vsprk, Sp, vecAp, vecBp, matP, vecWA, vecWB, M, lambdaWB;
  /* primes landing in H must be totally split */
  GEN Lpr = get_prlist(bnr, H, gell, &faFz, kum);

  if (DEBUGLEVEL>2) err_printf("Step 9, 10 and 11\n");
  list_Hecke(&Sp, &vsprk, nfz, faFz, gell, T->tau);

  if (DEBUGLEVEL>2) err_printf("Step 12\n");
  lSp = lg(Sp);
  vecAp = cgetg(lSp, t_VEC);
  vecBp = cgetg(lSp, t_VEC);
  matP  = cgetg(lSp, t_MAT);
  for (j = 1; j < lSp; j++)
  {
    GEN e, a;
    isprincipalell(bnfz, gel(Sp,j), cycgenmod,ell,rc, &e, &a);
    gel(matP,j) = e;
    gel(vecBp,j) = famat_mul_shallow(famatV_zv_factorback(vecC, zv_neg(e)), a);
    gel(vecAp,j) = lambdaofelt(gel(vecBp,j), T);
  }
  if (DEBUGLEVEL>2) err_printf("Step 13\n");
  vecWA = shallowconcat(vecW, vecAp);
  vecWB = shallowconcat(vecW, vecBp);

  if (DEBUGLEVEL>2) err_printf("Step 14, 15 and 17\n");
  M = matlogall(nfz, vecWA, lW, kum->mgi, gell, vsprk);
  if (kum->tQ)
  {
    GEN QtP = Flm_mul(kum->tQ, matP, ell);
    M = vconcat(M, shallowconcat(zero_Flm(lgcols(kum->tQ)-1,lW-1), QtP));
  }
  lambdaWB = shallowconcat(lambdaofvec(vecW, T), vecAp);/*vecWB^lambda*/
  M = vconcat(M, subgroup_info(bnfz, Lpr, gell, lambdaWB));
  if (DEBUGLEVEL>2) err_printf("Step 16\n");
  K = Flm_ker(M, ell);
  if (DEBUGLEVEL>2) err_printf("Step 18\n");
  be = compute_beta(gel(K,1), vecWB, gell, kum->bnfz);
  P = compute_polrel(kum, be);
  nfX_Z_normalize(bnr_get_nf(bnr), P);
  if (DEBUGLEVEL>1) err_printf("polrel(beta) = %Ps\n", P);
  return P;
}

static void
bnrclassfield_sanitize(GEN *pbnr, GEN *pH)
{
  GEN T;
  bnr_subgroup_sanitize(pbnr, pH);
  T = nf_get_pol(bnr_get_nf(*pbnr));
  if (!varn(T)) pari_err_PRIORITY("bnrclassfield", T, "=", 0);
}

static GEN
_rnfkummer(GEN bnr, GEN H, long prec)
{
  ulong ell;
  GEN gell, bnf, nf, P;
  struct rnfkummer kum;

  bnrclassfield_sanitize(&bnr, &H);
  gell = H? ZM_det(H): ZV_prod(bnr_get_cyc(bnr));
  ell = itou(gell);
  if (ell == 1) return pol_x(0);
  if (!uisprime(ell)) pari_err_IMPL("rnfkummer for composite relative degree");
  if (bnf_get_tuN(bnr_get_bnf(bnr)) % ell == 0)
    return rnfkummersimple(bnr, H, ell);
  bnf =  bnr_get_bnf(bnr); nf = bnf_get_nf(bnf);
  P = ZV_union_shallow(nf_get_ramified_primes(nf), mkvec(gell));
  rnfkummer_init(&kum, bnf, P, ell, maxss(prec,BIGDEFAULTPREC));
  return rnfkummer_ell(&kum, bnr, H);
}

GEN
rnfkummer(GEN bnr, GEN H, long prec)
{ pari_sp av = avma; return gerepilecopy(av, _rnfkummer(bnr, H, prec)); }

/*******************************************************************/
/*                        bnrclassfield                            */
/*******************************************************************/

/* TODO: could be exported */
static void
gsetvarn(GEN x, long v)
{
  long i;
  switch(typ(x))
  {
    case t_POL: case t_SER:
      setvarn(x, v); return;
    case t_LIST:
      x = list_data(x); if (!x) return;
      /* fall through t_VEC */
    case t_VEC: case t_COL: case t_MAT:
      for (i = lg(x)-1; i > 0; i--) gsetvarn(gel(x,i), v);
  }
}

/* emb root of pol as polmod modulo pol2, return relative polynomial */
static GEN
relative_pol(GEN pol, GEN emb, GEN pol2)
{
  GEN eqn, polrel;
  if (degree(pol)==1) return pol2;
  eqn = gsub(liftpol_shallow(emb), pol_x(varn(pol)));
  eqn = Q_remove_denom(eqn, NULL);
  polrel = nfgcd(pol2, eqn, pol, NULL);
  return RgX_Rg_div(polrel, leading_coeff(polrel));
}

/* pol defines K/nf */
static GEN
bnrclassfield_tower(GEN bnr, GEN subgroup, GEN TB, GEN p, long finaldeg, long absolute, long prec)
{
  pari_sp av = avma;
  GEN nf, nf2, rnf, bnf, bnf2, bnr2, q, H, dec, cyc, pk, sgpk, pol2, emb, emb2, famod, fa, Lbad;
  long i, r1, ell, sp, spk, last;
  forprime_t iter;

  bnf = bnr_get_bnf(bnr);
  nf = bnf_get_nf(bnf);
  rnf = rnfinit0(nf, TB, 1);
  nf2 = rnf_build_nfabs(rnf, prec);
  gsetvarn(nf2, varn(nf_get_pol(nf)));

  if (lg(nfcertify(nf2)) > 1)
  {
    rnf = rnfinit0(nf, gel(TB,1), 1);
    nf2 = rnf_build_nfabs(rnf, prec);
    gsetvarn(nf2, varn(nf_get_pol(nf)));
  }

  r1 = nf_get_r1(nf2);
  bnf2 = Buchall(nf2, nf_FORCE, prec);

  sp = itos(p);
  spk = sp * rnf_get_degree(rnf);
  pk = stoi(spk);
  sgpk = hnfmodid(subgroup,pk);
  last = spk==finaldeg;

  /* compute conductor */
  famod = gel(bid_get_fact2(bnr_get_bid(bnr)),1);
  if (lg(famod)==1)
  {
    fa = trivial_fact();
    Lbad = cgetg(1, t_VECSMALL);
  }
  else
  {
    long j=1;
    fa = cgetg(3, t_MAT);
    gel(fa,1) = cgetg(lg(famod), t_VEC);
    Lbad = cgetg(lg(famod), t_VEC);
    for(i=1; i<lg(famod); i++)
    {
      GEN pr = gel(famod,i);
      gmael(fa,1,i) = rnfidealprimedec(rnf, pr);
      q = pr_get_p(pr);
      if (lgefint(q) == 3) gel(Lbad,j++) = q;
    }
    setlg(Lbad,j);
    Lbad = ZV_to_zv(ZV_sort_uniq_shallow(Lbad));
    gel(fa,1) = shallowconcat1(gel(fa,1));
    settyp(gel(fa,1), t_COL);
    gel(fa,2) = cgetg(lg(gel(fa,1)), t_COL);
    for (i=1; i<lg(gel(fa,1)); i++)
    {
      GEN pr = gcoeff(fa,i,1);
      long e = equalii(p, pr_get_p(pr))? 1 + (pr_get_e(pr)*sp) / (sp-1): 1;
      gcoeff(fa,i,2) = utoipos(e);
    }
  }
  bnr2 = Buchraymod(bnf2, mkvec2(fa, const_vec(r1,gen_1)), nf_INIT, pk);

  /* compute subgroup */
  cyc = bnr_get_cyc(bnr2);
  H = Flm_image(zv_diagonal(ZV_to_Flv(cyc,sp)), sp);
  u_forprime_init(&iter, 2, ULONG_MAX);
  while ((ell = u_forprime_next(&iter))) if (!zv_search(Lbad, ell))
  {
    dec = idealprimedec_limit_f(nf, utoi(ell), 1);
    for (i=1; i<lg(dec); i++)
    {
      GEN pr = gel(dec,i), Pr = gel(rnfidealprimedec(rnf, pr), 1);
      long f = pr_get_f(Pr) / pr_get_f(pr);
      GEN vpr = FpC_Fp_mul(bnrisprincipalmod(bnr,pr,pk,0), utoi(f), pk);
      if (gequal0(ZC_hnfrem(vpr,sgpk)))
        H = vec_append(H, ZV_to_Flv(bnrisprincipalmod(bnr2,Pr,p,0), sp));
    }
    if (lg(H) > lg(cyc)+3)
    {
      H = Flm_image(H, sp);
      if (lg(cyc)-lg(H) == 1) break;
    }
  }
  H = hnfmodid(shallowconcat(zm_to_ZM(H), diagonal_shallow(cyc)), p);

  /* polynomial over nf2 */
  pol2 = _rnfkummer(bnr2, H, prec);
  /* absolute polynomial */
  pol2 = rnfequation2(nf2, pol2);
  emb2 = gel(pol2,2); /* generator of nf2 as polmod modulo pol2 */
  pol2 = gel(pol2,1);
  /* polynomial over nf */
  if (!absolute || !last)
  {
    emb = rnf_get_alpha(rnf); /* generator of nf as polynomial in nf2 */
    emb = poleval(emb, emb2); /* generator of nf as polmod modulo pol2 */
    pol2 = relative_pol(nf_get_pol(nf), emb, pol2);
  }
  if (!last) pol2 = rnfpolredbest(nf, pol2, 0);

  obj_free(rnf);
  pol2 = gerepilecopy(av, pol2);
  if (last) return pol2;
  TB = mkvec2(pol2, gel(TB,2));
  return bnrclassfield_tower(bnr, subgroup, TB, p, finaldeg, absolute, prec);
}

/* subgroups H_i of bnr s.t. bnr/H_i is cyclic and inter_i H_i = subgroup */
static GEN
cyclic_compos(GEN subgroup)
{
  pari_sp av = avma;
  GEN Ui, L, pe, D = ZM_snf_group(subgroup, NULL, &Ui);
  long i, l = lg(D);

  L = cgetg(l, t_VEC);
  if (l == 1) return L;
  pe = gel(D,1);
  for (i = 1; i < l; i++)
    gel(L,i) = hnfmodid(shallowconcat(subgroup, vecsplice(Ui,i)),pe);
  return gerepilecopy(av, L);
}

/* p prime; set pkum=NULL if p-th root of unity in base field
 * absolute=1 allowed if extension is cyclic with exponent>1 */
static GEN
bnrclassfield_primepower(struct rnfkummer *pkum, GEN bnr, GEN subgroup, GEN p,
  GEN P, long absolute, long prec)
{
  GEN res, subs = cyclic_compos(subgroup);
  long i, l = lg(subs);

  res = cgetg(l,t_VEC);
  for (i = 1; i < l; i++)
  {
    GEN H = gel(subs,i), cnd = bnrconductormod(bnr, hnfmodid(H,p), p);
    GEN pol, pe, bnr2 = gel(cnd,2), Hp = gel(cnd,3);
    if (pkum) pol = rnfkummer_ell(pkum, bnr2, Hp);
    else      pol = rnfkummersimple(bnr2, Hp, itos(p));
    pe = ZM_det_triangular(H);
    if (!equalii(p,pe))
      pol = bnrclassfield_tower(bnr, H, mkvec2(pol,P), p, itos(pe), absolute, prec);
    gel(res,i) = pol;
  }
  return res;
}

/* partition of v into two subsets whose products are as balanced as possible */
/* assume v sorted */
static GEN
vecsmall_balance(GEN v)
{
  forvec_t T;
  GEN xbounds, x, vuniq, mult, ind, prod, prodbest = gen_0, bound,
      xbest = NULL, res1, res2;
  long i=1, j, k1, k2;
  if (lg(v) == 3) return mkvec2(mkvecsmall(1), mkvecsmall(2));
  vuniq = cgetg(lg(v), t_VECSMALL);
  mult = cgetg(lg(v), t_VECSMALL);
  ind = cgetg(lg(v), t_VECSMALL);
  vuniq[1] = v[1];
  mult[1] = 1;
  ind[1] = 1;
  for (j=2; j<lg(v); j++)
  {
    if (v[j] == vuniq[i]) mult[i]++;
    else
    {
      i++;
      vuniq[i] = v[j];
      mult[i] = 1;
      ind[i] = j;
    }
  }
  setlg(vuniq, ++i);
  setlg(mult, i);
  setlg(ind, i);

  vuniq = zv_to_ZV(vuniq);
  prod = factorback2(vuniq, mult);
  bound = sqrti(prod);
  xbounds = cgetg(lg(mult), t_VEC);
  for (i=1; i<lg(mult); i++) gel(xbounds,i) = mkvec2s(0,mult[i]);

  forvec_init(&T, xbounds, 0);
  while ((x = forvec_next(&T)))
  {
    prod = factorback2(vuniq, x);
    if (cmpii(prod,bound)<=0 && cmpii(prod,prodbest)>0)
    {
      prodbest = prod;
      xbest = gcopy(x);
    }
  }
  res1 = cgetg(lg(v), t_VECSMALL);
  res2 = cgetg(lg(v), t_VECSMALL);
  for (i=1,k1=1,k2=1; i<lg(xbest); i++)
  {
    for (j=0; j<itos(gel(xbest,i)); j++) res1[k1++] = ind[i]+j;
    for (; j<mult[i]; j++)               res2[k2++] = ind[i]+j;
  }
  setlg(res1, k1);
  setlg(res2, k2); return mkvec2(res1, res2);
}

/* TODO nfcompositum should accept vectors of pols */
/* assume all fields are linearly disjoint */
/* assume the polynomials are sorted by degree */
static GEN
nfcompositumall(GEN nf, GEN L)
{
  GEN pol, vdeg, part;
  long i;
  if (lg(L)==2) return gel(L,1);
  vdeg = cgetg(lg(L), t_VECSMALL);
  for (i=1; i<lg(L); i++) vdeg[i] = degree(gel(L,i));
  part = vecsmall_balance(vdeg);
  pol = cgetg(3, t_VEC);
  for (i = 1; i < 3; i++)
  {
    GEN L2 = vecpermute(L, gel(part,i)), T = nfcompositumall(nf, L2);
    gel(pol,i) = rnfpolredbest(nf, T, 0);
  }
  return nfcompositum(nf, gel(pol,1), gel(pol,2), 2);
}

static GEN
disc_primes(GEN bnr)
{
  GEN v = bid_primes(bnr_get_bid(bnr));
  GEN r = nf_get_ramified_primes(bnr_get_nf(bnr));
  return ZV_union_shallow(r, v);
}
static struct rnfkummer **
rnfkummer_initall(GEN bnr, GEN vP, GEN P, long prec)
{
  long i, w, l = lg(vP), S = vP[l-1] + 1;
  GEN bnf = bnr_get_bnf(bnr);
  struct rnfkummer **vkum;

  w = bnf_get_tuN(bnf);
  vkum = (struct rnfkummer **)stack_malloc(S * sizeof(struct rnfkummer*));
  if (prec < BIGDEFAULTPREC) prec = BIGDEFAULTPREC;
  for (i = 1; i < l; i++)
  {
    long p = vP[i];
    if (w % p == 0) { vkum[p] = NULL; continue; }
    vkum[p] = (struct rnfkummer *)stack_malloc(sizeof(struct rnfkummer));
    rnfkummer_init(vkum[p], bnf, P, p, prec);
  }
  return vkum;
}
/* fully handle a single congruence subgroup H */
static GEN
bnrclassfield_H(struct rnfkummer **vkum, GEN bnr, GEN bad, GEN H0, GEN fa, long flag,
                long prec)
{
  GEN PN = gel(fa,1), EN = gel(fa,2), res;
  long i, lPN = lg(PN), absolute;

  if (lPN == 1) switch(flag)
  {
    case 0:
      return mkvec(pol_x(0));
    case 1:
      return pol_x(0);
    default: /* 2 */
      res = shallowcopy(nf_get_pol(bnr_get_nf(bnr)));
      setvarn(res,0); return res;
  }
  absolute = flag==2 && lPN==2 && !equali1(gel(EN,1)); /* one prime, exponent > 1 */
  res = cgetg(lPN, t_VEC);
  for (i = 1; i < lPN; i++)
  {
    GEN p = gel(PN,i), H = hnfmodid(H0, powii(p, gel(EN,i)));
    long sp = itos(p);
    if (absolute) absolute = FpM_rank(H,p)==lg(H)-2; /* cyclic */
    gel(res,i) = bnrclassfield_primepower(vkum[sp], bnr, H, p, bad, absolute, prec);
  }
  res = liftpol_shallow(shallowconcat1(res));
  res = gen_sort_shallow(res, (void*)cmp_RgX, gen_cmp_RgX);
  if (flag)
  {
    GEN nf = bnr_get_nf(bnr);
    res = nfcompositumall(nf, res);
    if (flag==2 && !absolute) res = rnfequation(nf, res);
  }
  return res;
}
/* for a vector of subgroups */
static GEN
bnrclassfieldvec(GEN bnr, GEN v, long flag, long prec)
{
  long j, lv = lg(v);
  GEN vH, vfa, vP, P, w = cgetg(lv, t_VEC);
  struct rnfkummer **vkum = NULL;

  if (lv == 1) return w;
  vH = cgetg(lv, t_VEC);
  vP = cgetg(lv, t_VEC);
  vfa = cgetg(lv, t_VEC);
  for (j = 1; j < lv; j++)
  {
    GEN N, fa, H = bnr_subgroup_check(bnr, gel(v,j), &N);
    if (is_bigint(N)) pari_err_OVERFLOW("bnrclassfield [too large degree]");
    if (!H) H = diagonal_shallow(bnr_get_cyc(bnr));
    gel(vH,j) = H;
    gel(vfa,j) = fa = Z_factor(N);
    gel(vP,j) = ZV_to_zv(gel(fa, 1));
  }
  vP = shallowconcat1(vP); vecsmall_sort(vP);
  vP = vecsmall_uniq_sorted(vP);
  P = disc_primes(bnr);
  if (lg(vP) > 1) vkum = rnfkummer_initall(bnr, vP, P, prec);
  for (j = 1; j < lv; j++)
    gel(w,j) = bnrclassfield_H(vkum, bnr, P, gel(vH,j), gel(vfa,j), flag, prec);
  return w;
}
/* flag:
 * 0 t_VEC of polynomials whose compositum is the extension
 * 1 single polynomial
 * 2 single absolute polynomial */
GEN
bnrclassfield(GEN bnr, GEN subgroup, long flag, long prec)
{
  pari_sp av = avma;
  GEN N, fa, P;
  struct rnfkummer **vkum;

  if (flag<0 || flag>2) pari_err_FLAG("bnrclassfield [must be 0,1 or 2]");
  if (subgroup && typ(subgroup) == t_VEC)
  {
    if (nftyp(bnr)==typ_BNF) bnr = Buchray(bnr, gen_1, nf_INIT);
    else checkbnr(bnr);
    if (!char_check(bnr_get_cyc(bnr), subgroup))
      return gerepilecopy(av, bnrclassfieldvec(bnr, subgroup, flag, prec));
  }
  bnrclassfield_sanitize(&bnr, &subgroup);
  N = ZM_det_triangular(subgroup);
  if (equali1(N)) switch(flag)
  {
    case 0: set_avma(av); retmkvec(pol_x(0));
    case 1: set_avma(av); return pol_x(0);
    default: /* 2 */
      P = shallowcopy(nf_get_pol(bnr_get_nf(bnr)));
      setvarn(P,0); return gerepilecopy(av,P);
  }
  if (is_bigint(N)) pari_err_OVERFLOW("bnrclassfield [too large degree]");
  fa = Z_factor(N); P = disc_primes(bnr);
  vkum = rnfkummer_initall(bnr, ZV_to_zv(gel(fa,1)), P, prec);
  return  gerepilecopy(av, bnrclassfield_H(vkum, bnr, P, subgroup, fa, flag, prec));
}
