Line data Source code
1 : /* Copyright (C) 2015 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 : /** L-functions: Applications **/
18 : /** **/
19 : /********************************************************************/
20 :
21 : #include "pari.h"
22 : #include "paripriv.h"
23 :
24 : #define DEBUGLEVEL DEBUGLEVEL_lfun
25 :
26 : static GEN
27 22600 : tag(GEN x, long t) { return mkvec2(mkvecsmall(t), x); }
28 :
29 : /* v a t_VEC of length > 1 */
30 : static int
31 91492 : is_tagged(GEN v)
32 : {
33 91492 : GEN T = gel(v,1);
34 91492 : return (typ(T)==t_VEC && lg(T)==3 && typ(gel(T,1))==t_VECSMALL);
35 : }
36 : /* rough check */
37 : static long
38 109946 : is_ldata(GEN L)
39 : {
40 109946 : long l = lg(L);
41 109946 : return typ(L) == t_VEC && (l == 7 || l == 8);
42 : }
43 : /* thorough check */
44 : static void
45 91396 : checkldata(GEN ldata)
46 : {
47 : GEN vga, w, N;
48 : #if 0 /* assumed already checked and true */
49 : if (!is_ldata(ldata) || !is_tagged(ldata)) pari_err_TYPE("checkldata", ldata);
50 : #endif
51 91396 : vga = ldata_get_gammavec(ldata);
52 91396 : if (typ(vga) != t_VEC) pari_err_TYPE("checkldata [gammavec]",vga);
53 91396 : w = gel(ldata, 4); /* FIXME */
54 91396 : switch(typ(w))
55 : {
56 89598 : case t_INT: case t_FRAC: break;
57 1798 : case t_VEC: if (lg(w) == 3 && is_rational_t(typ(gel(w,1)))) break;
58 0 : default: pari_err_TYPE("checkldata [weight]",w);
59 : }
60 91396 : N = ldata_get_conductor(ldata);
61 91396 : if (gsigne(N) <= 0) pari_err_TYPE("checkldata [conductor]",N);
62 91396 : }
63 :
64 : /* tag as t_LFUN_GENERIC */
65 : static void
66 540 : lfuncreate_tag(GEN L)
67 : {
68 540 : if (is_tagged(L)) return;
69 396 : gel(L,1) = tag(gel(L,1), t_LFUN_GENERIC);
70 396 : if (typ(gel(L,2)) != t_INT) gel(L,2) = tag(gel(L,2), t_LFUN_GENERIC);
71 : }
72 :
73 : /* shallow */
74 : static GEN
75 156 : closure2ldata(GEN C, long prec)
76 : {
77 156 : GEN L = closure_callgen0prec(C, prec);
78 156 : if (is_ldata(L)) { checkldata(L); lfuncreate_tag(L); }
79 48 : else L = lfunmisc_to_ldata_shallow(L);
80 156 : return L;
81 : }
82 :
83 : /* data may be either an object (polynomial, elliptic curve, etc...)
84 : * or a description vector [an,sd,Vga,k,conductor,rootno,{poles}]. */
85 : GEN
86 3468 : lfuncreate(GEN data)
87 : {
88 3468 : if (is_ldata(data))
89 : {
90 432 : GEN L = gcopy(data);
91 432 : lfuncreate_tag(L); checkldata(L); return L;
92 : }
93 3036 : if (typ(data) == t_CLOSURE && closure_arity(data)==0)
94 : {
95 18 : pari_sp av = avma;
96 18 : GEN L = closure2ldata(data, DEFAULTPREC);
97 18 : gel(L,1) = tag(data, t_LFUN_CLOSURE0); return gc_GEN(av, L);
98 : }
99 3018 : return lfunmisc_to_ldata(data);
100 : }
101 :
102 : GEN
103 114 : lfunparams(GEN L, long prec)
104 : {
105 114 : pari_sp av = avma;
106 : GEN k, N, v;
107 : long p;
108 :
109 114 : if (!is_ldata(L) || !is_tagged(L)) L = lfunmisc_to_ldata_shallow(L);
110 114 : N = ldata_get_conductor(L);
111 114 : k = ldata_get_k(L);
112 114 : v = ldata_get_gammavec(L);
113 114 : p = gprecision(v);
114 114 : if (p > prec) v = gprec_wtrunc(v, prec);
115 114 : else if (p < prec)
116 : {
117 114 : GEN van = ldata_get_an(L), an = gel(van,2);
118 114 : long t = mael(van,1,1);
119 114 : if (t == t_LFUN_CLOSURE0) L = closure2ldata(an, prec);
120 : }
121 114 : return gc_GEN(av, mkvec3(N, k, v));
122 : }
123 :
124 : /********************************************************************/
125 : /** Simple constructors **/
126 : /********************************************************************/
127 : static GEN ldata_eulerf(GEN van, GEN p, long prec);
128 :
129 : static GEN
130 108 : vecan_conj(GEN an, long n, long prec)
131 : {
132 108 : GEN p1 = ldata_vecan(gel(an,1), n, prec);
133 108 : return typ(p1) == t_VEC? conj_i(p1): p1;
134 : }
135 :
136 : static GEN
137 0 : eulerf_conj(GEN an, GEN p, long prec)
138 : {
139 0 : GEN p1 = ldata_eulerf(gel(an,1), p, prec);
140 0 : return conj_i(p1);
141 : }
142 :
143 : static GEN
144 354 : vecan_mul(GEN an, long n, long prec)
145 : {
146 354 : GEN p1 = ldata_vecan(gel(an,1), n, prec);
147 354 : GEN p2 = ldata_vecan(gel(an,2), n, prec);
148 354 : if (typ(p1) == t_VECSMALL) p1 = vecsmall_to_vec(p1);
149 354 : if (typ(p2) == t_VECSMALL) p2 = vecsmall_to_vec(p2);
150 354 : return dirmul(p1, p2);
151 : }
152 :
153 : static GEN
154 36 : eulerf_mul(GEN an, GEN p, long prec)
155 : {
156 36 : GEN p1 = ldata_eulerf(gel(an,1), p, prec);
157 36 : GEN p2 = ldata_eulerf(gel(an,2), p, prec);
158 36 : return gmul(p1, p2);
159 : }
160 :
161 : static GEN
162 72 : lfunconvol(GEN a1, GEN a2)
163 72 : { return tag(mkvec2(a1, a2), t_LFUN_MUL); }
164 :
165 : static GEN
166 540 : vecan_div(GEN an, long n, long prec)
167 : {
168 540 : GEN p1 = ldata_vecan(gel(an,1), n, prec);
169 540 : GEN p2 = ldata_vecan(gel(an,2), n, prec);
170 540 : if (typ(p1) == t_VECSMALL) p1 = vecsmall_to_vec(p1);
171 540 : if (typ(p2) == t_VECSMALL) p2 = vecsmall_to_vec(p2);
172 540 : return dirdiv(p1, p2);
173 : }
174 :
175 : static GEN
176 12 : eulerf_div(GEN an, GEN p, long prec)
177 : {
178 12 : GEN p1 = ldata_eulerf(gel(an,1), p, prec);
179 12 : GEN p2 = ldata_eulerf(gel(an,2), p, prec);
180 12 : return gdiv(p1, p2);
181 : }
182 :
183 : static GEN
184 48 : lfunconvolinv(GEN a1, GEN a2)
185 48 : { return tag(mkvec2(a1,a2), t_LFUN_DIV); }
186 :
187 : static GEN
188 72 : lfunconj(GEN a1)
189 72 : { return tag(mkvec(a1), t_LFUN_CONJ); }
190 :
191 : static GEN
192 120 : lfuncombdual(GEN (*fun)(GEN, GEN), GEN ldata1, GEN ldata2)
193 : {
194 120 : GEN a1 = ldata_get_an(ldata1), a2 = ldata_get_an(ldata2);
195 120 : GEN b1 = ldata_get_dual(ldata1), b2 = ldata_get_dual(ldata2);
196 120 : if (typ(b1)==t_INT && typ(b2)==t_INT)
197 120 : return utoi(signe(b1) || signe(b2));
198 : else
199 : {
200 0 : if (typ(b1)==t_INT) b1 = signe(b1) ? lfunconj(a1): a1;
201 0 : if (typ(b2)==t_INT) b2 = signe(b2) ? lfunconj(a2): a2;
202 0 : return fun(b1, b2);
203 : }
204 : }
205 :
206 : static GEN
207 2472 : vecan_twist(GEN an, long n, long prec)
208 : {
209 2472 : GEN p1 = ldata_vecan(gel(an,1), n, prec);
210 2472 : GEN p2 = ldata_vecan(gel(an,2), n, prec);
211 : long i;
212 : GEN V;
213 2472 : if (typ(p1) == t_VECSMALL) p1 = vecsmall_to_vec(p1);
214 2472 : if (typ(p2) == t_VECSMALL) p2 = vecsmall_to_vec(p2);
215 2472 : V = cgetg(n+1, t_VEC);
216 1222086 : for(i = 1; i <= n ; i++)
217 1219614 : gel(V, i) = gmul(gel(p1, i), gel(p2, i));
218 2472 : return V;
219 : }
220 :
221 : static GEN
222 12 : eulerf_twist(GEN an, GEN p, long prec)
223 : {
224 12 : GEN p1 = ldata_eulerf(gel(an,1), p, prec);
225 12 : GEN p2 = ginv(ldata_eulerf(gel(an,2), p, prec));
226 12 : if (typ(p2)!=t_POL || degpol(p2)==0)
227 0 : return poleval(p1,pol_0(0));
228 12 : if (degpol(p2)!=1) pari_err_IMPL("lfuneuler");
229 12 : return poleval(p1,monomial(gneg(gel(p2,3)),1,0));
230 : }
231 :
232 : static GEN
233 648 : vecan_shift(GEN an, long n, long prec)
234 : {
235 648 : GEN p1 = ldata_vecan(gel(an,1), n, prec);
236 648 : GEN s = gel(an,2);
237 : long i;
238 : GEN V;
239 648 : if (typ(p1) == t_VECSMALL) p1 = vecsmall_to_vec(p1);
240 648 : V = cgetg(n+1, t_VEC);
241 648 : if (typ(s)==t_INT)
242 : {
243 486 : if (equali1(s))
244 27300 : for(i = 1; i <= n ; i++)
245 : {
246 27000 : GEN gi = gel(p1, i);
247 27000 : gel(V, i) = gequal0(gi)? gi: gmulgu(gi, i);
248 : }
249 : else
250 3066 : for(i = 1; i <= n ; i++)
251 : {
252 2880 : GEN gi = gel(p1, i);
253 2880 : gel(V, i) = gequal0(gi)? gi: gmul(gi, powgi(utoi(i), s));
254 : }
255 : }
256 : else
257 : {
258 162 : GEN D = dirpowers(n, s, prec);
259 6042 : for(i = 1; i <= n ; i++)
260 5880 : gel(V, i) = gmul(gel(p1,i), gel(D,i));
261 : }
262 648 : return V;
263 : }
264 :
265 : static GEN
266 48 : eulerf_shift(GEN an, GEN p, long prec)
267 : {
268 48 : GEN p1 = ldata_eulerf(gel(an,1), p, prec);
269 48 : GEN s = gel(an,2);
270 48 : return gsubst(p1, 0, monomial(gpow(p, s, prec), 1, 0));
271 : }
272 :
273 : static GEN
274 72 : eulerf_hgm(GEN an, GEN p)
275 : {
276 72 : GEN H = gel(an,1), t = gel(an,2);
277 72 : if (typ(t)==t_VEC && lg(t)==3)
278 : {
279 24 : GEN L = gel(t,2);
280 24 : long i, l = lg(L);
281 24 : t = gel(t,1);
282 42 : for (i = 1; i < l; i++) /* wild primes */
283 30 : if (equalii(p, gmael(L, i, 1))) break;
284 24 : if (i<l) return gmael(L,i,2);
285 : }
286 60 : return ginv(hgmeulerfactor(H, t, itos(p), NULL));
287 : }
288 :
289 : static GEN
290 288 : deg1ser_shallow(GEN a1, GEN a0, long e)
291 288 : { return RgX_to_ser(deg1pol_shallow(a1, a0, 0), e+2); }
292 : /* lfunrtopoles without sort */
293 : static GEN
294 156 : rtopoles(GEN r)
295 : {
296 156 : long j, l = lg(r);
297 156 : GEN v = cgetg(l, t_VEC);
298 324 : for (j = 1; j < l; j++)
299 : {
300 168 : GEN rj = gel(r,j), a = gel(rj,1);
301 168 : gel(v,j) = a;
302 : }
303 156 : return v;
304 : }
305 : /* re = polar part; overestimate when re = gen_0 (unknown) */
306 : static long
307 240 : orderpole(GEN re) { return typ(re) == t_SER? -valser(re): 1; }
308 : static GEN
309 72 : lfunmulpoles(GEN ldata1, GEN ldata2, long bitprec)
310 : {
311 72 : GEN r, k = ldata_get_k(ldata1), b1 = NULL, b2 = NULL;
312 72 : GEN r1 = ldata_get_residue(ldata1);
313 72 : GEN r2 = ldata_get_residue(ldata2);
314 72 : long i, j, l, L = 0;
315 :
316 72 : if (!r1 && !r2) return NULL;
317 66 : if (r1 && !is_vec_t(typ(r1))) r1 = mkvec(mkvec2(k, r1));
318 66 : if (r2 && !is_vec_t(typ(r2))) r2 = mkvec(mkvec2(k, r2));
319 66 : if (r1) { b1 = rtopoles(r1); L += lg(b1); }
320 66 : if (r2) { b2 = rtopoles(r2); L += lg(b2); }
321 66 : r = cgetg(L, t_VEC); j = 1;
322 66 : if (b1)
323 : {
324 60 : l = lg(b1);
325 126 : for (i = 1; i < l; i++)
326 : {
327 66 : GEN z, z1, z2, be = gmael(r1,i,1);
328 66 : long n, v = orderpole(gmael(r1,i,2));
329 66 : if (b2 && (n = RgV_isin(b2, be))) v += orderpole(gmael(r2,n,2));
330 66 : z = deg1ser_shallow(gen_1, be, 2 + v);
331 66 : z1 = lfun(ldata1,z,bitprec);
332 66 : z2 = lfun(ldata2,z,bitprec);
333 66 : gel(r,j++) = mkvec2(be, gmul(z1, z2));
334 : }
335 : }
336 66 : if (b2)
337 : {
338 60 : long l = lg(b2);
339 126 : for (i = 1; i < l; i++)
340 : {
341 66 : GEN z, z1, z2, be = gmael(r2,i,1);
342 66 : long n, v = orderpole(gmael(r2,i,2));
343 66 : if (b1 && (n = RgV_isin(b1, be))) continue; /* done already */
344 30 : z = deg1ser_shallow(gen_1, be, 2 + v);
345 30 : z1 = lfun(ldata1,z,bitprec);
346 30 : z2 = lfun(ldata2,z,bitprec);
347 30 : gel(r,j++) = mkvec2(be, gmul(z1, z2));
348 : }
349 : }
350 66 : setlg(r, j); return r;
351 : }
352 :
353 : static GEN
354 72 : lfunmul_k(GEN ldata1, GEN ldata2, GEN k, long bitprec)
355 : {
356 : GEN r, N, Vga, eno, a1a2, b1b2;
357 72 : r = lfunmulpoles(ldata1, ldata2, bitprec);
358 72 : N = gmul(ldata_get_conductor(ldata1), ldata_get_conductor(ldata2));
359 72 : Vga = shallowconcat(ldata_get_gammavec(ldata1), ldata_get_gammavec(ldata2));
360 72 : Vga = sort(Vga);
361 72 : eno = gmul(ldata_get_rootno(ldata1), ldata_get_rootno(ldata2));
362 72 : a1a2 = lfunconvol(ldata_get_an(ldata1), ldata_get_an(ldata2));
363 72 : b1b2 = lfuncombdual(lfunconvol, ldata1, ldata2);
364 72 : return mkvecn(r? 7: 6, a1a2, b1b2, Vga, k, N, eno, r);
365 : }
366 :
367 : GEN
368 54 : lfunmul(GEN ldata1, GEN ldata2, long bitprec)
369 : {
370 54 : pari_sp ltop = avma;
371 : GEN k;
372 54 : long prec = nbits2prec(bitprec);
373 54 : ldata1 = ldata_newprec(lfunmisc_to_ldata_shallow(ldata1), prec);
374 54 : ldata2 = ldata_newprec(lfunmisc_to_ldata_shallow(ldata2), prec);
375 54 : k = ldata_get_k(ldata1);
376 54 : if (!gequal(ldata_get_k(ldata2),k))
377 0 : pari_err_OP("lfunmul [weight]",ldata1, ldata2);
378 54 : return gc_GEN(ltop, lfunmul_k(ldata1, ldata2, k, bitprec));
379 : }
380 :
381 : static GEN
382 48 : lfundivpoles(GEN ldata1, GEN ldata2, long bitprec)
383 : {
384 : long i, j, l;
385 48 : GEN be2, k = ldata_get_k(ldata1);
386 48 : GEN r1 = ldata_get_residue(ldata1);
387 48 : GEN r2 = ldata_get_residue(ldata2), r;
388 :
389 48 : if (r1 && !is_vec_t(typ(r1))) r1 = mkvec(mkvec2(k, r1));
390 48 : if (r2 && !is_vec_t(typ(r2))) r2 = mkvec(mkvec2(k, r2));
391 48 : if (!r1) return NULL;
392 48 : l = lg(r1); r = cgetg(l, t_VEC);
393 48 : be2 = r2? rtopoles(r2): NULL;
394 96 : for (i = j = 1; j < l; j++)
395 : {
396 48 : GEN z, v = gel(r1,j), be = gel(v,1), s1 = gel(v,2);
397 : long n;
398 48 : if (be2 && (n = RgV_isin(be2, be)))
399 : {
400 36 : GEN s2 = gmael(r2,n,2); /* s1,s2: polar parts */
401 36 : if (orderpole(s1) == orderpole(s2)) continue;
402 : }
403 12 : z = gdiv(lfun(ldata1,be,bitprec), lfun(ldata2,be,bitprec));
404 12 : if (valser(z) < 0) gel(r,i++) = mkvec2(be, z);
405 : }
406 48 : if (i == 1) return NULL;
407 12 : setlg(r, i); return r;
408 : }
409 :
410 : static GEN
411 48 : lfunvgasub(GEN v01, GEN v2)
412 : {
413 48 : GEN v1 = shallowcopy(v01), v;
414 48 : long l1 = lg(v1), l2 = lg(v2), j1, j2, j;
415 102 : for (j2 = 1; j2 < l2; j2++)
416 : {
417 78 : for (j1 = 1; j1 < l1; j1++)
418 78 : if (gel(v1,j1) && gequal(gel(v1,j1), gel(v2,j2)))
419 : {
420 54 : gel(v1,j1) = NULL; break;
421 : }
422 54 : if (j1 == l1) pari_err_OP("lfunvgasub", v1, v2);
423 : }
424 48 : v = cgetg(l1-l2+1, t_VEC);
425 222 : for (j1 = j = 1; j1 < l1; j1++)
426 174 : if (gel(v1, j1)) gel(v,j++) = gel(v1,j1);
427 48 : return v;
428 : }
429 :
430 : GEN
431 48 : lfundiv(GEN ldata1, GEN ldata2, long bitprec)
432 : {
433 48 : pari_sp ltop = avma;
434 : GEN k, r, N, v, eno, a1a2, b1b2, eno2;
435 48 : long prec = nbits2prec(bitprec);
436 48 : ldata1 = ldata_newprec(lfunmisc_to_ldata_shallow(ldata1), prec);
437 48 : ldata2 = ldata_newprec(lfunmisc_to_ldata_shallow(ldata2), prec);
438 48 : k = ldata_get_k(ldata1);
439 48 : if (!gequal(ldata_get_k(ldata2),k))
440 0 : pari_err_OP("lfundiv [weight]",ldata1, ldata2);
441 48 : N = gdiv(ldata_get_conductor(ldata1), ldata_get_conductor(ldata2));
442 48 : if (typ(N) != t_INT) pari_err_OP("lfundiv [conductor]",ldata1, ldata2);
443 48 : r = lfundivpoles(ldata1, ldata2, bitprec);
444 48 : a1a2 = lfunconvolinv(ldata_get_an(ldata1), ldata_get_an(ldata2));
445 48 : b1b2 = lfuncombdual(lfunconvolinv, ldata1, ldata2);
446 48 : eno2 = ldata_get_rootno(ldata2);
447 48 : eno = isintzero(eno2)? gen_0: gdiv(ldata_get_rootno(ldata1), eno2);
448 48 : v = lfunvgasub(ldata_get_gammavec(ldata1), ldata_get_gammavec(ldata2));
449 48 : return gc_GEN(ltop, mkvecn(r? 7: 6, a1a2, b1b2, v, k, N, eno, r));
450 : }
451 :
452 : static GEN
453 2052 : gamma_imagchi(GEN gam, GEN w)
454 : {
455 2052 : long i, j, k=1, l;
456 2052 : GEN g = cgetg_copy(gam, &l);
457 2052 : gam = shallowcopy(gam);
458 6156 : for (i = l-1; i>=1; i--)
459 : {
460 4104 : GEN al = gel(gam, i);
461 4104 : if (al)
462 : {
463 2058 : GEN N = gadd(w,gmul2n(real_i(al),1));
464 2058 : if (gcmpgs(N,2) > 0)
465 : {
466 2046 : GEN bl = gsubgs(al, 1);
467 2046 : for (j=1; j < i; j++)
468 2046 : if (gel(gam,j) && gequal(gel(gam,j), bl))
469 2046 : { gel(gam,j) = NULL; break; }
470 2046 : if (j==i) return NULL;
471 2046 : gel(g, k++) = al;
472 2046 : gel(g, k++) = bl;
473 12 : } else if (gequal0(N))
474 12 : gel(g, k++) = gaddgs(al, 1);
475 0 : else if (gequal1(N))
476 0 : gel(g, k++) = gsubgs(al, 1);
477 0 : else return NULL;
478 : }
479 : }
480 2052 : return sort(g);
481 : }
482 :
483 : GEN
484 4446 : lfuntwist(GEN ldata1, GEN chi, long bitprec)
485 : {
486 4446 : pari_sp ltop = avma;
487 : GEN k, L, N, N1, N2, a, a1, a2, b, b1, b2, gam, gam1, gam2;
488 : GEN ldata2;
489 : long d1, t;
490 4446 : long prec = nbits2prec(bitprec);
491 4446 : ldata1 = ldata_newprec(lfunmisc_to_ldata_shallow(ldata1), prec);
492 4446 : ldata2 = lfunmisc_to_ldata_shallow(chi);
493 4446 : t = ldata_get_type(ldata2);
494 4446 : a1 = ldata_get_an(ldata1);
495 4446 : a2 = ldata_get_an(ldata2);
496 4446 : if (t == t_LFUN_ZETA)
497 2076 : return gc_GEN(ltop, ldata1);
498 2370 : if (t != t_LFUN_CHIZ && t != t_LFUN_KRONECKER &&
499 6 : ( t != t_LFUN_CHIGEN || nf_get_degree(bnr_get_nf(gmael(a2,2,1))) != 1))
500 0 : pari_err_TYPE("lfuntwist", chi);
501 2370 : N1 = ldata_get_conductor(ldata1);
502 2370 : N2 = ldata_get_conductor(ldata2);
503 2370 : if (!gequal1(gcdii(N1, N2)))
504 0 : pari_err_IMPL("lfuntwist (conductors not coprime)");
505 2370 : k = ldata_get_k(ldata1);
506 2370 : d1 = ldata_get_degree(ldata1);
507 2370 : N = gmul(N1, gpowgs(N2, d1));
508 2370 : gam1 = ldata_get_gammavec(ldata1);
509 2370 : gam2 = ldata_get_gammavec(ldata2);
510 2370 : if (gequal0(gel(gam2, 1)))
511 318 : gam = gam1;
512 : else
513 2052 : gam = gamma_imagchi(ldata_get_gammavec(ldata1), gaddgs(k,-1));
514 2370 : if (!gam) pari_err_IMPL("lfuntwist (gammafactors)");
515 2370 : b1 = ldata_get_dual(ldata1);
516 2370 : b2 = ldata_get_dual(ldata2);
517 2370 : a = tag(mkvec2(a1, a2), t_LFUN_TWIST);
518 2370 : if (typ(b1)==t_INT)
519 2370 : b = signe(b1) && signe(b2) ? gen_0: gen_1;
520 : else
521 0 : b = tag(mkvec2(b1,lfunconj(a2)), t_LFUN_TWIST);
522 2370 : L = mkvecn(6, a, b, gam, k, N, gen_0);
523 2370 : return gc_GEN(ltop, L);
524 : }
525 :
526 : static GEN
527 252 : lfundualpoles(GEN ldata, GEN reno)
528 : {
529 : long l, j;
530 252 : GEN k = ldata_get_k(ldata);
531 252 : GEN r = gel(reno,2), eno = gel(reno,3), R;
532 252 : R = cgetg_copy(r, &l);
533 792 : for (j = 1; j < l; j++)
534 : {
535 540 : GEN b = gmael(r,j,1), e = gmael(r,j,2);
536 540 : long v = varn(e);
537 540 : GEN E = gsubst(gdiv(e, eno), v, gneg(pol_x(v)));
538 540 : gel(R,l-j) = mkvec2(gsub(k,b), E);
539 : }
540 252 : return R;
541 : }
542 :
543 : static GEN
544 498 : ginvvec(GEN x)
545 : {
546 498 : if (is_vec_t(typ(x)))
547 36 : pari_APPLY_same(ginv(gel(x,i)))
548 : else
549 486 : return ginv(x);
550 : }
551 :
552 : GEN
553 552 : lfundual(GEN L, long bitprec)
554 : {
555 552 : pari_sp av = avma;
556 552 : long prec = nbits2prec(bitprec);
557 552 : GEN ldata = ldata_newprec(lfunmisc_to_ldata_shallow(L), prec);
558 552 : GEN a = ldata_get_an(ldata), b = ldata_get_dual(ldata);
559 552 : GEN e = ldata_get_rootno(ldata);
560 552 : GEN ldual, ad, bd, ed, Rd = NULL;
561 552 : if (typ(b) == t_INT)
562 : {
563 528 : ad = equali1(b) ? lfunconj(a): a;
564 528 : bd = b;
565 : }
566 24 : else { ad = b; bd = a; }
567 552 : if (lg(ldata)==8)
568 : {
569 252 : GEN reno = lfunrootres(ldata, bitprec);
570 252 : e = gel(reno,3);
571 252 : Rd = lfundualpoles(ldata, reno);
572 : }
573 552 : ed = isintzero(e) ? e: ginvvec(e);
574 552 : ldual = mkvecn(Rd ? 7:6, ad, bd, gel(ldata,3), gel(ldata,4), gel(ldata,5), ed, Rd);
575 552 : return gc_GEN(av, ldual);
576 : }
577 :
578 : static GEN
579 90 : RgV_Rg_translate(GEN x, GEN s)
580 234 : { pari_APPLY_same(gadd(gel(x,i),s)) }
581 :
582 : static GEN
583 24 : pole_translate(GEN x, GEN s, GEN Ns)
584 : {
585 24 : x = shallowcopy(x);
586 24 : gel(x,1) = gadd(gel(x,1), s);
587 24 : if (Ns)
588 24 : gel(x,2) = gmul(gel(x,2), Ns);
589 24 : return x;
590 : }
591 :
592 : static GEN
593 12 : poles_translate(GEN x, GEN s, GEN Ns)
594 36 : { pari_APPLY_same(pole_translate(gel(x,i), s, Ns)) }
595 :
596 : /* r / x + O(1) */
597 : static GEN
598 234 : simple_pole(GEN r)
599 : {
600 : GEN S;
601 234 : if (isintzero(r)) return gen_0;
602 192 : S = deg1ser_shallow(gen_0, r, 1);
603 192 : setvalser(S, -1); return S;
604 : }
605 :
606 : GEN
607 90 : lfunshift(GEN ldata, GEN s, long flag, long bitprec)
608 : {
609 90 : pari_sp ltop = avma;
610 : GEN k, k1, L, N, a, b, gam, eps, res;
611 90 : long prec = nbits2prec(bitprec);
612 90 : if (!is_rational_t(typ(s))) pari_err_TYPE("lfunshift",s);
613 90 : ldata = ldata_newprec(lfunmisc_to_ldata_shallow(ldata), prec);
614 90 : a = ldata_get_an(ldata);
615 90 : b = ldata_get_dual(ldata);
616 90 : gam = RgV_Rg_translate(ldata_get_gammavec(ldata), gneg(s));
617 90 : k = gadd(ldata_get_k(ldata), gmul2n(s, 1));
618 90 : k1 = gadd(ldata_get_k1(ldata), s);
619 90 : N = ldata_get_conductor(ldata);
620 90 : eps = ldata_get_rootno(ldata);
621 90 : res = ldata_get_residue(ldata);
622 90 : a = tag(mkvec2(a, s), t_LFUN_SHIFT);
623 90 : if (typ(b) != t_INT)
624 0 : b = tag(mkvec2(b, s), t_LFUN_SHIFT);
625 90 : if (res)
626 90 : switch(typ(res))
627 : {
628 0 : case t_VEC:
629 0 : res = poles_translate(res, s, NULL);
630 0 : break;
631 12 : case t_COL:
632 12 : res = poles_translate(res, s, gpow(N, gmul2n(s, -1), prec));
633 12 : break;
634 78 : default:
635 78 : res = mkvec(mkvec2(gsub(k, s), simple_pole(res)));
636 : }
637 90 : L = mkvecn(res ? 7: 6, a, b, gam, mkvec2(k, k1), N, eps, res);
638 90 : if (flag) L = lfunmul_k(ldata, L, gsub(k, s), bitprec);
639 90 : return gc_GEN(ltop, L);
640 : }
641 :
642 : /*****************************************************************/
643 : /* L-series from closure */
644 : /*****************************************************************/
645 : static GEN
646 50532 : localfactor(void *E, GEN p, long n)
647 : {
648 50532 : GEN s = closure_callgen2((GEN)E, p, utoi(n));
649 50532 : return direuler_factor(s, n);
650 : }
651 : static GEN
652 1697 : vecan_closure(GEN a, long L, long prec)
653 : {
654 1697 : long ta = typ(a);
655 1697 : GEN gL, Sbad = NULL;
656 :
657 1697 : if (!L) return cgetg(1,t_VEC);
658 1697 : if (ta == t_VEC)
659 : {
660 911 : long l = lg(a);
661 911 : if (l == 1) pari_err_TYPE("vecan_closure", a);
662 911 : ta = typ(gel(a,1));
663 : /* regular vector, return it */
664 911 : if (ta != t_CLOSURE) return vecslice(a, 1, minss(L,l-1));
665 102 : if (l != 3) pari_err_TYPE("vecan_closure", a);
666 102 : Sbad = gel(a,2);
667 102 : if (typ(Sbad) != t_VEC) pari_err_TYPE("vecan_closure", a);
668 96 : a = gel(a,1);
669 : }
670 786 : else if (ta != t_CLOSURE) pari_err_TYPE("vecan_closure", a);
671 870 : push_localprec(prec);
672 870 : gL = stoi(L);
673 870 : switch(closure_arity(a))
674 : {
675 318 : case 2:
676 318 : a = direuler_bad((void*)a, localfactor, gen_2, gL,gL, Sbad);
677 288 : break;
678 546 : case 1:
679 546 : a = closure_callgen1(a, gL);
680 546 : if (typ(a) != t_VEC) pari_err_TYPE("vecan_closure", a);
681 540 : break;
682 6 : default: pari_err_TYPE("vecan_closure [wrong arity]", a);
683 : a = NULL; /*LCOV_EXCL_LINE*/
684 : }
685 828 : pop_localprec(); return a;
686 : }
687 :
688 : static GEN
689 60 : eulerf_closure(GEN a, GEN p, long prec)
690 : {
691 60 : long ta = typ(a);
692 60 : GEN Sbad = NULL, f;
693 :
694 60 : if (ta == t_VEC)
695 : {
696 0 : long l = lg(a);
697 0 : if (l == 1) pari_err_TYPE("vecan_closure", a);
698 0 : ta = typ(gel(a,1));
699 : /* regular vector, return it */
700 0 : if (ta != t_CLOSURE) return NULL;
701 0 : if (l != 3) pari_err_TYPE("vecan_closure", a);
702 0 : Sbad = gel(a,2);
703 0 : if (typ(Sbad) != t_VEC) pari_err_TYPE("vecan_closure", a);
704 0 : a = gel(a,1);
705 : }
706 60 : else if (ta != t_CLOSURE) pari_err_TYPE("vecan_closure", a);
707 60 : push_localprec(prec);
708 60 : switch(closure_arity(a))
709 : {
710 12 : case 2:
711 12 : f = closure_callgen2(a, p, mkoo()); break;
712 48 : case 1:
713 48 : f = NULL; break;
714 0 : default:
715 0 : f = NULL; pari_err_TYPE("vecan_closure", a);
716 : }
717 60 : pop_localprec(); return f;
718 : }
719 :
720 : /*****************************************************************/
721 : /* L-series of Dirichlet characters. */
722 : /*****************************************************************/
723 :
724 : static GEN
725 3512 : lfunzeta(void)
726 : {
727 3512 : GEN zet = mkvecn(7, NULL, gen_0, NULL, gen_1, gen_1, gen_1, gen_1);
728 3512 : gel(zet,1) = tag(gen_1, t_LFUN_ZETA);
729 3512 : gel(zet,3) = mkvec(gen_0);
730 3512 : return zet;
731 : }
732 :
733 : static GEN
734 3140 : vecan_Kronecker(GEN D, long n)
735 : {
736 3140 : GEN v = cgetg(n+1, t_VECSMALL);
737 3140 : ulong Du = itou_or_0(D);
738 3140 : long i, id, d = Du ? minuu(Du, n): n;
739 36454 : for (i = 1; i <= d; i++) v[i] = krois(D,i);
740 475619 : for (id = i; i <= n; i++,id++) /* periodic mod d */
741 : {
742 472479 : if (id > d) id = 1;
743 472479 : gel(v, i) = gel(v, id);
744 : }
745 3140 : return v;
746 : }
747 :
748 : static GEN
749 5908 : lfunchiquad(GEN D)
750 : {
751 : GEN r;
752 5908 : D = coredisc(D);
753 5908 : if (equali1(D)) return lfunzeta();
754 5198 : if (!isfundamental(D)) pari_err_TYPE("lfunchiquad [not primitive]", D);
755 5198 : r = mkvecn(6, NULL, gen_0, NULL, gen_1, NULL, gen_1);
756 5198 : gel(r,1) = tag(icopy(D), t_LFUN_KRONECKER);
757 5198 : gel(r,3) = mkvec(signe(D) < 0? gen_1: gen_0);
758 5198 : gel(r,5) = mpabs(D);
759 5198 : return r;
760 : }
761 :
762 : /* Begin Hecke characters. Here a character is assumed to be given by a
763 : vector on the generators of the ray class group clgp of CL_m(K).
764 : If clgp = [h,[d1,...,dk],[g1,...,gk]] with dk|...|d2|d1, a character chi
765 : is given by [a1,a2,...,ak] such that chi(gi)=\zeta_di^ai. */
766 :
767 : /* Value of CHI on x, coprime to bnr.mod */
768 : static GEN
769 90966 : chigeneval_i(GEN logx, GEN d, GEN nchi, GEN z, long prec)
770 : {
771 90966 : pari_sp av = avma;
772 90966 : GEN e = FpV_dotproduct(nchi, logx, d);
773 90966 : if (!is_vec_t(typ(z)))
774 1050 : return gc_upto(av, gpow(z, e, prec));
775 : else
776 89916 : return gc_const(av, gel(z, itou(e) + 1));
777 : }
778 :
779 : static GEN
780 74340 : chigenevalvec(GEN logx, GEN nchi, GEN z, long prec, long multi)
781 : {
782 74340 : GEN d = gel(nchi,1), x = gel(nchi, 2);
783 74340 : if (multi)
784 39090 : pari_APPLY_same(chigeneval_i(logx, d, gel(x,i), z, prec))
785 : else
786 63108 : return chigeneval_i(logx, d, x, z, prec);
787 : }
788 :
789 : /* return x + yz; y != 0; z = 0,1 "often"; x = 0 "often" */
790 : static GEN
791 1638336 : gaddmul(GEN x, GEN y, GEN z)
792 : {
793 : pari_sp av;
794 1638336 : if (typ(z) == t_INT)
795 : {
796 1461462 : if (!signe(z)) return x;
797 25788 : if (equali1(z)) return gadd(x,y);
798 : }
799 194682 : if (isintzero(x)) return gmul(y,z);
800 102798 : av = avma;
801 102798 : return gc_upto(av, gadd(x, gmul(y,z)));
802 : }
803 :
804 : static GEN
805 1551102 : gaddmulvec(GEN x, GEN y, GEN z, long multi)
806 : {
807 1551102 : if (multi)
808 233778 : pari_APPLY_same(gaddmul(gel(x,i),gel(y,i),gel(z,i)))
809 : else
810 1477830 : return gaddmul(x,y,z);
811 : }
812 :
813 : static GEN
814 4452 : mkvchi(GEN chi, long n)
815 : {
816 : GEN v;
817 4452 : if (lg(chi) > 1 && is_vec_t(typ(gel(chi,1))))
818 534 : {
819 534 : long d = lg(chi)-1;
820 534 : v = const_vec(n, zerovec(d));
821 534 : gel(v,1) = const_vec(d, gen_1);
822 : }
823 : else
824 3918 : v = vec_ei(n, 1);
825 4452 : return v;
826 : }
827 :
828 : static GEN
829 3120 : vecan_chiZ(GEN an, long n, long prec)
830 : {
831 : forprime_t iter;
832 3120 : GEN G = gel(an,1);
833 3120 : GEN nchi = gel(an,2), gord = gel(nchi,1), chi = gel(nchi,2), z;
834 3120 : GEN gp = cgetipos(3), v = mkvchi(chi, n);
835 3120 : GEN N = znstar_get_N(G);
836 3120 : long ord = itos_or_0(gord);
837 3120 : ulong Nu = itou_or_0(N);
838 3120 : long i, id, d = Nu ? minuu(Nu, n): n;
839 3120 : long multichi= (lg(chi) > 1 && is_vec_t(typ(gel(chi,1))));
840 : ulong p;
841 3120 : if (!multichi && ord && n > (ord>>4))
842 3012 : {
843 3012 : GEN w = ncharvecexpo(G, nchi);
844 3012 : z = grootsof1(ord, prec);
845 32008 : for (i = 1; i <= d; i++)
846 28996 : if (w[i] >= 0) gel(v, i) = gel(z, w[i]+1);
847 : }
848 : else
849 : {
850 108 : z = rootsof1_cx(gord, prec);
851 108 : u_forprime_init(&iter, 2, d);
852 690 : while ((p = u_forprime_next(&iter)))
853 : {
854 : GEN ch;
855 : ulong k;
856 582 : if (!umodiu(N,p)) continue;
857 480 : gp[2] = p;
858 480 : ch = chigenevalvec(znconreylog(G, gp), nchi, z, prec, multichi);
859 480 : gel(v, p) = ch;
860 1356 : for (k = 2*p; k <= (ulong)d; k += p)
861 876 : gel(v, k) = gaddmulvec(gel(v, k), ch, gel(v, k/p), multichi);
862 : }
863 : }
864 770356 : for (id = i = d+1; i <= n; i++,id++) /* periodic mod d */
865 : {
866 767236 : if (id > d) id = 1;
867 767236 : gel(v, i) = gel(v, id);
868 : }
869 3120 : return v;
870 : }
871 :
872 : static GEN
873 36 : eulerf_chiZ(GEN an, GEN p, long prec)
874 : {
875 36 : GEN G = gel(an,1);
876 36 : GEN nchi = gel(an,2), gord = gel(nchi,1), chi = gel(nchi,2);
877 36 : long multichi= (lg(chi) > 1 && is_vec_t(typ(gel(chi,1))));
878 36 : GEN z = rootsof1_cx(gord, prec);
879 36 : GEN N = znstar_get_N(G);
880 36 : GEN ch = dvdii(N,p) ? gen_0: chigenevalvec(znconreylog(G, p), nchi, z, prec, multichi);
881 36 : return mkrfrac(gen_1, deg1pol_shallow(gneg(ch), gen_1,0));
882 : }
883 :
884 : static GEN
885 1332 : vecan_chigen(GEN an, long n, long prec)
886 : {
887 : forprime_t iter;
888 1332 : GEN bnr = gel(an,1), nf = bnr_get_nf(bnr);
889 1332 : GEN nchi = gel(an,2), gord = gel(nchi,1), chi = gel(nchi,2), z;
890 1332 : GEN gp = cgetipos(3), v = mkvchi(chi, n);
891 1332 : GEN N = gel(bnr_get_mod(bnr), 1), NZ = gcoeff(N,1,1);
892 1332 : long ord = itos_or_0(gord);
893 1332 : long multichi= (lg(chi) > 1 && is_vec_t(typ(gel(chi,1))));
894 : ulong p;
895 :
896 1332 : if (ord && n > (ord>>4))
897 1332 : z = grootsof1(ord, prec);
898 : else
899 0 : z = rootsof1_cx(gord, prec);
900 :
901 1332 : if (nf_get_degree(nf) == 1)
902 : {
903 990 : ulong Nu = itou_or_0(NZ);
904 990 : long i, id, d = Nu ? minuu(Nu, n): n;
905 990 : u_forprime_init(&iter, 2, d);
906 5922 : while ((p = u_forprime_next(&iter)))
907 : {
908 : GEN ch;
909 : ulong k;
910 4932 : if (!umodiu(NZ,p)) continue;
911 3840 : gp[2] = p;
912 3840 : ch = chigenevalvec(isprincipalray(bnr,gp), nchi, z, prec, multichi);
913 3840 : gel(v, p) = ch;
914 11460 : for (k = 2*p; k <= (ulong)d; k += p)
915 7620 : gel(v, k) = gaddmulvec(gel(v, k), ch, gel(v, k/p), multichi);
916 : }
917 11914 : for (id = i = d+1; i <= n; i++,id++) /* periodic mod d */
918 : {
919 10924 : if (id > d) id = 1;
920 10924 : gel(v, i) = gel(v, id);
921 : }
922 : }
923 : else
924 : {
925 342 : GEN BOUND = stoi(n);
926 342 : u_forprime_init(&iter, 2, n);
927 70602 : while ((p = u_forprime_next(&iter)))
928 : {
929 : GEN L;
930 : long j;
931 70260 : int check = !umodiu(NZ,p);
932 70260 : gp[2] = p;
933 70260 : L = idealprimedec_limit_norm(nf, gp, BOUND);
934 140424 : for (j = 1; j < lg(L); j++)
935 : {
936 70164 : GEN pr = gel(L, j), ch;
937 : ulong k, q;
938 70164 : if (check && idealval(nf, N, pr)) continue;
939 69954 : ch = chigenevalvec(isprincipalray(bnr,pr), nchi, z, prec, multichi);
940 69954 : q = upr_norm(pr);
941 69954 : gel(v, q) = gadd(gel(v, q), ch);
942 1612560 : for (k = 2*q; k <= (ulong)n; k += q)
943 1542606 : gel(v, k) = gaddmulvec(gel(v, k), ch, gel(v, k/q), multichi);
944 : }
945 : }
946 : }
947 1332 : return v;
948 : }
949 :
950 : static GEN
951 24 : eulerf_chigen(GEN an, GEN p, long prec)
952 : {
953 24 : GEN bnr = gel(an,1), nf = bnr_get_nf(bnr);
954 24 : GEN nchi = gel(an,2), gord = gel(nchi,1), chi = gel(nchi,2), z;
955 24 : GEN N = gel(bnr_get_mod(bnr), 1), NZ = gcoeff(N,1,1), f;
956 24 : long multichi= (lg(chi) > 1 && is_vec_t(typ(gel(chi,1))));
957 :
958 24 : z = rootsof1_cx(gord, prec);
959 24 : if (nf_get_degree(nf) == 1)
960 : {
961 : GEN ch;
962 0 : if (dvdii(NZ,p)) ch = gen_0;
963 : else
964 : {
965 0 : ch = chigenevalvec(isprincipalray(bnr,p), nchi, z, prec, multichi);
966 0 : if (typ(ch)==t_VEC) return NULL;
967 : }
968 0 : f = deg1pol_shallow(gneg(ch), gen_1, 0);
969 : }
970 : else
971 : {
972 24 : int check = dvdii(NZ,p);
973 24 : GEN L = idealprimedec(nf, p);
974 24 : long j, lL = lg(L);
975 24 : f = pol_1(0);
976 42 : for (j = 1; j < lL; j++)
977 : {
978 30 : GEN pr = gel(L, j), ch;
979 30 : if (check && idealval(nf, N, pr)) ch = gen_0;
980 : else
981 30 : ch = chigenevalvec(isprincipalray(bnr,pr), nchi, z, prec, multichi);
982 30 : if (typ(ch)==t_VEC) return NULL;
983 18 : f = gmul(f, gsub(gen_1, monomial(ch, pr_get_f(pr), 0)));
984 : }
985 : }
986 12 : return mkrfrac(gen_1,f);
987 : }
988 :
989 : static GEN
990 4044 : vec01(long r1, long r2)
991 : {
992 4044 : long d = r1+r2, i;
993 4044 : GEN v = cgetg(d+1,t_VEC);
994 11706 : for (i = 1; i <= r1; i++) gel(v,i) = gen_0;
995 7050 : for ( ; i <= d; i++) gel(v,i) = gen_1;
996 4044 : return v;
997 : }
998 :
999 : /* true nf or t_POL */
1000 : static GEN
1001 1080 : lfunzetak_i(GEN T)
1002 : {
1003 : GEN Vga, N;
1004 : long r1, r2;
1005 1080 : if (typ(T) == t_POL)
1006 : {
1007 570 : T = nfinit0(T, nf_NOLLL, DEFAULTPREC);
1008 570 : if (lg(T) == 3) T = gel(T,1); /* [nf,change of var] */
1009 : }
1010 1080 : if (nf_get_degree(T) == 1) return lfunzeta();
1011 1080 : nf_get_sign(T,&r1,&r2); Vga = vec01(r1+r2,r2);
1012 1080 : N = absi_shallow(nf_get_disc(T));
1013 1080 : return mkvecn(7, tag(T,t_LFUN_NF), gen_0, Vga, gen_1, N, gen_1, gen_0);
1014 : }
1015 : /* truen nf or t_POL */
1016 : static GEN
1017 714 : lfunzetak(GEN T)
1018 714 : { pari_sp av = avma; return gc_GEN(av, lfunzetak_i(T)); }
1019 :
1020 : /* C = normalized character of order dividing o; renormalize so that it has
1021 : * apparent order o */
1022 : GEN
1023 1032 : char_renormalize(GEN C, GEN o)
1024 : {
1025 1032 : GEN oc = gel(C,1), c = gel(C,2);
1026 1032 : if (!equalii(o, oc)) c = ZC_Z_mul(c, diviiexact(o, oc));
1027 1032 : return c;
1028 : }
1029 : static GEN
1030 18 : vecchar_renormalize(GEN x, GEN o)
1031 54 : { pari_APPLY_same(char_renormalize(gel(x,i), o)); }
1032 :
1033 : /* G is a bid of nftyp typ_BIDZ */
1034 : static GEN
1035 7227 : lfunchiZ(GEN G, GEN CHI)
1036 : {
1037 7227 : pari_sp av = avma;
1038 7227 : GEN sig = NULL, N = bid_get_ideal(G), nchi, r;
1039 : int real;
1040 : long s;
1041 :
1042 7227 : if (typ(N) != t_INT) pari_err_TYPE("lfunchiZ", G);
1043 7227 : if (typ(CHI) == t_VEC && !RgV_is_ZV(CHI))
1044 18 : {
1045 36 : GEN C, G0 = G, o = gen_1;
1046 36 : long i, l = lg(CHI);
1047 36 : nchi = cgetg(l, t_VEC);
1048 36 : N = znconreyconductor(G, gel(CHI,1), &C);
1049 30 : if (typ(N) != t_INT) G = znstar0(N, 1);
1050 30 : s = zncharisodd(G, C);
1051 78 : for (i = 1; i < l; i++)
1052 : {
1053 60 : if (i > 1)
1054 : {
1055 30 : if (!gequal(N, znconreyconductor(G0, gel(CHI,i), &C))
1056 24 : || zncharisodd(G, C) != s)
1057 12 : pari_err_TYPE("lfuncreate [different conductors]", CHI);
1058 : }
1059 48 : C = znconreylog_normalize(G, C);
1060 48 : o = lcmii(o, gel(C,1)); /* lcm with charorder */
1061 48 : gel(nchi,i) = C;
1062 : }
1063 18 : nchi = mkvec2(o, vecchar_renormalize(nchi, o));
1064 18 : if (typ(N) != t_INT) N = gel(N,1);
1065 : }
1066 : else
1067 : {
1068 7191 : N = znconreyconductor(G, CHI, &CHI);
1069 7191 : if (typ(N) != t_INT)
1070 : {
1071 6 : if (equali1(gel(N,1))) { set_avma(av); return lfunzeta(); }
1072 0 : G = znstar0(N, 1);
1073 0 : N = gel(N,1);
1074 : }
1075 : /* CHI now primitive on G */
1076 7185 : switch(itou_or_0(zncharorder(G, CHI)))
1077 : {
1078 2076 : case 1: set_avma(av); return lfunzeta();
1079 2565 : case 2: if (zncharisodd(G,CHI)) N = negi(N);
1080 2565 : return gc_upto(av, lfunchiquad(N));
1081 : }
1082 2544 : nchi = znconreylog_normalize(G, CHI);
1083 2544 : s = zncharisodd(G, CHI);
1084 : }
1085 2562 : sig = mkvec(s? gen_1: gen_0);
1086 2562 : real = abscmpiu(gel(nchi,1), 2) <= 0;
1087 2562 : r = mkvecn(6, tag(mkvec2(G,nchi), t_LFUN_CHIZ),
1088 : real? gen_0: gen_1, sig, gen_1, N, gen_0);
1089 2562 : return gc_GEN(av, r);
1090 : }
1091 :
1092 : static GEN
1093 1314 : lfunchigen(GEN bnr, GEN CHI)
1094 : {
1095 1314 : pari_sp av = avma;
1096 : GEN N, sig, Ldchi, nf, nchi, NN;
1097 : long r1, r2, n1;
1098 : int real;
1099 :
1100 1314 : if (typ(CHI) == t_VEC && !RgV_is_ZV(CHI))
1101 : {
1102 300 : bnr_vecchar_sanitize(&bnr, &CHI);
1103 294 : nchi = CHI;
1104 : }
1105 : else
1106 : {
1107 1014 : bnr_char_sanitize(&bnr, &CHI);
1108 1014 : nchi = NULL; /* now CHI is primitive wrt bnr */
1109 : }
1110 :
1111 1308 : N = bnr_get_mod(bnr);
1112 1308 : nf = bnr_get_nf(bnr);
1113 1308 : n1 = lg(vec01_to_indices(gel(N,2))) - 1; /* vecsum(N[2]) */
1114 1308 : N = gel(N,1);
1115 1308 : NN = mulii(idealnorm(nf, N), absi_shallow(nf_get_disc(nf)));
1116 1308 : if (!nchi)
1117 : {
1118 1014 : if (equali1(NN)) { set_avma(av); return lfunzeta(); }
1119 624 : if (ZV_equal0(CHI)) return gc_GEN(av, lfunzetak_i(bnr_get_nf(bnr)));
1120 558 : nchi = char_normalize(CHI, cyc_normalize(bnr_get_cyc(bnr)));
1121 : }
1122 852 : real = abscmpiu(gel(nchi,1), 2) <= 0;
1123 852 : nf_get_sign(nf, &r1, &r2);
1124 852 : sig = vec01(r1+r2-n1, r2+n1);
1125 852 : Ldchi = mkvecn(6, tag(mkvec2(bnr, nchi), t_LFUN_CHIGEN),
1126 : real? gen_0: gen_1, sig, gen_1, NN, gen_0);
1127 852 : return gc_GEN(av, Ldchi);
1128 : }
1129 :
1130 : /* Find all characters of clgp whose kernel contain group given by HNF H.
1131 : * Set *pcnj[i] to the conductor */
1132 : static GEN
1133 456 : chigenkerfind(GEN bnr, GEN H, GEN *pcnj)
1134 : {
1135 456 : GEN res, cnj, L = bnrchar(bnr, H, NULL);
1136 456 : long i, k, l = lg(L);
1137 :
1138 456 : res = cgetg(l, t_VEC);
1139 456 : *pcnj = cnj = cgetg(l, t_VEC);
1140 2226 : for (i = k = 1; i < l; i++)
1141 : {
1142 1770 : GEN chi = gel(L,i);
1143 1770 : gel(res, k) = chi;
1144 1770 : gel(cnj, k) = ZV_equal0(chi)? gen_0: bnrconductor_raw(bnr, chi);
1145 1770 : k++;
1146 : }
1147 456 : setlg(cnj, k);
1148 456 : setlg(res, k); return res;
1149 : }
1150 :
1151 : static GEN
1152 456 : vec_classes(GEN A, GEN F)
1153 : {
1154 456 : GEN w = vec_equiv(F);
1155 456 : long i, l = lg(w);
1156 456 : GEN V = cgetg(l, t_VEC);
1157 1554 : for (i = 1; i < l; i++) gel(V,i) = vecpermute(A,gel(w,i));
1158 456 : return V;
1159 : }
1160 :
1161 : static GEN
1162 848958 : abelrel_pfactor(GEN bnr, GEN pr, GEN U, GEN D, GEN h)
1163 : {
1164 848958 : GEN v = bnrisprincipalmod(bnr, pr, h, 0);
1165 848958 : GEN E = ZV_ZV_mod(ZM_ZC_mul(U, v), D);
1166 848958 : ulong o = itou(charorder(D, E)), f = pr_get_f(pr);
1167 848958 : return gpowgs(gsub(gen_1, monomial(gen_1, f * o, 0)), itou(h) / o);
1168 : }
1169 :
1170 : static GEN
1171 589650 : abelrel_factor(GEN bnr, GEN C, GEN p, GEN mod, GEN U, GEN D, GEN h)
1172 : {
1173 589650 : GEN nf = bnr_get_nf(bnr), F = pol_1(0), prid = idealprimedec(nf,p);
1174 589650 : GEN mod2 = shallowcopy(mod);
1175 589650 : long i, l = lg(prid);
1176 1438608 : for (i = 1; i < l; i++)
1177 : {
1178 848958 : GEN pr = gel(prid, i), Fpr;
1179 848958 : long v = idealval(nf,mod,pr);
1180 848958 : if (v > 0)
1181 : {
1182 : GEN bnr2, C2, U2, D2, h2;
1183 138 : gel(mod2, 1) = idealdivpowprime(nf, gel(mod, 1), pr, utoi(v));
1184 138 : bnr2 = bnrinitmod(bnr, mod2, 0, h);
1185 138 : C2 = bnrmap(bnrmap(bnr, bnr2), C);
1186 138 : D2 = ZM_snfall_i(C2, &U2, NULL, 1);
1187 138 : h2 = ZV_prod(D2);
1188 138 : Fpr = abelrel_pfactor(bnr2, pr, U2, D2, h2);
1189 : }
1190 : else
1191 848820 : Fpr = abelrel_pfactor(bnr, pr, U, D, h);
1192 848958 : F = ZX_mul(F, Fpr);
1193 : }
1194 589650 : return gcopy(mkrfrac(gen_1, F));
1195 : }
1196 :
1197 : static GEN
1198 36 : eulerf_abelrel(GEN an, GEN p)
1199 : {
1200 36 : GEN bnr = gel(an,1), C = gel(an,2), mod = gel(an,3);
1201 36 : GEN U, D = ZM_snfall_i(C, &U, NULL, 1), h = ZV_prod(D);
1202 36 : return abelrel_factor(bnr, C, p, mod, U, D, h);
1203 : }
1204 :
1205 : struct direuler_abelrel
1206 : {
1207 : GEN bnr, C, mod, U, D, h;
1208 : };
1209 :
1210 : static GEN
1211 589614 : _direuler_abelrel(void *E, GEN p)
1212 : {
1213 589614 : struct direuler_abelrel *s = (struct direuler_abelrel*) E;
1214 589614 : return abelrel_factor(s->bnr, s->C, p, s->mod, s->U, s->D, s->h);
1215 : }
1216 :
1217 : static GEN
1218 144 : vecan_abelrel(GEN an, long N)
1219 : {
1220 : struct direuler_abelrel s;
1221 144 : s.bnr = gel(an,1);
1222 144 : s.C = gel(an,2);
1223 144 : s.mod = gel(an,3);
1224 144 : s.D = ZM_snfall_i(s.C, &s.U, NULL, 1);
1225 144 : s.h = ZV_prod(s.D);
1226 144 : return direuler((void*)&s, _direuler_abelrel, gen_1, stoi(N), NULL);
1227 : }
1228 :
1229 : static GEN
1230 474 : lfunabelrel_i(GEN bnr, GEN H, GEN mod)
1231 : {
1232 474 : GEN NrD = bnrdisc(bnr, H, 0), N = absi_shallow(gel(NrD,3));
1233 474 : long n = itos(gel(NrD,1)), r1 = itos(gel(NrD,2)), r2 = (n-r1)>>1;
1234 474 : if (!mod) mod = bnrconductor(bnr, H, 0);
1235 474 : return mkvecn(7, tag(mkvec3(bnr,H,mod),t_LFUN_ABELREL),
1236 : gen_0, vec01(r1+r2, r2), gen_1, N, gen_1, gen_0);
1237 : }
1238 : static GEN
1239 18 : lfunabelrel(GEN bnr, GEN H, GEN mod)
1240 18 : { pari_sp av = avma; return gc_GEN(av, lfunabelrel_i(bnr, H, mod)); }
1241 :
1242 :
1243 : static GEN
1244 1098 : lfunchiinit(GEN bnr, GEN chi, GEN dom, long der, long bitprec)
1245 : {
1246 1098 : GEN L = lfunchigen(bnr, lg(chi)==2 ? gel(chi,1): chi);
1247 1098 : return lfuninit(L, dom, der, bitprec);
1248 : }
1249 : static GEN
1250 456 : veclfunchiinit(GEN bnr, GEN x, GEN dom, long der, long bitprec)
1251 1554 : { pari_APPLY_same(lfunchiinit(bnr, gel(x,i), dom, der, bitprec)); }
1252 : GEN
1253 456 : lfunabelianrelinit(GEN bnr, GEN H, GEN dom, long der, long bitprec)
1254 : {
1255 456 : GEN cnj, M, D, C = chigenkerfind(bnr, H, &cnj);
1256 : long l;
1257 456 : C = vec_classes(C, cnj); l = lg(C);
1258 456 : M = mkvec3(veclfunchiinit(bnr, C, dom, der, bitprec),
1259 : const_vecsmall(l-1, 1), const_vecsmall(l-1, 0));
1260 456 : D = mkvec2(dom, mkvecsmall2(der, bitprec));
1261 456 : return lfuninit_make(t_LDESC_PRODUCT, lfunabelrel_i(bnr, H, NULL), M, D);
1262 : }
1263 :
1264 : /*****************************************************************/
1265 : /* Dedekind zeta functions */
1266 : /*****************************************************************/
1267 : /* true nf */
1268 : static GEN
1269 1806 : dirzetak0(GEN nf, ulong N)
1270 : {
1271 1806 : GEN vect, c, c2, T = nf_get_pol(nf), index = nf_get_index(nf);
1272 1806 : pari_sp av = avma, av2;
1273 1806 : const ulong SQRTN = usqrt(N);
1274 : ulong i, p, lx;
1275 1806 : long court[] = {evaltyp(t_INT)|_evallg(3), evalsigne(1)|evallgefint(3),0};
1276 : forprime_t S;
1277 :
1278 1806 : c = cgetalloc(N+1, t_VECSMALL);
1279 1806 : c2 = cgetalloc(N+1, t_VECSMALL);
1280 2290278 : c2[1] = c[1] = 1; for (i=2; i<=N; i++) c[i] = 0;
1281 1806 : u_forprime_init(&S, 2, N); av2 = avma;
1282 298782 : while ( (p = u_forprime_next(&S)) )
1283 : {
1284 296976 : set_avma(av2);
1285 296976 : if (umodiu(index, p)) /* p does not divide index */
1286 296664 : vect = gel(Flx_degfact(ZX_to_Flx(T,p), p),1);
1287 : else
1288 : {
1289 312 : court[2] = p;
1290 312 : vect = idealprimedec_degrees(nf,court);
1291 : }
1292 296976 : lx = lg(vect);
1293 296976 : if (p <= SQRTN)
1294 30210 : for (i=1; i<lx; i++)
1295 : {
1296 20184 : ulong qn, q = upowuu(p, vect[i]); /* Norm P[i] */
1297 20184 : if (!q || q > N) break;
1298 17826 : memcpy(c2 + 2, c + 2, (N-1)*sizeof(long));
1299 : /* c2[i] <- c[i] + sum_{k = 1}^{v_q(i)} c[i/q^k] for all i <= N */
1300 36762 : for (qn = q; qn <= N; qn *= q)
1301 : {
1302 36762 : ulong k0 = N/qn, k, k2; /* k2 = k*qn */
1303 3222900 : for (k = k0, k2 = k*qn; k > 0; k--, k2 -=qn) c2[k2] += c[k];
1304 36762 : if (q > k0) break; /* <=> q*qn > N */
1305 : }
1306 17826 : swap(c, c2);
1307 : }
1308 : else /* p > sqrt(N): simpler */
1309 562536 : for (i=1; i<lx; i++)
1310 : {
1311 : ulong k, k2; /* k2 = k*p */
1312 498684 : if (vect[i] > 1) break;
1313 : /* c2[i] <- c[i] + sum_{k = 1}^{v_q(i)} c[i/q^k] for all i <= N */
1314 1634334 : for (k = N/p, k2 = k*p; k > 0; k--, k2 -= p) c[k2] += c[k];
1315 : }
1316 : }
1317 1806 : pari_free(c2); return gc_const(av, c);
1318 : }
1319 :
1320 : static GEN
1321 144 : eulerf_zetak(GEN nf, GEN p)
1322 : {
1323 144 : GEN v, f = pol_1(0);
1324 : long i, l;
1325 144 : if (dvdii(nf_get_index(nf), p)) /* p does not divide index */
1326 6 : v = idealprimedec_degrees(nf,p);
1327 : else
1328 138 : v = gel(FpX_degfact(nf_get_pol(nf), p), 1);
1329 144 : l = lg(v);
1330 348 : for (i = 1; i < l; i++) f = ZX_sub(f, RgX_shift_shallow(f, v[i]));
1331 144 : retmkrfrac(gen_1, ZX_copy(f));
1332 : }
1333 :
1334 : GEN
1335 1806 : dirzetak(GEN nf, GEN b)
1336 : {
1337 : GEN z, c;
1338 : long n;
1339 :
1340 1806 : if (typ(b) != t_INT) pari_err_TYPE("dirzetak",b);
1341 1806 : if (signe(b) <= 0) return cgetg(1,t_VEC);
1342 1806 : nf = checknf(nf);
1343 1806 : n = itou_or_0(b); if (!n) pari_err_OVERFLOW("dirzetak");
1344 1806 : c = dirzetak0(nf, n);
1345 1806 : z = vecsmall_to_vec(c); pari_free(c); return z;
1346 : }
1347 :
1348 : static GEN
1349 564 : linit_get_mat(GEN linit)
1350 : {
1351 564 : if (linit_get_type(linit)==t_LDESC_PRODUCT)
1352 138 : return lfunprod_get_fact(linit_get_tech(linit));
1353 : else
1354 426 : return mkvec3(mkvec(linit), mkvecsmall(1), mkvecsmall(0));
1355 : }
1356 :
1357 : static GEN
1358 282 : lfunproduct(GEN ldata, GEN linit1, GEN linit2, GEN domain)
1359 : {
1360 282 : GEN M1 = linit_get_mat(linit1);
1361 282 : GEN M2 = linit_get_mat(linit2);
1362 282 : GEN M3 = mkvec3(shallowconcat(gel(M1, 1), gel(M2, 1)),
1363 282 : vecsmall_concat(gel(M1, 2), gel(M2, 2)),
1364 282 : vecsmall_concat(gel(M1, 3), gel(M2, 3)));
1365 282 : return lfuninit_make(t_LDESC_PRODUCT, ldata, M3, domain);
1366 : }
1367 : static GEN lfunzetakinit_artin(GEN nf, GEN gal, GEN dom, long der, long bit);
1368 : /* true nf */
1369 : static GEN
1370 282 : lfunzetakinit_quotient(GEN nf, GEN polk, GEN dom, long der, long bitprec)
1371 : {
1372 : GEN ak, an, nfk, Vga, ldata, N, Lk, LKk, domain;
1373 : long r1k, r2k, r1, r2;
1374 :
1375 282 : nf_get_sign(nf,&r1,&r2);
1376 282 : nfk = nfinit(polk, nbits2prec(bitprec));
1377 282 : Lk = lfunzetakinit(nfk, dom, der, bitprec); /* zeta_k */
1378 282 : nf_get_sign(nfk,&r1k,&r2k);
1379 282 : Vga = vec01((r1+r2) - (r1k+r2k), r2-r2k);
1380 282 : N = absi_shallow(diviiexact(nf_get_disc(nf), nf_get_disc(nfk)));
1381 282 : ak = nf_get_degree(nf)==1 ? tag(gen_1, t_LFUN_ZETA): tag(nfk, t_LFUN_NF);
1382 282 : an = tag(mkvec2(tag(nf,t_LFUN_NF), ak), t_LFUN_DIV);
1383 282 : ldata = mkvecn(6, an, gen_0, Vga, gen_1, N, gen_1);
1384 282 : LKk = lfuninit(ldata, dom, der, bitprec); /* zeta_K/zeta_k */
1385 282 : domain = mkvec2(dom, mkvecsmall2(der, bitprec));
1386 282 : return lfunproduct(lfunzetak_i(nf), Lk, LKk, domain);
1387 : }
1388 : /* true nf */
1389 : GEN
1390 822 : lfunzetakinit(GEN nf, GEN dom, long der, long bitprec)
1391 : {
1392 822 : long n, d = nf_get_degree(nf);
1393 822 : GEN L, Q, R, T = nf_get_pol(nf);
1394 822 : if (d == 1) return lfuninit(lfunzeta(), dom, der, bitprec);
1395 678 : if (d > 2)
1396 : {
1397 390 : GEN G = galoisinit(nf, NULL);
1398 390 : if (isintzero(G))
1399 : { /* not Galois */
1400 282 : GEN S = nfsubfields(nf, 0); n = lg(S)-1;
1401 282 : return lfunzetakinit_quotient(nf, gmael(S,n-1,1), dom, der, bitprec);
1402 : }
1403 108 : if (!group_isabelian(galois_group(G))) /* Galois, not Abelian */
1404 18 : return lfunzetakinit_artin(nf, G, dom, der, bitprec);
1405 : }
1406 : /* Abelian over Q */
1407 378 : Q = Buchall(pol_x(1), 0, nbits2prec(bitprec));
1408 378 : T = shallowcopy(T); setvarn(T,0);
1409 378 : R = rnfconductor0(Q, T, 1);
1410 378 : L = lfunabelianrelinit(gel(R,2), gel(R,3), dom, der, bitprec);
1411 378 : delete_var(); return L;
1412 : }
1413 :
1414 : /***************************************************************/
1415 : /* Elliptic Curves and Modular Forms */
1416 : /***************************************************************/
1417 :
1418 : static GEN
1419 174 : lfunellnf(GEN e)
1420 : {
1421 174 : pari_sp av = avma;
1422 174 : GEN ldata = cgetg(7, t_VEC), nf = ellnf_get_nf(e);
1423 174 : GEN N = gel(ellglobalred(e), 1);
1424 174 : long n = nf_get_degree(nf);
1425 174 : gel(ldata, 1) = tag(e, t_LFUN_ELL);
1426 174 : gel(ldata, 2) = gen_0;
1427 174 : gel(ldata, 3) = vec01(n, n);
1428 174 : gel(ldata, 4) = gen_2;
1429 174 : gel(ldata, 5) = mulii(idealnorm(nf,N), sqri(nf_get_disc(nf)));
1430 174 : gel(ldata, 6) = stoi(ellrootno_global(e));
1431 174 : return gc_GEN(av, ldata);
1432 : }
1433 :
1434 : static GEN
1435 3306 : lfunellQ(GEN e)
1436 : {
1437 3306 : pari_sp av = avma;
1438 3306 : GEN ldata = cgetg(7, t_VEC);
1439 3306 : gel(ldata, 1) = tag(ellanal_globalred(e, NULL), t_LFUN_ELL);
1440 3306 : gel(ldata, 2) = gen_0;
1441 3306 : gel(ldata, 3) = mkvec2(gen_0, gen_1);
1442 3306 : gel(ldata, 4) = gen_2;
1443 3306 : gel(ldata, 5) = ellQ_get_N(e);
1444 3306 : gel(ldata, 6) = stoi(ellrootno_global(e));
1445 3306 : return gc_GEN(av, ldata); /* ellanal_globalred not stack-safe */
1446 : }
1447 :
1448 : static GEN
1449 3480 : lfunell(GEN e)
1450 : {
1451 3480 : long t = ell_get_type(e);
1452 3480 : switch(t)
1453 : {
1454 3306 : case t_ELL_Q: return lfunellQ(e);
1455 174 : case t_ELL_NF:return lfunellnf(e);
1456 : }
1457 0 : pari_err_TYPE("lfun",e);
1458 : return NULL; /*LCOV_EXCL_LINE*/
1459 : }
1460 :
1461 : static GEN
1462 120 : ellsympow_gamma(long m)
1463 : {
1464 120 : GEN V = cgetg(m+2, t_VEC);
1465 120 : long i = 1, j;
1466 120 : if (!odd(m)) gel(V, i++) = stoi(-2*(m>>2));
1467 312 : for (j = (m+1)>>1; j > 0; i+=2, j--)
1468 : {
1469 192 : gel(V,i) = stoi(1-j);
1470 192 : gel(V,i+1) = stoi(1-j+1);
1471 : }
1472 120 : return V;
1473 : }
1474 :
1475 : static GEN
1476 74526 : ellsympow_trace(GEN p, GEN t, long m)
1477 : {
1478 74526 : long k, n = m >> 1;
1479 74526 : GEN tp = gpowers0(sqri(t), n, odd(m)? t: NULL);
1480 74526 : GEN pp = gen_1, b = gen_1, r = gel(tp,n+1);
1481 213156 : for(k=1; k<=n; k++)
1482 : {
1483 : GEN s;
1484 138630 : pp = mulii(pp, p);
1485 138630 : b = diviuexact(muliu(b, (m-(2*k-1))*(m-(2*k-2))), k*(m-(k-1)));
1486 138630 : s = mulii(mulii(b, gel(tp,1+n-k)), pp);
1487 138630 : r = odd(k) ? subii(r, s): addii(r, s);
1488 : }
1489 74526 : return r;
1490 : }
1491 :
1492 : static GEN
1493 2682 : ellsympow_abelian(GEN p, GEN ap, long m, long o)
1494 : {
1495 2682 : pari_sp av = avma;
1496 2682 : long i, M, n = (m+1)>>1;
1497 : GEN pk, tv, pn, pm, F, v;
1498 2682 : if (!odd(o))
1499 : {
1500 0 : if (odd(m)) return pol_1(0);
1501 0 : M = m >> 1; o >>= 1;
1502 : }
1503 : else
1504 2682 : M = m * ((o+1) >> 1);
1505 2682 : pk = gpowers(p,n); pn = gel(pk,n+1);
1506 2682 : tv = cgetg(m+2,t_VEC);
1507 2682 : gel(tv, 1) = gen_2;
1508 2682 : gel(tv, 2) = ap;
1509 9144 : for (i = 3; i <= m+1; i++)
1510 6462 : gel(tv,i) = subii(mulii(ap,gel(tv,i-1)), mulii(p,gel(tv,i-2)));
1511 2682 : pm = odd(m)? mulii(gel(pk,n), pn): sqri(pn); /* cheap p^m */
1512 2682 : F = deg2pol_shallow(pm, gen_0, gen_1, 0);
1513 2682 : v = odd(m) ? pol_1(0): deg1pol_shallow(negi(pn), gen_1, 0);
1514 8100 : for (i = M % o; i < n; i += o) /* o | m-2*i */
1515 : {
1516 5418 : gel(F,3) = negi(mulii(gel(tv,m-2*i+1), gel(pk,i+1)));
1517 5418 : v = ZX_mul(v, F);
1518 : }
1519 2682 : return gc_GEN(av, v);
1520 : }
1521 :
1522 : static GEN
1523 77184 : ellsympow(GEN E, ulong m, GEN p, long n)
1524 : {
1525 77184 : pari_sp av = avma;
1526 77184 : GEN ap = ellap(E, p);
1527 77184 : if (n <= 2)
1528 : {
1529 74526 : GEN t = ellsympow_trace(p, ap, m);
1530 74526 : return deg1pol_shallow(t, gen_1, 0);
1531 : }
1532 : else
1533 2658 : return gc_upto(av, RgXn_inv_i(ellsympow_abelian(p, ap, m, 1), n));
1534 : }
1535 :
1536 : GEN
1537 4848 : direllsympow_worker(GEN P, ulong X, GEN E, ulong m)
1538 : {
1539 4848 : pari_sp av = avma;
1540 4848 : long i, l = lg(P);
1541 4848 : GEN W = cgetg(l, t_VEC);
1542 82032 : for(i = 1; i < l; i++)
1543 : {
1544 77184 : ulong p = uel(P,i);
1545 77184 : long d = ulogint(X, p) + 1; /* minimal d such that p^d > X */
1546 77184 : gel(W,i) = ellsympow(E, m, utoi(uel(P,i)), d);
1547 : }
1548 4848 : return gc_GEN(av, mkvec2(P,W));
1549 : }
1550 :
1551 : static GEN
1552 48 : eulerf_bad(GEN bad, GEN p)
1553 : {
1554 48 : long i, l = lg(bad);
1555 96 : for (i = 1; i < l; i++)
1556 48 : if (equalii(gmael(bad,i,1), p))
1557 0 : return gmael(bad,i,2);
1558 48 : return NULL;
1559 : }
1560 :
1561 : static GEN
1562 294 : vecan_ellsympow(GEN an, long n)
1563 : {
1564 294 : GEN nn = utoi(n), crvm = gel(an,1), bad = gel(an,2);
1565 294 : GEN worker = snm_closure(is_entry("_direllsympow_worker"), crvm);
1566 294 : return pardireuler(worker, gen_2, nn, nn, bad);
1567 : }
1568 :
1569 : static GEN
1570 24 : eulerf_ellsympow(GEN an, GEN p)
1571 : {
1572 24 : GEN crvm = gel(an,1), bad = gel(an,2), E = gel(crvm,1);
1573 24 : GEN f = eulerf_bad(bad, p);
1574 24 : if (f) return f;
1575 24 : retmkrfrac(gen_1,ellsympow_abelian(p, ellap(E, p), itos(gel(crvm,2)), 1));
1576 : }
1577 :
1578 : static long
1579 168 : ellsympow_betam(long o, long m)
1580 : {
1581 168 : const long c3[]={3, -1, 1};
1582 168 : const long c12[]={6, -2, 2, 0, 4, -4};
1583 168 : const long c24[]={12, -2, -4, 6, 4, -10};
1584 168 : if (!odd(o) && odd(m)) return 0;
1585 138 : switch(o)
1586 : {
1587 0 : case 1: return m+1;
1588 12 : case 2: return m+1;
1589 72 : case 3: case 6: return (m+c3[m%3])/3;
1590 0 : case 4: return m%4 == 0 ? (m+2)/2: m/2;
1591 18 : case 8: return m%4 == 0 ? (m+4)/4: (m-2)/4;
1592 30 : case 12: return (m+c12[(m%12)/2])/6;
1593 6 : case 24: return (m+c24[(m%12)/2])/12;
1594 : }
1595 0 : return 0;
1596 : }
1597 :
1598 : static long
1599 84 : ellsympow_epsm(long o, long m) { return m + 1 - ellsympow_betam(o, m); }
1600 :
1601 : static GEN
1602 84 : ellsympow_multred(GEN E, GEN p, long m, long vN, long *cnd, long *w)
1603 : {
1604 84 : if (vN == 1 || !odd(m))
1605 : {
1606 84 : GEN s = (odd(m) && signe(ellap(E,p)) < 0)? gen_1: gen_m1;
1607 84 : *cnd = m;
1608 84 : *w = odd(m)? ellrootno(E, p): 1;
1609 84 : return deg1pol_shallow(s, gen_1, 0);
1610 : }
1611 : else
1612 : {
1613 0 : *cnd = equaliu(p,2)? ((m+1)>>1) * vN: m+1;
1614 0 : *w = (m & 3) == 1? ellrootno(E, p): 1;
1615 0 : return pol_1(0);
1616 : }
1617 : }
1618 :
1619 : static GEN
1620 84 : ellsympow_nonabelian(GEN p, long m, long bet)
1621 : {
1622 84 : GEN q = powiu(p, m >> 1), q2 = sqri(q), F;
1623 84 : if (odd(m))
1624 : {
1625 30 : q2 = mulii(q2, p); /* p^m */
1626 30 : return gpowgs(deg2pol_shallow(q2, gen_0, gen_1, 0), bet>>1);
1627 : }
1628 54 : togglesign_safe(&q2);
1629 54 : F = gpowgs(deg2pol_shallow(q2, gen_0, gen_1, 0), bet>>1);
1630 54 : if (!odd(bet)) return F;
1631 24 : if (m%4 != 2) togglesign_safe(&q);
1632 24 : return gmul(F, deg1pol_shallow(q, gen_1, 0));
1633 : }
1634 :
1635 : static long
1636 0 : safe_Z_pvalrem(GEN n, GEN p, GEN *pr)
1637 0 : { return signe(n)==0? -1: Z_pvalrem(n, p, pr); }
1638 :
1639 : static GEN
1640 0 : c4c6_ap(GEN c4, GEN c6, GEN p)
1641 : {
1642 0 : GEN N = Fp_ellcard(Fp_muls(c4, -27, p), Fp_muls(c6, -54, p), p);
1643 0 : return subii(addiu(p, 1), N);
1644 : }
1645 :
1646 : static GEN
1647 0 : ellsympow_abelian_twist(GEN E, GEN p, long m, long o)
1648 : {
1649 0 : GEN ap, c4t, c6t, c4 = ell_get_c4(E), c6 = ell_get_c6(E);
1650 0 : long v4 = safe_Z_pvalrem(c4, p, &c4t);
1651 0 : long v6 = safe_Z_pvalrem(c6, p, &c6t);
1652 0 : if (v6>=0 && (v4==-1 || 3*v4>=2*v6)) c6 = c6t;
1653 0 : if (v4>=0 && (v6==-1 || 3*v4<=2*v6)) c4 = c4t;
1654 0 : ap = c4c6_ap(c4, c6, p);
1655 0 : return ellsympow_abelian(p, ap, m, o);
1656 : }
1657 :
1658 : static GEN
1659 0 : ellsympow_goodred(GEN E, GEN p, long m, long *cnd, long *w)
1660 : {
1661 0 : long o = 12/cgcd(12, Z_pval(ell_get_disc(E), p));
1662 0 : long bet = ellsympow_betam(o, m);
1663 0 : long eps = m + 1 - bet;
1664 0 : *w = odd(m) && odd(eps>>1) ? ellrootno(E,p): 1;
1665 0 : *cnd = eps;
1666 0 : if (umodiu(p, o) == 1)
1667 0 : return ellsympow_abelian_twist(E, p, m, o);
1668 : else
1669 0 : return ellsympow_nonabelian(p, m, bet);
1670 : }
1671 :
1672 : static long
1673 60 : ellsympow_inertia3(GEN E, long vN)
1674 : {
1675 60 : long vD = Z_lval(ell_get_disc(E), 3);
1676 60 : if (vN==2) return vD%2==0 ? 2: 4;
1677 60 : if (vN==4) return vD%4==0 ? 3: 6;
1678 60 : if (vN==3 || vN==5) return 12;
1679 0 : return 0;
1680 : }
1681 :
1682 : static long
1683 60 : ellsympow_deltam3(long o, long m, long vN)
1684 : {
1685 60 : if (o==3 || o==6) return ellsympow_epsm(3, m);
1686 60 : if (o==12 && vN ==3) return (ellsympow_epsm(3, m))/2;
1687 0 : if (o==12 && vN ==5) return (ellsympow_epsm(3, m))*3/2;
1688 0 : return 0;
1689 : }
1690 :
1691 : static long
1692 0 : ellsympow_isabelian3(GEN E)
1693 : {
1694 0 : ulong c4 = umodiu(ell_get_c4(E),81), c6 = umodiu(ell_get_c6(E), 243);
1695 0 : return (c4 == 27 || (c4%27==9 && (c6==108 || c6==135)));
1696 : }
1697 :
1698 : static long
1699 30 : ellsympow_rootno3(GEN E, GEN p, long o, long m)
1700 : {
1701 30 : const long w6p[]={1,-1,-1,-1,1,1};
1702 30 : const long w6n[]={-1,1,-1,1,-1,1};
1703 30 : const long w12p[]={1,1,-1,1,1,1};
1704 30 : const long w12n[]={-1,-1,-1,-1,-1,1};
1705 30 : long w = ellrootno(E, p), mm = (m%12)>>1;
1706 30 : switch(o)
1707 : {
1708 0 : case 2: return m%4== 1 ? -1: 1;
1709 0 : case 6: return w == 1 ? w6p[mm]: w6n[mm];
1710 30 : case 12: return w == 1 ? w12p[mm]: w12n[mm];
1711 0 : default: return 1;
1712 : }
1713 : }
1714 :
1715 : static GEN
1716 60 : ellsympow_goodred3(GEN E, GEN F, GEN p, long m, long vN, long *cnd, long *w)
1717 : {
1718 60 : long o = ellsympow_inertia3(E, vN);
1719 60 : long bet = ellsympow_betam(o, m);
1720 60 : *cnd = m + 1 - bet + ellsympow_deltam3(o, m, vN);
1721 60 : *w = odd(m)? ellsympow_rootno3(E, p, o, m): 1;
1722 60 : if (o==1 || o==2)
1723 0 : return ellsympow_abelian(p, ellap(F, p), m, o);
1724 60 : if ((o==3 || o==6) && ellsympow_isabelian3(F))
1725 0 : return ellsympow_abelian(p, p, m, o);
1726 : else
1727 60 : return ellsympow_nonabelian(p, m, bet);
1728 : }
1729 :
1730 : static long
1731 24 : ellsympow_inertia2(GEN F, long vN)
1732 : {
1733 24 : long vM = itos(gel(elllocalred(F, gen_2),1));
1734 24 : GEN c6 = ell_get_c6(F);
1735 24 : long v6 = signe(c6) ? vali(c6): 24;
1736 24 : if (vM==0) return vN==0 ? 1: 2;
1737 24 : if (vM==2) return vN==2 ? 3: 6;
1738 12 : if (vM==5) return 8;
1739 6 : if (vM==8) return v6>=9? 8: 4;
1740 6 : if (vM==3 || vN==7) return 24;
1741 0 : return 0;
1742 : }
1743 :
1744 : static long
1745 24 : ellsympow_deltam2(long o, long m, long vN)
1746 : {
1747 24 : if ((o==2 || o==6) && vN==4) return ellsympow_epsm(2, m);
1748 24 : if ((o==2 || o==6) && vN==6) return 2*ellsympow_epsm(2, m);
1749 24 : if (o==4) return 2*ellsympow_epsm(4, m)+ellsympow_epsm(2, m);
1750 24 : if (o==8 && vN==5) return ellsympow_epsm(8, m)+ellsympow_epsm(2, m)/2;
1751 18 : if (o==8 && vN==6) return ellsympow_epsm(8, m)+ellsympow_epsm(2, m);
1752 18 : if (o==8 && vN==8) return ellsympow_epsm(8, m)+ellsympow_epsm(4, m)+ellsympow_epsm(2, m);
1753 18 : if (o==24 && vN==3) return (2*ellsympow_epsm(8, m)+ellsympow_epsm(2, m))/6;
1754 12 : if (o==24 && vN==4) return (ellsympow_epsm(8, m)+ellsympow_epsm(2, m)*2)/3;
1755 12 : if (o==24 && vN==6) return (ellsympow_epsm(8, m)+ellsympow_epsm(2, m)*5)/3;
1756 12 : if (o==24 && vN==7) return (ellsympow_epsm(8, m)*10+ellsympow_epsm(2, m)*5)/6;
1757 12 : return 0;
1758 : }
1759 :
1760 : static long
1761 0 : ellsympow_isabelian2(GEN F)
1762 0 : { return umodi2n(ell_get_c4(F),7) == 96; }
1763 :
1764 : static long
1765 0 : ellsympow_rootno2(GEN E, long vN, long m, long bet)
1766 : {
1767 0 : long eps2 = (m + 1 - bet)>>1;
1768 0 : long eta = odd(vN) && m%8==3 ? -1 : 1;
1769 0 : long w2 = odd(eps2) ? ellrootno(E, gen_2): 1;
1770 0 : return eta == w2 ? 1 : -1;
1771 : }
1772 :
1773 : static GEN
1774 24 : ellsympow_goodred2(GEN E, GEN F, GEN p, long m, long vN, long *cnd, long *w)
1775 : {
1776 24 : long o = ellsympow_inertia2(F, vN);
1777 24 : long bet = ellsympow_betam(o, m);
1778 24 : *cnd = m + 1 - bet + ellsympow_deltam2(o, m, vN);
1779 24 : *w = odd(m) ? ellsympow_rootno2(E, vN, m, bet): 1;
1780 24 : if (o==1 || o==2)
1781 0 : return ellsympow_abelian(p, ellap(F, p), m, o);
1782 24 : if (o==4 && ellsympow_isabelian2(F))
1783 0 : return ellsympow_abelian(p, p, m, o);
1784 : else
1785 24 : return ellsympow_nonabelian(p, m, bet);
1786 : }
1787 :
1788 : static GEN
1789 162 : ellminimaldotwist(GEN E, GEN *pD)
1790 : {
1791 162 : GEN D = ellminimaltwistcond(E), Et = elltwist(E, D), Etmin;
1792 162 : if (pD) *pD = D;
1793 162 : Etmin = ellminimalmodel(Et, NULL);
1794 162 : obj_free(Et); return Etmin;
1795 : }
1796 :
1797 : /* Based on
1798 : Symmetric powers of elliptic curve L-functions,
1799 : Phil Martin and Mark Watkins, ANTS VII
1800 : <http://magma.maths.usyd.edu.au/users/watkins/papers/antsVII.pdf>
1801 : with thanks to Mark Watkins. BA20180402
1802 : */
1803 : static GEN
1804 120 : lfunellsympow(GEN e, ulong m)
1805 : {
1806 120 : pari_sp av = avma;
1807 : GEN B, N, Nfa, pr, ex, ld, bad, ejd, et, pole;
1808 120 : long i, l, mero, w = (m&7)==1 || (m&7)==3 ? -1: 1;
1809 120 : checkell_Q(e);
1810 120 : e = ellminimalmodel(e, NULL);
1811 120 : ejd = Q_denom(ell_get_j(e));
1812 120 : mero = m==0 || (m%4==0 && ellQ_get_CM(e)<0);
1813 120 : ellQ_get_Nfa(e, &N, &Nfa);
1814 120 : pr = gel(Nfa,1);
1815 120 : ex = gel(Nfa,2); l = lg(pr);
1816 120 : if (ugcdiu(N,6) == 1)
1817 18 : et = NULL;
1818 : else
1819 102 : et = ellminimaldotwist(e, NULL);
1820 120 : B = gen_1;
1821 120 : bad = cgetg(l, t_VEC);
1822 288 : for (i=1; i<l; i++)
1823 : {
1824 168 : long vN = itos(gel(ex,i));
1825 168 : GEN p = gel(pr,i), eul;
1826 : long cnd, wp;
1827 168 : if (dvdii(ejd, p))
1828 84 : eul = ellsympow_multred(e, p, m, vN, &cnd, &wp);
1829 84 : else if (equaliu(p, 2))
1830 24 : eul = ellsympow_goodred2(e, et, p, m, vN, &cnd, &wp);
1831 60 : else if (equaliu(p, 3))
1832 60 : eul = ellsympow_goodred3(e, et, p, m, vN, &cnd, &wp);
1833 : else
1834 0 : eul = ellsympow_goodred(e, p, m, &cnd, &wp);
1835 168 : gel(bad, i) = mkvec2(p, ginv(eul));
1836 168 : B = mulii(B, powiu(p,cnd));
1837 168 : w *= wp;
1838 : }
1839 120 : pole = mero ? mkvec(mkvec2(stoi(1+(m>>1)),gen_0)): NULL;
1840 240 : ld = mkvecn(mero? 7: 6, tag(mkvec2(mkvec2(e,utoi(m)),bad), t_LFUN_SYMPOW_ELL),
1841 120 : gen_0, ellsympow_gamma(m), stoi(m+1), B, stoi(w), pole);
1842 120 : if (et) obj_free(et);
1843 120 : return gc_GEN(av, ld);
1844 : }
1845 :
1846 : GEN
1847 60 : lfunsympow(GEN ldata, ulong m)
1848 : {
1849 60 : ldata = lfunmisc_to_ldata_shallow(ldata);
1850 60 : if (ldata_get_type(ldata) != t_LFUN_ELL)
1851 0 : pari_err_IMPL("lfunsympow");
1852 60 : return lfunellsympow(gel(ldata_get_an(ldata), 2), m);
1853 : }
1854 :
1855 : static GEN
1856 114 : check_0(GEN z, long bit) { return gexpo(z) < -bit? gen_0: z; }
1857 : static GEN
1858 114 : check_real(GEN z, long bit)
1859 : {
1860 114 : if (typ(z) != t_COMPLEX) return check_0(z, bit);
1861 0 : if (check_0(gel(z,2), bit) != gen_0) pari_err_BUG("lfunmfspec");
1862 0 : return check_0(gel(z,1), bit);
1863 : }
1864 : static GEN
1865 36 : lfunmfspec_i(GEN lmisc, long bit)
1866 : {
1867 : GEN linit, ldataf, v, ve, vo, om, op, B, dom;
1868 : long k, k2, bit2, j;
1869 :
1870 36 : ldataf = lfunmisc_to_ldata_shallow(lmisc);
1871 36 : if (!gequal(ldata_get_gammavec(ldataf), mkvec2(gen_0,gen_1)))
1872 0 : pari_err_TYPE("lfunmfspec", lmisc);
1873 36 : k = gtos(ldata_get_k(ldataf));
1874 36 : if (k == 1) return mkvec2(cgetg(1, t_VEC), gen_1);
1875 30 : dom = mkvec3(dbltor(k/2.), dbltor((k-2)/2.), gen_0);
1876 30 : if (is_linit(lmisc) && linit_get_type(lmisc) == t_LDESC_INIT
1877 0 : && sdomain_isincl((double)k, dom, lfun_get_dom(linit_get_tech(lmisc))))
1878 0 : linit = lmisc;
1879 : else
1880 30 : linit = lfuninit(ldataf, dom, 0, bit);
1881 30 : B = int2n(bit/4);
1882 30 : v = cgetg(k, t_VEC);
1883 204 : for (j = 1; j < k; j++) gel(v,j) = lfunlambda(linit, utoi(j), bit);
1884 30 : om = gel(v,1);
1885 30 : if (odd(k)) return mkvec2(bestappr(gdiv(v, om), B), om);
1886 :
1887 18 : k2 = k/2; bit2 = bit/2;
1888 18 : ve = cgetg(k2, t_VEC);
1889 18 : vo = cgetg(k2+1, t_VEC);
1890 18 : gel(vo,1) = check_real(gel(v,1), bit2);
1891 66 : for (j = 1; j < k2; j++)
1892 : {
1893 48 : gel(ve,j) = check_real(gel(v,2*j), bit2);
1894 48 : gel(vo,j+1) = check_real(gel(v,2*j+1), bit2);
1895 : }
1896 18 : if (k2 == 1) { om = gen_1; op = gel(vo,1); }
1897 : else
1898 : {
1899 18 : om = gel(ve,1); if (om != gen_0) ve = gdiv(ve, om);
1900 18 : op = gel(vo,2);
1901 18 : if (gexpo(op) < -bit2) op = gel(vo,1); /* should happen only in weight 6 */
1902 18 : if (op != gen_0) vo = gdiv(vo, op);
1903 : }
1904 18 : return mkvec4(bestappr(ve,B), bestappr(vo,B), om, op);
1905 : }
1906 : GEN
1907 36 : lfunmfspec(GEN lmisc, long bit)
1908 : {
1909 36 : pari_sp av = avma;
1910 36 : return gc_GEN(av, lfunmfspec_i(lmisc, bit));
1911 : }
1912 :
1913 : static long
1914 24 : ellsymsq_bad2(GEN c4, GEN c6, long e)
1915 : {
1916 24 : switch (e)
1917 : {
1918 12 : case 2: return 1;
1919 6 : case 3: return 0;
1920 6 : case 5: return 0;
1921 0 : case 7: return 0;
1922 0 : case 8:
1923 0 : if (!umodi2n(c6,9)) return 0;
1924 0 : return umodi2n(c4,7)==32 ? 1 : -1;
1925 0 : default: return 0;
1926 : }
1927 : }
1928 : static long
1929 12 : ellsymsq_bad3(GEN c4, GEN c6, long e)
1930 : {
1931 : long c6_243, c4_81;
1932 12 : switch (e)
1933 : {
1934 0 : case 2: return 1;
1935 12 : case 3: return 0;
1936 0 : case 5: return 0;
1937 0 : case 4:
1938 0 : c4_81 = umodiu(c4,81);
1939 0 : if (c4_81 == 27) return -1;
1940 0 : if (c4_81%27 != 9) return 1;
1941 0 : c6_243 = umodiu(c6,243);
1942 0 : return (c6_243==108 || c6_243==135)? -1: 1;
1943 0 : default: return 0;
1944 : }
1945 : }
1946 : static int
1947 0 : c4c6_testp(GEN c4, GEN c6, GEN p)
1948 0 : { GEN p2 = sqri(p); return (dvdii(c6,p2) && !dvdii(c4,p2)); }
1949 : /* assume e = v_p(N) >= 2 */
1950 : static long
1951 36 : ellsymsq_badp(GEN c4, GEN c6, GEN p, long e)
1952 : {
1953 36 : if (absequaliu(p, 2)) return ellsymsq_bad2(c4, c6, e);
1954 12 : if (absequaliu(p, 3)) return ellsymsq_bad3(c4, c6, e);
1955 0 : switch(umodiu(p, 12UL))
1956 : {
1957 0 : case 1: return -1;
1958 0 : case 5: return c4c6_testp(c4,c6,p)? -1: 1;
1959 0 : case 7: return c4c6_testp(c4,c6,p)? 1:-1;
1960 0 : default:return 1; /* p%12 = 11 */
1961 : }
1962 : }
1963 : static GEN
1964 60 : lfunellsymsqmintwist(GEN e)
1965 : {
1966 60 : pari_sp av = avma;
1967 : GEN N, Nfa, P, E, V, c4, c6, ld;
1968 : long i, l, k;
1969 60 : checkell_Q(e);
1970 60 : e = ellminimalmodel(e, NULL);
1971 60 : ellQ_get_Nfa(e, &N, &Nfa);
1972 60 : c4 = ell_get_c4(e);
1973 60 : c6 = ell_get_c6(e);
1974 60 : P = gel(Nfa,1); l = lg(P);
1975 60 : E = gel(Nfa,2);
1976 60 : V = cgetg(l, t_VEC);
1977 168 : for (i=k=1; i<l; i++)
1978 : {
1979 108 : GEN p = gel(P,i);
1980 108 : long a, e = itos(gel(E,i));
1981 108 : if (e == 1) continue;
1982 36 : a = ellsymsq_badp(c4, c6, p, e);
1983 36 : gel(V,k++) = mkvec2(p, stoi(a));
1984 : }
1985 60 : setlg(V, k);
1986 60 : ld = lfunellsympow(e, 2);
1987 60 : return gc_GEN(av, mkvec2(ld, V));
1988 : }
1989 :
1990 : static GEN
1991 60 : mfpeters(GEN ldata2, GEN fudge, GEN N, long k, long bitprec)
1992 : {
1993 60 : GEN t, L = real_i(lfun(ldata2, stoi(k), bitprec));
1994 60 : long prec = nbits2prec(bitprec);
1995 60 : t = powrs(mppi(prec), k+1); shiftr_inplace(t, 2*k-1); /* Pi/2 * (4Pi)^k */
1996 60 : return gmul(gdiv(gmul(mulii(N,mpfact(k-1)), fudge), t), L);
1997 : }
1998 :
1999 : /* Assume E to be twist-minimal */
2000 : static GEN
2001 60 : lfunellmfpetersmintwist(GEN E, long bitprec)
2002 : {
2003 60 : pari_sp av = avma;
2004 60 : GEN symsq, veceuler, N = ellQ_get_N(E), fudge = gen_1;
2005 60 : long j, k = 2;
2006 60 : symsq = lfunellsymsqmintwist(E);
2007 60 : veceuler = gel(symsq,2);
2008 96 : for (j = 1; j < lg(veceuler); j++)
2009 : {
2010 36 : GEN v = gel(veceuler,j), p = gel(v,1), q = powis(p,1-k);
2011 36 : long s = signe(gel(v,2));
2012 36 : if (s) fudge = gmul(fudge, s==1 ? gaddsg(1, q): gsubsg(1, q));
2013 : }
2014 60 : return gc_upto(av, mfpeters(gel(symsq,1),fudge,N,k,bitprec));
2015 : }
2016 :
2017 : /* From Christophe Delaunay, http://delaunay.perso.math.cnrs.fr/these.pdf */
2018 : static GEN
2019 60 : elldiscfix(GEN E, GEN Et, GEN D)
2020 : {
2021 60 : GEN N = ellQ_get_N(E), Nt = ellQ_get_N(Et);
2022 60 : GEN P = gel(absZ_factor(D), 1);
2023 60 : GEN f = gen_1;
2024 60 : long i, l = lg(P);
2025 114 : for (i=1; i < l; i++)
2026 : {
2027 54 : GEN r, p = gel(P,i);
2028 54 : long v = Z_pval(N, p), vt = Z_pval(Nt, p);
2029 54 : if (v <= vt) continue;
2030 : /* v > vt */
2031 42 : if (absequaliu(p, 2))
2032 : {
2033 24 : if (vt == 0 && v >= 4)
2034 0 : r = shifti(subsi(9, sqri(ellap(Et, p))), v-3); /* 9=(2+1)^2 */
2035 24 : else if (vt == 1)
2036 6 : r = gmul2n(utoipos(3), v-3); /* not in Z if v=2 */
2037 18 : else if (vt >= 2)
2038 18 : r = int2n(v-vt);
2039 : else
2040 0 : r = gen_1; /* vt = 0, 1 <= v <= 3 */
2041 : }
2042 18 : else if (vt >= 1)
2043 12 : r = gdiv(subiu(sqri(p), 1), p);
2044 : else
2045 6 : r = gdiv(mulii(subiu(p, 1), subii(sqri(addiu(p, 1)), sqri(ellap(Et, p)))), p);
2046 42 : f = gmul(f, r);
2047 : }
2048 60 : return f;
2049 : }
2050 :
2051 : GEN
2052 60 : lfunellmfpeters(GEN E, long bitprec)
2053 : {
2054 60 : pari_sp ltop = avma;
2055 60 : GEN D, Et = ellminimaldotwist(E, &D);
2056 60 : GEN nor = lfunellmfpetersmintwist(Et, bitprec);
2057 60 : GEN nor2 = gmul(nor, elldiscfix(E, Et, D));
2058 60 : obj_free(Et); return gc_upto(ltop, nor2);
2059 : }
2060 :
2061 : /*************************************************************/
2062 : /* Genus 2 curves */
2063 : /*************************************************************/
2064 :
2065 : static GEN
2066 1836 : Flx_difftable(GEN P, ulong p)
2067 : {
2068 1836 : long i, n = degpol(P);
2069 1836 : GEN V = cgetg(n+2, t_VECSMALL);
2070 1836 : uel(V, n+1) = Flx_constant(P);
2071 12852 : for(i = n; i >= 1; i--)
2072 : {
2073 11016 : P = Flx_diff1(P, p);
2074 11016 : uel(V, i) = Flx_constant(P);
2075 : }
2076 1836 : return V;
2077 : }
2078 :
2079 : static long
2080 1836 : Flx_genus2trace_naive(GEN H, ulong p)
2081 : {
2082 1836 : pari_sp av = avma;
2083 : ulong i, j;
2084 1836 : long a, n = degpol(H);
2085 1836 : GEN k = const_vecsmall(p, -1), d;
2086 1836 : k[1] = 0;
2087 104166 : for (i=1, j=1; i < p; i += 2, j = Fl_add(j, i, p))
2088 102330 : k[j+1] = 1;
2089 1836 : a = n == 5 ? 0: k[1+Flx_lead(H)];
2090 1836 : d = Flx_difftable(H, p);
2091 208332 : for (i=0; i < p; i++)
2092 : {
2093 206496 : a += k[1+uel(d,n+1)];
2094 206496 : if (n==6)
2095 206496 : uel(d,7) = Fl_add(uel(d,7), uel(d,6), p);
2096 206496 : uel(d,6) = Fl_add(uel(d,6), uel(d,5), p);
2097 206496 : uel(d,5) = Fl_add(uel(d,5), uel(d,4), p);
2098 206496 : uel(d,4) = Fl_add(uel(d,4), uel(d,3), p);
2099 206496 : uel(d,3) = Fl_add(uel(d,3), uel(d,2), p);
2100 206496 : uel(d,2) = Fl_add(uel(d,2), uel(d,1), p);
2101 : }
2102 1836 : return gc_long(av, a);
2103 : }
2104 :
2105 : static GEN
2106 1986 : dirgenus2(GEN Q, GEN p, long n)
2107 : {
2108 1986 : pari_sp av = avma;
2109 : GEN f;
2110 1986 : if (n > 2)
2111 150 : f = RgX_recip(hyperellcharpoly(gmul(Q,gmodulo(gen_1, p))));
2112 : else
2113 : {
2114 1836 : ulong pp = itou(p);
2115 1836 : GEN Qp = ZX_to_Flx(Q, pp);
2116 1836 : long t = Flx_genus2trace_naive(Qp, pp);
2117 1836 : f = deg1pol_shallow(stoi(t), gen_1, 0);
2118 : }
2119 1986 : return gc_upto(av, RgXn_inv_i(f, n));
2120 : }
2121 :
2122 : GEN
2123 792 : dirgenus2_worker(GEN P, ulong X, GEN Q)
2124 : {
2125 792 : pari_sp av = avma;
2126 792 : long i, l = lg(P);
2127 792 : GEN V = cgetg(l, t_VEC);
2128 2778 : for(i = 1; i < l; i++)
2129 : {
2130 1986 : ulong p = uel(P,i);
2131 1986 : long d = ulogint(X, p) + 1; /* minimal d such that p^d > X */
2132 1986 : gel(V,i) = dirgenus2(Q, utoi(uel(P,i)), d);
2133 : }
2134 792 : return gc_GEN(av, mkvec2(P,V));
2135 : }
2136 :
2137 : static GEN
2138 174 : vecan_genus2(GEN an, long L)
2139 : {
2140 174 : GEN Q = gel(an,1), bad = gel(an, 2);
2141 174 : GEN worker = snm_closure(is_entry("_dirgenus2_worker"), mkvec(Q));
2142 174 : return pardireuler(worker, gen_2, stoi(L), NULL, bad);
2143 : }
2144 :
2145 : static GEN
2146 0 : eulerf_genus2(GEN an, GEN p)
2147 : {
2148 0 : GEN Q = gel(an,1), bad = gel(an, 2);
2149 0 : GEN f = eulerf_bad(bad, p);
2150 0 : if (f) return f;
2151 0 : f = RgX_recip(hyperellcharpoly(gmul(Q,gmodulo(gen_1, p))));
2152 0 : return mkrfrac(gen_1,f);
2153 : }
2154 :
2155 : GEN
2156 36 : lfungenus2(GEN G)
2157 : {
2158 36 : pari_sp ltop = avma;
2159 : GEN Ldata;
2160 36 : GEN gr = genus2red(G, NULL);
2161 36 : GEN N = gel(gr, 1), M = gel(gr, 2), PQ = gel(gr, 3), L = gel(gr, 4);
2162 36 : GEN e, F = gadd(gsqr(gel(PQ, 2)), gmul2n(gel(PQ, 1), 2));
2163 36 : long i, lL = lg(L), ram2;
2164 36 : ram2 = absequaliu(gmael(M,1,1),2);
2165 36 : if (ram2 && equalis(gmael(M,2,1),-1))
2166 18 : pari_warn(warner,"unknown valuation of conductor at 2");
2167 36 : e = cgetg(lL+(ram2?0:1), t_VEC);
2168 54 : gel(e,1) = mkvec2(gen_2, ram2 ? ginv(RgX_recip(genus2_eulerfact2(F, PQ)))
2169 18 : : ginv(RgX_recip(hyperellcharpoly(gmul(PQ,gmodulss(1,2))))) );
2170 90 : for(i = ram2? 2: 1; i < lL; i++)
2171 : {
2172 54 : GEN Li = gel(L, i);
2173 54 : GEN p = gel(Li, 1), r = gel(Li, 4);
2174 54 : gel(e, ram2 ? i: i+1) = mkvec2(p, ginv(RgX_recip(genus2_eulerfact(F,p, r[1],r[2]))));
2175 : }
2176 36 : Ldata = mkvecn(6, tag(mkvec2(F,e), t_LFUN_GENUS2),
2177 : gen_0, mkvec4(gen_0, gen_0, gen_1, gen_1), gen_2, N, gen_0);
2178 36 : return gc_GEN(ltop, Ldata);
2179 : }
2180 :
2181 : /*************************************************************/
2182 : /* ETA QUOTIENTS */
2183 : /* An eta quotient is a matrix with 2 columns [m, r_m] with */
2184 : /* m >= 1 representing f(\tau)=\prod_m\eta(m\tau)^{r_m}. */
2185 : /*************************************************************/
2186 :
2187 : /* eta(x^v) + O(x^L) */
2188 : GEN
2189 1042 : eta_ZXn(long v, long L)
2190 : {
2191 1042 : long n, k = 0, v2 = 2*v, bn = v, cn = 0;
2192 : GEN P;
2193 1042 : if (!L) return zeropol(0);
2194 1042 : P = cgetg(L+2,t_POL); P[1] = evalsigne(1);
2195 60979 : for(n = 0; n < L; n++) gel(P,n+2) = gen_0;
2196 1042 : for(n = 0;; n++, bn += v2, cn += v)
2197 2540 : { /* k = v * (3*n-1) * n / 2; bn = v * (2*n+1); cn = v * n */
2198 : long k2;
2199 3582 : gel(P, k+2) = odd(n)? gen_m1: gen_1;
2200 3582 : k2 = k+cn; if (k2 >= L) break;
2201 3198 : k = k2;
2202 : /* k = v * (3*n+1) * n / 2 */;
2203 3198 : gel(P, k+2) = odd(n)? gen_m1: gen_1;
2204 3198 : k2 = k+bn; if (k2 >= L) break;
2205 2540 : k = k2;
2206 : }
2207 1042 : setlg(P, k+3); return P;
2208 : }
2209 : GEN
2210 276 : eta_product_ZXn(GEN eta, long L)
2211 : {
2212 276 : pari_sp av = avma;
2213 276 : GEN P = NULL, D = gel(eta,1), R = gel(eta,2);
2214 276 : long i, l = lg(D);
2215 984 : for (i = 1; i < l; ++i)
2216 : {
2217 708 : GEN Q = eta_ZXn(D[i], L);
2218 708 : long r = R[i];
2219 708 : if (r < 0) { Q = RgXn_inv_i(Q, L); r = -r; }
2220 708 : if (r != 1) Q = RgXn_powu_i(Q, r, L);
2221 708 : P = P? ZXn_mul(P, Q, L): Q;
2222 708 : if (gc_needed(av,1) && i > 1)
2223 : {
2224 0 : if (DEBUGMEM>1) pari_warn(warnmem,"eta_product_ZXn");
2225 0 : P = gc_GEN(av, P);
2226 : }
2227 : }
2228 276 : return P;
2229 : }
2230 : static GEN
2231 126 : vecan_eta(GEN an, long L)
2232 : {
2233 126 : long v = itos(gel(an, 3));
2234 : GEN t;
2235 126 : if (v > L) return zerovec(L);
2236 120 : t = eta_product_ZXn(an, L - v);
2237 120 : if (v) t = RgX_shift_shallow(t, v);
2238 120 : return RgX_to_RgV(t, L);
2239 : }
2240 : /* return 1 if cuspidal, 0 if holomorphic, -1 otherwise */
2241 : static int
2242 198 : etacuspidal(GEN N, GEN k, GEN B, GEN R, GEN NB)
2243 : {
2244 198 : long i, j, lD, l, cusp = 1;
2245 198 : pari_sp av = avma;
2246 : GEN D;
2247 198 : if (gsigne(k) < 0) return -1;
2248 192 : D = divisors(N); lD = lg(D); l = lg(B);
2249 1290 : for (i = 1; i < lD; i++)
2250 : {
2251 1098 : GEN t = gen_0, d = gel(D,i);
2252 : long s;
2253 3426 : for (j = 1; j < l; j++)
2254 2328 : t = addii(t, mulii(gel(NB,j), mulii(gel(R,j), sqri(gcdii(d, gel(B,j))))));
2255 1098 : s = signe(t);
2256 1098 : if (s < 0) return -1;
2257 1098 : if (!s) cusp = 0;
2258 : }
2259 192 : return gc_bool(av, cusp);
2260 : }
2261 : /* u | 24, level N = u*N0, N0 = lcm(B), NB[i] = N0/B[i] */
2262 : static int
2263 42 : etaselfdual(GEN B, GEN R, GEN NB, ulong u)
2264 : {
2265 42 : pari_sp av = avma;
2266 42 : long i, l = lg(B);
2267 138 : for (i = 1; i < l; i++)
2268 : {
2269 96 : long j = ZV_search(B, muliu(gel(NB,i), u)); /* search for N / B[i] */
2270 96 : set_avma(av); if (!j || !equalii(gel(R,i),gel(R,j))) return 0;
2271 : }
2272 42 : return 1;
2273 : }
2274 : /* return Nebentypus of eta quotient, k2 = 2*k integral */
2275 : static GEN
2276 174 : etachar(GEN B, GEN R, GEN k2)
2277 : {
2278 174 : long i, l = lg(B);
2279 174 : GEN P = gen_1;
2280 468 : for (i = 1; i < l; ++i) if (mpodd(gel(R,i))) P = mulii(P, gel(B,i));
2281 174 : switch(Mod4(k2))
2282 : {
2283 114 : case 0: break;
2284 36 : case 2: P = negi(P); break;
2285 24 : default: P = shifti(P, 1); break;
2286 : }
2287 174 : return coredisc(P);
2288 : }
2289 : /* Return 0 if not on gamma_0(N). Sets conductor, modular weight, character,
2290 : * canonical matrix, v_q(eta), sd = 1 iff self-dual, cusp = 1 iff cuspidal
2291 : * [0 if holomorphic at all cusps, else -1] */
2292 : long
2293 222 : etaquotype(GEN *peta, GEN *pN, GEN *pk, GEN *CHI, long *pv, long *sd,
2294 : long *cusp)
2295 : {
2296 222 : GEN B, R, S, T, N, NB, eta = *peta;
2297 : long l, i, u, S24;
2298 :
2299 222 : if (lg(eta) != 3) pari_err_TYPE("lfunetaquo", eta);
2300 222 : switch(typ(eta))
2301 : {
2302 66 : case t_VEC: eta = mkmat2(mkcol(gel(eta,1)), mkcol(gel(eta,2))); break;
2303 156 : case t_MAT: break;
2304 0 : default: pari_err_TYPE("lfunetaquo", eta);
2305 : }
2306 222 : if (!RgV_is_ZVpos(gel(eta,1)) || !RgV_is_ZV(gel(eta,2)))
2307 0 : pari_err_TYPE("lfunetaquo", eta);
2308 222 : *peta = eta = famat_reduce(eta);
2309 222 : B = gel(eta,1); l = lg(B); /* sorted in increasing order */
2310 222 : R = gel(eta,2);
2311 222 : N = ZV_lcm(B); NB = cgetg(l, t_VEC);
2312 618 : for (i = 1; i < l; i++) gel(NB,i) = diviiexact(N, gel(B,i));
2313 222 : S = gen_0; T = gen_0; u = 0;
2314 618 : for (i = 1; i < l; ++i)
2315 : {
2316 396 : GEN b = gel(B,i), r = gel(R,i);
2317 396 : S = addii(S, mulii(b, r));
2318 396 : T = addii(T, r);
2319 396 : u += umodiu(r,24) * umodiu(gel(NB,i), 24);
2320 : }
2321 222 : S = divis_rem(S, 24, &S24);
2322 222 : if (S24) return 0; /* nonintegral valuation at oo */
2323 216 : u = 24 / ugcd(24, u % 24);
2324 216 : *pN = muliu(N, u); /* level */
2325 216 : *pk = gmul2n(T,-1); /* weight */
2326 216 : *pv = itos(S); /* valuation */
2327 216 : if (cusp) *cusp = etacuspidal(*pN, *pk, B, R, NB);
2328 216 : if (sd) *sd = etaselfdual(B, R, NB, u);
2329 216 : if (CHI) *CHI = etachar(B, R, T);
2330 216 : return 1;
2331 : }
2332 :
2333 : GEN
2334 42 : lfunetaquo(GEN eta0)
2335 : {
2336 42 : pari_sp ltop = avma;
2337 42 : GEN Ldata, N, BR, k, eta = eta0;
2338 : long v, sd, cusp;
2339 42 : if (!etaquotype(&eta, &N, &k, NULL, &v, &sd, &cusp))
2340 0 : pari_err_TYPE("lfunetaquo", eta0);
2341 42 : if (!cusp) pari_err_IMPL("noncuspidal eta quotient");
2342 42 : if (!sd) pari_err_IMPL("non self-dual eta quotient");
2343 42 : if (typ(k) != t_INT) pari_err_TYPE("lfunetaquo [nonintegral weight]", eta0);
2344 42 : BR = mkvec3(ZV_to_zv(gel(eta,1)), ZV_to_zv(gel(eta,2)), stoi(v - 1));
2345 42 : Ldata = mkvecn(6, tag(BR,t_LFUN_ETA), gen_0, mkvec2(gen_0,gen_1), k,N, gen_1);
2346 42 : return gc_GEN(ltop, Ldata);
2347 : }
2348 :
2349 : static GEN
2350 342 : vecan_qf(GEN Q, long L)
2351 : {
2352 342 : GEN v, w = qfrep0(Q, utoi(L), 1);
2353 : long i;
2354 342 : v = cgetg(L+1, t_VEC);
2355 22884 : for (i = 1; i <= L; i++) gel(v,i) = utoi(2 * w[i]);
2356 342 : return v;
2357 : }
2358 :
2359 : long
2360 288 : qfiseven(GEN M)
2361 : {
2362 288 : long i, l = lg(M);
2363 672 : for (i=1; i<l; i++)
2364 582 : if (mpodd(gcoeff(M,i,i))) return 0;
2365 90 : return 1;
2366 : }
2367 :
2368 : GEN
2369 78 : lfunqf(GEN M, long prec)
2370 : {
2371 78 : pari_sp ltop = avma;
2372 : long n;
2373 : GEN k, D, d, Mi, Ldata, poles, eno, dual;
2374 :
2375 78 : if (typ(M) != t_MAT) pari_err_TYPE("lfunqf", M);
2376 78 : if (!RgM_is_ZM(M)) pari_err_TYPE("lfunqf [not integral]", M);
2377 78 : n = lg(M)-1;
2378 78 : k = uutoQ(n,2);
2379 78 : M = Q_primpart(M);
2380 78 : Mi = ZM_inv(M, &d); /* d M^(-1) */
2381 78 : if (!qfiseven(M)) { M = gmul2n(M, 1); d = shifti(d,1); }
2382 78 : if (!qfiseven(Mi)){ Mi= gmul2n(Mi,1); d = shifti(d,1); }
2383 : /* det(Mi) = d^n/det(M), D^2 = det(Mi)/det(M) */
2384 78 : D = gdiv(gpow(d,k,prec), ZM_det(M));
2385 78 : if (!issquareall(D, &eno)) eno = gsqrt(D, prec);
2386 78 : dual = gequal1(D) ? gen_0: tag(Mi, t_LFUN_QF);
2387 78 : poles = mkcol2(mkvec2(k, simple_pole(gmul2n(eno,1))),
2388 : mkvec2(gen_0, simple_pole(gen_m2)));
2389 78 : Ldata = mkvecn(7, tag(M, t_LFUN_QF), dual,
2390 : mkvec2(gen_0, gen_1), k, d, eno, poles);
2391 78 : return gc_GEN(ltop, Ldata);
2392 : }
2393 :
2394 : /********************************************************************/
2395 : /** Artin L function, based on a GP script by Charlotte Euvrard **/
2396 : /********************************************************************/
2397 :
2398 : static GEN
2399 102 : artin_charfromgens(GEN G, GEN M)
2400 : {
2401 102 : GEN R, V, ord = gal_get_orders(G), grp = gal_get_group(G);
2402 102 : long i, j, k, n = lg(ord)-1, m = lg(grp)-1;
2403 :
2404 102 : if (lg(M)-1 != n) pari_err_DIM("lfunartin");
2405 102 : R = cgetg(m+1, t_VEC);
2406 102 : gel(R, 1) = matid(lg(gel(M, 1))-1);
2407 306 : for (i = 1, k = 1; i <= n; ++i)
2408 : {
2409 204 : long c = k*(ord[i] - 1);
2410 204 : gel(R, ++k) = gel(M, i);
2411 894 : for (j = 2; j <= c; ++j) gel(R, ++k) = gmul(gel(R,j), gel(M,i));
2412 : }
2413 102 : V = cgetg(m+1, t_VEC);
2414 1098 : for (i = 1; i <= m; i++) gel(V, gel(grp,i)[1]) = gtrace(gel(R,i));
2415 102 : return V;
2416 : }
2417 :
2418 : /* TODO move somewhere else? */
2419 : GEN
2420 226 : galois_get_conj(GEN G)
2421 : {
2422 226 : GEN grp = gal_get_group(G);
2423 226 : long i, k, r = lg(grp)-1;
2424 226 : GEN b = zero_F2v(r);
2425 760 : for (k = 2; k <= r; ++k)
2426 : {
2427 760 : GEN g = gel(grp,k);
2428 760 : if (!F2v_coeff(b,g[1]) && g[g[1]]==1)
2429 : {
2430 314 : pari_sp av = avma;
2431 314 : GEN F = galoisfixedfield(G, g, 1, -1);
2432 314 : if (ZX_sturmpart(F, NULL) > 0) return gc_const(av, g);
2433 1096 : for (i = 1; i<=r; i++)
2434 : {
2435 1008 : GEN h = gel(grp, i);
2436 1008 : long t = h[1];
2437 3808 : while (h[t]!=1) t = h[t];
2438 1008 : F2v_set(b, h[g[t]]);
2439 : }
2440 88 : set_avma(av);
2441 : }
2442 : }
2443 0 : pari_err_BUG("galois_get_conj");
2444 : return NULL;/*LCOV_EXCL_LINE*/
2445 : }
2446 :
2447 6600 : static GEN cyclotoi(GEN v) { return simplify_shallow(lift_shallow(v)); }
2448 2478 : static long cyclotos(GEN v) { return gtos(cyclotoi(v)); }
2449 2418 : static long char_dim(GEN ch) { return cyclotos(gel(ch,1)); }
2450 :
2451 : static GEN
2452 1182 : artin_gamma(GEN N, GEN G, GEN ch)
2453 : {
2454 1182 : long a, t, d = char_dim(ch);
2455 1182 : if (nf_get_r2(N) == 0) return vec01(d, 0);
2456 60 : a = galois_get_conj(G)[1];
2457 60 : t = cyclotos(gel(ch,a));
2458 60 : return vec01((d+t) / 2, (d-t) / 2);
2459 : }
2460 :
2461 : static long
2462 2754 : artin_dim(GEN ind, GEN ch)
2463 : {
2464 2754 : long n = lg(ch)-1;
2465 2754 : GEN elts = group_elts(ind, n);
2466 2754 : long i, d = lg(elts)-1;
2467 2754 : GEN s = gen_0;
2468 15534 : for(i=1; i<=d; i++)
2469 12780 : s = gadd(s, gel(ch, gel(elts,i)[1]));
2470 2754 : return gtos(gdivgu(cyclotoi(s), d));
2471 : }
2472 :
2473 : static GEN
2474 534 : artin_ind(GEN elts, GEN ch, GEN p)
2475 : {
2476 534 : long i, d = lg(elts)-1;
2477 534 : GEN s = gen_0;
2478 1842 : for(i=1; i<=d; i++)
2479 1308 : s = gadd(s, gel(ch, gmul(gel(elts,i),p)[1]));
2480 534 : return gdivgu(s, d);
2481 : }
2482 :
2483 : static GEN
2484 1956 : artin_ram(GEN nf, GEN gal, GEN aut, GEN pr, GEN ramg, GEN ch, long d)
2485 : {
2486 1956 : pari_sp av = avma;
2487 : long i, v, n;
2488 : GEN p, q, V, elts;
2489 1956 : if (d==0) return pol_1(0);
2490 528 : n = degpol(gal_get_pol(gal));
2491 528 : q = p = idealramfrobenius_aut(nf, gal, pr, ramg, aut);
2492 528 : elts = group_elts(gel(ramg,2), n);
2493 528 : v = fetch_var_higher();
2494 528 : V = cgetg(d+2, t_POL);
2495 528 : V[1] = evalsigne(1)|evalvarn(v);
2496 1062 : for(i=1; i<=d; i++)
2497 : {
2498 534 : gel(V,i+1) = artin_ind(elts, ch, q);
2499 534 : q = gmul(q, p);
2500 : }
2501 528 : delete_var();
2502 528 : V = RgXn_expint(RgX_neg(V),d+1);
2503 528 : setvarn(V,0); return gc_upto(av, ginv(V));
2504 : }
2505 :
2506 : /* N true nf; [Artin conductor, vec of [p, Lp]] */
2507 : static GEN
2508 1182 : artin_badprimes(GEN N, GEN G, GEN aut, GEN ch)
2509 : {
2510 1182 : pari_sp av = avma;
2511 1182 : long i, d = char_dim(ch);
2512 1182 : GEN P = gel(absZ_factor(nf_get_disc(N)), 1);
2513 1182 : long lP = lg(P);
2514 1182 : GEN B = cgetg(lP, t_VEC), C = cgetg(lP, t_VEC);
2515 :
2516 3138 : for (i = 1; i < lP; ++i)
2517 : {
2518 1956 : GEN p = gel(P, i), pr = idealprimedec_galois(N, p);
2519 1956 : GEN J = idealramgroups_aut(N, G, pr, aut);
2520 1956 : GEN G0 = gel(J,2); /* inertia group */
2521 1956 : long lJ = lg(J);
2522 1956 : long sdec = artin_dim(G0, ch);
2523 1956 : long ndec = group_order(G0);
2524 1956 : long j, v = ndec * (d - sdec);
2525 2754 : for (j = 3; j < lJ; ++j)
2526 : {
2527 798 : GEN Jj = gel(J, j);
2528 798 : long s = artin_dim(Jj, ch);
2529 798 : v += group_order(Jj) * (d - s);
2530 : }
2531 1956 : gel(C, i) = powiu(p, v/ndec);
2532 1956 : gel(B, i) = mkvec2(p, artin_ram(N, G, aut, pr, J, ch, sdec));
2533 : }
2534 1182 : return gc_GEN(av, mkvec2(ZV_prod(C), B));
2535 : }
2536 :
2537 : /* p does not divide nf.index */
2538 : static GEN
2539 44916 : idealfrobenius_easy(GEN nf, GEN gal, GEN aut, GEN T, GEN p)
2540 : {
2541 44916 : long i, l = lg(aut), f = degpol(T);
2542 44916 : GEN D, Dzk, DzkT, DXp, grp = gal_get_group(gal);
2543 44916 : pari_sp av = avma;
2544 44916 : if (f==1) return gel(grp,1);
2545 43368 : Dzk = nf_get_zkprimpart(nf);
2546 43368 : D = modii(nf_get_zkden(nf), p);
2547 43368 : DzkT = RgV_to_RgM(FqV_red(Dzk, T, p), f);
2548 43368 : DXp = RgX_to_RgC(FpX_Frobenius(T, p), f);
2549 43368 : if (!equali1(D)) DXp = FpC_Fp_mul(DXp, D, p);
2550 284730 : for(i=1; i < l; i++)
2551 : {
2552 284730 : GEN g = gel(grp,i);
2553 284730 : if (perm_orderu(g) == (ulong)f)
2554 : {
2555 145956 : GEN A = FpM_FpC_mul(DzkT, gel(aut,g[1]), p);
2556 145956 : if (ZV_equal(A, DXp)) return gc_const(av, g);
2557 : }
2558 : }
2559 : return NULL; /* LCOV_EXCL_LINE */
2560 : }
2561 : /* true nf; p divides nf.index, pr/p unramified */
2562 : static GEN
2563 1368 : idealfrobenius_hard(GEN nf, GEN gal, GEN aut, GEN pr)
2564 : {
2565 1368 : long i, l = lg(aut), f = pr_get_f(pr);
2566 1368 : GEN modpr, p, T, X, Xp, pi, grp = gal_get_group(gal);
2567 1368 : pari_sp av = avma;
2568 1368 : if (f==1) return gel(grp,1);
2569 1152 : pi = pr_get_gen(pr);
2570 1152 : modpr = zkmodprinit(nf, pr);
2571 1152 : p = modpr_get_p(modpr);
2572 1152 : T = modpr_get_T(modpr);
2573 1152 : X = modpr_genFq(modpr);
2574 1152 : Xp = FpX_Frobenius(T, p);
2575 7890 : for (i = 1; i < l; i++)
2576 : {
2577 7890 : GEN g = gel(grp,i);
2578 7890 : if (perm_orderu(g) == (ulong)f)
2579 : {
2580 3762 : GEN S = gel(aut,g[1]);
2581 3762 : GEN A = nf_to_Fq(nf, zk_galoisapplymod(nf,X,S,p), modpr);
2582 : /* sigma(X) = X^p (mod pr) and sigma(pi) in pr */
2583 5010 : if (ZX_equal(A, Xp) && (f == nf_get_degree(nf) ||
2584 2400 : ZC_prdvd(zk_galoisapplymod(nf,pi,S,p),pr))) return gc_const(av, g);
2585 : }
2586 : }
2587 : return NULL; /* LCOV_EXCL_LINE */
2588 : }
2589 :
2590 : /* true nf */
2591 : static GEN
2592 46284 : dirartin(GEN nf, GEN G, GEN V, GEN aut, GEN p, long n)
2593 : {
2594 46284 : pari_sp av = avma;
2595 : GEN pr, frob;
2596 : /* pick one maximal ideal in the conjugacy class above p */
2597 46284 : GEN T = nf_get_pol(nf);
2598 46284 : if (!dvdii(nf_get_index(nf), p))
2599 : { /* simple case */
2600 44916 : GEN F = FpX_factor(T, p), P = gmael(F,1,1);
2601 44916 : frob = idealfrobenius_easy(nf, G, aut, P, p);
2602 : }
2603 : else
2604 : {
2605 1368 : pr = idealprimedec_galois(nf,p);
2606 1368 : frob = idealfrobenius_hard(nf, G, aut, pr);
2607 : }
2608 46284 : set_avma(av); return n ? RgXn_inv(gel(V, frob[1]), n): gel(V, frob[1]);
2609 : }
2610 :
2611 : GEN
2612 13428 : dirartin_worker(GEN P, ulong X, GEN nf, GEN G, GEN V, GEN aut)
2613 : {
2614 13428 : pari_sp av = avma;
2615 13428 : long i, l = lg(P);
2616 13428 : GEN W = cgetg(l, t_VEC);
2617 59688 : for(i = 1; i < l; i++)
2618 : {
2619 46260 : ulong p = uel(P,i);
2620 46260 : long d = ulogint(X, p) + 1; /* minimal d such that p^d > X */
2621 46260 : gel(W,i) = dirartin(nf, G, V, aut, utoi(uel(P,i)), d);
2622 : }
2623 13428 : return gc_GEN(av, mkvec2(P,W));
2624 : }
2625 :
2626 : static GEN
2627 2526 : vecan_artin(GEN an, long L, long prec)
2628 : {
2629 2526 : GEN A, Sbad = gel(an,5);
2630 2526 : long n = itos(gel(an,6)), isreal = lg(an)<8 ? 0: !itos(gel(an,7));
2631 2526 : GEN worker = snm_closure(is_entry("_dirartin_worker"), vecslice(an,1,4));
2632 2526 : A = lift_shallow(pardireuler(worker, gen_2, stoi(L), NULL, Sbad));
2633 2526 : A = RgXV_RgV_eval(A, grootsof1(n, prec));
2634 2526 : if (isreal) A = real_i(A);
2635 2526 : return A;
2636 : }
2637 :
2638 : static GEN
2639 24 : eulerf_artin(GEN an, GEN p, long prec)
2640 : {
2641 24 : GEN nf = gel(an,1), G = gel(an,2), V = gel(an,3), aut = gel(an,4);
2642 24 : GEN Sbad = gel(an,5);
2643 24 : long n = itos(gel(an,6)), isreal = lg(an)<8 ? 0: !itos(gel(an,7));
2644 24 : GEN f = eulerf_bad(Sbad, p);
2645 24 : if (!f) f = mkrfrac(gen_1,dirartin(nf, G, V, aut, p, 0));
2646 24 : f = gsubst(liftpol(f),1, rootsof1u_cx(n, prec));
2647 24 : if (isreal) f = real_i(f);
2648 24 : return f;
2649 : }
2650 :
2651 : static GEN
2652 2448 : char_expand(GEN conj, GEN ch)
2653 : {
2654 2448 : long i, l = lg(conj);
2655 2448 : GEN V = cgetg(l, t_COL);
2656 26922 : for (i=1; i<l; i++) gel(V,i) = gel(ch, conj[i]);
2657 2448 : return V;
2658 : }
2659 :
2660 : static GEN
2661 1368 : handle_zeta(long n, GEN ch, long *m)
2662 : {
2663 : GEN c;
2664 1368 : long t, i, l = lg(ch);
2665 1368 : GEN dim = cyclotoi(vecsum(ch));
2666 1368 : if (typ(dim) != t_INT)
2667 0 : pari_err_DOMAIN("lfunartin","chi","is not a", strtoGENstr("character"), ch);
2668 1368 : t = itos(dim);
2669 1368 : if (t < 0 || t % n)
2670 0 : pari_err_DOMAIN("lfunartin","chi","is not a", strtoGENstr("character"), ch);
2671 1368 : if (t == 0) { *m = 0; return ch; }
2672 192 : *m = t / n;
2673 192 : c = cgetg(l, t_COL);
2674 1770 : for (i=1; i<l; i++)
2675 1578 : gel(c,i) = gsubgs(gel(ch,i), *m);
2676 192 : return c;
2677 : }
2678 :
2679 : static int
2680 5568 : cyclo_is_real(GEN v, GEN ix)
2681 : {
2682 5568 : pari_sp av = avma;
2683 5568 : GEN w = poleval(lift_shallow(v), ix);
2684 5568 : return gc_bool(av, gequal(w, v));
2685 : }
2686 :
2687 : static int
2688 1182 : char_is_real(GEN ch, GEN mod)
2689 : {
2690 1182 : long i, l = lg(ch);
2691 1182 : GEN ix = QXQ_inv(pol_x(varn(mod)), mod);
2692 6012 : for (i=1; i<l; i++)
2693 5568 : if (!cyclo_is_real(gel(ch,i), ix)) return 0;
2694 444 : return 1;
2695 : }
2696 :
2697 : GEN
2698 1380 : lfunartin(GEN nf, GEN gal, GEN ch, long o, long bitprec)
2699 : {
2700 1380 : pari_sp av = avma;
2701 1380 : GEN bc, V, aut, mod, Ldata = NULL, chx, cc, conj, repr;
2702 : long tmult, var;
2703 1380 : nf = checknf(nf);
2704 1380 : checkgal(gal);
2705 1380 : var = gvar(ch);
2706 1380 : if (var == 0) pari_err_PRIORITY("lfunartin",ch,"=",0);
2707 1380 : if (var < 0) var = 1;
2708 1380 : if (!is_vec_t(typ(ch))) pari_err_TYPE("lfunartin", ch);
2709 1380 : cc = group_to_cc(gal);
2710 1380 : conj = gel(cc,2);
2711 1380 : repr = gel(cc,3);
2712 1380 : mod = mkpolmod(gen_1, polcyclo(o, var));
2713 1380 : if (lg(ch)>1 && typ(gel(ch,1))==t_MAT)
2714 102 : chx = artin_charfromgens(gal, gmul(ch,mod));
2715 : else
2716 : {
2717 1278 : if (lg(repr) != lg(ch)) pari_err_DIM("lfunartin");
2718 1266 : chx = char_expand(conj, gmul(ch,mod));
2719 : }
2720 1368 : chx = handle_zeta(nf_get_degree(nf), chx, &tmult);
2721 1368 : ch = shallowextract(chx, repr);
2722 1368 : if (!gequal0(chx))
2723 : {
2724 1182 : GEN real = char_is_real(chx, gel(mod,1))? gen_0: gen_1;
2725 1182 : aut = nfgaloispermtobasis(nf, gal);
2726 1182 : V = gmul(char_expand(conj, galoischarpoly(gal, ch, o)), mod);
2727 1182 : bc = artin_badprimes(nf, gal, aut, chx);
2728 2364 : Ldata = mkvecn(6,
2729 1182 : tag(mkcoln(7, nf, gal, V, aut, gel(bc, 2), stoi(o), real), t_LFUN_ARTIN),
2730 1182 : real, artin_gamma(nf, gal, chx), gen_1, gel(bc,1), gen_0);
2731 : }
2732 1368 : if (tmult==0 && Ldata==NULL) pari_err_TYPE("lfunartin",ch);
2733 1368 : if (tmult)
2734 : {
2735 : long i;
2736 192 : if (Ldata==NULL) { Ldata = lfunzeta(); tmult--; }
2737 198 : for(i=1; i<=tmult; i++)
2738 6 : Ldata = lfunmul(Ldata, gen_1, bitprec);
2739 : }
2740 1368 : return gc_GEN(av, Ldata);
2741 : }
2742 :
2743 : /* true nf */
2744 : static GEN
2745 18 : lfunzetakinit_artin(GEN nf, GEN gal, GEN dom, long der, long bitprec)
2746 : {
2747 18 : GEN F, E, M, domain, To = galoischartable(gal), T = gel(To, 1);
2748 18 : long i, o = itos(gel(To, 2)), l = lg(T);
2749 18 : F = cgetg(l, t_VEC);
2750 18 : E = cgetg(l, t_VECSMALL);
2751 72 : for (i = 1; i < l; ++i)
2752 : {
2753 54 : GEN L = lfunartin(nf, gal, gel(T,i), o, bitprec);
2754 54 : gel(F, i) = lfuninit(L, dom, der, bitprec);
2755 54 : E[i] = char_dim(gel(T,i));
2756 : }
2757 18 : domain = mkvec2(dom, mkvecsmall2(der, bitprec));
2758 18 : M = mkvec3(F, E, zero_zv(l-1));
2759 18 : return lfuninit_make(t_LDESC_PRODUCT, lfunzetak_i(nf), M, domain);
2760 : }
2761 :
2762 : /********************************************************************/
2763 : /** High-level Constructors **/
2764 : /********************************************************************/
2765 : enum { t_LFUNMISC_POL, t_LFUNMISC_CHIQUAD, t_LFUNMISC_CHICONREY,
2766 : t_LFUNMISC_CHIGEN, t_LFUNMISC_ELLINIT, t_LFUNMISC_ETAQUO,
2767 : t_LFUNMISC_GCHAR, t_LFUNMISC_ABELREL };
2768 : static long
2769 15208 : lfundatatype(GEN data)
2770 : {
2771 15208 : switch(typ(data))
2772 : {
2773 3343 : case t_INT: return t_LFUNMISC_CHIQUAD;
2774 186 : case t_INTMOD: return t_LFUNMISC_CHICONREY;
2775 570 : case t_POL: return t_LFUNMISC_POL;
2776 11109 : case t_VEC:
2777 11109 : switch(lg(data))
2778 : {
2779 3480 : case 17: return t_LFUNMISC_ELLINIT;
2780 0 : case 10: return t_LFUNMISC_POL;
2781 7629 : case 3:
2782 7629 : if (typ(gel(data,1)) != t_VEC) break;
2783 7629 : return is_gchar_group(gel(data,1)) ? t_LFUNMISC_GCHAR
2784 7629 : : typ(gel(data,2))==t_MAT ? t_LFUNMISC_ABELREL
2785 : : t_LFUNMISC_CHIGEN;
2786 : }
2787 0 : break;
2788 : }
2789 0 : return -1;
2790 : }
2791 : static GEN
2792 106208 : lfunmisc_to_ldata_i(GEN ldata, long shallow)
2793 : {
2794 : GEN x;
2795 106208 : if (is_linit(ldata)) ldata = linit_get_ldata(ldata);
2796 106208 : if (is_ldata(ldata) && is_tagged(ldata))
2797 : {
2798 90856 : if (!shallow) ldata = gcopy(ldata);
2799 90856 : checkldata(ldata); return ldata;
2800 : }
2801 15352 : x = checknf_i(ldata); if (x) return lfunzetak(x);
2802 15208 : switch (lfundatatype(ldata))
2803 : {
2804 570 : case t_LFUNMISC_POL: return lfunzetak(ldata);
2805 3343 : case t_LFUNMISC_CHIQUAD: return lfunchiquad(ldata);
2806 186 : case t_LFUNMISC_CHICONREY:
2807 : {
2808 186 : GEN G = znstar0(gel(ldata,1), 1);
2809 186 : return lfunchiZ(G, gel(ldata,2));
2810 : }
2811 7263 : case t_LFUNMISC_CHIGEN:
2812 : {
2813 7263 : GEN G = gel(ldata,1), chi = gel(ldata,2);
2814 7263 : switch(nftyp(G))
2815 : {
2816 7041 : case typ_BIDZ: return lfunchiZ(G, chi);
2817 216 : case typ_BNR: return lfunchigen(G, chi);
2818 : }
2819 : }
2820 6 : break;
2821 348 : case t_LFUNMISC_GCHAR: return lfungchar(gel(ldata,1), gel(ldata,2));
2822 18 : case t_LFUNMISC_ABELREL:
2823 18 : return lfunabelrel(gel(ldata,1), gel(ldata,2),
2824 18 : lg(ldata)==3? NULL: gel(ldata,3));
2825 3480 : case t_LFUNMISC_ELLINIT: return lfunell(ldata);
2826 : }
2827 6 : if (shallow != 2) pari_err_TYPE("lfunmisc_to_ldata",ldata);
2828 0 : return NULL;
2829 : }
2830 :
2831 : GEN
2832 3018 : lfunmisc_to_ldata(GEN ldata)
2833 3018 : { return lfunmisc_to_ldata_i(ldata, 0); }
2834 :
2835 : GEN
2836 84995 : lfunmisc_to_ldata_shallow(GEN ldata)
2837 84995 : { return lfunmisc_to_ldata_i(ldata, 1); }
2838 :
2839 : GEN
2840 18195 : lfunmisc_to_ldata_shallow_i(GEN ldata)
2841 18195 : { return lfunmisc_to_ldata_i(ldata, 2); }
2842 :
2843 : /********************************************************************/
2844 : /** High-level an expansion **/
2845 : /********************************************************************/
2846 : /* van is the output of ldata_get_an: return a_1,...a_L at precision prec */
2847 : GEN
2848 27999 : ldata_vecan(GEN van, long L, long prec)
2849 : {
2850 27999 : GEN an = gel(van, 2);
2851 27999 : long t = mael(van,1,1);
2852 : pari_timer ti;
2853 27999 : if (DEBUGLEVEL >= 1)
2854 0 : err_printf("Lfun: computing %ld coeffs, prec %ld, type %ld\n", L, prec, t);
2855 27999 : if (DEBUGLEVEL >= 2) timer_start(&ti);
2856 27999 : if (L < 0) L = 0;
2857 27999 : switch (t)
2858 : {
2859 : long n;
2860 1697 : case t_LFUN_GENERIC:
2861 1697 : an = vecan_closure(an, L, prec);
2862 1637 : n = lg(an)-1;
2863 1637 : if (n < L)
2864 : {
2865 12 : pari_warn(warner, "#an = %ld < %ld, results may be imprecise", n, L);
2866 12 : an = shallowconcat(an, zerovec(L-n));
2867 : }
2868 1637 : break;
2869 0 : case t_LFUN_CLOSURE0:
2870 : pari_err_BUG("ldata_vecan: please call ldata_newprec");/*LCOV_EXCL_LINE*/
2871 2696 : case t_LFUN_ZETA: an = const_vecsmall(L, 1); break;
2872 1800 : case t_LFUN_NF: an = dirzetak(an, stoi(L)); break;
2873 5376 : case t_LFUN_ELL:
2874 5376 : an = (ell_get_type(an) == t_ELL_Q) ? ellanQ_zv(an, L): ellan(an, L);
2875 5376 : break;
2876 3140 : case t_LFUN_KRONECKER: an = vecan_Kronecker(an, L); break;
2877 144 : case t_LFUN_ABELREL: an = vecan_abelrel(an, L); break;
2878 3120 : case t_LFUN_CHIZ: an = vecan_chiZ(an, L, prec); break;
2879 1332 : case t_LFUN_CHIGEN: an = vecan_chigen(an, L, prec); break;
2880 606 : case t_LFUN_HECKE: an = vecan_gchar(an, L, prec); break;
2881 2526 : case t_LFUN_ARTIN: an = vecan_artin(an, L, prec); break;
2882 126 : case t_LFUN_ETA: an = vecan_eta(an, L); break;
2883 342 : case t_LFUN_QF: an = vecan_qf(an, L); break;
2884 540 : case t_LFUN_DIV: an = vecan_div(an, L, prec); break;
2885 354 : case t_LFUN_MUL: an = vecan_mul(an, L, prec); break;
2886 108 : case t_LFUN_CONJ: an = vecan_conj(an, L, prec); break;
2887 294 : case t_LFUN_SYMPOW_ELL: an = vecan_ellsympow(an, L); break;
2888 174 : case t_LFUN_GENUS2: an = vecan_genus2(an, L); break;
2889 144 : case t_LFUN_HGM:
2890 144 : an = hgmcoefs(gel(an,1), gel(an,2), L); break;
2891 360 : case t_LFUN_MFCLOS:
2892 : {
2893 360 : GEN F = gel(an,1), E = gel(an,2), c = gel(an,3);
2894 360 : an = mfcoefs(F,L,1) + 1; /* skip a_0 */
2895 360 : an[0] = evaltyp(t_VEC)|_evallg(L+1);
2896 360 : an = mfvecembed(E, an);
2897 360 : if (!isint1(c)) an = RgV_Rg_mul(an,c);
2898 360 : break;
2899 : }
2900 2472 : case t_LFUN_TWIST: an = vecan_twist(an, L, prec); break;
2901 648 : case t_LFUN_SHIFT: an = vecan_shift(an, L, prec); break;
2902 0 : default: pari_err_TYPE("ldata_vecan", van);
2903 : }
2904 27939 : if (DEBUGLEVEL >= 2) timer_printf(&ti, "ldata_vecan");
2905 27939 : return an;
2906 : }
2907 :
2908 : /* shallow */
2909 : GEN
2910 28377 : ldata_newprec(GEN ldata, long prec)
2911 : {
2912 28377 : GEN van = ldata_get_an(ldata), an = gel(van, 2);
2913 28377 : long t = mael(van,1,1);
2914 28377 : switch (t)
2915 : {
2916 138 : case t_LFUN_CLOSURE0: return closure2ldata(an, prec);
2917 864 : case t_LFUN_HECKE:
2918 : {
2919 864 : GEN gc = gel(an, 1), chiw = gel(an, 2);
2920 864 : gc = gcharnewprec(gc, prec);
2921 864 : return gchari_lfun(gc, chiw, gen_0); /* chi in internal format */
2922 : }
2923 282 : case t_LFUN_QF:
2924 : {
2925 282 : GEN eno = ldata_get_rootno(ldata);
2926 282 : if (typ(eno)==t_REAL && realprec(eno) < prec) return lfunqf(an, prec);
2927 234 : break;
2928 : }
2929 : }
2930 27327 : return ldata;
2931 : }
2932 :
2933 : /* not gc clean */
2934 : GEN
2935 780 : ldata_eulerf(GEN van, GEN p, long prec)
2936 : {
2937 780 : GEN an = gel(van, 2), f = gen_0;
2938 780 : long t = mael(van,1,1);
2939 780 : switch (t)
2940 : {
2941 60 : case t_LFUN_GENERIC:
2942 60 : f = eulerf_closure(an, p, prec); break;
2943 0 : case t_LFUN_CLOSURE0:
2944 : pari_err_BUG("ldata_vecan: please call ldata_newprec");/*LCOV_EXCL_LINE*/
2945 84 : case t_LFUN_ZETA: f = mkrfrac(gen_1,deg1pol_shallow(gen_m1, gen_1,0)); break;
2946 144 : case t_LFUN_NF: f = eulerf_zetak(an, p); break;
2947 60 : case t_LFUN_ELL: f = elleulerf(an, p); break;
2948 60 : case t_LFUN_KRONECKER:
2949 60 : f = mkrfrac(gen_1, deg1pol_shallow(stoi(-kronecker(an, p)), gen_1, 0)); break;
2950 36 : case t_LFUN_ABELREL: f = eulerf_abelrel(an, p); break;
2951 36 : case t_LFUN_CHIZ: f = eulerf_chiZ(an, p, prec); break;
2952 24 : case t_LFUN_CHIGEN: f = eulerf_chigen(an, p, prec); break;
2953 12 : case t_LFUN_HECKE: f = eulerf_gchar(an, p, prec); break;
2954 24 : case t_LFUN_ARTIN: f = eulerf_artin(an, p, prec); break;
2955 12 : case t_LFUN_DIV: f = eulerf_div(an, p, prec); break;
2956 36 : case t_LFUN_MUL: f = eulerf_mul(an, p, prec); break;
2957 0 : case t_LFUN_CONJ: f = eulerf_conj(an, p, prec); break;
2958 24 : case t_LFUN_SYMPOW_ELL: f = eulerf_ellsympow(an, p); break;
2959 0 : case t_LFUN_GENUS2: f = eulerf_genus2(an, p); break;
2960 12 : case t_LFUN_TWIST: f = eulerf_twist(an, p, prec); break;
2961 48 : case t_LFUN_SHIFT: f = eulerf_shift(an, p, prec); break;
2962 72 : case t_LFUN_HGM: f = eulerf_hgm(an, p); break;
2963 36 : default: f = NULL; break;
2964 : }
2965 780 : if (!f) pari_err_DOMAIN("lfuneuler", "L", "Euler product", strtoGENstr("unknown"), an);
2966 684 : return f;
2967 : }
2968 :
2969 : GEN
2970 618 : lfuneuler(GEN ldata, GEN p, long prec)
2971 : {
2972 618 : pari_sp av = avma;
2973 618 : if (typ(p)!=t_INT || signe(p)<=0) pari_err_TYPE("lfuneuler", p);
2974 612 : ldata = ldata_newprec(lfunmisc_to_ldata_shallow(ldata), prec);
2975 612 : return gc_GEN(av, ldata_eulerf(ldata_get_an(ldata), p, prec));
2976 : }
|
