Line data Source code
1 : /* Copyright (C) 2000 The PARI group.
2 :
3 : This file is part of the PARI/GP package.
4 :
5 : PARI/GP is free software; you can redistribute it and/or modify it under the
6 : terms of the GNU General Public License as published by the Free Software
7 : Foundation; either version 2 of the License, or (at your option) any later
8 : version. It is distributed in the hope that it will be useful, but WITHOUT
9 : ANY WARRANTY WHATSOEVER.
10 :
11 : Check the License for details. You should have received a copy of it, along
12 : with the package; see the file 'COPYING'. If not, write to the Free Software
13 : Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
14 :
15 : /*******************************************************************/
16 : /* */
17 : /* RAY CLASS FIELDS */
18 : /* */
19 : /*******************************************************************/
20 : #include "pari.h"
21 : #include "paripriv.h"
22 :
23 : #define DEBUGLEVEL DEBUGLEVEL_bnr
24 :
25 : static GEN
26 1462952 : bnr_get_El(GEN bnr) { return gel(bnr,3); }
27 : static GEN
28 1843322 : bnr_get_U(GEN bnr) { return gel(bnr,4); }
29 : static GEN
30 12845 : bnr_get_Ui(GEN bnr) { return gmael(bnr,4,3); }
31 :
32 : /* faster than Buchray */
33 : GEN
34 35 : bnfnarrow(GEN bnf)
35 : {
36 : GEN nf, cyc, gen, Cyc, Gen, A, GD, v, w, H, invpi, L, R, u, U0, Uoo, archp, sarch;
37 : long r1, j, l, t, RU;
38 : pari_sp av;
39 :
40 35 : bnf = checkbnf(bnf);
41 35 : nf = bnf_get_nf(bnf);
42 35 : r1 = nf_get_r1(nf); if (!r1) return gcopy( bnf_get_clgp(bnf) );
43 :
44 : /* simplified version of nfsign_units; r1 > 0 so bnf.tu = -1 */
45 35 : av = avma; archp = identity_perm(r1);
46 35 : A = bnf_get_logfu(bnf); RU = lg(A)+1;
47 35 : invpi = invr( mppi(nf_get_prec(nf)) );
48 35 : v = cgetg(RU,t_MAT); gel(v, 1) = const_vecsmall(r1, 1); /* nfsign(-1) */
49 98 : for (j=2; j<RU; j++) gel(v,j) = nfsign_from_logarch(gel(A,j-1), invpi, archp);
50 : /* up to here */
51 :
52 35 : v = Flm_image(v, 2); t = lg(v)-1;
53 35 : if (t == r1) { set_avma(av); return gcopy( bnf_get_clgp(bnf) ); }
54 :
55 28 : v = Flm_suppl(v,2); /* v = (sgn(U)|H) in GL_r1(F_2) */
56 28 : H = zm_to_ZM( vecslice(v, t+1, r1) ); /* supplement H of sgn(U) */
57 28 : w = rowslice(Flm_inv(v,2), t+1, r1); /* H*w*z = proj of z on H // sgn(U) */
58 :
59 28 : sarch = nfarchstar(nf, NULL, archp);
60 28 : cyc = bnf_get_cyc(bnf);
61 28 : gen = bnf_get_gen(bnf); l = lg(gen);
62 28 : L = cgetg(l,t_MAT); GD = gmael(bnf,9,3);
63 63 : for (j=1; j<l; j++)
64 : {
65 35 : GEN z = nfsign_from_logarch(gel(GD,j), invpi, archp);
66 35 : gel(L,j) = zc_to_ZC( Flm_Flc_mul(w, z, 2) );
67 : }
68 : /* [cyc, 0; L, 2] = relation matrix for Cl_f */
69 28 : R = shallowconcat(
70 : vconcat(diagonal_shallow(cyc), L),
71 : vconcat(zeromat(l-1, r1-t), scalarmat_shallow(gen_2,r1-t)));
72 28 : Cyc = ZM_snf_group(R, NULL, &u);
73 28 : U0 = rowslice(u, 1, l-1);
74 28 : Uoo = ZM_mul(H, rowslice(u, l, nbrows(u)));
75 28 : l = lg(Cyc); Gen = cgetg(l,t_VEC);
76 91 : for (j = 1; j < l; j++)
77 : {
78 63 : GEN g = gel(U0,j), s = gel(Uoo,j);
79 63 : g = (lg(g) == 1)? gen_1: Q_primpart( idealfactorback(nf,gen,g,0) );
80 63 : if (!ZV_equal0(s))
81 : {
82 28 : GEN a = set_sign_mod_divisor(nf, ZV_to_Flv(s,2), gen_1, sarch);
83 28 : g = is_pm1(g)? a: idealmul(nf, a, g);
84 : }
85 63 : gel(Gen,j) = g;
86 : }
87 28 : return gc_GEN(av, mkvec3(shifti(bnf_get_no(bnf),r1-t), Cyc, Gen));
88 : }
89 :
90 : /********************************************************************/
91 : /** **/
92 : /** REDUCTION MOD IDELE **/
93 : /** **/
94 : /********************************************************************/
95 :
96 : static GEN
97 26635 : compute_fact(GEN nf, GEN U, GEN gen)
98 : {
99 26635 : long i, j, l = lg(U), h = lgcols(U); /* l > 1 */
100 26635 : GEN basecl = cgetg(l,t_VEC), G;
101 :
102 26635 : G = mkvec2(NULL, trivial_fact());
103 57575 : for (j = 1; j < l; j++)
104 : {
105 30940 : GEN z = NULL;
106 104482 : for (i = 1; i < h; i++)
107 : {
108 73542 : GEN g, e = gcoeff(U,i,j); if (!signe(e)) continue;
109 :
110 33397 : g = gel(gen,i);
111 33397 : if (typ(g) != t_MAT)
112 : {
113 22414 : if (z)
114 2296 : gel(z,2) = famat_mulpow_shallow(gel(z,2), g, e);
115 : else
116 20118 : z = mkvec2(NULL, to_famat_shallow(g, e));
117 22414 : continue;
118 : }
119 10983 : gel(G,1) = g;
120 10983 : g = idealpowred(nf,G,e);
121 10983 : z = z? idealmulred(nf,z,g): g;
122 : }
123 30940 : gel(z,2) = famat_reduce(gel(z,2));
124 30940 : gel(basecl,j) = z;
125 : }
126 26635 : return basecl;
127 : }
128 :
129 : static int
130 15484 : too_big(GEN nf, GEN bet)
131 : {
132 15484 : GEN x = nfnorm(nf,bet);
133 15484 : switch (typ(x))
134 : {
135 9009 : case t_INT: return abscmpii(x, gen_1);
136 6475 : case t_FRAC: return abscmpii(gel(x,1), gel(x,2));
137 : }
138 0 : pari_err_BUG("wrong type in too_big");
139 : return 0; /* LCOV_EXCL_LINE */
140 : }
141 :
142 : /* true nf; GTM 193: Algo 4.3.4. Reduce x mod divisor */
143 : static GEN
144 15036 : idealmoddivisor_aux(GEN nf, GEN x, GEN f, GEN sarch)
145 : {
146 15036 : pari_sp av = avma;
147 : GEN a, A;
148 :
149 15036 : if ( is_pm1(gcoeff(f,1,1)) ) /* f = 1 */
150 : {
151 476 : A = idealred(nf, mkvec2(x, gen_1));
152 476 : A = nfinv(nf, gel(A,2));
153 : }
154 : else
155 : {/* given coprime integral ideals x and f (f HNF), compute "small"
156 : * G in x, such that G = 1 mod (f). GTM 193: Algo 4.3.3 */
157 14560 : GEN G = idealaddtoone_raw(nf, x, f);
158 14560 : GEN D = idealaddtoone_i(nf, idealdiv(nf,G,x), f);
159 14560 : A = nfdiv(nf,D,G);
160 : }
161 15036 : if (too_big(nf,A) > 0) return gc_const(av, x);
162 13517 : a = set_sign_mod_divisor(nf, NULL, A, sarch);
163 13517 : if (a != A && too_big(nf,A) > 0) return gc_const(av, x);
164 13517 : return idealmul(nf, a, x);
165 : }
166 :
167 : GEN
168 4214 : idealmoddivisor(GEN bnr, GEN x)
169 : {
170 4214 : GEN nf = bnr_get_nf(bnr), bid = bnr_get_bid(bnr);
171 4214 : return idealmoddivisor_aux(nf, x, bid_get_ideal(bid), bid_get_sarch(bid));
172 : }
173 :
174 : /* v_pr(L0 * cx) */
175 : static long
176 17983 : fast_val(GEN L0, GEN cx, GEN pr)
177 : {
178 17983 : pari_sp av = avma;
179 17983 : long v = typ(L0) == t_INT? 0: ZC_nfval(L0,pr);
180 17983 : if (cx)
181 : {
182 9436 : long w = Q_pval(cx, pr_get_p(pr));
183 9436 : if (w) v += w * pr_get_e(pr);
184 : }
185 17983 : return gc_long(av,v);
186 : }
187 :
188 : /* x coprime to fZ, return y = x mod fZ, y integral */
189 : static GEN
190 4368 : make_integral_Z(GEN x, GEN fZ)
191 : {
192 4368 : GEN d, y = Q_remove_denom(x, &d);
193 4368 : if (d) y = FpC_Fp_mul(y, Fp_inv(d, fZ), fZ);
194 4368 : return y;
195 : }
196 :
197 : /* p pi^(-1) mod f */
198 : static GEN
199 9863 : get_pinvpi(GEN nf, GEN fZ, GEN p, GEN pi, GEN *v)
200 : {
201 9863 : if (!*v) {
202 4368 : GEN invpi = nfinv(nf, pi);
203 4368 : *v = make_integral_Z(RgC_Rg_mul(invpi, p), mulii(p, fZ));
204 : }
205 9863 : return *v;
206 : }
207 : /* uniformizer pi for pr, coprime to F/p */
208 : static GEN
209 10003 : get_pi(GEN F, GEN pr, GEN *v)
210 : {
211 10003 : if (!*v) *v = pr_uniformizer(pr, F);
212 10003 : return *v;
213 : }
214 :
215 : /* true nf */
216 : static GEN
217 33404 : bnr_grp(GEN nf, GEN U, GEN gen, GEN cyc, GEN bid)
218 : {
219 33404 : GEN h = ZV_prod(cyc);
220 : GEN f, fZ, basecl, fa, pr, t, EX, sarch, F, P, vecpi, vecpinvpi;
221 : long i,j,l,lp;
222 :
223 33404 : if (lg(U) == 1) return mkvec3(h, cyc, cgetg(1, t_VEC));
224 26635 : basecl = compute_fact(nf, U, gen); /* generators in factored form */
225 26635 : EX = gel(bid_get_cyc(bid),1); /* exponent of (O/f)^* */
226 26635 : f = bid_get_ideal(bid); fZ = gcoeff(f,1,1);
227 26635 : fa = bid_get_fact(bid);
228 26635 : sarch = bid_get_sarch(bid);
229 26635 : P = gel(fa,1); F = prV_lcm_capZ(P);
230 :
231 26635 : lp = lg(P);
232 26635 : vecpinvpi = cgetg(lp, t_VEC);
233 26635 : vecpi = cgetg(lp, t_VEC);
234 66241 : for (i=1; i<lp; i++)
235 : {
236 39606 : pr = gel(P,i);
237 39606 : gel(vecpi,i) = NULL; /* to be computed if needed */
238 39606 : gel(vecpinvpi,i) = NULL; /* to be computed if needed */
239 : }
240 :
241 26635 : l = lg(basecl);
242 57575 : for (i=1; i<l; i++)
243 : {
244 : GEN p, pi, pinvpi, dmulI, mulI, G, I, A, e, L, newL;
245 : long la, v, k;
246 : pari_sp av;
247 : /* G = [I, A=famat(L,e)] is a generator, I integral */
248 30940 : G = gel(basecl,i);
249 30940 : I = gel(G,1);
250 30940 : A = gel(G,2); L = gel(A,1); e = gel(A,2);
251 : /* if no reduction took place in compute_fact, everybody is still coprime
252 : * to f + no denominators */
253 30940 : if (!I) { gel(basecl,i) = famat_to_nf_moddivisor(nf, L, e, bid); continue; }
254 10822 : if (lg(A) == 1) { gel(basecl,i) = I; continue; }
255 :
256 : /* compute mulI so that mulI * I coprime to f
257 : * FIXME: use idealcoprime ??? (Less efficient. Fix idealcoprime!) */
258 10822 : dmulI = mulI = NULL;
259 26005 : for (j=1; j<lp; j++)
260 : {
261 15183 : pr = gel(P,j);
262 15183 : v = idealval(nf, I, pr);
263 15183 : if (!v) continue;
264 3801 : p = pr_get_p(pr);
265 3801 : pi = get_pi(F, pr, &gel(vecpi,j));
266 3801 : pinvpi = get_pinvpi(nf, fZ, p, pi, &gel(vecpinvpi,j));
267 3801 : t = nfpow_u(nf, pinvpi, (ulong)v);
268 3801 : mulI = mulI? nfmuli(nf, mulI, t): t;
269 3801 : t = powiu(p, v);
270 3801 : dmulI = dmulI? mulii(dmulI, t): t;
271 : }
272 :
273 : /* make all components of L coprime to f.
274 : * Assuming (L^e * I, f) = 1, then newL^e * mulI = L^e */
275 10822 : la = lg(e); newL = cgetg(la, t_VEC);
276 21742 : for (k=1; k<la; k++)
277 : {
278 10920 : GEN cx, LL = nf_to_scalar_or_basis(nf, gel(L,k));
279 10920 : GEN L0 = Q_primitive_part(LL, &cx); /* LL = L0*cx (faster nfval) */
280 28903 : for (j=1; j<lp; j++)
281 : {
282 17983 : pr = gel(P,j);
283 17983 : v = fast_val(L0,cx, pr); /* = val_pr(LL) */
284 17983 : if (!v) continue;
285 6202 : p = pr_get_p(pr);
286 6202 : pi = get_pi(F, pr, &gel(vecpi,j));
287 6202 : if (v > 0)
288 : {
289 6062 : pinvpi = get_pinvpi(nf, fZ, p, pi, &gel(vecpinvpi,j));
290 6062 : t = nfpow_u(nf,pinvpi, (ulong)v);
291 6062 : LL = nfmul(nf, LL, t);
292 6062 : LL = gdiv(LL, powiu(p, v));
293 : }
294 : else
295 : {
296 140 : t = nfpow_u(nf,pi,(ulong)(-v));
297 140 : LL = nfmul(nf, LL, t);
298 : }
299 : }
300 10920 : LL = make_integral(nf,LL,f,P);
301 10920 : gel(newL,k) = typ(LL) == t_INT? LL: FpC_red(LL, fZ);
302 : }
303 :
304 10822 : av = avma;
305 : /* G in nf, = L^e mod f */
306 10822 : G = famat_to_nf_modideal_coprime(nf, newL, e, f, EX);
307 10822 : if (mulI)
308 : {
309 3787 : G = nfmuli(nf, G, mulI);
310 3787 : G = typ(G) == t_COL? ZC_hnfrem(G, ZM_Z_mul(f, dmulI))
311 3787 : : modii(G, mulii(fZ,dmulI));
312 3787 : G = RgC_Rg_div(G, dmulI);
313 : }
314 10822 : G = set_sign_mod_divisor(nf,A,G,sarch);
315 10822 : I = idealmul(nf,I,G);
316 : /* more or less useless, but cheap at this point */
317 10822 : I = idealmoddivisor_aux(nf,I,f,sarch);
318 10822 : gel(basecl,i) = gc_GEN(av, I);
319 : }
320 26635 : return mkvec3(h, cyc, basecl);
321 : }
322 :
323 : /********************************************************************/
324 : /** **/
325 : /** INIT RAY CLASS GROUP **/
326 : /** **/
327 : /********************************************************************/
328 : GEN
329 313191 : bnr_subgroup_check(GEN bnr, GEN H, GEN *pdeg)
330 : {
331 313191 : GEN no = bnr_get_no(bnr);
332 313191 : if (H && isintzero(H)) H = NULL;
333 313186 : if (H)
334 : {
335 154517 : GEN h, cyc = bnr_get_cyc(bnr);
336 154517 : switch(typ(H))
337 : {
338 2555 : case t_INT:
339 2555 : H = scalarmat_shallow(H, lg(cyc)-1);
340 : /* fall through */
341 75473 : case t_MAT:
342 75473 : RgM_check_ZM(H, "bnr_subgroup_check");
343 75473 : H = ZM_hnfmodid(H, cyc);
344 75474 : break;
345 79044 : case t_VEC:
346 79044 : if (char_check(cyc, H)) { H = charker(cyc, H); break; }
347 0 : default: pari_err_TYPE("bnr_subgroup_check", H);
348 : }
349 154518 : h = ZM_det_triangular(H);
350 154513 : if (equalii(h, no)) H = NULL; else no = h;
351 : }
352 313186 : if (pdeg) *pdeg = no;
353 313186 : return H;
354 : }
355 :
356 : void
357 4249 : bnr_subgroup_sanitize(GEN *pbnr, GEN *pH)
358 : {
359 4249 : GEN D, cnd, mod, cyc, bnr = *pbnr, H = *pH;
360 :
361 4249 : if (nftyp(bnr)==typ_BNF) bnr = Buchray(bnr, gen_1, nf_INIT);
362 4151 : else checkbnr(bnr);
363 4235 : cyc = bnr_get_cyc(bnr);
364 4235 : if (!H) mod = cyc_get_expo(cyc);
365 3829 : else switch(typ(H))
366 : {
367 2772 : case t_INT: mod = H; break;
368 7 : case t_VEC:
369 7 : if (!char_check(cyc, H))
370 0 : pari_err_TYPE("bnr_subgroup_sanitize [character]", H);
371 7 : H = charker(cyc, H); /* character -> subgroup */
372 1050 : case t_MAT:
373 1050 : H = hnfmodid(H, cyc); /* make sure H is a left divisor of Mat(cyc) */
374 1036 : D = ZM_snf(H); /* structure of Cl_f / H */
375 1036 : mod = lg(D) == 1? gen_1: gel(D,1);
376 1036 : break;
377 7 : default: pari_err_TYPE("bnr_subroup_sanitize [subgroup]", H);
378 0 : mod = NULL;
379 : }
380 4214 : cnd = bnrconductormod(bnr, H, mod);
381 4214 : *pbnr = gel(cnd,2); *pH = gel(cnd,3);
382 4214 : }
383 : void
384 1386 : bnr_char_sanitize(GEN *pbnr, GEN *pchi)
385 : {
386 1386 : GEN cnd, cyc, bnr = *pbnr, chi = *pchi;
387 :
388 1386 : if (nftyp(bnr)==typ_BNF) bnr = Buchray(bnr, gen_1, nf_INIT);
389 1386 : else checkbnr(bnr);
390 1386 : cyc = bnr_get_cyc(bnr);
391 1386 : if (typ(chi) != t_VEC || !char_check(cyc, chi))
392 0 : pari_err_TYPE("bnr_char_sanitize [character]", chi);
393 1386 : cnd = bnrconductormod(bnr, chi, charorder(cyc, chi));
394 1386 : *pbnr = gel(cnd,2); *pchi = gel(cnd,3);
395 1386 : }
396 :
397 :
398 : /* c a rational content (NULL or t_INT or t_FRAC), return u*c as a ZM/d */
399 : static GEN
400 227070 : ZM_content_mul(GEN u, GEN c, GEN *pd)
401 : {
402 227070 : *pd = gen_1;
403 227070 : if (c)
404 : {
405 151948 : if (typ(c) == t_FRAC) { *pd = gel(c,2); c = gel(c,1); }
406 151948 : if (!is_pm1(c)) u = ZM_Z_mul(u, c);
407 : }
408 227071 : return u;
409 : }
410 :
411 : /* bnr natural generators: bnf gens made coprime to modulus + bid gens.
412 : * Beware: if bnr includes MOD, we may have #El < #bnf.ge*/
413 : static GEN
414 49700 : get_Gen(GEN bnf, GEN bid, GEN El)
415 : {
416 49700 : GEN nf = bnf_get_nf(bnf), gen = bnf_get_gen(bnf), Gen;
417 49700 : long i, l = lg(El);
418 49700 : if (lg(gen) > l) gen = vec_shorten(gen, l-1);
419 49700 : Gen = shallowconcat(gen, bid_get_gen(bid));
420 68733 : for (i = 1; i < l; i++)
421 : {
422 19033 : GEN e = gel(El,i);
423 19033 : if (!isint1(e)) gel(Gen,i) = idealmul(nf, gel(El,i), gel(Gen,i));
424 : }
425 49700 : return Gen;
426 : }
427 :
428 : static GEN
429 257000 : Buchraymod_i(GEN bnf, GEN module, long flag, GEN MOD)
430 : {
431 : GEN nf, cyc0, cyc, gen, Cyc, clg, h, logU, U, Ui, vu;
432 : GEN bid, cycbid, H, El;
433 : long RU, Ri, j, ngen;
434 257000 : const long add_gen = flag & nf_GEN;
435 257000 : const long do_init = flag & nf_INIT;
436 :
437 257000 : if (MOD && typ(MOD) != t_INT)
438 0 : pari_err_TYPE("bnrinit [incorrect cycmod]", MOD);
439 257000 : bnf = checkbnf(bnf);
440 256994 : nf = bnf_get_nf(bnf);
441 256992 : RU = lg(nf_get_roots(nf))-1; /* #K.futu */
442 256991 : El = NULL; /* gcc -Wall */
443 256991 : cyc = cyc0 = bnf_get_cyc(bnf);
444 256992 : gen = bnf_get_gen(bnf); ngen = lg(cyc)-1;
445 :
446 256991 : bid = checkbid_i(module);
447 256989 : if (!bid) bid = Idealstarmod(nf,module,nf_GEN|nf_INIT, MOD);
448 257011 : cycbid = bid_get_cyc(bid);
449 257009 : if (MOD) cyc = ZV_snfclean(ZV_snf_gcd(cyc, MOD));
450 257000 : Ri = lg(cycbid)-1;
451 257000 : if (Ri || add_gen || do_init)
452 : {
453 256997 : GEN fx = bid_get_fact(bid);
454 256998 : long n = Ri? ngen: lg(cyc)-1;
455 256998 : El = cgetg(n+1, t_VEC);
456 294106 : for (j = 1; j <= n; j++)
457 : {
458 37107 : GEN c = idealcoprimefact(nf, gel(gen,j), fx);
459 37106 : gel(El,j) = nf_to_scalar_or_basis(nf,c);
460 : }
461 : }
462 257002 : if (!Ri)
463 : {
464 29924 : GEN no, Gen = add_gen? get_Gen(bnf, bid, El): NULL;
465 29924 : if (MOD) { ngen = lg(cyc)-1; no = ZV_prod(cyc); } else no = bnf_get_no(bnf);
466 29924 : clg = add_gen? mkvec3(no, cyc, Gen): mkvec2(no, cyc);
467 29924 : if (!do_init) return clg;
468 29924 : U = matid(ngen);
469 29924 : U = mkvec3(U, cgetg(1,t_MAT), U);
470 29925 : vu = mkvec3(cgetg(1,t_MAT), matid(RU), gen_1);
471 29925 : return mkvecn(6, bnf, bid, El, U, clg, vu);
472 : }
473 :
474 227078 : logU = ideallog_units0(bnf, bid, MOD);
475 227053 : if (do_init)
476 : { /* (log(Units)|D) * u = (0 | H) */
477 227053 : GEN c1,c2, u,u1,u2, Hi, D = shallowconcat(logU, diagonal_shallow(cycbid));
478 227077 : H = ZM_hnfall_i(D, &u, 1);
479 227065 : u1 = matslice(u, 1,RU, 1,RU);
480 227081 : u2 = matslice(u, 1,RU, RU+1,lg(u)-1);
481 : /* log(Units) (u1|u2) = (0|H) (mod D), H HNF */
482 :
483 227083 : u1 = ZM_lll(u1, 0.99, LLL_INPLACE);
484 227074 : Hi = Q_primitive_part(RgM_inv_upper(H), &c1);
485 227065 : u2 = ZM_mul(ZM_reducemodmatrix(u2,u1), Hi);
486 227059 : u2 = Q_primitive_part(u2, &c2);
487 227063 : u2 = ZM_content_mul(u2, mul_content(c1,c2), &c2);
488 227071 : vu = mkvec3(u2,u1,c2); /* u2/c2 = H^(-1) (mod Im u1) */
489 : }
490 : else
491 : {
492 0 : H = ZM_hnfmodid(logU, cycbid);
493 0 : vu = NULL; /* -Wall */
494 : }
495 227073 : if (!ngen)
496 201257 : h = H;
497 : else
498 : {
499 25816 : GEN L = cgetg(ngen+1, t_MAT), cycgen = bnf_build_cycgen(bnf);
500 52416 : for (j=1; j<=ngen; j++)
501 : {
502 26600 : GEN c = gel(cycgen,j), e = gel(El,j);
503 26600 : if (!equali1(e)) c = famat_mulpow_shallow(c, e, gel(cyc0,j));
504 26600 : gel(L,j) = ideallogmod(nf, c, bid, MOD); /* = log(Gen[j]^cyc[j]) */
505 : }
506 : /* [cyc0, 0; -L, H] = relation matrix for generators Gen of Cl_f */
507 25816 : h = shallowconcat(vconcat(diagonal_shallow(cyc0), ZM_neg(L)),
508 : vconcat(zeromat(ngen, Ri), H));
509 25816 : h = MOD? ZM_hnfmodid(h, MOD): ZM_hnf(h);
510 : }
511 227073 : Cyc = ZM_snf_group(h, &U, &Ui);
512 : /* Gen = clg.gen*U, clg.gen = Gen*Ui */
513 33404 : clg = add_gen? bnr_grp(nf, Ui, get_Gen(bnf, bid, El), Cyc, bid)
514 227067 : : mkvec2(ZV_prod(Cyc), Cyc);
515 227076 : if (!do_init) return clg;
516 227076 : U = mkvec3(vecslice(U, 1,ngen), vecslice(U,ngen+1,lg(U)-1), Ui);
517 227076 : return mkvecn(6, bnf, bid, El, U, clg, vu);
518 : }
519 : GEN
520 41391 : Buchray(GEN bnf, GEN f, long flag)
521 41391 : { return Buchraymod(bnf, f, flag, NULL); }
522 : GEN
523 253573 : Buchraymod(GEN bnf, GEN f, long flag, GEN MOD)
524 : {
525 253573 : pari_sp av = avma;
526 253573 : return gc_GEN(av, Buchraymod_i(bnf, f, flag, MOD));
527 : }
528 : GEN
529 211377 : bnrinitmod(GEN bnf, GEN f, long flag, GEN MOD)
530 : {
531 211377 : switch(flag)
532 : {
533 211328 : case 0: flag = nf_INIT; break;
534 49 : case 1: flag = nf_INIT | nf_GEN; break;
535 0 : default: pari_err_FLAG("bnrinit");
536 : }
537 211377 : return Buchraymod(bnf, f, flag, MOD);
538 : }
539 : GEN
540 0 : bnrinit0(GEN bnf, GEN ideal, long flag)
541 0 : { return bnrinitmod(bnf, ideal, flag, NULL); }
542 :
543 : GEN
544 112 : bnrclassno(GEN bnf,GEN ideal)
545 : {
546 : GEN h, D, bid, cycbid;
547 112 : pari_sp av = avma;
548 :
549 112 : bnf = checkbnf(bnf);
550 112 : h = bnf_get_no(bnf);
551 112 : bid = checkbid_i(ideal);
552 112 : if (!bid) bid = Idealstar(bnf_get_nf(bnf), ideal, nf_INIT);
553 105 : cycbid = bid_get_cyc(bid);
554 105 : if (lg(cycbid) == 1) { set_avma(av); return icopy(h); }
555 84 : D = ideallog_units(bnf, bid); /* (Z_K/f)^* / units ~ Z^n / D */
556 84 : D = ZM_hnfmodid(D,cycbid);
557 84 : return gc_INT(av, mulii(h, ZM_det_triangular(D)));
558 : }
559 : GEN
560 105 : bnrclassno0(GEN A, GEN B, GEN C)
561 : {
562 105 : pari_sp av = avma;
563 105 : GEN h, H = NULL;
564 : /* adapted from ABC_to_bnr, avoid costly bnrinit if possible */
565 105 : if (typ(A) == t_VEC)
566 105 : switch(lg(A))
567 : {
568 14 : case 7: /* bnr */
569 14 : checkbnr(A); H = B;
570 14 : break;
571 91 : case 11: /* bnf */
572 91 : if (!B) pari_err_TYPE("bnrclassno [bnf+missing conductor]",A);
573 91 : if (!C) return bnrclassno(A, B);
574 7 : A = Buchray(A, B, nf_INIT); H = C;
575 7 : break;
576 0 : default: checkbnf(A);/*error*/
577 : }
578 0 : else checkbnf(A);/*error*/
579 :
580 21 : H = bnr_subgroup_check(A, H, &h);
581 21 : if (!H) { set_avma(av); return icopy(h); }
582 14 : return gc_INT(av, h);
583 : }
584 :
585 : /* ZMV_ZCV_mul for two matrices U = [Ux,Uy], it may have more components
586 : * (ignored) and vectors x,y */
587 : static GEN
588 1340362 : ZM2_ZC2_mul(GEN U, GEN x, GEN y)
589 : {
590 1340362 : GEN Ux = gel(U,1), Uy = gel(U,2);
591 1340362 : if (lg(Ux) == 1) return ZM_ZC_mul(Uy,y);
592 163174 : if (lg(Uy) == 1) return ZM_ZC_mul(Ux,x);
593 163174 : return ZC_add(ZM_ZC_mul(Ux,x), ZM_ZC_mul(Uy,y));
594 : }
595 :
596 : GEN
597 1458094 : bnrisprincipalmod(GEN bnr, GEN x, GEN MOD, long flag)
598 : {
599 1458094 : pari_sp av = avma;
600 : GEN E, G, clgp, bnf, nf, bid, ex, cycray, alpha, El;
601 : int trivialbid;
602 :
603 1458094 : checkbnr(bnr);
604 1458094 : El = bnr_get_El(bnr);
605 1458094 : cycray = bnr_get_cyc(bnr);
606 1458094 : if (MOD && flag) pari_err_FLAG("bnrisprincipalmod [MOD!=NULL and flag!=0]");
607 1458094 : if (lg(cycray) == 1 && !(flag & nf_GEN)) return cgetg(1,t_COL);
608 1457933 : if (MOD) cycray = ZV_snf_gcd(cycray, MOD);
609 :
610 1457933 : bnf = bnr_get_bnf(bnr); nf = bnf_get_nf(bnf);
611 1457933 : bid = bnr_get_bid(bnr);
612 1457933 : trivialbid = lg(bid_get_cyc(bid)) == 1;
613 1457933 : if (trivialbid)
614 : {
615 117571 : ex = isprincipal(bnf, x);
616 117571 : setlg(ex, lg(cycray)); /* can happen with MOD */
617 : }
618 : else
619 : {
620 1340362 : GEN v = bnfisprincipal0(bnf, x, nf_FORCE|nf_GENMAT);
621 1340362 : GEN e = gel(v,1), b = gel(v,2);
622 1340362 : long i, j = lg(e);
623 1508264 : for (i = 1; i < j; i++) /* modify b as if bnf.gen were El*bnf.gen */
624 167902 : if (typ(gel(El,i)) != t_INT && signe(gel(e,i))) /* <==> != 1 */
625 31308 : b = famat_mulpow_shallow(b, gel(El,i), negi(gel(e,i)));
626 1340362 : if (!MOD && !(flag & nf_GEN)) MOD = gel(cycray,1);
627 1340362 : ex = ZM2_ZC2_mul(bnr_get_U(bnr), e, ideallogmod(nf, b, bid, MOD));
628 : }
629 1457931 : ex = ZV_ZV_mod(ex, cycray);
630 1457934 : if (!(flag & (nf_GEN|nf_GENMAT))) return gc_upto(av, ex);
631 :
632 : /* compute generator */
633 7049 : E = ZC_neg(ex);
634 7049 : clgp = bnr_get_clgp(bnr);
635 7049 : if (lg(clgp) == 4)
636 21 : G = abgrp_get_gen(clgp);
637 : else
638 : {
639 7028 : G = get_Gen(bnf, bid, El);
640 7028 : E = ZM_ZC_mul(bnr_get_Ui(bnr), E);
641 : }
642 7049 : alpha = isprincipalfact(bnf, x, G, E, nf_GENMAT|nf_GEN_IF_PRINCIPAL|nf_FORCE);
643 7049 : if (alpha == gen_0) pari_err_BUG("isprincipalray");
644 7049 : if (!trivialbid)
645 : {
646 7049 : GEN v = gel(bnr,6), u2 = gel(v,1), u1 = gel(v,2), du2 = gel(v,3);
647 7049 : GEN y = ZM_ZC_mul(u2, ideallog(nf, alpha, bid));
648 7049 : if (!is_pm1(du2)) y = ZC_Z_divexact(y,du2);
649 7049 : y = ZC_reducemodmatrix(y, u1);
650 7049 : if (!ZV_equal0(y))
651 : {
652 4991 : GEN U = shallowcopy(bnf_build_units(bnf));
653 4991 : settyp(U, t_COL);
654 4991 : alpha = famat_div_shallow(alpha, mkmat2(U,y));
655 : }
656 : }
657 7049 : alpha = famat_reduce(alpha);
658 7049 : if (!(flag & nf_GENMAT)) alpha = nffactorback(nf, alpha, NULL);
659 7049 : return gc_GEN(av, mkvec2(ex,alpha));
660 : }
661 :
662 : GEN
663 413319 : bnrisprincipal(GEN bnr, GEN x, long flag)
664 413319 : { return bnrisprincipalmod(bnr, x, NULL, flag); }
665 :
666 : GEN
667 406235 : isprincipalray(GEN bnr, GEN x) { return bnrisprincipal(bnr,x,0); }
668 : GEN
669 0 : isprincipalraygen(GEN bnr, GEN x) { return bnrisprincipal(bnr,x,nf_GEN); }
670 :
671 : /* N! / N^N * (4/pi)^r2 * sqrt(|D|) */
672 : GEN
673 0 : minkowski_bound(GEN D, long N, long r2, long prec)
674 : {
675 0 : pari_sp av = avma;
676 0 : GEN c = divri(mpfactr(N,prec), powuu(N,N));
677 0 : if (r2) c = mulrr(c, powru(divur(4,mppi(prec)), r2));
678 0 : c = mulrr(c, gsqrt(absi_shallow(D),prec));
679 0 : return gc_uptoleaf(av, c);
680 : }
681 :
682 : /* N = [K:Q] > 1, D = disc(K) */
683 : static GEN
684 63 : zimmertbound(GEN D, long N, long R2)
685 : {
686 63 : pari_sp av = avma;
687 : GEN w;
688 :
689 63 : if (N > 20) w = minkowski_bound(D, N, R2, DEFAULTPREC);
690 : else
691 : {
692 63 : const double c[19][11] = {
693 : {/*2*/ 0.6931, 0.45158},
694 : {/*3*/ 1.71733859, 1.37420604},
695 : {/*4*/ 2.91799837, 2.50091538, 2.11943331},
696 : {/*5*/ 4.22701425, 3.75471588, 3.31196660},
697 : {/*6*/ 5.61209925, 5.09730381, 4.60693851, 4.14303665},
698 : {/*7*/ 7.05406203, 6.50550021, 5.97735406, 5.47145968},
699 : {/*8*/ 8.54052636, 7.96438858, 7.40555445, 6.86558259, 6.34608077},
700 : {/*9*/ 10.0630022, 9.46382812, 8.87952524, 8.31139202, 7.76081149},
701 : {/*10*/11.6153797, 10.9966020, 10.3907654, 9.79895170, 9.22232770, 8.66213267},
702 : {/*11*/13.1930961, 12.5573772, 11.9330458, 11.3210061, 10.7222412, 10.1378082},
703 : {/*12*/14.7926394, 14.1420915, 13.5016616, 12.8721114, 12.2542699, 11.6490374,
704 : 11.0573775},
705 : {/*13*/16.4112395, 15.7475710, 15.0929680, 14.4480777, 13.8136054, 13.1903162,
706 : 12.5790381},
707 : {/*14*/18.0466672, 17.3712806, 16.7040780, 16.0456127, 15.3964878, 14.7573587,
708 : 14.1289364, 13.5119848},
709 : {/*15*/19.6970961, 19.0111606, 18.3326615, 17.6620757, 16.9999233, 16.3467686,
710 : 15.7032228, 15.0699480},
711 : {/*16*/21.3610081, 20.6655103, 19.9768082, 19.2953176, 18.6214885, 17.9558093,
712 : 17.2988108, 16.6510652, 16.0131906},
713 :
714 : {/*17*/23.0371259, 22.3329066, 21.6349299, 20.9435607, 20.2591899, 19.5822454,
715 : 18.9131878, 18.2525157, 17.6007672},
716 :
717 : {/*18*/24.7243611, 24.0121449, 23.3056902, 22.6053167, 21.9113705, 21.2242247,
718 : 20.5442836, 19.8719830, 19.2077941, 18.5522234},
719 :
720 : {/*19*/26.4217792, 25.7021950, 24.9879497, 24.2793271, 23.5766321, 22.8801952,
721 : 22.1903709, 21.5075437, 20.8321263, 20.1645647},
722 : {/*20*/28.1285704, 27.4021674, 26.6807314, 25.9645140, 25.2537867, 24.5488420,
723 : 23.8499943, 23.1575823, 22.4719720, 21.7935548, 21.1227537}
724 : };
725 63 : w = mulrr(dbltor(exp(-c[N-2][R2])), gsqrt(absi_shallow(D),DEFAULTPREC));
726 : }
727 63 : return gc_INT(av, ceil_safe(w));
728 : }
729 :
730 : /* return \gamma_n^n if known, an upper bound otherwise */
731 : GEN
732 63 : Hermite_bound(long n, long prec)
733 : {
734 : GEN h,h1;
735 : pari_sp av;
736 :
737 63 : switch(n)
738 : {
739 35 : case 1: return gen_1;
740 14 : case 2: retmkfrac(utoipos(4), utoipos(3));
741 7 : case 3: return gen_2;
742 7 : case 4: return utoipos(4);
743 0 : case 5: return utoipos(8);
744 0 : case 6: retmkfrac(utoipos(64), utoipos(3));
745 0 : case 7: return utoipos(64);
746 0 : case 8: return utoipos(256);
747 0 : case 24: return int2n(48);
748 : }
749 0 : av = avma;
750 0 : h = powru(divur(2,mppi(prec)), n);
751 0 : h1 = sqrr(ggamma(uutoQ(n+4,2),prec));
752 0 : return gc_uptoleaf(av, mulrr(h,h1));
753 : }
754 :
755 : /* 1 if L (= nf != Q) primitive for sure, 0 if MAYBE imprimitive (may have a
756 : * subfield K) */
757 : static long
758 35 : isprimitive(GEN nf)
759 : {
760 35 : long p, i, l, ep, N = nf_get_degree(nf);
761 : GEN D, fa;
762 :
763 35 : p = ucoeff(factoru(N), 1,1); /* smallest prime | N */
764 35 : if (p == N) return 1; /* prime degree */
765 :
766 : /* N = [L:Q] = product of primes >= p, same is true for [L:K]
767 : * d_L = t d_K^[L:K] --> check that some q^p divides d_L */
768 0 : D = nf_get_disc(nf);
769 0 : fa = gel(absZ_factor_limit(D,0),2); /* list of v_q(d_L). Don't check large primes */
770 0 : if (mod2(D)) i = 1;
771 : else
772 : { /* q = 2 */
773 0 : ep = itos(gel(fa,1));
774 0 : if ((ep>>1) >= p) return 0; /* 2 | d_K ==> 4 | d_K */
775 0 : i = 2;
776 : }
777 0 : l = lg(fa);
778 0 : for ( ; i < l; i++)
779 : {
780 0 : ep = itos(gel(fa,i));
781 0 : if (ep >= p) return 0;
782 : }
783 0 : return 1;
784 : }
785 :
786 : static GEN
787 0 : dft_bound(void)
788 : {
789 0 : if (DEBUGLEVEL>1) err_printf("Default bound for regulator: 0.2\n");
790 0 : return dbltor(0.2);
791 : }
792 :
793 : static GEN
794 35 : regulatorbound(GEN bnf)
795 : {
796 : long N, R1, R2, R;
797 : GEN nf, dK, p1, c1;
798 :
799 35 : nf = bnf_get_nf(bnf); N = nf_get_degree(nf);
800 35 : if (!isprimitive(nf)) return dft_bound();
801 :
802 35 : dK = absi_shallow(nf_get_disc(nf));
803 35 : nf_get_sign(nf, &R1, &R2); R = R1+R2-1;
804 35 : c1 = (!R2 && N<12)? int2n(N & (~1UL)): powuu(N,N);
805 35 : if (cmpii(dK,c1) <= 0) return dft_bound();
806 :
807 35 : p1 = sqrr(glog(gdiv(dK,c1),DEFAULTPREC));
808 35 : p1 = divru(gmul2n(powru(divru(mulru(p1,3),N*(N*N-1)-6*R2),R),R2), N);
809 35 : p1 = sqrtr(gdiv(p1, Hermite_bound(R, DEFAULTPREC)));
810 35 : if (DEBUGLEVEL>1) err_printf("Mahler bound for regulator: %Ps\n",p1);
811 35 : return gmax_shallow(p1, dbltor(0.2));
812 : }
813 :
814 : static int
815 70553 : is_unit(GEN M, long r1, GEN x)
816 : {
817 70553 : pari_sp av = avma;
818 70553 : GEN Nx = ground( embed_norm(RgM_zc_mul(M,x), r1) );
819 70553 : return gc_bool(av, is_pm1(Nx));
820 : }
821 :
822 : /* True nf. FIXME: should use smallvectors */
823 : static double
824 42 : minimforunits(GEN nf, long BORNE, ulong w)
825 : {
826 42 : const long prec = MEDDEFAULTPREC;
827 42 : long n, r1, i, j, k, *x, cnt = 0;
828 42 : pari_sp av = avma;
829 : GEN r, M;
830 : double p, norme, normin;
831 : double **q,*v,*y,*z;
832 42 : double eps=0.000001, BOUND = BORNE * 1.00001;
833 :
834 42 : if (DEBUGLEVEL>=2)
835 : {
836 0 : err_printf("Searching minimum of T2-form on units:\n");
837 0 : if (DEBUGLEVEL>2) err_printf(" BOUND = %ld\n",BORNE);
838 : }
839 42 : n = nf_get_degree(nf); r1 = nf_get_r1(nf);
840 42 : minim_alloc(n+1, &q, &x, &y, &z, &v);
841 42 : M = gprec_w(nf_get_M(nf), prec);
842 42 : r = gaussred_from_QR(nf_get_G(nf), prec);
843 231 : for (j=1; j<=n; j++)
844 : {
845 189 : v[j] = gtodouble(gcoeff(r,j,j));
846 651 : for (i=1; i<j; i++) q[i][j] = gtodouble(gcoeff(r,i,j));
847 : }
848 42 : normin = (double)BORNE*(1-eps);
849 42 : k=n; y[n]=z[n]=0;
850 42 : x[n] = (long)(sqrt(BOUND/v[n]));
851 :
852 70553 : for(;;x[1]--)
853 : {
854 : do
855 : {
856 71901 : if (k>1)
857 : {
858 1348 : long l = k-1;
859 1348 : z[l] = 0;
860 5033 : for (j=k; j<=n; j++) z[l] += q[l][j]*x[j];
861 1348 : p = (double)x[k] + z[k];
862 1348 : y[l] = y[k] + p*p*v[k];
863 1348 : x[l] = (long)floor(sqrt((BOUND-y[l])/v[l])-z[l]);
864 1348 : k = l;
865 : }
866 : for(;;)
867 : {
868 73102 : p = (double)x[k] + z[k];
869 73102 : if (y[k] + p*p*v[k] <= BOUND) break;
870 1201 : k++; x[k]--;
871 : }
872 : }
873 71901 : while (k>1);
874 70595 : if (!x[1] && y[1]<=eps) break;
875 :
876 70567 : if (DEBUGLEVEL>8) err_printf(".");
877 70567 : if (++cnt == 5000) return -1.; /* too expensive */
878 :
879 70553 : p = (double)x[1] + z[1]; norme = y[1] + p*p*v[1];
880 70553 : if (is_unit(M, r1, x) && norme < normin)
881 : {
882 : /* exclude roots of unity */
883 56 : if (norme < 2*n)
884 : {
885 42 : GEN t = nfpow_u(nf, zc_to_ZC(x), w);
886 42 : if (typ(t) != t_COL || ZV_isscalar(t)) continue;
887 : }
888 21 : normin = norme*(1-eps);
889 21 : if (DEBUGLEVEL>=2) err_printf("*");
890 : }
891 : }
892 28 : if (DEBUGLEVEL>=2) err_printf("\n");
893 28 : set_avma(av);
894 28 : return normin;
895 : }
896 :
897 : #undef NBMAX
898 : static int
899 1804 : is_zero(GEN x, long bitprec) { return (gexpo(x) < -bitprec); }
900 :
901 : static int
902 1228 : is_complex(GEN x, long bitprec) { return !is_zero(imag_i(x), bitprec); }
903 :
904 : /* assume M_star t_REAL
905 : * FIXME: what does this do ? To be rewritten */
906 : static GEN
907 28 : compute_M0(GEN M_star,long N)
908 : {
909 : long m1,m2,n1,n2,n3,lr,lr1,lr2,i,j,l,vx,vy,vz,vM;
910 : GEN pol,p1,p2,p3,p4,p5,p6,p7,p8,p9,u,v,w,r,r1,r2,M0,M0_pro,S,P,M;
911 : GEN f1,f2,f3,g1,g2,g3,pg1,pg2,pg3,pf1,pf2,pf3,X,Y,Z;
912 28 : long bitprec = 24;
913 :
914 28 : if (N == 2) return gmul2n(sqrr(gacosh(gmul2n(M_star,-1),0)), -1);
915 21 : vx = fetch_var(); X = pol_x(vx);
916 21 : vy = fetch_var(); Y = pol_x(vy);
917 21 : vz = fetch_var(); Z = pol_x(vz);
918 21 : vM = fetch_var(); M = pol_x(vM);
919 :
920 21 : M0 = NULL; m1 = N/3;
921 56 : for (n1=1; n1<=m1; n1++) /* 1 <= n1 <= n2 <= n3 < N */
922 : {
923 35 : m2 = (N-n1)>>1;
924 112 : for (n2=n1; n2<=m2; n2++)
925 : {
926 77 : pari_sp av = avma; n3=N-n1-n2;
927 77 : if (n1==n2 && n1==n3) /* n1 = n2 = n3 = m1 = N/3 */
928 : {
929 7 : p1 = divru(M_star, m1);
930 7 : p4 = sqrtr_abs( mulrr(addsr(1,p1),subrs(p1,3)) );
931 7 : p5 = subrs(p1,1);
932 7 : u = gen_1;
933 7 : v = gmul2n(addrr(p5,p4),-1);
934 7 : w = gmul2n(subrr(p5,p4),-1);
935 7 : M0_pro=gmul2n(mulur(m1,addrr(sqrr(logr_abs(v)),sqrr(logr_abs(w)))), -2);
936 7 : if (DEBUGLEVEL>2)
937 0 : err_printf("[ %ld, %ld, %ld ]: %.28Pg\n",n1,n2,n3,M0_pro);
938 7 : if (!M0 || gcmp(M0_pro,M0) < 0) M0 = M0_pro;
939 : }
940 70 : else if (n1==n2 || n2==n3)
941 42 : { /* n3 > N/3 >= n1 */
942 42 : long k = N - 2*n2;
943 42 : p2 = deg1pol_shallow(stoi(-n2), M_star, vx); /* M* - n2 X */
944 42 : p3 = gmul(powuu(k,k),
945 : gpowgs(gsubgs(RgX_Rg_mul(p2, M_star), k*k), n2));
946 42 : pol = gsub(p3, RgX_mul(monomial(powuu(n2,n2), n2, vx),
947 : gpowgs(p2, N-n2)));
948 42 : r = roots(pol, DEFAULTPREC); lr = lg(r);
949 378 : for (i=1; i<lr; i++)
950 : {
951 : GEN n2S;
952 336 : S = real_i(gel(r,i));
953 336 : if (is_complex(gel(r,i), bitprec) || signe(S) <= 0) continue;
954 :
955 182 : n2S = mulur(n2,S);
956 182 : p4 = subrr(M_star, n2S);
957 182 : P = divrr(mulrr(n2S,p4), subrs(mulrr(M_star,p4),k*k));
958 182 : p5 = subrr(sqrr(S), gmul2n(P,2));
959 182 : if (gsigne(p5) < 0) continue;
960 :
961 140 : p6 = sqrtr(p5);
962 140 : v = gmul2n(subrr(S,p6),-1);
963 140 : if (gsigne(v) <= 0) continue;
964 :
965 126 : u = gmul2n(addrr(S,p6),-1);
966 126 : w = gpow(P, sstoQ(-n2,k), 0);
967 126 : p6 = mulur(n2, addrr(sqrr(logr_abs(u)), sqrr(logr_abs(v))));
968 126 : M0_pro = gmul2n(addrr(p6, mulur(k, sqrr(logr_abs(w)))),-2);
969 126 : if (DEBUGLEVEL>2)
970 0 : err_printf("[ %ld, %ld, %ld ]: %.28Pg\n",n1,n2,n3,M0_pro);
971 126 : if (!M0 || gcmp(M0_pro,M0) < 0) M0 = M0_pro;
972 : }
973 : }
974 : else
975 : {
976 28 : f1 = gsub(gadd(gmulsg(n1,X),gadd(gmulsg(n2,Y),gmulsg(n3,Z))), M);
977 28 : f2 = gmulsg(n1,gmul(Y,Z));
978 28 : f2 = gadd(f2,gmulsg(n2,gmul(X,Z)));
979 28 : f2 = gadd(f2,gmulsg(n3,gmul(X,Y)));
980 28 : f2 = gsub(f2,gmul(M,gmul(X,gmul(Y,Z))));
981 28 : f3 = gsub(gmul(gpowgs(X,n1),gmul(gpowgs(Y,n2),gpowgs(Z,n3))), gen_1);
982 : /* f1 = n1 X + n2 Y + n3 Z - M */
983 : /* f2 = n1 YZ + n2 XZ + n3 XY */
984 : /* f3 = X^n1 Y^n2 Z^n3 - 1*/
985 28 : g1=resultant(f1,f2); g1=primpart(g1);
986 28 : g2=resultant(f1,f3); g2=primpart(g2);
987 28 : g3=resultant(g1,g2); g3=primpart(g3);
988 28 : pf1=gsubst(f1,vM,M_star); pg1=gsubst(g1,vM,M_star);
989 28 : pf2=gsubst(f2,vM,M_star); pg2=gsubst(g2,vM,M_star);
990 28 : pf3=gsubst(f3,vM,M_star); pg3=gsubst(g3,vM,M_star);
991 : /* g3 = Res_Y,Z(f1,f2,f3) */
992 28 : r = roots(pg3,DEFAULTPREC); lr = lg(r);
993 476 : for (i=1; i<lr; i++)
994 : {
995 448 : w = real_i(gel(r,i));
996 448 : if (is_complex(gel(r,i), bitprec) || signe(w) <= 0) continue;
997 140 : p1=gsubst(pg1,vz,w);
998 140 : p2=gsubst(pg2,vz,w);
999 140 : p3=gsubst(pf1,vz,w);
1000 140 : p4=gsubst(pf2,vz,w);
1001 140 : p5=gsubst(pf3,vz,w);
1002 140 : r1 = roots(p1, DEFAULTPREC); lr1 = lg(r1);
1003 420 : for (j=1; j<lr1; j++)
1004 : {
1005 280 : v = real_i(gel(r1,j));
1006 280 : if (is_complex(gel(r1,j), bitprec) || signe(v) <= 0
1007 280 : || !is_zero(gsubst(p2,vy,v), bitprec)) continue;
1008 :
1009 164 : p7=gsubst(p3,vy,v);
1010 164 : p8=gsubst(p4,vy,v);
1011 164 : p9=gsubst(p5,vy,v);
1012 164 : r2 = roots(p7, DEFAULTPREC); lr2 = lg(r2);
1013 328 : for (l=1; l<lr2; l++)
1014 : {
1015 164 : u = real_i(gel(r2,l));
1016 164 : if (is_complex(gel(r2,l), bitprec) || signe(u) <= 0
1017 164 : || !is_zero(gsubst(p8,vx,u), bitprec)
1018 164 : || !is_zero(gsubst(p9,vx,u), bitprec)) continue;
1019 :
1020 164 : M0_pro = mulur(n1, sqrr(logr_abs(u)));
1021 164 : M0_pro = gadd(M0_pro, mulur(n2, sqrr(logr_abs(v))));
1022 164 : M0_pro = gadd(M0_pro, mulur(n3, sqrr(logr_abs(w))));
1023 164 : M0_pro = gmul2n(M0_pro,-2);
1024 164 : if (DEBUGLEVEL>2)
1025 0 : err_printf("[ %ld, %ld, %ld ]: %.28Pg\n",n1,n2,n3,M0_pro);
1026 164 : if (!M0 || gcmp(M0_pro,M0) < 0) M0 = M0_pro;
1027 : }
1028 : }
1029 : }
1030 : }
1031 77 : if (!M0) set_avma(av); else M0 = gc_GEN(av, M0);
1032 : }
1033 : }
1034 105 : for (i=1;i<=4;i++) (void)delete_var();
1035 21 : return M0? M0: gen_0;
1036 : }
1037 :
1038 : static GEN
1039 63 : lowerboundforregulator(GEN bnf, GEN units)
1040 : {
1041 63 : long i, N, R2, RU = lg(units)-1;
1042 : GEN nf, M0, M, G, minunit;
1043 : double bound;
1044 :
1045 63 : if (!RU) return gen_1;
1046 63 : nf = bnf_get_nf(bnf);
1047 63 : N = nf_get_degree(nf);
1048 63 : R2 = nf_get_r2(nf);
1049 :
1050 63 : G = nf_get_G(nf);
1051 63 : minunit = gnorml2(RgM_RgC_mul(G, gel(units,1))); /* T2(units[1]) */
1052 112 : for (i=2; i<=RU; i++)
1053 : {
1054 49 : GEN t = gnorml2(RgM_RgC_mul(G, gel(units,i)));
1055 49 : if (gcmp(t,minunit) < 0) minunit = t;
1056 : }
1057 63 : if (gexpo(minunit) > 30) return NULL;
1058 :
1059 42 : bound = minimforunits(nf, itos(gceil(minunit)), bnf_get_tuN(bnf));
1060 42 : if (bound < 0) return NULL;
1061 28 : if (DEBUGLEVEL>1) err_printf("M* = %Ps\n", dbltor(bound));
1062 28 : M0 = compute_M0(dbltor(bound), N);
1063 28 : if (DEBUGLEVEL>1) err_printf("M0 = %.28Pg\n",M0);
1064 28 : M = gmul2n(divru(gdiv(powrs(M0,RU),Hermite_bound(RU, DEFAULTPREC)),N),R2);
1065 28 : if (cmprr(M, dbltor(0.04)) < 0) return NULL;
1066 28 : M = sqrtr(M);
1067 28 : if (DEBUGLEVEL>1)
1068 0 : err_printf("(lower bound for regulator) M = %.28Pg\n",M);
1069 28 : return M;
1070 : }
1071 :
1072 : /* upper bound for the index of bnf.fu in the full unit group */
1073 : static GEN
1074 63 : bound_unit_index(GEN bnf, GEN units)
1075 : {
1076 63 : pari_sp av = avma;
1077 63 : GEN x = lowerboundforregulator(bnf, units);
1078 63 : if (!x) { set_avma(av); x = regulatorbound(bnf); }
1079 63 : return gc_INT(av, ground(gdiv(bnf_get_reg(bnf), x)));
1080 : }
1081 :
1082 : /* Compute a square matrix of rank #beta attached to a family
1083 : * (P_i), 1<=i<=#beta, of primes s.t. N(P_i) = 1 mod p, and
1084 : * (P_i,beta[j]) = 1 for all i,j. nf = true nf */
1085 : static void
1086 1715 : primecertify(GEN nf, GEN beta, ulong p, GEN bad)
1087 : {
1088 1715 : long lb = lg(beta), rmax = lb - 1;
1089 : GEN M, vQ, L;
1090 : ulong q;
1091 : forprime_t T;
1092 :
1093 1715 : if (p == 2)
1094 49 : L = cgetg(1,t_VECSMALL);
1095 : else
1096 1666 : L = mkvecsmall(p);
1097 1715 : (void)u_forprime_arith_init(&T, 1, ULONG_MAX, 1, p);
1098 1715 : M = cgetg(lb,t_MAT); setlg(M,1);
1099 3591 : while ((q = u_forprime_next(&T)))
1100 : {
1101 : GEN qq, gg, og;
1102 : long lQ, i, j;
1103 : ulong g, m;
1104 3591 : if (!umodiu(bad,q)) continue;
1105 :
1106 3283 : qq = utoipos(q);
1107 3283 : vQ = idealprimedec_limit_f(nf,qq,1);
1108 3283 : lQ = lg(vQ); if (lQ == 1) continue;
1109 :
1110 : /* cf rootsof1_Fl */
1111 2142 : g = pgener_Fl_local(q, L);
1112 2142 : m = (q-1) / p;
1113 2142 : gg = utoipos( Fl_powu(g, m, q) ); /* order p in (Z/q)^* */
1114 2142 : og = mkmat2(mkcol(utoi(p)), mkcol(gen_1)); /* order of g */
1115 :
1116 2142 : if (DEBUGLEVEL>3) err_printf(" generator of (Zk/Q)^*: %lu\n", g);
1117 2835 : for (i = 1; i < lQ; i++)
1118 : {
1119 2408 : GEN C = cgetg(lb, t_VECSMALL);
1120 2408 : GEN Q = gel(vQ,i); /* degree 1 */
1121 2408 : GEN modpr = zkmodprinit(nf, Q);
1122 : long r;
1123 :
1124 6944 : for (j = 1; j < lb; j++)
1125 : {
1126 4536 : GEN t = nf_to_Fp_coprime(nf, gel(beta,j), modpr);
1127 4536 : t = utoipos( Fl_powu(t[2], m, q) );
1128 4536 : C[j] = itou( Fp_log(t, gg, og, qq) ) % p;
1129 : }
1130 2408 : r = lg(M);
1131 2408 : gel(M,r) = C; setlg(M, r+1);
1132 2408 : if (Flm_rank(M, p) != r) { setlg(M,r); continue; }
1133 :
1134 2191 : if (DEBUGLEVEL>2)
1135 : {
1136 0 : if (DEBUGLEVEL>3)
1137 : {
1138 0 : err_printf(" prime ideal Q: %Ps\n",Q);
1139 0 : err_printf(" matrix log(b_j mod Q_i): %Ps\n", M);
1140 : }
1141 0 : err_printf(" new rank: %ld\n",r);
1142 : }
1143 2191 : if (r == rmax) return;
1144 : }
1145 : }
1146 0 : pari_err_BUG("primecertify");
1147 : }
1148 :
1149 : struct check_pr {
1150 : long w; /* #mu(K) */
1151 : GEN mu; /* generator of mu(K) */
1152 : GEN fu;
1153 : GEN cyc;
1154 : GEN cycgen;
1155 : GEN bad; /* p | bad <--> p | some element occurring in cycgen */
1156 : };
1157 :
1158 : static void
1159 1715 : check_prime(ulong p, GEN nf, struct check_pr *S)
1160 : {
1161 1715 : pari_sp av = avma;
1162 1715 : long i,b, lc = lg(S->cyc), lf = lg(S->fu);
1163 1715 : GEN beta = cgetg(lf+lc, t_VEC);
1164 :
1165 1715 : if (DEBUGLEVEL>1) err_printf(" *** testing p = %lu\n",p);
1166 1785 : for (b=1; b<lc; b++)
1167 : {
1168 1484 : if (umodiu(gel(S->cyc,b), p)) break; /* p \nmid cyc[b] */
1169 70 : if (b==1 && DEBUGLEVEL>2) err_printf(" p divides h(K)\n");
1170 70 : gel(beta,b) = gel(S->cycgen,b);
1171 : }
1172 1715 : if (S->w % p == 0)
1173 : {
1174 49 : if (DEBUGLEVEL>2) err_printf(" p divides w(K)\n");
1175 49 : gel(beta,b++) = S->mu;
1176 : }
1177 3787 : for (i=1; i<lf; i++) gel(beta,b++) = gel(S->fu,i);
1178 1715 : setlg(beta, b); /* beta = [cycgen[i] if p|cyc[i], tu if p|w, fu] */
1179 1715 : if (DEBUGLEVEL>3) err_printf(" Beta list = %Ps\n",beta);
1180 1715 : primecertify(nf, beta, p, S->bad); set_avma(av);
1181 1715 : }
1182 :
1183 : static void
1184 63 : init_bad(struct check_pr *S, GEN nf, GEN gen)
1185 : {
1186 63 : long i, l = lg(gen);
1187 63 : GEN bad = gen_1;
1188 :
1189 126 : for (i=1; i < l; i++)
1190 63 : bad = lcmii(bad, gcoeff(gel(gen,i),1,1));
1191 126 : for (i = 1; i < l; i++)
1192 : {
1193 63 : GEN c = gel(S->cycgen,i);
1194 : long j;
1195 63 : if (typ(c) == t_MAT)
1196 : {
1197 63 : GEN g = gel(c,1);
1198 455 : for (j = 1; j < lg(g); j++)
1199 : {
1200 392 : GEN h = idealhnf_shallow(nf, gel(g,j));
1201 392 : bad = lcmii(bad, gcoeff(h,1,1));
1202 : }
1203 : }
1204 : }
1205 63 : S->bad = bad;
1206 63 : }
1207 :
1208 : long
1209 63 : bnfcertify0(GEN bnf, long flag)
1210 : {
1211 63 : pari_sp av = avma;
1212 : long N;
1213 : GEN nf, cyc, B, U;
1214 : ulong bound, p;
1215 : struct check_pr S;
1216 : forprime_t T;
1217 :
1218 63 : bnf = checkbnf(bnf);
1219 63 : nf = bnf_get_nf(bnf);
1220 63 : N = nf_get_degree(nf); if (N==1) return 1;
1221 63 : B = zimmertbound(nf_get_disc(nf), N, nf_get_r2(nf));
1222 63 : if (is_bigint(B))
1223 0 : pari_warn(warner,"Zimmert's bound is large (%Ps), certification will take a long time", B);
1224 63 : if (!is_pm1(nf_get_index(nf)))
1225 : {
1226 42 : GEN D = nf_get_diff(nf), L;
1227 42 : if (DEBUGLEVEL>1) err_printf("**** Testing Different = %Ps\n",D);
1228 42 : L = bnfisprincipal0(bnf, D, nf_FORCE);
1229 42 : if (DEBUGLEVEL>1) err_printf(" is %Ps\n", L);
1230 : }
1231 63 : if (DEBUGLEVEL)
1232 : {
1233 0 : err_printf("PHASE 1 [CLASS GROUP]: are all primes good ?\n");
1234 0 : err_printf(" Testing primes <= %Ps\n", B);
1235 : }
1236 63 : bnftestprimes(bnf, B);
1237 63 : if (flag) return 1;
1238 :
1239 63 : U = bnf_build_units(bnf);
1240 63 : cyc = bnf_get_cyc(bnf);
1241 63 : S.w = bnf_get_tuN(bnf);
1242 63 : S.mu = gel(U,1);
1243 63 : S.fu = vecslice(U,2,lg(U)-1);
1244 63 : S.cyc = cyc;
1245 63 : S.cycgen = bnf_build_cycgen(bnf);
1246 63 : init_bad(&S, nf, bnf_get_gen(bnf));
1247 :
1248 63 : B = bound_unit_index(bnf, S.fu);
1249 63 : if (DEBUGLEVEL)
1250 : {
1251 0 : err_printf("PHASE 2 [UNITS/RELATIONS]: are all primes good ?\n");
1252 0 : err_printf(" Testing primes <= %Ps\n", B);
1253 : }
1254 63 : bound = itou_or_0(B);
1255 63 : if (!bound) pari_err_OVERFLOW("bnfcertify [too many primes to check]");
1256 63 : if (u_forprime_init(&T, 2, bound))
1257 1757 : while ( (p = u_forprime_next(&T)) ) check_prime(p, nf, &S);
1258 63 : if (lg(cyc) > 1)
1259 : {
1260 28 : GEN f = Z_factor(cyc_get_expo(cyc)), P = gel(f,1);
1261 : long i;
1262 28 : if (DEBUGLEVEL>1) err_printf(" Primes dividing h(K)\n\n");
1263 35 : for (i = lg(P)-1; i; i--)
1264 : {
1265 28 : p = itou(gel(P,i)); if (p <= bound) break;
1266 7 : check_prime(p, nf, &S);
1267 : }
1268 : }
1269 63 : return gc_long(av,1);
1270 : }
1271 : long
1272 35 : bnfcertify(GEN bnf) { return bnfcertify0(bnf, 0); }
1273 :
1274 : /*******************************************************************/
1275 : /* */
1276 : /* RAY CLASS FIELDS: CONDUCTORS AND DISCRIMINANTS */
1277 : /* */
1278 : /*******************************************************************/
1279 : /* \chi(gen[i]) = zeta_D^chic[i])
1280 : * denormalize: express chi(gen[i]) in terms of zeta_{cyc[i]} */
1281 : GEN
1282 214536 : char_denormalize(GEN cyc, GEN D, GEN chic)
1283 : {
1284 214536 : long i, l = lg(chic);
1285 214536 : GEN chi = cgetg(l, t_VEC);
1286 : /* \chi(gen[i]) = e(chic[i] / D) = e(chi[i] / cyc[i])
1287 : * hence chi[i] = chic[i]cyc[i]/ D mod cyc[i] */
1288 824481 : for (i = 1; i < l; ++i)
1289 : {
1290 609945 : GEN di = gel(cyc, i), t = diviiexact(mulii(di, gel(chic,i)), D);
1291 609945 : gel(chi, i) = modii(t, di);
1292 : }
1293 214536 : return chi;
1294 : }
1295 : static GEN
1296 595 : bnrchar_i(GEN bnr, GEN g, GEN v)
1297 : {
1298 595 : long i, h, l = lg(g), t = typ_NULL;
1299 595 : GEN CH, D, U, U2, H, cycD, dv, dchi, cyc = NULL;
1300 :
1301 595 : if (checkbnr_i(bnr)) { t = typ_BNR; cyc = bnr_get_cyc(bnr); }
1302 14 : else if (checkznstar_i(bnr)) { t = typ_BIDZ; cyc = znstar_get_cyc(bnr); }
1303 0 : else if (typ(bnr) == t_VEC && RgV_is_ZV(bnr)) cyc = bnr;
1304 0 : else pari_err_TYPE("bnrchar", bnr);
1305 595 : switch(typ(g))
1306 : {
1307 : GEN G;
1308 28 : case t_VEC:
1309 28 : G = cgetg(l, t_MAT);
1310 28 : if (t == typ_BNR)
1311 : {
1312 49 : for (i = 1; i < l; i++) gel(G,i) = isprincipalray(bnr, gel(g,i));
1313 14 : cyc = bnr_get_cyc(bnr);
1314 : }
1315 : else
1316 35 : for (i = 1; i < l; i++) gel(G,i) = Zideallog(bnr, gel(g,i));
1317 28 : g = G; break;
1318 567 : case t_MAT:
1319 567 : if (RgM_is_ZM(g)) break;
1320 : default:
1321 0 : pari_err_TYPE("bnrchar",g);
1322 : }
1323 595 : H = ZM_hnfall_i(shallowconcat(g,diagonal_shallow(cyc)), v? &U: NULL, 1);
1324 595 : dv = NULL;
1325 595 : if (v)
1326 : {
1327 42 : GEN w = Q_remove_denom(v, &dv);
1328 42 : if (typ(v)!=t_VEC || lg(v)!=l || !RgV_is_ZV(w)) pari_err_TYPE("bnrchar",v);
1329 42 : if (!dv) v = NULL;
1330 : else
1331 : {
1332 42 : U = rowslice(U, 1, l-1);
1333 42 : w = FpV_red(ZV_ZM_mul(w, U), dv);
1334 140 : for (i = 1; i < l; i++)
1335 105 : if (signe(gel(w,i))) pari_err_TYPE("bnrchar [inconsistent values]",v);
1336 35 : v = vecslice(w,l,lg(w)-1);
1337 : }
1338 : }
1339 : /* chi defined on subgroup H, chi(H[i]) = e(v[i] / dv)
1340 : * unless v = NULL: chi|H = 1*/
1341 588 : h = itos( ZM_det_triangular(H) ); /* #(clgp/H) = number of chars */
1342 588 : if (h == 1) /* unique character, H = Id */
1343 : {
1344 14 : if (v)
1345 14 : v = char_denormalize(cyc,dv,v);
1346 : else
1347 0 : v = zerovec(lg(cyc)-1); /* trivial char */
1348 14 : return mkvec(v);
1349 : }
1350 :
1351 : /* chi defined on a subgroup of index h > 1; U H V = D diagonal,
1352 : * Z^#H / (H) = Z^#H / (D) ~ \oplus (Z/diZ) */
1353 574 : D = ZM_snfall_i(H, &U, NULL, 1);
1354 574 : cycD = cyc_normalize(D); gel(cycD,1) = gen_1; /* cycD[i] = d1/di */
1355 574 : dchi = gel(D,1);
1356 574 : U2 = ZM_diag_mul(cycD, U);
1357 574 : if (v)
1358 : {
1359 21 : GEN Ui = ZM_inv(U, NULL);
1360 21 : GEN Z = hnf_solve(H, ZM_mul_diag(Ui, D));
1361 21 : v = ZV_ZM_mul(ZV_ZM_mul(v, Z), U2);
1362 21 : dchi = mulii(dchi, dv);
1363 21 : U2 = ZM_Z_mul(U2, dv);
1364 : }
1365 574 : CH = cyc2elts(D);
1366 2310 : for (i = 1; i <= h; i++)
1367 : {
1368 1736 : GEN c = zv_ZM_mul(gel(CH,i), U2);
1369 1736 : if (v) c = ZC_add(c, v);
1370 1736 : gel(CH,i) = char_denormalize(cyc, dchi, c);
1371 : }
1372 574 : return CH;
1373 : }
1374 : GEN
1375 595 : bnrchar(GEN bnr, GEN g, GEN v)
1376 : {
1377 595 : pari_sp av = avma;
1378 595 : return gc_GEN(av, bnrchar_i(bnr,g,v));
1379 : }
1380 :
1381 : /* Let bnr1, bnr2 be such that mod(bnr2) | mod(bnr1), compute surjective map
1382 : * p: Cl(bnr1) ->> Cl(bnr2).
1383 : * Write (bnr gens) for the concatenation of the bnf [corrected by El] and bid
1384 : * generators; and bnr.gen for the SNF generators. Then
1385 : * bnr.gen = (bnf.gen*bnr.El | bid.gen) bnr.Ui
1386 : * (bnf.gen*bnr.El | bid.gen) = bnr.gen * bnr.U */
1387 : GEN
1388 2723 : bnrsurjection(GEN bnr1, GEN bnr2)
1389 : {
1390 2723 : GEN bnf = bnr_get_bnf(bnr2), nf = bnf_get_nf(bnf);
1391 2723 : GEN M, U = bnr_get_U(bnr2), bid2 = bnr_get_bid(bnr2);
1392 2723 : GEN gen1 = bid_get_gen(bnr_get_bid(bnr1));
1393 2723 : GEN cyc2 = bnr_get_cyc(bnr2), e2 = cyc_get_expo(cyc2);
1394 2723 : long i, l = lg(bnf_get_cyc(bnf)), lb = lg(gen1);
1395 : /* p(bnr1.gen) = p(bnr1 gens) * bnr1.Ui
1396 : * = (bnr2 gens) * P * bnr1.Ui
1397 : * = bnr2.gen * (bnr2.U * P * bnr1.Ui) */
1398 :
1399 : /* p(bid1.gen) on bid2.gen */
1400 2723 : M = cgetg(lb, t_MAT);
1401 11858 : for (i = 1; i < lb; i++) gel(M,i) = ideallogmod(nf, gel(gen1,i), bid2, e2);
1402 : /* [U[1], U[2]] * [Id, 0; N, M] = [U[1] + U[2]*N, U[2]*M] */
1403 2723 : M = ZM_mul(gel(U,2), M);
1404 2723 : if (l > 1)
1405 : { /* non trivial class group */
1406 : /* p(bnf.gen * bnr1.El) in terms of bnf.gen * bnr2.El and bid2.gen */
1407 882 : GEN El2 = bnr_get_El(bnr2), El1 = bnr_get_El(bnr1);
1408 882 : long ngen2 = lg(bid_get_gen(bid2))-1;
1409 882 : if (!ngen2)
1410 595 : M = gel(U,1);
1411 : else
1412 : {
1413 287 : GEN U1 = gel(U,1), U2 = gel(U,2), T = cgetg(l, t_MAT);
1414 : /* T = U1 + U2 log(El2/El1) */
1415 595 : for (i = 1; i < l; i++)
1416 : { /* bnf gen in bnr1 is bnf.gen * El1 = bnf gen in bnr 2 * El1/El2 */
1417 308 : GEN c = gel(U1,i);
1418 308 : if (typ(gel(El1,i)) != t_INT) /* else El1[i] = 1 => El2[i] = 1 */
1419 : {
1420 119 : GEN z = nfdiv(nf,gel(El1,i),gel(El2,i));
1421 119 : c = ZC_add(c, ZM_ZC_mul(U2, ideallogmod(nf, z, bid2, e2)));
1422 : }
1423 308 : gel(T,i) = c;
1424 : }
1425 287 : M = shallowconcat(T, M);
1426 : }
1427 : }
1428 2723 : M = ZM_ZV_mod(ZM_mul(M, bnr_get_Ui(bnr1)), cyc2);
1429 2723 : return mkvec3(M, bnr_get_cyc(bnr1), cyc2);
1430 : }
1431 :
1432 : /* nchi a normalized character, S a surjective map ; return S(nchi)
1433 : * still normalized wrt the original cyclic structure (S[2]) */
1434 : static GEN
1435 903 : abmap_nchar_image(GEN S, GEN nchi)
1436 : {
1437 903 : GEN U, M = gel(S,1), Mc = diagonal_shallow(gel(S,3));
1438 903 : long l = lg(M);
1439 :
1440 903 : (void)ZM_hnfall_i(shallowconcat(M, Mc), &U, 1); /* identity */
1441 903 : U = matslice(U,1,l-1, l,lg(U)-1);
1442 903 : return char_simplify(gel(nchi,1), ZV_ZM_mul(gel(nchi,2), U));
1443 : }
1444 : static GEN
1445 686 : abmap_char_image(GEN S, GEN chi)
1446 : {
1447 686 : GEN nchi = char_normalize(chi, cyc_normalize(gel(S,2)));
1448 686 : GEN DC = abmap_nchar_image(S, nchi);
1449 686 : return char_denormalize(gel(S,3), gel(DC,1), gel(DC,2));
1450 : }
1451 :
1452 : GEN
1453 616 : bnrmap(GEN A, GEN B)
1454 : {
1455 616 : pari_sp av = avma;
1456 : GEN KA, KB, M, c, C;
1457 616 : if ((KA = checkbnf_i(A)))
1458 : {
1459 168 : checkbnr(A); checkbnr(B); KB = bnr_get_bnf(B);
1460 168 : if (!gidentical(KA, KB))
1461 0 : pari_err_TYPE("bnrmap [different fields]", mkvec2(KA,KB));
1462 168 : return gc_GEN(av, bnrsurjection(A,B));
1463 : }
1464 448 : if (lg(A) != 4 || typ(A) != t_VEC) pari_err_TYPE("bnrmap [not a map]", A);
1465 441 : M = gel(A,1); c = gel(A,2); C = gel(A,3);
1466 441 : if (typ(M) != t_MAT || !RgM_is_ZM(M) || typ(c) != t_VEC ||
1467 441 : typ(C) != t_VEC || lg(c) != lg(M) || (lg(M) > 1 && lgcols(M) != lg(C)))
1468 0 : pari_err_TYPE("bnrmap [not a map]", A);
1469 441 : switch(typ(B))
1470 : {
1471 7 : case t_INT: /* subgroup */
1472 7 : B = scalarmat_shallow(B, lg(C)-1);
1473 7 : B = ZM_hnfmodid(B, C); break;
1474 392 : case t_MAT: /* subgroup */
1475 392 : if (!RgM_is_ZM(B)) pari_err_TYPE("bnrmap [not a subgroup]", B);
1476 385 : B = ZM_hnfmodid(B, c); B = abmap_subgroup_image(A, B); break;
1477 21 : case t_VEC: /* character */
1478 21 : if (!char_check(c, B))
1479 14 : pari_err_TYPE("bnrmap [not a character mod mA]", B);
1480 7 : B = abmap_char_image(A, B); break;
1481 21 : case t_COL: /* discrete log mod mA */
1482 21 : if (lg(B) != lg(c) || !RgV_is_ZV(B))
1483 14 : pari_err_TYPE("bnrmap [not a discrete log]", B);
1484 7 : B = ZV_ZV_mod(ZM_ZC_mul(M, B), C);
1485 7 : return gc_upto(av, B);
1486 : }
1487 392 : return gc_GEN(av, B);
1488 : }
1489 :
1490 : /* Given normalized chi on bnr.clgp of conductor bnrc.mod,
1491 : * compute primitive character chic on bnrc.clgp equivalent to chi,
1492 : * still normalized wrt. bnr:
1493 : * chic(genc[i]) = zeta_C^chic[i]), C = cyc_normalize(bnr.cyc)[1] */
1494 : GEN
1495 217 : bnrchar_primitive(GEN bnr, GEN nchi, GEN bnrc)
1496 217 : { return abmap_nchar_image(bnrsurjection(bnr, bnrc), nchi); }
1497 :
1498 : /* s: <gen> = Cl_f -> Cl_f2 -> 0, H subgroup of Cl_f (generators given as
1499 : * HNF on [gen]). Return subgroup s(H) in Cl_f2 */
1500 : static GEN
1501 1967 : imageofgroup(GEN bnr, GEN bnr2, GEN H)
1502 : {
1503 1967 : if (!H) return diagonal_shallow(bnr_get_cyc(bnr2));
1504 1078 : return abmap_subgroup_image(bnrsurjection(bnr, bnr2), H);
1505 : }
1506 : GEN
1507 679 : bnrchar_primitive_raw(GEN bnr, GEN bnrc, GEN chi)
1508 679 : { return abmap_char_image(bnrsurjection(bnr, bnrc), chi); }
1509 :
1510 : /* convert A,B,C to [bnr, H] */
1511 : GEN
1512 273 : ABC_to_bnr(GEN A, GEN B, GEN C, GEN *H, int gen)
1513 : {
1514 273 : if (typ(A) == t_VEC)
1515 273 : switch(lg(A))
1516 : {
1517 119 : case 7: /* bnr */
1518 119 : *H = B; return A;
1519 154 : case 11: /* bnf */
1520 154 : if (!B) pari_err_TYPE("ABC_to_bnr [bnf+missing conductor]",A);
1521 154 : *H = C; return Buchray(A,B, gen? nf_INIT | nf_GEN: nf_INIT);
1522 : }
1523 0 : pari_err_TYPE("ABC_to_bnr",A);
1524 : *H = NULL; return NULL; /* LCOV_EXCL_LINE */
1525 : }
1526 :
1527 : /* OBSOLETE */
1528 : GEN
1529 63 : bnrconductor0(GEN A, GEN B, GEN C, long flag)
1530 : {
1531 63 : pari_sp av = avma;
1532 63 : GEN H, bnr = ABC_to_bnr(A,B,C,&H, 0);
1533 63 : return gc_GEN(av, bnrconductor(bnr, H, flag));
1534 : }
1535 :
1536 : long
1537 35 : bnrisconductor0(GEN A,GEN B,GEN C)
1538 : {
1539 35 : GEN H, bnr = ABC_to_bnr(A,B,C,&H, 0);
1540 35 : return bnrisconductor(bnr, H);
1541 : }
1542 :
1543 : static GEN
1544 516611 : ideallog_to_bnr_i(GEN Ubid, GEN cyc, GEN z)
1545 516611 : { return (lg(Ubid)==1)? zerocol(lg(cyc)-1): ZV_ZV_mod(ZM_ZC_mul(Ubid,z), cyc); }
1546 : /* return bnrisprincipal(bnr, (t)), assuming x = ideallog(t); allow a
1547 : * t_MAT for x, understood as a collection of ideallog(t_i) */
1548 : static GEN
1549 500240 : ideallog_to_bnr(GEN bnr, GEN x)
1550 : {
1551 500240 : GEN U = gel(bnr_get_U(bnr), 2); /* bid part */
1552 500243 : GEN cyc = bnr_get_cyc(bnr);
1553 500252 : if (typ(x) == t_COL) return ideallog_to_bnr_i(U, cyc, x);
1554 844293 : pari_APPLY_same(ideallog_to_bnr_i(U, cyc, gel(x,i)));
1555 : }
1556 : static GEN
1557 413991 : bnr_log_gen_pr(GEN bnr, zlog_S *S, long e, long index)
1558 413991 : { return ideallog_to_bnr(bnr, log_gen_pr(S, index, bnr_get_nf(bnr), e)); }
1559 : static GEN
1560 86269 : bnr_log_gen_arch(GEN bnr, zlog_S *S, long index)
1561 86269 : { return ideallog_to_bnr(bnr, log_gen_arch(S, index)); }
1562 :
1563 : /* A \subset H ? Allow H = NULL = trivial subgroup */
1564 : static int
1565 402949 : contains(GEN H, GEN A)
1566 402949 : { return H? (hnf_solve(H, A) != NULL): gequal0(A); }
1567 :
1568 : /* finite part of the conductor of H is S.P^e2*/
1569 : static GEN
1570 47236 : cond0_e(GEN bnr, GEN H, zlog_S *S)
1571 : {
1572 47236 : long j, k, l = lg(S->k), iscond0 = S->no2;
1573 47236 : GEN e = S->k, e2 = cgetg(l, t_COL);
1574 121765 : for (k = 1; k < l; k++)
1575 : {
1576 81711 : for (j = itos(gel(e,k)); j > 0; j--)
1577 : {
1578 77707 : if (!contains(H, bnr_log_gen_pr(bnr, S, j, k))) break;
1579 7182 : iscond0 = 0;
1580 : }
1581 74526 : gel(e2,k) = utoi(j);
1582 : }
1583 47236 : return iscond0? NULL: e2;
1584 : }
1585 : /* infinite part of the conductor of H in archp form */
1586 : static GEN
1587 47236 : condoo_archp(GEN bnr, GEN H, zlog_S *S)
1588 : {
1589 47236 : GEN archp = S->archp, archp2 = leafcopy(archp);
1590 47236 : long j, k, l = lg(archp);
1591 65639 : for (k = j = 1; k < l; k++)
1592 : {
1593 18403 : if (!contains(H, bnr_log_gen_arch(bnr, S, k)))
1594 : {
1595 14651 : archp2[j++] = archp[k];
1596 14651 : continue;
1597 : }
1598 : }
1599 47236 : if (j == l) return S->archp;
1600 2821 : setlg(archp2, j); return archp2;
1601 : }
1602 : /* MOD useless in this function */
1603 : static GEN
1604 5355 : bnrconductor_factored_i(GEN bnr, GEN H, long raw)
1605 : {
1606 5355 : GEN nf, bid, ideal, arch, archp, e, fa, cond = NULL;
1607 : zlog_S S;
1608 :
1609 5355 : checkbnr(bnr);
1610 5355 : bid = bnr_get_bid(bnr); init_zlog(&S, bid);
1611 5355 : nf = bnr_get_nf(bnr);
1612 5355 : H = bnr_subgroup_check(bnr, H, NULL);
1613 5355 : e = cond0_e(bnr, H, &S); /* in terms of S.P */
1614 5355 : archp = condoo_archp(bnr, H, &S);
1615 5355 : ideal = e? factorbackprime(nf, S.P, e): bid_get_ideal(bid);
1616 5355 : if (archp == S.archp)
1617 : {
1618 3472 : if (!e) cond = bnr_get_mod(bnr);
1619 3472 : arch = bid_get_arch(bid);
1620 : }
1621 : else
1622 1883 : arch = indices_to_vec01(archp, nf_get_r1(nf));
1623 5355 : if (!cond) cond = mkvec2(ideal, arch);
1624 5355 : if (raw) return cond;
1625 623 : fa = e? famat_remove_trivial(mkmat2(S.P, e)): bid_get_fact(bid);
1626 623 : return mkvec2(cond, fa);
1627 : }
1628 : GEN
1629 623 : bnrconductor_factored(GEN bnr, GEN H)
1630 623 : { return bnrconductor_factored_i(bnr, H, 0); }
1631 : GEN
1632 4732 : bnrconductor_raw(GEN bnr, GEN H)
1633 4732 : { return bnrconductor_factored_i(bnr, H, 1); }
1634 :
1635 : /* (see bnrdisc_i). Given a bnr, and a subgroup
1636 : * H0 (possibly given as a character chi, in which case H0 = ker chi) of the
1637 : * ray class group, compute the conductor of H if flag=0. If flag > 0, compute
1638 : * also the corresponding H' and output
1639 : * if flag = 1: [[ideal,arch],[hm,cyc,gen],H']
1640 : * if flag = 2: [[ideal,arch],newbnr,H'] */
1641 : GEN
1642 41881 : bnrconductormod(GEN bnr, GEN H0, GEN MOD)
1643 : {
1644 41881 : GEN nf, bid, arch, archp, bnrc, e, H, cond = NULL;
1645 : int ischi;
1646 : zlog_S S;
1647 :
1648 41881 : checkbnr(bnr);
1649 41881 : bid = bnr_get_bid(bnr); init_zlog(&S, bid);
1650 41881 : nf = bnr_get_nf(bnr);
1651 41881 : H = bnr_subgroup_check(bnr, H0, NULL);
1652 41881 : e = cond0_e(bnr, H, &S);
1653 41881 : archp = condoo_archp(bnr, H, &S);
1654 41881 : if (archp == S.archp)
1655 : {
1656 40943 : if (!e) cond = bnr_get_mod(bnr);
1657 40943 : arch = gel(bnr_get_mod(bnr), 2);
1658 : }
1659 : else
1660 938 : arch = indices_to_vec01(archp, nf_get_r1(nf));
1661 :
1662 : /* character or subgroup ? */
1663 41881 : ischi = H0 && typ(H0) == t_VEC;
1664 41881 : if (cond)
1665 : { /* same conductor */
1666 39256 : bnrc = bnr;
1667 39256 : if (ischi)
1668 728 : H = H0;
1669 38528 : else if (!H)
1670 26929 : H = diagonal_shallow(bnr_get_cyc(bnr));
1671 : }
1672 : else
1673 : {
1674 2625 : long fl = lg(bnr_get_clgp(bnr)) == 4? nf_INIT | nf_GEN: nf_INIT;
1675 2625 : GEN fa = famat_remove_trivial(mkmat2(S.P, e? e: S.k)), bid;
1676 2625 : bid = Idealstarmod(nf, mkvec2(fa, arch), nf_INIT | nf_GEN, MOD);
1677 2625 : bnrc = Buchraymod_i(bnr, bid, fl, MOD);
1678 2625 : cond = bnr_get_mod(bnrc);
1679 2625 : if (ischi)
1680 658 : H = bnrchar_primitive_raw(bnr, bnrc, H0);
1681 : else
1682 1967 : H = imageofgroup(bnr, bnrc, H);
1683 : }
1684 41881 : return mkvec3(cond, bnrc, H);
1685 : }
1686 : /* OBSOLETE */
1687 : GEN
1688 602 : bnrconductor_i(GEN bnr, GEN H, long flag)
1689 : {
1690 : GEN v;
1691 602 : if (flag == 0) return bnrconductor_raw(bnr, H);
1692 0 : v = bnrconductormod(bnr, H, NULL);
1693 0 : if (flag == 1) gel(v,2) = bnr_get_clgp(gel(v,2));
1694 0 : return v;
1695 : }
1696 : /* OBSOLETE */
1697 : GEN
1698 602 : bnrconductor(GEN bnr, GEN H, long flag)
1699 : {
1700 602 : pari_sp av = avma;
1701 602 : if (flag > 2 || flag < 0) pari_err_FLAG("bnrconductor");
1702 602 : return gc_GEN(av, bnrconductor_i(bnr, H, flag));
1703 : }
1704 :
1705 : long
1706 275060 : bnrisconductor(GEN bnr, GEN H0)
1707 : {
1708 275060 : pari_sp av = avma;
1709 : long j, k, l;
1710 : GEN archp, e, H;
1711 : zlog_S S;
1712 :
1713 275060 : checkbnr(bnr);
1714 275060 : init_zlog(&S, bnr_get_bid(bnr));
1715 275061 : if (!S.no2) return 0;
1716 231717 : H = bnr_subgroup_check(bnr, H0, NULL);
1717 :
1718 231717 : archp = S.archp;
1719 231717 : e = S.k; l = lg(e);
1720 369183 : for (k = 1; k < l; k++)
1721 : {
1722 261662 : j = itos(gel(e,k));
1723 261661 : if (contains(H, bnr_log_gen_pr(bnr, &S, j, k))) return gc_long(av,0);
1724 : }
1725 107521 : l = lg(archp);
1726 136549 : for (k = 1; k < l; k++)
1727 44925 : if (contains(H, bnr_log_gen_arch(bnr, &S, k))) return gc_long(av,0);
1728 91624 : return gc_long(av,1);
1729 : }
1730 :
1731 : /* return the norm group corresponding to the relative extension given by
1732 : * polrel over bnr.bnf, assuming it is abelian and the modulus of bnr is a
1733 : * multiple of the conductor */
1734 : static GEN
1735 812 : rnfnormgroup_i(GEN bnr, GEN polrel)
1736 : {
1737 : long i, j, degrel, degnf, k;
1738 : GEN bnf, index, discnf, nf, G, detG, fa, gdegrel;
1739 : GEN fac, col, cnd;
1740 : forprime_t S;
1741 : ulong p;
1742 :
1743 812 : checkbnr(bnr); bnf = bnr_get_bnf(bnr);
1744 812 : nf = bnf_get_nf(bnf);
1745 812 : cnd = gel(bnr_get_mod(bnr), 1);
1746 812 : polrel = RgX_nffix("rnfnormgroup", nf_get_pol(nf),polrel,1);
1747 812 : if (!gequal1(leading_coeff(polrel)))
1748 0 : pari_err_IMPL("rnfnormgroup for nonmonic polynomials");
1749 :
1750 812 : degrel = degpol(polrel);
1751 812 : if (umodiu(bnr_get_no(bnr), degrel)) return NULL;
1752 : /* degrel-th powers are in norm group */
1753 798 : gdegrel = utoipos(degrel);
1754 798 : G = ZV_snf_gcd(bnr_get_cyc(bnr), gdegrel);
1755 798 : detG = ZV_prod(G);
1756 798 : k = abscmpiu(detG,degrel);
1757 798 : if (k < 0) return NULL;
1758 798 : if (!k) return diagonal(G);
1759 :
1760 252 : G = diagonal_shallow(G);
1761 252 : discnf = nf_get_disc(nf);
1762 252 : index = nf_get_index(nf);
1763 252 : degnf = nf_get_degree(nf);
1764 252 : u_forprime_init(&S, 2, ULONG_MAX);
1765 1554 : while ( (p = u_forprime_next(&S)) )
1766 : {
1767 : long oldf, nfa;
1768 : /* If all pr are unramified and have the same residue degree, p =prod pr
1769 : * and including last pr^f or p^f is the same, but the last isprincipal
1770 : * is much easier! oldf is used to track this */
1771 :
1772 1554 : if (!umodiu(index, p)) continue; /* can't be treated efficiently */
1773 :
1774 : /* primes of degree 1 are enough, and simpler */
1775 1554 : fa = idealprimedec_limit_f(nf, utoipos(p), 1);
1776 1554 : nfa = lg(fa)-1;
1777 1554 : if (!nfa) continue;
1778 : /* all primes above p included ? */
1779 1267 : oldf = (nfa == degnf)? -1: 0;
1780 2429 : for (i=1; i<=nfa; i++)
1781 : {
1782 1414 : GEN pr = gel(fa,i), pp, T, polr, modpr;
1783 : long f, nfac;
1784 : /* if pr (probably) ramified, we have to use all (unramified) P | pr */
1785 1925 : if (idealval(nf,cnd,pr)) { oldf = 0; continue; }
1786 1085 : modpr = zk_to_Fq_init(nf, &pr, &T, &pp); /* T = NULL, pp ignored */
1787 1085 : polr = nfX_to_FqX(polrel, nf, modpr); /* in Fp[X] */
1788 1085 : polr = ZX_to_Flx(polr, p);
1789 1085 : if (!Flx_is_squarefree(polr, p)) { oldf = 0; continue; }
1790 :
1791 1029 : fac = gel(Flx_factor(polr, p), 1);
1792 1029 : f = degpol(gel(fac,1));
1793 1029 : if (f == degrel) continue; /* degrel-th powers already included */
1794 574 : nfac = lg(fac)-1;
1795 : /* check decomposition of pr has Galois type */
1796 1526 : for (j=2; j<=nfac; j++)
1797 1204 : if (degpol(gel(fac,j)) != f) return NULL;
1798 567 : if (oldf < 0) oldf = f; else if (oldf != f) oldf = 0;
1799 :
1800 : /* last prime & all pr^f, pr | p, included. Include p^f instead */
1801 567 : if (oldf && i == nfa && degrel == nfa*f && !umodiu(discnf, p))
1802 0 : pr = utoipos(p);
1803 :
1804 : /* pr^f = N P, P | pr, hence is in norm group */
1805 567 : col = bnrisprincipalmod(bnr,pr,gdegrel,0);
1806 567 : if (f > 1) col = ZC_z_mul(col, f);
1807 567 : G = ZM_hnf(shallowconcat(G, col));
1808 567 : detG = ZM_det_triangular(G);
1809 567 : k = abscmpiu(detG,degrel);
1810 567 : if (k < 0) return NULL;
1811 567 : if (!k) { cgiv(detG); return G; }
1812 : }
1813 : }
1814 0 : return NULL;
1815 : }
1816 : GEN
1817 14 : rnfnormgroup(GEN bnr, GEN polrel)
1818 : {
1819 14 : pari_sp av = avma;
1820 14 : GEN G = rnfnormgroup_i(bnr, polrel);
1821 14 : if (!G) retgc_const(av, cgetg(1, t_MAT));
1822 7 : return gc_upto(av, G);
1823 : }
1824 :
1825 : GEN
1826 0 : nf_deg1_prime(GEN nf)
1827 : {
1828 0 : GEN z, T = nf_get_pol(nf), D = nf_get_disc(nf), f = nf_get_index(nf);
1829 0 : long degnf = degpol(T);
1830 : forprime_t S;
1831 : pari_sp av;
1832 : ulong p;
1833 0 : u_forprime_init(&S, degnf, ULONG_MAX);
1834 0 : av = avma;
1835 0 : while ( (p = u_forprime_next(&S)) )
1836 : {
1837 : ulong r;
1838 0 : if (!umodiu(D, p) || !umodiu(f, p)) continue;
1839 0 : r = Flx_oneroot(ZX_to_Flx(T,p), p);
1840 0 : if (r != p)
1841 : {
1842 0 : z = utoi(Fl_neg(r, p));
1843 0 : z = deg1pol_shallow(gen_1, z, varn(T));
1844 0 : return idealprimedec_kummer(nf, z, 1, utoipos(p));
1845 : }
1846 0 : set_avma(av);
1847 : }
1848 0 : return NULL;
1849 : }
1850 :
1851 : /* Given bnf and T defining an abelian relative extension, compute the
1852 : * corresponding conductor and congruence subgroup. Return
1853 : * [cond,bnr(cond),H] where cond=[ideal,arch] is the conductor. */
1854 : GEN
1855 812 : rnfconductor0(GEN bnf, GEN T, long flag)
1856 : {
1857 812 : pari_sp av = avma;
1858 : GEN P, E, D, nf, module, bnr, H, lim, Tr, MOD;
1859 : long i, l, degT;
1860 :
1861 812 : if (flag < 0 || flag > 2) pari_err_FLAG("rnfconductor");
1862 812 : bnf = checkbnf(bnf); nf = bnf_get_nf(bnf);
1863 798 : Tr = rnfdisc_get_T(nf, T, &lim);
1864 798 : T = nfX_to_monic(nf, Tr, NULL); degT = degpol(T);
1865 798 : if (!lim)
1866 777 : D = rnfdisc_factored(nf, T, NULL);
1867 : else
1868 : {
1869 21 : D = nfX_disc(nf, Q_primpart(Tr));
1870 21 : if (gequal0(D))
1871 0 : pari_err_DOMAIN("rnfconductor","issquarefree(pol)","=",gen_0, Tr);
1872 21 : D = idealfactor_partial(nf, D, lim);
1873 : }
1874 798 : P = gel(D,1); l = lg(P);
1875 798 : E = gel(D,2);
1876 1764 : for (i = 1; i < l; i++) /* cheaply update tame primes */
1877 : { /* v_pr(f) = 1 + \sum_{0 < i < l} g_i/g_0
1878 : <= 1 + max_{i>0} g_i/(g_i-1) \sum_{0 < i < l} g_i -1
1879 : <= 1 + (p/(p-1)) * v_P(e(L/K, pr)), P | pr | p */
1880 966 : GEN pr = gel(P,i), p = pr_get_p(pr), e = gen_1;
1881 966 : ulong q, e0 = itou(gel(E,i));
1882 966 : if (e0 > 1 && cmpiu(p, degT) <= 0)
1883 : {
1884 427 : long v, pp = itou(p);
1885 427 : if ((v = u_lvalrem(degT, pp, &q)))
1886 : { /* e = e_tame * e_wild, e_wild | p^v */
1887 343 : ulong t = ugcdiu(subiu(pr_norm(pr),1), q); /* e_tame | t */
1888 : /* upper bound for 1 + p/(p-1) * v * e(L/Q,p) */
1889 343 : e0 = minuu(e0, 1 + (pp * v * pr_get_e(pr) * upowuu(pp,v) * t) / (pp-1));
1890 343 : e = utoipos(e0);
1891 : }
1892 : }
1893 966 : gel(E,i) = e;
1894 : }
1895 798 : module = mkvec2(D, identity_perm(nf_get_r1(nf)));
1896 798 : MOD = flag? utoipos(degpol(T)): NULL;
1897 798 : bnr = Buchraymod_i(bnf, module, nf_INIT|nf_GEN, MOD);
1898 798 : H = rnfnormgroup_i(bnr,T); if (!H) return gc_const(av,gen_0);
1899 1302 : return gc_GEN(av, flag == 2? bnrconductor_factored(bnr, H)
1900 518 : : bnrconductormod(bnr, H, MOD));
1901 : }
1902 : GEN
1903 35 : rnfconductor(GEN bnf, GEN T) { return rnfconductor0(bnf, T, 0); }
1904 :
1905 : static GEN
1906 1554 : prV_norms(GEN x)
1907 2835 : { pari_APPLY_same( pr_norm(gel(x,i))); }
1908 :
1909 : /* Given a number field bnf=bnr[1], a ray class group structure bnr, and a
1910 : * subgroup H (HNF form) of the ray class group, compute [n, r1, dk]
1911 : * attached to H. If flag & rnf_COND, abort (return NULL) if module is not the
1912 : * conductor. If flag & rnf_REL, return relative data, else absolute */
1913 : static GEN
1914 1631 : bnrdisc_i(GEN bnr, GEN H, long flag)
1915 : {
1916 1631 : const long flcond = flag & rnf_COND;
1917 : GEN nf, clhray, E, ED, dk;
1918 : long k, d, l, n, r1;
1919 : zlog_S S;
1920 :
1921 1631 : checkbnr(bnr);
1922 1631 : init_zlog(&S, bnr_get_bid(bnr));
1923 1631 : nf = bnr_get_nf(bnr);
1924 1631 : H = bnr_subgroup_check(bnr, H, &clhray);
1925 1631 : d = itos(clhray);
1926 1631 : if (!H) H = diagonal_shallow(bnr_get_cyc(bnr));
1927 1631 : E = S.k; ED = cgetg_copy(E, &l);
1928 2954 : for (k = 1; k < l; k++)
1929 : {
1930 1337 : long j, e = itos(gel(E,k)), eD = e*d;
1931 1337 : GEN H2 = H;
1932 1477 : for (j = e; j > 0; j--)
1933 : {
1934 1379 : GEN z = bnr_log_gen_pr(bnr, &S, j, k);
1935 : long d2;
1936 1379 : H2 = ZM_hnf(shallowconcat(H2, z));
1937 1379 : d2 = itos( ZM_det_triangular(H2) );
1938 1379 : if (flcond && j==e && d2 == d) return NULL;
1939 1365 : if (d2 == 1) { eD -= j; break; }
1940 140 : eD -= d2;
1941 : }
1942 1323 : gel(ED,k) = utoi(eD); /* v_{P[k]}(relative discriminant) */
1943 : }
1944 1617 : l = lg(S.archp); r1 = nf_get_r1(nf);
1945 1904 : for (k = 1; k < l; k++)
1946 : {
1947 315 : if (!contains(H, bnr_log_gen_arch(bnr, &S, k))) { r1--; continue; }
1948 98 : if (flcond) return NULL;
1949 : }
1950 : /* d = relative degree
1951 : * r1 = number of unramified real places;
1952 : * [P,ED] = factorization of relative discriminant */
1953 1589 : if (flag & rnf_REL)
1954 : {
1955 35 : n = d;
1956 35 : dk = factorbackprime(nf, S.P, ED);
1957 : }
1958 : else
1959 : {
1960 1554 : n = d * nf_get_degree(nf);
1961 1554 : r1= d * r1;
1962 1554 : dk = factorback2(prV_norms(S.P), ED);
1963 1554 : if (((n-r1)&3) == 2) dk = negi(dk); /* (2r2) mod 4 = 2: r2(relext) is odd */
1964 1554 : dk = mulii(dk, powiu(absi_shallow(nf_get_disc(nf)), d));
1965 : }
1966 1589 : return mkvec3(utoipos(n), utoi(r1), dk);
1967 : }
1968 : GEN
1969 1631 : bnrdisc(GEN bnr, GEN H, long flag)
1970 : {
1971 1631 : pari_sp av = avma;
1972 1631 : GEN D = bnrdisc_i(bnr, H, flag);
1973 1631 : return D? gc_GEN(av, D): gc_const(av, gen_0);
1974 : }
1975 : GEN
1976 175 : bnrdisc0(GEN A, GEN B, GEN C, long flag)
1977 : {
1978 175 : GEN H, bnr = ABC_to_bnr(A,B,C,&H, 0);
1979 175 : return bnrdisc(bnr,H,flag);
1980 : }
1981 :
1982 : /* Given a number field bnf=bnr[1], a ray class group structure bnr and a
1983 : * vector chi representing a character on the generators bnr[2][3], compute
1984 : * the conductor of chi. */
1985 : GEN
1986 7 : bnrconductorofchar(GEN bnr, GEN chi)
1987 : {
1988 7 : pari_sp av = avma;
1989 7 : return gc_GEN(av, bnrconductor_raw(bnr, chi));
1990 : }
1991 :
1992 : /* \sum U[i]*y[i], U[i],y[i] ZM, we allow lg(y) > lg(U). */
1993 : static GEN
1994 910 : ZMV_mul(GEN U, GEN y)
1995 : {
1996 910 : long i, l = lg(U);
1997 910 : GEN z = NULL;
1998 910 : if (l == 1) return cgetg(1,t_MAT);
1999 2324 : for (i = 1; i < l; i++)
2000 : {
2001 1442 : GEN u = ZM_mul(gel(U,i), gel(y,i));
2002 1442 : z = z? ZM_add(z, u): u;
2003 : }
2004 882 : return z;
2005 : }
2006 :
2007 : /* t = [bid,U], h = #Cl(K) */
2008 : static GEN
2009 910 : get_classno(GEN t, GEN h)
2010 : {
2011 910 : GEN bid = gel(t,1), m = gel(t,2), cyc = bid_get_cyc(bid), U = bid_get_U(bid);
2012 910 : return mulii(h, ZM_det_triangular(ZM_hnfmodid(ZMV_mul(U,m), cyc)));
2013 : }
2014 :
2015 : static void
2016 28 : chk_listBU(GEN L, const char *s) {
2017 28 : if (typ(L) != t_VEC) pari_err_TYPE(s,L);
2018 28 : if (lg(L) > 1) {
2019 28 : GEN z = gel(L,1);
2020 28 : if (typ(z) != t_VEC) pari_err_TYPE(s,z);
2021 28 : if (lg(z) == 1) return;
2022 28 : z = gel(z,1); /* [bid,U] */
2023 28 : if (typ(z) != t_VEC || lg(z) != 3) pari_err_TYPE(s,z);
2024 28 : checkbid(gel(z,1));
2025 : }
2026 : }
2027 :
2028 : /* Given lists of [bid, unit ideallogs], return lists of ray class numbers */
2029 : GEN
2030 7 : bnrclassnolist(GEN bnf,GEN L)
2031 : {
2032 7 : pari_sp av = avma;
2033 7 : long i, l = lg(L);
2034 : GEN V, h;
2035 :
2036 7 : chk_listBU(L, "bnrclassnolist");
2037 7 : if (l == 1) return cgetg(1, t_VEC);
2038 7 : bnf = checkbnf(bnf);
2039 7 : h = bnf_get_no(bnf);
2040 7 : V = cgetg(l,t_VEC);
2041 392 : for (i = 1; i < l; i++)
2042 : {
2043 385 : GEN v, z = gel(L,i);
2044 385 : long j, lz = lg(z);
2045 385 : gel(V,i) = v = cgetg(lz,t_VEC);
2046 826 : for (j=1; j<lz; j++) gel(v,j) = get_classno(gel(z,j), h);
2047 : }
2048 7 : return gc_GEN(av, V);
2049 : }
2050 :
2051 : static GEN
2052 1484 : Lbnrclassno(GEN L, GEN fac)
2053 : {
2054 1484 : long i, l = lg(L);
2055 2184 : for (i=1; i<l; i++)
2056 2184 : if (gequal(gmael(L,i,1),fac)) return gmael(L,i,2);
2057 0 : pari_err_BUG("Lbnrclassno");
2058 : return NULL; /* LCOV_EXCL_LINE */
2059 : }
2060 :
2061 : static GEN
2062 406 : factordivexact(GEN fa1,GEN fa2)
2063 : {
2064 : long i, j, k, c, l;
2065 : GEN P, E, P1, E1, P2, E2, p1;
2066 :
2067 406 : P1 = gel(fa1,1); E1 = gel(fa1,2); l = lg(P1);
2068 406 : P2 = gel(fa2,1); E2 = gel(fa2,2);
2069 406 : P = cgetg(l,t_COL);
2070 406 : E = cgetg(l,t_COL);
2071 903 : for (c = i = 1; i < l; i++)
2072 : {
2073 497 : j = RgV_isin(P2,gel(P1,i));
2074 497 : if (!j) { gel(P,c) = gel(P1,i); gel(E,c) = gel(E1,i); c++; }
2075 : else
2076 : {
2077 497 : p1 = subii(gel(E1,i), gel(E2,j)); k = signe(p1);
2078 497 : if (k < 0) pari_err_BUG("factordivexact [not exact]");
2079 497 : if (k > 0) { gel(P,c) = gel(P1,i); gel(E,c) = p1; c++; }
2080 : }
2081 : }
2082 406 : setlg(P, c);
2083 406 : setlg(E, c); return mkmat2(P, E);
2084 : }
2085 : /* remove index k */
2086 : static GEN
2087 1169 : factorsplice(GEN fa, long k)
2088 : {
2089 1169 : GEN p = gel(fa,1), e = gel(fa,2), P, E;
2090 1169 : long i, l = lg(p) - 1;
2091 1169 : P = cgetg(l, typ(p));
2092 1169 : E = cgetg(l, typ(e));
2093 1344 : for (i=1; i<k; i++) { P[i] = p[i]; E[i] = e[i]; }
2094 1169 : p++; e++;
2095 1694 : for ( ; i<l; i++) { P[i] = p[i]; E[i] = e[i]; }
2096 1169 : return mkvec2(P,E);
2097 : }
2098 : static GEN
2099 812 : factorpow(GEN fa, long n)
2100 : {
2101 812 : if (!n) return trivial_fact();
2102 812 : return mkmat2(gel(fa,1), gmulsg(n, gel(fa,2)));
2103 : }
2104 : static GEN
2105 1043 : factormul(GEN fa1,GEN fa2)
2106 : {
2107 1043 : GEN p, pnew, e, enew, v, P, y = famat_mul_shallow(fa1,fa2);
2108 : long i, c, lx;
2109 :
2110 1043 : p = gel(y,1); v = indexsort(p); lx = lg(p);
2111 1043 : e = gel(y,2);
2112 1043 : pnew = vecpermute(p, v);
2113 1043 : enew = vecpermute(e, v);
2114 1043 : P = gen_0; c = 0;
2115 2933 : for (i=1; i<lx; i++)
2116 : {
2117 1890 : if (gequal(gel(pnew,i),P))
2118 49 : gel(e,c) = addii(gel(e,c),gel(enew,i));
2119 : else
2120 : {
2121 1841 : c++; P = gel(pnew,i);
2122 1841 : gel(p,c) = P;
2123 1841 : gel(e,c) = gel(enew,i);
2124 : }
2125 : }
2126 1043 : setlg(p, c+1);
2127 1043 : setlg(e, c+1); return y;
2128 : }
2129 :
2130 : static long
2131 168 : get_nz(GEN bnf, GEN ideal, GEN arch, long clhray)
2132 : {
2133 : GEN arch2, mod;
2134 168 : long nz = 0, l = lg(arch), k, clhss;
2135 168 : if (typ(arch) == t_VECSMALL)
2136 14 : arch2 = indices_to_vec01(arch,nf_get_r1(bnf_get_nf(bnf)));
2137 : else
2138 154 : arch2 = leafcopy(arch);
2139 168 : mod = mkvec2(ideal, arch2);
2140 448 : for (k = 1; k < l; k++)
2141 : { /* FIXME: this is wasteful. Use the same algorithm as bnrconductor */
2142 301 : if (signe(gel(arch2,k)))
2143 : {
2144 28 : gel(arch2,k) = gen_0; clhss = itos(bnrclassno(bnf,mod));
2145 28 : gel(arch2,k) = gen_1;
2146 28 : if (clhss == clhray) return -1;
2147 : }
2148 273 : else nz++;
2149 : }
2150 147 : return nz;
2151 : }
2152 :
2153 : static GEN
2154 427 : get_NR1D(long Nf, long clhray, long degk, long nz, GEN fadkabs, GEN idealrel)
2155 : {
2156 : long n, R1;
2157 : GEN dlk;
2158 427 : if (nz < 0) return mkvec3(gen_0,gen_0,gen_0); /*EMPTY*/
2159 406 : n = clhray * degk;
2160 406 : R1 = clhray * nz;
2161 406 : dlk = factordivexact(factorpow(Z_factor(utoipos(Nf)),clhray), idealrel);
2162 : /* r2 odd, set dlk = -dlk */
2163 406 : if (((n-R1)&3)==2) dlk = factormul(to_famat_shallow(gen_m1,gen_1), dlk);
2164 406 : return mkvec3(utoipos(n),
2165 : stoi(R1),
2166 : factormul(dlk,factorpow(fadkabs,clhray)));
2167 : }
2168 :
2169 : /* t = [bid,U], h = #Cl(K) */
2170 : static GEN
2171 469 : get_discdata(GEN t, GEN h)
2172 : {
2173 469 : GEN bid = gel(t,1), fa = bid_get_fact(bid);
2174 469 : GEN P = gel(fa,1), E = vec_to_vecsmall(gel(fa,2));
2175 469 : return mkvec3(mkvec2(P, E), (GEN)itou(get_classno(t, h)), bid_get_mod(bid));
2176 : }
2177 : typedef struct _disc_data {
2178 : long degk;
2179 : GEN bnf, fadk, idealrelinit, V;
2180 : } disc_data;
2181 :
2182 : static GEN
2183 469 : get_discray(disc_data *D, GEN V, GEN z, long N)
2184 : {
2185 469 : GEN idealrel = D->idealrelinit;
2186 469 : GEN mod = gel(z,3), Fa = gel(z,1);
2187 469 : GEN P = gel(Fa,1), E = gel(Fa,2);
2188 469 : long k, nz, clhray = z[2], lP = lg(P);
2189 700 : for (k=1; k<lP; k++)
2190 : {
2191 546 : GEN pr = gel(P,k), p = pr_get_p(pr);
2192 546 : long e, ep = E[k], f = pr_get_f(pr);
2193 546 : long S = 0, norm = N, Npr = upowuu(p[2],f), clhss;
2194 798 : for (e=1; e<=ep; e++)
2195 : {
2196 : GEN fad;
2197 574 : if (e < ep) { E[k] = ep-e; fad = Fa; }
2198 462 : else fad = factorsplice(Fa, k);
2199 574 : norm /= Npr;
2200 574 : clhss = (long)Lbnrclassno(gel(V,norm), fad);
2201 574 : if (e==1 && clhss==clhray) { E[k] = ep; return cgetg(1, t_VEC); }
2202 259 : if (clhss == 1) { S += ep-e+1; break; }
2203 252 : S += clhss;
2204 : }
2205 231 : E[k] = ep;
2206 231 : idealrel = factormul(idealrel, to_famat_shallow(p, utoi(f * S)));
2207 : }
2208 154 : nz = get_nz(D->bnf, gel(mod,1), gel(mod,2), clhray);
2209 154 : return get_NR1D(N, clhray, D->degk, nz, D->fadk, idealrel);
2210 : }
2211 :
2212 : /* Given a list of bids and attached unit log matrices, return the
2213 : * list of discrayabs. Only keep moduli which are conductors. */
2214 : GEN
2215 21 : discrayabslist(GEN bnf, GEN L)
2216 : {
2217 21 : pari_sp av = avma;
2218 21 : long i, l = lg(L);
2219 : GEN nf, V, D, h;
2220 : disc_data ID;
2221 :
2222 21 : chk_listBU(L, "discrayabslist");
2223 21 : if (l == 1) return cgetg(1, t_VEC);
2224 21 : ID.bnf = bnf = checkbnf(bnf);
2225 21 : nf = bnf_get_nf(bnf);
2226 21 : h = bnf_get_no(bnf);
2227 21 : ID.degk = nf_get_degree(nf);
2228 21 : ID.fadk = absZ_factor(nf_get_disc(nf));
2229 21 : ID.idealrelinit = trivial_fact();
2230 21 : V = cgetg(l, t_VEC);
2231 21 : D = cgetg(l, t_VEC);
2232 448 : for (i = 1; i < l; i++)
2233 : {
2234 427 : GEN z = gel(L,i), v, d;
2235 427 : long j, lz = lg(z);
2236 427 : gel(V,i) = v = cgetg(lz,t_VEC);
2237 427 : gel(D,i) = d = cgetg(lz,t_VEC);
2238 896 : for (j=1; j<lz; j++) {
2239 469 : gel(d,j) = get_discdata(gel(z,j), h);
2240 469 : gel(v,j) = get_discray(&ID, D, gel(d,j), i);
2241 : }
2242 : }
2243 21 : return gc_GEN(av, V);
2244 : }
2245 :
2246 : /* a zsimp is [fa, cyc, v]
2247 : * fa: vecsmall factorisation,
2248 : * cyc: ZV (concatenation of (Z_K/pr^k)^* SNFs), the generators
2249 : * are positive at all real places [defined implicitly by weak approximation]
2250 : * v: ZC (log of units on (Z_K/pr^k)^* components) */
2251 : static GEN
2252 28 : zsimp(void)
2253 : {
2254 28 : GEN empty = cgetg(1, t_VECSMALL);
2255 28 : return mkvec3(mkvec2(empty,empty), cgetg(1,t_VEC), cgetg(1,t_MAT));
2256 : }
2257 :
2258 : /* fa a vecsmall factorization, append p^e */
2259 : static GEN
2260 175 : fasmall_append(GEN fa, long p, long e)
2261 : {
2262 175 : GEN P = gel(fa,1), E = gel(fa,2);
2263 175 : retmkvec2(vecsmall_append(P,p), vecsmall_append(E,e));
2264 : }
2265 :
2266 : /* sprk = sprkinit(pr,k), b zsimp with modulus coprime to pr */
2267 : static GEN
2268 518 : zsimpjoin(GEN b, GEN sprk, GEN U_pr, long prcode, long e)
2269 : {
2270 518 : GEN fa, cyc = sprk_get_cyc(sprk);
2271 518 : if (lg(gel(b,2)) == 1) /* trivial group */
2272 343 : fa = mkvec2(mkvecsmall(prcode),mkvecsmall(e));
2273 : else
2274 : {
2275 175 : fa = fasmall_append(gel(b,1), prcode, e);
2276 175 : cyc = shallowconcat(gel(b,2), cyc); /* no SNF ! */
2277 175 : U_pr = vconcat(gel(b,3),U_pr);
2278 : }
2279 518 : return mkvec3(fa, cyc, U_pr);
2280 : }
2281 : /* B a zsimp, sgnU = [cyc[f_oo], sgn_{f_oo}(units)] */
2282 : static GEN
2283 28 : bnrclassno_1(GEN B, ulong h, GEN sgnU)
2284 : {
2285 28 : long lx = lg(B), j;
2286 28 : GEN L = cgetg(lx,t_VEC);
2287 56 : for (j=1; j<lx; j++)
2288 : {
2289 28 : pari_sp av = avma;
2290 28 : GEN b = gel(B,j), cyc = gel(b,2), qm = gel(b,3);
2291 : ulong z;
2292 28 : cyc = shallowconcat(cyc, gel(sgnU,1));
2293 28 : qm = vconcat(qm, gel(sgnU,2));
2294 28 : z = itou( mului(h, ZM_det_triangular(ZM_hnfmodid(qm, cyc))) );
2295 28 : set_avma(av);
2296 28 : gel(L,j) = mkvec2(gel(b,1), mkvecsmall(z));
2297 : }
2298 28 : return L;
2299 : }
2300 :
2301 : static void
2302 1344 : vecselect_p(GEN A, GEN B, GEN p, long init, long lB)
2303 : {
2304 1344 : long i; setlg(B, lB);
2305 2688 : for (i=init; i<lB; i++) B[i] = A[p[i]];
2306 1344 : }
2307 : /* B := p . A = row selection according to permutation p. Treat only lower
2308 : * right corner init x init */
2309 : static void
2310 1022 : rowselect_p(GEN A, GEN B, GEN p, long init)
2311 : {
2312 1022 : long i, lB = lg(A), lp = lg(p);
2313 2436 : for (i=1; i<init; i++) setlg(B[i],lp);
2314 2366 : for ( ; i<lB; i++) vecselect_p(gel(A,i),gel(B,i),p,init,lp);
2315 1022 : }
2316 : static ulong
2317 1022 : hdet(ulong h, GEN m)
2318 : {
2319 1022 : pari_sp av = avma;
2320 1022 : GEN z = mului(h, ZM_det_triangular(ZM_hnf(m)));
2321 1022 : return gc_ulong(av, itou(z));
2322 : }
2323 : static GEN
2324 1106 : bnrclassno_all(GEN B, ulong h, GEN sgnU)
2325 : {
2326 : long lx, k, kk, j, r1, jj, nba, nbarch;
2327 : GEN _2, L, m, H, mm, rowsel;
2328 :
2329 1106 : if (typ(sgnU) == t_VEC) return bnrclassno_1(B,h,sgnU);
2330 1078 : lx = lg(B); if (lx == 1) return B;
2331 :
2332 371 : r1 = nbrows(sgnU); _2 = const_vec(r1, gen_2);
2333 371 : L = cgetg(lx,t_VEC); nbarch = 1L<<r1;
2334 889 : for (j=1; j<lx; j++)
2335 : {
2336 518 : pari_sp av = avma;
2337 518 : GEN b = gel(B,j), cyc = gel(b,2), qm = gel(b,3);
2338 518 : long nc = lg(cyc)-1;
2339 : /* [ qm cyc 0 ]
2340 : * [ sgnU 0 2 ] */
2341 518 : m = ZM_hnfmodid(vconcat(qm, sgnU), shallowconcat(cyc,_2));
2342 518 : mm = RgM_shallowcopy(m);
2343 518 : rowsel = cgetg(nc+r1+1,t_VECSMALL);
2344 518 : H = cgetg(nbarch+1,t_VECSMALL);
2345 1540 : for (k = 0; k < nbarch; k++)
2346 : {
2347 1022 : nba = nc+1;
2348 2366 : for (kk=k,jj=1; jj<=r1; jj++,kk>>=1)
2349 1344 : if (kk&1) rowsel[nba++] = nc + jj;
2350 1022 : setlg(rowsel, nba);
2351 1022 : rowselect_p(m, mm, rowsel, nc+1);
2352 1022 : H[k+1] = hdet(h, mm);
2353 : }
2354 518 : H = gc_uptoleaf(av, H);
2355 518 : gel(L,j) = mkvec2(gel(b,1), H);
2356 : }
2357 371 : return L;
2358 : }
2359 :
2360 : static int
2361 21 : is_module(GEN v)
2362 : {
2363 21 : if (lg(v) != 3 || (typ(v) != t_MAT && typ(v) != t_VEC)) return 0;
2364 21 : return typ(gel(v,1)) == t_VECSMALL && typ(gel(v,2)) == t_VECSMALL;
2365 : }
2366 : GEN
2367 21 : decodemodule(GEN nf, GEN fa)
2368 : {
2369 : long n, nn, k;
2370 21 : pari_sp av = avma;
2371 : GEN G, E, id, pr;
2372 :
2373 21 : nf = checknf(nf);
2374 21 : if (!is_module(fa)) pari_err_TYPE("decodemodule [not a factorization]", fa);
2375 21 : n = nf_get_degree(nf); nn = n*n; id = NULL;
2376 21 : G = gel(fa,1);
2377 21 : E = gel(fa,2);
2378 35 : for (k=1; k<lg(G); k++)
2379 : {
2380 14 : long code = G[k], p = code / nn, j = (code%n)+1;
2381 14 : GEN P = idealprimedec(nf, utoipos(p)), e = stoi(E[k]);
2382 14 : if (lg(P) <= j) pari_err_BUG("decodemodule [incorrect hash code]");
2383 14 : pr = gel(P,j);
2384 14 : id = id? idealmulpowprime(nf,id, pr,e)
2385 14 : : idealpow(nf, pr,e);
2386 : }
2387 21 : if (!id) { set_avma(av); return matid(n); }
2388 14 : return gc_upto(av,id);
2389 : }
2390 :
2391 : /* List of ray class fields. Do all from scratch, bound < 2^30. No subgroups.
2392 : *
2393 : * Output: a vector V, V[k] contains the ideals of norm k. Given such an ideal
2394 : * m, the component is as follows:
2395 : *
2396 : * + if arch = NULL, run through all possible archimedean parts; archs are
2397 : * ordered using inverse lexicographic order, [0,..,0], [1,0,..,0], [0,1,..,0],
2398 : * Component is [m,V] where V is a vector with 2^r1 entries, giving for each
2399 : * arch the triple [N,R1,D], with N, R1, D as in discrayabs; D is in factored
2400 : * form.
2401 : *
2402 : * + otherwise [m,N,R1,D] */
2403 : GEN
2404 28 : discrayabslistarch(GEN bnf, GEN arch, ulong bound)
2405 : {
2406 28 : int allarch = (arch==NULL), flbou = 0;
2407 : long degk, j, k, l, nba, nbarch, r1, c, sqbou;
2408 28 : pari_sp av0 = avma, av, av1;
2409 : GEN nf, p, Z, fa, Disc, U, sgnU, EMPTY, empty, archp;
2410 : GEN res, Ray, discall, idealrel, idealrelinit, fadkabs, BOUND;
2411 : ulong i, h;
2412 : forprime_t S;
2413 :
2414 28 : if (bound == 0)
2415 0 : pari_err_DOMAIN("discrayabslistarch","bound","==",gen_0,utoi(bound));
2416 28 : res = discall = NULL; /* -Wall */
2417 :
2418 28 : bnf = checkbnf(bnf);
2419 28 : nf = bnf_get_nf(bnf);
2420 28 : r1 = nf_get_r1(nf);
2421 28 : degk = nf_get_degree(nf);
2422 28 : fadkabs = absZ_factor(nf_get_disc(nf));
2423 28 : h = itou(bnf_get_no(bnf));
2424 :
2425 28 : if (allarch)
2426 : {
2427 21 : if (r1>15) pari_err_IMPL("r1>15 in discrayabslistarch");
2428 21 : arch = const_vec(r1, gen_1);
2429 : }
2430 7 : else if (lg(arch)-1 != r1)
2431 0 : pari_err_TYPE("Idealstar [incorrect archimedean component]",arch);
2432 28 : U = log_prk_units_init(bnf);
2433 28 : archp = vec01_to_indices(arch);
2434 28 : nba = lg(archp)-1;
2435 28 : sgnU = zm_to_ZM( nfsign_units(bnf, archp, 1) );
2436 28 : if (!allarch) sgnU = mkvec2(const_vec(nba,gen_2), sgnU);
2437 :
2438 28 : empty = cgetg(1,t_VEC);
2439 : /* what follows was rewritten from Ideallist */
2440 28 : BOUND = utoipos(bound);
2441 28 : p = cgetipos(3);
2442 28 : u_forprime_init(&S, 2, bound);
2443 28 : av = avma;
2444 28 : sqbou = (long)sqrt((double)bound) + 1;
2445 28 : Z = const_vec(bound, empty);
2446 28 : gel(Z,1) = mkvec(zsimp());
2447 28 : if (DEBUGLEVEL>1) err_printf("Starting zidealstarunits computations\n");
2448 : /* The goal is to compute Ray (lists of bnrclassno). Z contains "zsimps",
2449 : * simplified bid, from which bnrclassno is easy to compute.
2450 : * Once p > sqbou, delete Z[i] for i > sqbou and compute directly Ray */
2451 28 : Ray = Z;
2452 294 : while ((p[2] = u_forprime_next(&S)))
2453 : {
2454 266 : if (!flbou && p[2] > sqbou)
2455 : {
2456 21 : flbou = 1;
2457 21 : if (DEBUGLEVEL>1) err_printf("\nStarting bnrclassno computations\n");
2458 21 : Z = gc_GEN(av,Z);
2459 21 : Ray = cgetg(bound+1, t_VEC);
2460 889 : for (i=1; i<=bound; i++) gel(Ray,i) = bnrclassno_all(gel(Z,i),h,sgnU);
2461 21 : Z = vecslice(Z, 1, sqbou);
2462 : }
2463 266 : fa = idealprimedec_limit_norm(nf,p,BOUND);
2464 504 : for (j=1; j<lg(fa); j++)
2465 : {
2466 238 : GEN pr = gel(fa,j);
2467 238 : long prcode, f = pr_get_f(pr);
2468 238 : ulong q, Q = upowuu(p[2], f);
2469 :
2470 : /* p, f-1, j-1 as a single integer in "base degk" (f,j <= degk)*/
2471 238 : prcode = (p[2]*degk + f-1)*degk + j-1;
2472 238 : q = Q;
2473 : /* FIXME: if Q = 2, should start at l = 2 */
2474 238 : for (l = 1;; l++) /* Q <= bound */
2475 105 : {
2476 : ulong iQ;
2477 343 : GEN sprk = log_prk_init(nf, pr, l, NULL);
2478 343 : GEN U_pr = log_prk_units(nf, U, sprk);
2479 1582 : for (iQ = Q, i = 1; iQ <= bound; iQ += Q, i++)
2480 : {
2481 1239 : GEN pz, p2, p1 = gel(Z,i);
2482 1239 : long lz = lg(p1);
2483 1239 : if (lz == 1) continue;
2484 :
2485 595 : p2 = cgetg(lz,t_VEC); c = 0;
2486 1113 : for (k=1; k<lz; k++)
2487 : {
2488 658 : GEN z = gel(p1,k), v = gmael(z,1,1); /* primes in zsimp's fact. */
2489 658 : long lv = lg(v);
2490 : /* If z has a power of pr in its modulus, skip it */
2491 658 : if (i != 1 && lv > 1 && v[lv-1] == prcode) break;
2492 518 : gel(p2,++c) = zsimpjoin(z,sprk,U_pr,prcode,l);
2493 : }
2494 595 : setlg(p2, c+1);
2495 595 : pz = gel(Ray,iQ);
2496 595 : if (flbou) p2 = bnrclassno_all(p2,h,sgnU);
2497 595 : if (lg(pz) > 1) p2 = shallowconcat(pz,p2);
2498 595 : gel(Ray,iQ) = p2;
2499 : }
2500 343 : Q = itou_or_0( muluu(Q, q) );
2501 343 : if (!Q || Q > bound) break;
2502 : }
2503 : }
2504 266 : if (gc_needed(av,1))
2505 : {
2506 0 : if(DEBUGMEM>1) pari_warn(warnmem,"[1]: discrayabslistarch");
2507 0 : (void)gc_all(av, flbou? 2: 1, &Z, &Ray);
2508 : }
2509 : }
2510 28 : if (!flbou) /* occurs iff bound = 1,2,4 */
2511 : {
2512 7 : if (DEBUGLEVEL>1) err_printf("\nStarting bnrclassno computations\n");
2513 7 : Ray = cgetg(bound+1, t_VEC);
2514 35 : for (i=1; i<=bound; i++) gel(Ray,i) = bnrclassno_all(gel(Z,i),h,sgnU);
2515 : }
2516 28 : Ray = gc_GEN(av, Ray);
2517 :
2518 28 : if (DEBUGLEVEL>1) err_printf("Starting discrayabs computations\n");
2519 28 : if (allarch) nbarch = 1L<<r1;
2520 : else
2521 : {
2522 7 : nbarch = 1;
2523 7 : discall = cgetg(2,t_VEC);
2524 : }
2525 28 : EMPTY = mkvec3(gen_0,gen_0,gen_0);
2526 28 : idealrelinit = trivial_fact();
2527 28 : av1 = avma;
2528 28 : Disc = const_vec(bound, empty);
2529 924 : for (i=1; i<=bound; i++)
2530 : {
2531 896 : GEN sousdisc, sous = gel(Ray,i);
2532 896 : long ls = lg(sous);
2533 896 : gel(Disc,i) = sousdisc = cgetg(ls,t_VEC);
2534 1442 : for (j=1; j<ls; j++)
2535 : {
2536 546 : GEN b = gel(sous,j), clhrayall = gel(b,2), Fa = gel(b,1);
2537 546 : GEN P = gel(Fa,1), E = gel(Fa,2);
2538 546 : long lP = lg(P), karch;
2539 :
2540 546 : if (allarch) discall = cgetg(nbarch+1,t_VEC);
2541 1596 : for (karch=0; karch<nbarch; karch++)
2542 : {
2543 1050 : long nz, clhray = clhrayall[karch+1];
2544 1050 : if (allarch)
2545 : {
2546 : long ka, k2;
2547 1022 : nba = 0;
2548 2366 : for (ka=karch,k=1; k<=r1; k++,ka>>=1)
2549 1344 : if (ka & 1) nba++;
2550 1918 : for (k2=1,k=1; k<=r1; k++,k2<<=1)
2551 1190 : if (karch&k2 && clhrayall[karch-k2+1] == clhray)
2552 294 : { res = EMPTY; goto STORE; }
2553 : }
2554 756 : idealrel = idealrelinit;
2555 1078 : for (k=1; k<lP; k++) /* cf get_discray */
2556 : {
2557 805 : long e, ep = E[k], pf = P[k] / degk, f = (pf%degk) + 1, S = 0;
2558 805 : ulong normi = i, Npr;
2559 805 : p = utoipos(pf / degk);
2560 805 : Npr = upowuu(p[2],f);
2561 1204 : for (e=1; e<=ep; e++)
2562 : {
2563 : long clhss;
2564 : GEN fad;
2565 910 : if (e < ep) { E[k] = ep-e; fad = Fa; }
2566 707 : else fad = factorsplice(Fa, k);
2567 910 : normi /= Npr;
2568 910 : clhss = Lbnrclassno(gel(Ray,normi),fad)[karch+1];
2569 910 : if (e==1 && clhss==clhray) { E[k] = ep; res = EMPTY; goto STORE; }
2570 427 : if (clhss == 1) { S += ep-e+1; break; }
2571 399 : S += clhss;
2572 : }
2573 322 : E[k] = ep;
2574 322 : idealrel = factormul(idealrel, to_famat_shallow(p, utoi(f * S)));
2575 : }
2576 273 : if (!allarch && nba)
2577 14 : nz = get_nz(bnf, decodemodule(nf,Fa), arch, clhray);
2578 : else
2579 259 : nz = r1 - nba;
2580 273 : res = get_NR1D(i, clhray, degk, nz, fadkabs, idealrel);
2581 1050 : STORE: gel(discall,karch+1) = res;
2582 : }
2583 518 : res = allarch? mkvec2(Fa, discall)
2584 546 : : mkvec4(Fa, gel(res,1), gel(res,2), gel(res,3));
2585 546 : gel(sousdisc,j) = res;
2586 546 : if (gc_needed(av1,1))
2587 : {
2588 : long jj;
2589 0 : if(DEBUGMEM>1) pari_warn(warnmem,"[2]: discrayabslistarch");
2590 0 : for (jj=j+1; jj<ls; jj++) gel(sousdisc,jj) = gen_0; /* dummy */
2591 0 : Disc = gc_GEN(av1, Disc);
2592 0 : sousdisc = gel(Disc,i);
2593 : }
2594 : }
2595 : }
2596 28 : return gc_GEN(av0, Disc);
2597 : }
2598 :
2599 : int
2600 95213 : subgroup_conductor_ok(GEN H, GEN L)
2601 : { /* test conductor */
2602 95213 : long i, l = lg(L);
2603 222396 : for (i = 1; i < l; i++)
2604 180683 : if ( hnf_solve(H, gel(L,i)) ) return 0;
2605 41713 : return 1;
2606 : }
2607 : static GEN
2608 183017 : conductor_elts(GEN bnr)
2609 : {
2610 : long le, la, i, k;
2611 : GEN e, L;
2612 : zlog_S S;
2613 :
2614 183017 : if (!bnrisconductor(bnr, NULL)) return NULL;
2615 56324 : init_zlog(&S, bnr_get_bid(bnr));
2616 56328 : e = S.k; le = lg(e); la = lg(S.archp);
2617 56328 : L = cgetg(le + la - 1, t_VEC);
2618 56328 : i = 1;
2619 129587 : for (k = 1; k < le; k++)
2620 73259 : gel(L,i++) = bnr_log_gen_pr(bnr, &S, itos(gel(e,k)), k);
2621 78957 : for (k = 1; k < la; k++)
2622 22628 : gel(L,i++) = bnr_log_gen_arch(bnr, &S, k);
2623 56329 : return L;
2624 : }
2625 :
2626 : /* Let C a congruence group in bnr, compute its subgroups whose index is
2627 : * described by bound (see subgrouplist) as subgroups of Clk(bnr).
2628 : * Restrict to subgroups having the same conductor as bnr */
2629 : GEN
2630 455 : subgrouplist_cond_sub(GEN bnr, GEN C, GEN bound)
2631 : {
2632 455 : pari_sp av = avma;
2633 : long l, i, j;
2634 455 : GEN D, Mr, U, T, subgrp, L, cyc = bnr_get_cyc(bnr);
2635 :
2636 455 : L = conductor_elts(bnr); if (!L) return cgetg(1,t_VEC);
2637 455 : Mr = diagonal_shallow(cyc);
2638 455 : D = ZM_snfall_i(hnf_solve(C, Mr), &U, NULL, 1);
2639 455 : T = ZM_mul(C, RgM_inv(U));
2640 455 : subgrp = subgrouplist(D, bound);
2641 455 : l = lg(subgrp);
2642 966 : for (i = j = 1; i < l; i++)
2643 : {
2644 511 : GEN H = ZM_hnfmodid(ZM_mul(T, gel(subgrp,i)), cyc);
2645 511 : if (subgroup_conductor_ok(H, L)) gel(subgrp, j++) = H;
2646 : }
2647 455 : setlg(subgrp, j);
2648 455 : return gc_GEN(av, subgrp);
2649 : }
2650 :
2651 : static GEN
2652 182562 : subgroupcond(GEN bnr, GEN indexbound)
2653 : {
2654 182562 : pari_sp av = avma;
2655 182562 : GEN L = conductor_elts(bnr);
2656 :
2657 182551 : if (!L) return cgetg(1, t_VEC);
2658 55865 : L = subgroupcondlist(bnr_get_cyc(bnr), indexbound, L);
2659 55873 : if (indexbound && typ(indexbound) != t_VEC)
2660 : { /* sort by increasing index if not single value */
2661 14 : long i, l = lg(L);
2662 14 : GEN D = cgetg(l,t_VEC);
2663 245 : for (i=1; i<l; i++) gel(D,i) = ZM_det_triangular(gel(L,i));
2664 14 : L = vecreverse( vecpermute(L, indexsort(D)) );
2665 : }
2666 55873 : return gc_GEN(av, L);
2667 : }
2668 :
2669 : GEN
2670 184771 : subgrouplist0(GEN cyc, GEN indexbound, long all)
2671 : {
2672 184771 : if (!all && checkbnr_i(cyc)) return subgroupcond(cyc,indexbound);
2673 2205 : if (typ(cyc) != t_VEC || !RgV_is_ZV(cyc)) cyc = member_cyc(cyc);
2674 2198 : return subgrouplist(cyc,indexbound);
2675 : }
2676 :
2677 : GEN
2678 49 : bnrdisclist0(GEN bnf, GEN L, GEN arch)
2679 : {
2680 49 : if (typ(L)!=t_INT) return discrayabslist(bnf,L);
2681 28 : return discrayabslistarch(bnf,arch,itos(L));
2682 : }
2683 :
2684 : /****************************************************************************/
2685 : /* Galois action on a BNR */
2686 : /****************************************************************************/
2687 : GEN
2688 3094 : bnrautmatrix(GEN bnr, GEN aut)
2689 : {
2690 3094 : pari_sp av = avma;
2691 3094 : GEN bnf = bnr_get_bnf(bnr), nf = bnf_get_nf(bnf), bid = bnr_get_bid(bnr);
2692 3094 : GEN M, Gen = get_Gen(bnf, bid, bnr_get_El(bnr)), cyc = bnr_get_cyc(bnr);
2693 3094 : long i, l = lg(Gen);
2694 :
2695 3094 : M = cgetg(l, t_MAT); aut = nfgaloismatrix(nf, aut);
2696 : /* Gen = clg.gen*U, clg.gen = Gen*Ui */
2697 11676 : for (i = 1; i < l; i++)
2698 8582 : gel(M,i) = isprincipalray(bnr, nfgaloismatrixapply(nf, aut, gel(Gen,i)));
2699 3094 : M = ZM_mul(M, bnr_get_Ui(bnr));
2700 3094 : return gc_GEN(av, ZM_ZV_mod(M, cyc));
2701 : }
2702 :
2703 : GEN
2704 231 : bnrgaloismatrix(GEN bnr, GEN aut)
2705 : {
2706 231 : checkbnr(bnr);
2707 231 : switch (typ(aut))
2708 : {
2709 0 : case t_POL:
2710 : case t_COL:
2711 0 : return bnrautmatrix(bnr, aut);
2712 231 : case t_VEC:
2713 : {
2714 231 : pari_sp av = avma;
2715 231 : long i, l = lg(aut);
2716 : GEN v;
2717 231 : if (l == 9)
2718 : {
2719 7 : GEN g = gal_get_gen(aut);
2720 7 : if (typ(g) == t_VEC) { aut = galoispermtopol(aut, g); l = lg(aut); }
2721 : }
2722 231 : v = cgetg(l, t_VEC);
2723 693 : for(i = 1; i < l; i++) gel(v,i) = bnrautmatrix(bnr, gel(aut,i));
2724 231 : return gc_upto(av, v);
2725 : }
2726 0 : default:
2727 0 : pari_err_TYPE("bnrgaloismatrix", aut);
2728 : return NULL; /*LCOV_EXCL_LINE*/
2729 : }
2730 : }
2731 :
2732 : GEN
2733 3577 : bnrgaloisapply(GEN bnr, GEN mat, GEN x)
2734 : {
2735 3577 : pari_sp av=avma;
2736 : GEN cyc;
2737 3577 : checkbnr(bnr);
2738 3577 : cyc = bnr_get_cyc(bnr);
2739 3577 : if (typ(mat)!=t_MAT || !RgM_is_ZM(mat))
2740 0 : pari_err_TYPE("bnrgaloisapply",mat);
2741 3577 : if (typ(x)!=t_MAT || !RgM_is_ZM(x))
2742 0 : pari_err_TYPE("bnrgaloisapply",x);
2743 3577 : return gc_upto(av, ZM_hnfmodid(ZM_mul(mat, x), cyc));
2744 : }
2745 :
2746 : static GEN
2747 448 : check_bnrgal(GEN bnr, GEN M)
2748 : {
2749 448 : checkbnr(bnr);
2750 448 : if (typ(M)==t_MAT)
2751 0 : return mkvec(M);
2752 448 : else if (typ(M)==t_VEC && lg(M)==9 && typ(gal_get_gen(M))==t_VEC)
2753 : {
2754 224 : pari_sp av = avma;
2755 224 : GEN V = galoispermtopol(M, gal_get_gen(M));
2756 224 : return gc_upto(av, bnrgaloismatrix(bnr, V));
2757 : }
2758 224 : else if (!is_vec_t(typ(M)))
2759 0 : pari_err_TYPE("bnrisgalois",M);
2760 224 : return M;
2761 : }
2762 :
2763 : long
2764 448 : bnrisgalois(GEN bnr, GEN M, GEN H)
2765 : {
2766 448 : pari_sp av = avma;
2767 : long i, l;
2768 448 : if (typ(H)!=t_MAT || !RgM_is_ZM(H))
2769 0 : pari_err_TYPE("bnrisgalois",H);
2770 448 : M = check_bnrgal(bnr, M); l = lg(M);
2771 616 : for (i=1; i<l; i++)
2772 : {
2773 560 : long res = ZM_equal(bnrgaloisapply(bnr,gel(M,i), H), H);
2774 560 : if (!res) return gc_long(av,0);
2775 : }
2776 56 : return gc_long(av,1);
2777 : }
2778 :
2779 : static GEN
2780 14 : bnrlcmcond(GEN bnr1, GEN bnr2)
2781 : {
2782 14 : GEN I1 = bnr_get_bid(bnr1), f1 = bid_get_fact(I1), a1 = bid_get_arch(I1);
2783 14 : GEN I2 = bnr_get_bid(bnr2), f2 = bid_get_fact(I2), a2 = bid_get_arch(I2);
2784 : GEN f, a;
2785 : long i, l;
2786 14 : if (!gidentical(bnr_get_nf(bnr1), bnr_get_nf(bnr2)))
2787 0 : pari_err_TYPE("bnrcompositum[different fields]", mkvec2(bnr1,bnr2));
2788 14 : f = merge_factor(f1, f2, (void*)&cmp_prime_ideal, &cmp_nodata);
2789 14 : a = cgetg_copy(a1, &l);
2790 28 : for (i = 1; i < l; i++)
2791 14 : gel(a,i) = (signe(gel(a1,i)) || signe(gel(a2,i)))? gen_1: gen_0;
2792 14 : return mkvec2(f, a);
2793 : }
2794 : /* H subgroup (of bnr.clgp) in HNF; lift to BNR */
2795 : static GEN
2796 28 : bnrliftsubgroup(GEN BNR, GEN bnr, GEN H)
2797 : {
2798 28 : GEN E = gel(bnrsurjection(BNR, bnr), 1), K = kerint(shallowconcat(E, H));
2799 28 : return ZM_hnfmodid(rowslice(K, 1, lg(E)-1), bnr_get_cyc(BNR));
2800 : }
2801 : static GEN
2802 14 : ZM_intersect(GEN A, GEN B)
2803 : {
2804 14 : GEN K = kerint(shallowconcat(A, B));
2805 14 : return ZM_mul(A, rowslice(K, 1, lg(A)-1));
2806 : }
2807 : GEN
2808 14 : bnrcompositum(GEN fH1, GEN fH2)
2809 : {
2810 14 : pari_sp av = avma;
2811 : GEN bnr1, bnr2, bnr, H1, H2, H, n1, n2;
2812 14 : if (typ(fH1) != t_VEC || lg(fH2) != 3) pari_err_TYPE("bnrcompositum", fH1);
2813 14 : if (typ(fH2) != t_VEC || lg(fH2) != 3) pari_err_TYPE("bnrcompositum", fH2);
2814 14 : bnr1 = gel(fH1,1); if (!checkbnr_i(bnr1)) pari_err_TYPE("bnrcompositum",bnr1);
2815 14 : bnr2 = gel(fH2,1); if (!checkbnr_i(bnr2)) pari_err_TYPE("bnrcompositum",bnr2);
2816 14 : H1 = bnr_subgroup_check(bnr1, gel(fH1,2), &n1);
2817 14 : if (!H1) H1 = diagonal_shallow(bnr_get_cyc(bnr1));
2818 14 : H2 = bnr_subgroup_check(bnr2, gel(fH2,2), &n2);
2819 14 : if (!H2) H2 = diagonal_shallow(bnr_get_cyc(bnr2));
2820 14 : bnr = bnrinitmod(bnr_get_bnf(bnr1), bnrlcmcond(bnr1, bnr2), 0, lcmii(n1,n2));
2821 14 : H1 = bnrliftsubgroup(bnr, bnr1, H1);
2822 14 : H2 = bnrliftsubgroup(bnr, bnr2, H2);
2823 14 : H = ZM_intersect(H1, H2);
2824 14 : return gc_GEN(av, mkvec2(bnr, ZM_hnfmodid(H, bnr_get_cyc(bnr))));
2825 : }
|
