/* K a bnf. Compute kernel \tilde{Cl}_K(ell); return cyclic factors.
* Set *pM to (vtilde_S[i](US[j]))_{i,j} */
static GEN
CL_tilde(GEN K, GEN US, GEN ell, GEN T, GEN Ftilde, GEN *pM, long prec)
{
GEN D, M, ellk, vdegS;
long i, j, imin, vmin, k, lD, l = lg(T), lU = lg(US);
*pM = cgetg(1, t_MAT);
if (l == 2) return cgetg(1, t_VEC); /* p = P^e: \tilde{Cl}(l) = (1) */
vdegS = get_vdegS(Ftilde, ell, prec);
imin = 1; vmin = l; /* upper bound */
for (i = 1; i < l; i++)
{
long v = z_pval(Ftilde[i], ell);
if (v < vmin) { vmin = v; imin = i; }
}
M = cgetg(lU, t_MAT);
for (j = 1; j < lU; j++)
{
GEN c = cgetg(l, t_COL), a = gel(US,j);
for (i = 1; i < l; i++)
gel(c,i) = vtilde(K, a, gel(T,i), gel(vdegS,i), ell, prec);
gel(M,j) = c;
}
k = padicprec(M, ell); ellk = powiu(ell, k);
*pM = M = gmod(M, ellk);
M = rowsplice(M, imin);
l--;
if (l == 1) return cgetg(1, t_VEC);
M = ZM_hnfmodid(M, ellk);
D = matsnf0(M, 4); lD = lg(D);
if (lD > 1 && Z_pval(gel(D,1), ell) >= k) return NULL;
return D;
}
/* g in Z[X] potentially defines a subfield of Q[X]/f. It is a subfield iff A
* (cf subfield) was a block system; then there
* exists h in Q[X] such that f | g o h. listdelta determines h s.t f | g o h
* in Fp[X] (cf chinese_retrieve_pol). Try to lift it; den is a
* multiplicative bound for denominator of lift. */
static GEN
embedding(GEN g, GEN DATA, primedata *S, GEN den, GEN listdelta)
{
GEN TR, w0_Q, w0, w1_Q, w1, wpow, h0, gp, T, q2, q, maxp, a, p = S->p;
long rt;
pari_sp av;
T = gel(DATA,1); rt = brent_kung_optpow(degpol(T), 2);
maxp= gel(DATA,7);
gp = derivpol(g); av = avma;
w0 = chinese_retrieve_pol(DATA, S, listdelta);
w0_Q = centermod(gmul(w0,den), p);
h0 = FpXQ_inv(FpX_FpXQ_compo(gp,w0, T,p), T,p); /* = 1/g'(w0) mod (T,p) */
wpow = NULL; q = sqri(p);
for(;;)
{/* Given g,w0,h0 in Z[x], s.t. h0.g'(w0) = 1 and g(w0) = 0 mod (T,p), find
* [w1,h1] satisfying the same conditions mod p^2, [w1,h1] = [w0,h0] (mod p)
* (cf. Dixon: J. Austral. Math. Soc., Series A, vol.49, 1990, p.445) */
if (DEBUGLEVEL>1)
fprintferr("lifting embedding mod p^k = %Z^%ld\n",p, Z_pval(q,p));
/* w1 := w0 - h0 g(w0) mod (T,q) */
if (wpow)
a = FpX_FpXQV_compo(g,wpow, T,q);
else
a = FpX_FpXQ_compo(g,w0, T,q); /* first time */
/* now, a = 0 (p) */
a = gmul(gneg(h0), gdivexact(a, p));
w1 = gadd(w0, gmul(p, FpX_rem(a, T,p)));
w1_Q = centermod(gmul(w1, remii(den,q)), q);
if (gequal(w1_Q, w0_Q) || cmpii(q,maxp) > 0)
{
GEN G = gcmp1(den)? g: RgX_rescale(g,den);
if (gcmp0(RgX_RgXQ_compo(G, w1_Q, T))) break;
}
if (cmpii(q, maxp) > 0)
{
if (DEBUGLEVEL) fprintferr("coeff too big for embedding\n");
return NULL;
}
gerepileall(av, 5, &w1,&h0,&w1_Q,&q,&p);
q2 = sqri(q);
wpow = FpXQ_powers(w1, rt, T, q2);
/* h0 := h0 * (2 - h0 g'(w1)) mod (T,q)
* = h0 + h0 * (1 - h0 g'(w1)) */
a = gmul(gneg(h0), FpX_FpXQV_compo(gp, FpXV_red(wpow,q),T,q));
a = ZX_Z_add(FpX_rem(a, T,q), gen_1); /* 1 - h0 g'(w1) = 0 (p) */
a = gmul(h0, gdivexact(a, p));
h0 = gadd(h0, gmul(p, FpX_rem(a, T,p)));
w0 = w1; w0_Q = w1_Q; p = q; q = q2;
}
TR = gel(DATA,5);
if (!gcmp0(TR)) w1_Q = translate_pol(w1_Q, TR);
return gdiv(w1_Q,den);
}
/* v_ell( exponent(D) ) */
static long
ellexpo(GEN D, GEN ell) { return lg(D) == 1? 0: Z_pval(gel(D,1), ell); }
