Line data Source code
1 : /* Copyright (C) 2016 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 : /* Modular forms package based on trace formulas */
18 : /* */
19 : /*************************************************************************/
20 : #include "pari.h"
21 : #include "paripriv.h"
22 :
23 : #define DEBUGLEVEL DEBUGLEVEL_mf
24 :
25 : enum {
26 : MF_SPLIT = 1,
27 : MF_EISENSPACE,
28 : MF_FRICKE,
29 : MF_MF2INIT,
30 : MF_SPLITN
31 : };
32 :
33 : typedef struct {
34 : GEN vnew, vfull, DATA, VCHIP;
35 : long n, newHIT, newTOTAL, cuspHIT, cuspTOTAL;
36 : } cachenew_t;
37 :
38 : static void init_cachenew(cachenew_t *c, long n, long N, GEN f);
39 : static long mf1cuspdim_i(long N, GEN CHI, GEN TMP, GEN vSP, long *dih);
40 : static GEN mfinit_i(GEN NK, long space);
41 : static GEN mfinit_Nkchi(long N, long k, GEN CHI, long space, long flraw);
42 : static GEN mf2init_Nkchi(long N, long k, GEN CHI, long space, long flraw);
43 : static GEN mf2basis(long N, long r, GEN CHI, GEN *pCHI1, long space);
44 : static GEN mfeisensteinbasis(long N, long k, GEN CHI);
45 : static GEN mfeisensteindec(GEN mf, GEN F);
46 : static GEN initwt1newtrace(GEN mf);
47 : static GEN initwt1trace(GEN mf);
48 : static GEN myfactoru(long N);
49 : static GEN mydivisorsu(long N);
50 : static GEN Qab_Czeta(long k, long ord, GEN C, long vt);
51 : static GEN mfcoefs_i(GEN F, long n, long d);
52 : static GEN bhnmat_extend(GEN M, long m,long l, GEN S, cachenew_t *cache);
53 : static GEN initnewtrace(long N, GEN CHI);
54 : static void dbg_cachenew(cachenew_t *C);
55 : static GEN hecke_i(long m, long l, GEN V, GEN F, GEN DATA);
56 : static GEN c_Ek(long n, long d, GEN F);
57 : static GEN RgV_heckef2(long n, long d, GEN V, GEN F, GEN DATA);
58 : static GEN mfcusptrace_i(long N, long k, long n, GEN Dn, GEN TDATA);
59 : static GEN mfnewtracecache(long N, long k, long n, cachenew_t *cache);
60 : static GEN colnewtrace(long n0, long n, long d, long N, long k, cachenew_t *c);
61 : static GEN dihan(GEN bnr, GEN w, GEN k0j, long m, ulong n);
62 : static GEN sigchi(long k, GEN CHI, long n);
63 : static GEN sigchi2(long k, GEN CHI1, GEN CHI2, long n, long ord);
64 : static GEN mflineardivtomat(long N, GEN vF, long n);
65 : static GEN mfdihedralcusp(long N, GEN CHI, GEN vSP);
66 : static long mfdihedralcuspdim(long N, GEN CHI, GEN vSP);
67 : static GEN mfdihedralnew(long N, GEN CHI, GEN SP);
68 : static GEN mfdihedral(long N);
69 : static GEN mfdihedralall(long N);
70 : static long mf1cuspdim(long N, GEN CHI, GEN vSP);
71 : static long mf2dim_Nkchi(long N, long k, GEN CHI, ulong space);
72 : static long mfdim_Nkchi(long N, long k, GEN CHI, long space);
73 : static GEN charLFwtk(long N, long k, GEN CHI, long ord, long t);
74 : static GEN mfeisensteingacx(GEN E,long w,GEN ga,long n,long prec);
75 : static GEN mfgaexpansion(GEN mf, GEN F, GEN gamma, long n, long prec);
76 : static GEN mfEHmat(long n, long r);
77 : static GEN mfEHcoef(long r, long N);
78 : static GEN mftobasis_i(GEN mf, GEN F);
79 :
80 : static GEN
81 37863 : mkgNK(GEN N, GEN k, GEN CHI, GEN P) { return mkvec4(N, k, CHI, P); }
82 : static GEN
83 15267 : mkNK(long N, long k, GEN CHI) { return mkgNK(stoi(N), stoi(k), CHI, pol_x(1)); }
84 : GEN
85 8848 : MF_get_CHI(GEN mf) { return gmael(mf,1,3); }
86 : GEN
87 21273 : MF_get_gN(GEN mf) { return gmael(mf,1,1); }
88 : long
89 20069 : MF_get_N(GEN mf) { return itou(MF_get_gN(mf)); }
90 : GEN
91 15526 : MF_get_gk(GEN mf) { return gmael(mf,1,2); }
92 : long
93 7238 : MF_get_k(GEN mf)
94 : {
95 7238 : GEN gk = MF_get_gk(mf);
96 7238 : if (typ(gk)!=t_INT) pari_err_IMPL("half-integral weight");
97 7238 : return itou(gk);
98 : }
99 : long
100 280 : MF_get_r(GEN mf)
101 : {
102 280 : GEN gk = MF_get_gk(mf);
103 280 : if (typ(gk) == t_INT) pari_err_IMPL("integral weight");
104 280 : return itou(gel(gk, 1)) >> 1;
105 : }
106 : long
107 15393 : MF_get_space(GEN mf) { return itos(gmael(mf,1,4)); }
108 : GEN
109 4487 : MF_get_E(GEN mf) { return gel(mf,2); }
110 : GEN
111 21553 : MF_get_S(GEN mf) { return gel(mf,3); }
112 : GEN
113 1911 : MF_get_basis(GEN mf) { return shallowconcat(gel(mf,2), gel(mf,3)); }
114 : long
115 5642 : MF_get_dim(GEN mf)
116 : {
117 5642 : switch(MF_get_space(mf))
118 : {
119 721 : case mf_FULL:
120 721 : return lg(MF_get_S(mf)) - 1 + lg(MF_get_E(mf))-1;
121 140 : case mf_EISEN:
122 140 : return lg(MF_get_E(mf))-1;
123 4781 : default: /* mf_NEW, mf_CUSP, mf_OLD */
124 4781 : return lg(MF_get_S(mf)) - 1;
125 : }
126 : }
127 : GEN
128 7343 : MFnew_get_vj(GEN mf) { return gel(mf,4); }
129 : GEN
130 686 : MFcusp_get_vMjd(GEN mf) { return gel(mf,4); }
131 : GEN
132 6916 : MF_get_M(GEN mf) { return gmael(mf,5,3); }
133 : GEN
134 4872 : MF_get_Minv(GEN mf) { return gmael(mf,5,2); }
135 : GEN
136 10640 : MF_get_Mindex(GEN mf) { return gmael(mf,5,1); }
137 :
138 : /* ordinary gtocol forgets about initial 0s */
139 : GEN
140 2583 : sertocol(GEN S) { return gtocol0(S, -(lg(S) - 2 + valser(S))); }
141 : /*******************************************************************/
142 : /* Linear algebra in cyclotomic fields (TODO: export this) */
143 : /*******************************************************************/
144 : /* return r and split prime p giving projection Q(zeta_n) -> Fp, zeta -> r */
145 : static ulong
146 1246 : QabM_init(long n, ulong *p)
147 : {
148 1246 : ulong pinit = 1000000007;
149 : forprime_t T;
150 1246 : if (n <= 1) { *p = pinit; return 0; }
151 1225 : u_forprime_arith_init(&T, pinit, ULONG_MAX, 1, n);
152 1225 : *p = u_forprime_next(&T);
153 1225 : return Flx_oneroot(ZX_to_Flx(polcyclo(n, 0), *p), *p);
154 : }
155 : static ulong
156 8534960 : Qab_to_Fl(GEN P, ulong r, ulong p)
157 : {
158 : ulong t;
159 : GEN den;
160 8534960 : P = Q_remove_denom(liftpol_shallow(P), &den);
161 8534960 : if (typ(P) == t_POL) { GEN Pp = ZX_to_Flx(P, p); t = Flx_eval(Pp, r, p); }
162 8399335 : else t = umodiu(P, p);
163 8534960 : if (den) t = Fl_div(t, umodiu(den, p), p);
164 8534960 : return t;
165 : }
166 : static GEN
167 38164 : QabC_to_Flc(GEN x, ulong r, ulong p)
168 8341333 : { pari_APPLY_long( Qab_to_Fl(gel(x,i), r, p)); }
169 : static GEN
170 595 : QabM_to_Flm(GEN x, ulong r, ulong p)
171 38759 : { pari_APPLY_same(QabC_to_Flc(gel(x, i), r, p);) }
172 : /* A a t_POL */
173 : static GEN
174 1484 : QabX_to_Flx(GEN A, ulong r, ulong p)
175 : {
176 1484 : long i, l = lg(A);
177 1484 : GEN a = cgetg(l, t_VECSMALL);
178 1484 : a[1] = ((ulong)A[1])&VARNBITS;
179 233023 : for (i = 2; i < l; i++) uel(a,i) = Qab_to_Fl(gel(A,i), r, p);
180 1484 : return Flx_renormalize(a, l);
181 : }
182 :
183 : /* FIXME: remove */
184 : static GEN
185 1106 : ZabM_pseudoinv_i(GEN M, GEN P, long n, GEN *pv, GEN *den, int ratlift)
186 : {
187 1106 : GEN v = ZabM_indexrank(M, P, n);
188 1106 : if (pv) *pv = v;
189 1106 : M = shallowmatextract(M,gel(v,1),gel(v,2));
190 1106 : return ratlift? ZabM_inv_ratlift(M, P, n, den): ZabM_inv(M, P, n, den);
191 : }
192 :
193 : /* M matrix with coeff in Q(\chi)), where Q(\chi) = Q(X)/(P) for
194 : * P = cyclotomic Phi_n. Assume M rational if n <= 2 */
195 : static GEN
196 1652 : QabM_ker(GEN M, GEN P, long n)
197 : {
198 1652 : if (n <= 2) return QM_ker(M);
199 420 : return ZabM_ker(row_Q_primpart(liftpol_shallow(M)), P, n);
200 : }
201 : /* pseudo-inverse of M. FIXME: should replace QabM_pseudoinv */
202 : static GEN
203 1358 : QabM_pseudoinv_i(GEN M, GEN P, long n, GEN *pv, GEN *pden)
204 : {
205 : GEN cM, Mi;
206 1358 : if (n <= 2)
207 : {
208 1176 : M = Q_primitive_part(M, &cM);
209 1176 : Mi = ZM_pseudoinv(M, pv, pden); /* M^(-1) = Mi / (cM * den) */
210 : }
211 : else
212 : {
213 182 : M = Q_primitive_part(liftpol_shallow(M), &cM);
214 182 : Mi = ZabM_pseudoinv(M, P, n, pv, pden);
215 : }
216 1358 : *pden = mul_content(*pden, cM);
217 1358 : return Mi;
218 : }
219 : /* FIXME: delete */
220 : static GEN
221 1092 : QabM_pseudoinv(GEN M, GEN P, long n, GEN *pv, GEN *pden)
222 : {
223 1092 : GEN Mi = QabM_pseudoinv_i(M, P, n, pv, pden);
224 1092 : return P? gmodulo(Mi, P): Mi;
225 : }
226 :
227 : static GEN
228 10563 : QabM_indexrank(GEN M, GEN P, long n)
229 : {
230 : GEN z;
231 10563 : if (n <= 2)
232 : {
233 9366 : M = vec_Q_primpart(M);
234 9366 : z = ZM_indexrank(M); /* M^(-1) = Mi / (cM * den) */
235 : }
236 : else
237 : {
238 1197 : M = vec_Q_primpart(liftpol_shallow(M));
239 1197 : z = ZabM_indexrank(M, P, n);
240 : }
241 10563 : return z;
242 : }
243 :
244 : /*********************************************************************/
245 : /* Simple arithmetic functions */
246 : /*********************************************************************/
247 : /* TODO: most of these should be exported and used in ifactor1.c */
248 : /* phi(n) */
249 : static ulong
250 110726 : myeulerphiu(ulong n)
251 : {
252 : pari_sp av;
253 110726 : if (n == 1) return 1;
254 91140 : av = avma; return gc_ulong(av, eulerphiu_fact(myfactoru(n)));
255 : }
256 : static long
257 65709 : mymoebiusu(ulong n)
258 : {
259 : pari_sp av;
260 65709 : if (n == 1) return 1;
261 54194 : av = avma; return gc_long(av, moebiusu_fact(myfactoru(n)));
262 : }
263 :
264 : static long
265 3031 : mynumdivu(long N)
266 : {
267 : pari_sp av;
268 3031 : if (N == 1) return 1;
269 2898 : av = avma; return gc_long(av, numdivu_fact(myfactoru(N)));
270 : }
271 :
272 : /* N\prod_{p|N} (1+1/p) */
273 : static long
274 401541 : mypsiu(ulong N)
275 : {
276 : pari_sp av;
277 : GEN P;
278 : long j, l, a;
279 401541 : if (N == 1) return 1;
280 315532 : av = avma; P = gel(myfactoru(N), 1); l = lg(P);
281 751247 : for (a = N, j = 1; j < l; j++) a += a / P[j];
282 315532 : return gc_long(av, a);
283 : }
284 : /* write n = mf^2. Return m, set f. */
285 : static ulong
286 71 : mycore(ulong n, long *pf)
287 : {
288 71 : pari_sp av = avma;
289 71 : GEN fa = myfactoru(n), P = gel(fa,1), E = gel(fa,2);
290 71 : long i, l = lg(P), m = 1, f = 1;
291 268 : for (i = 1; i < l; i++)
292 : {
293 197 : long j, p = P[i], e = E[i];
294 197 : if (e & 1) m *= p;
295 456 : for (j = 2; j <= e; j+=2) f *= p;
296 : }
297 71 : *pf = f; return gc_long(av,m);
298 : }
299 :
300 : /* fa = factorization of -D > 0, return -D0 > 0 (where D0 is fundamental) */
301 : static long
302 12427786 : corediscs_fact(GEN fa)
303 : {
304 12427786 : GEN P = gel(fa,1), E = gel(fa,2);
305 12427786 : long i, l = lg(P), m = 1;
306 41412492 : for (i = 1; i < l; i++)
307 : {
308 28984706 : long p = P[i], e = E[i];
309 28984706 : if (e & 1) m *= p;
310 : }
311 12427786 : if ((m&3L) != 3) m <<= 2;
312 12427786 : return m;
313 : }
314 : static long
315 7098 : mubeta(long n)
316 : {
317 7098 : pari_sp av = avma;
318 7098 : GEN E = gel(myfactoru(n), 2);
319 7098 : long i, s = 1, l = lg(E);
320 14735 : for (i = 1; i < l; i++)
321 : {
322 7637 : long e = E[i];
323 7637 : if (e >= 3) return gc_long(av,0);
324 7637 : if (e == 1) s *= -2;
325 : }
326 7098 : return gc_long(av,s);
327 : }
328 :
329 : /* n = n1*n2, n1 = ppo(n, m); return mubeta(n1)*moebiusu(n2).
330 : * N.B. If n from newt_params we, in fact, never return 0 */
331 : static long
332 7850904 : mubeta2(long n, long m)
333 : {
334 7850904 : pari_sp av = avma;
335 7850904 : GEN fa = myfactoru(n), P = gel(fa,1), E = gel(fa,2);
336 7850904 : long i, s = 1, l = lg(P);
337 15734522 : for (i = 1; i < l; i++)
338 : {
339 7883618 : long p = P[i], e = E[i];
340 7883618 : if (m % p)
341 : { /* p^e in n1 */
342 6669223 : if (e >= 3) return gc_long(av,0);
343 6669223 : if (e == 1) s *= -2;
344 : }
345 : else
346 : { /* in n2 */
347 1214395 : if (e >= 2) return gc_long(av,0);
348 1214395 : s = -s;
349 : }
350 : }
351 7850904 : return gc_long(av,s);
352 : }
353 :
354 : /* write N = prod p^{ep} and n = df^2, d squarefree.
355 : * set g = ppo(gcd(sqfpart(N), f), FC)
356 : * N2 = prod p^if(e==1 || p|n, ep-1, ep-2) */
357 : static void
358 1941594 : newt_params(long N, long n, long FC, long *pg, long *pN2)
359 : {
360 1941594 : GEN fa = myfactoru(N), P = gel(fa,1), E = gel(fa,2);
361 1941594 : long i, g = 1, N2 = 1, l = lg(P);
362 5163782 : for (i = 1; i < l; i++)
363 : {
364 3222188 : long p = P[i], e = E[i];
365 3222188 : if (e == 1)
366 2825389 : { if (FC % p && n % (p*p) == 0) g *= p; }
367 : else
368 396799 : N2 *= upowuu(p,(n % p)? e-2: e-1);
369 : }
370 1941594 : *pg = g; *pN2 = N2;
371 1941594 : }
372 : /* simplified version of newt_params for n = 1 (newdim) */
373 : static void
374 42525 : newd_params(long N, long *pN2)
375 : {
376 42525 : GEN fa = myfactoru(N), P = gel(fa,1), E = gel(fa,2);
377 42525 : long i, N2 = 1, l = lg(P);
378 106092 : for (i = 1; i < l; i++)
379 : {
380 63567 : long p = P[i], e = E[i];
381 63567 : if (e > 2) N2 *= upowuu(p, e-2);
382 : }
383 42525 : *pN2 = N2;
384 42525 : }
385 :
386 : static long
387 21 : newd_params2(long N)
388 : {
389 21 : GEN fa = myfactoru(N), P = gel(fa,1), E = gel(fa,2);
390 21 : long i, N2 = 1, l = lg(P);
391 56 : for (i = 1; i < l; i++)
392 : {
393 35 : long p = P[i], e = E[i];
394 35 : if (e >= 2) N2 *= upowuu(p, e);
395 : }
396 21 : return N2;
397 : }
398 :
399 : /*******************************************************************/
400 : /* Relative trace between cyclotomic fields (TODO: export this) */
401 : /*******************************************************************/
402 : /* g>=1; return g * prod_{p | g, (p,q) = 1} (1-1/p) */
403 : static long
404 36869 : phipart(long g, long q)
405 : {
406 36869 : if (g > 1)
407 : {
408 19670 : GEN P = gel(myfactoru(g), 1);
409 19670 : long i, l = lg(P);
410 40194 : for (i = 1; i < l; i++) { long p = P[i]; if (q % p) g -= g / p; }
411 : }
412 36869 : return g;
413 : }
414 : /* Set s,v s.t. Trace(zeta_N^k) from Q(zeta_N) to Q(\zeta_N) = s * zeta_M^v
415 : * With k > 0, N = M*d and N, M != 2 mod 4 */
416 : static long
417 84756 : tracerelz(long *pv, long d, long M, long k)
418 : {
419 : long s, g, q, muq;
420 84756 : if (d == 1) { *pv = k; return 1; }
421 65618 : *pv = 0; g = ugcd(k, d); q = d / g;
422 65618 : muq = mymoebiusu(q); if (!muq) return 0;
423 47173 : if (M != 1)
424 : {
425 37828 : long v = Fl_invsafe(q % M, M);
426 37828 : if (!v) return 0;
427 27524 : *pv = (v * (k/g)) % M;
428 : }
429 36869 : s = phipart(g, M*q); if (muq < 0) s = -s;
430 36869 : return s;
431 : }
432 : /* Pi = polcyclo(i), i = m or n. Let Ki = Q(zeta_i), initialize Tr_{Kn/Km} */
433 : GEN
434 34062 : Qab_trace_init(long n, long m, GEN Pn, GEN Pm)
435 : {
436 : long a, i, j, N, M, vt, d, D;
437 : GEN T, G;
438 :
439 34062 : if (m == n || n <= 2) return mkvec(Pm);
440 16555 : vt = varn(Pn);
441 16555 : d = degpol(Pn);
442 : /* if (N != n) zeta_N = zeta_n^2 and zeta_n = - zeta_N^{(N+1)/2} */
443 16555 : N = ((n & 3) == 2)? n >> 1: n;
444 16555 : M = ((m & 3) == 2)? m >> 1: m; /* M | N | n */
445 16555 : a = N / M;
446 16555 : T = const_vec(d, NULL);
447 16555 : D = d / degpol(Pm); /* relative degree */
448 16555 : if (D == 1) G = NULL;
449 : else
450 : { /* zeta_M = zeta_n^A; s_j(zeta_M) = zeta_M <=> j = 1 (mod J) */
451 15281 : long lG, A = (N == n)? a: (a << 1), J = n / ugcd(n, A);
452 15281 : G = coprimes_zv(n);
453 150276 : for (j = lG = 1; j < n; j += J)
454 134995 : if (G[j]) G[lG++] = j;
455 15281 : setlg(G, lG); /* Gal(Q(zeta_n) / Q(zeta_m)) */
456 : }
457 16555 : T = const_vec(d, NULL);
458 16555 : gel(T,1) = utoipos(D); /* Tr 1 */
459 140140 : for (i = 1; i < d; i++)
460 : { /* if n = 2N, zeta_n^i = (-1)^i zeta_N^k */
461 : long s, v, k;
462 : GEN t;
463 :
464 123585 : if (gel(T, i+1)) continue;
465 84756 : k = (N == n)? i: ((odd(i)? i + N: i) >> 1);
466 84756 : if ((s = tracerelz(&v, a, M, k)))
467 : {
468 56007 : if (m != M) v *= 2;/* Tr = s * zeta_m^v */
469 56007 : if (n != N && odd(i)) s = -s;
470 56007 : t = Qab_Czeta(v, m, stoi(s), vt);
471 : }
472 : else
473 28749 : t = gen_0;
474 : /* t = Tr_{Kn/Km} zeta_n^i; fill using Galois action */
475 84756 : if (!G)
476 19138 : gel(T, i + 1) = t;
477 : else
478 370874 : for (j = 1; j <= D; j++)
479 : {
480 305256 : long z = Fl_mul(i,G[j], n);
481 305256 : if (z < d) gel(T, z + 1) = t;
482 : }
483 : }
484 16555 : return mkvec3(Pm, Pn, T);
485 : }
486 : /* x a t_POL modulo Phi_n */
487 : static GEN
488 80255 : tracerel_i(GEN T, GEN x)
489 : {
490 80255 : long k, l = lg(x);
491 : GEN S;
492 80255 : if (l == 2) return gen_0;
493 80255 : S = gmul(gel(T,1), gel(x,2));
494 283290 : for (k = 3; k < l; k++) S = gadd(S, gmul(gel(T,k-1), gel(x,k)));
495 80255 : return S;
496 : }
497 : static GEN
498 253855 : tracerel(GEN a, GEN v, GEN z)
499 : {
500 253855 : a = liftpol_shallow(a);
501 253855 : a = simplify_shallow(z? gmul(z,a): a);
502 253855 : if (typ(a) == t_POL)
503 : {
504 80255 : GEN T = gel(v,3);
505 80255 : long degrel = itou(gel(T,1));
506 80255 : a = tracerel_i(T, RgX_rem(a, gel(v,2)));
507 80255 : if (degrel != 1) a = gdivgu(a, degrel);
508 80255 : if (typ(a) == t_POL) a = RgX_rem(a, gel(v,1));
509 : }
510 253855 : return a;
511 : }
512 : static GEN
513 6944 : tracerel_z(GEN v, long t)
514 : {
515 6944 : GEN Pn = gel(v,2);
516 6944 : return t? pol_xn(t, varn(Pn)): NULL;
517 : }
518 : /* v = Qab_trace_init(n,m); x is a t_VEC of polmodulo Phi_n; Kn = Q(zeta_n)
519 : * [Kn:Km]^(-1) Tr_{Kn/Km} (zeta_n^t * x); 0 <= t < [Kn:Km] */
520 : GEN
521 0 : Qab_tracerel(GEN v, long t, GEN a)
522 : {
523 0 : if (lg(v) != 4) return a; /* => t = 0 */
524 0 : return tracerel(a, v, tracerel_z(v, t));
525 : }
526 : GEN
527 16198 : QabV_tracerel(GEN v, long t, GEN x)
528 : {
529 : GEN z;
530 16198 : if (lg(v) != 4) return x; /* => t = 0 */
531 6944 : z = tracerel_z(v, t);
532 260799 : pari_APPLY_same(tracerel(gel(x,i), v, z));
533 : }
534 : GEN
535 154 : QabM_tracerel(GEN v, long t, GEN x)
536 : {
537 154 : if (lg(v) != 4) return x;
538 105 : pari_APPLY_same(QabV_tracerel(v, t, gel(x,i)));
539 : }
540 :
541 : /* C*zeta_o^k mod X^o - 1 */
542 : static GEN
543 2247966 : Qab_Czeta(long k, long o, GEN C, long vt)
544 : {
545 2247966 : if (!k) return C;
546 1485694 : if (!odd(o))
547 : { /* optimization: reduce max degree by a factor 2 for free */
548 1434587 : o >>= 1;
549 1434587 : if (k >= o) { k -= o; C = gneg(C); if (!k) return C; }
550 : }
551 1137486 : return monomial(C, k, vt);
552 : }
553 : /* zeta_o^k */
554 : static GEN
555 200767 : Qab_zeta(long k, long o, long vt) { return Qab_Czeta(k, o, gen_1, vt); }
556 :
557 : /* Operations on Dirichlet characters */
558 :
559 : /* A Dirichlet character can be given in GP in different formats, but in this
560 : * package, it will be a vector CHI=[G,chi,ord,pol], where G is the (Z/MZ)^* to
561 : * which the character belongs, chi is the character in Conrey format, ord is
562 : * the order, and pol is polcyclo(ord,'t). */
563 :
564 : static GEN
565 3876236 : gmfcharorder(GEN CHI) { return gel(CHI, 3); }
566 : long
567 3817786 : mfcharorder(GEN CHI) { return itou(gmfcharorder(CHI)); }
568 : static long
569 2709 : mfcharistrivial(GEN CHI) { return !CHI || mfcharorder(CHI) == 1; }
570 : static GEN
571 1619786 : gmfcharmodulus(GEN CHI) { return gmael3(CHI, 1, 1, 1); }
572 : long
573 1619786 : mfcharmodulus(GEN CHI) { return itou(gmfcharmodulus(CHI)); }
574 : GEN
575 599354 : mfcharpol(GEN CHI) { return gel(CHI,4); }
576 :
577 : /* vz[i+1] = image of (zeta_o)^i in Fp */
578 : static ulong
579 313040 : Qab_Czeta_Fl(long k, GEN vz, ulong C, ulong p)
580 : {
581 : long o;
582 313040 : if (!k) return C;
583 205982 : o = lg(vz)-2;
584 205982 : if ((k << 1) == o) return Fl_neg(C,p);
585 179053 : return Fl_mul(C, vz[k+1], p);
586 : }
587 :
588 : static long
589 2556365 : znchareval_i(GEN CHI, long n, GEN ord)
590 2556365 : { return itos(znchareval(gel(CHI,1), gel(CHI,2), stoi(n), ord)); }
591 :
592 : /* n coprime with the modulus of CHI */
593 : static GEN
594 14553 : mfchareval(GEN CHI, long n)
595 : {
596 14553 : GEN Pn, C, go = gmfcharorder(CHI);
597 14553 : long k, o = go[2];
598 14553 : if (o == 1) return gen_1;
599 7399 : k = znchareval_i(CHI, n, go);
600 7399 : Pn = mfcharpol(CHI);
601 7399 : C = Qab_zeta(k, o, varn(Pn));
602 7399 : if (typ(C) != t_POL) return C;
603 5327 : return gmodulo(C, Pn);
604 : }
605 : /* d a multiple of ord(CHI); n coprime with char modulus;
606 : * return x s.t. CHI(n) = \zeta_d^x] */
607 : static long
608 3675462 : mfcharevalord(GEN CHI, long n, long d)
609 : {
610 3675462 : if (mfcharorder(CHI) == 1) return 0;
611 2545270 : return znchareval_i(CHI, n, utoi(d));
612 : }
613 :
614 : /* G a znstar, L a Conrey log: return a 'mfchar' */
615 : static GEN
616 378812 : mfcharGL(GEN G, GEN L)
617 : {
618 378812 : GEN o = zncharorder(G,L);
619 378812 : long ord = itou(o), vt = fetch_user_var("t");
620 378812 : return mkvec4(G, L, o, polcyclo(ord,vt));
621 : }
622 : static GEN
623 5859 : mfchartrivial()
624 5859 : { return mfcharGL(znstar0(gen_1,1), cgetg(1,t_COL)); }
625 : /* convert a generic character into an 'mfchar' */
626 : static GEN
627 4074 : get_mfchar(GEN CHI)
628 : {
629 : GEN G, L;
630 4074 : if (typ(CHI) != t_VEC) CHI = znchar(CHI);
631 : else
632 : {
633 889 : long l = lg(CHI);
634 889 : if ((l != 3 && l != 5) || !checkznstar_i(gel(CHI,1)))
635 7 : pari_err_TYPE("checkNF [chi]", CHI);
636 882 : if (l == 5) return CHI;
637 : }
638 4004 : G = gel(CHI,1);
639 4004 : L = gel(CHI,2); if (typ(L) != t_COL) L = znconreylog(G,L);
640 4004 : return mfcharGL(G, L);
641 : }
642 :
643 : /* parse [N], [N,k], [N,k,CHI]. If 'joker' is set, allow wildcard for CHI */
644 : static GEN
645 9247 : checkCHI(GEN NK, long N, int joker)
646 : {
647 : GEN CHI;
648 9247 : if (lg(NK) == 3)
649 742 : CHI = mfchartrivial();
650 : else
651 : {
652 : long i, l;
653 8505 : CHI = gel(NK,3); l = lg(CHI);
654 8505 : if (isintzero(CHI) && joker)
655 4116 : CHI = NULL; /* all character orbits */
656 4389 : else if (isintm1(CHI) && joker > 1)
657 2373 : CHI = gen_m1; /* sum over all character orbits */
658 2016 : else if ((typ(CHI) == t_VEC &&
659 217 : (l == 1 || l != 3 || !checkznstar_i(gel(CHI,1)))) && joker)
660 : {
661 133 : CHI = shallowtrans(CHI); /* list of characters */
662 952 : for (i = 1; i < l; i++) gel(CHI,i) = get_mfchar(gel(CHI,i));
663 : }
664 : else
665 : {
666 1883 : CHI = get_mfchar(CHI); /* single char */
667 1883 : if (N % mfcharmodulus(CHI)) pari_err_TYPE("checkNF [chi]", NK);
668 : }
669 : }
670 9233 : return CHI;
671 : }
672 : /* support half-integral weight */
673 : static void
674 9254 : checkNK2(GEN NK, long *N, long *nk, long *dk, GEN *CHI, int joker)
675 : {
676 9254 : long l = lg(NK);
677 : GEN T;
678 9254 : if (typ(NK) != t_VEC || l < 3 || l > 4) pari_err_TYPE("checkNK", NK);
679 9254 : T = gel(NK,1); if (typ(T) != t_INT) pari_err_TYPE("checkNF [N]", NK);
680 9254 : *N = itos(T); if (*N <= 0) pari_err_TYPE("checkNF [N <= 0]", NK);
681 9254 : T = gel(NK,2);
682 9254 : switch(typ(T))
683 : {
684 5866 : case t_INT: *nk = itos(T); *dk = 1; break;
685 3381 : case t_FRAC:
686 3381 : *nk = itos(gel(T,1));
687 3381 : *dk = itou(gel(T,2)); if (*dk == 2) break;
688 7 : default: pari_err_TYPE("checkNF [k]", NK);
689 : }
690 9247 : *CHI = checkCHI(NK, *N, joker);
691 9233 : }
692 : /* don't support half-integral weight */
693 : static void
694 133 : checkNK(GEN NK, long *N, long *k, GEN *CHI, int joker)
695 : {
696 : long d;
697 133 : checkNK2(NK, N, k, &d, CHI, joker);
698 133 : if (d != 1) pari_err_TYPE("checkNF [k]", NK);
699 133 : }
700 :
701 : static GEN
702 4872 : mfchargalois(long N, int odd, GEN flagorder)
703 : {
704 4872 : GEN G = znstar0(utoi(N), 1), L = chargalois(G, flagorder);
705 4872 : long l = lg(L), i, j;
706 113526 : for (i = j = 1; i < l; i++)
707 : {
708 108654 : GEN chi = znconreyfromchar(G, gel(L,i));
709 108654 : if (zncharisodd(G,chi) == odd) gel(L,j++) = mfcharGL(G,chi);
710 : }
711 4872 : setlg(L, j); return L;
712 : }
713 : /* possible characters for nontrivial S_1(N, chi) */
714 : static GEN
715 1729 : mf1chars(long N, GEN vCHI)
716 : {
717 1729 : if (vCHI) return vCHI; /*do not filter, user knows best*/
718 : /* Tate's theorem */
719 1659 : return mfchargalois(N, 1, uisprime(N)? mkvecsmall2(2,4): NULL);
720 : }
721 : static GEN
722 3255 : mfchars(long N, long k, long dk, GEN vCHI)
723 3255 : { return vCHI? vCHI: mfchargalois(N, (dk == 2)? 0: (k & 1), NULL); }
724 :
725 : /* wrappers from mfchar to znchar */
726 : static long
727 68670 : mfcharparity(GEN CHI)
728 : {
729 68670 : if (!CHI) return 1;
730 68670 : return zncharisodd(gel(CHI,1), gel(CHI,2)) ? -1 : 1;
731 : }
732 : /* if CHI is primitive, return CHI itself, not a copy */
733 : static GEN
734 82334 : mfchartoprimitive(GEN CHI, long *pF)
735 : {
736 : pari_sp av;
737 : GEN chi, F;
738 82334 : if (!CHI) { if (pF) *pF = 1; return mfchartrivial(); }
739 82334 : av = avma; F = znconreyconductor(gel(CHI,1), gel(CHI,2), &chi);
740 82334 : if (typ(F) == t_INT) set_avma(av);
741 : else
742 : {
743 7875 : CHI = leafcopy(CHI);
744 7875 : gel(CHI,1) = znstar0(F, 1);
745 7875 : gel(CHI,2) = chi;
746 : }
747 82334 : if (pF) *pF = mfcharmodulus(CHI);
748 82334 : return CHI;
749 : }
750 : static long
751 397950 : mfcharconductor(GEN CHI)
752 : {
753 397950 : pari_sp av = avma;
754 397950 : GEN res = znconreyconductor(gel(CHI,1), gel(CHI,2), NULL);
755 397950 : if (typ(res) == t_VEC) res = gel(res, 1);
756 397950 : return gc_long(av, itos(res));
757 : }
758 :
759 : /* Operations on mf closures */
760 : static GEN
761 64526 : tagparams(long t, GEN NK) { return mkvec2(mkvecsmall(t), NK); }
762 : static GEN
763 1197 : lfuntag(long t, GEN x) { return mkvec2(mkvecsmall(t), x); }
764 : static GEN
765 56 : tag0(long t, GEN NK) { retmkvec(tagparams(t,NK)); }
766 : static GEN
767 10423 : tag(long t, GEN NK, GEN x) { retmkvec2(tagparams(t,NK), x); }
768 : static GEN
769 37499 : tag2(long t, GEN NK, GEN x, GEN y) { retmkvec3(tagparams(t,NK), x,y); }
770 : static GEN
771 16415 : tag3(long t, GEN NK, GEN x,GEN y,GEN z) { retmkvec4(tagparams(t,NK), x,y,z); }
772 : static GEN
773 0 : tag4(long t, GEN NK, GEN x,GEN y,GEN z,GEN a)
774 0 : { retmkvec5(tagparams(t,NK), x,y,z,a); }
775 : /* is F a "modular form" ? */
776 : int
777 19565 : checkmf_i(GEN F)
778 19565 : { return typ(F) == t_VEC
779 18718 : && lg(F) > 1 && typ(gel(F,1)) == t_VEC
780 13902 : && lg(gel(F,1)) == 3
781 13741 : && typ(gmael(F,1,1)) == t_VECSMALL
782 38283 : && typ(gmael(F,1,2)) == t_VEC; }
783 241108 : long mf_get_type(GEN F) { return gmael(F,1,1)[1]; }
784 191968 : GEN mf_get_gN(GEN F) { return gmael3(F,1,2,1); }
785 144627 : GEN mf_get_gk(GEN F) { return gmael3(F,1,2,2); }
786 : /* k - 1/2, assume k in 1/2 + Z */
787 441 : long mf_get_r(GEN F) { return itou(gel(mf_get_gk(F),1)) >> 1; }
788 124019 : long mf_get_N(GEN F) { return itou(mf_get_gN(F)); }
789 : long
790 73731 : mf_get_k(GEN F)
791 : {
792 73731 : GEN gk = mf_get_gk(F);
793 73731 : if (typ(gk)!=t_INT) pari_err_IMPL("half-integral weight");
794 73731 : return itou(gk);
795 : }
796 65527 : GEN mf_get_CHI(GEN F) { return gmael3(F,1,2,3); }
797 25081 : GEN mf_get_field(GEN F) { return gmael3(F,1,2,4); }
798 19691 : GEN mf_get_NK(GEN F) { return gmael(F,1,2); }
799 : static void
800 588 : mf_setfield(GEN f, GEN P)
801 : {
802 588 : gel(f,1) = leafcopy(gel(f,1));
803 588 : gmael(f,1,2) = leafcopy(gmael(f,1,2));
804 588 : gmael3(f,1,2,4) = P;
805 588 : }
806 :
807 : /* UTILITY FUNCTIONS */
808 : GEN
809 9121 : mftocol(GEN F, long lim, long d)
810 9121 : { GEN c = mfcoefs_i(F, lim, d); settyp(c,t_COL); return c; }
811 : GEN
812 2135 : mfvectomat(GEN vF, long lim, long d)
813 : {
814 2135 : long j, l = lg(vF);
815 2135 : GEN M = cgetg(l, t_MAT);
816 10437 : for (j = 1; j < l; j++) gel(M,j) = mftocol(gel(vF,j), lim, d);
817 2135 : return M;
818 : }
819 :
820 : static GEN
821 4893 : RgV_to_ser_full(GEN x) { return RgV_to_ser(x, 0, lg(x)+1); }
822 : /* TODO: delete */
823 : static GEN
824 679 : mfcoefsser(GEN F, long n) { return RgV_to_ser_full(mfcoefs_i(F,n,1)); }
825 : static GEN
826 847 : sertovecslice(GEN S, long n)
827 : {
828 847 : GEN v = gtovec0(S, -(lg(S) - 2 + valser(S)));
829 847 : long l = lg(v), n2 = n + 2;
830 847 : if (l < n2) pari_err_BUG("sertovecslice [n too large]");
831 847 : return (l == n2)? v: vecslice(v, 1, n2-1);
832 : }
833 :
834 : /* a, b two RgV of the same length, multiply as truncated power series */
835 : static GEN
836 8869 : RgV_mul_RgXn(GEN a, GEN b)
837 : {
838 8869 : long n = lg(a)-1;
839 : GEN c;
840 8869 : a = RgV_to_RgX(a,0);
841 8869 : b = RgV_to_RgX(b,0); c = RgXn_mul(a, b, n);
842 8869 : c = RgX_to_RgC(c,n); settyp(c,t_VEC); return c;
843 : }
844 : /* divide as truncated power series */
845 : static GEN
846 399 : RgV_div_RgXn(GEN a, GEN b)
847 : {
848 399 : long n = lg(a)-1;
849 : GEN c;
850 399 : a = RgV_to_RgX(a,0);
851 399 : b = RgV_to_RgX(b,0); c = RgXn_div_i(a, b, n);
852 399 : c = RgX_to_RgC(c,n); settyp(c,t_VEC); return c;
853 : }
854 : /* a^b */
855 : static GEN
856 112 : RgV_pows_RgXn(GEN a, long b)
857 : {
858 112 : long n = lg(a)-1;
859 : GEN c;
860 112 : a = RgV_to_RgX(a,0);
861 112 : if (b < 0) { a = RgXn_inv(a, n); b = -b; }
862 112 : c = RgXn_powu_i(a,b,n);
863 112 : c = RgX_to_RgC(c,n); settyp(c,t_VEC); return c;
864 : }
865 :
866 : /* assume lg(V) >= n*d + 2 */
867 : static GEN
868 8939 : c_deflate(long n, long d, GEN v)
869 : {
870 8939 : long i, id, l = n+2;
871 : GEN w;
872 8939 : if (d == 1) return lg(v) == l ? v: vecslice(v, 1, l-1);
873 581 : w = cgetg(l, typ(v));
874 11249 : for (i = id = 1; i < l; i++, id += d) gel(w, i) = gel(v, id);
875 581 : return w;
876 : }
877 :
878 : static void
879 14 : err_cyclo(void)
880 14 : { pari_err_IMPL("changing cyclotomic fields in mf"); }
881 : /* Q(zeta_a) = Q(zeta_b) ? */
882 : static int
883 616 : same_cyc(long a, long b)
884 616 : { return (a == b) || (odd(a) && b == (a<<1)) || (odd(b) && a == (b<<1)); }
885 : /* need to combine elements in Q(CHI1) and Q(CHI2) with result in Q(CHI),
886 : * CHI = CHI1 * CHI2 or CHI / CHI2 times some character of order 2 */
887 : static GEN
888 2835 : chicompat(GEN CHI, GEN CHI1, GEN CHI2)
889 : {
890 2835 : long o1 = mfcharorder(CHI1);
891 2835 : long o2 = mfcharorder(CHI2), O, o;
892 : GEN T1, T2, P, Po;
893 2835 : if (o1 <= 2 && o2 <= 2) return NULL;
894 623 : o = mfcharorder(CHI);
895 623 : Po = mfcharpol(CHI);
896 623 : P = mfcharpol(CHI1);
897 623 : if (o1 == o2)
898 : {
899 21 : if (o1 == o) return NULL;
900 14 : if (!same_cyc(o1,o)) err_cyclo();
901 0 : return mkvec4(P, gen_1,gen_1, Qab_trace_init(o1, o, P, Po));
902 : }
903 602 : O = ulcm(o1, o2);
904 602 : if (!same_cyc(O,o)) err_cyclo();
905 602 : if (O != o1) P = (O == o2)? mfcharpol(CHI2): polcyclo(O, varn(P));
906 602 : T1 = o1 <= 2? gen_1: utoipos(O / o1);
907 602 : T2 = o2 <= 2? gen_1: utoipos(O / o2);
908 602 : return mkvec4(P, T1, T2, O == o? gen_1: Qab_trace_init(O, o, P, Po));
909 : }
910 : static GEN
911 49 : inflatemod(GEN f, long o, GEN P)
912 : {
913 49 : f = lift_shallow(f);
914 49 : return gmodulo(typ(f)==t_POL? RgX_inflate(f,o): f, P);
915 : }
916 : static GEN
917 7 : RgV_inflatemod(GEN x, long o, GEN P)
918 56 : { pari_APPLY_same(inflatemod(gel(x,i), o, P)); }
919 : /* *F a vector of cyclotomic numbers */
920 : static void
921 651 : chicompatlift(GEN T, GEN *F, GEN *G)
922 : {
923 651 : long o1 = itou(gel(T,2)), o2 = itou(gel(T,3));
924 651 : GEN P = gel(T,1);
925 651 : if (o1 != 1) *F = RgV_inflatemod(*F, o1, P);
926 651 : if (o2 != 1 && G) *G = RgV_inflatemod(*G, o2, P);
927 651 : }
928 : static GEN
929 651 : chicompatfix(GEN T, GEN F)
930 : {
931 651 : GEN V = gel(T,4);
932 651 : if (typ(V) == t_VEC) F = gmodulo(QabV_tracerel(V, 0, F), gel(V,1));
933 651 : return F;
934 : }
935 :
936 : static GEN
937 637 : c_mul(long n, long d, GEN S)
938 : {
939 637 : pari_sp av = avma;
940 637 : long nd = n*d;
941 637 : GEN F = gel(S,2), G = gel(S,3);
942 637 : F = mfcoefs_i(F, nd, 1);
943 637 : G = mfcoefs_i(G, nd, 1);
944 637 : if (lg(S) == 5) chicompatlift(gel(S,4),&F,&G);
945 637 : F = c_deflate(n, d, RgV_mul_RgXn(F,G));
946 637 : if (lg(S) == 5) F = chicompatfix(gel(S,4), F);
947 637 : return gc_GEN(av, F);
948 : }
949 : static GEN
950 112 : c_pow(long n, long d, GEN S)
951 : {
952 112 : pari_sp av = avma;
953 112 : long nd = n*d;
954 112 : GEN F = gel(S,2), a = gel(S,3), f = mfcoefs_i(F,nd,1);
955 112 : if (lg(S) == 5) chicompatlift(gel(S,4),&F, NULL);
956 112 : f = RgV_pows_RgXn(f, itos(a));
957 112 : f = c_deflate(n, d, f);
958 112 : if (lg(S) == 5) f = chicompatfix(gel(S,4), f);
959 112 : return gc_GEN(av, f);
960 : }
961 :
962 : /* F * Theta */
963 : static GEN
964 448 : mfmultheta(GEN F)
965 : {
966 448 : if (typ(mf_get_gk(F)) == t_FRAC && mf_get_type(F) == t_MF_DIV)
967 : {
968 154 : GEN T = gel(F,3); /* hopefully mfTheta() */
969 154 : if (mf_get_type(T) == t_MF_THETA && mf_get_N(T) == 4) return gel(F,2);
970 : }
971 294 : return mfmul(F, mfTheta(NULL));
972 : }
973 :
974 : static GEN
975 42 : c_bracket(long n, long d, GEN S)
976 : {
977 42 : pari_sp av = avma;
978 42 : long i, nd = n*d;
979 42 : GEN F = gel(S,2), G = gel(S,3), tF, tG, C, mpow, res, gk, gl;
980 42 : GEN VF = mfcoefs_i(F, nd, 1);
981 42 : GEN VG = mfcoefs_i(G, nd, 1);
982 42 : ulong j, m = itou(gel(S,4));
983 :
984 42 : if (!n)
985 : {
986 14 : if (m > 0) { set_avma(av); return mkvec(gen_0); }
987 7 : return gc_GEN(av, mkvec(gmul(gel(VF, 1), gel(VG, 1))));
988 : }
989 28 : tF = cgetg(nd+2, t_VEC);
990 28 : tG = cgetg(nd+2, t_VEC);
991 28 : res = NULL; gk = mf_get_gk(F); gl = mf_get_gk(G);
992 : /* pow[i,j+1] = i^j */
993 28 : if (lg(S) == 6) chicompatlift(gel(S,5),&VF,&VG);
994 28 : mpow = cgetg(m+2, t_MAT);
995 28 : gel(mpow,1) = const_col(nd, gen_1);
996 56 : for (j = 1; j <= m; j++)
997 : {
998 28 : GEN c = cgetg(nd+1, t_COL);
999 28 : gel(mpow,j+1) = c;
1000 245 : for (i = 1; i <= nd; i++) gel(c,i) = muliu(gcoeff(mpow,i,j), i);
1001 : }
1002 28 : C = binomial(gaddgs(gk, m-1), m);
1003 28 : if (odd(m)) C = gneg(C);
1004 84 : for (j = 0; j <= m; j++)
1005 : { /* C = (-1)^(m-j) binom(m+l-1, j) binom(m+k-1,m-j) */
1006 : GEN c;
1007 56 : gel(tF,1) = j == 0? gel(VF,1): gen_0;
1008 56 : gel(tG,1) = j == m? gel(VG,1): gen_0;
1009 56 : gel(tF,2) = gel(VF,2); /* assume nd >= 1 */
1010 56 : gel(tG,2) = gel(VG,2);
1011 518 : for (i = 2; i <= nd; i++)
1012 : {
1013 462 : gel(tF, i+1) = gmul(gcoeff(mpow,i,j+1), gel(VF, i+1));
1014 462 : gel(tG, i+1) = gmul(gcoeff(mpow,i,m-j+1), gel(VG, i+1));
1015 : }
1016 56 : c = gmul(C, c_deflate(n, d, RgV_mul_RgXn(tF, tG)));
1017 56 : res = res? gadd(res, c): c;
1018 56 : if (j < m)
1019 56 : C = gdiv(gmul(C, gmulsg(m-j, gaddgs(gl,m-j-1))),
1020 28 : gmulsg(-(j+1), gaddgs(gk,j)));
1021 : }
1022 28 : if (lg(S) == 6) res = chicompatfix(gel(S,5), res);
1023 28 : return gc_upto(av, res);
1024 : }
1025 : /* linear combination \sum L[j] vecF[j] */
1026 : static GEN
1027 3024 : c_linear(long n, long d, GEN F, GEN L, GEN dL)
1028 : {
1029 3024 : pari_sp av = avma;
1030 3024 : long j, l = lg(L);
1031 3024 : GEN S = NULL;
1032 10780 : for (j = 1; j < l; j++)
1033 : {
1034 7756 : GEN c = gel(L,j);
1035 7756 : if (gequal0(c)) continue;
1036 7000 : c = gmul(c, mfcoefs_i(gel(F,j), n, d));
1037 7000 : S = S? gadd(S,c): c;
1038 : }
1039 3024 : if (!S) return zerovec(n+1);
1040 3024 : if (!is_pm1(dL)) S = gdiv(S, dL);
1041 3024 : return gc_upto(av, S);
1042 : }
1043 :
1044 : /* B_d(T_j Trace^new) as t_MF_BD(t_MF_HECKE(t_MF_NEWTRACE)) or
1045 : * t_MF_HECKE(t_MF_NEWTRACE)
1046 : * or t_MF_NEWTRACE in level N. Set d and j, return t_MF_NEWTRACE component*/
1047 : static GEN
1048 84665 : bhn_parse(GEN f, long *d, long *j)
1049 : {
1050 84665 : long t = mf_get_type(f);
1051 84665 : *d = *j = 1;
1052 84665 : if (t == t_MF_BD) { *d = itos(gel(f,3)); f = gel(f,2); t = mf_get_type(f); }
1053 84665 : if (t == t_MF_HECKE) { *j = gel(f,2)[1]; f = gel(f,3); }
1054 84665 : return f;
1055 : }
1056 : /* f as above, return the t_MF_NEWTRACE component */
1057 : static GEN
1058 34993 : bhn_newtrace(GEN f)
1059 : {
1060 34993 : long t = mf_get_type(f);
1061 34993 : if (t == t_MF_BD) { f = gel(f,2); t = mf_get_type(f); }
1062 34993 : if (t == t_MF_HECKE) f = gel(f,3);
1063 34993 : return f;
1064 : }
1065 : static int
1066 4144 : ok_bhn_linear(GEN vf)
1067 : {
1068 4144 : long i, N0 = 0, l = lg(vf);
1069 : GEN CHI, gk;
1070 4144 : if (l == 1) return 1;
1071 4144 : gk = mf_get_gk(gel(vf,1));
1072 4144 : CHI = mf_get_CHI(gel(vf,1));
1073 29792 : for (i = 1; i < l; i++)
1074 : {
1075 28007 : GEN f = bhn_newtrace(gel(vf,i));
1076 28007 : long N = mf_get_N(f);
1077 28007 : if (mf_get_type(f) != t_MF_NEWTRACE) return 0;
1078 25648 : if (N < N0) return 0; /* largest level must come last */
1079 25648 : N0 = N;
1080 25648 : if (!gequal(gk,mf_get_gk(f))) return 0; /* same k */
1081 25648 : if (!gequal(gel(mf_get_CHI(f),2), gel(CHI,2))) return 0; /* same CHI */
1082 : }
1083 1785 : return 1;
1084 : }
1085 :
1086 : /* vF not empty, same hypotheses as bhnmat_extend */
1087 : static GEN
1088 7091 : bhnmat_extend_nocache(GEN M, long N, long n, long d, GEN vF)
1089 : {
1090 : cachenew_t cache;
1091 7091 : long l = lg(vF);
1092 : GEN f;
1093 7091 : if (l == 1) return M? M: cgetg(1, t_MAT);
1094 6986 : f = bhn_newtrace(gel(vF,1)); /* N.B. mf_get_N(f) divides N */
1095 6986 : init_cachenew(&cache, n*d, N, f);
1096 6986 : M = bhnmat_extend(M, n, d, vF, &cache);
1097 6986 : dbg_cachenew(&cache); return M;
1098 : }
1099 : /* c_linear of "bhn" mf closures, same hypotheses as bhnmat_extend */
1100 : static GEN
1101 2331 : c_linear_bhn(long n, long d, GEN F)
1102 : {
1103 : pari_sp av;
1104 2331 : GEN M, v, vF = gel(F,2), L = gel(F,3), dL = gel(F,4);
1105 2331 : if (lg(L) == 1) return zerovec(n+1);
1106 2331 : av = avma;
1107 2331 : M = bhnmat_extend_nocache(NULL, mf_get_N(F), n, d, vF);
1108 2331 : v = RgM_RgC_mul(M,L); settyp(v, t_VEC);
1109 2331 : if (!is_pm1(dL)) v = gdiv(v, dL);
1110 2331 : return gc_upto(av, v);
1111 : }
1112 :
1113 : /* c in K, K := Q[X]/(T) vz = vector of consecutive powers of root z of T
1114 : * attached to an embedding s: K -> C. Return s(c) in C */
1115 : static GEN
1116 84686 : Rg_embed1(GEN c, GEN vz)
1117 : {
1118 84686 : long t = typ(c);
1119 84686 : if (t == t_POLMOD) { c = gel(c,2); t = typ(c); }
1120 84686 : if (t == t_POL) c = RgX_RgV_eval(c, vz);
1121 84686 : return c;
1122 : }
1123 : /* return s(x) in C[X] */
1124 : static GEN
1125 13489 : RgX_embed1(GEN x, GEN vz)
1126 40698 : { pari_APPLY_pol(Rg_embed1(gel(x,i), vz)); }
1127 : /* return s(x) in C^n */
1128 : static GEN
1129 798 : vecembed1(GEN x, GEN vz)
1130 39858 : { pari_APPLY_same(Rg_embed1(gel(x,i), vz)); }
1131 : /* P in L = K[X]/(U), K = Q[t]/T; s an embedding of K -> C attached
1132 : * to a root of T, extended to an embedding of L -> C attached to a root
1133 : * of s(U); vT powers of the root of T, vU powers of the root of s(U).
1134 : * Return s(P) in C^n */
1135 : static GEN
1136 13328 : Rg_embed2(GEN P, long vt, GEN vT, GEN vU)
1137 : {
1138 13328 : P = liftpol_shallow(P);
1139 13328 : if (typ(P) != t_POL) return P;
1140 13272 : if (varn(P) == vt) return Rg_embed1(P, vT);
1141 13265 : return Rg_embed1(RgX_embed1(P, vT), vU); /* varn(P) == vx */
1142 : }
1143 : static GEN
1144 42 : vecembed2(GEN x, long vt, GEN vT, GEN vU)
1145 1050 : { pari_APPLY_same(Rg_embed2(gel(x,i), vt, vT, vU)); }
1146 : static GEN
1147 532 : RgX_embed2(GEN x, long vt, GEN vT, GEN vU)
1148 3724 : { pari_APPLY_pol(Rg_embed2(gel(x,i), vt, vT, vU)); }
1149 : /* embed polynomial f in variable 0 [ may be a scalar ], E from getembed */
1150 : static GEN
1151 1687 : RgX_embed(GEN f, GEN E)
1152 : {
1153 : GEN vT;
1154 1687 : if (typ(f) != t_POL || varn(f) != 0) return mfembed(E, f);
1155 945 : if (lg(E) == 1) return f;
1156 721 : vT = gel(E,2);
1157 721 : if (lg(E) == 3)
1158 189 : f = RgX_embed1(f, vT);
1159 : else
1160 532 : f = RgX_embed2(f, varn(gel(E,1)), vT, gel(E,3));
1161 721 : return f;
1162 : }
1163 : /* embed vector, E from getembed */
1164 : GEN
1165 1743 : mfvecembed(GEN E, GEN v)
1166 : {
1167 : GEN vT;
1168 1743 : if (lg(E) == 1) return v;
1169 840 : vT = gel(E,2);
1170 840 : if (lg(E) == 3)
1171 798 : v = vecembed1(v, vT);
1172 : else
1173 42 : v = vecembed2(v, varn(gel(E,1)), vT, gel(E,3));
1174 840 : return v;
1175 : }
1176 : GEN
1177 70 : mfmatembed(GEN E, GEN x)
1178 : {
1179 70 : if (lg(E) == 1) return x;
1180 168 : pari_APPLY_same(mfvecembed(E, gel(x,i)));
1181 : }
1182 : /* embed vector of polynomials in var 0 */
1183 : static GEN
1184 98 : RgXV_embed(GEN x, GEN E)
1185 : {
1186 98 : if (lg(E) == 1) return x;
1187 1358 : pari_APPLY_same(RgX_embed(gel(x,i), E));
1188 : }
1189 :
1190 : /* embed scalar */
1191 : GEN
1192 101545 : mfembed(GEN E, GEN f)
1193 : {
1194 : GEN vT;
1195 101545 : if (lg(E) == 1) return f;
1196 14273 : vT = gel(E,2);
1197 14273 : if (lg(E) == 3)
1198 5145 : f = Rg_embed1(f, vT);
1199 : else
1200 9128 : f = Rg_embed2(f, varn(gel(E,1)), vT, gel(E,3));
1201 14273 : return f;
1202 : }
1203 : /* vector of the sigma(f), sigma in vE */
1204 : static GEN
1205 364 : RgX_embedall(GEN f, GEN vE)
1206 : {
1207 364 : long i, l = lg(vE);
1208 : GEN v;
1209 364 : if (l == 2) return RgX_embed(f, gel(vE,1));
1210 35 : v = cgetg(l, t_VEC);
1211 105 : for (i = 1; i < l; i++) gel(v,i) = RgX_embed(f, gel(vE,i));
1212 35 : return v;
1213 : }
1214 : /* matrix whose colums are the sigma(v), sigma in vE */
1215 : static GEN
1216 350 : RgC_embedall(GEN v, GEN vE)
1217 : {
1218 350 : long j, l = lg(vE);
1219 350 : GEN M = cgetg(l, t_MAT);
1220 875 : for (j = 1; j < l; j++) gel(M,j) = mfvecembed(gel(vE,j), v);
1221 350 : return M;
1222 : }
1223 : /* vector of the sigma(v), sigma in vE */
1224 : static GEN
1225 4907 : Rg_embedall_i(GEN v, GEN vE)
1226 : {
1227 4907 : long j, l = lg(vE);
1228 4907 : GEN M = cgetg(l, t_VEC);
1229 14735 : for (j = 1; j < l; j++) gel(M,j) = mfembed(gel(vE,j), v);
1230 4907 : return M;
1231 : }
1232 : /* vector of the sigma(v), sigma in vE; if #vE == 1, return v */
1233 : static GEN
1234 95154 : Rg_embedall(GEN v, GEN vE)
1235 95154 : { return (lg(vE) == 2)? mfembed(gel(vE,1), v): Rg_embedall_i(v, vE); }
1236 :
1237 : static GEN
1238 847 : c_div_i(long n, GEN S)
1239 : {
1240 847 : GEN F = gel(S,2), G = gel(S,3);
1241 : GEN a0, a0i, H;
1242 847 : F = mfcoefs_i(F, n, 1);
1243 847 : G = mfcoefs_i(G, n, 1);
1244 847 : if (lg(S) == 5) chicompatlift(gel(S,4),&F,&G);
1245 847 : F = RgV_to_ser_full(F);
1246 847 : G = RgV_to_ser_full(G);
1247 847 : a0 = polcoef_i(G, 0, -1); /* != 0 */
1248 847 : if (gequal1(a0)) a0 = a0i = NULL;
1249 : else
1250 : {
1251 602 : a0i = ginv(a0);
1252 602 : G = gmul(ser_unscale(G,a0), a0i);
1253 602 : F = gmul(ser_unscale(F,a0), a0i);
1254 : }
1255 847 : H = gdiv(F, G);
1256 847 : if (a0) H = ser_unscale(H,a0i);
1257 847 : H = sertovecslice(H, n);
1258 847 : if (lg(S) == 5) H = chicompatfix(gel(S,4), H);
1259 847 : return H;
1260 : }
1261 : static GEN
1262 847 : c_div(long n, long d, GEN S)
1263 : {
1264 847 : pari_sp av = avma;
1265 847 : GEN D = (d==1)? c_div_i(n, S): c_deflate(n, d, c_div_i(n*d, S));
1266 847 : return gc_GEN(av, D);
1267 : }
1268 :
1269 : static GEN
1270 35 : c_shift(long n, long d, GEN F, GEN gsh)
1271 : {
1272 35 : pari_sp av = avma;
1273 : GEN vF;
1274 35 : long sh = itos(gsh), n1 = n*d + sh;
1275 35 : if (n1 < 0) return zerovec(n+1);
1276 35 : vF = mfcoefs_i(F, n1, 1);
1277 35 : if (sh < 0) vF = shallowconcat(zerovec(-sh), vF);
1278 35 : else vF = vecslice(vF, sh+1, n1+1);
1279 35 : return gc_GEN(av, c_deflate(n, d, vF));
1280 : }
1281 :
1282 : static GEN
1283 175 : c_deriv(long n, long d, GEN F, GEN gm)
1284 : {
1285 175 : pari_sp av = avma;
1286 175 : GEN V = mfcoefs_i(F, n, d), res;
1287 175 : long i, m = itos(gm);
1288 175 : if (!m) return V;
1289 175 : res = cgetg(n+2, t_VEC); gel(res,1) = gen_0;
1290 175 : if (m < 0)
1291 49 : { for (i=1; i <= n; i++) gel(res, i+1) = gdiv(gel(V, i+1), powuu(i,-m)); }
1292 : else
1293 2457 : { for (i=1; i <= n; i++) gel(res, i+1) = gmul(gel(V,i+1), powuu(i,m)); }
1294 175 : return gc_upto(av, res);
1295 : }
1296 :
1297 : static GEN
1298 14 : c_derivE2(long n, long d, GEN F, GEN gm)
1299 : {
1300 14 : pari_sp av = avma;
1301 : GEN VF, VE, res, tmp, gk;
1302 14 : long i, m = itos(gm), nd;
1303 14 : if (m == 0) return mfcoefs_i(F, n, d);
1304 14 : nd = n*d;
1305 14 : VF = mfcoefs_i(F, nd, 1); VE = mfcoefs_i(mfEk(2), nd, 1);
1306 14 : gk = mf_get_gk(F);
1307 14 : if (m == 1)
1308 : {
1309 7 : res = cgetg(n+2, t_VEC);
1310 56 : for (i = 0; i <= n; i++) gel(res, i+1) = gmulsg(i, gel(VF, i*d+1));
1311 7 : tmp = c_deflate(n, d, RgV_mul_RgXn(VF, VE));
1312 7 : return gc_upto(av, gsub(res, gmul(gdivgu(gk, 12), tmp)));
1313 : }
1314 : else
1315 : {
1316 : long j;
1317 35 : for (j = 1; j <= m; j++)
1318 : {
1319 28 : tmp = RgV_mul_RgXn(VF, VE);
1320 140 : for (i = 0; i <= nd; i++) gel(VF, i+1) = gmulsg(i, gel(VF, i+1));
1321 28 : VF = gsub(VF, gmul(gdivgu(gaddgs(gk, 2*(j-1)), 12), tmp));
1322 : }
1323 7 : return gc_GEN(av, c_deflate(n, d, VF));
1324 : }
1325 : }
1326 :
1327 : /* Twist by the character (D/.) */
1328 : static GEN
1329 168 : c_twist(long n, long d, GEN F, GEN D)
1330 : {
1331 168 : pari_sp av = avma;
1332 168 : GEN v = mfcoefs_i(F, n, d), z = cgetg(n+2, t_VEC);
1333 : long i;
1334 994 : for (i = 0; i <= n; i++)
1335 : {
1336 : long s;
1337 826 : GEN a = gel(v, i+1);
1338 826 : if (d == 1) s = krois(D, i);
1339 : else
1340 : {
1341 266 : pari_sp av2 = avma;
1342 266 : s = kronecker(D, muluu(i, d)); set_avma(av2);
1343 : }
1344 826 : switch(s)
1345 : {
1346 259 : case 1: a = gcopy(a); break;
1347 252 : case -1: a = gneg(a); break;
1348 315 : default: a = gen_0; break;
1349 : }
1350 826 : gel(z, i+1) = a;
1351 : }
1352 168 : return gc_upto(av, z);
1353 : }
1354 :
1355 : /* form F given by closure, compute T(n)(F) as closure */
1356 : static GEN
1357 1246 : c_hecke(long m, long l, GEN DATA, GEN F)
1358 : {
1359 1246 : pari_sp av = avma;
1360 1246 : return gc_GEN(av, hecke_i(m, l, NULL, F, DATA));
1361 : }
1362 : static GEN
1363 147 : c_const(long n, long d, GEN C)
1364 : {
1365 147 : GEN V = zerovec(n+1);
1366 147 : long i, j, l = lg(C);
1367 147 : if (l > d*n+2) l = d*n+2;
1368 196 : for (i = j = 1; i < l; i+=d, j++) gel(V, j) = gcopy(gel(C,i));
1369 147 : return V;
1370 : }
1371 :
1372 : /* m > 0 */
1373 : static GEN
1374 525 : eta3_ZXn(long m)
1375 : {
1376 525 : long l = m+2, n, k;
1377 525 : GEN P = cgetg(l,t_POL);
1378 525 : P[1] = evalsigne(1)|evalvarn(0);
1379 7245 : for (n = 2; n < l; n++) gel(P,n) = gen_0;
1380 525 : for (n = k = 0;; n++)
1381 : {
1382 2891 : if (k + n >= m) { setlg(P, k+3); return P; }
1383 2366 : k += n;
1384 : /* now k = n(n+1) / 2 */
1385 2366 : gel(P, k+2) = odd(n)? utoineg(2*n+1): utoipos(2*n+1);
1386 : }
1387 : }
1388 :
1389 : static GEN
1390 539 : c_delta(long n, long d)
1391 : {
1392 539 : pari_sp ltop = avma;
1393 539 : long N = n*d;
1394 : GEN e;
1395 539 : if (!N) return mkvec(gen_0);
1396 525 : e = eta3_ZXn(N);
1397 525 : e = ZXn_sqr(e,N);
1398 525 : e = ZXn_sqr(e,N);
1399 525 : e = ZXn_sqr(e,N); /* eta(x)^24 */
1400 525 : settyp(e, t_VEC);
1401 525 : gel(e,1) = gen_0; /* Delta(x) = x*eta(x)^24 as a t_VEC */
1402 525 : return gc_GEN(ltop, c_deflate(n, d, e));
1403 : }
1404 :
1405 : /* return s(d) such that s|f <=> d | f^2 */
1406 : static long
1407 56 : mysqrtu(ulong d)
1408 : {
1409 56 : GEN fa = myfactoru(d), P = gel(fa,1), E = gel(fa,2);
1410 56 : long l = lg(P), i, s = 1;
1411 140 : for (i = 1; i < l; i++) s *= upowuu(P[i], (E[i]+1)>>1);
1412 56 : return s;
1413 : }
1414 : static GEN
1415 1946 : c_theta(long n, long d, GEN psi)
1416 : {
1417 1946 : long lim = usqrt(n*d), F = mfcharmodulus(psi), par = mfcharparity(psi);
1418 1946 : long f, d2 = d == 1? 1: mysqrtu(d);
1419 1946 : GEN V = zerovec(n + 1);
1420 8722 : for (f = d2; f <= lim; f += d2)
1421 6776 : if (ugcd(F, f) == 1)
1422 : {
1423 6769 : pari_sp av = avma;
1424 6769 : GEN c = mfchareval(psi, f);
1425 6769 : gel(V, f*f/d + 1) = gc_upto(av, par < 0? gmulgu(c,2*f): gmul2n(c,1));
1426 : }
1427 1946 : if (F == 1) gel(V, 1) = gen_1;
1428 1946 : return V; /* no GC needed */
1429 : }
1430 :
1431 : static GEN
1432 203 : c_etaquo(long n, long d, GEN eta, GEN gs)
1433 : {
1434 203 : pari_sp av = avma;
1435 203 : long s = itos(gs), nd = n*d, nds = nd - s + 1;
1436 : GEN c;
1437 203 : if (nds <= 0) return zerovec(n+1);
1438 182 : c = RgX_to_RgC(eta_product_ZXn(eta, nds), nds); settyp(c, t_VEC);
1439 182 : if (s > 0) c = shallowconcat(zerovec(s), c);
1440 182 : return gc_GEN(av, c_deflate(n, d, c));
1441 : }
1442 :
1443 : static GEN
1444 77 : c_ell(long n, long d, GEN E)
1445 : {
1446 77 : pari_sp av = avma;
1447 : GEN v;
1448 77 : if (d == 1) return gconcat(gen_0, ellan(E, n));
1449 7 : v = vec_prepend(ellan(E, n*d), gen_0);
1450 7 : return gc_GEN(av, c_deflate(n, d, v));
1451 : }
1452 :
1453 : static GEN
1454 21 : c_cusptrace(long n, long d, GEN F)
1455 : {
1456 21 : pari_sp av = avma;
1457 21 : GEN D = gel(F,2), res = cgetg(n+2, t_VEC);
1458 21 : long i, N = mf_get_N(F), k = mf_get_k(F);
1459 21 : gel(res, 1) = gen_0;
1460 140 : for (i = 1; i <= n; i++)
1461 119 : gel(res, i+1) = mfcusptrace_i(N, k, i*d, mydivisorsu(i*d), D);
1462 21 : return gc_GEN(av, res);
1463 : }
1464 :
1465 : static GEN
1466 1918 : c_newtrace(long n, long d, GEN F)
1467 : {
1468 1918 : pari_sp av = avma;
1469 : cachenew_t cache;
1470 1918 : long N = mf_get_N(F);
1471 : GEN v;
1472 1918 : init_cachenew(&cache, n == 1? 1: n*d, N, F);
1473 1918 : v = colnewtrace(0, n, d, N, mf_get_k(F), &cache);
1474 1918 : settyp(v, t_VEC); return gc_GEN(av, v);
1475 : }
1476 :
1477 : static GEN
1478 7525 : c_Bd(long n, long d, GEN F, GEN A)
1479 : {
1480 7525 : pari_sp av = avma;
1481 7525 : long a = itou(A), ad = ugcd(a,d), aad = a/ad, i, j;
1482 7525 : GEN w, v = mfcoefs_i(F, n/aad, d/ad);
1483 7525 : if (a == 1) return v;
1484 7525 : n++; w = zerovec(n);
1485 213416 : for (i = j = 1; j <= n; i++, j += aad) gel(w,j) = gcopy(gel(v,i));
1486 7525 : return gc_upto(av, w);
1487 : }
1488 :
1489 : static GEN
1490 5579 : c_dihedral(long n, long d, GEN F)
1491 : {
1492 5579 : pari_sp av = avma;
1493 5579 : GEN CHI = mf_get_CHI(F);
1494 5579 : GEN w = gel(F,3), V = dihan(gel(F,2), w, gel(F,4), mfcharorder(CHI), n*d);
1495 5579 : GEN Tinit = gel(w,3), Pm = gel(Tinit,1);
1496 5579 : GEN A = c_deflate(n, d, V);
1497 5579 : if (degpol(Pm) == 1 || RgV_is_ZV(A)) return gc_GEN(av, A);
1498 1043 : return gc_upto(av, gmodulo(A, Pm));
1499 : }
1500 :
1501 : static GEN
1502 343 : c_mfEH(long n, long d, GEN F)
1503 : {
1504 343 : pari_sp av = avma;
1505 : GEN v, M, A;
1506 343 : long i, r = mf_get_r(F);
1507 343 : if (n == 1)
1508 14 : return gc_GEN(av, mkvec2(mfEHcoef(r,0),mfEHcoef(r,d)));
1509 : /* speedup mfcoef */
1510 329 : if (r == 1)
1511 : {
1512 70 : v = cgetg(n+2, t_VEC);
1513 70 : gel(v,1) = sstoQ(-1,12);
1514 83258 : for (i = 1; i <= n; i++)
1515 : {
1516 83188 : long id = i*d, a = id & 3;
1517 83188 : gel(v,i+1) = (a==1 || a==2)? gen_0: uutoQ(hclassno6u(id), 6);
1518 : }
1519 70 : return v; /* no GC needed */
1520 : }
1521 259 : M = mfEHmat(n*d+1,r);
1522 259 : if (d > 1)
1523 : {
1524 35 : long l = lg(M);
1525 119 : for (i = 1; i < l; i++) gel(M,i) = c_deflate(n, d, gel(M,i));
1526 : }
1527 259 : A = gel(F,2); /* [num(B), den(B)] */
1528 259 : v = RgC_Rg_div(RgM_RgC_mul(M, gel(A,1)), gel(A,2));
1529 259 : settyp(v,t_VEC); return gc_upto(av, v);
1530 : }
1531 :
1532 : static GEN
1533 11361 : c_mfeisen(long n, long d, GEN F)
1534 : {
1535 11361 : pari_sp av = avma;
1536 11361 : GEN v, vchi, E0, P, T, CHI, gk = mf_get_gk(F);
1537 : long i, k;
1538 11361 : if (typ(gk) != t_INT) return c_mfEH(n, d, F);
1539 11018 : k = itou(gk);
1540 11018 : vchi = gel(F,2);
1541 11018 : E0 = gel(vchi,1);
1542 11018 : T = gel(vchi,2);
1543 11018 : P = gel(T,1);
1544 11018 : CHI = gel(vchi,3);
1545 11018 : v = cgetg(n+2, t_VEC);
1546 11018 : gel(v, 1) = gcopy(E0); /* E(0) */
1547 11018 : if (lg(vchi) == 5)
1548 : { /* E_k(chi1,chi2) */
1549 8925 : GEN CHI2 = gel(vchi,4), F3 = gel(F,3);
1550 8925 : long ord = F3[1], j = F3[2];
1551 509670 : for (i = 1; i <= n; i++) gel(v, i+1) = sigchi2(k, CHI, CHI2, i*d, ord);
1552 8925 : v = QabV_tracerel(T, j, v);
1553 : }
1554 : else
1555 : { /* E_k(chi) */
1556 26285 : for (i = 1; i <= n; i++) gel(v, i+1) = sigchi(k, CHI, i*d);
1557 : }
1558 11018 : if (degpol(P) != 1 && !RgV_is_QV(v)) return gc_upto(av, gmodulo(v, P));
1559 8085 : return gc_GEN(av, v);
1560 : }
1561 :
1562 : /* N^k * (D * B_k)(x/N), set D = denom(B_k) */
1563 : static GEN
1564 2023 : bern_init(long N, long k, GEN *pD)
1565 2023 : { return ZX_rescale(Q_remove_denom(bernpol(k, 0), pD), utoi(N)); }
1566 :
1567 : /* L(chi_D, 1-k) */
1568 : static GEN
1569 28 : lfunquadneg_naive(long D, long k)
1570 : {
1571 : GEN B, dS, S;
1572 28 : long r, N = labs(D);
1573 : pari_sp av;
1574 28 : if (k == 1 && N == 1) return gneg(ghalf);
1575 28 : B = bern_init(N, k, &dS);
1576 28 : dS = mul_denom(dS, stoi(-N*k));
1577 28 : av = avma;
1578 7175 : for (r = 0, S = gen_0; r < N; r++)
1579 : {
1580 7147 : long c = kross(D, r);
1581 7147 : if (c)
1582 : {
1583 5152 : GEN t = ZX_Z_eval(B, utoi(r));
1584 5152 : S = c > 0 ? addii(S, t) : subii(S, t);
1585 5152 : S = gc_INT(av, S);
1586 : }
1587 : }
1588 28 : return gdiv(S, dS);
1589 : }
1590 :
1591 : /* Returns vector of coeffs from F[0], F[d], ..., F[d*n] */
1592 : static GEN
1593 38563 : mfcoefs_i(GEN F, long n, long d)
1594 : {
1595 38563 : if (n < 0) return gen_0;
1596 38563 : switch(mf_get_type(F))
1597 : {
1598 147 : case t_MF_CONST: return c_const(n, d, gel(F,2));
1599 11361 : case t_MF_EISEN: return c_mfeisen(n, d, F);
1600 882 : case t_MF_Ek: return c_Ek(n, d, F);
1601 539 : case t_MF_DELTA: return c_delta(n, d);
1602 1680 : case t_MF_THETA: return c_theta(n, d, gel(F,2));
1603 203 : case t_MF_ETAQUO: return c_etaquo(n, d, gel(F,2), gel(F,3));
1604 77 : case t_MF_ELL: return c_ell(n, d, gel(F,2));
1605 637 : case t_MF_MUL: return c_mul(n, d, F);
1606 112 : case t_MF_POW: return c_pow(n, d, F);
1607 42 : case t_MF_BRACKET: return c_bracket(n, d, F);
1608 3024 : case t_MF_LINEAR: return c_linear(n, d, gel(F,2), gel(F,3), gel(F,4));
1609 2331 : case t_MF_LINEAR_BHN: return c_linear_bhn(n, d, F);
1610 847 : case t_MF_DIV: return c_div(n, d, F);
1611 35 : case t_MF_SHIFT: return c_shift(n, d, gel(F,2), gel(F,3));
1612 175 : case t_MF_DERIV: return c_deriv(n, d, gel(F,2), gel(F,3));
1613 14 : case t_MF_DERIVE2: return c_derivE2(n, d, gel(F,2), gel(F,3));
1614 168 : case t_MF_TWIST: return c_twist(n, d, gel(F,2), gel(F,3));
1615 1246 : case t_MF_HECKE: return c_hecke(n, d, gel(F,2), gel(F,3));
1616 7525 : case t_MF_BD: return c_Bd(n, d, gel(F,2), gel(F,3));
1617 21 : case t_MF_TRACE: return c_cusptrace(n, d, F);
1618 1918 : case t_MF_NEWTRACE: return c_newtrace(n, d, F);
1619 5579 : case t_MF_DIHEDRAL: return c_dihedral(n, d, F);
1620 : default: pari_err_TYPE("mfcoefs",F); return NULL;/*LCOV_EXCL_LINE*/
1621 : }
1622 : }
1623 :
1624 : static GEN
1625 392 : matdeflate(long n, long d, GEN x)
1626 1680 : { pari_APPLY_same(c_deflate(n,d,gel(x,i))); }
1627 : static int
1628 6104 : space_is_cusp(long space) { return space != mf_FULL && space != mf_EISEN; }
1629 : /* safe with flraw mf */
1630 : static GEN
1631 2632 : mfcoefs_mf(GEN mf, long n, long d)
1632 : {
1633 2632 : GEN MS, ME, E = MF_get_E(mf), S = MF_get_S(mf), M = MF_get_M(mf);
1634 2632 : long lE = lg(E), lS = lg(S), l = lE+lS-1;
1635 :
1636 2632 : if (l == 1) return cgetg(1, t_MAT);
1637 2520 : if (typ(M) == t_MAT && lg(M) != 1 && (n+1)*d < nbrows(M))
1638 21 : return matdeflate(n, d, M); /*cached; lg = 1 is possible from mfinit */
1639 2499 : ME = (lE == 1)? cgetg(1, t_MAT): mfvectomat(E, n, d);
1640 2499 : if (lS == 1)
1641 455 : MS = cgetg(1, t_MAT);
1642 2044 : else if (mf_get_type(gel(S,1)) == t_MF_DIV) /*k 1/2-integer or k=1 (exotic)*/
1643 371 : MS = matdeflate(n,d, mflineardivtomat(MF_get_N(mf), S, n*d));
1644 1673 : else if (MF_get_k(mf) == 1) /* k = 1 (dihedral) */
1645 : {
1646 308 : GEN M = mfvectomat(gmael(S,1,2), n, d);
1647 : long i;
1648 308 : MS = cgetg(lS, t_MAT);
1649 1589 : for (i = 1; i < lS; i++)
1650 : {
1651 1281 : GEN f = gel(S,i), dc = gel(f,4), c = RgM_RgC_mul(M, gel(f,3));
1652 1281 : if (!equali1(dc)) c = RgC_Rg_div(c,dc);
1653 1281 : gel(MS,i) = c;
1654 : }
1655 : }
1656 : else /* k >= 2 integer */
1657 1365 : MS = bhnmat_extend_nocache(NULL, MF_get_N(mf), n, d, S);
1658 2499 : return shallowconcat(ME,MS);
1659 : }
1660 : GEN
1661 4144 : mfcoefs(GEN F, long n, long d)
1662 : {
1663 4144 : if (!checkmf_i(F))
1664 : {
1665 42 : pari_sp av = avma;
1666 42 : GEN mf = checkMF_i(F); if (!mf) pari_err_TYPE("mfcoefs", F);
1667 42 : return gc_GEN(av, mfcoefs_mf(mf,n,d));
1668 : }
1669 4102 : if (d <= 0) pari_err_DOMAIN("mfcoefs", "d", "<=", gen_0, stoi(d));
1670 4102 : if (n < 0) return cgetg(1, t_VEC);
1671 4102 : return mfcoefs_i(F, n, d);
1672 : }
1673 :
1674 : /* assume k >= 0 */
1675 : static GEN
1676 455 : mfak_i(GEN F, long k)
1677 : {
1678 455 : if (!k) return gel(mfcoefs_i(F,0,1), 1);
1679 294 : return gel(mfcoefs_i(F,1,k), 2);
1680 : }
1681 : GEN
1682 301 : mfcoef(GEN F, long n)
1683 : {
1684 301 : pari_sp av = avma;
1685 301 : if (!checkmf_i(F)) pari_err_TYPE("mfcoef",F);
1686 301 : return n < 0? gen_0: gc_GEN(av, mfak_i(F, n));
1687 : }
1688 :
1689 : static GEN
1690 133 : paramconst() { return tagparams(t_MF_CONST, mkNK(1,0,mfchartrivial())); }
1691 : static GEN
1692 91 : mftrivial(void) { retmkvec2(paramconst(), cgetg(1,t_VEC)); }
1693 : static GEN
1694 42 : mf1(void) { retmkvec2(paramconst(), mkvec(gen_1)); }
1695 :
1696 : /* induce mfchar CHI to G */
1697 : static GEN
1698 312179 : induce(GEN G, GEN CHI)
1699 : {
1700 : GEN o, chi;
1701 312179 : if (typ(CHI) == t_INT) /* Kronecker */
1702 : {
1703 300888 : chi = znchar_quad(G, CHI);
1704 300888 : o = ZV_equal0(chi)? gen_1: gen_2;
1705 300888 : CHI = mkvec4(G,chi,o,cgetg(1,t_VEC));
1706 : }
1707 : else
1708 : {
1709 11291 : if (mfcharmodulus(CHI) == itos(znstar_get_N(G))) return CHI;
1710 10640 : CHI = leafcopy(CHI);
1711 10640 : chi = zncharinduce(gel(CHI,1), gel(CHI,2), G);
1712 10640 : gel(CHI,1) = G;
1713 10640 : gel(CHI,2) = chi;
1714 : }
1715 311528 : return CHI;
1716 : }
1717 : /* induce mfchar CHI to znstar(N) */
1718 : static GEN
1719 42476 : induceN(long N, GEN CHI)
1720 : {
1721 42476 : if (mfcharmodulus(CHI) != N) CHI = induce(znstar0(utoipos(N),1), CHI);
1722 42476 : return CHI;
1723 : }
1724 : /* *pCHI1 and *pCHI2 are mfchar, induce to common modulus */
1725 : static void
1726 11305 : char2(GEN *pCHI1, GEN *pCHI2)
1727 : {
1728 11305 : GEN CHI1 = *pCHI1, G1 = gel(CHI1,1), N1 = znstar_get_N(G1);
1729 11305 : GEN CHI2 = *pCHI2, G2 = gel(CHI2,1), N2 = znstar_get_N(G2);
1730 11305 : if (!equalii(N1,N2))
1731 : {
1732 8855 : GEN G, d = gcdii(N1,N2);
1733 8855 : if (equalii(N2,d)) *pCHI2 = induce(G1, CHI2);
1734 1589 : else if (equalii(N1,d)) *pCHI1 = induce(G2, CHI1);
1735 : else
1736 : {
1737 154 : if (!equali1(d)) N2 = diviiexact(N2,d);
1738 154 : G = znstar0(mulii(N1,N2), 1);
1739 154 : *pCHI1 = induce(G, CHI1);
1740 154 : *pCHI2 = induce(G, CHI2);
1741 : }
1742 : }
1743 11305 : }
1744 : /* mfchar or charinit wrt same modulus; outputs a mfchar */
1745 : static GEN
1746 301994 : mfcharmul_i(GEN CHI1, GEN CHI2)
1747 : {
1748 301994 : GEN G = gel(CHI1,1), chi3 = zncharmul(G, gel(CHI1,2), gel(CHI2,2));
1749 301994 : return mfcharGL(G, chi3);
1750 : }
1751 : /* mfchar or charinit; outputs a mfchar */
1752 : static GEN
1753 1127 : mfcharmul(GEN CHI1, GEN CHI2)
1754 : {
1755 1127 : char2(&CHI1, &CHI2); return mfcharmul_i(CHI1,CHI2);
1756 : }
1757 : /* mfchar or charinit; outputs a mfchar */
1758 : static GEN
1759 161 : mfcharpow(GEN CHI, GEN n)
1760 : {
1761 : GEN G, chi;
1762 161 : G = gel(CHI,1); chi = zncharpow(G, gel(CHI,2), n);
1763 161 : return mfchartoprimitive(mfcharGL(G, chi), NULL);
1764 : }
1765 : /* mfchar or charinit wrt same modulus; outputs a mfchar */
1766 : static GEN
1767 10178 : mfchardiv_i(GEN CHI1, GEN CHI2)
1768 : {
1769 10178 : GEN G = gel(CHI1,1), chi3 = znchardiv(G, gel(CHI1,2), gel(CHI2,2));
1770 10178 : return mfcharGL(G, chi3);
1771 : }
1772 : /* mfchar or charinit; outputs a mfchar */
1773 : static GEN
1774 10178 : mfchardiv(GEN CHI1, GEN CHI2)
1775 : {
1776 10178 : char2(&CHI1, &CHI2); return mfchardiv_i(CHI1,CHI2);
1777 : }
1778 : static GEN
1779 56 : mfcharconj(GEN CHI)
1780 : {
1781 56 : CHI = leafcopy(CHI);
1782 56 : gel(CHI,2) = zncharconj(gel(CHI,1), gel(CHI,2));
1783 56 : return CHI;
1784 : }
1785 :
1786 : /* CHI mfchar, assume 4 | N. Multiply CHI by \chi_{-4} */
1787 : static GEN
1788 1092 : mfchilift(GEN CHI, long N)
1789 : {
1790 1092 : CHI = induceN(N, CHI);
1791 1092 : return mfcharmul_i(CHI, induce(gel(CHI,1), stoi(-4)));
1792 : }
1793 : /* CHI defined mod N, N4 = N/4;
1794 : * if CHI is defined mod N4 return CHI;
1795 : * else if CHI' = CHI*(-4,.) is defined mod N4, return CHI' (primitive)
1796 : * else error */
1797 : static GEN
1798 42 : mfcharchiliftprim(GEN CHI, long N4)
1799 : {
1800 42 : long FC = mfcharconductor(CHI);
1801 : GEN CHIP;
1802 42 : if (N4 % FC == 0) return CHI;
1803 14 : CHIP = mfchartoprimitive(mfchilift(CHI, N4 << 2), &FC);
1804 14 : if (N4 % FC) pari_err_TYPE("mfkohnenbasis [incorrect CHI]", CHI);
1805 14 : return CHIP;
1806 : }
1807 : /* ensure CHI(-1) = (-1)^k [k integer] or 1 [half-integer], by multiplying
1808 : * by (-4/.) if needed */
1809 : static GEN
1810 2933 : mfchiadjust(GEN CHI, GEN gk, long N)
1811 : {
1812 2933 : long par = mfcharparity(CHI);
1813 2933 : if (typ(gk) == t_INT && mpodd(gk)) par = -par;
1814 2933 : return par == 1 ? CHI : mfchilift(CHI, N);
1815 : }
1816 :
1817 : static GEN
1818 4270 : mfsamefield(GEN T, GEN P, GEN Q)
1819 : {
1820 4270 : if (degpol(P) == 1) return Q;
1821 721 : if (degpol(Q) == 1) return P;
1822 630 : if (!gequal(P,Q)) pari_err_TYPE("mfsamefield [different fields]",mkvec2(P,Q));
1823 623 : if (T) err_cyclo();
1824 623 : return P;
1825 : }
1826 :
1827 : GEN
1828 455 : mfmul(GEN f, GEN g)
1829 : {
1830 455 : pari_sp av = avma;
1831 : GEN T, N, K, NK, CHI, CHIf, CHIg;
1832 455 : if (!checkmf_i(f)) pari_err_TYPE("mfmul",f);
1833 455 : if (!checkmf_i(g)) pari_err_TYPE("mfmul",g);
1834 455 : N = lcmii(mf_get_gN(f), mf_get_gN(g));
1835 455 : K = gadd(mf_get_gk(f), mf_get_gk(g));
1836 455 : CHIf = mf_get_CHI(f);
1837 455 : CHIg = mf_get_CHI(g);
1838 455 : CHI = mfchiadjust(mfcharmul(CHIf,CHIg), K, itos(N));
1839 455 : T = chicompat(CHI, CHIf, CHIg);
1840 455 : NK = mkgNK(N, K, CHI, mfsamefield(T, mf_get_field(f), mf_get_field(g)));
1841 448 : return gc_GEN(av, T? tag3(t_MF_MUL,NK,f,g,T): tag2(t_MF_MUL,NK,f,g));
1842 : }
1843 : GEN
1844 77 : mfpow(GEN f, long n)
1845 : {
1846 77 : pari_sp av = avma;
1847 : GEN T, KK, NK, gn, CHI, CHIf;
1848 77 : if (!checkmf_i(f)) pari_err_TYPE("mfpow",f);
1849 77 : if (!n) return mf1();
1850 77 : if (n == 1) return gcopy(f);
1851 77 : KK = gmulsg(n,mf_get_gk(f));
1852 77 : gn = stoi(n);
1853 77 : CHIf = mf_get_CHI(f);
1854 77 : CHI = mfchiadjust(mfcharpow(CHIf,gn), KK, mf_get_N(f));
1855 77 : T = chicompat(CHI, CHIf, CHIf);
1856 70 : NK = mkgNK(mf_get_gN(f), KK, CHI, mf_get_field(f));
1857 70 : return gc_GEN(av, T? tag3(t_MF_POW,NK,f,gn,T): tag2(t_MF_POW,NK,f,gn));
1858 : }
1859 : GEN
1860 28 : mfbracket(GEN f, GEN g, long m)
1861 : {
1862 28 : pari_sp av = avma;
1863 : GEN T, N, K, NK, CHI, CHIf, CHIg;
1864 28 : if (!checkmf_i(f)) pari_err_TYPE("mfbracket",f);
1865 28 : if (!checkmf_i(g)) pari_err_TYPE("mfbracket",g);
1866 28 : if (m < 0) pari_err_TYPE("mfbracket [m<0]",stoi(m));
1867 28 : K = gaddgs(gadd(mf_get_gk(f), mf_get_gk(g)), 2*m);
1868 28 : if (gsigne(K) < 0) pari_err_IMPL("mfbracket for this form");
1869 28 : N = lcmii(mf_get_gN(f), mf_get_gN(g));
1870 28 : CHIf = mf_get_CHI(f);
1871 28 : CHIg = mf_get_CHI(g);
1872 28 : CHI = mfcharmul(CHIf, CHIg);
1873 28 : CHI = mfchiadjust(CHI, K, itou(N));
1874 28 : T = chicompat(CHI, CHIf, CHIg);
1875 28 : NK = mkgNK(N, K, CHI, mfsamefield(T, mf_get_field(f), mf_get_field(g)));
1876 56 : return gc_GEN(av, T? tag4(t_MF_BRACKET, NK, f, g, utoi(m), T)
1877 28 : : tag3(t_MF_BRACKET, NK, f, g, utoi(m)));
1878 : }
1879 :
1880 : /* remove 0 entries in L */
1881 : static int
1882 1960 : mflinear_strip(GEN *pF, GEN *pL)
1883 : {
1884 1960 : pari_sp av = avma;
1885 1960 : GEN F = *pF, L = *pL;
1886 1960 : long i, j, l = lg(L);
1887 1960 : GEN F2 = cgetg(l, t_VEC), L2 = cgetg(l, t_VEC);
1888 11753 : for (i = j = 1; i < l; i++)
1889 : {
1890 9793 : if (gequal0(gel(L,i))) continue;
1891 4823 : gel(F2,j) = gel(F,i);
1892 4823 : gel(L2,j) = gel(L,i); j++;
1893 : }
1894 1960 : if (j == l) set_avma(av);
1895 : else
1896 : {
1897 602 : setlg(F2,j); *pF = F2;
1898 602 : setlg(L2,j); *pL = L2;
1899 : }
1900 1960 : return (j > 1);
1901 : }
1902 : static GEN
1903 7070 : taglinear_i(long t, GEN NK, GEN F, GEN L)
1904 : {
1905 : GEN dL;
1906 7070 : L = Q_remove_denom(L, &dL); if (!dL) dL = gen_1;
1907 7070 : return tag3(t, NK, F, L, dL);
1908 : }
1909 : static GEN
1910 2926 : taglinear(GEN NK, GEN F, GEN L)
1911 : {
1912 2926 : long t = ok_bhn_linear(F)? t_MF_LINEAR_BHN: t_MF_LINEAR;
1913 2926 : return taglinear_i(t, NK, F, L);
1914 : }
1915 : /* assume F has parameters NK = [N,K,CHI] */
1916 : static GEN
1917 490 : mflinear_i(GEN NK, GEN F, GEN L)
1918 : {
1919 490 : if (!mflinear_strip(&F,&L)) return mftrivial();
1920 490 : return taglinear(NK, F,L);
1921 : }
1922 : static GEN
1923 770 : mflinear_bhn(GEN mf, GEN L)
1924 : {
1925 : long i, l;
1926 770 : GEN P, NK, F = MF_get_S(mf);
1927 770 : if (!mflinear_strip(&F,&L)) return mftrivial();
1928 763 : l = lg(L); P = pol_x(1);
1929 3465 : for (i = 1; i < l; i++)
1930 : {
1931 2702 : GEN c = gel(L,i);
1932 2702 : if (typ(c) == t_POLMOD && varn(gel(c,1)) == 1)
1933 665 : P = mfsamefield(NULL, P, gel(c,1));
1934 : }
1935 763 : NK = mkgNK(MF_get_gN(mf), MF_get_gk(mf), MF_get_CHI(mf), P);
1936 763 : return taglinear_i(t_MF_LINEAR_BHN, NK, F,L);
1937 : }
1938 :
1939 : /* F vector of forms with same weight and character but varying level, return
1940 : * global [N,k,chi,P] */
1941 : static GEN
1942 3339 : vecmfNK(GEN F)
1943 : {
1944 3339 : long i, l = lg(F);
1945 : GEN N, f;
1946 3339 : if (l == 1) return mkNK(1, 0, mfchartrivial());
1947 3339 : f = gel(F,1); N = mf_get_gN(f);
1948 47474 : for (i = 2; i < l; i++) N = lcmii(N, mf_get_gN(gel(F,i)));
1949 3339 : return mkgNK(N, mf_get_gk(f), mf_get_CHI(f), mf_get_field(f));
1950 : }
1951 : /* do not use mflinear: mflineardivtomat rely on F being constant across the
1952 : * basis where mflinear strips the ones matched by 0 coeffs. Assume k and CHI
1953 : * constant, N is allowed to vary. */
1954 : static GEN
1955 1218 : vecmflinear(GEN F, GEN C)
1956 : {
1957 1218 : long i, t, l = lg(C);
1958 1218 : GEN NK, v = cgetg(l, t_VEC);
1959 1218 : if (l == 1) return v;
1960 1218 : t = ok_bhn_linear(F)? t_MF_LINEAR_BHN: t_MF_LINEAR;
1961 1218 : NK = vecmfNK(F);
1962 4599 : for (i = 1; i < l; i++) gel(v,i) = taglinear_i(t, NK, F, gel(C,i));
1963 1218 : return v;
1964 : }
1965 : /* vecmflinear(F,C), then divide everything by E, which has valuation 0 */
1966 : static GEN
1967 434 : vecmflineardiv0(GEN F, GEN C, GEN E)
1968 : {
1969 434 : GEN v = vecmflinear(F, C);
1970 434 : long i, l = lg(v);
1971 434 : if (l == 1) return v;
1972 434 : gel(v,1) = mfdiv_val(gel(v,1), E, 0);
1973 1729 : for (i = 2; i < l; i++)
1974 : { /* v[i] /= E */
1975 1295 : GEN f = shallowcopy(gel(v,1));
1976 1295 : gel(f,2) = gel(v,i);
1977 1295 : gel(v,i) = f;
1978 : }
1979 434 : return v;
1980 : }
1981 :
1982 : /* Non empty linear combination of linear combinations of same
1983 : * F_j=\sum_i \mu_{i,j}G_i so R = \sum_i (\sum_j(\la_j\mu_{i,j})) G_i */
1984 : static GEN
1985 2121 : mflinear_linear(GEN F, GEN L, int strip)
1986 : {
1987 2121 : long l = lg(F), j;
1988 2121 : GEN vF, M = cgetg(l, t_MAT);
1989 2121 : L = shallowcopy(L);
1990 20097 : for (j = 1; j < l; j++)
1991 : {
1992 17976 : GEN f = gel(F,j), c = gel(f,3), d = gel(f,4);
1993 17976 : if (typ(c) == t_VEC) c = shallowtrans(c);
1994 17976 : if (!isint1(d)) gel(L,j) = gdiv(gel(L,j),d);
1995 17976 : gel(M,j) = c;
1996 : }
1997 2121 : vF = gmael(F,1,2); L = RgM_RgC_mul(M,L);
1998 2121 : if (strip && !mflinear_strip(&vF,&L)) return mftrivial();
1999 2121 : return taglinear(vecmfNK(vF), vF, L);
2000 : }
2001 : /* F nonempty vector of forms of the form mfdiv(mflinear(B,v), E) where E
2002 : * does not vanish at oo, or mflinear(B,v). Apply mflinear(F, L) */
2003 : static GEN
2004 2121 : mflineardiv_linear(GEN F, GEN L, int strip)
2005 : {
2006 2121 : long l = lg(F), j;
2007 : GEN v, E, f;
2008 2121 : if (lg(L) != l) pari_err_DIM("mflineardiv_linear");
2009 2121 : f = gel(F,1); /* l > 1 */
2010 2121 : if (mf_get_type(f) != t_MF_DIV) return mflinear_linear(F,L,strip);
2011 1813 : E = gel(f,3);
2012 1813 : v = cgetg(l, t_VEC);
2013 18634 : for (j = 1; j < l; j++) { GEN f = gel(F,j); gel(v,j) = gel(f,2); }
2014 1813 : return mfdiv_val(mflinear_linear(v,L,strip), E, 0);
2015 : }
2016 : static GEN
2017 483 : vecmflineardiv_linear(GEN F, GEN M)
2018 : {
2019 483 : long i, l = lg(M);
2020 483 : GEN v = cgetg(l, t_VEC);
2021 2023 : for (i = 1; i < l; i++) gel(v,i) = mflineardiv_linear(F, gel(M,i), 0);
2022 483 : return v;
2023 : }
2024 :
2025 : static GEN
2026 1057 : tobasis(GEN mf, GEN F, GEN L)
2027 : {
2028 1057 : if (checkmf_i(L) && mf) return mftobasis(mf, L, 0);
2029 1050 : if (typ(F) != t_VEC) pari_err_TYPE("mflinear",F);
2030 1050 : if (!is_vec_t(typ(L))) pari_err_TYPE("mflinear",L);
2031 1050 : if (lg(L) != lg(F)) pari_err_DIM("mflinear");
2032 1050 : return L;
2033 : }
2034 : GEN
2035 1106 : mflinear(GEN F, GEN L)
2036 : {
2037 1106 : pari_sp av = avma;
2038 1106 : GEN G, NK, P, mf = checkMF_i(F), N = NULL, K = NULL, CHI = NULL;
2039 : long i, l;
2040 1106 : if (mf)
2041 : {
2042 728 : GEN gk = MF_get_gk(mf);
2043 728 : F = MF_get_basis(F);
2044 728 : if (typ(gk) != t_INT)
2045 49 : return gc_GEN(av, mflineardiv_linear(F, L, 1));
2046 679 : if (itou(gk) > 1 && space_is_cusp(MF_get_space(mf)))
2047 : {
2048 455 : L = tobasis(mf, F, L);
2049 455 : return gc_GEN(av, mflinear_bhn(mf, L));
2050 : }
2051 : }
2052 602 : L = tobasis(mf, F, L);
2053 602 : if (!mflinear_strip(&F,&L)) return mftrivial();
2054 :
2055 588 : l = lg(F);
2056 588 : if (l == 2 && gequal1(gel(L,1))) return gc_GEN(av, gel(F,1));
2057 329 : P = pol_x(1);
2058 1057 : for (i = 1; i < l; i++)
2059 : {
2060 735 : GEN f = gel(F,i), c = gel(L,i), Ni, Ki;
2061 735 : if (!checkmf_i(f)) pari_err_TYPE("mflinear", f);
2062 735 : Ni = mf_get_gN(f); N = N? lcmii(N, Ni): Ni;
2063 735 : Ki = mf_get_gk(f);
2064 735 : if (!K) K = Ki;
2065 406 : else if (!gequal(K, Ki))
2066 7 : pari_err_TYPE("mflinear [different weights]", mkvec2(K,Ki));
2067 728 : P = mfsamefield(NULL, P, mf_get_field(f));
2068 728 : if (typ(c) == t_POLMOD && varn(gel(c,1)) == 1)
2069 126 : P = mfsamefield(NULL, P, gel(c,1));
2070 : }
2071 322 : G = znstar0(N,1);
2072 1036 : for (i = 1; i < l; i++)
2073 : {
2074 721 : GEN CHI2 = mf_get_CHI(gel(F,i));
2075 721 : CHI2 = induce(G, CHI2);
2076 721 : if (!CHI) CHI = CHI2;
2077 399 : else if (!gequal(CHI, CHI2))
2078 7 : pari_err_TYPE("mflinear [different characters]", mkvec2(CHI,CHI2));
2079 : }
2080 315 : NK = mkgNK(N, K, CHI, P);
2081 315 : return gc_GEN(av, taglinear(NK,F,L));
2082 : }
2083 :
2084 : GEN
2085 42 : mfshift(GEN F, long sh)
2086 : {
2087 42 : pari_sp av = avma;
2088 42 : if (!checkmf_i(F)) pari_err_TYPE("mfshift",F);
2089 42 : return gc_GEN(av, tag2(t_MF_SHIFT, mf_get_NK(F), F, stoi(sh)));
2090 : }
2091 : static long
2092 49 : mfval(GEN F)
2093 : {
2094 49 : pari_sp av = avma;
2095 49 : long i = 0, n, sb;
2096 : GEN gk, gN;
2097 49 : if (!checkmf_i(F)) pari_err_TYPE("mfval", F);
2098 49 : gN = mf_get_gN(F);
2099 49 : gk = mf_get_gk(F);
2100 49 : sb = mfsturmNgk(itou(gN), gk);
2101 70 : for (n = 1; n <= sb;)
2102 : {
2103 : GEN v;
2104 63 : if (n > 0.5*sb) n = sb+1;
2105 63 : v = mfcoefs_i(F, n, 1);
2106 119 : for (; i <= n; i++)
2107 98 : if (!gequal0(gel(v, i+1))) return gc_long(av,i);
2108 21 : n <<= 1;
2109 : }
2110 7 : return gc_long(av,-1);
2111 : }
2112 :
2113 : GEN
2114 2275 : mfdiv_val(GEN f, GEN g, long vg)
2115 : {
2116 : GEN T, N, K, NK, CHI, CHIf, CHIg;
2117 2275 : if (vg) { f = mfshift(f,vg); g = mfshift(g,vg); }
2118 2275 : N = lcmii(mf_get_gN(f), mf_get_gN(g));
2119 2275 : K = gsub(mf_get_gk(f), mf_get_gk(g));
2120 2275 : CHIf = mf_get_CHI(f);
2121 2275 : CHIg = mf_get_CHI(g);
2122 2275 : CHI = mfchiadjust(mfchardiv(CHIf, CHIg), K, itos(N));
2123 2275 : T = chicompat(CHI, CHIf, CHIg);
2124 2268 : NK = mkgNK(N, K, CHI, mfsamefield(T, mf_get_field(f), mf_get_field(g)));
2125 2268 : return T? tag3(t_MF_DIV, NK, f, g, T): tag2(t_MF_DIV, NK, f, g);
2126 : }
2127 : GEN
2128 49 : mfdiv(GEN F, GEN G)
2129 : {
2130 49 : pari_sp av = avma;
2131 49 : long v = mfval(G);
2132 49 : if (!checkmf_i(F)) pari_err_TYPE("mfdiv", F);
2133 42 : if (v < 0 || (v && !gequal0(mfcoefs(F, v-1, 1))))
2134 14 : pari_err_DOMAIN("mfdiv", "ord(G)", ">", strtoGENstr("ord(F)"),
2135 : mkvec2(F, G));
2136 28 : return gc_GEN(av, mfdiv_val(F, G, v));
2137 : }
2138 : GEN
2139 182 : mfderiv(GEN F, long m)
2140 : {
2141 182 : pari_sp av = avma;
2142 : GEN NK, gk;
2143 182 : if (!checkmf_i(F)) pari_err_TYPE("mfderiv",F);
2144 182 : gk = gaddgs(mf_get_gk(F), 2*m);
2145 182 : NK = mkgNK(mf_get_gN(F), gk, mf_get_CHI(F), mf_get_field(F));
2146 182 : return gc_GEN(av, tag2(t_MF_DERIV, NK, F, stoi(m)));
2147 : }
2148 : GEN
2149 21 : mfderivE2(GEN F, long m)
2150 : {
2151 21 : pari_sp av = avma;
2152 : GEN NK, gk;
2153 21 : if (!checkmf_i(F)) pari_err_TYPE("mfderivE2",F);
2154 21 : if (m < 0) pari_err_DOMAIN("mfderivE2","m","<",gen_0,stoi(m));
2155 21 : gk = gaddgs(mf_get_gk(F), 2*m);
2156 21 : NK = mkgNK(mf_get_gN(F), gk, mf_get_CHI(F), mf_get_field(F));
2157 21 : return gc_GEN(av, tag2(t_MF_DERIVE2, NK, F, stoi(m)));
2158 : }
2159 :
2160 : GEN
2161 28 : mftwist(GEN F, GEN D)
2162 : {
2163 28 : pari_sp av = avma;
2164 : GEN NK, CHI, NT, Da;
2165 : long q;
2166 28 : if (!checkmf_i(F)) pari_err_TYPE("mftwist", F);
2167 28 : if (typ(D) != t_INT) pari_err_TYPE("mftwist", D);
2168 28 : Da = mpabs_shallow(D);
2169 28 : CHI = mf_get_CHI(F); q = mfcharconductor(CHI);
2170 28 : NT = glcm(glcm(mf_get_gN(F), mulsi(q, Da)), sqri(Da));
2171 28 : NK = mkgNK(NT, mf_get_gk(F), CHI, mf_get_field(F));
2172 28 : return gc_GEN(av, tag2(t_MF_TWIST, NK, F, D));
2173 : }
2174 :
2175 : /***************************************************************/
2176 : /* Generic cache handling */
2177 : /***************************************************************/
2178 : enum { cache_FACT, cache_DIV, cache_H, cache_D, cache_DIH };
2179 : typedef struct {
2180 : const char *name;
2181 : GEN cache;
2182 : ulong minself, maxself;
2183 : void (*init)(long);
2184 : ulong miss, maxmiss;
2185 : long compressed;
2186 : } cache;
2187 :
2188 : static void constfact(long lim);
2189 : static void constdiv(long lim);
2190 : static void consttabh(long lim);
2191 : static void consttabdihedral(long lim);
2192 : static void constcoredisc(long lim);
2193 : static THREAD cache caches[] = {
2194 : { "Factors", NULL, 50000, 50000, &constfact, 0, 0, 0 },
2195 : { "Divisors", NULL, 50000, 50000, &constdiv, 0, 0, 0 },
2196 : { "H", NULL, 100000, 10000000, &consttabh, 0, 0, 1 },
2197 : { "CorediscF",NULL, 100000, 10000000, &constcoredisc, 0, 0, 0 },
2198 : { "Dihedral", NULL, 1000, 3000, &consttabdihedral, 0, 0, 0 },
2199 : };
2200 :
2201 : static void
2202 879 : cache_reset(long id) { caches[id].miss = caches[id].maxmiss = 0; }
2203 : static void
2204 9435 : cache_delete(long id) { guncloneNULL(caches[id].cache); }
2205 : static void
2206 885 : cache_set(long id, GEN S)
2207 : {
2208 885 : GEN old = caches[id].cache;
2209 885 : caches[id].cache = gclone(S);
2210 885 : guncloneNULL(old);
2211 885 : }
2212 :
2213 : /* handle a cache miss: store stats, possibly reset table; return value
2214 : * if (now) cached; return NULL on failure. HACK: some caches contain an
2215 : * ulong where the 0 value is impossible, and return it (typecast to GEN) */
2216 : static GEN
2217 456742564 : cache_get(long id, ulong D)
2218 : {
2219 456742564 : cache *S = &caches[id];
2220 456742564 : const ulong d = S->compressed? D>>1: D;
2221 : ulong max, l;
2222 :
2223 456742564 : if (!S->cache)
2224 : {
2225 635 : max = maxuu(minuu(D, S->maxself), S->minself);
2226 635 : S->init(max);
2227 627 : l = lg(S->cache);
2228 : }
2229 : else
2230 : {
2231 456741929 : l = lg(S->cache);
2232 456741929 : if (l <= d)
2233 : {
2234 504 : if (D > S->maxmiss) S->maxmiss = D;
2235 504 : if (DEBUGLEVEL >= 3)
2236 0 : err_printf("miss in cache %s: %lu, max = %lu\n",
2237 : S->name, D, S->maxmiss);
2238 504 : if (S->miss++ >= 5 && D < S->maxself)
2239 : {
2240 31 : max = minuu(S->maxself, (long)(S->maxmiss * 1.2));
2241 31 : if (max <= S->maxself)
2242 : {
2243 31 : if (DEBUGLEVEL >= 3)
2244 0 : err_printf("resetting cache %s to %lu\n", S->name, max);
2245 31 : S->init(max); l = lg(S->cache);
2246 : }
2247 : }
2248 : }
2249 : }
2250 456742556 : return (l <= d)? NULL: gel(S->cache, d);
2251 : }
2252 : static GEN
2253 70 : cache_report(long id)
2254 : {
2255 70 : cache *S = &caches[id];
2256 70 : GEN v = zerocol(5);
2257 70 : gel(v,1) = strtoGENstr(S->name);
2258 70 : if (S->cache)
2259 : {
2260 35 : gel(v,2) = utoi(lg(S->cache)-1);
2261 35 : gel(v,3) = utoi(S->miss);
2262 35 : gel(v,4) = utoi(S->maxmiss);
2263 35 : gel(v,5) = utoi(gsizebyte(S->cache));
2264 : }
2265 70 : return v;
2266 : }
2267 : GEN
2268 14 : getcache(void)
2269 : {
2270 14 : pari_sp av = avma;
2271 14 : GEN M = cgetg(6, t_MAT);
2272 14 : gel(M,1) = cache_report(cache_FACT);
2273 14 : gel(M,2) = cache_report(cache_DIV);
2274 14 : gel(M,3) = cache_report(cache_H);
2275 14 : gel(M,4) = cache_report(cache_D);
2276 14 : gel(M,5) = cache_report(cache_DIH);
2277 14 : return gc_GEN(av, shallowtrans(M));
2278 : }
2279 :
2280 : void
2281 1887 : pari_close_mf(void)
2282 : {
2283 1887 : cache_delete(cache_FACT);
2284 1887 : cache_delete(cache_DIV);
2285 1887 : cache_delete(cache_H);
2286 1887 : cache_delete(cache_D);
2287 1887 : cache_delete(cache_DIH);
2288 1887 : }
2289 :
2290 : /*************************************************************************/
2291 : /* a odd, update local cache (recycle memory) */
2292 : static GEN
2293 5461 : update_factor_cache(long a, long lim, long *pb)
2294 : {
2295 5461 : const long step = 16000; /* even; don't increase this: RAM cache thrashing */
2296 5461 : if (a + 2*step > lim)
2297 354 : *pb = lim; /* fuse last 2 chunks */
2298 : else
2299 5107 : *pb = a + step;
2300 5461 : return vecfactoroddu_i(a, *pb);
2301 : }
2302 : /* assume lim < MAX_LONG/8 */
2303 : static void
2304 82 : constcoredisc(long lim)
2305 : {
2306 82 : pari_sp av2, av = avma;
2307 82 : GEN D = caches[cache_D].cache, CACHE = NULL;
2308 82 : long cachea, cacheb, N, LIM = !D ? 4 : lg(D)-1;
2309 82 : if (lim <= 0) lim = 5;
2310 82 : if (lim <= LIM) return;
2311 82 : cache_reset(cache_D);
2312 82 : D = zero_zv(lim);
2313 82 : av2 = avma;
2314 82 : cachea = cacheb = 0;
2315 12427868 : for (N = 1; N <= lim; N+=2)
2316 : { /* N odd */
2317 : long i, d, d2;
2318 : GEN F;
2319 12427786 : if (N > cacheb)
2320 : {
2321 1521 : set_avma(av2); cachea = N;
2322 1521 : CACHE = update_factor_cache(N, lim, &cacheb);
2323 : }
2324 12427786 : F = gel(CACHE, ((N-cachea)>>1)+1); /* factoru(N) */
2325 12427786 : D[N] = d = corediscs_fact(F); /* = 3 mod 4 or 4 mod 16 */
2326 12427786 : d2 = odd(d)? d<<3: d<<1;
2327 12427786 : for (i = 1;;)
2328 : {
2329 16570354 : if ((N << i) > lim) break;
2330 8285196 : D[N<<i] = d2; i++;
2331 8285196 : if ((N << i) > lim) break;
2332 4142568 : D[N<<i] = d; i++;
2333 : }
2334 : }
2335 82 : cache_set(cache_D, D);
2336 82 : set_avma(av);
2337 : }
2338 :
2339 : static void
2340 294 : constfact(long lim)
2341 : {
2342 : pari_sp av;
2343 294 : GEN VFACT = caches[cache_FACT].cache;
2344 294 : long LIM = VFACT? lg(VFACT)-1: 4;
2345 294 : if (lim <= 0) lim = 5;
2346 294 : if (lim <= LIM) return;
2347 266 : cache_reset(cache_FACT); av = avma;
2348 266 : cache_set(cache_FACT, vecfactoru_i(1,lim)); set_avma(av);
2349 : }
2350 : static void
2351 259 : constdiv(long lim)
2352 : {
2353 : pari_sp av;
2354 259 : GEN VFACT, VDIV = caches[cache_DIV].cache;
2355 259 : long N, LIM = VDIV? lg(VDIV)-1: 4;
2356 259 : if (lim <= 0) lim = 5;
2357 259 : if (lim <= LIM) return;
2358 259 : constfact(lim);
2359 255 : VFACT = caches[cache_FACT].cache;
2360 255 : cache_reset(cache_DIV); av = avma;
2361 255 : VDIV = cgetg(lim+1, t_VEC);
2362 12750255 : for (N = 1; N <= lim; N++) gel(VDIV,N) = divisorsu_fact(gel(VFACT,N));
2363 255 : cache_set(cache_DIV, VDIV); set_avma(av);
2364 : }
2365 :
2366 : /* n > 1, D = divisors(n); sets L = 2*lambda(n), S = sigma(n) */
2367 : static void
2368 38429238 : lamsig(GEN D, long *pL, long *pS)
2369 : {
2370 38429238 : pari_sp av = avma;
2371 38429238 : long i, l = lg(D), L = 1, S = D[l-1]+1;
2372 138200094 : for (i = 2; i < l; i++) /* skip d = 1 */
2373 : {
2374 138200094 : long d = D[i], nd = D[l-i]; /* nd = n/d */
2375 138200094 : if (d < nd) { L += d; S += d + nd; }
2376 : else
2377 : {
2378 38429238 : L <<= 1; if (d == nd) { L += d; S += d; }
2379 38429238 : break;
2380 : }
2381 : }
2382 38429238 : set_avma(av); *pL = L; *pS = S;
2383 38429238 : }
2384 : /* table of 6 * Hurwitz class numbers D <= lim */
2385 : static void
2386 276 : consttabh(long lim)
2387 : {
2388 276 : pari_sp av = avma, av2;
2389 276 : GEN VHDH0, VDIV, CACHE = NULL;
2390 276 : GEN VHDH = caches[cache_H].cache;
2391 276 : long r, N, cachea, cacheb, lim0 = VHDH? lg(VHDH)-1: 2, LIM = lim0 << 1;
2392 :
2393 276 : if (lim <= 0) lim = 5;
2394 276 : if (lim <= LIM) return;
2395 276 : cache_reset(cache_H);
2396 276 : r = lim&3L; if (r) lim += 4-r;
2397 276 : cache_get(cache_DIV, lim);
2398 272 : VDIV = caches[cache_DIV].cache;
2399 272 : VHDH0 = cgetg(lim/2 + 1, t_VECSMALL);
2400 272 : VHDH0[1] = 2;
2401 272 : VHDH0[2] = 3;
2402 3057404 : for (N = 3; N <= lim0; N++) VHDH0[N] = VHDH[N];
2403 272 : av2 = avma;
2404 272 : cachea = cacheb = 0;
2405 19214891 : for (N = LIM + 3; N <= lim; N += 4)
2406 : {
2407 19214619 : long s = 0, limt = usqrt(N>>2), flsq = 0, ind, t, L, S;
2408 : GEN DN, DN2;
2409 19214619 : if (N + 2 >= lg(VDIV))
2410 : { /* use local cache */
2411 : GEN F;
2412 16115115 : if (N + 2 > cacheb)
2413 : {
2414 3940 : set_avma(av2); cachea = N;
2415 3940 : CACHE = update_factor_cache(N, lim+2, &cacheb);
2416 : }
2417 16115115 : F = gel(CACHE, ((N-cachea)>>1)+1); /* factoru(N) */
2418 16115115 : DN = divisorsu_fact(F);
2419 16115115 : F = gel(CACHE, ((N-cachea)>>1)+2); /* factoru(N+2) */
2420 16115115 : DN2 = divisorsu_fact(F);
2421 : }
2422 : else
2423 : { /* use global cache */
2424 3099504 : DN = gel(VDIV,N);
2425 3099504 : DN2 = gel(VDIV,N+2);
2426 : }
2427 19214619 : ind = N >> 1;
2428 4083539486 : for (t = 1; t <= limt; t++)
2429 : {
2430 4064324867 : ind -= (t<<2)-2; /* N/2 - 2t^2 */
2431 4064324867 : if (ind) s += VHDH0[ind]; else flsq = 1;
2432 : }
2433 19214619 : lamsig(DN, &L,&S);
2434 19214619 : VHDH0[N >> 1] = 2*S - 3*L - 2*s + flsq;
2435 19214619 : s = 0; flsq = 0; limt = (usqrt(N+2) - 1) >> 1;
2436 19214619 : ind = (N+1) >> 1;
2437 4074016196 : for (t = 1; t <= limt; t++)
2438 : {
2439 4054801577 : ind -= t<<2; /* (N+1)/2 - 2t(t+1) */
2440 4054801577 : if (ind) s += VHDH0[ind]; else flsq = 1;
2441 : }
2442 19214619 : lamsig(DN2, &L,&S);
2443 19214619 : VHDH0[(N+1) >> 1] = S - 3*(L >> 1) - s - flsq;
2444 : }
2445 272 : cache_set(cache_H, VHDH0); set_avma(av);
2446 : }
2447 :
2448 : /*************************************************************************/
2449 : /* Core functions using factorizations, divisors of class numbers caches */
2450 : /* TODO: myfactoru and factorization cache should be exported */
2451 : static GEN
2452 34098967 : myfactoru(long N)
2453 : {
2454 34098967 : GEN z = cache_get(cache_FACT, N);
2455 34098967 : return z? gcopy(z): factoru(N);
2456 : }
2457 : static GEN
2458 71683095 : mydivisorsu(long N)
2459 : {
2460 71683095 : GEN z = cache_get(cache_DIV, N);
2461 71683095 : return z? leafcopy(z): divisorsu(N);
2462 : }
2463 : /* write -n = Df^2, D < 0 fundamental discriminant. Return D, set f. */
2464 : static long
2465 179330411 : mycoredisc2neg(ulong n, long *pf)
2466 : {
2467 179330411 : ulong m, D = (ulong)cache_get(cache_D, n);
2468 179330411 : if (D) { *pf = usqrt(n/D); return -(long)D; }
2469 57 : m = mycore(n, pf);
2470 57 : if ((m&3) != 3) { m <<= 2; *pf >>= 1; }
2471 57 : return (long)-m;
2472 : }
2473 : /* write n = Df^2, D > 0 fundamental discriminant. Return D, set f. */
2474 : static long
2475 14 : mycoredisc2pos(ulong n, long *pf)
2476 : {
2477 14 : ulong m = mycore(n, pf);
2478 14 : if ((m&3) != 1) { m <<= 2; *pf >>= 1; }
2479 14 : return (long)m;
2480 : }
2481 :
2482 : /* D < 0 fundamental. Return 6*hclassno(-D); faster than quadclassunit up
2483 : * to 5*10^5 or so */
2484 : static ulong
2485 123 : hclassno6_count(long D)
2486 : {
2487 123 : ulong a, b, b2, h = 0, d = -D;
2488 123 : int f = 0;
2489 :
2490 123 : if (d > 500000) return 6 * quadclassnos(D);
2491 : /* this part would work with -d non fundamental */
2492 116 : b = d&1; b2 = (1+d)>>2;
2493 116 : if (!b)
2494 : {
2495 8956 : for (a=1; a*a<b2; a++)
2496 8927 : if (b2%a == 0) h++;
2497 29 : f = (a*a==b2); b=2; b2=(4+d)>>2;
2498 : }
2499 21585 : while (b2*3 < d)
2500 : {
2501 21469 : if (b2%b == 0) h++;
2502 3344544 : for (a=b+1; a*a < b2; a++)
2503 3323075 : if (b2%a == 0) h += 2;
2504 21469 : if (a*a == b2) h++;
2505 21469 : b += 2; b2 = (b*b+d)>>2;
2506 : }
2507 116 : if (b2*3 == d) return 6*h+2;
2508 116 : if (f) return 6*h+3;
2509 116 : return 6*h;
2510 : }
2511 : /* D0 < 0; 6 * hclassno(-D), using D = D0*F^2 */
2512 : static long
2513 201 : hclassno6u_2(long D0, long F)
2514 : {
2515 : long h;
2516 201 : if (F == 1) h = hclassno6_count(D0);
2517 : else
2518 : { /* second chance */
2519 79 : h = (ulong)cache_get(cache_H, -D0);
2520 79 : if (!h) h = hclassno6_count(D0);
2521 79 : h *= uhclassnoF_fact(myfactoru(F), D0);
2522 : }
2523 201 : return h;
2524 : }
2525 : /* D > 0; 6 * hclassno(D) (6*Hurwitz). Beware, cached value for D (=0,3 mod 4)
2526 : * is stored at D>>1 */
2527 : ulong
2528 2522834 : hclassno6u(ulong D)
2529 : {
2530 2522834 : ulong z = (ulong)cache_get(cache_H, D);
2531 : long D0, F;
2532 2522830 : if (z) return z;
2533 201 : D0 = mycoredisc2neg(D, &F);
2534 201 : return hclassno6u_2(D0,F);
2535 : }
2536 : /* same as hclassno6u without creating caches */
2537 : ulong
2538 160911 : hclassno6u_no_cache(ulong D)
2539 : {
2540 160911 : cache *S = &caches[cache_H];
2541 : long D0, F;
2542 160911 : if (S->cache)
2543 : {
2544 136617 : const ulong d = D>>1; /* compressed */
2545 136617 : if ((ulong)lg(S->cache) > d) return S->cache[d];
2546 : }
2547 160611 : S = &caches[cache_D];
2548 160611 : if (!S->cache || (ulong)lg(S->cache) <= D) return 0;
2549 0 : D0 = mycoredisc2neg(D, &F);
2550 0 : return hclassno6u_2(D0,F);
2551 : }
2552 : /* same, where the decomposition D = D0*F^2 is already known */
2553 : static ulong
2554 158346131 : hclassno6u_i(ulong D, long D0, long F)
2555 : {
2556 158346131 : ulong z = (ulong)cache_get(cache_H, D);
2557 158346131 : if (z) return z;
2558 0 : return hclassno6u_2(D0,F);
2559 : }
2560 :
2561 : /* D < -4 fundamental, 6 * h(D), ordinary class number */
2562 : static long
2563 10748416 : hclassno6u_fund(long D)
2564 : {
2565 10748416 : ulong z = (ulong)cache_get(cache_H, -D);
2566 10748416 : return z? z: 6 * quadclassnos(D);
2567 : }
2568 :
2569 : /*************************************************************************/
2570 : /* TRACE FORMULAS */
2571 : /* CHIP primitive, initialize for t_POLMOD output */
2572 : static GEN
2573 33551 : mfcharinit(GEN CHIP)
2574 : {
2575 33551 : long n, o, l, vt, N = mfcharmodulus(CHIP);
2576 : GEN c, v, V, G, Pn;
2577 33551 : if (N == 1) return mkvec2(mkvec(gen_1), pol_x(0));
2578 5831 : G = gel(CHIP,1);
2579 5831 : v = ncharvecexpo(G, znconrey_normalized(G, gel(CHIP,2)));
2580 5831 : l = lg(v); V = cgetg(l, t_VEC);
2581 5831 : o = mfcharorder(CHIP);
2582 5831 : Pn = mfcharpol(CHIP); vt = varn(Pn);
2583 5831 : if (o <= 2)
2584 : {
2585 60620 : for (n = 1; n < l; n++)
2586 : {
2587 55867 : if (v[n] < 0) c = gen_0; else c = v[n]? gen_m1: gen_1;
2588 55867 : gel(V,n) = c;
2589 : }
2590 : }
2591 : else
2592 : {
2593 17591 : for (n = 1; n < l; n++)
2594 : {
2595 16513 : if (v[n] < 0) c = gen_0;
2596 : else
2597 : {
2598 9394 : c = Qab_zeta(v[n], o, vt);
2599 9394 : if (typ(c) == t_POL && lg(c) >= lg(Pn)) c = RgX_rem(c, Pn);
2600 : }
2601 16513 : gel(V,n) = c;
2602 : }
2603 : }
2604 5831 : return mkvec2(V, Pn);
2605 : }
2606 : static GEN
2607 428379 : vchip_lift(GEN VCHI, long x, GEN C)
2608 : {
2609 428379 : GEN V = gel(VCHI,1);
2610 428379 : long F = lg(V)-1;
2611 428379 : if (F == 1) return C;
2612 33005 : x %= F;
2613 33005 : if (!x) return C;
2614 33005 : if (x <= 0) x += F;
2615 33005 : return gmul(C, gel(V, x));
2616 : }
2617 : static long
2618 282559972 : vchip_FC(GEN VCHI) { return lg(gel(VCHI,1))-1; }
2619 : static GEN
2620 6586245 : vchip_mod(GEN VCHI, GEN S)
2621 6586245 : { return (typ(S) == t_POL)? RgX_rem(S, gel(VCHI,2)): S; }
2622 : static GEN
2623 1992428 : vchip_polmod(GEN VCHI, GEN S)
2624 1992428 : { return (typ(S) == t_POL)? mkpolmod(S, gel(VCHI,2)): S; }
2625 :
2626 : /* contribution of scalar matrices in dimension formula */
2627 : static GEN
2628 366373 : A1(long N, long k) { return uutoQ(mypsiu(N)*(k-1), 12); }
2629 : static long
2630 7756 : ceilA1(long N, long k) { return ceildivuu(mypsiu(N) * (k-1), 12); }
2631 :
2632 : /* sturm bound, slightly larger than dimension */
2633 : long
2634 22036 : mfsturmNk(long N, long k) { return (mypsiu(N) * k) / 12; }
2635 : long
2636 3346 : mfsturmNgk(long N, GEN k)
2637 : {
2638 3346 : long n,d; Qtoss(k,&n,&d);
2639 3346 : return 1 + (mypsiu(N)*n)/(d == 1? 12: 24);
2640 : }
2641 : static long
2642 427 : mfsturmmf(GEN F) { return mfsturmNgk(mf_get_N(F), mf_get_gk(F)); }
2643 :
2644 : /* List of all solutions of x^2 + x + 1 = 0 modulo N, x modulo N */
2645 : static GEN
2646 581 : sqrtm3modN(long N)
2647 : {
2648 : pari_sp av;
2649 : GEN fa, P, E, B, mB, A, Q, T, R, v, gen_m3;
2650 581 : long l, i, n, ct, fl3 = 0, Ninit;
2651 581 : if (!odd(N) || (N%9) == 0) return cgetg(1,t_VECSMALL);
2652 553 : Ninit = N;
2653 553 : if ((N%3) == 0) { N /= 3; fl3 = 1; }
2654 553 : fa = myfactoru(N); P = gel(fa, 1); E = gel(fa, 2);
2655 553 : l = lg(P);
2656 749 : for (i = 1; i < l; i++)
2657 560 : if ((P[i]%3) == 2) return cgetg(1,t_VECSMALL);
2658 189 : A = cgetg(l, t_VECSMALL);
2659 189 : B = cgetg(l, t_VECSMALL);
2660 189 : mB= cgetg(l, t_VECSMALL);
2661 189 : Q = cgetg(l, t_VECSMALL); gen_m3 = utoineg(3);
2662 385 : for (i = 1; i < l; i++)
2663 : {
2664 196 : long p = P[i], e = E[i];
2665 196 : Q[i] = upowuu(p,e);
2666 196 : B[i] = itou( Zp_sqrt(gen_m3, utoipos(p), e) );
2667 196 : mB[i]= Q[i] - B[i];
2668 : }
2669 189 : ct = 1 << (l-1);
2670 189 : T = ZV_producttree(Q);
2671 189 : R = ZV_chinesetree(Q,T);
2672 189 : v = cgetg(ct+1, t_VECSMALL);
2673 189 : av = avma;
2674 581 : for (n = 1; n <= ct; n++)
2675 : {
2676 392 : long m = n-1, r;
2677 812 : for (i = 1; i < l; i++)
2678 : {
2679 420 : A[i] = (m&1L)? mB[i]: B[i];
2680 420 : m >>= 1;
2681 : }
2682 392 : r = itou( ZV_chinese_tree(A, Q, T, R) );
2683 462 : if (fl3) while (r%3) r += N;
2684 392 : set_avma(av); v[n] = odd(r) ? (r-1) >> 1 : (r+Ninit-1) >> 1;
2685 : }
2686 189 : return v;
2687 : }
2688 :
2689 : /* number of elliptic points of order 3 in X0(N) */
2690 : static long
2691 10220 : nu3(long N)
2692 : {
2693 : long i, l;
2694 : GEN P;
2695 10220 : if (!odd(N) || (N%9) == 0) return 0;
2696 8995 : if ((N%3) == 0) N /= 3;
2697 8995 : P = gel(myfactoru(N), 1); l = lg(P);
2698 13195 : for (i = 1; i < l; i++) if ((P[i]%3) == 2) return 0;
2699 4018 : return 1L<<(l-1);
2700 : }
2701 : /* number of elliptic points of order 2 in X0(N) */
2702 : static long
2703 17647 : nu2(long N)
2704 : {
2705 : long i, l;
2706 : GEN P;
2707 17647 : if ((N&3L) == 0) return 0;
2708 17647 : if (!odd(N)) N >>= 1;
2709 17647 : P = gel(myfactoru(N), 1); l = lg(P);
2710 22078 : for (i = 1; i < l; i++) if ((P[i]&3L) == 3) return 0;
2711 3969 : return 1L<<(l-1);
2712 : }
2713 :
2714 : /* contribution of elliptic matrices of order 3 in dimension formula
2715 : * Only depends on CHIP the primitive char attached to CHI */
2716 : static GEN
2717 44135 : A21(long N, long k, GEN CHI)
2718 : {
2719 : GEN res, G, chi, o;
2720 : long a21, i, limx, S;
2721 44135 : if ((N&1L) == 0) return gen_0;
2722 21371 : a21 = k%3 - 1;
2723 21371 : if (!a21) return gen_0;
2724 20531 : if (N <= 3) return sstoQ(a21, 3);
2725 10801 : if (!CHI) return sstoQ(nu3(N) * a21, 3);
2726 581 : res = sqrtm3modN(N); limx = (N - 1) >> 1;
2727 581 : G = gel(CHI,1); chi = gel(CHI,2);
2728 581 : o = gmfcharorder(CHI);
2729 973 : for (S = 0, i = 1; i < lg(res); i++)
2730 : { /* (x,N) = 1; S += chi(x) + chi(x^2) */
2731 392 : long x = res[i];
2732 392 : if (x <= limx)
2733 : { /* CHI(x)=e(c/o), 3rd-root of 1 */
2734 196 : GEN c = znchareval(G, chi, utoi(x), o);
2735 196 : if (!signe(c)) S += 2; else S--;
2736 : }
2737 : }
2738 581 : return sstoQ(a21 * S, 3);
2739 : }
2740 :
2741 : /* List of all square roots of -1 modulo N */
2742 : static GEN
2743 595 : sqrtm1modN(long N)
2744 : {
2745 : pari_sp av;
2746 : GEN fa, P, E, B, mB, A, Q, T, R, v;
2747 595 : long l, i, n, ct, fleven = 0;
2748 595 : if ((N&3L) == 0) return cgetg(1,t_VECSMALL);
2749 595 : if ((N&1L) == 0) { N >>= 1; fleven = 1; }
2750 595 : fa = myfactoru(N); P = gel(fa,1); E = gel(fa,2);
2751 595 : l = lg(P);
2752 945 : for (i = 1; i < l; i++)
2753 665 : if ((P[i]&3L) == 3) return cgetg(1,t_VECSMALL);
2754 280 : A = cgetg(l, t_VECSMALL);
2755 280 : B = cgetg(l, t_VECSMALL);
2756 280 : mB= cgetg(l, t_VECSMALL);
2757 280 : Q = cgetg(l, t_VECSMALL);
2758 574 : for (i = 1; i < l; i++)
2759 : {
2760 294 : long p = P[i], e = E[i];
2761 294 : Q[i] = upowuu(p,e);
2762 294 : B[i] = itou( Zp_sqrt(gen_m1, utoipos(p), e) );
2763 294 : mB[i]= Q[i] - B[i];
2764 : }
2765 280 : ct = 1 << (l-1);
2766 280 : T = ZV_producttree(Q);
2767 280 : R = ZV_chinesetree(Q,T);
2768 280 : v = cgetg(ct+1, t_VECSMALL);
2769 280 : av = avma;
2770 868 : for (n = 1; n <= ct; n++)
2771 : {
2772 588 : long m = n-1, r;
2773 1232 : for (i = 1; i < l; i++)
2774 : {
2775 644 : A[i] = (m&1L)? mB[i]: B[i];
2776 644 : m >>= 1;
2777 : }
2778 588 : r = itou( ZV_chinese_tree(A, Q, T, R) );
2779 588 : if (fleven && !odd(r)) r += N;
2780 588 : set_avma(av); v[n] = r;
2781 : }
2782 280 : return v;
2783 : }
2784 :
2785 : /* contribution of elliptic matrices of order 4 in dimension formula.
2786 : * Only depends on CHIP the primitive char attached to CHI */
2787 : static GEN
2788 44135 : A22(long N, long k, GEN CHI)
2789 : {
2790 : GEN G, chi, o, res;
2791 : long S, a22, i, limx, o2;
2792 44135 : if ((N&3L) == 0) return gen_0;
2793 30380 : a22 = (k & 3L) - 1; /* (k % 4) - 1 */
2794 30380 : if (!a22) return gen_0;
2795 30310 : if (N <= 2) return sstoQ(a22, 4);
2796 18452 : if (!CHI) return sstoQ(nu2(N)*a22, 4);
2797 805 : if (mfcharparity(CHI) == -1) return gen_0;
2798 595 : res = sqrtm1modN(N); limx = (N - 1) >> 1;
2799 595 : G = gel(CHI,1); chi = gel(CHI,2);
2800 595 : o = gmfcharorder(CHI);
2801 595 : o2 = itou(o)>>1;
2802 1183 : for (S = 0, i = 1; i < lg(res); i++)
2803 : { /* (x,N) = 1, S += real(chi(x)) */
2804 588 : long x = res[i];
2805 588 : if (x <= limx)
2806 : { /* CHI(x)=e(c/o), 4th-root of 1 */
2807 294 : long c = itou( znchareval(G, chi, utoi(x), o) );
2808 294 : if (!c) S++; else if (c == o2) S--;
2809 : }
2810 : }
2811 595 : return sstoQ(a22 * S, 2);
2812 : }
2813 :
2814 : /* sumdiv(N,d,eulerphi(gcd(d,N/d))) */
2815 : static long
2816 39116 : nuinf(long N)
2817 : {
2818 39116 : GEN fa = myfactoru(N), P = gel(fa,1), E = gel(fa,2);
2819 39116 : long i, t = 1, l = lg(P);
2820 82999 : for (i=1; i<l; i++)
2821 : {
2822 43883 : long p = P[i], e = E[i];
2823 43883 : if (odd(e))
2824 35091 : t *= upowuu(p,e>>1) << 1;
2825 : else
2826 8792 : t *= upowuu(p,(e>>1)-1) * (p+1);
2827 : }
2828 39116 : return t;
2829 : }
2830 :
2831 : /* contribution of hyperbolic matrices in dimension formula */
2832 : static GEN
2833 44583 : A3(long N, long FC)
2834 : {
2835 : long i, S, NF, l;
2836 : GEN D;
2837 44583 : if (FC == 1) return uutoQ(nuinf(N),2);
2838 5467 : D = mydivisorsu(N); l = lg(D);
2839 5467 : S = 0; NF = N/FC;
2840 42840 : for (i = 1; i < l; i++)
2841 : {
2842 37373 : long g = ugcd(D[i], D[l-i]);
2843 37373 : if (NF%g == 0) S += myeulerphiu(g);
2844 : }
2845 5467 : return uutoQ(S, 2);
2846 : }
2847 :
2848 : /* special contribution in weight 2 in dimension formula */
2849 : static long
2850 43666 : A4(long k, long FC)
2851 43666 : { return (k==2 && FC==1)? 1: 0; }
2852 : /* gcd(x,N) */
2853 : static long
2854 288402905 : myugcd(GEN GCD, ulong x)
2855 : {
2856 288402905 : ulong N = lg(GCD)-1;
2857 288402905 : if (x >= N) x %= N;
2858 288402905 : return GCD[x+1];
2859 : }
2860 : /* 1_{gcd(x,N) = 1} * chi(x), return NULL if 0 */
2861 : static GEN
2862 411157547 : mychicgcd(GEN GCD, GEN VCHI, long x)
2863 : {
2864 411157547 : long N = lg(GCD)-1;
2865 411157547 : if (N == 1) return gen_1;
2866 336008349 : x = umodsu(x, N);
2867 336008349 : if (GCD[x+1] != 1) return NULL;
2868 274839143 : x %= vchip_FC(VCHI); if (!x) return gen_1;
2869 6668046 : return gel(gel(VCHI,1), x);
2870 : }
2871 :
2872 : /* contribution of scalar matrices to trace formula */
2873 : static GEN
2874 6564045 : TA1(long N, long k, GEN VCHI, GEN GCD, long n)
2875 : {
2876 : GEN S;
2877 : ulong m;
2878 6564045 : if (!uissquareall(n, &m)) return gen_0;
2879 398979 : if (m == 1) return A1(N,k); /* common */
2880 358113 : S = mychicgcd(GCD, VCHI, m);
2881 358113 : return S? gmul(gmul(powuu(m, k-2), A1(N,k)), S): gen_0;
2882 : }
2883 :
2884 : /* All square roots modulo 4N, x modulo 2N, precomputed to accelerate TA2 */
2885 : static GEN
2886 129171 : mksqr(long N)
2887 : {
2888 129171 : pari_sp av = avma;
2889 129171 : long x, N2 = N << 1, N4 = N << 2;
2890 129171 : GEN v = const_vec(N2, cgetg(1, t_VECSMALL));
2891 129171 : gel(v, N2) = mkvecsmall(0); /* x = 0 */
2892 3523569 : for (x = 1; x <= N; x++)
2893 : {
2894 3394398 : long r = (((x*x - 1)%N4) >> 1) + 1;
2895 3394398 : gel(v,r) = vecsmall_append(gel(v,r), x);
2896 : }
2897 129171 : return gc_GEN(av, v);
2898 : }
2899 :
2900 : static GEN
2901 129171 : mkgcd(long N)
2902 : {
2903 : GEN GCD, d;
2904 : long i, N2;
2905 129171 : if (N == 1) return mkvecsmall(N);
2906 106246 : GCD = cgetg(N + 1, t_VECSMALL);
2907 106246 : d = GCD+1; /* GCD[i+1] = d[i] = gcd(i,N) = gcd(N-i,N), i = 0..N-1 */
2908 106246 : d[0] = N; d[1] = d[N-1] = 1; N2 = N>>1;
2909 1664670 : for (i = 2; i <= N2; i++) d[i] = d[N-i] = ugcd(N, i);
2910 106246 : return GCD;
2911 : }
2912 :
2913 : /* Table of \sum_{x^2-tx+n=0 mod Ng}chi(x) for all g dividing gcd(N,F),
2914 : * F^2 largest such that (t^2-4n)/F^2=0 or 1 mod 4; t >= 0 */
2915 : static GEN
2916 16069092 : mutglistall(long t, long N, long NF, GEN VCHI, long n, GEN MUP, GEN L, GEN GCD)
2917 : {
2918 16069092 : long i, lx = lg(L);
2919 16069092 : GEN DNF = mydivisorsu(NF), v = zerovec(NF);
2920 16069092 : long j, g, lDNF = lg(DNF);
2921 44948705 : for (i = 1; i < lx; i++)
2922 : {
2923 28879613 : long x = (L[i] + t) >> 1, y, lD;
2924 28879613 : GEN D, c = mychicgcd(GCD, VCHI, x);
2925 28879613 : if (L[i] && L[i] != N)
2926 : {
2927 19329393 : GEN c2 = mychicgcd(GCD, VCHI, t - x);
2928 19329393 : if (c2) c = c? gadd(c, c2): c2;
2929 : }
2930 28879613 : if (!c) continue;
2931 22310113 : y = (x*(x - t) + n) / N; /* exact division */
2932 22310113 : D = mydivisorsu(ugcd(labs(y), NF)); lD = lg(D);
2933 60130499 : for (j=1; j < lD; j++) { g = D[j]; gel(v,g) = gadd(gel(v,g), c); }
2934 : }
2935 : /* j = 1 corresponds to g = 1, and MUP[1] = 1 */
2936 37214644 : for (j=2; j < lDNF; j++) { g = DNF[j]; gel(v,g) = gmulsg(MUP[g], gel(v,g)); }
2937 16069092 : return v;
2938 : }
2939 :
2940 : /* special case (N,F) = 1: easier */
2941 : static GEN
2942 163261104 : mutg1(long t, long N, GEN VCHI, GEN L, GEN GCD)
2943 : {
2944 163261104 : GEN S = NULL;
2945 163261104 : long i, lx = lg(L);
2946 342969170 : for (i = 1; i < lx; i++)
2947 : {
2948 179708066 : long x = (L[i] + t) >> 1;
2949 179708066 : GEN c = mychicgcd(GCD, VCHI, x);
2950 179708066 : if (c) S = S? gadd(S, c): c;
2951 179708066 : if (L[i] && L[i] != N)
2952 : {
2953 99891078 : c = mychicgcd(GCD, VCHI, t - x);
2954 99891078 : if (c) S = S? gadd(S, c): c;
2955 : }
2956 179708066 : if (S && !signe(S)) S = NULL; /* strive hard to add gen_0 */
2957 : }
2958 163261104 : return S; /* single value */
2959 : }
2960 :
2961 : /* n > 2, return P_n = \sum_{0<=j<=n/2} (-1)^j binomial(n-j,j) X^j
2962 : * (2x)^n P_n (1 / (4x^2)) = polchebyshev(n, 2) */
2963 : GEN
2964 402734 : mfrhopol(long n)
2965 : {
2966 : #ifdef LONG_IS_64BIT
2967 345246 : const long M = 2642249;
2968 : #else
2969 57488 : const long M = 1629;
2970 : #endif
2971 402734 : long j, d = n >> 1; /* >= 1 */
2972 402734 : GEN P = cgetg(d + 3, t_POL);
2973 :
2974 402734 : if (n > M) pari_err_IMPL("mfrhopol for large weight"); /* avoid overflow */
2975 402734 : P[1] = evalvarn(0)|evalsigne(1);
2976 402734 : gel(P,2) = gen_1;
2977 402734 : gel(P,3) = utoineg(n-1); /* j = 1 */
2978 402734 : if (d > 1) gel(P,4) = utoipos(((n-3)*(n-2)) >> 1); /* j = 2 */
2979 402734 : if (d > 2) gel(P,5) = utoineg(((n-5)*(n-4)*(n-3)) / 6); /* j = 3 */
2980 1608867 : for (j = 4; j <= d; j++)
2981 1206133 : gel(P,j+2) = diviuexact(mulis(gel(P,j+1), -(n-2*j+1)*(n-2*j+2)), (n-j+1)*j);
2982 402734 : return P;
2983 : }
2984 :
2985 : /* polrecip(Q)(x), assume Q(0) = 1 */
2986 : GEN
2987 4102887 : mfrhopol_u_eval(GEN Q, ulong x)
2988 : {
2989 4102887 : GEN T = addiu(gel(Q,3), x);
2990 4102887 : long l = lg(Q), j;
2991 41482944 : for (j = 4; j < l; j++) T = addii(gel(Q,j), mului(x, T));
2992 4102887 : return T;
2993 : }
2994 : GEN
2995 105133 : mfrhopol_eval(GEN Q, GEN x)
2996 : {
2997 : long l, j;
2998 : GEN T;
2999 105133 : if (lgefint(x) == 3) return mfrhopol_u_eval(Q, x[2]);
3000 0 : l = lg(Q); T = addii(gel(Q,3), x);
3001 0 : for (j = 4; j < l; j++) T = addii(gel(Q,j), mulii(x, T));
3002 0 : return T;
3003 : }
3004 : /* t >= 0. If nu odd, let [N, T] = [(nu - 1)/2, t]; else let [N, T] = [nu/2, 1].
3005 : * We have t2 = t^2 and Q(X) = sum_{0<=j<=N} (-1)^j binomial(nu-j,j) n^j X^j
3006 : * U_nu(z) = polchebyshev(nu, 2, z)
3007 : * = sum_{0<=j<=N} (-1)^j binomial(nu-j,j) (2z)^(nu-2*j))
3008 : * Return C n^(nu/2) U_nu(t / (2*sqrt(n)))
3009 : * = C sum_{0<=j<=N} (-1)^j binomial(nu-j,j) n^j t^(nu - 2j)
3010 : * = C T sum_{0<=j<=N} (-1)^j binomial(nu-j,j) n^j (t^2)^(N - j)
3011 : * = C T polrecip(Q)(t^2); note that Q(0) = 1 */
3012 : static GEN
3013 170066746 : mfrhopow(GEN C, GEN Q, long nu, long t, long t2, long n)
3014 : {
3015 : GEN T;
3016 170066746 : switch (nu)
3017 : {
3018 162107834 : case 0: return C;
3019 2168698 : case 1: return gmulsg(t, C);
3020 1664866 : case 2: return gmulsg(t2 - n, C);
3021 51275 : case 3: return gmul(mulss(t, t2 - 2*n), C);
3022 4074073 : default:
3023 4074073 : if (!t) return gmul(gel(Q, lg(Q) - 1), C);
3024 3997754 : T = mfrhopol_u_eval(Q, t2); if (odd(nu)) T = mului(t, T);
3025 3997754 : return gmul(T, C);
3026 : }
3027 : }
3028 :
3029 : static GEN
3030 324085950 : TA2_t(long t, long N, long N4, long n, long n4, long nu, GEN Q,
3031 : GEN VCHI, GEN SQRTS, GEN MUP, GEN GCD)
3032 : {
3033 324085950 : long F, NF, D0, t2 = t*t, D = n4 - t2; /* > 0 */
3034 324085950 : GEN sh, L = gel(SQRTS, (umodsu(-D - 1, N4) >> 1) + 1);
3035 :
3036 324085950 : if (lg(L) == 1) return NULL;
3037 179330196 : D0 = mycoredisc2neg(D, &F);
3038 179330196 : NF = myugcd(GCD, F);
3039 179330196 : if (NF == 1)
3040 : { /* (N,F) = 1 => single value in mutglistall */
3041 163261104 : GEN mut = mutg1(t, N, VCHI, L, GCD);
3042 163261104 : if (!mut) return NULL;
3043 158346131 : sh = gmulgu(mut, hclassno6u_i(D,D0,F));
3044 : }
3045 : else
3046 : {
3047 16069092 : GEN v = mutglistall(t, N, NF, VCHI, n, MUP, L, GCD);
3048 16069092 : GEN DF = mydivisorsu(F);
3049 16069092 : long i, lDF = lg(DF);
3050 16069092 : sh = gen_0;
3051 64474719 : for (i = 1; i < lDF; i++)
3052 : {
3053 48405627 : long Ff, f = DF[i], g = myugcd(GCD, f);
3054 48405627 : GEN mut = gel(v, g);
3055 48405627 : if (gequal0(mut)) continue;
3056 31401426 : Ff = DF[lDF-i]; /* F/f */
3057 31401426 : if (Ff > 1)
3058 : {
3059 22452173 : GEN P = gel(myfactoru(Ff), 1);
3060 22452173 : long j, lP = lg(P);
3061 49502654 : for (j = 1; j < lP; j++) { long p = P[j]; Ff -= kross(D0, p)*Ff/p; }
3062 22452173 : mut = gmulsg(Ff, mut);
3063 : }
3064 31401426 : sh = gadd(sh, mut);
3065 : }
3066 16069092 : if (gequal0(sh)) return NULL;
3067 11720615 : if (D0 == -3) sh = gmul2n(sh, 1);
3068 11225060 : else if (D0 == -4) sh = gmulgu(sh, 3);
3069 10748416 : else sh = gmulgu(sh, hclassno6u_fund(D0));
3070 : }
3071 170066746 : return mfrhopow(sh, Q, nu, t, t2, n);
3072 : }
3073 :
3074 : /* contribution of elliptic matrices to trace formula */
3075 : static GEN
3076 6564045 : TA2(long N, long k, GEN VCHI, long n, GEN SQRTS, GEN MUP, GEN GCD)
3077 : {
3078 6564045 : long N4 = N << 2, n4 = n << 2, nu = k - 2;
3079 6564045 : long st = (!odd(N) && odd(n)) ? 2 : 1;
3080 6564045 : long t, limt = usqrt(n4 - 1);
3081 6564045 : GEN s, S = gen_0, Q = nu > 3 ? ZX_z_unscale(mfrhopol(nu), n) : NULL;
3082 :
3083 : /* actually compute 6*S to ensure integrality */
3084 324390485 : for (t = st; t <= limt; t += st) /* t^2 < 4n */
3085 : {
3086 317826440 : pari_sp av = avma;
3087 317826440 : s = TA2_t(t, N, N4, n, n4, nu, Q, VCHI, SQRTS, MUP, GCD);
3088 317826440 : if (s) S = gc_upto(av, gadd(S, s)); else set_avma(av);
3089 : }
3090 6564045 : if (!odd(k))
3091 : {
3092 6259510 : s = TA2_t(0, N, N4, n, n4, nu, Q, VCHI, SQRTS, MUP, GCD);
3093 : /* s/2 is the only term involving a denominator (= 2) */
3094 6259510 : if (s) S = gadd(S, gmul2n(s, -1));
3095 : }
3096 6564045 : return gdivgu(S, 6);
3097 : }
3098 :
3099 : /* compute global auxiliary data for TA3 */
3100 : static GEN
3101 129171 : mkbez(long N, long FC)
3102 : {
3103 129171 : long ct, i, NF = N/FC;
3104 129171 : GEN w, D = mydivisorsu(N);
3105 129171 : long l = lg(D);
3106 :
3107 129171 : w = cgetg(l, t_VEC);
3108 374556 : for (i = ct = 1; i < l; i++)
3109 : {
3110 351631 : long u, v, h, c = D[i], Nc = D[l-i];
3111 351631 : if (c > Nc) break;
3112 245385 : h = cbezout(c, Nc, &u, &v);
3113 245385 : if (h == 1) /* shortcut */
3114 177051 : gel(w, ct++) = mkvecsmall4(1,u*c,1,i);
3115 68334 : else if (!(NF%h))
3116 57582 : gel(w, ct++) = mkvecsmall4(h,u*(c/h),myeulerphiu(h),i);
3117 : }
3118 129171 : setlg(w,ct); stackdummy((pari_sp)(w+ct),(pari_sp)(w+l));
3119 129171 : return w;
3120 : }
3121 :
3122 : /* contribution of hyperbolic matrices to trace formula, d * nd = n,
3123 : * DN = divisorsu(N) */
3124 : static GEN
3125 34044534 : auxsum(GEN VCHI, GEN GCD, long d, long nd, GEN DN, GEN BEZ)
3126 : {
3127 34044534 : GEN S = gen_0;
3128 34044534 : long ct, g = nd - d, lDN = lg(DN), lBEZ = lg(BEZ);
3129 87676498 : for (ct = 1; ct < lBEZ; ct++)
3130 : {
3131 53631964 : GEN y, B = gel(BEZ, ct);
3132 53631964 : long ic, c, Nc, uch, h = B[1];
3133 53631964 : if (g%h) continue;
3134 52409078 : uch = B[2];
3135 52409078 : ic = B[4];
3136 52409078 : c = DN[ic];
3137 52409078 : Nc= DN[lDN - ic]; /* Nc = N/c */
3138 52409078 : if (ugcd(Nc, nd) == 1)
3139 43984571 : y = mychicgcd(GCD, VCHI, d + uch*g); /* 0 if (c,d) > 1 */
3140 : else
3141 8424507 : y = NULL;
3142 52409078 : if (c != Nc && ugcd(Nc, d) == 1)
3143 : {
3144 39006713 : GEN y2 = mychicgcd(GCD, VCHI, nd - uch*g); /* 0 if (c,nd) > 1 */
3145 39006713 : if (y2) y = y? gadd(y, y2): y2;
3146 : }
3147 52409078 : if (y) S = gadd(S, gmulsg(B[3], y));
3148 : }
3149 34044534 : return S;
3150 : }
3151 :
3152 : static GEN
3153 6564045 : TA3(long N, long k, GEN VCHI, GEN GCD, GEN Dn, GEN BEZ)
3154 : {
3155 6564045 : GEN S = gen_0, DN = mydivisorsu(N);
3156 6564045 : long i, l = lg(Dn);
3157 40608579 : for (i = 1; i < l; i++)
3158 : {
3159 40567713 : long d = Dn[i], nd = Dn[l-i]; /* = n/d */
3160 : GEN t, u;
3161 40567713 : if (d > nd) break;
3162 34044534 : t = auxsum(VCHI, GCD, d, nd, DN, BEZ);
3163 34044534 : if (isintzero(t)) continue;
3164 32683853 : u = powuu(d,k-1); if (d == nd) u = gmul2n(u,-1);
3165 32683853 : S = gadd(S, gmul(u,t));
3166 : }
3167 6564045 : return S;
3168 : }
3169 :
3170 : /* special contribution in weight 2 in trace formula */
3171 : static long
3172 6564045 : TA4(long k, GEN VCHIP, GEN Dn, GEN GCD)
3173 : {
3174 : long i, l, S;
3175 6564045 : if (k != 2 || vchip_FC(VCHIP) != 1) return 0;
3176 5687416 : l = lg(Dn); S = 0;
3177 66354498 : for (i = 1; i < l; i++)
3178 : {
3179 60667082 : long d = Dn[i]; /* gcd(N,n/d) == 1? */
3180 60667082 : if (myugcd(GCD, Dn[l-i]) == 1) S += d;
3181 : }
3182 5687416 : return S;
3183 : }
3184 :
3185 : /* precomputation of products occurring im mutg, again to accelerate TA2 */
3186 : static GEN
3187 129171 : mkmup(long N)
3188 : {
3189 129171 : GEN fa = myfactoru(N), P = gel(fa,1), D = divisorsu_fact(fa);
3190 129171 : long i, lP = lg(P), lD = lg(D);
3191 129171 : GEN MUP = zero_zv(N);
3192 129171 : MUP[1] = 1;
3193 452403 : for (i = 2; i < lD; i++)
3194 : {
3195 323232 : long j, g = D[i], Ng = D[lD-i]; /* N/g */
3196 886011 : for (j = 1; j < lP; j++) { long p = P[j]; if (Ng%p) g += g/p; }
3197 323232 : MUP[D[i]] = g;
3198 : }
3199 129171 : return MUP;
3200 : }
3201 :
3202 : /* quadratic nonresidues mod p; p odd prime, p^2 fits in a long */
3203 : static GEN
3204 2814 : non_residues(long p)
3205 : {
3206 2814 : long i, j, p2 = p >> 1;
3207 2814 : GEN v = cgetg(p2+1, t_VECSMALL), w = const_vecsmall(p-1, 1);
3208 4571 : for (i = 2; i <= p2; i++) w[(i*i) % p] = 0; /* no need to check 1 */
3209 9142 : for (i = 2, j = 1; i < p; i++) if (w[i]) v[j++] = i;
3210 2814 : return v;
3211 : }
3212 :
3213 : /* CHIP primitive. Return t_VECSMALL v of length q such that
3214 : * Tr^new_{N,CHIP}(n) = 0 whenever v[(n%q) + 1] is nonzero */
3215 : static GEN
3216 33649 : mfnewzerodata(long N, GEN CHIP)
3217 : {
3218 33649 : GEN V, M, L, faN = myfactoru(N), PN = gel(faN,1), EN = gel(faN,2);
3219 33649 : GEN G = gel(CHIP,1), chi = gel(CHIP,2);
3220 33649 : GEN fa = znstar_get_faN(G), P = ZV_to_zv(gel(fa,1)), E = gel(fa,2);
3221 33649 : long i, mod, j = 1, l = lg(PN);
3222 :
3223 33649 : M = cgetg(l, t_VECSMALL); M[1] = 0;
3224 33649 : V = cgetg(l, t_VEC);
3225 : /* Tr^new(n) = 0 if (n mod M[i]) in V[i] */
3226 33649 : if ((N & 3) == 0)
3227 : {
3228 13153 : long e = EN[1];
3229 13153 : long c = (lg(P) > 1 && P[1] == 2)? E[1]: 0; /* c = v_2(FC) */
3230 : /* e >= 2 */
3231 13153 : if (c == e-1) return NULL; /* Tr^new = 0 */
3232 13048 : if (c == e)
3233 : {
3234 3941 : if (e == 2)
3235 : { /* sc: -4 */
3236 1946 : gel(V,1) = mkvecsmall(3);
3237 1946 : M[1] = 4;
3238 : }
3239 1995 : else if (e == 3)
3240 : { /* sc: -8 (CHI_2(-1)=-1<=>chi[1]=1) and 8 (CHI_2(-1)=1 <=> chi[1]=0) */
3241 1995 : long t = signe(gel(chi,1))? 7: 3;
3242 1995 : gel(V,1) = mkvecsmall2(5, t);
3243 1995 : M[1] = 8;
3244 : }
3245 : }
3246 9107 : else if (e == 5 && c == 3)
3247 154 : { /* sc: -8 (CHI_2(-1)=-1<=>chi[1]=1) and 8 (CHI_2(-1)=1 <=> chi[1]=0) */
3248 154 : long t = signe(gel(chi,1))? 7: 3;
3249 154 : gel(V,1) = mkvecsmalln(6, 2L,4L,5L,6L,8L,t);
3250 154 : M[1] = 8;
3251 : }
3252 8953 : else if ((e == 4 && c == 2) || (e == 5 && c <= 2) || (e == 6 && c <= 2)
3253 7378 : || (e >= 7 && c == e - 3))
3254 : { /* sc: 4 */
3255 1575 : gel(V,1) = mkvecsmall3(0,2,3);
3256 1575 : M[1] = 4;
3257 : }
3258 7378 : else if ((e <= 4 && c == 0) || (e >= 5 && c == e - 2))
3259 : { /* sc: 2 */
3260 7021 : gel(V,1) = mkvecsmall(0);
3261 7021 : M[1] = 2;
3262 : }
3263 357 : else if ((e == 6 && c == 3) || (e >= 7 && c <= e - 4))
3264 : { /* sc: -2 */
3265 357 : gel(V,1) = mkvecsmalln(7, 0L,2L,3L,4L,5L,6L,7L);
3266 357 : M[1] = 8;
3267 : }
3268 : }
3269 33544 : j = M[1]? 2: 1;
3270 71526 : for (i = odd(N)? 1: 2; i < l; i++) /* skip p=2, done above */
3271 : {
3272 37982 : long p = PN[i], e = EN[i];
3273 37982 : long z = zv_search(P, p), c = z? E[z]: 0; /* c = v_p(FC) */
3274 37982 : if ((e <= 2 && c == 1 && itos(gel(chi,z)) == (p>>1)) /* ord(CHI_p)=2 */
3275 35791 : || (e >= 3 && c <= e - 2))
3276 2814 : { /* sc: -p */
3277 2814 : GEN v = non_residues(p);
3278 2814 : if (e != 1) v = vecsmall_prepend(v, 0);
3279 2814 : gel(V,j) = v;
3280 2814 : M[j] = p; j++;
3281 : }
3282 35168 : else if (e >= 2 && c < e)
3283 : { /* sc: p */
3284 2660 : gel(V,j) = mkvecsmall(0);
3285 2660 : M[j] = p; j++;
3286 : }
3287 : }
3288 33544 : if (j == 1) return cgetg(1, t_VECSMALL);
3289 15603 : setlg(V,j); setlg(M,j); mod = zv_prod(M);
3290 15603 : L = zero_zv(mod);
3291 34125 : for (i = 1; i < j; i++)
3292 : {
3293 18522 : GEN v = gel(V,i);
3294 18522 : long s, m = M[i], lv = lg(v);
3295 48132 : for (s = 1; s < lv; s++)
3296 : {
3297 29610 : long a = v[s] + 1;
3298 56679 : do { L[a] = 1; a += m; } while (a <= mod);
3299 : }
3300 : }
3301 15603 : return L;
3302 : }
3303 : /* v=mfnewzerodata(N,CHI); returns TRUE if newtrace(n) must be zero,
3304 : * (but newtrace(n) may still be zero if we return FALSE) */
3305 : static long
3306 2673683 : mfnewchkzero(GEN v, long n) { long q = lg(v)-1; return q && v[(n%q) + 1]; }
3307 :
3308 : /* if (!VCHIP): from mftraceform_cusp;
3309 : * else from initnewtrace and CHI is known to be primitive */
3310 : static GEN
3311 129171 : inittrace(long N, GEN CHI, GEN VCHIP)
3312 : {
3313 : long FC;
3314 129171 : if (VCHIP)
3315 129164 : FC = mfcharmodulus(CHI);
3316 : else
3317 7 : VCHIP = mfcharinit(mfchartoprimitive(CHI, &FC));
3318 129171 : return mkvecn(5, mksqr(N), mkmup(N), mkgcd(N), VCHIP, mkbez(N, FC));
3319 : }
3320 :
3321 : /* p > 2 prime; return a sorted t_VECSMALL of primes s.t Tr^new(p) = 0 for all
3322 : * weights > 2 */
3323 : static GEN
3324 33544 : inittrconj(long N, long FC)
3325 : {
3326 : GEN fa, P, E, v;
3327 : long i, k, l;
3328 :
3329 33544 : if (FC != 1) return cgetg(1,t_VECSMALL);
3330 :
3331 27713 : fa = myfactoru(N >> vals(N));
3332 27713 : P = gel(fa,1); l = lg(P);
3333 27713 : E = gel(fa,2);
3334 27713 : v = cgetg(l, t_VECSMALL);
3335 60298 : for (i = k = 1; i < l; i++)
3336 : {
3337 32585 : long j, p = P[i]; /* > 2 */
3338 78610 : for (j = 1; j < l; j++)
3339 46025 : if (j != i && E[j] == 1 && kross(-p, P[j]) == 1) v[k++] = p;
3340 : }
3341 27713 : setlg(v,k); return v;
3342 : }
3343 :
3344 : /* assume CHIP primitive, f(CHIP) | N; NZ = mfnewzerodata(N,CHIP) */
3345 : static GEN
3346 33544 : initnewtrace_i(long N, GEN CHIP, GEN NZ)
3347 : {
3348 33544 : GEN T = const_vec(N, cgetg(1,t_VEC)), D, VCHIP;
3349 33544 : long FC = mfcharmodulus(CHIP), N1, N2, i, l;
3350 :
3351 33544 : if (!NZ) NZ = mkvecsmall(1); /*Tr^new = 0; initialize data nevertheless*/
3352 33544 : VCHIP = mfcharinit(CHIP);
3353 33544 : N1 = N/FC; newd_params(N1, &N2);
3354 33544 : D = mydivisorsu(N1/N2); l = lg(D);
3355 33544 : N2 *= FC;
3356 162708 : for (i = 1; i < l; i++)
3357 : {
3358 129164 : long M = D[i]*N2;
3359 129164 : gel(T,M) = inittrace(M, CHIP, VCHIP);
3360 : }
3361 33544 : gel(T,N) = shallowconcat(gel(T,N), mkvec2(NZ, inittrconj(N,FC)));
3362 33544 : return T;
3363 : }
3364 : /* don't initialize if Tr^new = 0, return NULL */
3365 : static GEN
3366 33649 : initnewtrace(long N, GEN CHI)
3367 : {
3368 33649 : GEN CHIP = mfchartoprimitive(CHI, NULL), NZ = mfnewzerodata(N,CHIP);
3369 33649 : return NZ? initnewtrace_i(N, CHIP, NZ): NULL;
3370 : }
3371 :
3372 : /* (-1)^k */
3373 : static long
3374 8295 : m1pk(long k) { return odd(k)? -1 : 1; }
3375 : static long
3376 7931 : badchar(long N, long k, GEN CHI)
3377 7931 : { return mfcharparity(CHI) != m1pk(k) || (CHI && N % mfcharconductor(CHI)); }
3378 :
3379 :
3380 : static long
3381 43743 : mfcuspdim_i(long N, long k, GEN CHI, GEN vSP)
3382 : {
3383 43743 : pari_sp av = avma;
3384 : long FC;
3385 : GEN s;
3386 43743 : if (k <= 0) return 0;
3387 43743 : if (k == 1) return CHI? mf1cuspdim(N, CHI, vSP): 0;
3388 43484 : FC = CHI? mfcharconductor(CHI): 1;
3389 43484 : if (FC == 1) CHI = NULL;
3390 43484 : s = gsub(A1(N, k), gadd(A21(N, k, CHI), A22(N, k, CHI)));
3391 43484 : s = gadd(s, gsubsg(A4(k, FC), A3(N, FC)));
3392 43484 : return gc_long(av, itos(s));
3393 : }
3394 : /* dimension of space of cusp forms S_k(\G_0(N),CHI)
3395 : * Only depends on CHIP the primitive char attached to CHI */
3396 : long
3397 3458 : mfcuspdim(long N, long k, GEN CHI) { return mfcuspdim_i(N, k, CHI, NULL); }
3398 :
3399 : /* dimension of whole space M_k(\G_0(N),CHI)
3400 : * Only depends on CHIP the primitive char attached to CHI; assumes !badchar */
3401 : long
3402 868 : mffulldim(long N, long k, GEN CHI)
3403 : {
3404 868 : pari_sp av = avma;
3405 868 : long FC = CHI? mfcharconductor(CHI): 1;
3406 : GEN s;
3407 868 : if (k <= 0) return (k == 0 && FC == 1)? 1: 0;
3408 868 : if (k == 1) return gc_long(av, itos(A3(N, FC)) + mf1cuspdim(N, CHI, NULL));
3409 651 : if (FC == 1) CHI = NULL;
3410 651 : s = gsub(A1(N, k), gadd(A21(N, k, CHI), A22(N, k, CHI)));
3411 651 : s = gadd(s, A3(N, FC));
3412 651 : return gc_long(av, itos(s));
3413 : }
3414 :
3415 : /* Dimension of the space of Eisenstein series */
3416 : long
3417 231 : mfeisensteindim(long N, long k, GEN CHI)
3418 : {
3419 231 : pari_sp av = avma;
3420 231 : long s, FC = CHI? mfcharconductor(CHI): 1;
3421 231 : if (k <= 0) return (k == 0 && FC == 1)? 1: 0;
3422 231 : s = itos(gmul2n(A3(N, FC), 1));
3423 231 : if (k > 1) s -= A4(k, FC); else s >>= 1;
3424 231 : return gc_long(av,s);
3425 : }
3426 :
3427 : enum { _SQRTS = 1, _MUP, _GCD, _VCHIP, _BEZ, _NEWLZ, _TRCONJ };
3428 : /* Trace of T(n) on space of cuspforms; only depends on CHIP the primitive char
3429 : * attached to CHI */
3430 : static GEN
3431 6564045 : mfcusptrace_i(long N, long k, long n, GEN Dn, GEN S)
3432 : {
3433 6564045 : pari_sp av = avma;
3434 : GEN a, b, VCHIP, GCD;
3435 : long t;
3436 6564045 : if (!n) return gen_0;
3437 6564045 : VCHIP = gel(S,_VCHIP);
3438 6564045 : GCD = gel(S,_GCD);
3439 6564045 : t = TA4(k, VCHIP, Dn, GCD);
3440 6564045 : a = TA1(N, k, VCHIP, GCD, n); if (t) a = gaddgs(a,t);
3441 6564045 : b = TA2(N, k, VCHIP, n, gel(S,_SQRTS), gel(S,_MUP), GCD);
3442 6564045 : b = gadd(b, TA3(N, k, VCHIP, GCD, Dn, gel(S,_BEZ)));
3443 6564045 : b = gsub(a,b);
3444 6564045 : if (typ(b) != t_POL) return gc_upto(av, b);
3445 50834 : return gc_GEN(av, vchip_polmod(VCHIP, b));
3446 : }
3447 :
3448 : static GEN
3449 7850904 : mfcusptracecache(long N, long k, long n, GEN Dn, GEN S, cachenew_t *cache)
3450 : {
3451 7850904 : GEN C = NULL, T = gel(cache->vfull,N);
3452 7850904 : long lcache = lg(T);
3453 7850904 : if (n < lcache) C = gel(T, n);
3454 7850904 : if (C) cache->cuspHIT++; else C = mfcusptrace_i(N, k, n, Dn, S);
3455 7850904 : cache->cuspTOTAL++;
3456 7850904 : if (n < lcache) gel(T,n) = C;
3457 7850904 : return C;
3458 : }
3459 :
3460 : /* return the divisors of n, known to be among the elements of D */
3461 : static GEN
3462 336280 : div_restrict(GEN D, ulong n)
3463 : {
3464 : long i, j, l;
3465 336280 : GEN v, VDIV = caches[cache_DIV].cache;
3466 336280 : if (lg(VDIV) > n) return gel(VDIV,n);
3467 0 : l = lg(D);
3468 0 : v = cgetg(l, t_VECSMALL);
3469 0 : for (i = j = 1; i < l; i++)
3470 : {
3471 0 : ulong d = D[i];
3472 0 : if (n % d == 0) v[j++] = d;
3473 : }
3474 0 : setlg(v,j); return v;
3475 : }
3476 :
3477 : /* for some prime divisors of N, Tr^new(p) = 0 */
3478 : static int
3479 270911 : trconj(GEN T, long N, long n)
3480 270911 : { return (lg(T) > 1 && N % n == 0 && zv_search(T, n)); }
3481 :
3482 : /* n > 0; trace formula on new space */
3483 : static GEN
3484 2673683 : mfnewtrace_i(long N, long k, long n, cachenew_t *cache)
3485 : {
3486 2673683 : GEN VCHIP, s, Dn, DN1, SN, S = cache->DATA;
3487 : long FC, N1, N2, N1N2, g, i, j, lDN1;
3488 :
3489 2673683 : if (!S) return gen_0;
3490 2673683 : SN = gel(S,N);
3491 2673683 : if (mfnewchkzero(gel(SN,_NEWLZ), n)) return gen_0;
3492 1941643 : if (k > 2 && trconj(gel(SN,_TRCONJ), N, n)) return gen_0;
3493 1941594 : VCHIP = gel(SN, _VCHIP); FC = vchip_FC(VCHIP);
3494 1941594 : N1 = N/FC; newt_params(N1, n, FC, &g, &N2);
3495 1941594 : N1N2 = N1/N2;
3496 1941594 : DN1 = mydivisorsu(N1N2); lDN1 = lg(DN1);
3497 1941594 : N2 *= FC;
3498 1941594 : Dn = mydivisorsu(n); /* this one is probably out of cache */
3499 1941594 : s = gmulsg(mubeta2(N1N2,n), mfcusptracecache(N2, k, n, Dn, gel(S,N2), cache));
3500 7514624 : for (i = 2; i < lDN1; i++)
3501 : { /* skip M1 = 1, done above */
3502 5573030 : long M1 = DN1[i], N1M1 = DN1[lDN1-i];
3503 5573030 : GEN Dg = mydivisorsu(ugcd(M1, g));
3504 5573030 : M1 *= N2;
3505 5573030 : s = gadd(s, gmulsg(mubeta2(N1M1,n),
3506 5573030 : mfcusptracecache(M1, k, n, Dn, gel(S,M1), cache)));
3507 5909310 : for (j = 2; j < lg(Dg); j++) /* skip d = 1, done above */
3508 : {
3509 336280 : long d = Dg[j], ndd = n/(d*d), M = M1/d;
3510 336280 : GEN z = mulsi(mubeta2(N1M1,ndd), powuu(d,k-1)), C = vchip_lift(VCHIP,d,z);
3511 336280 : GEN Dndd = div_restrict(Dn, ndd);
3512 336280 : s = gadd(s, gmul(C, mfcusptracecache(M, k, ndd, Dndd, gel(S,M), cache)));
3513 : }
3514 5573030 : s = vchip_mod(VCHIP, s);
3515 : }
3516 1941594 : return vchip_polmod(VCHIP, s);
3517 : }
3518 :
3519 : static GEN
3520 12355 : get_DIH(long N)
3521 : {
3522 12355 : GEN x = cache_get(cache_DIH, N);
3523 12355 : return x? gcopy(x): mfdihedral(N);
3524 : }
3525 : static GEN
3526 2373 : get_vDIH(long N, GEN D)
3527 : {
3528 2373 : GEN x = const_vec(N, NULL);
3529 : long i, l;
3530 2373 : if (!D) D = mydivisorsu(N);
3531 2373 : l = lg(D);
3532 14504 : for (i = 1; i < l; i++) { long d = D[i]; gel(x, d) = get_DIH(d); }
3533 2373 : return x;
3534 : }
3535 :
3536 : /* divisors of N which are multiple of F */
3537 : static GEN
3538 322 : divisorsNF(long N, long F)
3539 : {
3540 322 : GEN D = mydivisorsu(N / F);
3541 322 : long l = lg(D), i;
3542 833 : for (i = 1; i < l; i++) D[i] = N / D[i];
3543 322 : return D;
3544 : }
3545 : /* mfcuspdim(N,k,CHI) - mfnewdim(N,k,CHI); CHIP primitive (for efficiency) */
3546 : static long
3547 8512 : mfolddim_i(long N, long k, GEN CHIP, GEN vSP)
3548 : {
3549 8512 : long S, i, l, F = mfcharmodulus(CHIP), N1 = N / F, N2;
3550 : GEN D;
3551 8512 : newd_params(N1, &N2); /* will ensure mubeta != 0 */
3552 8512 : D = mydivisorsu(N1/N2); l = lg(D); S = 0;
3553 8512 : if (k == 1 && !vSP) vSP = get_vDIH(N, divisorsNF(N, F));
3554 32795 : for (i = 2; i < l; i++)
3555 : {
3556 24283 : long d = mfcuspdim_i(N / D[i], k, CHIP, vSP);
3557 24283 : if (d) S -= mubeta(D[i]) * d;
3558 : }
3559 8512 : return S;
3560 : }
3561 : long
3562 224 : mfolddim(long N, long k, GEN CHI)
3563 : {
3564 224 : pari_sp av = avma;
3565 224 : GEN CHIP = mfchartoprimitive(CHI, NULL);
3566 224 : return gc_long(av, mfolddim_i(N, k, CHIP, NULL));
3567 : }
3568 : /* Only depends on CHIP the primitive char attached to CHI; assumes !badchar */
3569 : long
3570 16002 : mfnewdim(long N, long k, GEN CHI)
3571 : {
3572 : pari_sp av;
3573 : long S, F;
3574 16002 : GEN vSP, CHIP = mfchartoprimitive(CHI, &F);
3575 16002 : vSP = (k == 1)? get_vDIH(N, divisorsNF(N, F)): NULL;
3576 16002 : S = mfcuspdim_i(N, k, CHIP, vSP); if (!S) return 0;
3577 8015 : av = avma; return gc_long(av, S - mfolddim_i(N, k, CHIP, vSP));
3578 : }
3579 :
3580 : /* trace form, given as closure */
3581 : static GEN
3582 980 : mftraceform_new(long N, long k, GEN CHI)
3583 : {
3584 : GEN T;
3585 980 : if (k == 1) return initwt1newtrace(mfinit_Nkchi(N, 1, CHI, mf_CUSP, 0));
3586 959 : T = initnewtrace(N,CHI); if (!T) return mftrivial();
3587 959 : return tag(t_MF_NEWTRACE, mkNK(N,k,CHI), T);
3588 : }
3589 : static GEN
3590 14 : mftraceform_cusp(long N, long k, GEN CHI)
3591 : {
3592 14 : if (k == 1) return initwt1trace(mfinit_Nkchi(N, 1, CHI, mf_CUSP, 0));
3593 7 : return tag(t_MF_TRACE, mkNK(N,k,CHI), inittrace(N,CHI,NULL));
3594 : }
3595 : static GEN
3596 98 : mftraceform_i(GEN NK, long space)
3597 : {
3598 : GEN CHI;
3599 : long N, k;
3600 98 : checkNK(NK, &N, &k, &CHI, 0);
3601 98 : if (!mfdim_Nkchi(N, k, CHI, space)) return mftrivial();
3602 77 : switch(space)
3603 : {
3604 56 : case mf_NEW: return mftraceform_new(N, k, CHI);
3605 14 : case mf_CUSP:return mftraceform_cusp(N, k, CHI);
3606 : }
3607 7 : pari_err_DOMAIN("mftraceform", "space", "=", utoi(space), NK);
3608 : return NULL;/*LCOV_EXCL_LINE*/
3609 : }
3610 : GEN
3611 98 : mftraceform(GEN NK, long space)
3612 98 : { pari_sp av = avma; return gc_GEN(av, mftraceform_i(NK,space)); }
3613 :
3614 : static GEN
3615 18466 : hecke_data(long N, long n)
3616 18466 : { return mkvecsmall3(n, u_ppo(n, N), N); }
3617 : /* 1/2-integral weight */
3618 : static GEN
3619 84 : heckef2_data(long N, long n)
3620 : {
3621 : ulong f, fN, fN2;
3622 84 : if (!uissquareall(n, &f)) return NULL;
3623 77 : fN = u_ppo(f, N); fN2 = fN*fN;
3624 77 : return mkvec2(myfactoru(fN), mkvecsmall4(n, N, fN2, n/fN2));
3625 : }
3626 : /* N = mf_get_N(F) or a multiple */
3627 : static GEN
3628 25704 : mfhecke_i(long n, long N, GEN F)
3629 : {
3630 25704 : if (n == 1) return F;
3631 18081 : return tag2(t_MF_HECKE, mf_get_NK(F), hecke_data(N,n), F);
3632 : }
3633 :
3634 : GEN
3635 119 : mfhecke(GEN mf, GEN F, long n)
3636 : {
3637 119 : pari_sp av = avma;
3638 : GEN NK, CHI, gk, DATA;
3639 : long N, nk, dk;
3640 119 : mf = checkMF(mf);
3641 119 : if (!checkmf_i(F)) pari_err_TYPE("mfhecke",F);
3642 119 : if (n <= 0) pari_err_TYPE("mfhecke [n <= 0]", stoi(n));
3643 119 : if (n == 1) return gcopy(F);
3644 119 : gk = mf_get_gk(F);
3645 119 : Qtoss(gk,&nk,&dk);
3646 119 : CHI = mf_get_CHI(F);
3647 119 : N = MF_get_N(mf);
3648 119 : if (dk == 2)
3649 : {
3650 77 : DATA = heckef2_data(N,n);
3651 77 : if (!DATA) return mftrivial();
3652 : }
3653 : else
3654 42 : DATA = hecke_data(N,n);
3655 112 : NK = mkgNK(lcmii(stoi(N), mf_get_gN(F)), gk, CHI, mf_get_field(F));
3656 112 : return gc_GEN(av, tag2(t_MF_HECKE, NK, DATA, F));
3657 : }
3658 :
3659 : /* form F given by closure, compute B(d)(F) as closure (q -> q^d) */
3660 : static GEN
3661 36981 : mfbd_i(GEN F, long d)
3662 : {
3663 : GEN D, NK, gk, CHI;
3664 36981 : if (d == 1) return F;
3665 13762 : if (d <= 0) pari_err_TYPE("mfbd [d <= 0]", stoi(d));
3666 13762 : if (mf_get_type(F) != t_MF_BD) D = utoi(d);
3667 7 : else { D = mului(d, gel(F,3)); F = gel(F,2); }
3668 13762 : gk = mf_get_gk(F); CHI = mf_get_CHI(F);
3669 13762 : if (typ(gk) != t_INT) CHI = mfcharmul(CHI, get_mfchar(utoi(d << 2)));
3670 13762 : NK = mkgNK(muliu(mf_get_gN(F), d), gk, CHI, mf_get_field(F));
3671 13762 : return tag2(t_MF_BD, NK, F, D);
3672 : }
3673 : GEN
3674 266 : mfbd(GEN F, long d)
3675 : {
3676 266 : pari_sp av = avma;
3677 266 : if (!checkmf_i(F)) pari_err_TYPE("mfbd",F);
3678 266 : return gc_GEN(av, mfbd_i(F, d));
3679 : }
3680 :
3681 : /* A[i+1] = a(t*i^2) */
3682 : static GEN
3683 112 : RgV_shimura(GEN A, long n, long t, long N, long r, GEN CHI)
3684 : {
3685 112 : GEN R, a0, Pn = mfcharpol(CHI);
3686 112 : long m, st, ord = mfcharorder(CHI), vt = varn(Pn), Nt = t == 1? N: ulcm(N,t);
3687 :
3688 112 : R = cgetg(n + 2, t_VEC);
3689 112 : st = odd(r)? -t: t;
3690 112 : a0 = gel(A, 1);
3691 112 : if (!gequal0(a0))
3692 : {
3693 14 : long o = mfcharorder(CHI);
3694 14 : if (st != 1 && odd(o)) o <<= 1;
3695 14 : a0 = gmul(a0, charLFwtk(Nt, r, CHI, o, st));
3696 : }
3697 112 : gel(R, 1) = a0;
3698 672 : for (m = 1; m <= n; m++)
3699 : {
3700 560 : GEN Dm = mydivisorsu(u_ppo(m, Nt)), S = gel(A, m*m + 1);
3701 560 : long i, l = lg(Dm);
3702 833 : for (i = 2; i < l; i++)
3703 : { /* (e,Nt) = 1; skip i = 1: e = 1, done above */
3704 273 : long e = Dm[i], me = m / e, a = mfcharevalord(CHI, e, ord);
3705 273 : GEN c, C = powuu(e, r - 1);
3706 273 : if (kross(st, e) == -1) C = negi(C);
3707 273 : c = Qab_Czeta(a, ord, C, vt);
3708 273 : S = gadd(S, gmul(c, gel(A, me*me + 1)));
3709 : }
3710 560 : gel(R, m+1) = S;
3711 : }
3712 112 : return degpol(Pn) > 1? gmodulo(R, Pn): R;
3713 : }
3714 :
3715 : static long
3716 35 : mfisinkohnen(GEN mf, GEN F)
3717 : {
3718 35 : GEN v, gk = MF_get_gk(mf), CHI = MF_get_CHI(mf);
3719 35 : long i, eps, N4 = MF_get_N(mf) >> 2, sb = mfsturmNgk(N4 << 4, gk) + 1;
3720 35 : eps = N4 % mfcharconductor(CHI)? -1 : 1;
3721 35 : if (odd(MF_get_r(mf))) eps = -eps;
3722 35 : v = mfcoefs(F, sb, 1);
3723 910 : for (i = 2; i <= sb; i+=4) if (!gequal0(gel(v,i+1))) return 0;
3724 462 : for (i = 2+eps; i <= sb; i+=4) if (!gequal0(gel(v,i+1))) return 0;
3725 21 : return 1;
3726 : }
3727 :
3728 : static long
3729 49 : mfshimura_space_cusp(GEN mf)
3730 : {
3731 : long N4;
3732 49 : if (MF_get_r(mf) == 1 && (N4 = MF_get_N(mf) >> 2) >= 4)
3733 : {
3734 21 : GEN E = gel(myfactoru(N4), 2);
3735 21 : long ma = vecsmall_max(E);
3736 21 : if (ma > 2 || (ma == 2 && !mfcharistrivial(MF_get_CHI(mf)))) return 0;
3737 : }
3738 35 : return 1;
3739 : }
3740 :
3741 : static GEN
3742 56 : mfshifin(GEN mf2, GEN G)
3743 : {
3744 56 : GEN res = mftobasis_i(mf2, G);
3745 : /* not mflinear(mf2,): we want lowest possible level */
3746 56 : G = mflinear(MF_get_basis(mf2), res);
3747 56 : return mkvec3(mf2, G, res);
3748 : }
3749 :
3750 : /* t is either a positive squarefree integer or a fundamental
3751 : discriminant of sign (-1)^r. */
3752 : GEN
3753 63 : mfshimura(GEN mf, GEN F, long t)
3754 : {
3755 63 : pari_sp av = avma;
3756 : GEN G, mf2, CHI;
3757 63 : long sb, M, r, N, space = mf_FULL;
3758 :
3759 63 : if (!checkmf_i(F)) pari_err_TYPE("mfshimura",F);
3760 63 : mf = checkMF(mf);
3761 63 : r = MF_get_r(mf);
3762 63 : if (r <= 0) pari_err_DOMAIN("mfshimura", "weight", "<=", ghalf, mf_get_gk(F));
3763 63 : if (t <= 0 || !uissquarefree(t))
3764 : {
3765 14 : GEN gD = stoi(t);
3766 14 : if (!t || !isfundamental(gD) || (t < 0 && !odd(r)) || (t > 0 && odd(r)))
3767 7 : pari_err_TYPE("mfshimura [t]", stoi(t));
3768 7 : if (odd(t)) t = -t;
3769 : else
3770 : {
3771 : GEN SH;
3772 7 : if (t < 0) t = -t;
3773 7 : SH = mfshimura(mf, F, t >> 2); mf2 = gel(SH, 1);
3774 7 : G = mfhecke(mf2, gel(SH, 2), 2);
3775 7 : return gc_GEN(av, mfshifin(mf2, G));
3776 : }
3777 : }
3778 49 : N = MF_get_N(mf); M = N >> 1;
3779 49 : if (mfiscuspidal(mf,F))
3780 : {
3781 35 : if (mfshimura_space_cusp(mf)) space = mf_CUSP;
3782 35 : if (mfisinkohnen(mf,F)) M = N >> 2;
3783 : }
3784 49 : CHI = MF_get_CHI(mf);
3785 49 : mf2 = mfinit_Nkchi(M, r << 1, mfcharpow(CHI, gen_2), space, 0);
3786 49 : sb = mfsturm(mf2);
3787 49 : G = RgV_shimura(mfcoefs_i(F, sb*sb, t), sb, t, N, r, CHI);
3788 49 : return gc_GEN(av, mfshifin(mf2, G));
3789 : }
3790 :
3791 : /* W ZabM (ZM if n = 1), a t_INT or NULL, b t_INT, ZXQ mod P or NULL.
3792 : * Write a/b = A/d with d t_INT and A Zab return [W,d,A,P] */
3793 : static GEN
3794 7819 : mkMinv(GEN W, GEN a, GEN b, GEN P)
3795 : {
3796 7819 : GEN A = (b && typ(b) == t_POL)? Q_remove_denom(QXQ_inv(b,P), &b): NULL;
3797 7819 : if (a && b)
3798 : {
3799 1358 : a = Qdivii(a,b);
3800 1358 : if (typ(a) == t_INT) b = gen_1; else { b = gel(a,2); a = gel(a,1); }
3801 1358 : if (is_pm1(a)) a = NULL;
3802 : }
3803 7819 : if (a) A = A? ZX_Z_mul(A,a): a; else if (!A) A = gen_1;
3804 7819 : if (!b) b = gen_1;
3805 7819 : if (!P) P = gen_0;
3806 7819 : return mkvec4(W,b,A,P);
3807 : }
3808 : /* M square invertible QabM, return [M',d], M*M' = d*Id */
3809 : static GEN
3810 609 : QabM_Minv(GEN M, GEN P, long n)
3811 : {
3812 : GEN dW, W, dM;
3813 609 : M = Q_remove_denom(M, &dM);
3814 609 : W = P? ZabM_inv(liftpol_shallow(M), P, n, &dW): ZM_inv(M, &dW);
3815 609 : return mkMinv(W, dM, dW, P);
3816 : }
3817 : /* Simplified form of mfclean, after a QabM_indexrank: M a ZabM with full
3818 : * column rank and z = indexrank(M) is known */
3819 : static GEN
3820 861 : mfclean2(GEN M, GEN z, GEN P, long n)
3821 : {
3822 861 : GEN d, Minv, y = gel(z,1), W = rowpermute(M, y);
3823 861 : W = P? ZabM_inv(liftpol_shallow(W), P, n, &d): ZM_inv(W, &d);
3824 861 : M = rowslice(M, 1, y[lg(y)-1]);
3825 861 : Minv = mkMinv(W, NULL, d, P);
3826 861 : return mkvec3(y, Minv, M);
3827 : }
3828 : /* M QabM, lg(M)>1 and [y,z] its rank profile. Let Minv be the inverse of the
3829 : * invertible square matrix in mkMinv format. Return [y,Minv, M[..y[#y],]]
3830 : * P cyclotomic polynomial of order n > 2 or NULL */
3831 : static GEN
3832 5047 : mfclean(GEN M, GEN P, long n, int ratlift)
3833 : {
3834 5047 : GEN W, v, y, z, d, Minv, dM, MdM = Q_remove_denom(M, &dM);
3835 5047 : if (n <= 2)
3836 3941 : W = ZM_pseudoinv(MdM, &v, &d);
3837 : else
3838 1106 : W = ZabM_pseudoinv_i(liftpol_shallow(MdM), P, n, &v, &d, ratlift);
3839 5047 : y = gel(v,1);
3840 5047 : z = gel(v,2);
3841 5047 : if (lg(z) != lg(MdM)) M = vecpermute(M,z);
3842 5047 : M = rowslice(M, 1, y[lg(y)-1]);
3843 5047 : Minv = mkMinv(W, dM, d, P);
3844 5047 : return mkvec3(y, Minv, M);
3845 : }
3846 : /* call mfclean using only CHI */
3847 : static GEN
3848 4095 : mfcleanCHI(GEN M, GEN CHI, int ratlift)
3849 : {
3850 4095 : long n = mfcharorder(CHI);
3851 4095 : GEN P = (n <= 2)? NULL: mfcharpol(CHI);
3852 4095 : return mfclean(M, P, n, ratlift);
3853 : }
3854 :
3855 : /* DATA component of a t_MF_NEWTRACE. Was it stripped to save memory ? */
3856 : static int
3857 34601 : newtrace_stripped(GEN DATA)
3858 34601 : { return DATA && (lg(DATA) == 5 && typ(gel(DATA,3)) == t_INT); }
3859 : /* f a t_MF_NEWTRACE */
3860 : static GEN
3861 34601 : newtrace_DATA(long N, GEN f)
3862 : {
3863 34601 : GEN DATA = gel(f,2);
3864 34601 : return newtrace_stripped(DATA)? initnewtrace(N, DATA): DATA;
3865 : }
3866 : /* reset cachenew for new level incorporating new DATA, tf a t_MF_NEWTRACE
3867 : * (+ possibly initialize 'full' for new allowed levels) */
3868 : static void
3869 34601 : reset_cachenew(cachenew_t *cache, long N, GEN tf)
3870 : {
3871 : long i, n, l;
3872 34601 : GEN v, DATA = newtrace_DATA(N,tf);
3873 34601 : cache->DATA = DATA;
3874 34601 : if (!DATA) return;
3875 34496 : n = cache->n;
3876 34496 : v = cache->vfull; l = N+1; /* = lg(DATA) */
3877 2223592 : for (i = 1; i < l; i++)
3878 2189096 : if (typ(gel(v,i)) == t_INT && lg(gel(DATA,i)) != 1)
3879 54551 : gel(v,i) = const_vec(n, NULL);
3880 34496 : cache->VCHIP = gel(gel(DATA,N),_VCHIP);
3881 : }
3882 : /* initialize a cache of newtrace / cusptrace up to index n and level | N;
3883 : * DATA may be NULL (<=> Tr^new = 0). tf a t_MF_NEWTRACE */
3884 : static void
3885 13650 : init_cachenew(cachenew_t *cache, long n, long N, GEN tf)
3886 : {
3887 13650 : long i, l = N+1; /* = lg(tf.DATA) when DATA != NULL */
3888 : GEN v;
3889 13650 : cache->n = n;
3890 13650 : cache->vnew = v = cgetg(l, t_VEC);
3891 957593 : for (i = 1; i < l; i++) gel(v,i) = (N % i)? gen_0: const_vec(n, NULL);
3892 13650 : cache->newHIT = cache->newTOTAL = cache->cuspHIT = cache->cuspTOTAL = 0;
3893 13650 : cache->vfull = v = zerovec(N);
3894 13650 : reset_cachenew(cache, N, tf);
3895 13650 : }
3896 : static void
3897 17780 : dbg_cachenew(cachenew_t *C)
3898 : {
3899 17780 : if (DEBUGLEVEL >= 2 && C)
3900 0 : err_printf("newtrace cache hits: new = %ld/%ld, cusp = %ld/%ld\n",
3901 : C->newHIT, C->newTOTAL, C->cuspHIT, C->cuspTOTAL);
3902 17780 : }
3903 :
3904 : /* newtrace_{N,k}(d*i), i = n0, ..., n */
3905 : static GEN
3906 185598 : colnewtrace(long n0, long n, long d, long N, long k, cachenew_t *cache)
3907 : {
3908 185598 : GEN v = cgetg(n-n0+2, t_COL);
3909 : long i;
3910 4831841 : for (i = n0; i <= n; i++) gel(v, i-n0+1) = mfnewtracecache(N, k, i*d, cache);
3911 185598 : return v;
3912 : }
3913 : /* T_n(l*m0, l*(m0+1), ..., l*m) F, F = t_MF_NEWTRACE [N,k],DATA, cache
3914 : * contains DATA != NULL as well as cached values of F */
3915 : static GEN
3916 91581 : heckenewtrace(long m0, long m, long l, long N, long NBIG, long k, long n, cachenew_t *cache)
3917 : {
3918 91581 : long lD, a, k1, nl = n*l;
3919 91581 : GEN D, V, v = colnewtrace(m0, m, nl, N, k, cache); /* d=1 */
3920 : GEN VCHIP;
3921 91581 : if (n == 1) return v;
3922 63259 : VCHIP = cache->VCHIP;
3923 63259 : D = mydivisorsu(u_ppo(n, NBIG)); lD = lg(D);
3924 63259 : k1 = k - 1;
3925 155358 : for (a = 2; a < lD; a++)
3926 : { /* d > 1, (d,NBIG) = 1 */
3927 92099 : long i, j, d = D[a], c = ugcd(l, d), dl = d/c, m0d = ceildivuu(m0, dl);
3928 92099 : GEN C = vchip_lift(VCHIP, d, powuu(d, k1));
3929 : /* m0=0: i = 1 => skip F(0) = 0 */
3930 92099 : if (!m0) { i = 1; j = dl; } else { i = 0; j = m0d*dl; }
3931 92099 : V = colnewtrace(m0d, m/dl, nl/(d*c), N, k, cache);
3932 : /* C = chi(d) d^(k-1) */
3933 1105314 : for (; j <= m; i++, j += dl)
3934 1013215 : gel(v,j-m0+1) = gadd(gel(v,j-m0+1), vchip_mod(VCHIP, gmul(C,gel(V,i+1))));
3935 : }
3936 63259 : return v;
3937 : }
3938 :
3939 : /* Given v = an[i], return an[d*i], i=0..n */
3940 : static GEN
3941 2646 : anextract(GEN v, long n, long d)
3942 : {
3943 2646 : long i, id, l = n + 2;
3944 2646 : GEN w = cgetg(l, t_VEC);
3945 2646 : if (d == 1)
3946 7322 : for (i = 1; i < l; i++) gel(w, i) = gel(v, i);
3947 : else
3948 22169 : for (i = id = 1; i < l; i++, id += d) gel(w, i) = gel(v, id);
3949 2646 : return w;
3950 : }
3951 : /* T_n(F)(0, l, ..., l*m) */
3952 : static GEN
3953 2723 : hecke_i(long m, long l, GEN V, GEN F, GEN DATA)
3954 : {
3955 : long k, n, nNBIG, NBIG, lD, M, a, t, nl;
3956 : GEN D, v, CHI;
3957 2723 : if (typ(DATA) == t_VEC)
3958 : { /* 1/2-integral k */
3959 98 : if (!V) { GEN S = gel(DATA,2); V = mfcoefs_i(F, m*l*S[3], S[4]); }
3960 98 : return RgV_heckef2(m, l, V, F, DATA);
3961 : }
3962 2625 : k = mf_get_k(F);
3963 2625 : n = DATA[1]; nl = n*l;
3964 2625 : nNBIG = DATA[2];
3965 2625 : NBIG = DATA[3];
3966 2625 : if (nNBIG == 1) return V? V: mfcoefs_i(F,m,nl);
3967 1869 : if (!V && mf_get_type(F) == t_MF_NEWTRACE)
3968 : { /* inline F to allow cache, T_n at level NBIG acting on Tr^new(N,k,CHI) */
3969 : cachenew_t cache;
3970 546 : long N = mf_get_N(F);
3971 546 : init_cachenew(&cache, m*nl, N, F);
3972 546 : v = heckenewtrace(0, m, l, N, NBIG, k, n, &cache);
3973 546 : dbg_cachenew(&cache);
3974 546 : settyp(v, t_VEC); return v;
3975 : }
3976 1323 : CHI = mf_get_CHI(F);
3977 1323 : D = mydivisorsu(nNBIG); lD = lg(D);
3978 1323 : M = m + 1;
3979 1323 : t = nNBIG * ugcd(nNBIG, l);
3980 1323 : if (!V) V = mfcoefs_i(F, m * t, nl / t); /* usually nl = t */
3981 1323 : v = anextract(V, m, t); /* mfcoefs(F, m, nl); d = 1 */
3982 2646 : for (a = 2; a < lD; a++)
3983 : { /* d > 1, (d, NBIG) = 1 */
3984 1323 : long d = D[a], c = ugcd(l, d), dl = d/c, i, idl;
3985 1323 : GEN chi = mfchareval(CHI, d);
3986 1323 : GEN C = k ? gmul(chi, powuu(d, k-1)): chi;
3987 1323 : GEN w = anextract(V, m/dl, t/(d*c)); /* mfcoefs(F, m/dl, nl/(d*c)) */
3988 7322 : for (i = idl = 1; idl <= M; i++, idl += dl)
3989 5999 : gel(v,idl) = gadd(gel(v,idl), gmul(C, gel(w,i)));
3990 : }
3991 1323 : return v;
3992 : }
3993 :
3994 : static GEN
3995 12544 : mkmf(GEN x1, GEN x2, GEN x3, GEN x4, GEN x5)
3996 : {
3997 12544 : GEN MF = obj_init(5, MF_SPLITN);
3998 12544 : gel(MF,1) = x1;
3999 12544 : gel(MF,2) = x2;
4000 12544 : gel(MF,3) = x3;
4001 12544 : gel(MF,4) = x4;
4002 12544 : gel(MF,5) = x5; return MF;
4003 : }
4004 :
4005 : /* return an integer b such that p | b => T_p^k Tr^new = 0, for all k > 0 */
4006 : static long
4007 7756 : get_badj(long N, long FC)
4008 : {
4009 7756 : GEN fa = myfactoru(N), P = gel(fa,1), E = gel(fa,2);
4010 7756 : long i, b = 1, l = lg(P);
4011 20587 : for (i = 1; i < l; i++)
4012 12831 : if (E[i] > 1 && u_lval(FC, P[i]) < E[i]) b *= P[i];
4013 7756 : return b;
4014 : }
4015 : /* in place, assume perm strictly increasing */
4016 : static void
4017 1372 : vecpermute_inplace(GEN v, GEN perm)
4018 : {
4019 1372 : long i, l = lg(perm);
4020 11914 : for (i = 1; i < l; i++) gel(v,i) = gel(v,perm[i]);
4021 1372 : }
4022 :
4023 : /* Find basis of newspace using closures; assume k >= 2 and !badchar.
4024 : * Return NULL if space is empty, else
4025 : * [mf1, list of closures T(j)traceform, list of corresponding j, matrix] */
4026 : static GEN
4027 15757 : mfnewinit(long N, long k, GEN CHI, cachenew_t *cache, long init)
4028 : {
4029 : GEN S, vj, M, CHIP, mf1, listj, P, tf;
4030 : long j, ct, ctlj, dim, jin, SB, sb, two, ord, FC, badj;
4031 :
4032 15757 : dim = mfnewdim(N, k, CHI);
4033 15757 : if (!dim && !init) return NULL;
4034 7756 : sb = mfsturmNk(N, k);
4035 7756 : CHIP = mfchartoprimitive(CHI, &FC);
4036 : /* remove newtrace data from S to save space in output: negligible slowdown */
4037 7756 : tf = tag(t_MF_NEWTRACE, mkNK(N,k,CHIP), CHIP);
4038 7756 : badj = get_badj(N, FC);
4039 : /* try sbsmall first: Sturm bound not sharp for new space */
4040 7756 : SB = ceilA1(N, k);
4041 7756 : listj = cgetg(2*sb + 3, t_VECSMALL);
4042 377461 : for (j = ctlj = 1; ctlj < 2*sb + 3; j++)
4043 369705 : if (ugcd(j, badj) == 1) listj[ctlj++] = j;
4044 7756 : if (init)
4045 : {
4046 4200 : init_cachenew(cache, (SB+1)*listj[dim+1], N, tf);
4047 4200 : if (init == -1 || !dim) return NULL; /* old space or dim = 0 */
4048 : }
4049 : else
4050 3556 : reset_cachenew(cache, N, tf);
4051 : /* cache.DATA is not NULL */
4052 7287 : ord = mfcharorder(CHIP);
4053 7287 : P = ord <= 2? NULL: mfcharpol(CHIP);
4054 7287 : vj = cgetg(dim+1, t_VECSMALL);
4055 7287 : M = cgetg(dim+1, t_MAT);
4056 7294 : for (two = 1, ct = 0, jin = 1; two <= 2; two++)
4057 : {
4058 7294 : long a, jlim = jin + sb;
4059 22876 : for (a = jin; a <= jlim; a++)
4060 : {
4061 : GEN z, vecz;
4062 22869 : ct++; vj[ct] = listj[a];
4063 22869 : gel(M, ct) = heckenewtrace(0, SB, 1, N, N, k, vj[ct], cache);
4064 22869 : if (ct < dim) continue;
4065 :
4066 7973 : z = QabM_indexrank(M, P, ord);
4067 7973 : vecz = gel(z, 2); ct = lg(vecz) - 1;
4068 7973 : if (ct == dim) { M = mkvec3(z, gen_0, M); break; } /*maximal rank, done*/
4069 686 : vecpermute_inplace(M, vecz);
4070 686 : vecpermute_inplace(vj, vecz);
4071 : }
4072 7294 : if (a <= jlim) break;
4073 : /* sbsmall was not sufficient, use Sturm bound: must extend M */
4074 70 : for (j = 1; j <= ct; j++)
4075 : {
4076 63 : GEN t = heckenewtrace(SB + 1, sb, 1, N, N, k, vj[j], cache);
4077 63 : gel(M,j) = shallowconcat(gel(M, j), t);
4078 : }
4079 7 : jin = jlim + 1; SB = sb;
4080 : }
4081 7287 : S = cgetg(dim + 1, t_VEC);
4082 29428 : for (j = 1; j <= dim; j++) gel(S, j) = mfhecke_i(vj[j], N, tf);
4083 7287 : dbg_cachenew(cache);
4084 7287 : mf1 = mkvec4(utoipos(N), utoipos(k), CHI, utoi(mf_NEW));
4085 7287 : return mkmf(mf1, cgetg(1,t_VEC), S, vj, M);
4086 : }
4087 : /* k > 1 integral, mf space is mf_CUSP or mf_FULL */
4088 : static GEN
4089 49 : mfinittonew(GEN mf)
4090 : {
4091 49 : GEN CHI = MF_get_CHI(mf), S = MF_get_S(mf), vMjd = MFcusp_get_vMjd(mf);
4092 49 : GEN M = MF_get_M(mf), vj, mf1;
4093 49 : long i, j, l, l0 = lg(S), N0 = MF_get_N(mf);
4094 252 : for (i = l0-1; i > 0; i--)
4095 : {
4096 238 : long N = gel(vMjd,i)[1];
4097 238 : if (N != N0) break;
4098 : }
4099 49 : if (i == l0-1) return NULL;
4100 42 : S = vecslice(S, i+1, l0-1); /* forms of conductor N0 */
4101 42 : l = lg(S); vj = cgetg(l, t_VECSMALL);
4102 245 : for (j = 1; j < l; j++) vj[j] = gel(vMjd,j+i)[2];
4103 42 : M = vecslice(M, lg(M)-lg(S)+1, lg(M)-1); /* their coefficients */
4104 42 : M = mfcleanCHI(M, CHI, 0);
4105 42 : mf1 = mkvec4(utoipos(N0), MF_get_gk(mf), CHI, utoi(mf_NEW));
4106 42 : return mkmf(mf1, cgetg(1,t_VEC), S, vj, M);
4107 : }
4108 :
4109 : /* Bd(f)[m0..m], v = f[ceil(m0/d)..floor(m/d)], m0d = ceil(m0/d) */
4110 : static GEN
4111 84665 : RgC_Bd_expand(long m0, long m, GEN v, long d, long m0d)
4112 : {
4113 : long i, j;
4114 : GEN w;
4115 84665 : if (d == 1) return v;
4116 24080 : w = zerocol(m-m0+1);
4117 24080 : if (!m0) { i = 1; j = d; } else { i = 0; j = m0d*d; }
4118 477421 : for (; j <= m; i++, j += d) gel(w,j-m0+1) = gel(v,i+1);
4119 24080 : return w;
4120 : }
4121 : /* S a nonempty vector of t_MF_BD(t_MF_HECKE(t_MF_NEWTRACE)); M the matrix
4122 : * of their coefficients r*0, r*1, ..., r*m0 (~ mfvectomat) or NULL (empty),
4123 : * extend it to coeffs up to m > m0. The forms B_d(T_j(tf_N))in S should be
4124 : * sorted by level N, then j, then increasing d. No reordering here. */
4125 : static GEN
4126 9282 : bhnmat_extend(GEN M, long m, long r, GEN S, cachenew_t *cache)
4127 : {
4128 9282 : long i, mr, m0, m0r, Nold = 0, jold = 0, l = lg(S);
4129 9282 : GEN MAT = cgetg(l, t_MAT), v = NULL;
4130 9282 : if (M) { m0 = nbrows(M); m0r = m0 * r; } else m0 = m0r = 0;
4131 9282 : mr = m*r;
4132 93947 : for (i = 1; i < l; i++)
4133 : {
4134 : long d, j, md, N;
4135 84665 : GEN c, f = bhn_parse(gel(S,i), &d,&j); /* t_MF_NEWTRACE */
4136 84665 : N = mf_get_N(f);
4137 84665 : md = ceildivuu(m0r,d);
4138 84665 : if (N != Nold) { reset_cachenew(cache, N, f); Nold = N; jold = 0; }
4139 84665 : if (!cache->DATA) { gel(MAT,i) = zerocol(m+1); continue; }
4140 84665 : if (j != jold || md)
4141 68103 : { v = heckenewtrace(md, mr/d, 1, N, N, mf_get_k(f), j,cache); jold=j; }
4142 84665 : c = RgC_Bd_expand(m0r, mr, v, d, md);
4143 84665 : if (r > 1) c = c_deflate(m-m0, r, c);
4144 84665 : if (M) c = shallowconcat(gel(M,i), c);
4145 84665 : gel(MAT,i) = c;
4146 : }
4147 9282 : return MAT;
4148 : }
4149 :
4150 : /* k > 1 */
4151 : static GEN
4152 3269 : mfinitcusp(long N, long k, GEN CHI, cachenew_t *cache, long space)
4153 : {
4154 : long L, l, lDN1, FC, N1, d1, i, init;
4155 3269 : GEN vS, vMjd, DN1, vmf, CHIP = mfchartoprimitive(CHI, &FC);
4156 :
4157 3269 : d1 = (space == mf_OLD)? mfolddim_i(N, k, CHIP, NULL): mfcuspdim(N, k, CHIP);
4158 3269 : if (!d1) return NULL;
4159 2961 : N1 = N/FC; DN1 = mydivisorsu(N1); lDN1 = lg(DN1);
4160 2961 : init = (space == mf_OLD)? -1: 1;
4161 2961 : vmf = cgetg(lDN1, t_VEC);
4162 17479 : for (i = lDN1 - 1, l = 1; i; i--)
4163 : { /* by decreasing level to allow cache */
4164 14518 : GEN mf = mfnewinit(FC*DN1[i], k, CHIP, cache, init);
4165 14518 : if (mf) gel(vmf, l++) = mf;
4166 14518 : init = 0;
4167 : }
4168 2961 : setlg(vmf,l); vmf = vecreverse(vmf); /* reorder by increasing level */
4169 :
4170 2961 : L = mfsturmNk(N, k)+1;
4171 2961 : vS = vectrunc_init(L);
4172 2961 : vMjd = vectrunc_init(L);
4173 9380 : for (i = 1; i < l; i++)
4174 : {
4175 6419 : GEN DNM, mf = gel(vmf,i), S = MF_get_S(mf), vj = MFnew_get_vj(mf);
4176 6419 : long a, lDNM, lS = lg(S), M = MF_get_N(mf);
4177 6419 : DNM = mydivisorsu(N / M); lDNM = lg(DNM);
4178 26404 : for (a = 1; a < lS; a++)
4179 : {
4180 19985 : GEN tf = gel(S,a);
4181 19985 : long b, j = vj[a];
4182 49553 : for (b = 1; b < lDNM; b++)
4183 : {
4184 29568 : long d = DNM[b];
4185 29568 : vectrunc_append(vS, mfbd_i(tf, d));
4186 29568 : vectrunc_append(vMjd, mkvecsmall3(M, j, d));
4187 : }
4188 : }
4189 : }
4190 2961 : return mkmf(NULL, cgetg(1, t_VEC), vS, vMjd, NULL);
4191 : }
4192 :
4193 : long
4194 4592 : mfsturm_mf(GEN mf)
4195 : {
4196 4592 : GEN Mindex = MF_get_Mindex(mf);
4197 4592 : long n = lg(Mindex)-1;
4198 4592 : return n? Mindex[n]-1: 0;
4199 : }
4200 :
4201 : long
4202 833 : mfsturm(GEN T)
4203 : {
4204 : long N, nk, dk;
4205 833 : GEN CHI, mf = checkMF_i(T);
4206 833 : if (mf) return mfsturm_mf(mf);
4207 7 : checkNK2(T, &N, &nk, &dk, &CHI, 0);
4208 7 : return dk == 1 ? mfsturmNk(N, nk) : mfsturmNk(N, (nk + 1) >> 1);
4209 : }
4210 : long
4211 196 : mfisequal(GEN F, GEN G, long lim)
4212 : {
4213 196 : pari_sp av = avma;
4214 : long b;
4215 196 : if (!checkmf_i(F)) pari_err_TYPE("mfisequal",F);
4216 196 : if (!checkmf_i(G)) pari_err_TYPE("mfisequal",G);
4217 196 : b = lim? lim: maxss(mfsturmmf(F), mfsturmmf(G));
4218 196 : return gc_long(av, gequal(mfcoefs_i(F, b, 1), mfcoefs_i(G, b, 1)));
4219 : }
4220 :
4221 : GEN
4222 35 : mffields(GEN mf)
4223 : {
4224 35 : if (checkmf_i(mf)) return gcopy(mf_get_field(mf));
4225 35 : mf = checkMF(mf); return gcopy(MF_get_fields(mf));
4226 : }
4227 :
4228 : GEN
4229 364 : mfeigenbasis(GEN mf)
4230 : {
4231 364 : pari_sp ltop = avma;
4232 : GEN F, S, v, vP;
4233 : long i, l, k, dS;
4234 :
4235 364 : mf = checkMF(mf);
4236 364 : k = MF_get_k(mf);
4237 364 : S = MF_get_S(mf); dS = lg(S)-1;
4238 364 : if (!dS) return cgetg(1, t_VEC);
4239 357 : F = MF_get_newforms(mf);
4240 357 : vP = MF_get_fields(mf);
4241 357 : if (k == 1)
4242 : {
4243 210 : if (MF_get_space(mf) == mf_FULL)
4244 : {
4245 14 : long dE = lg(MF_get_E(mf)) - 1;
4246 14 : if (dE) F = rowslice(F, dE+1, dE+dS);
4247 : }
4248 210 : v = vecmflineardiv_linear(S, F);
4249 210 : l = lg(v);
4250 : }
4251 : else
4252 : {
4253 147 : GEN (*L)(GEN, GEN) = (MF_get_space(mf) == mf_FULL)? mflinear: mflinear_bhn;
4254 147 : l = lg(F); v = cgetg(l, t_VEC);
4255 511 : for (i = 1; i < l; i++) gel(v,i) = L(mf, gel(F,i));
4256 : }
4257 945 : for (i = 1; i < l; i++) mf_setfield(gel(v,i), gel(vP,i));
4258 357 : return gc_GEN(ltop, v);
4259 : }
4260 :
4261 : /* Minv = [M, d, A], v a t_COL; A a Zab, d a t_INT; return (A/d) * M*v */
4262 : static GEN
4263 7938 : Minv_RgC_mul(GEN Minv, GEN v)
4264 : {
4265 7938 : GEN M = gel(Minv,1), d = gel(Minv,2), A = gel(Minv,3);
4266 7938 : v = RgM_RgC_mul(M, v);
4267 7938 : if (!equali1(A))
4268 : {
4269 2072 : if (typ(A) == t_POL && degpol(A) > 0) A = mkpolmod(A, gel(Minv,4));
4270 2072 : v = RgC_Rg_mul(v, A);
4271 : }
4272 7938 : if (!equali1(d)) v = RgC_Rg_div(v, d);
4273 7938 : return v;
4274 : }
4275 : static GEN
4276 1309 : Minv_RgM_mul(GEN Minv, GEN B)
4277 : {
4278 1309 : long j, l = lg(B);
4279 1309 : GEN M = cgetg(l, t_MAT);
4280 6090 : for (j = 1; j < l; j++) gel(M,j) = Minv_RgC_mul(Minv, gel(B,j));
4281 1309 : return M;
4282 : }
4283 : /* B * Minv; allow B = NULL for Id */
4284 : static GEN
4285 2450 : RgM_Minv_mul(GEN B, GEN Minv)
4286 : {
4287 2450 : GEN M = gel(Minv,1), d = gel(Minv,2), A = gel(Minv,3);
4288 2450 : if (B) M = RgM_mul(B, M);
4289 2450 : if (!equali1(A))
4290 : {
4291 980 : if (typ(A) == t_POL) A = mkpolmod(A, gel(Minv,4));
4292 980 : M = RgM_Rg_mul(M, A);
4293 : }
4294 2450 : if (!equali1(d)) M = RgM_Rg_div(M,d);
4295 2450 : return M;
4296 : }
4297 :
4298 : /* perm vector of strictly increasing indices, v a vector or arbitrary length;
4299 : * the last r entries of perm fall beyond v.
4300 : * Return v o perm[1..(-r)], discarding the last r entries of v */
4301 : static GEN
4302 1610 : vecpermute_partial(GEN v, GEN perm, long *r)
4303 : {
4304 1610 : long i, n = lg(v)-1, l = lg(perm);
4305 : GEN w;
4306 1610 : if (perm[l-1] <= n) { *r = 0; return vecpermute(v,perm); }
4307 63 : for (i = 1; i < l; i++)
4308 63 : if (perm[i] > n) break;
4309 21 : *r = l - i; l = i;
4310 21 : w = cgetg(l, typ(v));
4311 63 : for (i = 1; i < l; i++) gel(w,i) = gel(v,perm[i]);
4312 21 : return w;
4313 : }
4314 :
4315 : /* given form F, find coeffs of F on mfbasis(mf). If power series, not
4316 : * guaranteed correct if precision less than Sturm bound */
4317 : static GEN
4318 1449 : mftobasis_i(GEN mf, GEN F)
4319 : {
4320 : GEN v, Mindex, Minv;
4321 1449 : if (!MF_get_dim(mf)) return cgetg(1, t_COL);
4322 1449 : Mindex = MF_get_Mindex(mf);
4323 1449 : Minv = MF_get_Minv(mf);
4324 1449 : if (checkmf_i(F))
4325 : {
4326 294 : long n = Mindex[lg(Mindex)-1];
4327 294 : v = vecpermute(mfcoefs_i(F, n, 1), Mindex);
4328 294 : return Minv_RgC_mul(Minv, v);
4329 : }
4330 : else
4331 : {
4332 1155 : GEN A = gel(Minv,1), d = gel(Minv,2);
4333 : long r;
4334 1155 : v = F;
4335 1155 : switch(typ(F))
4336 : {
4337 0 : case t_SER: v = sertocol(v);
4338 1155 : case t_VEC: case t_COL: break;
4339 0 : default: pari_err_TYPE("mftobasis", F);
4340 : }
4341 1155 : if (lg(v) == 1) pari_err_TYPE("mftobasis",v);
4342 1155 : v = vecpermute_partial(v, Mindex, &r);
4343 1155 : if (!r) return Minv_RgC_mul(Minv, v); /* single solution */
4344 : /* affine space of dimension r */
4345 21 : v = RgM_RgC_mul(vecslice(A, 1, lg(v)-1), v);
4346 21 : if (!equali1(d)) v = RgC_Rg_div(v,d);
4347 21 : return mkvec2(v, vecslice(A, lg(A)-r, lg(A)-1));
4348 : }
4349 : }
4350 :
4351 : static GEN
4352 910 : const_mat(long n, GEN x)
4353 : {
4354 910 : long j, l = n+1;
4355 910 : GEN A = cgetg(l,t_MAT);
4356 6902 : for (j = 1; j < l; j++) gel(A,j) = const_col(n, x);
4357 910 : return A;
4358 : }
4359 :
4360 : /* L is the mftobasis of a form on CUSP space. We allow mf_FULL or mf_CUSP */
4361 : static GEN
4362 455 : mftonew_i(GEN mf, GEN L, long *plevel)
4363 : {
4364 : GEN S, listMjd, CHI, res, Aclos, Acoef, D, perm;
4365 455 : long N1, LC, lD, i, l, t, level, N = MF_get_N(mf);
4366 :
4367 455 : if (MF_get_k(mf) == 1) pari_err_IMPL("mftonew in weight 1");
4368 455 : listMjd = MFcusp_get_vMjd(mf);
4369 455 : CHI = MF_get_CHI(mf); LC = mfcharconductor(CHI);
4370 455 : S = MF_get_S(mf);
4371 :
4372 455 : N1 = N/LC;
4373 455 : D = mydivisorsu(N1); lD = lg(D);
4374 455 : perm = cgetg(N1+1, t_VECSMALL);
4375 3451 : for (i = 1; i < lD; i++) perm[D[i]] = i;
4376 455 : Aclos = const_mat(lD-1, cgetg(1,t_VEC));
4377 455 : Acoef = const_mat(lD-1, cgetg(1,t_VEC));
4378 455 : l = lg(listMjd);
4379 4669 : for (i = 1; i < l; i++)
4380 : {
4381 : long M, d;
4382 : GEN v;
4383 4214 : if (gequal0(gel(L,i))) continue;
4384 469 : v = gel(listMjd, i);
4385 469 : M = perm[ v[1]/LC ];
4386 469 : d = perm[ v[3] ];
4387 469 : gcoeff(Aclos,M,d) = vec_append(gcoeff(Aclos,M,d), gel(S,i));
4388 469 : gcoeff(Acoef,M,d) = shallowconcat(gcoeff(Acoef,M,d), gel(L,i));
4389 : }
4390 455 : res = cgetg(l, t_VEC); level = 1;
4391 3451 : for (i = t = 1; i < lD; i++)
4392 : {
4393 2996 : long j, M = D[i]*LC;
4394 2996 : GEN gM = utoipos(M);
4395 26530 : for (j = 1; j < lD; j++)
4396 : {
4397 23534 : GEN vf = gcoeff(Aclos,i,j), C, NK;
4398 : long d;
4399 23534 : if (lg(vf) == 1) continue;
4400 427 : d = D[j];
4401 427 : C = gcoeff(Acoef,i,j);
4402 427 : NK = mf_get_NK(gel(vf, 1));
4403 427 : if (d > 1)
4404 : { /* remove mfbd(, d) wrappers */
4405 175 : long h, lf = lg(vf);
4406 357 : for (h = 1; h < lf; h++)
4407 : {
4408 182 : GEN fd = gel(vf, h);
4409 182 : if (mf_get_type(fd) != t_MF_BD || !equaliu(gel(fd,3), d))
4410 0 : pari_err_BUG("mftonew [inconsistent multiplier]");
4411 182 : gel(vf, h) = gel(fd, 2);
4412 : }
4413 : }
4414 427 : level = ulcm(level, M*d);
4415 427 : gel(res,t++) = mkvec3(gM, utoipos(d), mflinear_i(NK,vf,C));
4416 : }
4417 : }
4418 455 : if (plevel) *plevel = level;
4419 455 : setlg(res, t); return res;
4420 : }
4421 : GEN
4422 217 : mftonew(GEN mf, GEN F)
4423 : {
4424 217 : pari_sp av = avma;
4425 : GEN ES;
4426 : long s;
4427 217 : mf = checkMF(mf);
4428 217 : s = MF_get_space(mf);
4429 217 : if (s != mf_FULL && s != mf_CUSP)
4430 7 : pari_err_TYPE("mftonew [not a full or cuspidal space]", mf);
4431 210 : ES = mftobasisES(mf,F);
4432 203 : if (!gequal0(gel(ES,1)))
4433 0 : pari_err_TYPE("mftonew [not a cuspidal form]", F);
4434 203 : F = gel(ES,2);
4435 203 : return gc_GEN(av, mftonew_i(mf,F, NULL));
4436 : }
4437 :
4438 : static GEN mfeisenstein_i(long k, GEN CHI1, GEN CHI2);
4439 :
4440 : /* mfinit(F * Theta) */
4441 : static GEN
4442 98 : mf2init(GEN mf)
4443 : {
4444 98 : GEN CHI = MF_get_CHI(mf), gk = gadd(MF_get_gk(mf), ghalf);
4445 98 : long N = MF_get_N(mf);
4446 98 : return mfinit_Nkchi(N, itou(gk), mfchiadjust(CHI, gk, N), mf_FULL, 0);
4447 : }
4448 :
4449 : static long
4450 637 : mfvec_first_cusp(GEN v)
4451 : {
4452 637 : long i, l = lg(v);
4453 1533 : for (i = 1; i < l; i++)
4454 : {
4455 1428 : GEN F = gel(v,i);
4456 1428 : long t = mf_get_type(F);
4457 1428 : if (t == t_MF_BD) { F = gel(F,2); t = mf_get_type(F); }
4458 1428 : if (t == t_MF_HECKE) { F = gel(F,3); t = mf_get_type(F); }
4459 1428 : if (t == t_MF_NEWTRACE) break;
4460 : }
4461 637 : return i;
4462 : }
4463 : /* vF a vector of mf F of type DIV(LINEAR(BAS,L), f) in (lcm) level N,
4464 : * F[2]=LINEAR(BAS,L), F[2][2]=BAS=fixed basis (Eisenstein or bhn type),
4465 : * F[2][3]=L, F[3]=f; mfvectomat(vF, n) */
4466 : static GEN
4467 644 : mflineardivtomat(long N, GEN vF, long n)
4468 : {
4469 644 : GEN F, M, f, fc, ME, dB, B, a0, V = NULL;
4470 644 : long lM, lF = lg(vF), j;
4471 :
4472 644 : if (lF == 1) return cgetg(1,t_MAT);
4473 637 : F = gel(vF,1);
4474 637 : if (lg(F) == 5)
4475 : { /* chicompat */
4476 273 : V = gmael(F,4,4);
4477 273 : if (typ(V) == t_INT) V = NULL;
4478 : }
4479 637 : M = gmael(F,2,2); /* BAS */
4480 637 : lM = lg(M);
4481 637 : j = mfvec_first_cusp(M);
4482 637 : if (j == 1) ME = NULL;
4483 : else
4484 : { /* BAS starts by Eisenstein */
4485 161 : ME = mfvectomat(vecslice(M,1,j-1), n, 1);
4486 161 : M = vecslice(M, j,lM-1);
4487 : }
4488 637 : M = bhnmat_extend_nocache(NULL, N, n, 1, M);
4489 637 : if (ME) M = shallowconcat(ME,M);
4490 : /* M = mfcoefs of BAS */
4491 637 : B = cgetg(lF, t_MAT);
4492 637 : dB= cgetg(lF, t_VEC);
4493 3157 : for (j = 1; j < lF; j++)
4494 : {
4495 2520 : GEN g = gel(vF, j); /* t_MF_DIV */
4496 2520 : gel(B,j) = RgM_RgC_mul(M, gmael(g,2,3));
4497 2520 : gel(dB,j)= gmael(g,2,4);
4498 : }
4499 637 : f = mfcoefsser(gel(F,3),n);
4500 637 : a0 = polcoef_i(f, 0, -1);
4501 637 : if (gequal0(a0) || gequal1(a0))
4502 336 : a0 = NULL;
4503 : else
4504 301 : f = gdiv(ser_unscale(f, a0), a0);
4505 637 : fc = ginv(f);
4506 3157 : for (j = 1; j < lF; j++)
4507 : {
4508 2520 : pari_sp av = avma;
4509 2520 : GEN LISer = RgV_to_ser_full(gel(B,j)), f;
4510 2520 : if (a0) LISer = gdiv(ser_unscale(LISer, a0), a0);
4511 2520 : f = gmul(LISer, fc);
4512 2520 : if (a0) f = ser_unscale(f, ginv(a0));
4513 2520 : f = sertocol(f); setlg(f, n+2);
4514 2520 : if (!gequal1(gel(dB,j))) f = RgC_Rg_div(f, gel(dB,j));
4515 2520 : gel(B,j) = gc_upto(av,f);
4516 : }
4517 637 : if (V) B = gmodulo(QabM_tracerel(V, 0, B), gel(V,1));
4518 637 : return B;
4519 : }
4520 :
4521 : static GEN
4522 350 : mfheckemat_mfcoefs(GEN mf, GEN B, GEN DATA)
4523 : {
4524 350 : GEN Mindex = MF_get_Mindex(mf), Minv = MF_get_Minv(mf);
4525 350 : long j, l = lg(B), sb = mfsturm_mf(mf);
4526 350 : GEN b = MF_get_basis(mf), Q = cgetg(l, t_VEC);
4527 1827 : for (j = 1; j < l; j++)
4528 : {
4529 1477 : GEN v = hecke_i(sb, 1, gel(B,j), gel(b,j), DATA); /* Tn b[j] */
4530 1477 : settyp(v,t_COL); gel(Q,j) = vecpermute(v, Mindex);
4531 : }
4532 350 : return Minv_RgM_mul(Minv,Q);
4533 : }
4534 : /* T_p^2, p prime, 1/2-integral weight; B = mfcoefs(mf,sb*p^2,1) or (mf,sb,p^2)
4535 : * if p|N */
4536 : static GEN
4537 7 : mfheckemat_mfcoefs_p2(GEN mf, long p, GEN B)
4538 : {
4539 7 : pari_sp av = avma;
4540 7 : GEN DATA = heckef2_data(MF_get_N(mf), p*p);
4541 7 : return gc_upto(av, mfheckemat_mfcoefs(mf, B, DATA));
4542 : }
4543 : /* convert Mindex from row-index to mfcoef indexation: a(n) is stored in
4544 : * mfcoefs()[n+1], so subtract 1 from all indices */
4545 : static GEN
4546 49 : Mindex_as_coef(GEN mf)
4547 : {
4548 49 : GEN v, Mindex = MF_get_Mindex(mf);
4549 49 : long i, l = lg(Mindex);
4550 49 : v = cgetg(l, t_VECSMALL);
4551 210 : for (i = 1; i < l; i++) v[i] = Mindex[i]-1;
4552 49 : return v;
4553 : }
4554 : /* T_p, p prime; B = mfcoefs(mf,sb*p,1) or (mf,sb,p) if p|N; integral weight */
4555 : static GEN
4556 35 : mfheckemat_mfcoefs_p(GEN mf, long p, GEN B)
4557 : {
4558 35 : pari_sp av = avma;
4559 35 : GEN vm, Q, C, Minv = MF_get_Minv(mf);
4560 35 : long lm, k, i, j, l = lg(B), N = MF_get_N(mf);
4561 :
4562 35 : if (N % p == 0) return Minv_RgM_mul(Minv, rowpermute(B, MF_get_Mindex(mf)));
4563 21 : k = MF_get_k(mf);
4564 21 : C = gmul(mfchareval(MF_get_CHI(mf), p), powuu(p, k-1));
4565 21 : vm = Mindex_as_coef(mf); lm = lg(vm);
4566 21 : Q = cgetg(l, t_MAT);
4567 147 : for (j = 1; j < l; j++) gel(Q,j) = cgetg(lm, t_COL);
4568 147 : for (i = 1; i < lm; i++)
4569 : {
4570 126 : long m = vm[i], mp = m*p;
4571 126 : GEN Cm = (m % p) == 0? C : NULL;
4572 1260 : for (j = 1; j < l; j++)
4573 : {
4574 1134 : GEN S = gel(B,j), s = gel(S, mp + 1);
4575 1134 : if (Cm) s = gadd(s, gmul(C, gel(S, m/p + 1)));
4576 1134 : gcoeff(Q, i, j) = s;
4577 : }
4578 : }
4579 21 : return gc_upto(av, Minv_RgM_mul(Minv,Q));
4580 : }
4581 : /* Matrix of T(p), p prime, dim(mf) > 0 and integral weight */
4582 : static GEN
4583 343 : mfheckemat_p(GEN mf, long p)
4584 : {
4585 343 : pari_sp av = avma;
4586 343 : long N = MF_get_N(mf), sb = mfsturm_mf(mf);
4587 343 : GEN B = (N % p)? mfcoefs_mf(mf, sb * p, 1): mfcoefs_mf(mf, sb, p);
4588 343 : return gc_upto(av, mfheckemat_mfcoefs(mf, B, hecke_data(N,p)));
4589 : }
4590 :
4591 : /* mf_NEW != (0), weight > 1, p prime. Use
4592 : * T(p) T(j) = T(j*p) + p^{k-1} \chi(p) 1_{p | j, p \nmid N} T(j/p) */
4593 : static GEN
4594 924 : mfnewmathecke_p(GEN mf, long p)
4595 : {
4596 924 : pari_sp av = avma;
4597 924 : GEN tf, vj = MFnew_get_vj(mf), CHI = MF_get_CHI(mf);
4598 924 : GEN Mindex = MF_get_Mindex(mf), Minv = MF_get_Minv(mf);
4599 924 : long N = MF_get_N(mf), k = MF_get_k(mf);
4600 924 : long i, j, lvj = lg(vj), lim = vj[lvj-1] * p;
4601 924 : GEN M, perm, V, need = zero_zv(lim);
4602 924 : GEN C = (N % p)? gmul(mfchareval(CHI,p), powuu(p,k-1)): NULL;
4603 924 : tf = mftraceform_new(N, k, CHI);
4604 4004 : for (i = 1; i < lvj; i++)
4605 : {
4606 3080 : j = vj[i]; need[j*p] = 1;
4607 3080 : if (N % p && j % p == 0) need[j/p] = 1;
4608 : }
4609 924 : perm = zero_zv(lim);
4610 924 : V = cgetg(lim+1, t_VEC);
4611 12754 : for (i = j = 1; i <= lim; i++)
4612 11830 : if (need[i]) { gel(V,j) = mfhecke_i(i, N, tf); perm[i] = j; j++; }
4613 924 : setlg(V, j);
4614 924 : V = bhnmat_extend_nocache(NULL, N, mfsturm_mf(mf), 1, V);
4615 924 : V = rowpermute(V, Mindex); /* V[perm[i]] = coeffs(T_i newtrace) */
4616 924 : M = cgetg(lvj, t_MAT);
4617 4004 : for (i = 1; i < lvj; i++)
4618 : {
4619 : GEN t;
4620 3080 : j = vj[i]; t = gel(V, perm[j*p]);
4621 3080 : if (C && j % p == 0) t = RgC_add(t, RgC_Rg_mul(gel(V, perm[j/p]),C));
4622 3080 : gel(M,i) = t;
4623 : }
4624 924 : return gc_upto(av, Minv_RgM_mul(Minv, M));
4625 : }
4626 :
4627 : GEN
4628 77 : mfheckemat(GEN mf, GEN vn)
4629 : {
4630 77 : pari_sp av = avma;
4631 77 : long lv, lvP, i, N, dim, nk, dk, p, sb, flint = (typ(vn)==t_INT);
4632 : GEN CHI, res, vT, FA, B, vP;
4633 :
4634 77 : mf = checkMF(mf);
4635 77 : if (typ(vn) != t_VECSMALL) vn = gtovecsmall(vn);
4636 77 : N = MF_get_N(mf); CHI = MF_get_CHI(mf); Qtoss(MF_get_gk(mf), &nk, &dk);
4637 77 : dim = MF_get_dim(mf);
4638 77 : lv = lg(vn);
4639 77 : res = cgetg(lv, t_VEC);
4640 77 : FA = cgetg(lv, t_VEC);
4641 77 : vP = cgetg(lv, t_VEC);
4642 77 : vT = const_vec(vecsmall_max(vn), NULL);
4643 182 : for (i = 1; i < lv; i++)
4644 : {
4645 105 : ulong n = (ulong)labs(vn[i]);
4646 : GEN fa;
4647 105 : if (!n) pari_err_TYPE("mfheckemat", vn);
4648 105 : if (dk == 1 || uissquareall(n, &n)) fa = myfactoru(n);
4649 0 : else { n = 0; fa = myfactoru(1); } /* dummy: T_{vn[i]} = 0 */
4650 105 : vn[i] = n;
4651 105 : gel(FA,i) = fa;
4652 105 : gel(vP,i) = gel(fa,1);
4653 : }
4654 77 : vP = shallowconcat1(vP); vecsmall_sort(vP);
4655 77 : vP = vecsmall_uniq_sorted(vP); /* all primes occurring in vn */
4656 77 : lvP = lg(vP); if (lvP == 1) goto END;
4657 56 : p = vP[lvP-1];
4658 56 : sb = mfsturm_mf(mf);
4659 56 : if (dk == 1 && nk != 1 && MF_get_space(mf) == mf_NEW)
4660 21 : B = NULL; /* special purpose mfnewmathecke_p is faster */
4661 35 : else if (lvP == 2 && N % p == 0)
4662 21 : B = mfcoefs_mf(mf, sb, dk==2? p*p: p); /* single prime | N, can optimize */
4663 : else
4664 14 : B = mfcoefs_mf(mf, sb * (dk==2? p*p: p), 1); /* general initialization */
4665 126 : for (i = 1; i < lvP; i++)
4666 : {
4667 70 : long j, l, q, e = 1;
4668 : GEN C, Tp, u1, u0;
4669 70 : p = vP[i];
4670 189 : for (j = 1; j < lv; j++) e = maxss(e, z_lval(vn[j], p));
4671 70 : if (!B)
4672 28 : Tp = mfnewmathecke_p(mf, p);
4673 42 : else if (dk == 2)
4674 7 : Tp = mfheckemat_mfcoefs_p2(mf,p, (lvP==2||N%p)? B: matdeflate(sb,p*p,B));
4675 : else
4676 35 : Tp = mfheckemat_mfcoefs_p(mf, p, (lvP==2||N%p)? B: matdeflate(sb,p,B));
4677 70 : gel(vT, p) = Tp;
4678 70 : if (e == 1) continue;
4679 14 : u0 = gen_1;
4680 14 : if (dk == 2)
4681 : {
4682 0 : C = N % p? gmul(mfchareval(CHI,p*p), powuu(p, nk-2)): NULL;
4683 0 : if (e == 2) u0 = uutoQ(p+1,p); /* special case T_{p^4} */
4684 : }
4685 : else
4686 14 : C = N % p? gmul(mfchareval(CHI,p), powuu(p, nk-1)): NULL;
4687 28 : for (u1=Tp, q=p, l=2; l <= e; l++)
4688 : { /* u0 = T_{p^{l-2}}, u1 = T_{p^{l-1}} for l > 2 */
4689 14 : GEN v = gmul(Tp, u1);
4690 14 : if (C) v = gsub(v, gmul(C, u0));
4691 : /* q = p^l, vT[q] = T_q for k integer else T_{q^2} */
4692 14 : q *= p; u0 = u1; gel(vT, q) = u1 = v;
4693 : }
4694 : }
4695 56 : END:
4696 : /* vT[p^e] = T_{p^e} for all p^e occurring below */
4697 182 : for (i = 1; i < lv; i++)
4698 : {
4699 105 : long n = vn[i], j, lP;
4700 : GEN fa, P, E, M;
4701 105 : if (n == 0) { gel(res,i) = zeromat(dim,dim); continue; }
4702 105 : if (n == 1) { gel(res,i) = matid(dim); continue; }
4703 77 : fa = gel(FA,i);
4704 77 : P = gel(fa,1); lP = lg(P);
4705 77 : E = gel(fa,2); M = gel(vT, upowuu(P[1], E[1]));
4706 84 : for (j = 2; j < lP; j++) M = RgM_mul(M, gel(vT, upowuu(P[j], E[j])));
4707 77 : gel(res,i) = M;
4708 : }
4709 77 : if (flint) res = gel(res,1);
4710 77 : return gc_GEN(av, res);
4711 : }
4712 :
4713 : /* f = \sum_i v[i] T_listj[i] (Trace Form) attached to v; replace by f/a_1(f) */
4714 : static GEN
4715 1540 : mf_normalize(GEN mf, GEN v)
4716 : {
4717 1540 : GEN c, dc = NULL, M = MF_get_M(mf), Mindex = MF_get_Mindex(mf);
4718 1540 : v = Q_primpart(v);
4719 1540 : c = RgMrow_RgC_mul(M, v, 2); /* a_1(f) */
4720 1540 : if (gequal1(c)) return v;
4721 945 : if (typ(c) == t_POL) c = gmodulo(c, mfcharpol(MF_get_CHI(mf)));
4722 945 : if (typ(c) == t_POLMOD && varn(gel(c,1)) == 1 && degpol(gel(c,1)) >= 40
4723 7 : && Mindex[1] == 2
4724 7 : && mfcharorder(MF_get_CHI(mf)) <= 2)
4725 7 : { /* normalize using expansion at infinity (small coefficients) */
4726 7 : GEN w, P = gel(c,1), a1 = gel(c,2);
4727 7 : long i, l = lg(Mindex);
4728 7 : w = cgetg(l, t_COL);
4729 7 : gel(w,1) = gen_1;
4730 280 : for (i = 2; i < l; i++)
4731 : {
4732 273 : c = liftpol_shallow(RgMrow_RgC_mul(M, v, Mindex[i]));
4733 273 : gel(w,i) = QXQ_div(c, a1, P);
4734 : }
4735 : /* w = expansion at oo of normalized form */
4736 7 : v = Minv_RgC_mul(MF_get_Minv(mf), Q_remove_denom(w, &dc));
4737 7 : v = gmodulo(v, P); /* back to mfbasis coefficients */
4738 : }
4739 : else
4740 : {
4741 938 : c = ginv(c);
4742 938 : if (typ(c) == t_POLMOD) c = Q_remove_denom(c, &dc);
4743 938 : v = RgC_Rg_mul(v, c);
4744 : }
4745 945 : if (dc) v = RgC_Rg_div(v, dc);
4746 945 : return v;
4747 : }
4748 : static void
4749 455 : pol_red(GEN NF, GEN *pP, GEN *pa, long flag)
4750 : {
4751 455 : GEN dP, a, P = *pP;
4752 455 : long d = degpol(P);
4753 :
4754 455 : *pa = a = pol_x(varn(P));
4755 455 : if (d * (NF ? nf_get_degree(NF): 1) > 30) return;
4756 :
4757 448 : dP = RgX_disc(P);
4758 448 : if (typ(dP) != t_INT)
4759 112 : { dP = gnorm(dP); if (typ(dP) != t_INT) pari_err_BUG("mfnewsplit"); }
4760 448 : if (d == 2 || expi(dP) < 62)
4761 : {
4762 413 : if (expi(dP) < 31)
4763 406 : P = NF? rnfpolredabs(NF, P,flag): polredabs0(P,flag);
4764 : else
4765 7 : P = NF? rnfpolredbest(NF,P,flag): polredbest(P,flag);
4766 413 : if (flag)
4767 : {
4768 385 : a = gel(P,2); if (typ(a) == t_POLMOD) a = gel(a,2);
4769 385 : P = gel(P,1);
4770 : }
4771 : }
4772 448 : *pP = P;
4773 448 : *pa = a;
4774 : }
4775 :
4776 : /* Diagonalize and normalize. See mfsplit for meaning of flag. */
4777 : static GEN
4778 1092 : mfspclean(GEN mf, GEN mf0, GEN NF, long ord, GEN simplesp, long flag)
4779 : {
4780 1092 : const long vz = 1;
4781 1092 : long i, l = lg(simplesp), dim = MF_get_dim(mf);
4782 1092 : GEN res = cgetg(l, t_MAT), pols = cgetg(l, t_VEC);
4783 1092 : GEN zeros = (mf == mf0)? NULL: zerocol(dim - MF_get_dim(mf0));
4784 2660 : for (i = 1; i < l; i++)
4785 : {
4786 1568 : GEN ATP = gel(simplesp, i), A = gel(ATP,1), P = gel(ATP,3);
4787 1568 : long d = degpol(P);
4788 1568 : GEN a, v = (flag && d > flag)? NULL: gel(A,1);
4789 1568 : if (d == 1) P = pol_x(vz);
4790 : else
4791 : {
4792 455 : pol_red(NF, &P, &a, !!v);
4793 455 : if (v)
4794 : { /* Mod(a,P) root of charpoly(T), K*gpowers(a) = eigenvector of T */
4795 427 : GEN K, den, M = cgetg(d+1, t_MAT), T = gel(ATP,2);
4796 : long j;
4797 427 : T = shallowtrans(T);
4798 427 : gel(M,1) = vec_ei(d,1); /* basis of cyclic vectors */
4799 1372 : for (j = 2; j <= d; j++) gel(M,j) = RgM_RgC_mul(T, gel(M,j-1));
4800 427 : M = Q_primpart(M);
4801 147 : K = NF? ZabM_inv(liftpol_shallow(M), nf_get_pol(NF), ord, &den)
4802 427 : : ZM_inv(M,&den);
4803 427 : K = shallowtrans(K);
4804 427 : v = gequalX(a)? pol_x_powers(d, vz): RgXQ_powers(a, d-1, P);
4805 427 : v = gmodulo(RgM_RgC_mul(A, RgM_RgC_mul(K,v)), P);
4806 : }
4807 : }
4808 1568 : if (v)
4809 : {
4810 1540 : v = mf_normalize(mf0, v); if (zeros) v = shallowconcat(zeros,v);
4811 1540 : gel(res,i) = v; if (flag) setlg(res,i+1);
4812 : }
4813 : else
4814 28 : gel(res,i) = zerocol(dim);
4815 1568 : gel(pols,i) = P;
4816 : }
4817 1092 : return mkvec2(res, pols);
4818 : }
4819 :
4820 : /* return v = v_{X-r}(P), and set Z = P / (X-r)^v */
4821 : static long
4822 70 : RgX_valrem_root(GEN P, GEN r, GEN *Z)
4823 : {
4824 : long v;
4825 140 : for (v = 0; degpol(P); v++)
4826 : {
4827 140 : GEN t, Q = RgX_div_by_X_x(P, r, &t);
4828 140 : if (!gequal0(t)) break;
4829 70 : P = Q;
4830 : }
4831 70 : *Z = P; return v;
4832 : }
4833 : static GEN
4834 1533 : mynffactor(GEN NF, GEN P, long dimlim)
4835 : {
4836 : long i, l, v;
4837 : GEN R, E;
4838 1533 : if (dimlim != 1)
4839 : {
4840 966 : R = NF? nffactor(NF, P): QX_factor(P);
4841 966 : if (!dimlim) return R;
4842 21 : E = gel(R,2);
4843 21 : R = gel(R,1); l = lg(R);
4844 98 : for (i = 1; i < l; i++)
4845 91 : if (degpol(gel(R,i)) > dimlim) break;
4846 21 : if (i == 1) return NULL;
4847 21 : setlg(E,i);
4848 21 : setlg(R,i); return mkmat2(R, E);
4849 : }
4850 : /* dimlim = 1 */
4851 567 : R = nfroots(NF, P); l = lg(R);
4852 567 : if (l == 1) return NULL;
4853 504 : v = varn(P);
4854 504 : settyp(R, t_COL);
4855 504 : if (degpol(P) == l-1)
4856 448 : E = const_col(l-1, gen_1);
4857 : else
4858 : {
4859 56 : E = cgetg(l, t_COL);
4860 126 : for (i = 1; i < l; i++) gel(E,i) = utoi(RgX_valrem_root(P, gel(R,i), &P));
4861 : }
4862 504 : R = deg1_from_roots(R, v);
4863 504 : return mkmat2(R, E);
4864 : }
4865 :
4866 : /* Let K be a number field attached to NF (Q if NF = NULL). A K-vector
4867 : * space of dimension d > 0 is given by a t_MAT A (n x d, full column rank)
4868 : * giving a K-basis, X a section (d x n: left pseudo-inverse of A). Return a
4869 : * pair (T, fa), where T is an element of the Hecke algebra (a sum of Tp taken
4870 : * from vector vTp) acting on A (a d x d t_MAT) and fa is the factorization of
4871 : * its characteristic polynomial, limited to factors of degree <= dimlim if
4872 : * dimlim != 0 (return NULL if there are no factors of degree <= dimlim) */
4873 : static GEN
4874 1358 : findbestsplit(GEN NF, GEN vTp, GEN A, GEN X, long dimlim, long vz)
4875 : {
4876 1358 : GEN T = NULL, Tkeep = NULL, fakeep = NULL;
4877 1358 : long lmax = 0, i, lT = lg(vTp);
4878 1785 : for (i = 1; i < lT; i++)
4879 : {
4880 1785 : GEN D, P, E, fa, TpA = gel(vTp,i);
4881 : long l;
4882 2828 : if (typ(TpA) == t_INT) break;
4883 1533 : if (lg(TpA) > lg(A)) TpA = RgM_mul(X, RgM_mul(TpA, A)); /* Tp | A */
4884 1533 : T = T ? RgM_add(T, TpA) : TpA;
4885 1533 : if (!NF) { P = QM_charpoly_ZX(T); setvarn(P, vz); }
4886 : else
4887 : {
4888 294 : P = charpoly(Q_remove_denom(T, &D), vz);
4889 294 : if (D) P = gdiv(RgX_unscale(P, D), powiu(D, degpol(P)));
4890 : }
4891 1533 : fa = mynffactor(NF, P, dimlim);
4892 1533 : if (!fa) return NULL;
4893 1470 : E = gel(fa, 2);
4894 : /* characteristic polynomial is separable ? */
4895 1470 : if (isint1(vecmax(E))) { Tkeep = T; fakeep = fa; break; }
4896 427 : l = lg(E);
4897 : /* characteristic polynomial has more factors than before ? */
4898 427 : if (l > lmax) { lmax = l; Tkeep = T; fakeep = fa; }
4899 : }
4900 1295 : return mkvec2(Tkeep, fakeep);
4901 : }
4902 :
4903 : static GEN
4904 294 : nfcontent(GEN nf, GEN v)
4905 : {
4906 294 : long i, l = lg(v);
4907 294 : GEN c = gel(v,1);
4908 1512 : for (i = 2; i < l; i++) c = idealadd(nf, c, gel(v,i));
4909 294 : if (typ(c) == t_MAT && gequal1(gcoeff(c,1,1))) c = gen_1;
4910 294 : return c;
4911 : }
4912 : static GEN
4913 455 : nf_primpart(GEN nf, GEN x)
4914 : {
4915 455 : switch(typ(x))
4916 : {
4917 294 : case t_COL:
4918 : {
4919 294 : GEN A = matalgtobasis(nf, x), c = nfcontent(nf, A);
4920 294 : if (typ(c) == t_INT) return x;
4921 35 : c = idealred_elt(nf,c);
4922 35 : A = Q_primpart( nfC_nf_mul(nf, A, Q_primpart(nfinv(nf,c))) );
4923 35 : A = liftpol_shallow( matbasistoalg(nf, A) );
4924 35 : if (gexpo(A) > gexpo(x)) A = x;
4925 35 : return A;
4926 : }
4927 455 : case t_MAT: pari_APPLY_same(nf_primpart(nf, gel(x,i)));
4928 0 : default:
4929 0 : pari_err_TYPE("nf_primpart", x);
4930 : return NULL; /*LCOV_EXCL_LINE*/
4931 : }
4932 : }
4933 :
4934 : /* rotate entries of v to accomodate new entry 'x' (push out oldest entry) */
4935 : static void
4936 1239 : vecpush(GEN v, GEN x)
4937 : {
4938 : long i;
4939 6195 : for (i = lg(v)-1; i > 1; i--) gel(v,i) = gel(v,i-1);
4940 1239 : gel(v,1) = x;
4941 1239 : }
4942 :
4943 : /* sort t_VEC of vector spaces by increasing dimension */
4944 : static GEN
4945 1092 : sort_by_dim(GEN v)
4946 : {
4947 1092 : long i, l = lg(v);
4948 1092 : GEN D = cgetg(l, t_VECSMALL);
4949 2660 : for (i = 1; i < l; i++) D[i] = lg(gmael(v,i,2));
4950 1092 : return vecpermute(v, vecsmall_indexsort(D));
4951 : }
4952 : static GEN
4953 1092 : split_starting_space(GEN mf)
4954 : {
4955 1092 : long d = MF_get_dim(mf), d2;
4956 1092 : GEN id = matid(d);
4957 1092 : switch(MF_get_space(mf))
4958 : {
4959 1085 : case mf_NEW:
4960 1085 : case mf_CUSP: return mkvec2(id, id);
4961 : }
4962 7 : d2 = lg(MF_get_S(mf))-1;
4963 7 : return mkvec2(vecslice(id, d-d2+1,d),
4964 : shallowconcat(zeromat(d2,d-d2),matid(d2)));
4965 : }
4966 : /* If dimlim > 0, keep only the dimension <= dimlim eigenspaces.
4967 : * See mfsplit for the meaning of flag. */
4968 : static GEN
4969 1491 : split_ii(GEN mf, long dimlim, long flag, GEN vSP, long *pnewd)
4970 : {
4971 : forprime_t iter;
4972 1491 : GEN CHI = MF_get_CHI(mf), empty = cgetg(1, t_VEC), mf0 = mf;
4973 : GEN NF, POLCYC, todosp, Tpbigvec, simplesp;
4974 1491 : long N = MF_get_N(mf), k = MF_get_k(mf);
4975 1491 : long ord, FC, NEWT, dimsimple = 0, newd = -1;
4976 1491 : const long NBH = 5, vz = 1;
4977 : ulong p;
4978 :
4979 1491 : switch(MF_get_space(mf))
4980 : {
4981 1197 : case mf_NEW: break;
4982 287 : case mf_CUSP:
4983 : case mf_FULL:
4984 : {
4985 : GEN CHIP;
4986 287 : if (k > 1) { mf0 = mfinittonew(mf); break; }
4987 259 : CHIP = mfchartoprimitive(CHI, NULL);
4988 259 : newd = lg(MF_get_S(mf))-1 - mfolddim_i(N, k, CHIP, vSP);
4989 259 : break;
4990 : }
4991 7 : default: pari_err_TYPE("mfsplit [space does not contain newspace]", mf);
4992 : return NULL; /*LCOV_EXCL_LINE*/
4993 : }
4994 1484 : if (newd < 0) newd = mf0? MF_get_dim(mf0): 0;
4995 1484 : *pnewd = newd;
4996 1484 : if (!newd) return mkvec2(cgetg(1, t_MAT), empty);
4997 :
4998 1092 : NEWT = (k > 1 && MF_get_space(mf0) == mf_NEW);
4999 1092 : todosp = mkvec( split_starting_space(mf0) );
5000 1092 : simplesp = empty;
5001 1092 : FC = mfcharconductor(CHI);
5002 1092 : ord = mfcharorder(CHI);
5003 1092 : if (ord <= 2) NF = POLCYC = NULL;
5004 : else
5005 : {
5006 210 : POLCYC = mfcharpol(CHI);
5007 210 : NF = nfinit(POLCYC,DEFAULTPREC);
5008 : }
5009 1092 : Tpbigvec = zerovec(NBH);
5010 1092 : u_forprime_init(&iter, 2, ULONG_MAX);
5011 1526 : while (dimsimple < newd && (p = u_forprime_next(&iter)))
5012 : {
5013 : GEN nextsp;
5014 : long ind;
5015 1526 : if (N % (p*p) == 0 && N/p % FC == 0) continue; /* T_p = 0 in this case */
5016 1239 : vecpush(Tpbigvec, NEWT? mfnewmathecke_p(mf0,p): mfheckemat_p(mf0,p));
5017 1239 : nextsp = empty;
5018 1638 : for (ind = 1; ind < lg(todosp); ind++)
5019 : {
5020 1358 : GEN tmp = gel(todosp, ind), fa, P, E, D, Tp, DTp;
5021 1358 : GEN A = gel(tmp, 1);
5022 1358 : GEN X = gel(tmp, 2);
5023 : long lP, i;
5024 1358 : tmp = findbestsplit(NF, Tpbigvec, A, X, dimlim, vz);
5025 1477 : if (!tmp) continue; /* nothing there */
5026 1295 : Tp = gel(tmp, 1);
5027 1295 : fa = gel(tmp, 2);
5028 1295 : P = gel(fa, 1);
5029 1295 : E = gel(fa, 2); lP = lg(P);
5030 : /* lP > 1 */
5031 1295 : if (DEBUGLEVEL) err_printf("Exponents = %Ps\n", E);
5032 1295 : if (lP == 2)
5033 : {
5034 868 : GEN P1 = gel(P,1);
5035 868 : long e1 = itos(gel(E,1)), d1 = degpol(P1);
5036 868 : if (e1 * d1 == lg(Tp)-1)
5037 : {
5038 819 : if (e1 > 1) nextsp = vec_append(nextsp, mkvec2(A,X));
5039 : else
5040 : { /* simple module */
5041 721 : simplesp = vec_append(simplesp, mkvec3(A,Tp,P1));
5042 980 : if ((dimsimple += d1) == newd) goto END;
5043 : }
5044 119 : continue;
5045 : }
5046 : }
5047 : /* Found splitting */
5048 476 : DTp = Q_remove_denom(Tp, &D);
5049 1295 : for (i = 1; i < lP; i++)
5050 : {
5051 1078 : GEN Ai, Xi, dXi, AAi, v, y, Pi = gel(P,i);
5052 1078 : Ai = RgX_RgM_eval(D? RgX_rescale(Pi,D): Pi, DTp);
5053 1078 : Ai = QabM_ker(Ai, POLCYC, ord);
5054 1078 : if (NF) Ai = nf_primpart(NF, Ai);
5055 :
5056 1078 : AAi = RgM_mul(A, Ai);
5057 : /* gives section, works on nonsquare matrices */
5058 1078 : Xi = QabM_pseudoinv(Ai, POLCYC, ord, &v, &dXi);
5059 1078 : Xi = RgM_Rg_div(Xi, dXi);
5060 1078 : y = gel(v,1);
5061 1078 : if (isint1(gel(E,i)))
5062 : {
5063 847 : GEN Tpi = RgM_mul(Xi, RgM_mul(rowpermute(Tp,y), Ai));
5064 847 : simplesp = vec_append(simplesp, mkvec3(AAi, Tpi, Pi));
5065 847 : if ((dimsimple += degpol(Pi)) == newd) goto END;
5066 : }
5067 : else
5068 : {
5069 231 : Xi = RgM_mul(Xi, rowpermute(X,y));
5070 231 : nextsp = vec_append(nextsp, mkvec2(AAi, Xi));
5071 : }
5072 : }
5073 : }
5074 280 : todosp = nextsp; if (lg(todosp) == 1) break;
5075 : }
5076 0 : END:
5077 1092 : if (DEBUGLEVEL) err_printf("end split, need to clean\n");
5078 1092 : return mfspclean(mf, mf0, NF, ord, sort_by_dim(simplesp), flag);
5079 : }
5080 : static GEN
5081 42 : dim_filter(GEN v, long dim)
5082 : {
5083 42 : GEN P = gel(v,2);
5084 42 : long j, l = lg(P);
5085 175 : for (j = 1; j < l; j++)
5086 161 : if (degpol(gel(P,j)) > dim)
5087 : {
5088 28 : v = mkvec2(vecslice(gel(v,1),1,j-1), vecslice(P,1,j-1));
5089 28 : break;
5090 : }
5091 42 : return v;
5092 : }
5093 : static long
5094 287 : dim_sum(GEN v)
5095 : {
5096 287 : GEN P = gel(v,2);
5097 287 : long j, l = lg(P), d = 0;
5098 707 : for (j = 1; j < l; j++) d += degpol(gel(P,j));
5099 287 : return d;
5100 : }
5101 : static GEN
5102 1169 : split_i(GEN mf, long dimlim, long flag)
5103 1169 : { long junk; return split_ii(mf, dimlim, flag, NULL, &junk); }
5104 : /* mf is either already split or output by mfinit. Splitting is done only for
5105 : * newspace except in weight 1. If flag = 0 (default) split completely.
5106 : * If flag = d > 0, only give the Galois polynomials in degree > d
5107 : * Flag is ignored if dimlim = 1. */
5108 : GEN
5109 112 : mfsplit(GEN mf0, long dimlim, long flag)
5110 : {
5111 112 : pari_sp av = avma;
5112 112 : GEN v, mf = checkMF_i(mf0);
5113 112 : if (!mf) pari_err_TYPE("mfsplit", mf0);
5114 112 : if ((v = obj_check(mf, MF_SPLIT)))
5115 42 : { if (dimlim) v = dim_filter(v, dimlim); }
5116 70 : else if (dimlim && (v = obj_check(mf, MF_SPLITN)))
5117 21 : { v = (itos(gel(v,1)) >= dimlim)? dim_filter(gel(v,2), dimlim): NULL; }
5118 112 : if (!v)
5119 : {
5120 : long newd;
5121 70 : v = split_ii(mf, dimlim, flag, NULL, &newd);
5122 70 : if (lg(v) == 1) obj_insert(mf, MF_SPLITN, mkvec2(utoi(dimlim), v));
5123 70 : else if (!flag)
5124 : {
5125 49 : if (dim_sum(v) == newd) obj_insert(mf, MF_SPLIT,v);
5126 21 : else obj_insert(mf, MF_SPLITN, mkvec2(utoi(dimlim), v));
5127 : }
5128 : }
5129 112 : return gc_GEN(av, v);
5130 : }
5131 : static GEN
5132 252 : split(GEN mf) { return split_i(mf,0,0); }
5133 : GEN
5134 819 : MF_get_newforms(GEN mf) { return gel(obj_checkbuild(mf,MF_SPLIT,&split),1); }
5135 : GEN
5136 616 : MF_get_fields(GEN mf) { return gel(obj_checkbuild(mf,MF_SPLIT,&split),2); }
5137 :
5138 : /*************************************************************************/
5139 : /* Modular forms of Weight 1 */
5140 : /*************************************************************************/
5141 : /* S_1(G_0(N)), small N. Return 1 if definitely empty; return 0 if maybe
5142 : * nonempty */
5143 : static int
5144 16632 : wt1empty(long N)
5145 : {
5146 16632 : if (N <= 100) switch (N)
5147 : { /* nonempty [32/100] */
5148 5453 : case 23: case 31: case 39: case 44: case 46:
5149 : case 47: case 52: case 55: case 56: case 57:
5150 : case 59: case 62: case 63: case 68: case 69:
5151 : case 71: case 72: case 76: case 77: case 78:
5152 : case 79: case 80: case 83: case 84: case 87:
5153 : case 88: case 92: case 93: case 94: case 95:
5154 5453 : case 99: case 100: return 0;
5155 3549 : default: return 1;
5156 : }
5157 7630 : if (N <= 600) switch(N)
5158 : { /* empty [111/500] */
5159 336 : case 101: case 102: case 105: case 106: case 109:
5160 : case 113: case 121: case 122: case 123: case 125:
5161 : case 130: case 134: case 137: case 146: case 149:
5162 : case 150: case 153: case 157: case 162: case 163:
5163 : case 169: case 170: case 173: case 178: case 181:
5164 : case 182: case 185: case 187: case 193: case 194:
5165 : case 197: case 202: case 205: case 210: case 218:
5166 : case 221: case 226: case 233: case 241: case 242:
5167 : case 245: case 246: case 250: case 257: case 265:
5168 : case 267: case 269: case 274: case 277: case 281:
5169 : case 289: case 293: case 298: case 305: case 306:
5170 : case 313: case 314: case 317: case 326: case 337:
5171 : case 338: case 346: case 349: case 353: case 361:
5172 : case 362: case 365: case 369: case 370: case 373:
5173 : case 374: case 377: case 386: case 389: case 394:
5174 : case 397: case 401: case 409: case 410: case 421:
5175 : case 425: case 427: case 433: case 442: case 449:
5176 : case 457: case 461: case 466: case 481: case 482:
5177 : case 485: case 490: case 493: case 509: case 514:
5178 : case 521: case 530: case 533: case 534: case 538:
5179 : case 541: case 545: case 554: case 557: case 562:
5180 : case 565: case 569: case 577: case 578: case 586:
5181 336 : case 593: return 1;
5182 6979 : default: return 0;
5183 : }
5184 315 : return 0;
5185 : }
5186 :
5187 : static GEN
5188 28 : initwt1trace(GEN mf)
5189 : {
5190 28 : GEN S = MF_get_S(mf), v, H;
5191 : long l, i;
5192 28 : if (lg(S) == 1) return mftrivial();
5193 28 : H = mfheckemat(mf, Mindex_as_coef(mf));
5194 28 : l = lg(H); v = cgetg(l, t_VEC);
5195 63 : for (i = 1; i < l; i++) gel(v,i) = gtrace(gel(H,i));
5196 28 : v = Minv_RgC_mul(MF_get_Minv(mf), v);
5197 28 : return mflineardiv_linear(S, v, 1);
5198 : }
5199 : static GEN
5200 21 : initwt1newtrace(GEN mf)
5201 : {
5202 21 : GEN v, D, S, Mindex, CHI = MF_get_CHI(mf);
5203 21 : long FC, lD, i, sb, N1, N2, lM, N = MF_get_N(mf);
5204 21 : CHI = mfchartoprimitive(CHI, &FC);
5205 21 : if (N % FC || mfcharparity(CHI) == 1) return mftrivial();
5206 21 : D = mydivisorsu(N/FC); lD = lg(D);
5207 21 : S = MF_get_S(mf);
5208 21 : if (lg(S) == 1) return mftrivial();
5209 21 : N2 = newd_params2(N);
5210 21 : N1 = N / N2;
5211 21 : Mindex = MF_get_Mindex(mf);
5212 21 : lM = lg(Mindex);
5213 21 : sb = Mindex[lM-1];
5214 21 : v = zerovec(sb+1);
5215 42 : for (i = 1; i < lD; i++)
5216 : {
5217 21 : long M = FC*D[i], j;
5218 21 : GEN tf = initwt1trace(M == N? mf: mfinit_Nkchi(M, 1, CHI, mf_CUSP, 0));
5219 : GEN listd, w;
5220 21 : if (mf_get_type(tf) == t_MF_CONST) continue;
5221 21 : w = mfcoefs_i(tf, sb, 1);
5222 21 : if (M == N) { v = gadd(v, w); continue; }
5223 0 : listd = mydivisorsu(u_ppo(ugcd(N/M, N1), FC));
5224 0 : for (j = 1; j < lg(listd); j++)
5225 : {
5226 0 : long d = listd[j], d2 = d*d; /* coprime to FC */
5227 0 : GEN dk = mfchareval(CHI, d);
5228 0 : long NMd = N/(M*d), m;
5229 0 : for (m = 1; m <= sb/d2; m++)
5230 : {
5231 0 : long be = mubeta2(NMd, m);
5232 0 : if (be)
5233 : {
5234 0 : GEN c = gmul(dk, gmulsg(be, gel(w, m+1)));
5235 0 : long n = m*d2;
5236 0 : gel(v, n+1) = gadd(gel(v, n+1), c);
5237 : }
5238 : }
5239 : }
5240 : }
5241 21 : if (gequal0(gel(v,2))) return mftrivial();
5242 21 : v = vecpermute(v,Mindex);
5243 21 : v = Minv_RgC_mul(MF_get_Minv(mf), v);
5244 21 : return mflineardiv_linear(S, v, 1);
5245 : }
5246 :
5247 : /* i*p + 1, i*p < lim corresponding to a_p(f_j), a_{2p}(f_j)... */
5248 : static GEN
5249 1834 : pindices(long p, long lim)
5250 : {
5251 1834 : GEN v = cgetg(lim, t_VECSMALL);
5252 : long i, ip;
5253 22190 : for (i = 1, ip = p + 1; ip < lim; i++, ip += p) v[i] = ip;
5254 1834 : setlg(v, i); return v;
5255 : }
5256 :
5257 : /* assume !wt1empty(N), in particular N>25 */
5258 : /* Returns [[lim,p], mf (weight 2), p*lim x dim matrix] */
5259 : static GEN
5260 1834 : mf1_pre(long N)
5261 : {
5262 : pari_timer tt;
5263 : GEN mf, v, L, I, M, Minv, den;
5264 : long B, lim, LIM, p;
5265 :
5266 1834 : if (DEBUGLEVEL) timer_start(&tt);
5267 1834 : mf = mfinit_Nkchi(N, 2, mfchartrivial(), mf_CUSP, 0);
5268 1834 : if (DEBUGLEVEL)
5269 0 : timer_printf(&tt, "mf1basis [pre]: S_2(%ld), dim = %ld",
5270 : N, MF_get_dim(mf));
5271 1834 : M = MF_get_M(mf); Minv = MF_get_Minv(mf); den = gel(Minv,2);
5272 1834 : B = mfsturm_mf(mf);
5273 1834 : if (uisprime(N))
5274 : {
5275 392 : lim = 2 * MF_get_dim(mf); /* ensure mfstabiter's first kernel ~ square */
5276 392 : p = 2;
5277 : }
5278 : else
5279 : {
5280 : forprime_t S;
5281 1442 : u_forprime_init(&S, 2, N);
5282 2576 : while ((p = u_forprime_next(&S)))
5283 2576 : if (N % p) break;
5284 1442 : lim = B + 1;
5285 : }
5286 1834 : LIM = (N & (N - 1))? 2 * lim: 3 * lim; /* N power of 2 ? */
5287 1834 : L = mkvecsmall4(lim, LIM, mfsturmNk(N,1), p);
5288 1834 : M = bhnmat_extend_nocache(M, N, LIM-1, 1, MF_get_S(mf));
5289 1834 : if (DEBUGLEVEL) timer_printf(&tt, "mf1basis [pre]: bnfmat_extend");
5290 1834 : v = pindices(p, LIM);
5291 1834 : if (!LIM) return mkvec4(L, mf, M, v);
5292 1834 : I = RgM_Rg_div(ZM_mul(rowslice(M, B+2, LIM), gel(Minv,1)), den);
5293 1834 : I = Q_remove_denom(I, &den);
5294 1834 : if (DEBUGLEVEL) timer_printf(&tt, "mf1basis [prec]: Iden");
5295 1834 : return mkvec5(L, mf, M, v, mkvec2(I, den));
5296 : }
5297 :
5298 : /* lg(A) > 1, E a t_POL */
5299 : static GEN
5300 700 : mfmatsermul(GEN A, GEN E)
5301 : {
5302 700 : long j, l = lg(A), r = nbrows(A);
5303 700 : GEN M = cgetg(l, t_MAT);
5304 700 : E = RgXn_red_shallow(E, r+1);
5305 6328 : for (j = 1; j < l; j++)
5306 : {
5307 5628 : GEN c = RgV_to_RgX(gel(A,j), 0);
5308 5628 : gel(M, j) = RgX_to_RgC(RgXn_mul(c, E, r+1), r);
5309 : }
5310 700 : return M;
5311 : }
5312 : /* lg(Ap) > 1, Ep an Flxn */
5313 : static GEN
5314 1141 : mfmatsermul_Fl(GEN Ap, GEN Ep, ulong p)
5315 : {
5316 1141 : long j, l = lg(Ap), r = nbrows(Ap);
5317 1141 : GEN M = cgetg(l, t_MAT);
5318 42630 : for (j = 1; j < l; j++)
5319 : {
5320 41489 : GEN c = Flv_to_Flx(gel(Ap,j), 0);
5321 41489 : gel(M,j) = Flx_to_Flv(Flxn_mul(c, Ep, r+1, p), r);
5322 : }
5323 1141 : return M;
5324 : }
5325 :
5326 : /* CHI mod F | N, return mfchar of modulus N.
5327 : * FIXME: wasteful, G should be precomputed */
5328 : static GEN
5329 13048 : mfcharinduce(GEN CHI, long N)
5330 : {
5331 : GEN G, chi;
5332 13048 : if (mfcharmodulus(CHI) == N) return CHI;
5333 1463 : G = znstar0(utoipos(N), 1);
5334 1463 : chi = zncharinduce(gel(CHI,1), gel(CHI,2), G);
5335 1463 : CHI = leafcopy(CHI);
5336 1463 : gel(CHI,1) = G;
5337 1463 : gel(CHI,2) = chi; return CHI;
5338 : }
5339 :
5340 : static GEN
5341 3983 : gmfcharno(GEN CHI)
5342 : {
5343 3983 : GEN G = gel(CHI,1), chi = gel(CHI,2);
5344 3983 : return mkintmod(znconreyexp(G, chi), znstar_get_N(G));
5345 : }
5346 : static long
5347 13699 : mfcharno(GEN CHI)
5348 : {
5349 13699 : GEN n = znconreyexp(gel(CHI,1), gel(CHI,2));
5350 13699 : return itou(n);
5351 : }
5352 :
5353 : /* return k such that minimal mfcharacter in Galois orbit of CHI is CHI^k */
5354 : static long
5355 12138 : mfconreyminimize(GEN CHI)
5356 : {
5357 12138 : GEN G = gel(CHI,1), cyc, chi;
5358 12138 : cyc = ZV_to_zv(znstar_get_cyc(G));
5359 12138 : chi = ZV_to_zv(znconreychar(G, gel(CHI,2)));
5360 12138 : return zv_cyc_minimize(cyc, chi, coprimes_zv(mfcharorder(CHI)));
5361 : }
5362 :
5363 : /* find scalar c such that first nonzero entry of c*v is 1; return c*v */
5364 : static GEN
5365 2065 : RgV_normalize(GEN v, GEN *pc)
5366 : {
5367 2065 : long i, l = lg(v);
5368 5313 : for (i = 1; i < l; i++)
5369 : {
5370 5313 : GEN c = gel(v,i);
5371 5313 : if (!gequal0(c))
5372 : {
5373 2065 : if (gequal1(c)) break;
5374 679 : *pc = ginv(c); return RgV_Rg_mul(v, *pc);
5375 : }
5376 : }
5377 1386 : *pc = gen_1; return v;
5378 : }
5379 : /* pS != NULL; dim > 0 */
5380 : static GEN
5381 784 : mftreatdihedral(long N, GEN DIH, GEN POLCYC, long ordchi, GEN *pS)
5382 : {
5383 784 : long l = lg(DIH), lim = mfsturmNk(N, 1), i;
5384 784 : GEN Minv, C = cgetg(l, t_VEC), M = cgetg(l, t_MAT);
5385 2436 : for (i = 1; i < l; i++)
5386 : {
5387 1652 : GEN c, v = mfcoefs_i(gel(DIH,i), lim, 1);
5388 1652 : gel(M,i) = RgV_normalize(v, &c);
5389 1652 : gel(C,i) = Rg_col_ei(c, l-1, i);
5390 : }
5391 784 : Minv = gel(mfclean(M,POLCYC,ordchi,0),2);
5392 784 : M = RgM_Minv_mul(M, Minv);
5393 784 : C = RgM_Minv_mul(C, Minv);
5394 784 : *pS = vecmflinear(DIH, C); return M;
5395 : }
5396 :
5397 : /* same mode a maximal ideal above q */
5398 : static GEN
5399 2408 : Tpmod(GEN Ap, GEN A, ulong chip, long p, ulong q)
5400 : {
5401 2408 : GEN B = leafcopy(Ap);
5402 2408 : long i, ip, l = lg(B);
5403 86345 : for (i = 1, ip = p; ip < l; i++, ip += p)
5404 83937 : B[ip] = Fl_add(B[ip], Fl_mul(A[i], chip, q), q);
5405 2408 : return B;
5406 : }
5407 : /* Tp(f_1), ..., Tp(f_d) mod q */
5408 : static GEN
5409 301 : matTpmod(GEN xp, GEN x, ulong chip, long p, ulong q)
5410 2709 : { pari_APPLY_same(Tpmod(gel(xp,i), gel(x,i), chip, p, q)); }
5411 :
5412 : /* Ap[i] = a_{p*i}(F), A[i] = a_i(F), i = 1..lim
5413 : * Tp(f)[n] = a_{p*n}(f) + chi(p) a_{n/p}(f) * 1_{p | n} */
5414 : static GEN
5415 469 : Tp(GEN Ap, GEN A, GEN chip, long p)
5416 : {
5417 469 : GEN B = leafcopy(Ap);
5418 469 : long i, ip, l = lg(B);
5419 12915 : for (i = 1, ip = p; ip < l; i++, ip += p)
5420 12446 : gel(B,ip) = gadd(gel(B,ip), gmul(gel(A,i), chip));
5421 469 : return B;
5422 : }
5423 : /* Tp(f_1), ..., Tp(f_d) */
5424 : static GEN
5425 56 : matTp(GEN xp, GEN x, GEN chip, long p)
5426 525 : { pari_APPLY_same(Tp(gel(xp,i), gel(x,i), chip, p)); }
5427 :
5428 : static GEN
5429 378 : _RgXQM_mul(GEN x, GEN y, GEN T)
5430 378 : { return T? RgXQM_mul(x, y, T): RgM_mul(x, y); }
5431 : /* largest T-stable Q(CHI)-subspace of Q(CHI)-vector space spanned by columns
5432 : * of A */
5433 : static GEN
5434 28 : mfstabiter(GEN *pC, GEN A0, GEN chip, GEN TMP, GEN P, long ordchi)
5435 : {
5436 28 : GEN A, Ap, vp = gel(TMP,4), C = NULL;
5437 28 : long i, lA, lim1 = gel(TMP,1)[3], p = gel(TMP,1)[4];
5438 : pari_timer tt;
5439 :
5440 28 : Ap = rowpermute(A0, vp);
5441 28 : A = rowslice(A0, 2, nbrows(Ap)+1); /* remove a0 */
5442 : for(;;)
5443 28 : {
5444 56 : GEN R = shallowconcat(matTp(Ap, A, chip, p), A);
5445 56 : GEN B = QabM_ker(R, P, ordchi);
5446 56 : long lB = lg(B);
5447 56 : if (DEBUGLEVEL)
5448 0 : timer_printf(&tt, "mf1basis: Hecke intersection (dim %ld)", lB-1);
5449 56 : if (lB == 1) return NULL;
5450 56 : lA = lg(A); if (lB == lA) break;
5451 28 : B = rowslice(B, 1, lA-1);
5452 28 : Ap = _RgXQM_mul(Ap, B, P);
5453 28 : A = _RgXQM_mul(A, B, P);
5454 28 : C = C? _RgXQM_mul(C, B, P): B;
5455 : }
5456 28 : if (nbrows(A) < lim1)
5457 : {
5458 14 : A0 = rowslice(A0, 2, lim1);
5459 14 : A = C? _RgXQM_mul(A0, C, P): A0;
5460 : }
5461 : else /* all needed coefs computed */
5462 14 : A = rowslice(A, 1, lim1-1);
5463 28 : if (*pC) C = C? _RgXQM_mul(*pC, C, P): *pC;
5464 : /* put back a0 */
5465 119 : for (i = 1; i < lA; i++) gel(A,i) = vec_prepend(gel(A,i), gen_0);
5466 28 : *pC = C; return A;
5467 : }
5468 :
5469 : static long
5470 252 : mfstabitermod(GEN A, GEN vp, ulong chip, long p, ulong q)
5471 : {
5472 252 : GEN Ap, C = NULL;
5473 252 : Ap = rowpermute(A, vp);
5474 252 : A = rowslice(A, 2, nbrows(Ap)+1);
5475 : while (1)
5476 49 : {
5477 301 : GEN Rp = shallowconcat(matTpmod(Ap, A, chip, p, q), A);
5478 301 : GEN B = Flm_ker(Rp, q);
5479 301 : long lA = lg(A), lB = lg(B);
5480 301 : if (lB == 1) return 0;
5481 266 : if (lB == lA) return lA-1;
5482 49 : B = rowslice(B, 1, lA-1);
5483 49 : Ap = Flm_mul(Ap, B, q);
5484 49 : A = Flm_mul(A, B, q);
5485 49 : C = C? Flm_mul(C, B, q): B;
5486 : }
5487 : }
5488 :
5489 : static GEN
5490 595 : mfcharinv_i(GEN CHI)
5491 : {
5492 595 : GEN G = gel(CHI,1);
5493 595 : CHI = leafcopy(CHI); gel(CHI,2) = zncharconj(G, gel(CHI,2)); return CHI;
5494 : }
5495 :
5496 : /* upper bound dim S_1(Gamma_0(N),chi) performing the linear algebra mod p */
5497 : static long
5498 595 : mf1dimmod(GEN E1, GEN E, GEN chip, long ordchi, long dih, GEN TMP)
5499 : {
5500 595 : GEN E1i, A, vp, mf, C = NULL;
5501 595 : ulong q, r = QabM_init(ordchi, &q);
5502 : long lim, LIM, p;
5503 :
5504 595 : LIM = gel(TMP,1)[2]; lim = gel(TMP,1)[1];
5505 595 : mf= gel(TMP,2);
5506 595 : A = gel(TMP,3);
5507 595 : A = QabM_to_Flm(A, r, q);
5508 595 : E1 = QabX_to_Flx(E1, r, q);
5509 595 : E1i = Flxn_inv(E1, nbrows(A), q);
5510 595 : if (E)
5511 : {
5512 574 : GEN Iden = gel(TMP,5), I = gel(Iden,1), den = gel(Iden,2);
5513 574 : GEN Mindex = MF_get_Mindex(mf), F = rowslice(A, 1, LIM);
5514 574 : GEN E1ip = Flxn_red(E1i, LIM);
5515 574 : ulong d = den? umodiu(den, q): 1;
5516 574 : long i, nE = lg(E) - 1;
5517 : pari_sp av;
5518 :
5519 574 : I = ZM_to_Flm(I, q);
5520 574 : if (d != 1) I = Flm_Fl_mul(I, Fl_inv(d, q), q);
5521 574 : av = avma;
5522 1120 : for (i = 1; i <= nE; i++)
5523 : {
5524 889 : GEN e = Flxn_mul(E1ip, QabX_to_Flx(gel(E,i), r, q), LIM, q);
5525 889 : GEN B = mfmatsermul_Fl(F, e, q), z;
5526 889 : GEN B2 = Flm_mul(I, rowpermute(B, Mindex), q);
5527 889 : B = rowslice(B, lim+1,LIM);
5528 889 : z = Flm_ker(Flm_sub(B2, B, q), q);
5529 889 : if (lg(z)-1 == dih) return dih;
5530 546 : C = C? Flm_mul(C, z, q): z;
5531 546 : F = Flm_mul(F, z, q);
5532 546 : (void)gc_all(av, 2, &F,&C);
5533 : }
5534 231 : A = F;
5535 : }
5536 : /* use Schaeffer */
5537 252 : p = gel(TMP,1)[4]; vp = gel(TMP,4);
5538 252 : A = mfmatsermul_Fl(A, E1i, q);
5539 252 : return mfstabitermod(A, vp, Qab_to_Fl(chip, r, q), p, q);
5540 : }
5541 :
5542 : static GEN
5543 224 : mf1intermat(GEN A, GEN Mindex, GEN e, GEN Iden, long lim, GEN POLCYC)
5544 : {
5545 224 : long j, l = lg(A), LIM = nbrows(A);
5546 224 : GEN I = gel(Iden,1), den = gel(Iden,2), B = cgetg(l, t_MAT);
5547 :
5548 5257 : for (j = 1; j < l; j++)
5549 : {
5550 5033 : pari_sp av = avma;
5551 5033 : GEN c = RgV_to_RgX(gel(A,j), 0), c1, c2;
5552 5033 : c = RgX_to_RgC(RgXn_mul(c, e, LIM), LIM);
5553 5033 : if (POLCYC) c = liftpol_shallow(c);
5554 5033 : c1 = vecslice(c, lim+1, LIM);
5555 5033 : if (den) c1 = RgC_Rg_mul(c1, den);
5556 5033 : c2 = RgM_RgC_mul(I, vecpermute(c, Mindex));
5557 5033 : gel(B, j) = gc_upto(av, RgC_sub(c2, c1));
5558 : }
5559 224 : return B;
5560 : }
5561 : /* Compute the full S_1(\G_0(N),\chi); return NULL if space is empty; else
5562 : * if pS is NULL, return stoi(dim), where dim is the dimension; else *pS is
5563 : * set to a vector of forms making up a basis, and return the matrix of their
5564 : * Fourier expansions. pdih gives the dimension of the subspace generated by
5565 : * dihedral forms; TMP is from mf1_pre or NULL. */
5566 : static GEN
5567 11284 : mf1basis(long N, GEN CHI, GEN TMP, GEN vSP, GEN *pS, long *pdih)
5568 : {
5569 11284 : GEN E = NULL, EB, E1, E1i, dE1i, mf, A, C, POLCYC, DIH, Minv, chip;
5570 11284 : long nE = 0, p, LIM, lim, lim1, i, lA, dimp, ordchi, dih;
5571 : pari_timer tt;
5572 : pari_sp av;
5573 :
5574 11284 : if (pdih) *pdih = 0;
5575 11284 : if (pS) *pS = NULL;
5576 11284 : if (wt1empty(N) || mfcharparity(CHI) != -1) return NULL;
5577 10990 : ordchi = mfcharorder(CHI);
5578 10990 : if (uisprime(N) && ordchi > 4) return NULL;
5579 10962 : if (pS)
5580 : {
5581 3857 : DIH = mfdihedralcusp(N, CHI, vSP);
5582 3857 : dih = lg(DIH) - 1;
5583 : }
5584 : else
5585 : {
5586 7105 : DIH = NULL;
5587 7105 : dih = mfdihedralcuspdim(N, CHI, vSP);
5588 : }
5589 10962 : POLCYC = (ordchi <= 2)? NULL: mfcharpol(CHI);
5590 10962 : if (pdih) *pdih = dih;
5591 10962 : if (N <= 600) switch(N)
5592 : {
5593 : long m;
5594 126 : case 219: case 273: case 283: case 331: case 333: case 344: case 416:
5595 : case 438: case 468: case 491: case 504: case 546: case 553: case 563:
5596 : case 566: case 581: case 592:
5597 126 : break; /* one chi with both exotic and dihedral forms */
5598 9499 : default: /* only dihedral forms */
5599 9499 : if (!dih) return NULL;
5600 : /* fall through */
5601 : case 124: case 133: case 148: case 171: case 201: case 209: case 224:
5602 : case 229: case 248: case 261: case 266: case 288: case 296: case 301:
5603 : case 309: case 325: case 342: case 371: case 372: case 380: case 399:
5604 : case 402: case 403: case 404: case 408: case 418: case 432: case 444:
5605 : case 448: case 451: case 453: case 458: case 496: case 497: case 513:
5606 : case 522: case 527: case 532: case 576: case 579:
5607 : /* no chi with both exotic and dihedral; one chi with exotic forms */
5608 3248 : if (dih)
5609 : {
5610 2338 : if (!pS) return utoipos(dih);
5611 728 : return mftreatdihedral(N, DIH, POLCYC, ordchi, pS) ;
5612 : }
5613 910 : m = mfcharno(mfcharinduce(CHI,N));
5614 910 : if (N == 124 && (m != 67 && m != 87)) return NULL;
5615 784 : if (N == 133 && (m != 83 && m !=125)) return NULL;
5616 490 : if (N == 148 && (m !=105 && m !=117)) return NULL;
5617 364 : if (N == 171 && (m != 94 && m !=151)) return NULL;
5618 364 : if (N == 201 && (m != 29 && m !=104)) return NULL;
5619 364 : if (N == 209 && (m != 87 && m !=197)) return NULL;
5620 364 : if (N == 224 && (m != 95 && m !=191)) return NULL;
5621 364 : if (N == 229 && (m !=107 && m !=122)) return NULL;
5622 364 : if (N == 248 && (m != 87 && m !=191)) return NULL;
5623 273 : if (N == 261 && (m != 46 && m !=244)) return NULL;
5624 273 : if (N == 266 && (m != 83 && m !=125)) return NULL;
5625 273 : if (N == 288 && (m != 31 && m !=223)) return NULL;
5626 273 : if (N == 296 && (m !=105 && m !=265)) return NULL;
5627 : }
5628 595 : if (DEBUGLEVEL)
5629 0 : err_printf("mf1basis: start character %Ps, conductor = %ld, order = %ld\n",
5630 : gmfcharno(CHI), mfcharconductor(CHI), ordchi);
5631 595 : if (!TMP) TMP = mf1_pre(N);
5632 595 : lim = gel(TMP,1)[1]; LIM = gel(TMP,1)[2]; lim1 = gel(TMP,1)[3];
5633 595 : p = gel(TMP,1)[4];
5634 595 : mf = gel(TMP,2);
5635 595 : A = gel(TMP,3);
5636 595 : EB = mfeisensteinbasis(N, 1, mfcharinv_i(CHI));
5637 595 : nE = lg(EB) - 1;
5638 595 : E1 = RgV_to_RgX(mftocol(gel(EB,1), LIM-1, 1), 0); /* + O(x^LIM) */
5639 595 : if (--nE)
5640 574 : E = RgM_to_RgXV(mfvectomat(vecslice(EB, 2, nE+1), LIM-1, 1), 0);
5641 595 : chip = mfchareval(CHI, p); /* != 0 */
5642 595 : if (DEBUGLEVEL) timer_start(&tt);
5643 595 : av = avma; dimp = mf1dimmod(E1, E, chip, ordchi, dih, TMP);
5644 595 : set_avma(av);
5645 595 : if (DEBUGLEVEL) timer_printf(&tt, "mf1basis: dim mod p is %ld", dimp);
5646 595 : if (!dimp) return NULL;
5647 280 : if (!pS) return utoi(dimp);
5648 224 : if (dimp == dih) return mftreatdihedral(N, DIH, POLCYC, ordchi, pS);
5649 168 : E1i = RgXn_inv(E1, LIM); /* E[1] does not vanish at oo */
5650 168 : if (POLCYC) E1i = liftpol_shallow(E1i);
5651 168 : E1i = Q_remove_denom(E1i, &dE1i);
5652 168 : if (DEBUGLEVEL)
5653 : {
5654 0 : GEN a0 = gel(E1,2);
5655 0 : if (typ(a0) == t_POLMOD) a0 = gnorm(a0);
5656 0 : a0 = Q_abs_shallow(a0);
5657 0 : timer_printf(&tt, "mf1basis: invert E; norm(a0(E)) = %Ps", a0);
5658 : }
5659 168 : C = NULL;
5660 168 : if (nE)
5661 : { /* mf attached to S2(N), fi = mfbasis(mf)
5662 : * M = coefs(f1,...,fd) up to LIM
5663 : * F = coefs(F1,...,FD) = M * C, for some matrix C over Q(chi),
5664 : * initially 1, eventually giving \cap_E S2 / E; D <= d.
5665 : * B = coefs(E/E1 F1, .., E/E1 FD); we want X in Q(CHI)^d and
5666 : * Y in Q(CHI)^D such that
5667 : * B * X = M * Y, i.e. Minv * rowpermute(B, Mindex * X) = Y
5668 : *(B - I * rowpermute(B, Mindex)) * X = 0.
5669 : * where I = M * Minv. Rows of (B - I * ...) are 0 up to lim so
5670 : * are not included */
5671 154 : GEN Mindex = MF_get_Mindex(mf), Iden = gel(TMP,5);
5672 : pari_timer TT;
5673 154 : pari_sp av = avma;
5674 154 : if (DEBUGLEVEL) timer_start(&TT);
5675 238 : for (i = 1; i <= nE; i++)
5676 : {
5677 224 : pari_sp av2 = avma;
5678 : GEN e, z, B;
5679 :
5680 224 : e = Q_primpart(RgXn_mul(E1i, gel(E,i), LIM));
5681 224 : if (DEBUGLEVEL) timer_printf(&TT, "mf1basis: E[%ld] / E[1]", i+1);
5682 : /* the first time A is over Z and it is more efficient to lift than
5683 : * to let RgXn_mul use Kronecker's trick */
5684 224 : if (POLCYC && i == 1) e = liftpol_shallow(e);
5685 224 : B = mf1intermat(A, Mindex, e, Iden, lim, i == 1? NULL: POLCYC);
5686 224 : if (DEBUGLEVEL) timer_printf(&TT, "mf1basis: ... intermat");
5687 224 : z = gc_upto(av2, QabM_ker(B, POLCYC, ordchi));
5688 224 : if (DEBUGLEVEL)
5689 0 : timer_printf(&TT, "mf1basis: ... kernel (dim %ld)",lg(z)-1);
5690 224 : if (lg(z) == 1) return NULL;
5691 224 : if (lg(z) == lg(A)) { set_avma(av2); continue; } /* no progress */
5692 224 : C = C? _RgXQM_mul(C, z, POLCYC): z;
5693 224 : A = _RgXQM_mul(A, z, POLCYC);
5694 224 : if (DEBUGLEVEL) timer_printf(&TT, "mf1basis: ... updates");
5695 224 : if (lg(z)-1 == dimp) break;
5696 84 : if (gc_needed(av, 1))
5697 : {
5698 0 : if (DEBUGMEM > 1) pari_warn(warnmem,"mf1basis i = %ld", i);
5699 0 : (void)gc_all(av, 2, &A, &C);
5700 : }
5701 : }
5702 154 : if (DEBUGLEVEL) timer_printf(&tt, "mf1basis: intersection [total]");
5703 : }
5704 168 : lA = lg(A);
5705 168 : if (lA-1 == dimp)
5706 : {
5707 140 : A = mfmatsermul(rowslice(A, 1, lim1), E1i);
5708 140 : if (POLCYC) A = RgXQM_red(A, POLCYC);
5709 140 : if (DEBUGLEVEL) timer_printf(&tt, "mf1basis: matsermul [1]");
5710 : }
5711 : else
5712 : {
5713 28 : A = mfmatsermul(A, E1i);
5714 28 : if (POLCYC) A = RgXQM_red(A, POLCYC);
5715 28 : if (DEBUGLEVEL) timer_printf(&tt, "mf1basis: matsermul [2]");
5716 28 : A = mfstabiter(&C, A, chip, TMP, POLCYC, ordchi);
5717 28 : if (DEBUGLEVEL) timer_printf(&tt, "mf1basis: Hecke stability");
5718 28 : if (!A) return NULL;
5719 : }
5720 168 : if (dE1i) C = RgM_Rg_mul(C, dE1i);
5721 168 : if (POLCYC)
5722 : {
5723 147 : A = QXQM_to_mod_shallow(A, POLCYC);
5724 147 : C = QXQM_to_mod_shallow(C, POLCYC);
5725 : }
5726 168 : lA = lg(A);
5727 581 : for (i = 1; i < lA; i++)
5728 : {
5729 413 : GEN c, v = gel(A,i);
5730 413 : gel(A,i) = RgV_normalize(v, &c);
5731 413 : gel(C,i) = RgC_Rg_mul(gel(C,i), c);
5732 : }
5733 168 : Minv = gel(mfclean(A, POLCYC, ordchi, 0), 2);
5734 168 : A = RgM_Minv_mul(A, Minv);
5735 168 : C = RgM_Minv_mul(C, Minv);
5736 168 : *pS = vecmflineardiv0(MF_get_S(mf), C, gel(EB,1));
5737 168 : return A;
5738 : }
5739 :
5740 : static void
5741 413 : MF_set_space(GEN mf, long x) { gmael(mf,1,4) = utoi(x); }
5742 : static GEN
5743 252 : mf1_cusptonew(GEN mf, GEN vSP)
5744 : {
5745 252 : const long vy = 1;
5746 : long i, lP, dSnew, ct;
5747 252 : GEN vP, F, S, Snew, vF, v = split_ii(mf, 0, 0, vSP, &i);
5748 :
5749 252 : F = gel(v,1);
5750 252 : vP= gel(v,2); lP = lg(vP);
5751 252 : if (lP == 1) { obj_insert(mf, MF_SPLIT, v); return NULL; }
5752 238 : MF_set_space(mf, mf_NEW);
5753 238 : S = MF_get_S(mf);
5754 238 : dSnew = dim_sum(v);
5755 238 : Snew = cgetg(dSnew + 1, t_VEC); ct = 0;
5756 238 : vF = cgetg(lP, t_MAT);
5757 546 : for (i = 1; i < lP; i++)
5758 : {
5759 308 : GEN V, P = gel(vP,i), f = liftpol_shallow(gel(F,i));
5760 308 : long j, d = degpol(P);
5761 308 : gel(vF,i) = V = zerocol(dSnew);
5762 308 : if (d == 1)
5763 : {
5764 140 : gel(Snew, ct+1) = mflineardiv_linear(S, f, 0);
5765 140 : gel(V, ct+1) = gen_1;
5766 : }
5767 : else
5768 : {
5769 168 : f = RgXV_to_RgM(f,d);
5770 511 : for (j = 1; j <= d; j++)
5771 : {
5772 343 : gel(Snew, ct+j) = mflineardiv_linear(S, row(f,j), 0);
5773 343 : gel(V, ct+j) = mkpolmod(pol_xn(j-1,vy), P);
5774 : }
5775 : }
5776 308 : ct += d;
5777 : }
5778 238 : obj_insert(mf, MF_SPLIT, mkvec2(vF, vP));
5779 238 : gel(mf,3) = Snew; return mf;
5780 : }
5781 : static GEN
5782 3969 : mf1init(long N, GEN CHI, GEN TMP, GEN vSP, long space, long flraw)
5783 : {
5784 3969 : GEN mf, mf1, S, M = mf1basis(N, CHI, TMP, vSP, &S, NULL);
5785 3969 : if (!M) return NULL;
5786 952 : mf1 = mkvec4(stoi(N), gen_1, CHI, utoi(mf_CUSP));
5787 952 : mf = mkmf(mf1, cgetg(1,t_VEC), S, gen_0, NULL);
5788 952 : if (space == mf_NEW)
5789 : {
5790 252 : gel(mf,5) = mfcleanCHI(M,CHI, 0);
5791 252 : mf = mf1_cusptonew(mf, vSP); if (!mf) return NULL;
5792 238 : if (!flraw) M = mfcoefs_mf(mf, mfsturmNk(N,1)+1, 1);
5793 : }
5794 938 : gel(mf,5) = flraw? zerovec(3): mfcleanCHI(M, CHI, 0);
5795 938 : return mf;
5796 : }
5797 :
5798 : static GEN
5799 1029 : mfEMPTY(GEN mf1)
5800 : {
5801 1029 : GEN Minv = mkMinv(cgetg(1,t_MAT), NULL,NULL,NULL);
5802 1029 : GEN M = mkvec3(cgetg(1,t_VECSMALL), Minv, cgetg(1,t_MAT));
5803 1029 : return mkmf(mf1, cgetg(1,t_VEC), cgetg(1,t_VEC), cgetg(1,t_VEC), M);
5804 : }
5805 : static GEN
5806 616 : mfEMPTYall(long N, GEN gk, GEN vCHI, long space)
5807 : {
5808 : long i, l;
5809 : GEN v, gN, gs;
5810 616 : if (!vCHI) return cgetg(1, t_VEC);
5811 14 : gN = utoipos(N); gs = utoi(space);
5812 14 : l = lg(vCHI); v = cgetg(l, t_VEC);
5813 42 : for (i = 1; i < l; i++) gel(v,i) = mfEMPTY(mkvec4(gN,gk,gel(vCHI,i),gs));
5814 14 : return v;
5815 : }
5816 :
5817 : static GEN
5818 3983 : fmt_dim(GEN CHI, long d, long dih)
5819 3983 : { return mkvec4(gmfcharorder(CHI), gmfcharno(CHI), utoi(d), stoi(dih)); }
5820 : /* merge two vector of fmt_dim's for the same vector of characters. If CHI
5821 : * is not NULL, remove dim-0 spaces and add character from CHI */
5822 : static GEN
5823 7 : merge_dims(GEN V, GEN W, GEN CHI)
5824 : {
5825 7 : long i, j, id, l = lg(V);
5826 7 : GEN A = cgetg(l, t_VEC);
5827 7 : if (l == 1) return A;
5828 7 : id = CHI? 1: 3;
5829 21 : for (i = j = 1; i < l; i++)
5830 : {
5831 14 : GEN v = gel(V,i), w = gel(W,i);
5832 14 : long dv = itou(gel(v,id)), dvh = itou(gel(v,id+1)), d;
5833 14 : long dw = itou(gel(w,id)), dwh = itou(gel(w,id+1));
5834 14 : d = dv + dw;
5835 14 : if (d || CHI)
5836 14 : gel(A,j++) = CHI? fmt_dim(gel(CHI,i),d, dvh+dwh)
5837 14 : : mkvec2s(d,dvh+dwh);
5838 : }
5839 7 : setlg(A, j); return A;
5840 : }
5841 : static GEN
5842 3010 : mfdim0all(GEN w)
5843 : {
5844 3038 : if (w) retconst_vec(lg(w)-1, zerovec(2));
5845 3003 : return cgetg(1,t_VEC);
5846 : }
5847 : static long
5848 7315 : mf1cuspdim_i(long N, GEN CHI, GEN TMP, GEN vSP, long *dih)
5849 : {
5850 7315 : pari_sp av = avma;
5851 7315 : GEN b = mf1basis(N, CHI, TMP, vSP, NULL, dih);
5852 7315 : return gc_long(av, b? itou(b): 0);
5853 : }
5854 :
5855 : static long
5856 476 : mf1cuspdim(long N, GEN CHI, GEN vSP)
5857 : {
5858 476 : if (!vSP) vSP = get_vDIH(N, divisorsNF(N, mfcharconductor(CHI)));
5859 476 : return mf1cuspdim_i(N, CHI, NULL, vSP, NULL);
5860 : }
5861 : static GEN
5862 4144 : mf1cuspdimall(long N, GEN vCHI)
5863 : {
5864 : GEN z, TMP, w, vSP;
5865 : long i, j, l;
5866 4144 : if (wt1empty(N)) return mfdim0all(vCHI);
5867 1141 : w = mf1chars(N,vCHI);
5868 1141 : l = lg(w); if (l == 1) return cgetg(1,t_VEC);
5869 1141 : z = cgetg(l, t_VEC);
5870 1141 : TMP = mf1_pre(N); vSP = get_vDIH(N, NULL);
5871 7861 : for (i = j = 1; i < l; i++)
5872 : {
5873 6720 : GEN CHI = gel(w,i);
5874 6720 : long dih, d = mf1cuspdim_i(N, CHI, TMP, vSP, &dih);
5875 6720 : if (vCHI)
5876 42 : gel(z,j++) = mkvec2s(d, dih);
5877 6678 : else if (d)
5878 1428 : gel(z,j++) = fmt_dim(CHI, d, dih);
5879 : }
5880 1141 : setlg(z,j); return z;
5881 : }
5882 :
5883 : /* dimension of S_1(Gamma_1(N)) */
5884 : static long
5885 4123 : mf1cuspdimsum(long N)
5886 : {
5887 4123 : pari_sp av = avma;
5888 4123 : GEN v = mf1cuspdimall(N, NULL);
5889 4123 : long i, ct = 0, l = lg(v);
5890 5544 : for (i = 1; i < l; i++)
5891 : {
5892 1421 : GEN w = gel(v,i); /* [ord(CHI),*,dim,*] */
5893 1421 : ct += itou(gel(w,3))*myeulerphiu(itou(gel(w,1)));
5894 : }
5895 4123 : return gc_long(av,ct);
5896 : }
5897 :
5898 : static GEN
5899 56 : mf1newdimall(long N, GEN vCHI)
5900 : {
5901 : GEN z, w, vTMP, vSP, fa, P, E;
5902 : long i, c, l, lw, P1;
5903 56 : if (wt1empty(N)) return mfdim0all(vCHI);
5904 56 : w = mf1chars(N,vCHI);
5905 56 : lw = lg(w); if (lw == 1) return cgetg(1,t_VEC);
5906 56 : vTMP = const_vec(N, NULL);
5907 56 : vSP = get_vDIH(N, NULL);
5908 56 : gel(vTMP,N) = mf1_pre(N);
5909 : /* if p || N and p \nmid F(CHI), S_1^new(G0(N),chi) = 0 */
5910 56 : fa = znstar_get_faN(gmael(w,1,1));
5911 56 : P = gel(fa,1); l = lg(P);
5912 56 : E = gel(fa,2);
5913 154 : for (i = P1 = 1; i < l; i++)
5914 98 : if (E[i] == 1) P1 *= itou(gel(P,i));
5915 : /* P1 = \prod_{v_p(N) = 1} p */
5916 56 : z = cgetg(lw, t_VEC);
5917 182 : for (i = c = 1; i < lw; i++)
5918 : {
5919 : long S, j, l, F, dihnew;
5920 126 : GEN D, CHI = gel(w,i), CHIP = mfchartoprimitive(CHI,&F);
5921 :
5922 126 : S = F % P1? 0: mf1cuspdim_i(N, CHI, gel(vTMP,N), vSP, &dihnew);
5923 126 : if (!S)
5924 : {
5925 56 : if (vCHI) gel(z, c++) = zerovec(2);
5926 56 : continue;
5927 : }
5928 70 : D = mydivisorsu(N/F); l = lg(D);
5929 77 : for (j = l-2; j > 0; j--) /* skip last M = N */
5930 : {
5931 7 : long M = D[j]*F, m, s, dih;
5932 7 : GEN TMP = gel(vTMP,M);
5933 7 : if (wt1empty(M) || !(m = mubeta(D[l-j]))) continue; /*m = mubeta(N/M)*/
5934 7 : if (!TMP) gel(vTMP,M) = TMP = mf1_pre(M);
5935 7 : s = mf1cuspdim_i(M, CHIP, TMP, vSP, &dih);
5936 7 : if (s) { S += m * s; dihnew += m * dih; }
5937 : }
5938 70 : if (vCHI)
5939 63 : gel(z,c++) = mkvec2s(S, dihnew);
5940 7 : else if (S)
5941 7 : gel(z, c++) = fmt_dim(CHI, S, dihnew);
5942 : }
5943 56 : setlg(z,c); return z;
5944 : }
5945 :
5946 : static GEN
5947 28 : mf1olddimall(long N, GEN vCHI)
5948 : {
5949 : long i, j, l;
5950 : GEN z, w;
5951 28 : if (wt1empty(N)) return mfdim0all(vCHI);
5952 28 : w = mf1chars(N,vCHI);
5953 28 : l = lg(w); z = cgetg(l, t_VEC);
5954 84 : for (i = j = 1; i < l; i++)
5955 : {
5956 56 : GEN CHI = gel(w,i);
5957 56 : long d = mfolddim(N, 1, CHI);
5958 56 : if (vCHI)
5959 28 : gel(z,j++) = mkvec2s(d,d?-1:0);
5960 28 : else if (d)
5961 7 : gel(z, j++) = fmt_dim(CHI, d, -1);
5962 : }
5963 28 : setlg(z,j); return z;
5964 : }
5965 :
5966 : static long
5967 469 : mf1olddimsum(long N)
5968 : {
5969 : GEN D;
5970 469 : long N2, i, l, S = 0;
5971 469 : newd_params(N, &N2); /* will ensure mubeta != 0 */
5972 469 : D = mydivisorsu(N/N2); l = lg(D);
5973 2485 : for (i = 2; i < l; i++)
5974 : {
5975 2016 : long M = D[l-i]*N2, d = mf1cuspdimsum(M);
5976 2016 : if (d) S -= mubeta(D[i]) * d;
5977 : }
5978 469 : return S;
5979 : }
5980 : static long
5981 1050 : mf1newdimsum(long N)
5982 : {
5983 1050 : long S = mf1cuspdimsum(N);
5984 1050 : return S? S - mf1olddimsum(N): 0;
5985 : }
5986 :
5987 : /* return the automorphism of a degree-2 nf */
5988 : static GEN
5989 5768 : nf2_get_conj(GEN nf)
5990 : {
5991 5768 : GEN pol = nf_get_pol(nf);
5992 5768 : return deg1pol_shallow(gen_m1, negi(gel(pol,3)), varn(pol));
5993 : }
5994 : static int
5995 42 : foo_stable(GEN foo)
5996 42 : { return lg(foo) != 3 || equalii(gel(foo,1), gel(foo,2)); }
5997 :
5998 : static long
5999 224 : mfisdihedral(GEN vF, GEN DIH)
6000 : {
6001 224 : GEN vG = gel(DIH,1), M = gel(DIH,2), v, G, bnr, w, gen, D, f, nf, tau;
6002 224 : GEN bnr0 = NULL, f0, f0b, xin, foo;
6003 : long i, l, e, j, L, n;
6004 224 : if (lg(M) == 1) return 0;
6005 42 : v = RgM_RgC_invimage(M, vF);
6006 42 : if (!v) return 0;
6007 42 : l = lg(v);
6008 42 : for (i = 1; i < l; i++)
6009 42 : if (!gequal0(gel(v,i))) break;
6010 42 : if (i == l) return 0;
6011 42 : G = gel(vG,i);
6012 42 : bnr = gel(G,2); D = cyc_get_expo(bnr_get_cyc(bnr));
6013 42 : w = gel(G,3);
6014 42 : f = bnr_get_mod(bnr);
6015 42 : nf = bnr_get_nf(bnr);
6016 42 : tau = nf2_get_conj(nf);
6017 42 : f0 = gel(f,1); foo = gel(f,2);
6018 42 : f0b = galoisapply(nf, tau, f0);
6019 42 : xin = zv_to_ZV(gel(w,2)); /* xi(bnr.gen[i]) = e(xin[i] / D) */
6020 42 : if (!foo_stable(foo)) { foo = mkvec2(gen_1, gen_1); bnr0 = bnr; }
6021 42 : if (!gequal(f0, f0b))
6022 : {
6023 21 : f0 = idealmul(nf, f0, idealdivexact(nf, f0b, idealadd(nf, f0, f0b)));
6024 21 : bnr0 = bnr;
6025 : }
6026 42 : if (bnr0)
6027 : { /* conductor not ambiguous */
6028 : GEN S;
6029 28 : bnr = Buchray(bnr_get_bnf(bnr), mkvec2(f0, foo), nf_INIT | nf_GEN);
6030 28 : S = bnrsurjection(bnr, bnr0);
6031 28 : xin = FpV_red(RgV_RgM_mul(xin, gel(S,1)), D);
6032 : /* still xi(gen[i]) = e(xin[i] / D), for the new generators; D stays
6033 : * the same, not exponent(bnr.cyc) ! */
6034 : }
6035 42 : gen = bnr_get_gen(bnr); L = lg(gen);
6036 77 : for (j = 1, e = itou(D); j < L; j++)
6037 : {
6038 63 : GEN Ng = idealnorm(nf, gel(gen,j));
6039 63 : GEN a = shifti(gel(xin,j), 1); /* xi(g_j^2) = e(a/D) */
6040 63 : GEN b = FpV_dotproduct(xin, isprincipalray(bnr,Ng), D);
6041 63 : GEN m = Fp_sub(a, b, D); /* xi(g_j/g_j^\tau) = e(m/D) */
6042 63 : e = ugcd(e, itou(m)); if (e == 1) break;
6043 : }
6044 42 : n = itou(D) / e;
6045 42 : return n == 1? 4: 2*n;
6046 : }
6047 :
6048 : static ulong
6049 119 : myradicalu(ulong n) { return zv_prod(gel(myfactoru(n),1)); }
6050 :
6051 : /* list of fundamental discriminants unramified outside N, with sign s
6052 : * [s = 0 => no sign condition] */
6053 : static GEN
6054 119 : mfunram(long N, long s)
6055 : {
6056 119 : long cN = myradicalu(N >> vals(N)), p = 1, m = 1, l, c, i;
6057 119 : GEN D = mydivisorsu(cN), res;
6058 119 : l = lg(D);
6059 119 : if (s == 1) m = 0; else if (s == -1) p = 0;
6060 119 : res = cgetg(6*l - 5, t_VECSMALL);
6061 119 : c = 1;
6062 119 : if (!odd(N))
6063 : { /* d = 1 */
6064 56 : if (p) res[c++] = 8;
6065 56 : if (m) { res[c++] =-8; res[c++] =-4; }
6066 : }
6067 364 : for (i = 2; i < l; i++)
6068 : { /* skip d = 1, done above */
6069 245 : long d = D[i], d4 = d & 3L; /* d odd, squarefree, d4 = 1 or 3 */
6070 245 : if (d4 == 1) { if (p) res[c++] = d; }
6071 182 : else { if (m) res[c++] =-d; }
6072 245 : if (!odd(N))
6073 : {
6074 56 : if (p) { res[c++] = 8*d; if (d4 == 3) res[c++] = 4*d; }
6075 56 : if (m) { res[c++] =-8*d; if (d4 == 1) res[c++] =-4*d; }
6076 : }
6077 : }
6078 119 : setlg(res, c); return res;
6079 : }
6080 :
6081 : /* Return 1 if F is definitely not S4 type; return 0 on failure. */
6082 : static long
6083 105 : mfisnotS4(long N, GEN w)
6084 : {
6085 105 : GEN D = mfunram(N, 0);
6086 105 : long i, lD = lg(D), lw = lg(w);
6087 616 : for (i = 1; i < lD; i++)
6088 : {
6089 511 : long p, d = D[i], ok = 0;
6090 1442 : for (p = 2; p < lw; p++)
6091 1442 : if (w[p] && kross(d,p) == -1) { ok = 1; break; }
6092 511 : if (!ok) return 0;
6093 : }
6094 105 : return 1;
6095 : }
6096 :
6097 : /* Return 1 if Q(sqrt(5)) \not\subset Q(F), i.e. F is definitely not A5 type;
6098 : * return 0 on failure. */
6099 : static long
6100 105 : mfisnotA5(GEN F)
6101 : {
6102 105 : GEN CHI = mf_get_CHI(F), P = mfcharpol(CHI), T, Q;
6103 :
6104 105 : if (mfcharorder(CHI) % 5 == 0) return 0;
6105 105 : T = mf_get_field(F); if (degpol(T) == 1) return 1;
6106 105 : if (degpol(P) > 1) T = rnfequation(P,T);
6107 105 : Q = gsubgs(pol_xn(2,varn(T)), 5);
6108 105 : return (typ(nfisincl(Q, T)) == t_INT);
6109 : }
6110 :
6111 : /* v[p+1]^2 / chi(p) - 2 = z + 1/z with z primitive root of unity of order n,
6112 : * return n */
6113 : static long
6114 6741 : mffindrootof1(GEN v, long p, GEN CHI)
6115 : {
6116 6741 : GEN ap = gel(v,p+1), u0, u1, u1k, u2;
6117 6741 : long c = 1;
6118 6741 : if (gequal0(ap)) return 2;
6119 5033 : u0 = gen_2; u1k = u1 = gsubgs(gdiv(gsqr(ap), mfchareval(CHI, p)), 2);
6120 14812 : while (!gequalsg(2, liftpol_shallow(u1))) /* u1 = z^c + z^-c */
6121 : {
6122 9779 : u2 = gsub(gmul(u1k, u1), u0);
6123 9779 : u0 = u1; u1 = u2; c++;
6124 : }
6125 5033 : return c;
6126 : }
6127 :
6128 : /* we known that F is not dihedral */
6129 : static long
6130 182 : mfgaloistype_i(long N, GEN CHI, GEN F, GEN v)
6131 : {
6132 : forprime_t iter;
6133 182 : long lim = lg(v)-2;
6134 182 : GEN w = zero_zv(lim);
6135 : pari_sp av;
6136 : ulong p;
6137 182 : u_forprime_init(&iter, 2, lim);
6138 182 : av = avma;
6139 5292 : while((p = u_forprime_next(&iter))) if (N%p) switch(mffindrootof1(v, p, CHI))
6140 : {
6141 1400 : case 1: case 2: continue;
6142 3451 : case 3: w[p] = 1; break;
6143 70 : case 4: return -24; /* S4 */
6144 0 : case 5: return -60; /* A5 */
6145 7 : default: pari_err_DOMAIN("mfgaloistype", "form", "not a",
6146 : strtoGENstr("cuspidal eigenform"), F);
6147 0 : set_avma(av);
6148 : }
6149 105 : if (mfisnotS4(N,w) && mfisnotA5(F)) return -12; /* A4 */
6150 0 : return 0; /* FAILURE */
6151 : }
6152 :
6153 : static GEN
6154 224 : mfgaloistype0(long N, GEN CHI, GEN F, GEN DIH, long lim)
6155 : {
6156 224 : pari_sp av = avma;
6157 224 : GEN vF = mftocol(F, lim, 1);
6158 224 : long t = mfisdihedral(vF, DIH), bound;
6159 224 : if (t) return gc_stoi(av,t);
6160 182 : bound = maxss(200, 5*expu(N)*expu(N));
6161 : for(;;)
6162 : {
6163 182 : t = mfgaloistype_i(N, CHI, F, vF);
6164 175 : set_avma(av); if (t) return stoi(t);
6165 0 : if (lim > bound) return gen_0;
6166 0 : lim += lim >> 1;
6167 0 : vF = mfcoefs_i(F,lim,1);
6168 : }
6169 : }
6170 :
6171 : /* If f is NULL, give all the galoistypes, otherwise just for f */
6172 : /* Return 0 to indicate failure; in this case the type is either -12 or -60,
6173 : * most likely -12. FIXME using the Galois representation. */
6174 : GEN
6175 231 : mfgaloistype(GEN NK, GEN f)
6176 : {
6177 231 : pari_sp av = avma;
6178 231 : GEN CHI, T, F, DIH, SP, mf = checkMF_i(NK);
6179 : long N, k, lL, i, lim, SB;
6180 :
6181 231 : if (f && !checkmf_i(f)) pari_err_TYPE("mfgaloistype", f);
6182 224 : if (mf)
6183 : {
6184 189 : N = MF_get_N(mf);
6185 189 : k = MF_get_k(mf);
6186 189 : CHI = MF_get_CHI(mf);
6187 : }
6188 : else
6189 : {
6190 35 : checkNK(NK, &N, &k, &CHI, 0);
6191 35 : mf = f? NULL: mfinit_i(NK, mf_NEW);
6192 : }
6193 224 : if (k != 1) pari_err_DOMAIN("mfgaloistype", "k", "!=", gen_1, stoi(k));
6194 224 : SB = mf? mfsturm_mf(mf): mfsturmNk(N,1);
6195 224 : SP = get_DIH(N);
6196 224 : DIH = mfdihedralnew(N, CHI, SP);
6197 224 : lim = lg(DIH) == 1? 200: SB;
6198 224 : DIH = mkvec2(DIH, mfvectomat(DIH,SB,1));
6199 224 : if (f) return gc_INT(av, mfgaloistype0(N,CHI, f, DIH, lim));
6200 126 : F = mfeigenbasis(mf); lL = lg(F);
6201 126 : T = cgetg(lL, t_VEC);
6202 252 : for (i=1; i < lL; i++) gel(T,i) = mfgaloistype0(N, CHI, gel(F,i), DIH, lim);
6203 126 : return gc_upto(av, T);
6204 : }
6205 :
6206 : /******************************************************************/
6207 : /* Find all dihedral forms. */
6208 : /******************************************************************/
6209 : /* lim >= 2 */
6210 : static void
6211 14 : consttabdihedral(long lim) { cache_set(cache_DIH, mfdihedralall(lim)); }
6212 :
6213 : /* a ideal coprime to bnr modulus */
6214 : static long
6215 107611 : mfdiheval(GEN bnr, GEN w, GEN a)
6216 : {
6217 107611 : GEN L, cycn = gel(w,1), chin = gel(w,2);
6218 107611 : long ordmax = cycn[1];
6219 107611 : L = ZV_to_Flv(isprincipalray(bnr,a), ordmax);
6220 107611 : return Flv_dotproduct(chin, L, ordmax);
6221 : }
6222 :
6223 : /* x(t^k) mod T = polcyclo(m), 0 <= k < m */
6224 : static GEN
6225 30331 : Galois(GEN x, long k, GEN T, long m)
6226 : {
6227 : GEN B;
6228 : long i, ik, d;
6229 30331 : if (typ(x) != t_POL) return x;
6230 7455 : if (varn(x) != varn(T)) pari_APPLY_pol_normalized(Galois(gel(x,i), k, T, m));
6231 7420 : if ((d = degpol(x)) <= 0) return x;
6232 7063 : B = cgetg(m + 2, t_POL); B[1] = x[1]; gel(B,2) = gel(x,2);
6233 61565 : for (i = 1; i < m; i++) gel(B, i+2) = gen_0;
6234 23940 : for (i = 1, ik = k; i <= d; i++, ik = Fl_add(ik, k, m))
6235 16877 : gel(B, ik + 2) = gel(x, i+2);
6236 7063 : return QX_ZX_rem(normalizepol(B), T);
6237 : }
6238 : static GEN
6239 1022 : vecGalois(GEN x, long k, GEN T, long m)
6240 31332 : { pari_APPLY_same(Galois(gel(x,i), k, T, m)); }
6241 :
6242 : static GEN
6243 234178 : fix_pol(GEN S, GEN Pn, int *trace)
6244 : {
6245 234178 : if (typ(S) != t_POL) return S;
6246 118069 : S = RgX_rem(S, Pn);
6247 118069 : if (typ(S) == t_POL)
6248 : {
6249 118069 : switch(lg(S))
6250 : {
6251 45108 : case 2: return gen_0;
6252 20517 : case 3: return gel(S,2);
6253 : }
6254 52444 : *trace = 1;
6255 : }
6256 52444 : return S;
6257 : }
6258 :
6259 : static GEN
6260 13573 : dihan(GEN bnr, GEN w, GEN k0j, long m, ulong lim)
6261 : {
6262 13573 : GEN nf = bnr_get_nf(bnr), f = bid_get_ideal(bnr_get_bid(bnr));
6263 13573 : GEN v = zerovec(lim+1), cycn = gel(w,1), Tinit = gel(w,3);
6264 13573 : GEN Pn = gel(Tinit,lg(Tinit)==4? 2: 1);
6265 13573 : long j, ordmax = cycn[1];
6266 13573 : long D = itos(nf_get_disc(nf)), vt = varn(Pn);
6267 13573 : int trace = 0;
6268 : ulong p, n;
6269 : forprime_t T;
6270 :
6271 13573 : if (!lim) return v;
6272 13363 : gel(v,2) = gen_1;
6273 13363 : u_forprime_init(&T, 2, lim);
6274 : /* fill in prime powers first */
6275 116207 : while ((p = u_forprime_next(&T)))
6276 : {
6277 : GEN vP, vchiP, S;
6278 : long k, lP;
6279 : ulong q, qk;
6280 102844 : if (kross(D,p) >= 0) q = p;
6281 45192 : else if (!(q = umuluu_le(p,p,lim))) continue;
6282 : /* q = Norm P */
6283 65856 : vP = idealprimedec(nf, utoipos(p));
6284 65856 : lP = lg(vP);
6285 65856 : vchiP = cgetg(lP, t_VECSMALL);
6286 179081 : for (j = k = 1; j < lP; j++)
6287 : {
6288 113225 : GEN P = gel(vP,j);
6289 113225 : if (!idealval(nf, f, P)) vchiP[k++] = mfdiheval(bnr,w,P);
6290 : }
6291 65856 : if (k == 1) continue;
6292 62188 : setlg(vchiP, k); lP = k;
6293 62188 : if (lP == 2)
6294 : { /* one prime above p not dividing f */
6295 16765 : long s, s0 = vchiP[1];
6296 27069 : for (qk=q, s = s0;; s = Fl_add(s,s0,ordmax))
6297 : {
6298 27069 : S = Qab_zeta(s, ordmax, vt);
6299 27069 : gel(v, qk+1) = fix_pol(S, Pn, &trace);
6300 27069 : if (!(qk = umuluu_le(qk,q,lim))) break;
6301 : }
6302 : }
6303 : else /* two primes above p not dividing f */
6304 : {
6305 45423 : long s, s0 = vchiP[1], s1 = vchiP[2];
6306 45423 : for (qk=q, k = 1;; k++)
6307 18424 : { /* sum over a,b s.t. Norm( P1^a P2^b ) = q^k, i.e. a+b = k */
6308 : long a;
6309 63847 : GEN S = gen_0;
6310 220752 : for (a = 0; a <= k; a++)
6311 : {
6312 156905 : s = Fl_add(Fl_mul(a, s0, ordmax), Fl_mul(k-a, s1, ordmax), ordmax);
6313 156905 : S = gadd(S, Qab_zeta(s, ordmax, vt));
6314 : }
6315 63847 : gel(v, qk+1) = fix_pol(S, Pn, &trace);
6316 63847 : if (!(qk = umuluu_le(qk,q,lim))) break;
6317 : }
6318 : }
6319 : }
6320 : /* complete with nonprime powers */
6321 308098 : for (n = 2; n <= lim; n++)
6322 : {
6323 294735 : GEN S, fa = myfactoru(n), P = gel(fa, 1), E = gel(fa, 2);
6324 : long q;
6325 294735 : if (lg(P) == 2) continue;
6326 : /* not a prime power */
6327 143262 : q = upowuu(P[1],E[1]);
6328 143262 : S = gmul(gel(v, q + 1), gel(v, n/q + 1));
6329 143262 : gel(v, n+1) = fix_pol(S, Pn, &trace);
6330 : }
6331 13363 : if (trace)
6332 : {
6333 7154 : long k0 = k0j[1], jdeg = k0j[2];
6334 7154 : v = QabV_tracerel(Tinit, jdeg, v); /* Apply Galois Mod(k0, ordw) */
6335 7154 : if (k0 > 1) v = vecGalois(v, k0, gel(Tinit,1), m);
6336 : }
6337 13363 : return v;
6338 : }
6339 :
6340 : /* as cyc_normalize for t_VECSMALL cyc */
6341 : static GEN
6342 26810 : cyc_normalize_zv(GEN cyc)
6343 : {
6344 26810 : long i, o = cyc[1], l = lg(cyc); /* > 1 */
6345 26810 : GEN D = cgetg(l, t_VECSMALL);
6346 31185 : D[1] = o; for (i = 2; i < l; i++) D[i] = o / cyc[i];
6347 26810 : return D;
6348 : }
6349 : /* as char_normalize for t_VECSMALLs */
6350 : static GEN
6351 118517 : char_normalize_zv(GEN chi, GEN ncyc)
6352 : {
6353 118517 : long i, l = lg(chi);
6354 118517 : GEN c = cgetg(l, t_VECSMALL);
6355 118517 : if (l > 1) {
6356 118517 : c[1] = chi[1];
6357 160454 : for (i = 2; i < l; i++) c[i] = chi[i] * ncyc[i];
6358 : }
6359 118517 : return c;
6360 : }
6361 :
6362 : static GEN
6363 9331 : dihan_bnf(long D)
6364 : {
6365 9331 : GEN c = getrand(), bnf;
6366 9331 : setrand(gen_1);
6367 9331 : bnf = Buchall(quadpoly_i(stoi(D)), nf_FORCE, LOWDEFAULTPREC);
6368 9331 : setrand(c);
6369 9331 : return bnf;
6370 : }
6371 : static GEN
6372 37758 : dihan_bnr(GEN bnf, GEN A)
6373 : {
6374 37758 : GEN c = getrand(), bnr;
6375 37758 : setrand(gen_1);
6376 37758 : bnr = Buchray(bnf, A, nf_INIT|nf_GEN);
6377 37758 : setrand(c);
6378 37758 : return bnr;
6379 : }
6380 : /* Hecke xi * (D/.) = Dirichlet chi, return v in Q^r st chi(g_i) = e(v[i]).
6381 : * cycn = cyc_normalize_zv(bnr.cyc), chin = char_normalize_zv(chi,cyc) */
6382 : static GEN
6383 34489 : bnrchartwist2conrey(GEN chin, GEN cycn, GEN bnrconreyN, GEN kroconreyN)
6384 : {
6385 34489 : long l = lg(bnrconreyN), c1 = cycn[1], i;
6386 34489 : GEN v = cgetg(l, t_COL);
6387 125363 : for (i = 1; i < l; i++)
6388 : {
6389 90874 : GEN d = sstoQ(zv_dotproduct(chin, gel(bnrconreyN,i)), c1);
6390 90874 : if (kroconreyN[i] < 0) d = gadd(d, ghalf);
6391 90874 : gel(v,i) = d;
6392 : }
6393 34489 : return v;
6394 : }
6395 :
6396 : /* chi(g_i) = e(v[i]) denormalize wrt Conrey generators orders */
6397 : static GEN
6398 34489 : conreydenormalize(GEN znN, GEN v)
6399 : {
6400 34489 : GEN gcyc = znstar_get_conreycyc(znN), w;
6401 34489 : long l = lg(v), i;
6402 34489 : w = cgetg(l, t_COL);
6403 125363 : for (i = 1; i < l; i++)
6404 90874 : gel(w,i) = modii(gmul(gel(v,i), gel(gcyc,i)), gel(gcyc,i));
6405 34489 : return w;
6406 : }
6407 :
6408 : static long
6409 84028 : Miyake(GEN vchi, GEN gb, GEN cycn)
6410 : {
6411 84028 : long i, e = cycn[1], lb = lg(gb);
6412 84028 : GEN v = char_normalize_zv(vchi, cycn);
6413 124992 : for (i = 1; i < lb; i++)
6414 100268 : if ((zv_dotproduct(v, gel(gb,i)) - v[i]) % e) return 1;
6415 24724 : return 0;
6416 : }
6417 :
6418 : /* list of Hecke characters not induced by a Dirichlet character up to Galois
6419 : * conjugation, whose conductor is bnr.cond; cycn = cyc_normalize(bnr.cyc)*/
6420 : static GEN
6421 26810 : mklvchi(GEN bnr, GEN cycn, GEN gb)
6422 : {
6423 26810 : GEN cyc = bnr_get_cyc(bnr), cycsmall = ZV_to_zv(cyc);
6424 26810 : GEN vchi = cyc2elts(cycsmall);
6425 26810 : long ordmax = cycsmall[1], c, i, l;
6426 26810 : l = lg(vchi);
6427 304024 : for (i = c = 1; i < l; i++)
6428 : {
6429 277214 : GEN chi = gel(vchi,i);
6430 277214 : if (!gb || Miyake(chi, gb, cycn)) gel(vchi, c++) = Flv_to_ZV(chi);
6431 : }
6432 26810 : setlg(vchi, c); l = c;
6433 279300 : for (i = 1; i < l; i++)
6434 : {
6435 252490 : GEN chi = gel(vchi,i);
6436 : long n;
6437 252490 : if (!chi) continue;
6438 1055754 : for (n = 2; n < ordmax; n++)
6439 966476 : if (ugcd(n, ordmax) == 1)
6440 : {
6441 397670 : GEN tmp = ZV_ZV_mod(gmulsg(n, chi), cyc);
6442 : long j;
6443 7623539 : for (j = i+1; j < l; j++)
6444 7225869 : if (gel(vchi,j) && gequal(gel(vchi,j), tmp)) gel(vchi,j) = NULL;
6445 : }
6446 : }
6447 279300 : for (i = c = 1; i < l; i++)
6448 : {
6449 252490 : GEN chi = gel(vchi,i);
6450 252490 : if (chi && bnrisconductor(bnr, chi)) gel(vchi, c++) = chi;
6451 : }
6452 26810 : setlg(vchi, c); return vchi;
6453 : }
6454 :
6455 : static GEN
6456 7805 : get_gb(GEN bnr, GEN con)
6457 : {
6458 7805 : GEN gb, g = bnr_get_gen(bnr), nf = bnr_get_nf(bnr);
6459 7805 : long i, l = lg(g);
6460 7805 : gb = cgetg(l, t_VEC);
6461 18326 : for (i = 1; i < l; i++)
6462 10521 : gel(gb,i) = ZV_to_zv(isprincipalray(bnr, galoisapply(nf, con, gel(g,i))));
6463 7805 : return gb;
6464 : }
6465 : static GEN
6466 15862 : get_bnrconreyN(GEN bnr, GEN znN)
6467 : {
6468 15862 : GEN z, g = znstar_get_conreygen(znN);
6469 15862 : long i, l = lg(g);
6470 15862 : z = cgetg(l, t_VEC);
6471 57134 : for (i = 1; i < l; i++) gel(z,i) = ZV_to_zv(isprincipalray(bnr,gel(g,i)));
6472 15862 : return z;
6473 : }
6474 : /* con = NULL if D > 0 or if D < 0 and id != idcon. */
6475 : static GEN
6476 33698 : mfdihedralcommon(GEN bnf, GEN id, GEN znN, GEN kroconreyN, long vt,
6477 : long N, long D, GEN con)
6478 : {
6479 33698 : GEN bnr = dihan_bnr(bnf, id), cyc = ZV_to_zv( bnr_get_cyc(bnr) );
6480 : GEN bnrconreyN, cycn, cycN, Lvchi, res, P, vT;
6481 : long j, ordmax, l, lc, deghecke;
6482 :
6483 33698 : lc = lg(cyc); if (lc == 1) return NULL;
6484 26810 : cycn = cyc_normalize_zv(cyc);
6485 26810 : Lvchi = mklvchi(bnr, cycn, con? get_gb(bnr, con): NULL);
6486 26810 : l = lg(Lvchi);
6487 26810 : if (l == 1) return NULL;
6488 :
6489 15862 : bnrconreyN = get_bnrconreyN(bnr, znN);
6490 15862 : cycN = ZV_to_zv(znstar_get_cyc(znN));
6491 15862 : ordmax = cyc[1];
6492 15862 : vT = const_vec(odd(ordmax)? ordmax << 1: ordmax, NULL);
6493 15862 : P = polcyclo(ordmax, vt);
6494 15862 : gel(vT,ordmax) = Qab_trace_init(ordmax, ordmax, P, P);
6495 15862 : deghecke = myeulerphiu(ordmax);
6496 15862 : res = cgetg(l, t_VEC);
6497 50351 : for (j = 1; j < l; j++)
6498 : {
6499 34489 : GEN T, v, vchi = ZV_to_zv(gel(Lvchi,j));
6500 34489 : GEN chi, chin = char_normalize_zv(vchi, cycn);
6501 : long o, vnum, k0, degrel;
6502 34489 : v = bnrchartwist2conrey(chin, cycn, bnrconreyN, kroconreyN);
6503 34489 : o = itou(Q_denom(v));
6504 34489 : T = gel(vT, o);
6505 34489 : if (!T) gel(vT,o) = T = Qab_trace_init(ordmax, o, P, polcyclo(o,vt));
6506 34489 : chi = conreydenormalize(znN, v);
6507 34489 : vnum = itou(znconreyexp(znN, chi));
6508 34489 : chi = ZV_to_zv(znconreychar(znN,chi));
6509 34489 : degrel = deghecke / degpol(gel(T,1));
6510 34489 : k0 = zv_cyc_minimize(cycN, chi, coprimes_zv(o));
6511 34489 : vnum = Fl_powu(vnum, k0, N);
6512 : /* encodes degrel forms: jdeg = 0..degrel-1 */
6513 34489 : gel(res,j) = mkvec3(mkvecsmalln(5, N, k0 % o, vnum, D, degrel),
6514 : id, mkvec3(cycn,chin,T));
6515 : }
6516 15862 : return res;
6517 : }
6518 :
6519 : static long
6520 49364 : is_cond(long D, long n)
6521 : {
6522 49364 : if (D > 0) return n != 4 || (D&7L) == 1;
6523 30114 : return n != 2 && n != 3 && (n != 4 || (D&7L)!=1);
6524 : }
6525 : /* Append to v all dihedral weight 1 forms coming from D, if fundamental.
6526 : * level in [l1, l2] */
6527 : static void
6528 18718 : append_dihedral(GEN v, long D, long l1, long l2, long vt)
6529 : {
6530 18718 : long Da = labs(D), no, i, numi, ct, min, max;
6531 : GEN bnf, con, vI, resall, arch1, arch2;
6532 : pari_sp av;
6533 :
6534 : /* min <= Nf <= max */
6535 18718 : max = l2 / Da;
6536 18718 : if (l1 == l2)
6537 : { /* assume Da | l2 */
6538 140 : min = max;
6539 140 : if (D > 0 && min < 3) return;
6540 : }
6541 : else /* assume l1 < l2 */
6542 18578 : min = (l1 + Da-1)/Da;
6543 18718 : if (!sisfundamental(D)) return;
6544 :
6545 5726 : av = avma;
6546 5726 : bnf = dihan_bnf(D);
6547 5726 : con = nf2_get_conj(bnf_get_nf(bnf));
6548 5726 : vI = ideallist(bnf, max);
6549 55090 : numi = 0; for (i = min; i <= max; i++) numi += lg(gel(vI, i)) - 1;
6550 5726 : if (D > 0)
6551 : {
6552 1428 : numi <<= 1;
6553 1428 : arch1 = mkvec2(gen_1,gen_0);
6554 1428 : arch2 = mkvec2(gen_0,gen_1);
6555 : }
6556 : else
6557 4298 : arch1 = arch2 = NULL;
6558 5726 : resall = cgetg(numi+1, t_VEC); ct = 1;
6559 55090 : for (no = min; no <= max; no++) if (is_cond(D, no))
6560 : {
6561 44646 : long N = Da*no, lc, lI;
6562 44646 : GEN I = gel(vI, no), znN = znstar0(utoipos(N), 1), conreyN, kroconreyN;
6563 :
6564 44646 : conreyN = znstar_get_conreygen(znN); lc = lg(conreyN);
6565 44646 : kroconreyN = cgetg(lc, t_VECSMALL);
6566 166054 : for (i = 1; i < lc; i++) kroconreyN[i] = krosi(D, gel(conreyN, i));
6567 44646 : lI = lg(I);
6568 87822 : for (i = 1; i < lI; i++)
6569 : {
6570 43176 : GEN id = gel(I, i), idcon, z;
6571 : long j;
6572 43176 : if (typ(id) == t_INT) continue;
6573 28182 : idcon = galoisapply(bnf, con, id);
6574 51408 : for (j = i; j < lI; j++)
6575 51408 : if (gequal(idcon, gel(I, j))) { gel(I, j) = gen_0; break; }
6576 28182 : if (D < 0)
6577 : {
6578 17479 : GEN conk = i == j ? con : NULL;
6579 17479 : z = mfdihedralcommon(bnf, id, znN, kroconreyN, vt, N, D, conk);
6580 17479 : if (z) gel(resall, ct++) = z;
6581 : }
6582 : else
6583 : {
6584 : GEN ide;
6585 10703 : ide = mkvec2(id, arch1);
6586 10703 : z = mfdihedralcommon(bnf, ide, znN, kroconreyN, vt, N, D, NULL);
6587 10703 : if (z) gel(resall, ct++) = z;
6588 10703 : if (gequal(idcon,id)) continue;
6589 5516 : ide = mkvec2(id, arch2);
6590 5516 : z = mfdihedralcommon(bnf, ide, znN, kroconreyN, vt, N, D, NULL);
6591 5516 : if (z) gel(resall, ct++) = z;
6592 : }
6593 : }
6594 : }
6595 5726 : if (ct == 1) set_avma(av);
6596 : else
6597 : {
6598 4816 : setlg(resall, ct);
6599 4816 : vectrunc_append(v, gc_GEN(av, shallowconcat1(resall)));
6600 : }
6601 : }
6602 :
6603 : static long
6604 42042 : di_N(GEN a) { return gel(a,1)[1]; }
6605 : static GEN
6606 14 : mfdihedral(long N)
6607 : {
6608 14 : GEN D = mydivisorsu(N), res = vectrunc_init(2*N);
6609 14 : long j, l = lg(D), vt = fetch_user_var("t");
6610 105 : for (j = 2; j < l; j++)
6611 : { /* skip d = 1 */
6612 91 : long d = D[j];
6613 91 : if (d == 2) continue;
6614 84 : append_dihedral(res, -d, N,N, vt);
6615 84 : if (d >= 5 && D[l-j] >= 3) append_dihedral(res, d, N,N, vt);/* Nf >= 3 */
6616 : }
6617 14 : if (lg(res) > 1) res = shallowconcat1(res);
6618 14 : return res;
6619 : }
6620 : /* All primitive dihedral weight 1 forms of leven in [1, N], N > 1 */
6621 : static GEN
6622 14 : mfdihedralall(long N)
6623 : {
6624 14 : GEN res = vectrunc_init(2*N), z;
6625 14 : long D, ct, i, vt = fetch_user_var("t");
6626 :
6627 13986 : for (D = -3; D >= -N; D--) append_dihedral(res, D, 1,N, vt);
6628 : /* Nf >= 3 (GTM 193, prop 3.3.18) */
6629 4620 : for (D = N / 3; D >= 5; D--) append_dihedral(res, D, 1,N, vt);
6630 14 : ct = lg(res);
6631 14 : if (ct > 1)
6632 : { /* sort wrt N */
6633 14 : res = shallowconcat1(res);
6634 14 : res = vecpermute(res, indexvecsort(res, mkvecsmall(1)));
6635 14 : ct = lg(res);
6636 : }
6637 14 : z = const_vec(N, cgetg(1,t_VEC));
6638 7658 : for (i = 1; i < ct;)
6639 : { /* regroup result sharing the same N */
6640 7644 : long n = di_N(gel(res,i)), j = i+1, k;
6641 : GEN v;
6642 34412 : while (j < ct && di_N(gel(res,j)) == n) j++;
6643 7644 : gel(z, n) = v = cgetg(j-i+1, t_VEC);
6644 42056 : for (k = 1; i < j; k++,i++) gel(v,k) = gel(res,i);
6645 : }
6646 14 : return z;
6647 : }
6648 :
6649 : /* return [vF, index], where vecpermute(vF,index) generates dihedral forms
6650 : * for character CHI */
6651 : static GEN
6652 24969 : mfdihedralnew_i(long N, GEN CHI, GEN SP)
6653 : {
6654 : GEN bnf, Tinit, Pm, vf, M, V, NK;
6655 : long Dold, d, ordw, i, SB, c, l, k0, k1, chino, chinoorig, lv;
6656 :
6657 24969 : lv = lg(SP); if (lv == 1) return NULL;
6658 12138 : CHI = mfcharinduce(CHI,N);
6659 12138 : ordw = mfcharorder(CHI);
6660 12138 : chinoorig = mfcharno(CHI);
6661 12138 : k0 = mfconreyminimize(CHI);
6662 12138 : chino = Fl_powu(chinoorig, k0, N);
6663 12138 : k1 = Fl_inv(k0 % ordw, ordw);
6664 12138 : V = cgetg(lv, t_VEC);
6665 12138 : d = 0;
6666 39039 : for (i = l = 1; i < lv; i++)
6667 : {
6668 26901 : GEN sp = gel(SP,i), T = gel(sp,1);
6669 26901 : if (T[3] != chino) continue;
6670 4060 : d += T[5];
6671 4060 : if (k1 != 1)
6672 : {
6673 77 : GEN t = leafcopy(T);
6674 77 : t[3] = chinoorig;
6675 77 : t[2] = (t[2]*k1) % ordw;
6676 77 : sp = mkvec4(t, gel(sp,2), gel(sp,3), gel(sp,4));
6677 : }
6678 4060 : gel(V, l++) = sp;
6679 : }
6680 12138 : setlg(V, l); /* dihedral forms of level N and character CHI */
6681 12138 : if (l == 1) return NULL;
6682 :
6683 2555 : SB = mfsturmNk(N,1) + 1;
6684 2555 : M = cgetg(d+1, t_MAT);
6685 2555 : vf = cgetg(d+1, t_VEC);
6686 2555 : NK = mkNK(N, 1, CHI);
6687 2555 : bnf = NULL; Dold = 0;
6688 6615 : for (i = c = 1; i < l; i++)
6689 : { /* T = [N, k0, conreyno, D, degrel] */
6690 4060 : GEN bnr, Vi = gel(V,i), T = gel(Vi,1), id = gel(Vi,2), w = gel(Vi,3);
6691 4060 : long jdeg, k0i = T[2], D = T[4], degrel = T[5];
6692 :
6693 4060 : if (D != Dold) { Dold = D; bnf = dihan_bnf(D); }
6694 4060 : bnr = dihan_bnr(bnf, id);
6695 12054 : for (jdeg = 0; jdeg < degrel; jdeg++,c++)
6696 : {
6697 7994 : GEN k0j = mkvecsmall2(k0i, jdeg), an = dihan(bnr, w, k0j, ordw, SB);
6698 7994 : settyp(an, t_COL); gel(M,c) = an;
6699 7994 : gel(vf,c) = tag3(t_MF_DIHEDRAL, NK, bnr, w, k0j);
6700 : }
6701 : }
6702 2555 : Tinit = gmael3(V,1,3,3); Pm = gel(Tinit,1);
6703 2555 : V = QabM_indexrank(M, degpol(Pm)==1? NULL: Pm, ordw);
6704 2555 : return mkvec2(vf,gel(V,2));
6705 : }
6706 : static long
6707 16149 : mfdihedralnewdim(long N, GEN CHI, GEN SP)
6708 : {
6709 16149 : pari_sp av = avma;
6710 16149 : GEN S = mfdihedralnew_i(N, CHI, SP);
6711 16149 : return gc_long(av, S? lg(gel(S,2))-1: 0);
6712 : }
6713 : static GEN
6714 8820 : mfdihedralnew(long N, GEN CHI, GEN SP)
6715 : {
6716 8820 : pari_sp av = avma;
6717 8820 : GEN S = mfdihedralnew_i(N, CHI, SP);
6718 8820 : if (!S) retgc_const(av, cgetg(1, t_VEC));
6719 917 : return vecpermute(gel(S,1), gel(S,2));
6720 : }
6721 :
6722 : static long
6723 7105 : mfdihedralcuspdim(long N, GEN CHI, GEN vSP)
6724 : {
6725 7105 : pari_sp av = avma;
6726 : GEN D, CHIP;
6727 : long F, i, lD, dim;
6728 :
6729 7105 : CHIP = mfchartoprimitive(CHI, &F);
6730 7105 : D = mydivisorsu(N/F); lD = lg(D);
6731 7105 : dim = mfdihedralnewdim(N, CHI, gel(vSP,N)); /* d = 1 */
6732 16149 : for (i = 2; i < lD; i++)
6733 : {
6734 9044 : long d = D[i], a = mfdihedralnewdim(N/d, CHIP, gel(vSP, N/d));
6735 9044 : if (a) dim += a * mynumdivu(d);
6736 : }
6737 7105 : return gc_long(av,dim);
6738 : }
6739 :
6740 : static GEN
6741 7385 : mfbdall(GEN E, long N)
6742 : {
6743 7385 : GEN v, D = mydivisorsu(N);
6744 7385 : long i, j, nD = lg(D) - 1, nE = lg(E) - 1;
6745 7385 : v = cgetg(nD*nE + 1, t_VEC);
6746 10500 : for (j = 1; j <= nE; j++)
6747 : {
6748 3115 : GEN Ej = gel(E, j);
6749 9513 : for (i = 0; i < nD; i++) gel(v, i*nE + j) = mfbd_i(Ej, D[i+1]);
6750 : }
6751 7385 : return v;
6752 : }
6753 : static GEN
6754 3857 : mfdihedralcusp(long N, GEN CHI, GEN vSP)
6755 : {
6756 3857 : pari_sp av = avma;
6757 : GEN D, CHIP, z;
6758 : long F, i, lD;
6759 :
6760 3857 : CHIP = mfchartoprimitive(CHI, &F);
6761 3857 : D = mydivisorsu(N/F); lD = lg(D);
6762 3857 : z = cgetg(lD, t_VEC);
6763 3857 : gel(z,1) = mfdihedralnew(N, CHI, gel(vSP,N));
6764 8596 : for (i = 2; i < lD; i++) /* skip 1 */
6765 : {
6766 4739 : GEN LF = mfdihedralnew(N / D[i], CHIP, gel(vSP, N / D[i]));
6767 4739 : gel(z,i) = mfbdall(LF, D[i]);
6768 : }
6769 3857 : return gc_GEN(av, shallowconcat1(z));
6770 : }
6771 :
6772 : /* used to decide between ratlift and comatrix for ZM_inv; ratlift is better
6773 : * when N has many divisors */
6774 : static int
6775 2604 : abundant(ulong N) { return mynumdivu(N) >= 8; }
6776 :
6777 : /* CHI an mfchar */
6778 : static int
6779 371 : cmp_ord(void *E, GEN a, GEN b)
6780 : {
6781 371 : GEN chia = MF_get_CHI(a), chib = MF_get_CHI(b);
6782 371 : (void)E; return cmpii(gmfcharorder(chia), gmfcharorder(chib));
6783 : }
6784 : /* mfinit structure.
6785 : -- mf[1] contains [N,k,CHI,space],
6786 : -- mf[2] contains vector of closures of Eisenstein series, empty if not
6787 : full space.
6788 : -- mf[3] contains vector of closures, so #mf[3] = dimension of cusp/new space.
6789 : -- mf[4] contains the corresponding indices: either j for T(j)tf if newspace,
6790 : or [M,j,d] for B(d)T(j)tf_M if cuspspace or oldspace.
6791 : -- mf[5] contains the matrix M of first coefficients of basis, never cleaned.
6792 : * NK is either [N,k] or [N,k,CHI].
6793 : * mfinit does not do the splitting, only the basis generation. */
6794 :
6795 : /* Set flraw to 1 if do not need mf[5]: no mftobasis etc..., only the
6796 : expansions of the basis elements are needed. */
6797 :
6798 : static GEN
6799 5075 : mfinit_Nkchi(long N, long k, GEN CHI, long space, long flraw)
6800 : {
6801 5075 : GEN M = NULL, mf = NULL, mf1 = mkvec4(utoi(N), stoi(k), CHI, utoi(space));
6802 5075 : long sb = mfsturmNk(N, k);
6803 5075 : if (k < 0 || badchar(N, k, CHI)) return mfEMPTY(mf1);
6804 5040 : if (k == 0 || space == mf_EISEN) /*nothing*/;
6805 4879 : else if (k == 1)
6806 : {
6807 364 : switch (space)
6808 : {
6809 350 : case mf_NEW:
6810 : case mf_FULL:
6811 350 : case mf_CUSP: mf = mf1init(N, CHI, NULL, get_vDIH(N,NULL), space, flraw);
6812 350 : break;
6813 7 : case mf_OLD: pari_err_IMPL("mfinit in weight 1 for old space");
6814 7 : default: pari_err_FLAG("mfinit");
6815 : }
6816 : }
6817 : else /* k >= 2 */
6818 : {
6819 4515 : long ord = mfcharorder(CHI);
6820 4515 : GEN z = NULL, P = (ord <= 2)? NULL: mfcharpol(CHI);
6821 : cachenew_t cache;
6822 4515 : switch(space)
6823 : {
6824 1239 : case mf_NEW:
6825 1239 : mf = mfnewinit(N, k, CHI, &cache, 1);
6826 1239 : if (mf && !flraw) { M = MF_get_M(mf); z = MF_get_Mindex(mf); }
6827 1239 : break;
6828 3269 : case mf_OLD:
6829 : case mf_CUSP:
6830 : case mf_FULL:
6831 3269 : if (!(mf = mfinitcusp(N, k, CHI, &cache, space))) break;
6832 2961 : if (!flraw)
6833 : {
6834 2296 : M = bhnmat_extend(M, sb+1, 1, MF_get_S(mf), &cache);
6835 2296 : if (space != mf_FULL) gel(mf,5) = mfcleanCHI(M, CHI, abundant(N));
6836 : }
6837 2961 : dbg_cachenew(&cache); break;
6838 7 : default: pari_err_FLAG("mfinit");
6839 : }
6840 4508 : if (z) gel(mf,5) = mfclean2(M, z, P, ord);
6841 : }
6842 5019 : if (!mf) mf = mfEMPTY(mf1);
6843 : else
6844 : {
6845 4053 : gel(mf,1) = mf1;
6846 4053 : if (flraw) gel(mf,5) = zerovec(3);
6847 : }
6848 5019 : if (!space_is_cusp(space))
6849 : {
6850 861 : GEN E = mfeisensteinbasis(N, k, CHI);
6851 861 : gel(mf,2) = E;
6852 861 : if (!flraw)
6853 : {
6854 539 : if (M)
6855 231 : M = shallowconcat(mfvectomat(E, sb+1, 1), M);
6856 : else
6857 308 : M = mfcoefs_mf(mf, sb+1, 1);
6858 539 : gel(mf,5) = mfcleanCHI(M, CHI, abundant(N));
6859 : }
6860 : }
6861 5019 : return mf;
6862 : }
6863 :
6864 : /* mfinit for k = nk/dk */
6865 : static GEN
6866 2765 : mfinit_Nndkchi(long N, long nk, long dk, GEN CHI, long space, long flraw)
6867 273 : { return (dk == 2)? mf2init_Nkchi(N, nk >> 1, CHI, space, flraw)
6868 3038 : : mfinit_Nkchi(N, nk, CHI, space, flraw); }
6869 : static GEN
6870 3430 : mfinit_i(GEN NK, long space)
6871 : {
6872 : GEN CHI, mf;
6873 : long N, k, dk, joker;
6874 3430 : if (checkmf_i(NK))
6875 : {
6876 161 : N = mf_get_N(NK);
6877 161 : Qtoss(mf_get_gk(NK), &k, &dk);
6878 161 : CHI = mf_get_CHI(NK);
6879 : }
6880 3269 : else if ((mf = checkMF_i(NK)))
6881 : {
6882 21 : long s = MF_get_space(mf);
6883 21 : if (s == space) return mf;
6884 21 : Qtoss(MF_get_gk(mf), &k, &dk);
6885 21 : if (dk == 1 && k > 1 && space == mf_NEW && (s == mf_CUSP || s == mf_FULL))
6886 21 : return mfinittonew(mf);
6887 0 : N = MF_get_N(mf);
6888 0 : CHI = MF_get_CHI(mf);
6889 : }
6890 : else
6891 3248 : checkNK2(NK, &N, &k, &dk, &CHI, 1);
6892 3388 : joker = !CHI || typ(CHI) == t_COL;
6893 3388 : if (joker)
6894 : {
6895 1162 : GEN mf, vCHI = CHI;
6896 : long i, j, l;
6897 1162 : if (CHI && lg(CHI) == 1) return cgetg(1,t_VEC);
6898 1155 : if (k < 0) return mfEMPTYall(N, uutoQ(k,dk), CHI, space);
6899 1141 : if (k == 1 && dk == 1 && space != mf_EISEN)
6900 504 : {
6901 : GEN TMP, vSP, gN, gs;
6902 : pari_timer tt;
6903 1106 : if (space != mf_CUSP && space != mf_NEW)
6904 0 : pari_err_IMPL("mfinit([N,1,wildcard], space != cusp or new space)");
6905 1106 : if (wt1empty(N)) return mfEMPTYall(N, gen_1, CHI, space);
6906 504 : vCHI = mf1chars(N,vCHI);
6907 504 : l = lg(vCHI); mf = cgetg(l, t_VEC); if (l == 1) return mf;
6908 504 : TMP = mf1_pre(N); vSP = get_vDIH(N, NULL);
6909 504 : gN = utoipos(N); gs = utoi(space);
6910 504 : if (DEBUGLEVEL) timer_start(&tt);
6911 4123 : for (i = j = 1; i < l; i++)
6912 : {
6913 3619 : pari_sp av = avma;
6914 3619 : GEN c = gel(vCHI,i), z = mf1init(N, c, TMP, vSP, space, 0);
6915 3619 : if (z) z = gc_GEN(av, z);
6916 : else
6917 : {
6918 2905 : set_avma(av);
6919 2905 : if (CHI) z = mfEMPTY(mkvec4(gN,gen_1,c,gs));
6920 : }
6921 3619 : if (z) gel(mf, j++) = z;
6922 3619 : if (DEBUGLEVEL)
6923 0 : timer_printf(&tt, "mf1basis: character %ld / %ld (order = %ld)",
6924 : i, l-1, mfcharorder(c));
6925 : }
6926 : }
6927 : else
6928 : {
6929 35 : vCHI = mfchars(N,k,dk,vCHI);
6930 35 : l = lg(vCHI); mf = cgetg(l, t_VEC);
6931 119 : for (i = j = 1; i < l; i++)
6932 : {
6933 84 : pari_sp av = avma;
6934 84 : GEN v = mfinit_Nndkchi(N, k, dk, gel(vCHI,i), space, 0);
6935 84 : if (MF_get_dim(v) || CHI) gel(mf, j++) = v; else set_avma(av);
6936 : }
6937 : }
6938 539 : setlg(mf,j);
6939 539 : if (!CHI) gen_sort_inplace(mf, NULL, &cmp_ord, NULL);
6940 539 : return mf;
6941 : }
6942 2226 : return mfinit_Nndkchi(N, k, dk, CHI, space, 0);
6943 : }
6944 : GEN
6945 2450 : mfinit(GEN NK, long space)
6946 : {
6947 2450 : pari_sp av = avma;
6948 2450 : return gc_GEN(av, mfinit_i(NK, space));
6949 : }
6950 :
6951 : /* UTILITY FUNCTIONS */
6952 : static void
6953 364 : cusp_canon(GEN cusp, long N, long *pA, long *pC)
6954 : {
6955 364 : pari_sp av = avma;
6956 : long A, C, tc, cg;
6957 364 : if (N <= 0) pari_err_DOMAIN("mfcuspwidth","N","<=",gen_0,stoi(N));
6958 357 : if (!cusp || (tc = typ(cusp)) == t_INFINITY) { *pA = 1; *pC = N; return; }
6959 350 : if (tc != t_INT && tc != t_FRAC) pari_err_TYPE("checkcusp", cusp);
6960 350 : Qtoss(cusp, &A,&C);
6961 350 : if (N % C)
6962 : {
6963 : ulong uC;
6964 14 : long u = Fl_invgen((C-1)%N + 1, N, &uC);
6965 14 : A = Fl_mul(A, u, N);
6966 14 : C = (long)uC;
6967 : }
6968 350 : cg = ugcd(C, N/C);
6969 420 : while (ugcd(A, N) > 1) A += cg;
6970 350 : *pA = A % N; *pC = C; set_avma(av);
6971 : }
6972 : static long
6973 1001 : mfcuspcanon_width(long N, long C)
6974 1001 : { return (!C || C == N)? 1 : N / ugcd(N, Fl_sqr(umodsu(C,N),N)); }
6975 : /* v = [a,c] a ZC, width of cusp (a:c) */
6976 : static long
6977 9975 : mfZC_width(long N, GEN v)
6978 : {
6979 9975 : ulong C = umodiu(gel(v,2), N);
6980 9975 : return (C == 0)? 1: N / ugcd(N, Fl_sqr(C,N));
6981 : }
6982 : long
6983 161 : mfcuspwidth(GEN gN, GEN cusp)
6984 : {
6985 161 : long N = 0, A, C;
6986 : GEN mf;
6987 161 : if (typ(gN) == t_INT) N = itos(gN);
6988 42 : else if ((mf = checkMF_i(gN))) N = MF_get_N(mf);
6989 0 : else pari_err_TYPE("mfcuspwidth", gN);
6990 161 : cusp_canon(cusp, N, &A, &C);
6991 154 : return mfcuspcanon_width(N, C);
6992 : }
6993 :
6994 : /* Q a t_INT */
6995 : static GEN
6996 14 : findq(GEN al, GEN Q)
6997 : {
6998 : long n;
6999 14 : if (typ(al) == t_FRAC && cmpii(gel(al,2), Q) <= 0)
7000 0 : return mkvec(mkvec2(gel(al,1), gel(al,2)));
7001 14 : n = 1 + (long)ceil(2.0781*gtodouble(glog(Q, LOWDEFAULTPREC)));
7002 14 : return contfracpnqn(gboundcf(al,n), n);
7003 : }
7004 : static GEN
7005 91 : findqga(long N, GEN z)
7006 : {
7007 91 : GEN Q, LDC, CK = NULL, DK = NULL, ma, x, y = imag_i(z);
7008 : long j, l;
7009 91 : if (gcmpgs(gmulsg(2*N, y), 1) >= 0) return NULL;
7010 14 : x = real_i(z);
7011 14 : Q = ground(ginv(gsqrt(gmulsg(N, y), LOWDEFAULTPREC)));
7012 14 : LDC = findq(gmulsg(-N,x), Q);
7013 14 : ma = gen_1; l = lg(LDC);
7014 35 : for (j = 1; j < l; j++)
7015 : {
7016 21 : GEN D, DC = gel(LDC,j), C1 = gel(DC,2);
7017 21 : if (cmpii(C1,Q) > 0) break;
7018 21 : D = gel(DC,1);
7019 21 : if (ugcdiu(D,N) == 1)
7020 : {
7021 7 : GEN C = mului(N, C1), den;
7022 7 : den = gadd(gsqr(gmul(C,y)), gsqr(gadd(D, gmul(C,x))));
7023 7 : if (gcmp(den, ma) < 0) { ma = den; CK = C; DK = D; }
7024 : }
7025 : }
7026 14 : return DK? mkvec2(CK, DK): NULL;
7027 : }
7028 :
7029 : static long
7030 168 : valNC2(GEN P, GEN E, long e)
7031 : {
7032 168 : long i, d = 1, l = lg(P);
7033 504 : for (i = 1; i < l; i++)
7034 : {
7035 336 : long v = u_lval(e, P[i]) << 1;
7036 336 : if (v == E[i] + 1) v--;
7037 336 : d *= upowuu(P[i], v);
7038 : }
7039 168 : return d;
7040 : }
7041 :
7042 : static GEN
7043 49 : findqganew(long N, GEN z)
7044 : {
7045 49 : GEN MI, DI, x = real_i(z), y = imag_i(z), Ck = gen_0, Dk = gen_1, fa, P, E;
7046 : long i;
7047 49 : MI = uutoQ(1,N);
7048 49 : DI = mydivisorsu(mysqrtu(N));
7049 49 : fa = myfactoru(N); P = gel(fa,1); E = gel(fa,2);
7050 217 : for (i = 1; i < lg(DI); i++)
7051 : {
7052 168 : long e = DI[i], g;
7053 : GEN U, C, D, m;
7054 168 : (void)cxredsl2(gmulsg(e, z), &U);
7055 168 : C = gcoeff(U,2,1); if (!signe(C)) continue;
7056 168 : D = gcoeff(U,2,2);
7057 168 : g = ugcdiu(D,e);
7058 168 : if (g > 1) { C = muliu(C,e/g); D = diviuexact(D,g); } else C = muliu(C,e);
7059 168 : m = gadd(gsqr(gadd(gmul(C, x), D)), gsqr(gmul(C, y)));
7060 168 : m = gdivgu(m, valNC2(P, E, e));
7061 168 : if (gcmp(m, MI) < 0) { MI = m; Ck = C; Dk = D; }
7062 : }
7063 49 : return signe(Ck)? mkvec2(Ck, Dk): NULL;
7064 : }
7065 :
7066 : /* Return z' and U = [a,b;c,d] \in SL_2(Z), z' = U*z,
7067 : * Im(z')/width(U.oo) > sqrt(3)/(2N). Set *pczd = c*z+d */
7068 : static GEN
7069 182 : cxredga0N(long N, GEN z, GEN *pU, GEN *pczd, long flag)
7070 : {
7071 182 : GEN v = NULL, A, B, C, D;
7072 : long e;
7073 182 : if (N == 1) return cxredsl2_i(z, pU, pczd);
7074 140 : e = gexpo(gel(z,2));
7075 140 : if (e < 0) z = gprec_wensure(z, precision(z) + nbits2extraprec(-e));
7076 140 : v = flag? findqganew(N,z): findqga(N,z);
7077 140 : if (!v) { *pU = matid(2); *pczd = gen_1; return z; }
7078 56 : C = gel(v,1);
7079 56 : D = gel(v,2);
7080 56 : if (!is_pm1(bezout(C,D, &B,&A))) pari_err_BUG("cxredga0N [gcd > 1]");
7081 56 : B = negi(B);
7082 56 : *pU = mkmat2(mkcol2(A,C), mkcol2(B,D));
7083 56 : *pczd = gadd(gmul(C,z), D);
7084 56 : return gdiv(gadd(gmul(A,z), B), *pczd);
7085 : }
7086 :
7087 : static GEN
7088 161 : lfunthetaall(GEN b, GEN vL, GEN t, long bitprec)
7089 : {
7090 161 : long i, l = lg(vL);
7091 161 : GEN v = cgetg(l, t_VEC);
7092 350 : for (i = 1; i < l; i++)
7093 : {
7094 189 : GEN T, L = gel(vL,i), a0 = gel(L,1), ldata = gel(L,2);
7095 189 : GEN van = gel(ldata_get_an(ldata),2);
7096 189 : if (lg(van) == 1)
7097 : {
7098 0 : T = gmul(b, a0);
7099 0 : if (isexactzero(T)) { GEN z = real_0_bit(-bitprec); T = mkcomplex(z,z); }
7100 : }
7101 : else
7102 : {
7103 189 : T = gmul2n(lfuntheta(ldata, t, 0, bitprec), -1);
7104 189 : T = gmul(b, gadd(a0, T));
7105 : }
7106 189 : gel(v,i) = T;
7107 : }
7108 161 : return l == 2? gel(v,1): v;
7109 : }
7110 :
7111 : /* P in ZX, irreducible */
7112 : static GEN
7113 182 : ZX_roots(GEN P, long prec)
7114 : {
7115 182 : long d = degpol(P);
7116 182 : if (d == 1) return mkvec(gen_0);
7117 182 : if (d == 2 && isint1(gel(P,2)) && isintzero(gel(P,3)) && isint1(gel(P,4)))
7118 7 : return mkvec2(powIs(3), gen_I()); /* order as polroots */
7119 294 : return (ZX_sturm_irred(P) == d)? ZX_realroots_irred(P, prec)
7120 294 : : QX_complex_roots(P, prec);
7121 : }
7122 : /* initializations for RgX_RgV_eval / RgC_embed */
7123 : static GEN
7124 217 : rootspowers(GEN v)
7125 : {
7126 217 : long i, l = lg(v);
7127 217 : GEN w = cgetg(l, t_VEC);
7128 868 : for (i = 1; i < l; i++) gel(w,i) = gpowers(gel(v,i), l-2);
7129 217 : return w;
7130 : }
7131 : /* mf embeddings attached to Q(chi)/(T), chi attached to cyclotomic P */
7132 : static GEN
7133 938 : getembed(GEN P, GEN T, GEN zcyclo, long prec)
7134 : {
7135 : long i, l;
7136 : GEN v;
7137 938 : if (degpol(P) == 1) P = NULL; /* mfcharpol for quadratic char */
7138 938 : if (degpol(T) == 1) T = NULL; /* dim 1 orbit */
7139 938 : if (T && P)
7140 35 : { /* K(y) / (T(y)), K = Q(t)/(P) cyclotomic */
7141 35 : GEN vr = RgX_is_ZX(T)? ZX_roots(T,prec): roots(RgX_embed1(T,zcyclo), prec);
7142 35 : v = rootspowers(vr); l = lg(v);
7143 105 : for (i = 1; i < l; i++) gel(v,i) = mkcol3(P,zcyclo,gel(v,i));
7144 : }
7145 903 : else if (T)
7146 : { /* Q(y) / (T(y)), T noncyclotomic */
7147 182 : GEN vr = ZX_roots(T, prec);
7148 182 : v = rootspowers(vr); l = lg(v);
7149 763 : for (i = 1; i < l; i++) gel(v,i) = mkcol2(T, gel(v,i));
7150 : }
7151 : else /* cyclotomic or rational */
7152 721 : v = mkvec(P? mkvec2(P, zcyclo): cgetg(1,t_VEC));
7153 938 : return v;
7154 : }
7155 : static GEN
7156 791 : grootsof1_CHI(GEN CHI, long prec)
7157 791 : { return grootsof1(mfcharorder(CHI), prec); }
7158 : /* return the [Q(F):Q(chi)] embeddings of F */
7159 : static GEN
7160 623 : mfgetembed(GEN F, long prec)
7161 : {
7162 623 : GEN T = mf_get_field(F), CHI = mf_get_CHI(F), P = mfcharpol(CHI);
7163 623 : return getembed(P, T, grootsof1_CHI(CHI, prec), prec);
7164 : }
7165 : static GEN
7166 7 : mfchiembed(GEN mf, long prec)
7167 : {
7168 7 : GEN CHI = MF_get_CHI(mf), P = mfcharpol(CHI);
7169 7 : return getembed(P, pol_x(0), grootsof1_CHI(CHI, prec), prec);
7170 : }
7171 : /* mfgetembed for the successive eigenforms in MF_get_newforms */
7172 : static GEN
7173 161 : mfeigenembed(GEN mf, long prec)
7174 : {
7175 161 : GEN vP = MF_get_fields(mf), vF = MF_get_newforms(mf);
7176 161 : GEN zcyclo, vE, CHI = MF_get_CHI(mf), P = mfcharpol(CHI);
7177 161 : long i, l = lg(vP);
7178 161 : vF = Q_remove_denom(liftpol_shallow(vF), NULL);
7179 161 : prec += nbits2extraprec(gexpo(vF));
7180 161 : zcyclo = grootsof1_CHI(CHI, prec);
7181 161 : vE = cgetg(l, t_VEC);
7182 469 : for (i = 1; i < l; i++) gel(vE,i) = getembed(P, gel(vP,i), zcyclo, prec);
7183 161 : return vE;
7184 : }
7185 :
7186 : static int
7187 28 : checkPv(GEN P, GEN v)
7188 28 : { return typ(P) == t_POL && is_vec_t(typ(v)) && lg(v)-1 >= degpol(P); }
7189 : static int
7190 28 : checkemb_i(GEN E)
7191 : {
7192 28 : long t = typ(E), l = lg(E);
7193 28 : if (t == t_VEC) return l == 1 || (l == 3 && checkPv(gel(E,1), gel(E,2)));
7194 21 : if (t != t_COL) return 0;
7195 21 : if (l == 3) return checkPv(gel(E,1), gel(E,2));
7196 21 : return l == 4 && is_vec_t(typ(gel(E,2))) && checkPv(gel(E,1), gel(E,3));
7197 : }
7198 : static GEN
7199 28 : anyembed(GEN v, GEN E)
7200 : {
7201 28 : switch(typ(v))
7202 : {
7203 21 : case t_VEC: case t_COL: return mfvecembed(E, v);
7204 7 : case t_MAT: return mfmatembed(E, v);
7205 : }
7206 0 : return mfembed(E, v);
7207 : }
7208 : GEN
7209 49 : mfembed0(GEN E, GEN v, long prec)
7210 : {
7211 49 : pari_sp av = avma;
7212 49 : GEN mf, vE = NULL;
7213 49 : if (checkmf_i(E)) vE = mfgetembed(E, prec);
7214 35 : else if ((mf = checkMF_i(E))) vE = mfchiembed(mf, prec);
7215 49 : if (vE)
7216 : {
7217 21 : long i, l = lg(vE);
7218 : GEN w;
7219 21 : if (!v) return gc_GEN(av, l == 2? gel(vE,1): vE);
7220 0 : w = cgetg(l, t_VEC);
7221 0 : for (i = 1; i < l; i++) gel(w,i) = anyembed(v, gel(vE,i));
7222 0 : return gc_GEN(av, l == 2? gel(w,1): w);
7223 : }
7224 28 : if (!checkemb_i(E) || !v) pari_err_TYPE("mfembed", E);
7225 28 : return gc_GEN(av, anyembed(v,E));
7226 : }
7227 :
7228 : /* dummy lfun create for theta evaluation */
7229 : static GEN
7230 980 : mfthetaancreate(GEN van, GEN N, GEN k)
7231 : {
7232 980 : GEN L = zerovec(6);
7233 980 : gel(L,1) = lfuntag(t_LFUN_GENERIC, van);
7234 980 : gel(L,3) = mkvec2(gen_0, gen_1);
7235 980 : gel(L,4) = k;
7236 980 : gel(L,5) = N; return L;
7237 : }
7238 : /* destroy van and prepare to evaluate theta(sigma(van)), for all sigma in
7239 : * embeddings vector vE */
7240 : static GEN
7241 357 : van_embedall(GEN van, GEN vE, GEN gN, GEN gk)
7242 : {
7243 357 : GEN a0 = gel(van,1), vL;
7244 357 : long i, lE = lg(vE), l = lg(van);
7245 357 : van++; van[0] = evaltyp(t_VEC) | _evallg(l-1); /* remove a0 */
7246 357 : vL = cgetg(lE, t_VEC);
7247 945 : for (i = 1; i < lE; i++)
7248 : {
7249 588 : GEN E = gel(vE,i), v = mfvecembed(E, van);
7250 588 : gel(vL,i) = mkvec2(mfembed(E,a0), mfthetaancreate(v, gN, gk));
7251 : }
7252 357 : return vL;
7253 : }
7254 :
7255 : static int
7256 1134 : cusp_AC(GEN cusp, long *A, long *C)
7257 : {
7258 1134 : switch(typ(cusp))
7259 : {
7260 140 : case t_INFINITY: *A = 1; *C = 0; break;
7261 301 : case t_INT: *A = itos(cusp); *C = 1; break;
7262 448 : case t_FRAC: *A = itos(gel(cusp, 1)); *C = itos(gel(cusp, 2)); break;
7263 245 : case t_REAL: case t_COMPLEX:
7264 245 : *A = 0; *C = 0;
7265 245 : if (gsigne(imag_i(cusp)) <= 0)
7266 7 : pari_err_DOMAIN("mfeval","imag(tau)","<=",gen_0,cusp);
7267 238 : return 0;
7268 0 : default: pari_err_TYPE("cusp_AC", cusp);
7269 : }
7270 889 : return 1;
7271 : }
7272 : static GEN
7273 518 : cusp2mat(long A, long C)
7274 : { long B, D;
7275 518 : cbezout(A, C, &D, &B);
7276 518 : return mkmat22s(A, -B, C, D);
7277 : }
7278 : static GEN
7279 21 : mkS(void) { return mkmat22s(0,-1,1,0); }
7280 :
7281 : /* if t is a cusp, return F(t), else NULL */
7282 : static GEN
7283 364 : evalcusp(GEN mf, GEN F, GEN t, long prec)
7284 : {
7285 : long A, C;
7286 : GEN R;
7287 364 : if (!cusp_AC(t, &A,&C)) return NULL;
7288 196 : if (C % mf_get_N(F) == 0) return gel(mfcoefs_i(F, 0, 1), 1);
7289 175 : R = mfgaexpansion(mf, F, cusp2mat(A,C), 0, prec);
7290 175 : return gequal0(gel(R,1))? gmael(R,3,1): gen_0;
7291 : }
7292 : /* Evaluate an mf closure numerically, i.e., in the usual sense, either for a
7293 : * single tau or a vector of tau; for each, return a vector of results
7294 : * corresponding to all complex embeddings of F. If flag is nonzero, allow
7295 : * replacing F by F | gamma to increase imag(gamma^(-1).tau) [ expensive if
7296 : * MF_EISENSPACE not present ] */
7297 : static GEN
7298 168 : mfeval_i(GEN mf, GEN F, GEN vtau, long flag, long bitprec)
7299 : {
7300 : GEN L0, vL, vb, sqN, vczd, vTAU, vs, van, vE;
7301 168 : long N = MF_get_N(mf), N0, ta, lv, i, prec = nbits2prec(bitprec);
7302 168 : GEN gN = utoipos(N), gk = mf_get_gk(F), gk1 = gsubgs(gk,1), vgk;
7303 168 : long flscal = 0;
7304 :
7305 : /* gen_0 is ignored, second component assumes Ramanujan-Petersson in
7306 : * 1/2-integer weight */
7307 168 : vgk = mkvec2(gen_0, mfiscuspidal(mf,F)? gmul2n(gk1,-1): gk1);
7308 168 : ta = typ(vtau);
7309 168 : if (!is_vec_t(ta)) { flscal = 1; vtau = mkvec(vtau); ta = t_VEC; }
7310 168 : lv = lg(vtau);
7311 168 : sqN = sqrtr_abs(utor(N, prec));
7312 168 : vs = const_vec(lv-1, NULL);
7313 168 : vb = const_vec(lv-1, NULL);
7314 168 : vL = cgetg(lv, t_VEC);
7315 168 : vTAU = cgetg(lv, t_VEC);
7316 168 : vczd = cgetg(lv, t_VEC);
7317 168 : L0 = mfthetaancreate(NULL, gN, vgk); /* only for thetacost */
7318 168 : vE = mfgetembed(F, prec);
7319 168 : N0 = 0;
7320 357 : for (i = 1; i < lv; i++)
7321 : {
7322 196 : GEN z = gel(vtau,i), tau, U;
7323 : long w, n;
7324 :
7325 196 : gel(vs,i) = evalcusp(mf, F, z, prec);
7326 189 : if (gel(vs,i)) continue;
7327 161 : tau = cxredga0N(N, z, &U, &gel(vczd,i), flag);
7328 161 : if (!flag) w = 0; else { w = mfZC_width(N, gel(U,1)); tau = gdivgu(tau,w); }
7329 161 : gel(vTAU,i) = mulcxmI(gmul(tau, sqN));
7330 161 : n = lfunthetacost(L0, real_i(gel(vTAU,i)), 0, bitprec, NULL);
7331 161 : if (N0 < n) N0 = n;
7332 161 : if (flag)
7333 : {
7334 49 : GEN A, al, v = mfslashexpansion(mf, F, ZM_inv(U,NULL), n, 0, &A, prec);
7335 49 : gel(vL,i) = van_embedall(v, vE, gN, vgk);
7336 49 : al = gel(A,1);
7337 49 : if (!gequal0(al))
7338 7 : gel(vb,i) = gexp(gmul(gmul(gmulsg(w,al),PiI2(prec)), tau), prec);
7339 : }
7340 : }
7341 161 : if (!flag)
7342 : {
7343 112 : van = mfcoefs_i(F, N0, 1);
7344 112 : vL = const_vec(lv-1, van_embedall(van, vE, gN, vgk));
7345 : }
7346 350 : for (i = 1; i < lv; i++)
7347 : {
7348 : GEN T;
7349 189 : if (gel(vs,i)) continue;
7350 161 : T = gpow(gel(vczd,i), gneg(gk), prec);
7351 161 : if (flag && gel(vb,i)) T = gmul(T, gel(vb,i));
7352 161 : gel(vs,i) = lfunthetaall(T, gel(vL,i), gel(vTAU,i), bitprec);
7353 : }
7354 161 : return flscal? gel(vs,1): vs;
7355 : }
7356 :
7357 : static long
7358 1372 : mfistrivial(GEN F)
7359 : {
7360 1372 : switch(mf_get_type(F))
7361 : {
7362 7 : case t_MF_CONST: return lg(gel(F,2)) == 1;
7363 287 : case t_MF_LINEAR: case t_MF_LINEAR_BHN: return gequal0(gel(F,3));
7364 1078 : default: return 0;
7365 : }
7366 : }
7367 :
7368 : static long
7369 1190 : mf_same_k(GEN mf, GEN f) { return gequal(MF_get_gk(mf), mf_get_gk(f)); }
7370 : static long
7371 1148 : mf_same_CHI(GEN mf, GEN f)
7372 : {
7373 1148 : GEN F1, F2, chi1, chi2, CHI1 = MF_get_CHI(mf), CHI2 = mf_get_CHI(f);
7374 : /* are the primitive chars attached to CHI1 and CHI2 equal ? */
7375 1148 : F1 = znconreyconductor(gel(CHI1,1), gel(CHI1,2), &chi1);
7376 1148 : if (typ(F1) == t_VEC) F1 = gel(F1,1);
7377 1148 : F2 = znconreyconductor(gel(CHI2,1), gel(CHI2,2), &chi2);
7378 1148 : if (typ(F2) == t_VEC) F2 = gel(F2,1);
7379 1148 : return equalii(F1,F2) && ZV_equal(chi1,chi2);
7380 : }
7381 : /* check k and CHI rigorously, but not coefficients nor N */
7382 : static long
7383 259 : mfisinspace_i(GEN mf, GEN F)
7384 : {
7385 259 : return mfistrivial(F) || (mf_same_k(mf,F) && mf_same_CHI(mf,F));
7386 : }
7387 : static void
7388 7 : err_space(GEN F)
7389 7 : { pari_err_DOMAIN("mftobasis", "form", "does not belong to",
7390 0 : strtoGENstr("space"), F); }
7391 :
7392 : static long
7393 154 : mfcheapeisen(GEN mf)
7394 : {
7395 154 : long k, L, N = MF_get_N(mf);
7396 : GEN P;
7397 154 : if (N <= 70) return 1;
7398 84 : k = itos(gceil(MF_get_gk(mf)));
7399 84 : if (odd(k)) k--;
7400 84 : switch (k)
7401 : {
7402 0 : case 2: L = 190; break;
7403 14 : case 4: L = 162; break;
7404 70 : case 6:
7405 70 : case 8: L = 88; break;
7406 0 : case 10: L = 78; break;
7407 0 : default: L = 66; break;
7408 : }
7409 84 : P = gel(myfactoru(N), 1);
7410 84 : return P[lg(P)-1] <= L;
7411 : }
7412 :
7413 : static GEN
7414 189 : myimag_i(GEN x)
7415 : {
7416 189 : long tc = typ(x);
7417 189 : if (tc == t_INFINITY || tc == t_INT || tc == t_FRAC) return gen_1;
7418 196 : if (tc == t_VEC) pari_APPLY_same(myimag_i(gel(x,i)));
7419 154 : return imag_i(x);
7420 : }
7421 :
7422 : static GEN
7423 154 : mintau(GEN vtau)
7424 : {
7425 154 : if (!is_vec_t(typ(vtau))) return myimag_i(vtau);
7426 7 : return (lg(vtau) == 1)? gen_1: vecmin(myimag_i(vtau));
7427 : }
7428 :
7429 : /* initialization for mfgaexpansion: what does not depend on cusp */
7430 : static GEN
7431 1218 : mf_eisendec(GEN mf, GEN F, long prec)
7432 : {
7433 1218 : GEN B = liftpol_shallow(mfeisensteindec(mf, F)), v = variables_vecsmall(B);
7434 1218 : GEN Mvecj = obj_check(mf, MF_EISENSPACE);
7435 1218 : long l = lg(v), i, ord;
7436 1218 : if (lg(Mvecj) < 5) Mvecj = gel(Mvecj,1);
7437 1218 : ord = itou(gel(Mvecj,4));
7438 1274 : for (i = 1; i < l; i++)
7439 924 : if (v[i] != 1)
7440 : {
7441 : GEN d;
7442 : long e;
7443 868 : B = Q_remove_denom(B, &d);
7444 868 : e = gexpo(B);
7445 868 : if (e > 0) prec += nbits2prec(e);
7446 868 : B = gsubst(B, v[i], rootsof1u_cx(ord, prec));
7447 868 : if (d) B = gdiv(B, d);
7448 868 : break;
7449 : }
7450 1218 : return B;
7451 : }
7452 :
7453 : GEN
7454 168 : mfeval(GEN mf0, GEN F, GEN vtau, long bitprec)
7455 : {
7456 168 : pari_sp av = avma;
7457 168 : long flnew = 1;
7458 168 : GEN mf = checkMF_i(mf0);
7459 168 : if (!mf) pari_err_TYPE("mfeval", mf0);
7460 168 : if (!checkmf_i(F)) pari_err_TYPE("mfeval", F);
7461 168 : if (!mfisinspace_i(mf, F)) err_space(F);
7462 168 : if (!obj_check(mf, MF_EISENSPACE)) flnew = mfcheapeisen(mf);
7463 168 : if (flnew && gcmpgs(gmulsg(2*MF_get_N(mf), mintau(vtau)), 1) >= 0) flnew = 0;
7464 168 : return gc_GEN(av, mfeval_i(mf, F, vtau, flnew, bitprec));
7465 : }
7466 :
7467 : static long
7468 189 : val(GEN v, long bit)
7469 : {
7470 189 : long c, l = lg(v);
7471 392 : for (c = 1; c < l; c++)
7472 378 : if (gexpo(gel(v,c)) > -bit) return c-1;
7473 14 : return -1;
7474 : }
7475 : GEN
7476 203 : mfcuspval(GEN mf, GEN F, GEN cusp, long bitprec)
7477 : {
7478 203 : pari_sp av = avma;
7479 203 : long lvE, w, N, sb, n, A, C, prec = nbits2prec(bitprec);
7480 : GEN ga, gk, vE;
7481 203 : mf = checkMF(mf);
7482 203 : if (!checkmf_i(F)) pari_err_TYPE("mfcuspval",F);
7483 203 : N = MF_get_N(mf);
7484 203 : cusp_canon(cusp, N, &A, &C);
7485 203 : gk = mf_get_gk(F);
7486 203 : if (typ(gk) != t_INT)
7487 : {
7488 42 : GEN FT = mfmultheta(F), mf2 = obj_checkbuild(mf, MF_MF2INIT, &mf2init);
7489 42 : GEN r = mfcuspval(mf2, FT, cusp, bitprec);
7490 42 : if ((C & 3L) == 2)
7491 : {
7492 14 : GEN z = uutoQ(1,4);
7493 14 : r = gsub(r, typ(r) == t_VEC? const_vec(lg(r)-1, z): z);
7494 : }
7495 42 : return gc_upto(av, r);
7496 : }
7497 161 : vE = mfgetembed(F, prec);
7498 161 : lvE = lg(vE);
7499 161 : w = mfcuspcanon_width(N, C);
7500 161 : sb = w * mfsturmNk(N, itos(gk));
7501 161 : ga = cusp2mat(A,C);
7502 168 : for (n = 8;; n = minss(sb, n << 1))
7503 7 : {
7504 168 : GEN R = mfgaexpansion(mf, F, ga, n, prec), res = liftpol_shallow(gel(R,3));
7505 168 : GEN v = cgetg(lvE-1, t_VECSMALL);
7506 168 : long j, ok = 1;
7507 168 : res = RgC_embedall(res, vE);
7508 357 : for (j = 1; j < lvE; j++)
7509 : {
7510 189 : v[j] = val(gel(res,j), bitprec/2);
7511 189 : if (v[j] < 0) ok = 0;
7512 : }
7513 168 : if (ok)
7514 : {
7515 154 : res = cgetg(lvE, t_VEC);
7516 329 : for (j = 1; j < lvE; j++) gel(res,j) = gadd(gel(R,1), uutoQ(v[j], w));
7517 154 : return gc_GEN(av, lvE==2? gel(res,1): res);
7518 : }
7519 14 : if (n == sb) return lvE==2? mkoo(): const_vec(lvE-1, mkoo()); /* 0 */
7520 : }
7521 : }
7522 :
7523 : long
7524 238 : mfiscuspidal(GEN mf, GEN F)
7525 : {
7526 238 : pari_sp av = avma;
7527 : GEN mf2;
7528 238 : if (space_is_cusp(MF_get_space(mf))) return 1;
7529 105 : if (typ(mf_get_gk(F)) == t_INT)
7530 : {
7531 63 : GEN v = mftobasis(mf,F,0), vE;
7532 63 : if (lg(v)==1) return gc_long(av, 0);
7533 63 : vE = vecslice(v, 1, lg(MF_get_E(mf))-1);
7534 63 : return gc_long(av, gequal0(vE));
7535 : }
7536 42 : if (!gequal0(mfak_i(F, 0))) return 0;
7537 21 : mf2 = obj_checkbuild(mf, MF_MF2INIT, &mf2init);
7538 21 : return mfiscuspidal(mf2, mfmultheta(F));
7539 : }
7540 :
7541 : /* F = vector of newforms in mftobasis format */
7542 : static GEN
7543 119 : mffrickeeigen_i(GEN mf, GEN F, GEN vE, long prec)
7544 : {
7545 119 : GEN M, Z, L0, gN = MF_get_gN(mf), gk = MF_get_gk(mf);
7546 119 : long N0, i, lM, bit = prec2nbits(prec), k = itou(gk);
7547 119 : long LIM = 5; /* Sturm bound is enough */
7548 :
7549 119 : L0 = mfthetaancreate(NULL, gN, gk); /* only for thetacost */
7550 119 : START:
7551 119 : N0 = lfunthetacost(L0, gen_1, LIM, bit, NULL);
7552 119 : M = mfcoefs_mf(mf, N0, 1);
7553 119 : lM = lg(F);
7554 119 : Z = cgetg(lM, t_VEC);
7555 315 : for (i = 1; i < lM; i++)
7556 : { /* expansion of D * F[i] */
7557 196 : GEN D, z, van = RgM_RgC_mul(M, Q_remove_denom(gel(F,i), &D));
7558 196 : GEN L = van_embedall(van, gel(vE,i), gN, gk);
7559 196 : long l = lg(L), j, bit_add = D? expi(D): 0;
7560 196 : gel(Z,i) = z = cgetg(l, t_VEC);
7561 595 : for (j = 1; j < l; j++)
7562 : {
7563 : GEN v, C, C0;
7564 : long m, e;
7565 546 : for (m = 0; m <= LIM; m++)
7566 : {
7567 546 : v = lfuntheta(gmael(L,j,2), gen_1, m, bit);
7568 546 : if (gexpo(v) > bit_add - bit/2) break;
7569 : }
7570 399 : if (m > LIM) { LIM <<= 1; goto START; }
7571 399 : C = mulcxpowIs(gdiv(v,conj_i(v)), 2*m - k);
7572 399 : C0 = grndtoi(C, &e); if (e < 5-prec2nbits(precision(C))) C = C0;
7573 399 : gel(z,j) = C;
7574 : }
7575 : }
7576 119 : return Z;
7577 : }
7578 : static GEN
7579 84 : mffrickeeigen(GEN mf, GEN vE, long prec)
7580 : {
7581 84 : GEN D = obj_check(mf, MF_FRICKE);
7582 84 : if (D) { long p = gprecision(D); if (!p || p >= prec) return D; }
7583 77 : D = mffrickeeigen_i(mf, MF_get_newforms(mf), vE, prec);
7584 77 : return obj_insert(mf, MF_FRICKE, D);
7585 : }
7586 :
7587 : /* integral weight, new space for primitive quadratic character CHIP;
7588 : * MF = vector of embedded eigenforms coefs on mfbasis, by orbit.
7589 : * Assume N > Q > 1 and (Q,f(CHIP)) = 1 */
7590 : static GEN
7591 56 : mfatkineigenquad(GEN mf, GEN CHIP, long Q, GEN MF, long bitprec)
7592 : {
7593 : GEN L0, la2, S, F, vP, tau, wtau, Z, va, vb, den, coe, sqrtQ, sqrtN;
7594 56 : GEN M, gN, gk = MF_get_gk(mf);
7595 56 : long N0, x, yq, i, j, lF, dim, muQ, prec = nbits2prec(bitprec);
7596 56 : long N = MF_get_N(mf), k = itos(gk), NQ = N / Q;
7597 :
7598 : /* Q coprime to FC */
7599 56 : F = MF_get_newforms(mf);
7600 56 : vP = MF_get_fields(mf);
7601 56 : lF = lg(F);
7602 56 : Z = cgetg(lF, t_VEC);
7603 56 : S = MF_get_S(mf); dim = lg(S) - 1;
7604 56 : muQ = mymoebiusu(Q);
7605 56 : if (muQ)
7606 : {
7607 42 : GEN SQ = cgetg(dim+1,t_VEC), Qk = gpow(stoi(Q), sstoQ(k-2, 2), prec);
7608 42 : long i, bit2 = bitprec >> 1;
7609 154 : for (j = 1; j <= dim; j++) gel(SQ,j) = mfak_i(gel(S,j), Q);
7610 84 : for (i = 1; i < lF; i++)
7611 : {
7612 42 : GEN S = RgV_dotproduct(gel(F,i), SQ), T = gel(vP,i);
7613 : long e;
7614 42 : if (degpol(T) > 1 && typ(S) != t_POLMOD) S = gmodulo(S, T);
7615 42 : S = grndtoi(gdiv(conjvec(S, prec), Qk), &e);
7616 42 : if (e > -bit2) pari_err_PREC("mfatkineigenquad");
7617 42 : if (muQ == -1) S = gneg(S);
7618 42 : gel(Z,i) = S;
7619 : }
7620 42 : return Z;
7621 : }
7622 14 : la2 = mfchareval(CHIP, Q); /* 1 or -1 */
7623 14 : (void)cbezout(Q, NQ, &x, &yq);
7624 14 : sqrtQ = sqrtr_abs(utor(Q,prec));
7625 14 : tau = mkcomplex(gadd(sstoQ(-1, NQ), uutoQ(1, 1000)),
7626 : divru(sqrtQ, N));
7627 14 : den = gaddgs(gmulsg(NQ, tau), 1);
7628 14 : wtau = gdiv(gsub(gmulsg(x, tau), sstoQ(yq, Q)), den);
7629 14 : coe = gpowgs(gmul(sqrtQ, den), k);
7630 :
7631 14 : sqrtN = sqrtr_abs(utor(N,prec));
7632 14 : tau = mulcxmI(gmul(tau, sqrtN));
7633 14 : wtau = mulcxmI(gmul(wtau, sqrtN));
7634 14 : gN = utoipos(N);
7635 14 : L0 = mfthetaancreate(NULL, gN, gk); /* only for thetacost */
7636 14 : N0 = maxss(lfunthetacost(L0,real_i(tau), 0,bitprec, NULL),
7637 : lfunthetacost(L0,real_i(wtau),0,bitprec, NULL));
7638 14 : M = mfcoefs_mf(mf, N0, 1);
7639 14 : va = cgetg(dim+1, t_VEC);
7640 14 : vb = cgetg(dim+1, t_VEC);
7641 105 : for (j = 1; j <= dim; j++)
7642 : {
7643 91 : GEN L, v = vecslice(gel(M,j), 2, N0+1); /* remove a0 */
7644 91 : settyp(v, t_VEC); L = mfthetaancreate(v, gN, gk);
7645 91 : gel(va,j) = lfuntheta(L, tau,0,bitprec);
7646 91 : gel(vb,j) = lfuntheta(L,wtau,0,bitprec);
7647 : }
7648 84 : for (i = 1; i < lF; i++)
7649 : {
7650 70 : GEN z, FE = gel(MF,i);
7651 70 : long l = lg(FE);
7652 70 : z = cgetg(l, t_VEC);
7653 70 : for (j = 1; j < l; j++)
7654 : {
7655 70 : GEN f = gel(FE,j), a = RgV_dotproduct(va,f), b = RgV_dotproduct(vb,f);
7656 70 : GEN la = ground( gdiv(b, gmul(a,coe)) );
7657 70 : if (!gequal(gsqr(la), la2)) pari_err_PREC("mfatkineigenquad");
7658 70 : if (typ(la) == t_INT)
7659 : {
7660 70 : if (j != 1) pari_err_BUG("mfatkineigenquad");
7661 70 : z = const_vec(l-1, la); break;
7662 : }
7663 0 : gel(z,j) = la;
7664 : }
7665 70 : gel(Z,i) = z;
7666 : }
7667 14 : return Z;
7668 : }
7669 :
7670 : static GEN
7671 84 : myusqrt(ulong a, long prec)
7672 : {
7673 84 : if (a == 1UL) return gen_1;
7674 70 : if (uissquareall(a, &a)) return utoipos(a);
7675 49 : return sqrtr_abs(utor(a, prec));
7676 : }
7677 : /* Assume mf is a nontrivial new space, rational primitive character CHIP
7678 : * and (Q,FC) = 1 */
7679 : static GEN
7680 112 : mfatkinmatnewquad(GEN mf, GEN CHIP, long Q, long flag, long PREC)
7681 : {
7682 112 : GEN cM, M, D, MF, den, vE, F = MF_get_newforms(mf);
7683 112 : long i, c, e, prec, bitprec, lF = lg(F), N = MF_get_N(mf), k = MF_get_k(mf);
7684 :
7685 112 : if (Q == 1) return mkvec4(gen_0, matid(MF_get_dim(mf)), gen_1, mf);
7686 112 : den = gel(MF_get_Minv(mf), 2);
7687 112 : bitprec = expi(den) + 64;
7688 112 : if (!flag) bitprec = maxss(bitprec, prec2nbits(PREC));
7689 :
7690 35 : START:
7691 112 : prec = nbits2prec(bitprec);
7692 112 : vE = mfeigenembed(mf, prec);
7693 112 : M = cgetg(lF, t_VEC);
7694 294 : for (i = 1; i < lF; i++) gel(M,i) = RgC_embedall(gel(F,i), gel(vE,i));
7695 112 : if (Q != N)
7696 : {
7697 56 : D = mfatkineigenquad(mf, CHIP, Q, M, bitprec);
7698 56 : c = odd(k)? Q: 1;
7699 : }
7700 : else
7701 : {
7702 56 : D = mffrickeeigen(mf, vE, prec);
7703 56 : c = mfcharmodulus(CHIP); if (odd(k)) c = -Q/c;
7704 : }
7705 112 : D = shallowconcat1(D);
7706 112 : if (vec_isconst(D)) { MF = diagonal_shallow(D); flag = 0; }
7707 : else
7708 : {
7709 63 : M = shallowconcat1(M);
7710 63 : MF = RgM_mul(matmuldiagonal(M,D), ginv(M));
7711 : }
7712 112 : if (!flag) return mkvec4(gen_0, MF, gen_1, mf);
7713 :
7714 21 : if (c > 0)
7715 21 : cM = myusqrt(c, PREC);
7716 : else
7717 : {
7718 0 : MF = imag_i(MF); c = -c;
7719 0 : cM = mkcomplex(gen_0, myusqrt(c,PREC));
7720 : }
7721 21 : if (c != 1) MF = RgM_Rg_mul(MF, myusqrt(c,prec));
7722 21 : MF = grndtoi(RgM_Rg_mul(MF,den), &e);
7723 21 : if (e > -32) { bitprec <<= 1; goto START; }
7724 21 : MF = RgM_Rg_div(MF, den);
7725 21 : if (is_rational_t(typ(cM)) && !isint1(cM))
7726 0 : { MF = RgM_Rg_div(MF, cM); cM = gen_1; }
7727 21 : return mkvec4(gen_0, MF, cM, mf);
7728 : }
7729 :
7730 : /* let CHI mod N, Q || N, return \bar{CHI_Q} * CHI_{N/Q} */
7731 : static GEN
7732 112 : mfcharAL(GEN CHI, long Q)
7733 : {
7734 112 : GEN G = gel(CHI,1), c = gel(CHI,2), cycc, d, P, E, F;
7735 112 : long l = lg(c), N = mfcharmodulus(CHI), i;
7736 112 : if (N == Q) return mfcharconj(CHI);
7737 56 : if (N == 1) return CHI;
7738 42 : CHI = leafcopy(CHI);
7739 42 : gel(CHI,2) = d = leafcopy(c);
7740 42 : F = znstar_get_faN(G);
7741 42 : P = gel(F,1);
7742 42 : E = gel(F,2);
7743 42 : cycc = znstar_get_conreycyc(G);
7744 42 : if (!odd(Q) && equaliu(gel(P,1), 2) && E[1] >= 3)
7745 14 : gel(d,2) = Fp_neg(gel(d,2), gel(cycc,2));
7746 56 : else for (i = 1; i < l; i++)
7747 28 : if (!umodui(Q, gel(P,i))) gel(d,i) = Fp_neg(gel(d,i), gel(cycc,i));
7748 42 : return CHI;
7749 : }
7750 : static long
7751 245 : atkin_get_NQ(long N, long Q, const char *f)
7752 : {
7753 245 : long NQ = N / Q;
7754 245 : if (N % Q) pari_err_DOMAIN(f,"N % Q","!=",gen_0,utoi(Q));
7755 245 : if (ugcd(NQ, Q) > 1) pari_err_DOMAIN(f,"gcd(Q,N/Q)","!=",gen_1,utoi(Q));
7756 245 : return NQ;
7757 : }
7758 :
7759 : /* transform mf to new_NEW if possible */
7760 : static GEN
7761 1589 : MF_set_new(GEN mf)
7762 : {
7763 1589 : GEN vMjd, vj, gk = MF_get_gk(mf);
7764 : long l, j;
7765 1589 : if (MF_get_space(mf) != mf_CUSP
7766 1589 : || typ(gk) != t_INT || itou(gk) == 1) return mf;
7767 182 : vMjd = MFcusp_get_vMjd(mf); l = lg(vMjd);
7768 182 : if (l > 1 && gel(vMjd,1)[1] != MF_get_N(mf)) return mf; /* oldspace != 0 */
7769 175 : mf = shallowcopy(mf);
7770 175 : gel(mf,1) = shallowcopy(gel(mf,1));
7771 175 : MF_set_space(mf, mf_NEW);
7772 175 : vj = cgetg(l, t_VECSMALL);
7773 938 : for (j = 1; j < l; j++) vj[j] = gel(vMjd, j)[2];
7774 175 : gel(mf,4) = vj; return mf;
7775 : }
7776 :
7777 : /* if flag = 1, rationalize, else don't */
7778 : static GEN
7779 224 : mfatkininit_i(GEN mf, long Q, long flag, long prec)
7780 : {
7781 : GEN M, B, C, CHI, CHIAL, G, chi, P, z, g, mfB, s, Mindex, Minv;
7782 224 : long j, l, lim, ord, FC, NQ, cQ, nk, dk, N = MF_get_N(mf);
7783 :
7784 224 : B = MF_get_basis(mf); l = lg(B);
7785 224 : M = cgetg(l, t_MAT); if (l == 1) return mkvec4(gen_0,M,gen_1,mf);
7786 224 : Qtoss(MF_get_gk(mf), &nk,&dk);
7787 224 : Q = labs(Q);
7788 224 : NQ = atkin_get_NQ(N, Q, "mfatkininit");
7789 224 : CHI = MF_get_CHI(mf);
7790 224 : CHI = mfchartoprimitive(CHI, &FC);
7791 224 : ord = mfcharorder(CHI);
7792 224 : mf = MF_set_new(mf);
7793 224 : if (MF_get_space(mf) == mf_NEW && ord <= 2 && NQ % FC == 0 && dk == 1)
7794 112 : return mfatkinmatnewquad(mf, CHI, Q, flag, prec);
7795 : /* now flag != 0 */
7796 112 : G = gel(CHI,1);
7797 112 : chi = gel(CHI,2);
7798 112 : if (Q == N) { g = mkmat22s(0, -1, N, 0); cQ = NQ; } /* Fricke */
7799 : else
7800 : {
7801 28 : GEN F, gQP = utoi(ugcd(Q, FC));
7802 : long t, v;
7803 28 : chi = znchardecompose(G, chi, gQP);
7804 28 : F = znconreyconductor(G, chi, &chi);
7805 28 : G = znstar0(F,1);
7806 28 : (void)cbezout(Q, NQ, &t, &v);
7807 28 : g = mkmat22s(Q*t, 1, -N*v, Q);
7808 28 : cQ = -NQ*v;
7809 : }
7810 112 : C = s = gen_1;
7811 : /* N.B. G,chi are G_Q,chi_Q [primitive] at this point */
7812 112 : if (lg(chi) != 1) C = ginv( znchargauss(G, chi, gen_1, prec2nbits(prec)) );
7813 112 : if (dk == 1)
7814 91 : { if (odd(nk)) s = myusqrt(Q,prec); }
7815 : else
7816 : {
7817 21 : long r = nk >> 1; /* k-1/2 */
7818 21 : s = gpow(utoipos(Q), mkfracss(odd(r)? 1: 3, 4), prec);
7819 21 : if (odd(cQ))
7820 : {
7821 21 : long t = r + ((cQ-1) >> 1);
7822 21 : s = mkcomplex(s, odd(t)? gneg(s): s);
7823 : }
7824 : }
7825 112 : if (!isint1(s)) C = gmul(C, s);
7826 112 : CHIAL = mfcharAL(CHI, Q);
7827 112 : if (dk == 2)
7828 : {
7829 21 : ulong q = odd(Q)? Q << 2: Q, Nq = ulcm(q, mfcharmodulus(CHIAL));
7830 21 : CHIAL = induceN(Nq, CHIAL);
7831 21 : CHIAL = mfcharmul(CHIAL, induce(gel(CHIAL,1), utoipos(q)));
7832 : }
7833 112 : CHIAL = mfchartoprimitive(CHIAL,NULL);
7834 112 : mfB = gequal(CHIAL,CHI)? mf: mfinit_Nndkchi(N,nk,dk,CHIAL,MF_get_space(mf),0);
7835 112 : Mindex = MF_get_Mindex(mfB);
7836 112 : Minv = MF_get_Minv(mfB);
7837 112 : P = z = NULL;
7838 112 : if (ord > 2) { P = mfcharpol(CHI); z = rootsof1u_cx(ord, prec); }
7839 112 : lim = maxss(mfsturm(mfB), mfsturm(mf)) + 1;
7840 567 : for (j = 1; j < l; j++)
7841 : {
7842 455 : GEN v = mfslashexpansion(mf, gel(B,j), g, lim, 0, NULL, prec+EXTRAPREC64);
7843 : long junk;
7844 455 : if (!isint1(C)) v = RgV_Rg_mul(v, C);
7845 455 : v = bestapprnf(v, P, z, prec);
7846 455 : v = vecpermute_partial(v, Mindex, &junk);
7847 455 : v = Minv_RgC_mul(Minv, v); /* cf mftobasis_i */
7848 455 : gel(M, j) = v;
7849 : }
7850 112 : if (is_rational_t(typ(C)) && !gequal1(C)) { M = gdiv(M, C); C = gen_1; }
7851 112 : if (mfB == mf) mfB = gen_0;
7852 112 : return mkvec4(mfB, M, C, mf);
7853 : }
7854 : GEN
7855 98 : mfatkininit(GEN mf, long Q, long prec)
7856 : {
7857 98 : pari_sp av = avma;
7858 98 : mf = checkMF(mf); return gc_GEN(av, mfatkininit_i(mf, Q, 1, prec));
7859 : }
7860 : static void
7861 63 : checkmfa(GEN z)
7862 : {
7863 63 : if (typ(z) != t_VEC || lg(z) != 5 || typ(gel(z,2)) != t_MAT
7864 63 : || !checkMF_i(gel(z,4))
7865 63 : || (!isintzero(gel(z,1)) && !checkMF_i(gel(z,1))))
7866 0 : pari_err_TYPE("mfatkin [please apply mfatkininit()]",z);
7867 63 : }
7868 :
7869 : /* Apply atkin Q to closure F */
7870 : GEN
7871 63 : mfatkin(GEN mfa, GEN F)
7872 : {
7873 63 : pari_sp av = avma;
7874 : GEN z, mfB, MQ, mf;
7875 63 : checkmfa(mfa);
7876 63 : mfB= gel(mfa,1);
7877 63 : MQ = gel(mfa,2);
7878 63 : mf = gel(mfa,4);
7879 63 : if (typ(mfB) == t_INT) mfB = mf;
7880 63 : z = RgM_RgC_mul(MQ, mftobasis_i(mf,F));
7881 63 : return gc_upto(av, mflinear(mfB, z));
7882 : }
7883 :
7884 : GEN
7885 49 : mfatkineigenvalues(GEN mf, long Q, long prec)
7886 : {
7887 49 : pari_sp av = avma;
7888 : GEN vF, L, CHI, M, mfatk, C, MQ, vE, mfB;
7889 : long N, NQ, l, i;
7890 :
7891 49 : mf = checkMF(mf); N = MF_get_N(mf);
7892 49 : vF = MF_get_newforms(mf); l = lg(vF);
7893 : /* N.B. k is integral */
7894 49 : if (l == 1) retgc_const(av, cgetg(1, t_VEC));
7895 49 : L = cgetg(l, t_VEC);
7896 49 : if (Q == 1)
7897 : {
7898 7 : GEN vP = MF_get_fields(mf);
7899 21 : for (i = 1; i < l; i++) gel(L,i) = const_vec(degpol(gel(vP,i)), gen_1);
7900 7 : return L;
7901 : }
7902 42 : vE = mfeigenembed(mf,prec);
7903 42 : if (Q == N) return gc_upto(av, mffrickeeigen(mf, vE, prec));
7904 21 : Q = labs(Q);
7905 21 : NQ = atkin_get_NQ(N, Q, "mfatkineigenvalues"); /* != 1 */
7906 21 : mfatk = mfatkininit(mf, Q, prec);
7907 21 : mfB= gel(mfatk,1); if (typ(mfB) != t_VEC) mfB = mf;
7908 21 : MQ = gel(mfatk,2);
7909 21 : C = gel(mfatk,3);
7910 21 : M = row(mfcoefs_mf(mfB,1,1), 2); /* vec of a_1(b_i) for mfbasis functions */
7911 56 : for (i = 1; i < l; i++)
7912 : {
7913 35 : GEN c = RgV_dotproduct(RgM_RgC_mul(MQ,gel(vF,i)), M); /* C * eigen_i */
7914 35 : gel(L,i) = Rg_embedall_i(c, gel(vE,i));
7915 : }
7916 21 : if (!gequal1(C)) L = gdiv(L, C);
7917 21 : CHI = MF_get_CHI(mf);
7918 21 : if (mfcharorder(CHI) <= 2 && NQ % mfcharconductor(CHI) == 0) L = ground(L);
7919 21 : return gc_GEN(av, L);
7920 : }
7921 :
7922 : /* expand B_d V, keeping same length */
7923 : static GEN
7924 14168 : bdexpand(GEN V, long d)
7925 : {
7926 : GEN W;
7927 : long N, n;
7928 14168 : if (d == 1) return V;
7929 2730 : N = lg(V)-1; W = zerovec(N);
7930 47768 : for (n = 0; n <= (N-1)/d; n++) gel(W, n*d+1) = gel(V, n+1);
7931 2730 : return W;
7932 : }
7933 : /* expand B_d V, increasing length up to lim */
7934 : static GEN
7935 343 : bdexpandall(GEN V, long d, long lim)
7936 : {
7937 : GEN W;
7938 : long N, n;
7939 343 : if (d == 1) return V;
7940 49 : N = lg(V)-1; W = zerovec(lim);
7941 301 : for (n = 0; n <= N-1 && n*d <= lim; n++) gel(W, n*d+1) = gel(V, n+1);
7942 49 : return W;
7943 : }
7944 :
7945 : static void
7946 15491 : parse_vecj(GEN T, GEN *E1, GEN *E2)
7947 : {
7948 15491 : if (lg(T)==3) { *E1 = gel(T,1); *E2 = gel(T,2); }
7949 5600 : else { *E1 = T; *E2 = NULL; }
7950 15491 : }
7951 :
7952 : /* g in M_2(Z) ? */
7953 : static int
7954 3486 : check_M2Z(GEN g)
7955 3486 : { return typ(g) == t_MAT && lg(g) == 3 && lgcols(g) == 3 && RgM_is_ZM(g); }
7956 : /* g in SL_2(Z) ? */
7957 : static int
7958 2058 : check_SL2Z(GEN g) { return check_M2Z(g) && equali1(ZM_det(g)); }
7959 :
7960 : static GEN
7961 9513 : mfcharcxeval(GEN CHI, long n, long prec)
7962 : {
7963 9513 : ulong ord, N = mfcharmodulus(CHI);
7964 : GEN ordg;
7965 9513 : if (N == 1) return gen_1;
7966 3696 : if (ugcd(N, labs(n)) > 1) return gen_0;
7967 3696 : ordg = gmfcharorder(CHI);
7968 3696 : ord = itou(ordg);
7969 3696 : return rootsof1q_cx(znchareval_i(CHI,n,ordg), ord, prec);
7970 : }
7971 :
7972 : static GEN
7973 11039 : RgV_shift(GEN V, GEN gn)
7974 : {
7975 : long i, n, l;
7976 : GEN W;
7977 11039 : if (typ(gn) != t_INT) pari_err_BUG("RgV_shift [n not integral]");
7978 11039 : n = itos(gn);
7979 11039 : if (n < 0) pari_err_BUG("RgV_shift [n negative]");
7980 11039 : if (!n) return V;
7981 112 : W = cgetg_copy(V, &l); if (n > l-1) n = l-1;
7982 308 : for (i=1; i <= n; i++) gel(W,i) = gen_0;
7983 4900 : for ( ; i < l; i++) gel(W,i) = gel(V, i-n);
7984 112 : return W;
7985 : }
7986 : static GEN
7987 19236 : hash_eisengacx(hashtable *H, void *E, long w, GEN ga, long n, long prec)
7988 : {
7989 19236 : ulong h = H->hash(E);
7990 19236 : hashentry *e = hash_search2(H, E, h);
7991 : GEN v;
7992 19236 : if (e) v = (GEN)e->val;
7993 : else
7994 : {
7995 12971 : v = mfeisensteingacx((GEN)E, w, ga, n, prec);
7996 12971 : hash_insert2(H, E, (void*)v, h);
7997 : }
7998 19236 : return v;
7999 : }
8000 : static GEN
8001 11039 : vecj_expand(GEN B, hashtable *H, long w, GEN ga, long n, long prec)
8002 : {
8003 : GEN E1, E2, v;
8004 11039 : parse_vecj(B, &E1, &E2);
8005 11039 : v = hash_eisengacx(H, (void*)E1, w, ga, n, prec);
8006 11039 : if (E2)
8007 : {
8008 8141 : GEN u = hash_eisengacx(H, (void*)E2, w, ga, n, prec);
8009 8141 : GEN a = gadd(gel(v,1), gel(u,1));
8010 8141 : GEN b = RgV_mul_RgXn(gel(v,2), gel(u,2));
8011 8141 : v = mkvec2(a,b);
8012 : }
8013 11039 : return v;
8014 : }
8015 : static GEN
8016 1288 : shift_M(GEN M, GEN Valpha, long w)
8017 : {
8018 1288 : long i, l = lg(Valpha);
8019 1288 : GEN almin = vecmin(Valpha);
8020 12327 : for (i = 1; i < l; i++)
8021 : {
8022 11039 : GEN alpha = gel(Valpha, i), gsh = gmulsg(w, gsub(alpha,almin));
8023 11039 : gel(M,i) = RgV_shift(gel(M,i), gsh);
8024 : }
8025 1288 : return almin;
8026 : }
8027 : static GEN mfeisensteinspaceinit(GEN NK);
8028 : #if 0
8029 : /* ga in M_2^+(Z)), n >= 0 */
8030 : static GEN
8031 : mfgaexpansion_init(GEN mf, GEN ga, long n, long prec)
8032 : {
8033 : GEN M, Mvecj, vecj, almin, Valpha;
8034 : long i, w, l, N = MF_get_N(mf), c = itos(gcoeff(ga,2,1));
8035 : hashtable *H;
8036 :
8037 : if (c % N == 0)
8038 : { /* ga in G_0(N), trivial case; w = 1 */
8039 : GEN chid = mfcharcxeval(MF_get_CHI(mf), itos(gcoeff(ga,2,2)), prec);
8040 : return mkvec2(chid, utoi(n));
8041 : }
8042 :
8043 : Mvecj = obj_checkbuild(mf, MF_EISENSPACE, &mfeisensteinspaceinit);
8044 : if (lg(Mvecj) < 5) pari_err_IMPL("mfgaexpansion_init in this case");
8045 : w = mfcuspcanon_width(N, c);
8046 : vecj = gel(Mvecj, 3);
8047 : l = lg(vecj);
8048 : M = cgetg(l, t_VEC);
8049 : Valpha = cgetg(l, t_VEC);
8050 : H = hash_create_GEN(l, 1);
8051 : for (i = 1; i < l; i++)
8052 : {
8053 : GEN v = vecj_expand(gel(vecj,i), H, w, ga, n, prec);
8054 : gel(Valpha,i) = gel(v,1);
8055 : gel(M,i) = gel(v,2);
8056 : }
8057 : almin = shift_M(M, Valpha, w);
8058 : return mkvec3(almin, utoi(w), M);
8059 : }
8060 : /* half-integer weight not supported; vF = [F,eisendec(F)].
8061 : * Minit = mfgaexpansion_init(mf, ga, n, prec) */
8062 : static GEN
8063 : mfgaexpansion_with_init(GEN Minit, GEN vF)
8064 : {
8065 : GEN v;
8066 : if (lg(Minit) == 3)
8067 : { /* ga in G_0(N) */
8068 : GEN chid = gel(Minit,1), gn = gel(Minit,2);
8069 : v = mfcoefs_i(gel(vF,1), itou(gn), 1);
8070 : v = mkvec3(gen_0, gen_1, RgV_Rg_mul(v,chid));
8071 : }
8072 : else
8073 : {
8074 : GEN V = RgM_RgC_mul(gel(Minit,3), gel(vF,2));
8075 : v = mkvec3(gel(Minit,1), gel(Minit,2), V);
8076 : }
8077 : return v;
8078 : }
8079 : #endif
8080 :
8081 : /* B = mfeisensteindec(F) already embedded, ga in M_2^+(Z)), n >= 0 */
8082 : static GEN
8083 1288 : mfgaexpansion_i(GEN mf, GEN B0, GEN ga, long n, long prec)
8084 : {
8085 1288 : GEN M, Mvecj, vecj, almin, Valpha, B, E = NULL;
8086 1288 : long i, j, w, nw, l, N = MF_get_N(mf), bit = prec2nbits(prec) / 2;
8087 : hashtable *H;
8088 :
8089 1288 : Mvecj = obj_check(mf, MF_EISENSPACE);
8090 1288 : if (lg(Mvecj) < 5) { E = gel(Mvecj, 2); Mvecj = gel(Mvecj, 1); }
8091 1288 : vecj = gel(Mvecj, 3);
8092 1288 : l = lg(vecj);
8093 1288 : B = cgetg(l, t_COL);
8094 1288 : M = cgetg(l, t_VEC);
8095 1288 : Valpha = cgetg(l, t_VEC);
8096 1288 : w = mfZC_width(N, gel(ga,1));
8097 1288 : nw = E ? n + w : n;
8098 1288 : H = hash_create_GEN(l, 1);
8099 15673 : for (i = j = 1; i < l; i++)
8100 : {
8101 : GEN v;
8102 14385 : if (gequal0(gel(B0,i))) continue;
8103 11039 : v = vecj_expand(gel(vecj,i), H, w, ga, nw, prec);
8104 11039 : gel(B,j) = gel(B0,i);
8105 11039 : gel(Valpha,j) = gel(v,1);
8106 11039 : gel(M,j) = gel(v,2); j++;
8107 : }
8108 1288 : setlg(Valpha, j);
8109 1288 : setlg(B, j);
8110 1288 : setlg(M, j); l = j;
8111 1288 : if (l == 1) return mkvec3(gen_0, utoi(w), zerovec(n+1));
8112 1288 : almin = shift_M(M, Valpha, w);
8113 1288 : B = RgM_RgC_mul(M, B); l = lg(B);
8114 158347 : for (i = 1; i < l; i++)
8115 157059 : if (gexpo(gel(B,i)) < -bit) gel(B,i) = gen_0;
8116 1288 : settyp(B, t_VEC);
8117 1288 : if (E)
8118 : {
8119 : GEN v, e;
8120 56 : long ell = 0, vB, ve;
8121 126 : for (i = 1; i < l; i++)
8122 126 : if (!gequal0(gel(B,i))) break;
8123 56 : vB = i-1;
8124 56 : v = hash_eisengacx(H, (void*)E, w, ga, n + vB, prec);
8125 56 : e = gel(v,2); l = lg(e);
8126 56 : for (i = 1; i < l; i++)
8127 56 : if (!gequal0(gel(e,i))) break;
8128 56 : ve = i-1;
8129 56 : almin = gsub(almin, gel(v,1));
8130 56 : if (gsigne(almin) < 0)
8131 : {
8132 0 : GEN gell = gceil(gmulsg(-w, almin));
8133 0 : ell = itos(gell);
8134 0 : almin = gadd(almin, gdivgu(gell, w));
8135 0 : if (nw < ell) pari_err_IMPL("alpha < 0 in mfgaexpansion");
8136 : }
8137 56 : if (ve) { ell += ve; e = vecslice(e, ve+1, l-1); }
8138 56 : B = vecslice(B, ell + 1, minss(n + ell + 1, lg(B)-1));
8139 56 : B = RgV_div_RgXn(B, e);
8140 : }
8141 1288 : return mkvec3(almin, utoi(w), B);
8142 : }
8143 :
8144 : /* Theta multiplier: assume 4 | C, (C,D)=1 */
8145 : static GEN
8146 343 : mfthetamultiplier(GEN C, GEN D)
8147 : {
8148 343 : long s = kronecker(C, D);
8149 343 : if (Mod4(D) == 1) return s > 0 ? gen_1: gen_m1;
8150 84 : return s > 0? powIs(3): gen_I();
8151 : }
8152 : /* theta | [*,*;C,D] defined over Q(i) [else over Q] */
8153 : static int
8154 56 : mfthetaI(long C, long D) { return odd(C) || (D & 3) == 3; }
8155 : /* (theta | M) [0..n], assume (C,D) = 1 */
8156 : static GEN
8157 343 : mfthetaexpansion(GEN M, long n)
8158 : {
8159 343 : GEN w, s, al, sla, E, V = zerovec(n+1), C = gcoeff(M,2,1), D = gcoeff(M,2,2);
8160 343 : long lim, la, f, C4 = Mod4(C);
8161 343 : switch (C4)
8162 : {
8163 70 : case 0: al = gen_0; w = gen_1;
8164 70 : s = mfthetamultiplier(C,D);
8165 70 : lim = usqrt(n); gel(V, 1) = s;
8166 70 : s = gmul2n(s, 1);
8167 756 : for (f = 1; f <= lim; f++) gel(V, f*f + 1) = s;
8168 70 : break;
8169 105 : case 2: al = uutoQ(1,4); w = gen_1;
8170 105 : E = subii(C, shifti(D,1)); /* (E, D) = 1 */
8171 105 : s = gmul2n(mfthetamultiplier(E, D), 1);
8172 105 : if ((!signe(E) && equalim1(D)) || (signe(E) > 0 && signe(C) < 0))
8173 14 : s = gneg(s);
8174 105 : lim = (usqrt(n << 2) - 1) >> 1;
8175 966 : for (f = 0; f <= lim; f++) gel(V, f*(f+1) + 1) = s;
8176 105 : break;
8177 168 : default: al = gen_0; w = utoipos(4);
8178 168 : la = (-Mod4(D)*C4) & 3L;
8179 168 : E = negi(addii(D, mului(la, C)));
8180 168 : s = mfthetamultiplier(E, C); /* (E,C) = 1 */
8181 168 : if (signe(C) < 0 && signe(E) >= 0) s = gneg(s);
8182 168 : s = gsub(s, mulcxI(s));
8183 168 : sla = gmul(s, powIs(-la));
8184 168 : lim = usqrt(n); gel(V, 1) = gmul2n(s, -1);
8185 1708 : for (f = 1; f <= lim; f++) gel(V, f*f + 1) = odd(f) ? sla : s;
8186 168 : break;
8187 : }
8188 343 : return mkvec3(al, w, V);
8189 : }
8190 :
8191 : /* F 1/2 integral weight */
8192 : static GEN
8193 343 : mf2gaexpansion(GEN mf2, GEN F, GEN ga, long n, long prec)
8194 : {
8195 343 : GEN FT = mfmultheta(F), mf = obj_checkbuild(mf2, MF_MF2INIT, &mf2init);
8196 343 : GEN res, V1, Tres, V2, al, V, gsh, C = gcoeff(ga,2,1);
8197 343 : long w2, N = MF_get_N(mf), w = mfcuspcanon_width(N, umodiu(C,N));
8198 343 : long ext = (Mod4(C) != 2)? 0: (w+3) >> 2;
8199 343 : long prec2 = prec + nbits2extraprec((long)M_PI/(2*M_LN2)*sqrt(n + ext));
8200 343 : res = mfgaexpansion(mf, FT, ga, n + ext, prec2);
8201 343 : Tres = mfthetaexpansion(ga, n + ext);
8202 343 : V1 = gel(res,3);
8203 343 : V2 = gel(Tres,3);
8204 343 : al = gsub(gel(res,1), gel(Tres,1));
8205 343 : w2 = itos(gel(Tres,2));
8206 343 : if (w != itos(gel(res,2)) || w % w2)
8207 0 : pari_err_BUG("mf2gaexpansion [incorrect w2 or w]");
8208 343 : if (w2 != w) V2 = bdexpand(V2, w/w2);
8209 343 : V = RgV_div_RgXn(V1, V2);
8210 343 : gsh = gfloor(gmulsg(w, al));
8211 343 : if (!gequal0(gsh))
8212 : {
8213 35 : al = gsub(al, gdivgu(gsh, w));
8214 35 : if (gsigne(gsh) > 0)
8215 : {
8216 0 : V = RgV_shift(V, gsh);
8217 0 : V = vecslice(V, 1, n + 1);
8218 : }
8219 : else
8220 : {
8221 35 : long sh = -itos(gsh), i;
8222 35 : if (sh > ext) pari_err_BUG("mf2gaexpansion [incorrect sh]");
8223 154 : for (i = 1; i <= sh; i++)
8224 119 : if (!gequal0(gel(V,i))) pari_err_BUG("mf2gaexpansion [sh too large]");
8225 35 : V = vecslice(V, sh+1, n + sh+1);
8226 : }
8227 : }
8228 343 : obj_free(mf); return mkvec3(al, stoi(w), gprec_wtrunc(V, prec));
8229 : }
8230 :
8231 : static GEN
8232 77 : mfgaexpansionatkin(GEN mf, GEN F, GEN C, GEN D, long Q, long n, long prec)
8233 : {
8234 77 : GEN mfa = mfatkininit_i(mf, Q, 0, prec), MQ = gel(mfa,2);
8235 77 : long i, FC, k = MF_get_k(mf);
8236 77 : GEN x, v, V, z, s, CHI = mfchartoprimitive(MF_get_CHI(mf), &FC);
8237 :
8238 : /* V = mfcoefs(F | w_Q, n), can't use mfatkin because MQ nonrational */
8239 77 : V = RgM_RgC_mul(mfcoefs_mf(mf,n,1), RgM_RgC_mul(MQ, mftobasis_i(mf,F)));
8240 77 : (void)bezout(utoipos(Q), C, &x, &v);
8241 77 : s = mfchareval(CHI, (umodiu(x, FC) * umodiu(D, FC)) % FC);
8242 77 : s = gdiv(s, gpow(utoipos(Q), uutoQ(k,2), prec));
8243 77 : V = RgV_Rg_mul(V, s);
8244 77 : z = rootsof1powinit(umodiu(D,Q)*umodiu(v,Q) % Q, Q, prec);
8245 11613 : for (i = 1; i <= n+1; i++) gel(V,i) = gmul(gel(V,i), rootsof1pow(z, i-1));
8246 77 : return mkvec3(gen_0, utoipos(Q), V);
8247 : }
8248 :
8249 : static long
8250 70 : inveis_extraprec(long N, GEN ga, GEN Mvecj, long n)
8251 : {
8252 70 : long e, w = mfZC_width(N, gel(ga,1));
8253 70 : GEN f, E = gel(Mvecj,2), v = mfeisensteingacx(E, w, ga, n, DEFAULTPREC);
8254 70 : v = gel(v,2);
8255 70 : f = RgV_to_RgX(v,0); n -= RgX_valrem(f, &f);
8256 70 : e = gexpo(RgXn_inv(f, n+1));
8257 70 : return (e > 0)? nbits2extraprec(e): 0;
8258 : }
8259 : /* allow F of the form [F, mf_eisendec(F)]~ */
8260 : static GEN
8261 2051 : mfgaexpansion(GEN mf, GEN F, GEN ga, long n, long prec)
8262 : {
8263 2051 : GEN v, EF = NULL, res, Mvecj, c, d;
8264 : long precnew, N;
8265 :
8266 2051 : if (n < 0) pari_err_DOMAIN("mfgaexpansion", "n", "<", gen_0, stoi(n));
8267 2051 : if (typ(F) == t_COL && lg(F) == 3) { EF = gel(F,2); F = gel(F,1); }
8268 2051 : if (!checkmf_i(F)) pari_err_TYPE("mfgaexpansion", F);
8269 2051 : if (!check_SL2Z(ga)) pari_err_TYPE("mfgaexpansion",ga);
8270 2051 : if (typ(mf_get_gk(F)) != t_INT) return mf2gaexpansion(mf, F, ga, n, prec);
8271 1708 : c = gcoeff(ga,2,1);
8272 1708 : d = gcoeff(ga,2,2);
8273 1708 : N = MF_get_N(mf);
8274 1708 : if (!umodiu(c, mf_get_N(F)))
8275 : { /* trivial case: ga in Gamma_0(N) */
8276 343 : long w = mfcuspcanon_width(N, umodiu(c,N));
8277 343 : GEN CHI = mf_get_CHI(F);
8278 343 : GEN chid = mfcharcxeval(CHI, umodiu(d,mfcharmodulus(CHI)), prec);
8279 343 : v = mfcoefs_i(F, n/w, 1); if (!isint1(chid)) v = RgV_Rg_mul(v,chid);
8280 343 : return mkvec3(gen_0, stoi(w), bdexpandall(v,w,n+1));
8281 : }
8282 1365 : mf = MF_set_new(mf);
8283 1365 : if (MF_get_space(mf) == mf_NEW)
8284 : {
8285 483 : long cN = umodiu(c,N), g = ugcd(cN,N), Q = N/g;
8286 483 : GEN CHI = MF_get_CHI(mf);
8287 483 : if (ugcd(cN, Q)==1 && mfcharorder(CHI) <= 2
8288 231 : && g % mfcharconductor(CHI) == 0
8289 119 : && degpol(mf_get_field(F)) == 1)
8290 77 : return mfgaexpansionatkin(mf, F, c, d, Q, n, prec);
8291 : }
8292 1288 : Mvecj = obj_checkbuild(mf, MF_EISENSPACE, &mfeisensteinspaceinit);
8293 1288 : precnew = prec;
8294 1288 : if (lg(Mvecj) < 5) precnew += inveis_extraprec(N, ga, Mvecj, n);
8295 1288 : if (!EF) EF = mf_eisendec(mf, F, precnew);
8296 1288 : res = mfgaexpansion_i(mf, EF, ga, n, precnew);
8297 1288 : return precnew == prec ? res : gprec_wtrunc(res, prec);
8298 : }
8299 :
8300 : /* parity = -1 or +1 */
8301 : static GEN
8302 217 : findd(long N, long parity)
8303 : {
8304 217 : GEN L, D = mydivisorsu(N);
8305 217 : long i, j, l = lg(D);
8306 217 : L = cgetg(l, t_VEC);
8307 1218 : for (i = j = 1; i < l; i++)
8308 : {
8309 1001 : long d = D[i];
8310 1001 : if (parity == -1) d = -d;
8311 1001 : if (sisfundamental(d)) gel(L,j++) = stoi(d);
8312 : }
8313 217 : setlg(L,j); return L;
8314 : }
8315 : /* does ND contain a divisor of N ? */
8316 : static int
8317 413 : seenD(long N, GEN ND)
8318 : {
8319 413 : long j, l = lg(ND);
8320 427 : for (j = 1; j < l; j++)
8321 14 : if (N % ND[j] == 0) return 1;
8322 413 : return 0;
8323 : }
8324 : static GEN
8325 63 : search_levels(GEN vN, const char *f)
8326 : {
8327 63 : switch(typ(vN))
8328 : {
8329 28 : case t_INT: vN = mkvecsmall(itos(vN)); break;
8330 35 : case t_VEC: case t_COL: vN = ZV_to_zv(vN); break;
8331 0 : case t_VECSMALL: vN = leafcopy(vN); break;
8332 0 : default: pari_err_TYPE(f, vN);
8333 : }
8334 63 : vecsmall_sort(vN); return vN;
8335 : }
8336 : GEN
8337 28 : mfsearch(GEN NK, GEN V, long space)
8338 : {
8339 28 : pari_sp av = avma;
8340 : GEN F, gk, NbyD, vN;
8341 : long n, nk, dk, parity, nV, i, lvN;
8342 :
8343 28 : if (typ(NK) != t_VEC || lg(NK) != 3) pari_err_TYPE("mfsearch", NK);
8344 28 : gk = gel(NK,2);
8345 28 : if (typ(gmul2n(gk, 1)) != t_INT) pari_err_TYPE("mfsearch [k]", gk);
8346 28 : switch(typ(V))
8347 : {
8348 28 : case t_VEC: V = shallowtrans(V);
8349 28 : case t_COL: break;
8350 0 : default: pari_err_TYPE("mfsearch [V]", V);
8351 : }
8352 28 : vN = search_levels(gel(NK,1), "mfsearch [N]");
8353 28 : if (gequal0(V)) { set_avma(av); retmkvec(mftrivial()); }
8354 14 : lvN = lg(vN);
8355 :
8356 14 : Qtoss(gk, &nk,&dk);
8357 14 : parity = (dk == 1 && odd(nk)) ? -1 : 1;
8358 14 : nV = lg(V)-2;
8359 14 : F = cgetg(1, t_VEC);
8360 14 : NbyD = const_vec(vN[lvN-1], cgetg(1,t_VECSMALL));
8361 231 : for (n = 1; n < lvN; n++)
8362 : {
8363 217 : long N = vN[n];
8364 : GEN L;
8365 217 : if (N <= 0 || (dk == 2 && (N & 3))) continue;
8366 217 : L = findd(N, parity);
8367 630 : for (i = 1; i < lg(L); i++)
8368 : {
8369 413 : GEN mf, M, CO, gD = gel(L,i);
8370 413 : GEN *ND = (GEN*)NbyD + itou(gD); /* points to NbyD[|D|] */
8371 :
8372 413 : if (seenD(N, *ND)) continue;
8373 413 : mf = mfinit_Nndkchi(N, nk, dk, get_mfchar(gD), space, 1);
8374 413 : M = mfcoefs_mf(mf, nV, 1);
8375 413 : CO = inverseimage(M, V); if (lg(CO) == 1) continue;
8376 :
8377 42 : F = vec_append(F, mflinear(mf,CO));
8378 42 : *ND = vecsmall_append(*ND, N); /* add to NbyD[|D|] */
8379 : }
8380 : }
8381 14 : return gc_GEN(av, F);
8382 : }
8383 :
8384 : static GEN
8385 889 : search_from_split(GEN mf, GEN vap, GEN vlp)
8386 : {
8387 889 : pari_sp av = avma;
8388 889 : long lvlp = lg(vlp), j, jv, l1;
8389 889 : GEN v, NK, S1, S, M = NULL;
8390 :
8391 889 : S1 = gel(split_i(mf, 1, 0), 1); /* rational newforms */
8392 889 : l1 = lg(S1);
8393 889 : if (l1 == 1) return gc_NULL(av);
8394 455 : v = cgetg(l1, t_VEC);
8395 455 : S = MF_get_S(mf);
8396 455 : NK = mf_get_NK(gel(S,1));
8397 455 : if (lvlp > 1) M = rowpermute(mfcoefs_mf(mf, vlp[lvlp-1], 1), vlp);
8398 980 : for (j = jv = 1; j < l1; j++)
8399 : {
8400 525 : GEN vF = gel(S1,j);
8401 : long t;
8402 658 : for (t = lvlp-1; t > 0; t--)
8403 : { /* lhs = vlp[j]-th coefficient of eigenform */
8404 595 : GEN rhs = gel(vap,t), lhs = RgMrow_RgC_mul(M, vF, t);
8405 595 : if (!gequal(lhs, rhs)) break;
8406 : }
8407 525 : if (!t) gel(v,jv++) = mflinear_i(NK,S,vF);
8408 : }
8409 455 : if (jv == 1) return gc_NULL(av);
8410 63 : setlg(v,jv); return v;
8411 : }
8412 : GEN
8413 35 : mfeigensearch(GEN NK, GEN AP)
8414 : {
8415 35 : pari_sp av = avma;
8416 35 : GEN k, vN, vap, vlp, vres = cgetg(1, t_VEC), D;
8417 : long n, lvN, i, l, even;
8418 :
8419 35 : if (!AP) l = 1;
8420 : else
8421 : {
8422 28 : l = lg(AP);
8423 28 : if (typ(AP) != t_VEC) pari_err_TYPE("mfeigensearch",AP);
8424 : }
8425 35 : vap = cgetg(l, t_VEC);
8426 35 : vlp = cgetg(l, t_VECSMALL);
8427 35 : if (l > 1)
8428 : {
8429 28 : GEN perm = indexvecsort(AP, mkvecsmall(1));
8430 77 : for (i = 1; i < l; i++)
8431 : {
8432 49 : GEN v = gel(AP,perm[i]), gp, ap;
8433 49 : if (typ(v) != t_VEC || lg(v) != 3) pari_err_TYPE("mfeigensearch", AP);
8434 49 : gp = gel(v,1);
8435 49 : ap = gel(v,2);
8436 49 : if (typ(gp) != t_INT || (typ(ap) != t_INT && typ(ap) != t_INTMOD))
8437 0 : pari_err_TYPE("mfeigensearch", AP);
8438 49 : gel(vap,i) = ap;
8439 49 : vlp[i] = itos(gp)+1; if (vlp[i] < 0) pari_err_TYPE("mfeigensearch", AP);
8440 : }
8441 : }
8442 35 : l = lg(NK);
8443 35 : if (typ(NK) != t_VEC || l != 3) pari_err_TYPE("mfeigensearch",NK);
8444 35 : k = gel(NK,2);
8445 35 : vN = search_levels(gel(NK,1), "mfeigensearch [N]");
8446 35 : lvN = lg(vN);
8447 35 : vecsmall_sort(vlp);
8448 35 : even = !mpodd(k);
8449 980 : for (n = 1; n < lvN; n++)
8450 : {
8451 945 : pari_sp av2 = avma;
8452 : GEN mf, L;
8453 945 : long N = vN[n];
8454 945 : if (even) D = gen_1;
8455 : else
8456 : {
8457 112 : long r = (N&3L);
8458 112 : if (r == 1 || r == 2) continue;
8459 56 : D = stoi( corediscs(-N, NULL) ); /* < 0 */
8460 : }
8461 889 : mf = mfinit_i(mkvec3(utoipos(N), k, D), mf_NEW);
8462 889 : L = search_from_split(mf, vap, vlp);
8463 889 : if (L) vres = shallowconcat(vres, L); else set_avma(av2);
8464 : }
8465 35 : return gc_GEN(av, vres);
8466 : }
8467 :
8468 : /* tf_{N,k}(n) */
8469 : static GEN
8470 4646243 : mfnewtracecache(long N, long k, long n, cachenew_t *cache)
8471 : {
8472 4646243 : GEN C = NULL, S;
8473 : long lcache;
8474 4646243 : if (!n) return gen_0;
8475 4501854 : S = gel(cache->vnew,N);
8476 4501854 : lcache = lg(S);
8477 4501854 : if (n < lcache) C = gel(S, n);
8478 4501854 : if (C) cache->newHIT++;
8479 2673683 : else C = mfnewtrace_i(N,k,n,cache);
8480 4501854 : cache->newTOTAL++;
8481 4501854 : if (n < lcache) gel(S,n) = C;
8482 4501854 : return C;
8483 : }
8484 :
8485 : static long
8486 1400 : mfdim_Nkchi(long N, long k, GEN CHI, long space)
8487 : {
8488 1400 : if (k < 0 || badchar(N,k,CHI)) return 0;
8489 1099 : if (k == 0)
8490 35 : return mfcharistrivial(CHI) && !space_is_cusp(space)? 1: 0;
8491 1064 : switch(space)
8492 : {
8493 245 : case mf_NEW: return mfnewdim(N,k,CHI);
8494 203 : case mf_CUSP:return mfcuspdim(N,k,CHI);
8495 168 : case mf_OLD: return mfolddim(N,k,CHI);
8496 217 : case mf_FULL:return mffulldim(N,k,CHI);
8497 231 : case mf_EISEN: return mfeisensteindim(N,k,CHI);
8498 0 : default: pari_err_FLAG("mfdim");
8499 : }
8500 : return 0;/*LCOV_EXCL_LINE*/
8501 : }
8502 : static long
8503 2114 : mf1dimsum(long N, long space)
8504 : {
8505 2114 : switch(space)
8506 : {
8507 1050 : case mf_NEW: return mf1newdimsum(N);
8508 1057 : case mf_CUSP: return mf1cuspdimsum(N);
8509 7 : case mf_OLD: return mf1olddimsum(N);
8510 : }
8511 0 : pari_err_FLAG("mfdim");
8512 : return 0; /*LCOV_EXCL_LINE*/
8513 : }
8514 : /* mfdim for k = nk/dk */
8515 : static long
8516 44744 : mfdim_Nndkchi(long N, long nk, long dk, GEN CHI, long space)
8517 43463 : { return (dk == 2)? mf2dim_Nkchi(N, nk >> 1, CHI, space)
8518 88186 : : mfdim_Nkchi(N, nk, CHI, space); }
8519 : /* FIXME: use direct dim Gamma1(N) formula, don't compute individual spaces */
8520 : static long
8521 252 : mfkdimsum(long N, long k, long dk, long space)
8522 : {
8523 252 : GEN w = mfchars(N, k, dk, NULL);
8524 252 : long i, j, D = 0, l = lg(w);
8525 1239 : for (i = j = 1; i < l; i++)
8526 : {
8527 987 : GEN CHI = gel(w,i);
8528 987 : long d = mfdim_Nndkchi(N,k,dk,CHI,space);
8529 987 : if (d) D += d * myeulerphiu(mfcharorder(CHI));
8530 : }
8531 252 : return D;
8532 : }
8533 : static GEN
8534 105 : mf1dims(long N, GEN vCHI, long space)
8535 : {
8536 105 : GEN D = NULL;
8537 105 : switch(space)
8538 : {
8539 56 : case mf_NEW: D = mf1newdimall(N, vCHI); break;
8540 21 : case mf_CUSP:D = mf1cuspdimall(N, vCHI); break;
8541 28 : case mf_OLD: D = mf1olddimall(N, vCHI); break;
8542 0 : default: pari_err_FLAG("mfdim");
8543 : }
8544 105 : return D;
8545 : }
8546 : static GEN
8547 2961 : mfkdims(long N, long k, long dk, GEN vCHI, long space)
8548 : {
8549 2961 : GEN D, w = mfchars(N, k, dk, vCHI);
8550 2961 : long i, j, l = lg(w);
8551 2961 : D = cgetg(l, t_VEC);
8552 46592 : for (i = j = 1; i < l; i++)
8553 : {
8554 43631 : GEN CHI = gel(w,i);
8555 43631 : long d = mfdim_Nndkchi(N,k,dk,CHI,space);
8556 43631 : if (vCHI)
8557 574 : gel(D, j++) = mkvec2s(d, 0);
8558 43057 : else if (d)
8559 2520 : gel(D, j++) = fmt_dim(CHI, d, 0);
8560 : }
8561 2961 : setlg(D,j); return D;
8562 : }
8563 : GEN
8564 5719 : mfdim(GEN NK, long space)
8565 : {
8566 5719 : pari_sp av = avma;
8567 : long N, k, dk, joker;
8568 : GEN CHI, mf;
8569 5719 : if ((mf = checkMF_i(NK))) return utoi(MF_get_dim(mf));
8570 5586 : checkNK2(NK, &N, &k, &dk, &CHI, 2);
8571 5586 : if (!CHI) joker = 1;
8572 : else
8573 2611 : switch(typ(CHI))
8574 : {
8575 2373 : case t_INT: joker = 2; break;
8576 112 : case t_COL: joker = 3; break;
8577 126 : default: joker = 0; break;
8578 : }
8579 5586 : if (joker)
8580 : {
8581 : long d;
8582 : GEN D;
8583 5460 : if (k < 0) switch(joker)
8584 : {
8585 0 : case 1: return cgetg(1,t_VEC);
8586 7 : case 2: return gen_0;
8587 0 : case 3: return mfdim0all(CHI);
8588 : }
8589 5453 : if (k == 0)
8590 : {
8591 28 : if (space_is_cusp(space)) switch(joker)
8592 : {
8593 7 : case 1: return cgetg(1,t_VEC);
8594 0 : case 2: return gen_0;
8595 7 : case 3: return mfdim0all(CHI);
8596 : }
8597 14 : switch(joker)
8598 : {
8599 : long i, l;
8600 7 : case 1: retmkvec(fmt_dim(mfchartrivial(),0,0));
8601 0 : case 2: return gen_1;
8602 7 : case 3: l = lg(CHI); D = cgetg(l,t_VEC);
8603 35 : for (i = 1; i < l; i++)
8604 : {
8605 28 : long t = mfcharistrivial(gel(CHI,i));
8606 28 : gel(D,i) = mkvec2(t? gen_1: gen_0, gen_0);
8607 : }
8608 7 : return D;
8609 : }
8610 : }
8611 5425 : if (dk == 1 && k == 1 && space != mf_EISEN)
8612 105 : {
8613 2219 : long fix = 0, space0 = space;
8614 2219 : if (space == mf_FULL) space = mf_CUSP; /* remove Eisenstein part */
8615 2219 : if (joker == 2)
8616 : {
8617 2114 : d = mf1dimsum(N, space);
8618 2114 : if (space0 == mf_FULL) d += mfkdimsum(N,k,dk,mf_EISEN);/*add it back*/
8619 2114 : return gc_utoi(av, d);
8620 : }
8621 : /* must initialize explicitly: trivial spaces for E_k/S_k differ */
8622 105 : if (space0 == mf_FULL)
8623 : {
8624 7 : if (!CHI) fix = 1; /* must remove 0 spaces */
8625 7 : CHI = mfchars(N, k, dk, CHI);
8626 : }
8627 105 : D = mf1dims(N, CHI, space);
8628 105 : if (space0 == mf_FULL)
8629 : {
8630 7 : GEN D2 = mfkdims(N, k, dk, CHI, mf_EISEN);
8631 7 : D = merge_dims(D, D2, fix? CHI: NULL);
8632 : }
8633 : }
8634 : else
8635 : {
8636 3206 : if (joker==2) { d = mfkdimsum(N,k,dk,space); return gc_utoi(av,d); }
8637 2954 : D = mfkdims(N, k, dk, CHI, space);
8638 : }
8639 3059 : if (!CHI) return gc_upto(av, vecsort(D, mkvecsmall(1)));
8640 105 : return gc_GEN(av, D);
8641 : }
8642 126 : return utoi( mfdim_Nndkchi(N, k, dk, CHI, space) );
8643 : }
8644 :
8645 : GEN
8646 371 : mfbasis(GEN NK, long space)
8647 : {
8648 371 : pari_sp av = avma;
8649 : long N, k, dk;
8650 : GEN mf, CHI;
8651 371 : if ((mf = checkMF_i(NK))) return gconcat(gel(mf,2), gel(mf,3));
8652 14 : checkNK2(NK, &N, &k, &dk, &CHI, 0);
8653 14 : if (dk == 2) return gc_GEN(av, mf2basis(N, k>>1, CHI, NULL, space));
8654 14 : mf = mfinit_Nkchi(N, k, CHI, space, 1);
8655 14 : return gc_GEN(av, MF_get_basis(mf));
8656 : }
8657 :
8658 : static GEN
8659 49 : deg1ser_shallow(GEN a1, GEN a0, long v, long e)
8660 49 : { return RgX_to_ser(deg1pol_shallow(a1, a0, v), e+2); }
8661 : /* r / x + O(1) */
8662 : static GEN
8663 49 : simple_pole(GEN r)
8664 : {
8665 49 : GEN S = deg1ser_shallow(gen_0, r, 0, 1);
8666 49 : setvalser(S, -1); return S;
8667 : }
8668 :
8669 : /* F form, E embedding; mfa = mfatkininit or root number (eigenform case) */
8670 : static GEN
8671 175 : mflfuncreate(GEN mfa, GEN F, GEN E, GEN N, GEN gk)
8672 : {
8673 175 : GEN LF = cgetg(8,t_VEC), polar = cgetg(1,t_COL), eps;
8674 175 : long k = itou(gk);
8675 175 : gel(LF,1) = lfuntag(t_LFUN_MFCLOS, mkvec3(F,E,gen_1));
8676 175 : if (typ(mfa) != t_VEC)
8677 112 : eps = mfa; /* cuspidal eigenform: root number; no poles */
8678 : else
8679 : { /* mfatkininit */
8680 63 : GEN a0, b0, vF, vG, G = NULL;
8681 63 : GEN M = gel(mfa,2), C = gel(mfa,3), mf = gel(mfa,4);
8682 63 : M = gdiv(mfmatembed(E, M), C);
8683 63 : vF = mfvecembed(E, mftobasis_i(mf, F));
8684 63 : vG = RgM_RgC_mul(M, vF);
8685 63 : if (gequal(vF,vG)) eps = gen_1;
8686 49 : else if (gequal(vF,gneg(vG))) eps = gen_m1;
8687 : else
8688 : { /* not self-dual */
8689 42 : eps = NULL;
8690 42 : G = mfatkin(mfa, F);
8691 42 : gel(LF,2) = lfuntag(t_LFUN_MFCLOS, mkvec3(G,E,ginv(C)));
8692 42 : gel(LF,6) = powIs(k);
8693 : }
8694 : /* polar part */
8695 63 : a0 = mfembed(E, mfcoef(F,0));
8696 63 : b0 = eps? gmul(eps,a0): gdiv(mfembed(E, mfcoef(G,0)), C);
8697 63 : if (!gequal0(b0))
8698 : {
8699 28 : b0 = mulcxpowIs(gmul2n(b0,1), k);
8700 28 : polar = vec_append(polar, mkvec2(gk, simple_pole(b0)));
8701 : }
8702 63 : if (!gequal0(a0))
8703 : {
8704 21 : a0 = gneg(gmul2n(a0,1));
8705 21 : polar = vec_append(polar, mkvec2(gen_0, simple_pole(a0)));
8706 : }
8707 : }
8708 175 : if (eps) /* self-dual */
8709 : {
8710 133 : gel(LF,2) = mfcharorder(mf_get_CHI(F)) <= 2? gen_0: gen_1;
8711 133 : gel(LF,6) = mulcxpowIs(eps,k);
8712 : }
8713 175 : gel(LF,3) = mkvec2(gen_0, gen_1);
8714 175 : gel(LF,4) = gk;
8715 175 : gel(LF,5) = N;
8716 175 : if (lg(polar) == 1) setlg(LF,7); else gel(LF,7) = polar;
8717 175 : return LF;
8718 : }
8719 : static GEN
8720 147 : mflfuncreateall(long sd, GEN mfa, GEN F, GEN vE, GEN gN, GEN gk)
8721 : {
8722 147 : long i, l = lg(vE);
8723 147 : GEN L = cgetg(l, t_VEC);
8724 322 : for (i = 1; i < l; i++)
8725 175 : gel(L,i) = mflfuncreate(sd? gel(mfa,i): mfa, F, gel(vE,i), gN, gk);
8726 147 : return L;
8727 : }
8728 : GEN
8729 98 : lfunmf(GEN mf, GEN F, long bitprec)
8730 : {
8731 98 : pari_sp av = avma;
8732 98 : long i, l, prec = nbits2prec(bitprec);
8733 : GEN L, gk, gN;
8734 98 : mf = checkMF(mf);
8735 98 : gk = MF_get_gk(mf);
8736 98 : gN = MF_get_gN(mf);
8737 98 : if (typ(gk)!=t_INT) pari_err_IMPL("half-integral weight");
8738 98 : if (F)
8739 : {
8740 : GEN v;
8741 91 : long s = MF_get_space(mf);
8742 91 : if (!checkmf_i(F)) pari_err_TYPE("lfunmf", F);
8743 91 : if (!mfisinspace_i(mf, F)) err_space(F);
8744 91 : L = NULL;
8745 91 : if ((s == mf_NEW || s == mf_CUSP || s == mf_FULL)
8746 77 : && gequal(mfcoefs_i(F,1,1), mkvec2(gen_0,gen_1)))
8747 : { /* check if eigenform */
8748 49 : GEN vP, vF, b = mftobasis_i(mf, F);
8749 49 : long lF, d = degpol(mf_get_field(F));
8750 49 : v = mfsplit(mf, d, 0);
8751 49 : vF = gel(v,1);
8752 49 : vP = gel(v,2); lF = lg(vF);
8753 49 : for (i = 1; i < lF; i++)
8754 42 : if (degpol(gel(vP,i)) == d && gequal(gel(vF,i), b))
8755 : {
8756 42 : GEN vE = mfgetembed(F, prec);
8757 42 : GEN Z = mffrickeeigen_i(mf, mkvec(b), mkvec(vE), prec);
8758 42 : L = mflfuncreateall(1, gel(Z,1), F, vE, gN, gk);
8759 42 : break;
8760 : }
8761 : }
8762 91 : if (!L)
8763 : { /* not an eigenform: costly general case */
8764 49 : GEN mfa = mfatkininit_i(mf, itou(gN), 1, prec);
8765 49 : L = mflfuncreateall(0,mfa, F, mfgetembed(F,prec), gN, gk);
8766 : }
8767 91 : if (lg(L) == 2) L = gel(L,1);
8768 : }
8769 : else
8770 : {
8771 7 : GEN M = mfeigenbasis(mf), vE = mfeigenembed(mf, prec);
8772 7 : GEN v = mffrickeeigen(mf, vE, prec);
8773 7 : l = lg(vE); L = cgetg(l, t_VEC);
8774 63 : for (i = 1; i < l; i++)
8775 56 : gel(L,i) = mflfuncreateall(1,gel(v,i), gel(M,i), gel(vE,i), gN, gk);
8776 : }
8777 98 : return gc_GEN(av, L);
8778 : }
8779 :
8780 : GEN
8781 28 : mffromell(GEN E)
8782 : {
8783 28 : pari_sp av = avma;
8784 : GEN mf, F, z, v, S;
8785 : long N, i, l;
8786 :
8787 28 : checkell(E);
8788 28 : if (ell_get_type(E) != t_ELL_Q) pari_err_TYPE("mfffromell [E not over Q]", E);
8789 28 : N = itos(ellQ_get_N(E));
8790 28 : mf = mfinit_i(mkvec2(utoi(N), gen_2), mf_NEW);
8791 28 : v = split_i(mf, 1, 0);
8792 28 : S = gel(v,1); l = lg(S); /* rational newforms */
8793 28 : F = tag(t_MF_ELL, mkNK(N,2,mfchartrivial()), E);
8794 28 : z = mftobasis_i(mf, F);
8795 28 : for(i = 1; i < l; i++)
8796 28 : if (gequal(z, gel(S,i))) break;
8797 28 : if (i == l) pari_err_BUG("mffromell [E is not modular]");
8798 28 : return gc_GEN(av, mkvec3(mf, F, z));
8799 : }
8800 :
8801 : /* returns -1 if not, degree otherwise */
8802 : long
8803 140 : polishomogeneous(GEN P)
8804 : {
8805 : long i, D, l;
8806 140 : if (typ(P) != t_POL) return 0;
8807 77 : D = -1; l = lg(P);
8808 322 : for (i = 2; i < l; i++)
8809 : {
8810 245 : GEN c = gel(P,i);
8811 : long d;
8812 245 : if (gequal0(c)) continue;
8813 112 : d = polishomogeneous(c);
8814 112 : if (d < 0) return -1;
8815 112 : if (D < 0) D = d + i-2; else if (D != d + i-2) return -1;
8816 : }
8817 77 : return D;
8818 : }
8819 :
8820 : /* M a pp((Gram q)^(-1)) ZM; P a homogeneous t_POL, is P spherical ? */
8821 : static int
8822 28 : RgX_isspherical(GEN M, GEN P)
8823 : {
8824 28 : pari_sp av = avma;
8825 28 : GEN S, v = variables_vecsmall(P);
8826 28 : long i, j, l = lg(v);
8827 28 : if (l > lg(M)) pari_err(e_MISC, "too many variables in mffromqf");
8828 21 : S = gen_0;
8829 63 : for (j = 1; j < l; j++)
8830 : {
8831 42 : GEN Mj = gel(M, j), Pj = deriv(P, v[j]);
8832 105 : for (i = 1; i <= j; i++)
8833 : {
8834 63 : GEN c = gel(Mj, i);
8835 63 : if (!signe(c)) continue;
8836 42 : if (i != j) c = shifti(c, 1);
8837 42 : S = gadd(S, gmul(c, deriv(Pj, v[i])));
8838 : }
8839 : }
8840 21 : return gc_bool(av, gequal0(S));
8841 : }
8842 :
8843 : static GEN
8844 49 : c_QFsimple_i(long n, GEN Q, GEN P)
8845 : {
8846 49 : GEN V, v = qfrep0(Q, utoi(n), 1);
8847 49 : long i, l = lg(v);
8848 49 : V = cgetg(l+1, t_VEC);
8849 49 : if (!P || equali1(P))
8850 : {
8851 42 : gel(V,1) = gen_1;
8852 420 : for (i = 2; i <= l; i++) gel(V,i) = utoi(v[i-1] << 1);
8853 : }
8854 : else
8855 : {
8856 7 : gel(V,1) = gcopy(P);
8857 7 : for (i = 2; i <= l; i++) gel(V,i) = gmulgu(P, v[i-1] << 1);
8858 : }
8859 49 : return V;
8860 : }
8861 :
8862 : /* v a t_VECSMALL of variable numbers, lg(r) >= lg(v), r is a vector of
8863 : * scalars [not involving any variable in v] */
8864 : static GEN
8865 14 : gsubstvec_i(GEN e, GEN v, GEN r)
8866 : {
8867 14 : long i, l = lg(v);
8868 42 : for(i = 1; i < l; i++) e = gsubst(e, v[i], gel(r,i));
8869 14 : return e;
8870 : }
8871 : static GEN
8872 56 : c_QF_i(long n, GEN Q, GEN P)
8873 : {
8874 56 : pari_sp av = avma;
8875 : GEN V, v, va;
8876 : long i, l;
8877 56 : if (!P || typ(P) != t_POL) return gc_upto(av, c_QFsimple_i(n, Q, P));
8878 7 : v = gel(minim(Q, utoi(2*n), NULL), 3);
8879 7 : va = variables_vecsmall(P);
8880 7 : V = zerovec(n + 1); l = lg(v);
8881 21 : for (i = 1; i < l; i++)
8882 : {
8883 14 : pari_sp av = avma;
8884 14 : GEN X = gel(v,i);
8885 14 : long c = (itos(qfeval(Q, X)) >> 1) + 1;
8886 14 : gel(V, c) = gc_upto(av, gadd(gel(V, c), gsubstvec_i(P, va, X)));
8887 : }
8888 7 : return gmul2n(V, 1);
8889 : }
8890 :
8891 : GEN
8892 77 : mffromqf(GEN Q, GEN P)
8893 : {
8894 77 : pari_sp av = avma;
8895 : GEN G, Qi, F, D, N, mf, v, gk, chi;
8896 : long m, d, space;
8897 77 : if (typ(Q) != t_MAT) pari_err_TYPE("mffromqf", Q);
8898 77 : if (!RgM_is_ZM(Q) || !qfiseven(Q))
8899 0 : pari_err_TYPE("mffromqf [not integral or even]", Q);
8900 77 : m = lg(Q)-1;
8901 77 : Qi = ZM_inv(Q, &N);
8902 77 : if (!qfiseven(Qi)) N = shifti(N, 1);
8903 77 : d = 0;
8904 77 : if (!P || gequal1(P)) P = NULL;
8905 : else
8906 : {
8907 35 : P = simplify_shallow(P);
8908 35 : if (typ(P) == t_POL)
8909 : {
8910 28 : d = polishomogeneous(P);
8911 28 : if (d < 0) pari_err_TYPE("mffromqf [not homogeneous t_POL]", P);
8912 28 : if (!RgX_isspherical(Qi, P))
8913 7 : pari_err_TYPE("mffromqf [not a spherical t_POL]", P);
8914 : }
8915 : }
8916 63 : gk = uutoQ(m + 2*d, 2);
8917 63 : D = ZM_det(Q);
8918 63 : if (!odd(m)) { if ((m & 3) == 2) D = negi(D); } else D = shifti(D, 1);
8919 63 : space = d > 0 ? mf_CUSP : mf_FULL;
8920 63 : G = znstar0(N,1);
8921 63 : chi = mkvec2(G, znchar_quad(G,D));
8922 63 : mf = mfinit(mkvec3(N, gk, chi), space);
8923 63 : if (odd(d))
8924 : {
8925 7 : F = mftrivial();
8926 7 : v = zerocol(MF_get_dim(mf));
8927 : }
8928 : else
8929 : {
8930 56 : F = c_QF_i(mfsturm(mf), Q, P);
8931 56 : v = mftobasis_i(mf, F);
8932 56 : F = mflinear(mf, v);
8933 : }
8934 63 : return gc_GEN(av, mkvec3(mf, F, v));
8935 : }
8936 :
8937 : /***********************************************************************/
8938 : /* Eisenstein Series */
8939 : /***********************************************************************/
8940 : /* \sigma_{k-1}(\chi,n) */
8941 : static GEN
8942 24192 : sigchi(long k, GEN CHI, long n)
8943 : {
8944 24192 : pari_sp av = avma;
8945 24192 : GEN S = gen_1, D = mydivisorsu(u_ppo(n,mfcharmodulus(CHI)));
8946 24192 : long i, l = lg(D), ord = mfcharorder(CHI), vt = varn(mfcharpol(CHI));
8947 83671 : for (i = 2; i < l; i++) /* skip D[1] = 1 */
8948 : {
8949 59479 : long d = D[i], a = mfcharevalord(CHI, d, ord);
8950 59479 : S = gadd(S, Qab_Czeta(a, ord, powuu(d, k-1), vt));
8951 : }
8952 24192 : return gc_upto(av,S);
8953 : }
8954 :
8955 : /* write n = n0*n1*n2, (n0,N1*N2) = 1, n1 | N1^oo, n2 | N2^oo;
8956 : * return NULL if (n,N1,N2) > 1, else return factoru(n0) */
8957 : static GEN
8958 686350 : sigchi2_dec(long n, long N1, long N2, long *pn1, long *pn2)
8959 : {
8960 686350 : GEN P0, E0, P, E, fa = myfactoru(n);
8961 : long i, j, l;
8962 686350 : *pn1 = 1;
8963 686350 : *pn2 = 1;
8964 686350 : if (N1 == 1 && N2 == 1) return fa;
8965 669242 : P = gel(fa,1); l = lg(P);
8966 669242 : E = gel(fa,2);
8967 669242 : P0 = cgetg(l, t_VECSMALL);
8968 669242 : E0 = cgetg(l, t_VECSMALL);
8969 1553958 : for (i = j = 1; i < l; i++)
8970 : {
8971 989975 : long p = P[i], e = E[i];
8972 989975 : if (N1 % p == 0)
8973 : {
8974 142919 : if (N2 % p == 0) return NULL;
8975 37660 : *pn1 *= upowuu(p,e);
8976 : }
8977 847056 : else if (N2 % p == 0)
8978 129717 : *pn2 *= upowuu(p,e);
8979 717339 : else { P0[j] = p; E0[j] = e; j++; }
8980 : }
8981 563983 : setlg(P0, j);
8982 563983 : setlg(E0, j); return mkvec2(P0,E0);
8983 : }
8984 :
8985 : /* sigma_{k-1}(\chi_1,\chi_2,n), ord multiple of lcm(ord(CHI1),ord(CHI2)) */
8986 : static GEN
8987 608559 : sigchi2(long k, GEN CHI1, GEN CHI2, long n, long ord)
8988 : {
8989 608559 : pari_sp av = avma;
8990 : GEN S, D;
8991 608559 : long i, l, n1, n2, vt, N1 = mfcharmodulus(CHI1), N2 = mfcharmodulus(CHI2);
8992 608559 : D = sigchi2_dec(n, N1, N2, &n1, &n2); if (!D) return gc_const(av, gen_0);
8993 507983 : D = divisorsu_fact(D); l = lg(D);
8994 507983 : vt = varn(mfcharpol(CHI1));
8995 2192253 : for (i = 1, S = gen_0; i < l; i++)
8996 : { /* S += d^(k-1)*chi1(d)*chi2(n/d) */
8997 1684270 : long a, d = n2*D[i], nd = n1*D[l-i]; /* (d,N1)=1; (n/d,N2) = 1 */
8998 1684270 : a = mfcharevalord(CHI1, d, ord) + mfcharevalord(CHI2, nd, ord);
8999 1684270 : if (a >= ord) a -= ord;
9000 1684270 : S = gadd(S, Qab_Czeta(a, ord, powuu(d, k-1), vt));
9001 : }
9002 507983 : return gc_upto(av, S);
9003 : }
9004 :
9005 : /**************************************************************************/
9006 : /** Dirichlet characters with precomputed values **/
9007 : /**************************************************************************/
9008 : /* CHI mfchar */
9009 : static GEN
9010 33985 : mfcharcxinit(GEN CHI, long prec)
9011 : {
9012 33985 : GEN G = gel(CHI,1), chi = gel(CHI,2), z, V;
9013 33985 : GEN v = ncharvecexpo(G, znconrey_normalized(G,chi));
9014 33985 : long n, l = lg(v), o = mfcharorder(CHI);
9015 33985 : V = cgetg(l, t_VEC);
9016 33985 : z = grootsof1(o, prec); /* Mod(t, Phi_o(t)) -> e(1/o) */
9017 480851 : for (n = 1; n < l; n++) gel(V,n) = v[n] < 0? gen_0: gel(z, v[n]+1);
9018 33985 : return mkvecn(6, G, chi, gmfcharorder(CHI), v, V, mfcharpol(CHI));
9019 : }
9020 : /* v a "CHIvec" */
9021 : static long
9022 28601909 : CHIvec_N(GEN v) { return itou(znstar_get_N(gel(v,1))); }
9023 : static GEN
9024 25914 : CHIvec_CHI(GEN v)
9025 25914 : { return mkvec4(gel(v,1), gel(v,2), gel(v,3), gel(v,6)); }
9026 : /* character order */
9027 : static long
9028 66311 : CHIvec_ord(GEN v) { return itou(gel(v,3)); }
9029 : /* character exponents, i.e. t such that chi(n) = e(t) */
9030 : static GEN
9031 626913 : CHIvec_expo(GEN v) { return gel(v,4); }
9032 : /* character values chi(n) */
9033 : static GEN
9034 27670174 : CHIvec_val(GEN v) { return gel(v,5); }
9035 : /* CHI(n) */
9036 : static GEN
9037 27645779 : mychareval(GEN v, long n)
9038 : {
9039 27645779 : long N = CHIvec_N(v), ind = n%N;
9040 27645779 : if (ind <= 0) ind += N;
9041 27645779 : return gel(CHIvec_val(v), ind);
9042 : }
9043 : /* return c such that CHI(n) = e(c / ordz) or -1 if (n,N) > 1 */
9044 : static long
9045 626913 : mycharexpo(GEN v, long n)
9046 : {
9047 626913 : long N = CHIvec_N(v), ind = n%N;
9048 626913 : if (ind <= 0) ind += N;
9049 626913 : return CHIvec_expo(v)[ind];
9050 : }
9051 : /* faster than mfcharparity */
9052 : static long
9053 54754 : CHIvec_parity(GEN v) { return mycharexpo(v,-1) ? -1: 1; }
9054 : /**************************************************************************/
9055 :
9056 : static ulong
9057 77791 : sigchi2_Fl(long k, GEN CHI1vec, GEN CHI2vec, long n, GEN vz, ulong p)
9058 : {
9059 77791 : pari_sp av = avma;
9060 77791 : long ordz = lg(vz)-2, i, l, n1, n2;
9061 77791 : ulong S = 0;
9062 77791 : GEN D = sigchi2_dec(n, CHIvec_N(CHI1vec), CHIvec_N(CHI2vec), &n1, &n2);
9063 77791 : if (!D) return gc_ulong(av,S);
9064 73108 : D = divisorsu_fact(D);
9065 73108 : l = lg(D);
9066 276444 : for (i = 1; i < l; i++)
9067 : { /* S += d^(k-1)*chi1(d)*chi2(n/d) */
9068 203336 : long a, d = n2*D[i], nd = n1*D[l-i]; /* (d,N1)=1, (n/d,N2)=1 */
9069 203336 : a = mycharexpo(CHI2vec, nd) + mycharexpo(CHI1vec, d);
9070 203336 : if (a >= ordz) a -= ordz;
9071 203336 : S = Fl_add(S, Qab_Czeta_Fl(a, vz, Fl_powu(d,k-1,p), p), p);
9072 : }
9073 73108 : return gc_ulong(av,S);
9074 : }
9075 :
9076 : /**********************************************************************/
9077 : /* Fourier expansions of Eisenstein series */
9078 : /**********************************************************************/
9079 : /* L(CHI_t,0) / 2, CHI_t(n) = CHI(n)(t/n) as a character modulo N*t,
9080 : * order(CHI) | ord != 0 */
9081 : static GEN
9082 2618 : charLFwt1(long N, GEN CHI, long ord, long t)
9083 : {
9084 : GEN S;
9085 : long r, vt;
9086 :
9087 2618 : if (N == 1 && t == 1) return mkfrac(gen_m1,stoi(4));
9088 2618 : S = gen_0; vt = varn(mfcharpol(CHI));
9089 295435 : for (r = 1; r < N; r++)
9090 : { /* S += r*chi(r) */
9091 : long a, c;
9092 292817 : if (ugcd(N,r) != 1) continue;
9093 233310 : a = mfcharevalord(CHI,r,ord);
9094 233310 : c = (t != 1 && kross(t, r) < 0)? -r: r;
9095 233310 : S = gadd(S, Qab_Czeta(a, ord, stoi(c), vt));
9096 : }
9097 2618 : return gdivgs(S, -2*N);
9098 : }
9099 : /* L(CHI,0) / 2, mod p */
9100 : static ulong
9101 2002 : charLFwt1_Fl(GEN CHIvec, GEN vz, ulong p)
9102 : {
9103 2002 : long r, m = CHIvec_N(CHIvec);
9104 : ulong S;
9105 2002 : if (m == 1) return Rg_to_Fl(mkfrac(gen_m1,stoi(4)), p);
9106 2002 : S = 0;
9107 95977 : for (r = 1; r < m; r++)
9108 : { /* S += r*chi(r) */
9109 93975 : long a = mycharexpo(CHIvec,r);
9110 93975 : if (a < 0) continue;
9111 91616 : S = Fl_add(S, Qab_Czeta_Fl(a, vz, r, p), p);
9112 : }
9113 2002 : return Fl_div(Fl_neg(S,p), 2*m, p);
9114 : }
9115 : /* L(CHI_t,1-k) / 2, CHI_t(n) = CHI(n) * (t/n), order(CHI) | ord != 0;
9116 : * assume conductor of CHI_t divides N */
9117 : static GEN
9118 4557 : charLFwtk(long N, long k, GEN CHI, long ord, long t)
9119 : {
9120 : GEN S, P, dS;
9121 : long r, vt;
9122 :
9123 4557 : if (k == 1) return charLFwt1(N, CHI, ord, t);
9124 1939 : if (N == 1 && t == 1) return gdivgs(bernfrac(k),-2*k);
9125 1176 : vt = varn(mfcharpol(CHI));
9126 1176 : P = bern_init(N, k, &dS);
9127 1176 : dS = mul_denom(dS, stoi(-2*N*k));
9128 17633 : for (r = 1, S = gen_0; r < N; r++)
9129 : { /* S += P(r)*chi(r) */
9130 : long a;
9131 : GEN C;
9132 16457 : if (ugcd(r,N) != 1) continue;
9133 13860 : a = mfcharevalord(CHI,r,ord);
9134 13860 : C = ZX_Z_eval(P, utoi(r));
9135 13860 : if (t != 1 && kross(t, r) < 0) C = gneg(C);
9136 13860 : S = gadd(S, Qab_Czeta(a, ord, C, vt));
9137 : }
9138 1176 : return gdiv(S, dS);
9139 : }
9140 : /* L(CHI,1-k) / 2, mod p */
9141 : static ulong
9142 3227 : charLFwtk_Fl(long k, GEN CHIvec, GEN vz, ulong p)
9143 : {
9144 : GEN P, dS;
9145 : long r, m;
9146 : ulong S, d;
9147 3227 : if (k == 1) return charLFwt1_Fl(CHIvec, vz, p);
9148 1225 : m = CHIvec_N(CHIvec);
9149 1225 : if (m == 1) return Rg_to_Fl(gdivgs(bernfrac(k),-2*k), p);
9150 819 : P = ZX_to_Flx(bern_init(m, k, &dS), p);
9151 20167 : for (r = 1, S = 0; r < m; r++)
9152 : { /* S += P(r)*chi(r) */
9153 19348 : long a = mycharexpo(CHIvec,r);
9154 19348 : if (a < 0) continue;
9155 18088 : S = Fl_add(S, Qab_Czeta_Fl(a, vz, Flx_eval(P,r,p), p), p);
9156 : }
9157 819 : d = (2 * k * m) % p; if (dS) d = Fl_mul(d, umodiu(dS, p), p);
9158 819 : return Fl_div(Fl_neg(S,p), d, p);
9159 : }
9160 :
9161 : static GEN
9162 8365 : mfeisenstein2_0(long k, GEN CHI1, GEN CHI2, long ord)
9163 : {
9164 8365 : long N1 = mfcharmodulus(CHI1), N2 = mfcharmodulus(CHI2);
9165 8365 : if (k == 1 && N1 == 1) return charLFwtk(N2, 1, CHI2, ord, 1);
9166 5754 : if (N2 == 1) return charLFwtk(N1, k, CHI1, ord, 1);
9167 4025 : return gen_0;
9168 : }
9169 : static ulong
9170 5054 : mfeisenstein2_0_Fl(long k, GEN CHI1vec, GEN CHI2vec, GEN vz, ulong p)
9171 : {
9172 5054 : if (k == 1 && CHIvec_N(CHI1vec) == 1)
9173 2002 : return charLFwtk_Fl(k, CHI2vec, vz, p);
9174 3052 : else if (CHIvec_N(CHI2vec) == 1)
9175 1225 : return charLFwtk_Fl(k, CHI1vec, vz, p);
9176 1827 : else return 0;
9177 : }
9178 : static GEN
9179 140 : NK_eisen2(long k, GEN CHI1, GEN CHI2, long ord)
9180 : {
9181 140 : long o, N = mfcharmodulus(CHI1)*mfcharmodulus(CHI2);
9182 140 : GEN CHI = mfcharmul(CHI1, CHI2);
9183 140 : o = mfcharorder(CHI);
9184 140 : if ((ord & 3) == 2) ord >>= 1;
9185 140 : if ((o & 3) == 2) o >>= 1;
9186 140 : if (ord != o) pari_err_IMPL("mfeisenstein for these characters");
9187 133 : return mkNK(N, k, CHI);
9188 : }
9189 : static GEN
9190 343 : mfeisenstein_prim(long k, GEN CHI1, GEN CHI2)
9191 : {
9192 : long ord, vt;
9193 : GEN E0, NK, vchi, T;
9194 343 : if (!CHI2)
9195 : { /* E_k(chi1) */
9196 203 : vt = varn(mfcharpol(CHI1));
9197 203 : ord = mfcharorder(CHI1);
9198 203 : NK = mkNK(mfcharmodulus(CHI1), k, CHI1);
9199 203 : E0 = charLFwtk(mfcharmodulus(CHI1), k, CHI1, ord, 1);
9200 203 : vchi = mkvec3(E0, mkvec(mfcharpol(CHI1)), CHI1);
9201 203 : return tag(t_MF_EISEN, NK, vchi);
9202 : }
9203 : /* E_k(chi1,chi2) */
9204 140 : vt = varn(mfcharpol(CHI1));
9205 140 : ord = ulcm(mfcharorder(CHI1), mfcharorder(CHI2));
9206 140 : NK = NK_eisen2(k, CHI1, CHI2, ord);
9207 133 : E0 = mfeisenstein2_0(k, CHI1, CHI2, ord);
9208 133 : T = mkvec(polcyclo(ord, vt));
9209 133 : vchi = mkvec4(E0, T, CHI1, CHI2);
9210 133 : return tag2(t_MF_EISEN, NK, vchi, mkvecsmall2(ord,0));
9211 : }
9212 : static GEN
9213 378 : mfeisenstein_i(long k, GEN CHI1, GEN CHI2)
9214 : {
9215 378 : long s = 1, i, f = 1, N1 = 1, Nf, lD;
9216 : GEN P, E, D, L1, L2;
9217 378 : if (CHI2) { CHI2 = get_mfchar(CHI2); if (mfcharparity(CHI2) < 0) s = -s; }
9218 378 : if (CHI1)
9219 : {
9220 154 : CHI1 = get_mfchar(CHI1);
9221 140 : N1 = mfcharmodulus(CHI1);
9222 140 : CHI1 = mfchartoprimitive(CHI1, &f);
9223 140 : if (mfcharparity(CHI1) < 0) s = -s;
9224 : } else
9225 224 : CHI1 = mfchartrivial();
9226 364 : if (s != m1pk(k)) return mftrivial();
9227 343 : E = mfeisenstein_prim(k,CHI1,CHI2);
9228 336 : if (N1 == f) return E;
9229 14 : Nf = N1 / f;
9230 14 : P = gel(factoru(u_ppo(Nf, f)), 1);
9231 14 : D = divisorsu_moebius(P); lD = lg(D);
9232 14 : L1 = cgetg(lD, t_VEC); L2 = cgetg(lD, t_VEC);
9233 42 : for (i = 1; i < lD; i++)
9234 : { /* m = mu(g)*g, g | Nf, coprime to f, squarefree */
9235 28 : long m = D[i], g = labs(m);
9236 28 : GEN c = gdiv(mfchareval(CHI1,g),powuu(g,k));
9237 28 : gel(L1,i) = m < 0 ? gneg(c): c;
9238 28 : gel(L2,i) = mfbd_i(E, Nf / g);
9239 : }
9240 14 : return mflinear(L2, L1);
9241 : }
9242 :
9243 : GEN
9244 378 : mfeisenstein(long k, GEN CHI1, GEN CHI2)
9245 : {
9246 378 : pari_sp av = avma;
9247 378 : if (k < 1) pari_err_DOMAIN("mfeisenstein", "k", "<", gen_1, stoi(k));
9248 378 : return gc_GEN(av, mfeisenstein_i(k, CHI1, CHI2));
9249 : }
9250 :
9251 : static GEN
9252 2646 : mfeisenstein2all(long N0, GEN NK, long k, GEN CHI1, GEN CHI2, GEN T, long o)
9253 : {
9254 2646 : GEN E, E0 = mfeisenstein2_0(k, CHI1,CHI2, o), vchi = mkvec4(E0, T, CHI1,CHI2);
9255 2646 : long j, d = (lg(T)==4)? itou(gmael(T,3,1)): 1;
9256 2646 : E = cgetg(d+1, t_VEC);
9257 5411 : for (j=1; j<=d; j++) gel(E,j) = tag2(t_MF_EISEN, NK,vchi,mkvecsmall2(o,j-1));
9258 2646 : return mfbdall(E, N0 / mf_get_N(gel(E,1)));
9259 : }
9260 :
9261 : /* list of characters on G = (Z/NZ)^*, v[i] = NULL if (i,N) > 1, else
9262 : * the conductor of Conrey label i, [conductor, primitive char].
9263 : * Trivial chi (label 1) comes first */
9264 : static GEN
9265 1169 : zncharsG(GEN G)
9266 : {
9267 1169 : long i, l, N = itou(znstar_get_N(G));
9268 : GEN vCHI, V;
9269 1169 : if (N == 1) return mkvec2(gen_1,cgetg(1,t_COL));
9270 1169 : vCHI = const_vec(N,NULL);
9271 1169 : V = cyc2elts(znstar_get_conreycyc(G));
9272 1169 : l = lg(V);
9273 207739 : for (i = 1; i < l; i++)
9274 : {
9275 206570 : GEN chi0, chi = zc_to_ZC(gel(V,i)), n, F;
9276 206570 : F = znconreyconductor(G, chi, &chi0);
9277 206570 : if (typ(F) != t_INT) F = gel(F,1);
9278 206570 : n = znconreyexp(G, chi);
9279 206570 : gel(vCHI, itos(n)) = mkvec2(chi0, F);
9280 : }
9281 1169 : return vCHI;
9282 : }
9283 :
9284 : /* CHI primitive, f(CHI) | N. Return pairs (CHI1,CHI2) both primitive
9285 : * such that f(CHI1)*f(CHI2) | N and CHI1 * CHI2 = CHI;
9286 : * if k = 1, CHI1 is even; if k = 2, omit (1,1) if CHI = 1 */
9287 : static GEN
9288 1428 : mfeisensteinbasis_i(long N0, long k, GEN CHI)
9289 : {
9290 1428 : GEN G = gel(CHI,1), chi = gel(CHI,2), vT = const_vec(myeulerphiu(N0), NULL);
9291 1428 : GEN CHI0, GN, chiN, Lchi, LG, V, RES, NK, T, C = mfcharpol(CHI);
9292 1428 : long i, j, l, n, n1, N, ord = mfcharorder(CHI);
9293 1428 : long F = mfcharmodulus(CHI), vt = varn(mfcharpol(CHI));
9294 :
9295 1428 : CHI0 = (F == 1)? CHI: mfchartrivial();
9296 1428 : j = 1; RES = cgetg(N0+1, t_VEC);
9297 1428 : T = gel(vT,ord) = Qab_trace_init(ord, ord, C, C);
9298 1428 : if (F != 1 || k != 2)
9299 : { /* N1 = 1 */
9300 1274 : NK = mkNK(F, k, CHI);
9301 1274 : gel(RES, j++) = mfeisenstein2all(N0, NK, k, CHI0, CHI, T, ord);
9302 1274 : if (F != 1 && k != 1)
9303 329 : gel(RES, j++) = mfeisenstein2all(N0, NK, k, CHI, CHI0, T, ord);
9304 : }
9305 1428 : if (N0 == 1) { setlg(RES,j); return RES; }
9306 1330 : GN = G; chiN = chi;
9307 1330 : if (F == N0) N = N0;
9308 : else
9309 : {
9310 728 : GEN faN = myfactoru(N0), P = gel(faN,1), E = gel(faN,2);
9311 728 : long lP = lg(P);
9312 1876 : for (i = N = 1; i < lP; i++)
9313 : {
9314 1148 : long p = P[i];
9315 1148 : N *= upowuu(p, maxuu(E[i]/2, z_lval(F,p)));
9316 : }
9317 728 : if ((N & 3) == 2) N >>= 1;
9318 728 : if (N == 1) { setlg(RES,j); return RES; }
9319 567 : if (F != N)
9320 : {
9321 133 : GN = znstar0(utoipos(N),1);
9322 133 : chiN = zncharinduce(G, chi, GN);
9323 : }
9324 : }
9325 1169 : LG = const_vec(N, NULL); /* LG[d] = znstar(d,1) or NULL */
9326 1169 : gel(LG,1) = gel(CHI0,1);
9327 1169 : gel(LG,F) = G;
9328 1169 : gel(LG,N) = GN;
9329 1169 : Lchi = coprimes_zv(N);
9330 1169 : n = itou(znconreyexp(GN,chiN));
9331 1169 : V = zncharsG(GN); l = lg(V);
9332 263305 : for (n1 = 2; n1 < l; n1++) /* skip 1 (trivial char) */
9333 : {
9334 262136 : GEN v = gel(V,n1), w, chi1, chi2, G1, G2, CHI1, CHI2;
9335 : long N12, N1, N2, no, o12, t, m;
9336 262136 : if (!Lchi[n1] || n1 == n) continue; /* skip trivial chi2 */
9337 204197 : chi1 = gel(v,1); N1 = itou(gel(v,2)); /* conductor of chi1 */
9338 204197 : w = gel(V, Fl_div(n,n1,N));
9339 204197 : chi2 = gel(w,1); N2 = itou(gel(w,2)); /* conductor of chi2 */
9340 204197 : N12 = N1 * N2;
9341 204197 : if (N0 % N12) continue;
9342 :
9343 1771 : G1 = gel(LG,N1); if (!G1) gel(LG,N1) = G1 = znstar0(utoipos(N1), 1);
9344 1771 : if (k == 1 && zncharisodd(G1,chi1)) continue;
9345 1043 : G2 = gel(LG,N2); if (!G2) gel(LG,N2) = G2 = znstar0(utoipos(N2), 1);
9346 1043 : CHI1 = mfcharGL(G1, chi1);
9347 1043 : CHI2 = mfcharGL(G2, chi2);
9348 1043 : o12 = ulcm(mfcharorder(CHI1), mfcharorder(CHI2));
9349 : /* remove Galois orbit: same trace */
9350 1043 : no = Fl_powu(n1, ord, N);
9351 1414 : for (t = 1+ord, m = n1; t <= o12; t += ord)
9352 : { /* m <-> CHI1^t, if t in Gal(Q(chi1,chi2)/Q), omit (CHI1^t,CHI2^t) */
9353 371 : m = Fl_mul(m, no, N); if (!m) break;
9354 371 : if (ugcd(t, o12) == 1) Lchi[m] = 0;
9355 : }
9356 1043 : T = gel(vT,o12);
9357 1043 : if (!T) T = gel(vT,o12) = Qab_trace_init(o12, ord, polcyclo(o12,vt), C);
9358 1043 : NK = mkNK(N12, k, CHI);
9359 1043 : gel(RES, j++) = mfeisenstein2all(N0, NK, k, CHI1, CHI2, T, o12);
9360 : }
9361 1169 : setlg(RES,j); return RES;
9362 : }
9363 :
9364 : static GEN
9365 721 : mfbd_E2(GEN E2, long d, GEN CHI)
9366 : {
9367 721 : GEN E2d = mfbd_i(E2, d);
9368 721 : GEN F = mkvec2(E2, E2d), L = mkvec2(gen_1, utoineg(d));
9369 : /* cannot use mflinear_i: E2 and E2d do not have the same level */
9370 721 : return tag3(t_MF_LINEAR, mkNK(d,2,CHI), F, L, gen_1);
9371 : }
9372 : /* C-basis of E_k(Gamma_0(N),chi). If k = 1, the first basis element must not
9373 : * vanish at oo [used in mf1basis]. Here E_1(CHI), whose q^0 coefficient
9374 : * does not vanish (since L(CHI,0) does not) *if* CHI is not trivial; which
9375 : * must be the case in weight 1.
9376 : *
9377 : * (k>=3): In weight k >= 3, basis is B(d) E(CHI1,(CHI/CHI1)_prim), where
9378 : * CHI1 is primitive modulo N1, and if N2 is the conductor of CHI/CHI1
9379 : * then d*N1*N2 | N.
9380 : * (k=2): In weight k=2, same if CHI is nontrivial. If CHI is trivial, must
9381 : * not take CHI1 trivial, and must add E_2(tau)-dE_2(d tau)), where
9382 : * d|N, d > 1.
9383 : * (k=1): In weight k=1, same as k >= 3 except that we restrict to CHI1 even */
9384 : static GEN
9385 1456 : mfeisensteinbasis(long N, long k, GEN CHI)
9386 : {
9387 : long i, F;
9388 : GEN L;
9389 1456 : if (badchar(N, k, CHI)) return cgetg(1, t_VEC);
9390 1456 : if (k == 0) return mfcharistrivial(CHI)? mkvec(mf1()): cgetg(1, t_VEC);
9391 1428 : CHI = mfchartoprimitive(CHI, &F);
9392 1428 : L = mfeisensteinbasis_i(N, k, CHI);
9393 1428 : if (F == 1 && k == 2)
9394 : {
9395 154 : GEN v, E2 = mfeisenstein(2, NULL, NULL), D = mydivisorsu(N);
9396 154 : long nD = lg(D)-1;
9397 154 : v = cgetg(nD, t_VEC); L = vec_append(L,v);
9398 868 : for (i = 1; i < nD; i++) gel(v,i) = mfbd_E2(E2, D[i+1], CHI);
9399 : }
9400 1428 : return lg(L) == 1? L: shallowconcat1(L);
9401 : }
9402 :
9403 : static GEN
9404 77 : not_in_space(GEN F, long flag)
9405 : {
9406 77 : if (!flag) err_space(F);
9407 70 : return cgetg(1, t_COL);
9408 : }
9409 : /* when flag set, no error */
9410 : GEN
9411 1029 : mftobasis(GEN mf, GEN F, long flag)
9412 : {
9413 1029 : pari_sp av2, av = avma;
9414 : GEN G, v, y, gk;
9415 1029 : long N, B, ismf = checkmf_i(F);
9416 :
9417 1029 : mf = checkMF(mf);
9418 1029 : if (ismf)
9419 : {
9420 938 : if (mfistrivial(F)) return zerocol(MF_get_dim(mf));
9421 931 : if (!mf_same_k(mf, F) || !mf_same_CHI(mf, F)) return not_in_space(F, flag);
9422 : }
9423 980 : N = MF_get_N(mf);
9424 980 : gk = MF_get_gk(mf);
9425 980 : if (ismf)
9426 : {
9427 889 : long NF = mf_get_N(F);
9428 889 : B = maxuu(mfsturmNgk(NF,gk), mfsturmNgk(N,gk)) + 1;
9429 889 : v = mfcoefs_i(F,B,1);
9430 : }
9431 : else
9432 : {
9433 91 : B = mfsturmNgk(N, gk) + 1;
9434 91 : switch(typ(F))
9435 : { /* F(0),...,F(lg(v)-2) */
9436 63 : case t_SER: v = sertocol(F); settyp(v,t_VEC); break;
9437 14 : case t_VEC: v = F; break;
9438 7 : case t_COL: v = shallowtrans(F); break;
9439 7 : default: pari_err_TYPE("mftobasis",F);
9440 : v = NULL;/*LCOV_EXCL_LINE*/
9441 : }
9442 84 : if (flag) B = minss(B, lg(v)-2);
9443 : }
9444 973 : y = mftobasis_i(mf, v);
9445 973 : if (typ(y) == t_VEC)
9446 : {
9447 21 : if (flag) return gc_GEN(av, y);
9448 0 : pari_err(e_MISC, "not enough coefficients in mftobasis");
9449 : }
9450 952 : av2 = avma;
9451 952 : if (MF_get_space(mf) == mf_FULL || mfsturm(mf)+1 == B) return y;
9452 476 : G = mflinear(mf, y);
9453 476 : if (!gequal(v, mfcoefs_i(G, lg(v)-2,1))) y = NULL;
9454 476 : if (!y) { set_avma(av); return not_in_space(F, flag); }
9455 441 : set_avma(av2); return gc_upto(av, y);
9456 : }
9457 :
9458 : /* assume N > 0; first cusp is always 0 */
9459 : static GEN
9460 49 : mfcusps_i(long N)
9461 : {
9462 : long i, c, l;
9463 : GEN D, v;
9464 :
9465 49 : if (N == 1) return mkvec(gen_0);
9466 49 : D = mydivisorsu(N); l = lg(D); /* left on stack */
9467 49 : c = mfnumcuspsu_fact(myfactoru(N));
9468 49 : v = cgetg(c + 1, t_VEC);
9469 350 : for (i = c = 1; i < l; i++)
9470 : {
9471 301 : long C = D[i], NC = D[l-i], lima = ugcd(C, NC), A0, A;
9472 889 : for (A0 = 0; A0 < lima; A0++)
9473 588 : if (ugcd(A0, lima) == 1)
9474 : {
9475 539 : A = A0; while (ugcd(A,C) > 1) A += lima;
9476 392 : gel(v, c++) = uutoQ(A, C);
9477 : }
9478 : }
9479 49 : return v;
9480 : }
9481 : /* List of cusps of Gamma_0(N) */
9482 : GEN
9483 28 : mfcusps(GEN gN)
9484 : {
9485 : long N;
9486 : GEN mf;
9487 28 : if (typ(gN) == t_INT) N = itos(gN);
9488 14 : else if ((mf = checkMF_i(gN))) N = MF_get_N(mf);
9489 0 : else { pari_err_TYPE("mfcusps", gN); N = 0; }
9490 28 : if (N <= 0) pari_err_DOMAIN("mfcusps", "N", "<=", gen_0, stoi(N));
9491 28 : return mfcusps_i(N);
9492 : }
9493 :
9494 : long
9495 315 : mfcuspisregular(GEN NK, GEN cusp)
9496 : {
9497 : long v, N, dk, nk, t, o;
9498 : GEN mf, CHI, go, A, C, g, c, d;
9499 315 : if ((mf = checkMF_i(NK)))
9500 : {
9501 49 : GEN gk = MF_get_gk(mf);
9502 49 : N = MF_get_N(mf);
9503 49 : CHI = MF_get_CHI(mf);
9504 49 : Qtoss(gk, &nk, &dk);
9505 : }
9506 : else
9507 266 : checkNK2(NK, &N, &nk, &dk, &CHI, 0);
9508 315 : if (typ(cusp) == t_INFINITY) return 1;
9509 315 : if (typ(cusp) == t_FRAC) { A = gel(cusp,1); C = gel(cusp,2); }
9510 28 : else { A = cusp; C = gen_1; }
9511 315 : g = diviuexact(mului(N,C), ugcd(N, Fl_sqr(umodiu(C,N), N)));
9512 315 : c = mulii(negi(C),g);
9513 315 : d = addiu(mulii(A,g), 1);
9514 315 : if (!CHI) return 1;
9515 315 : go = gmfcharorder(CHI);
9516 315 : v = vali(go); if (v < 2) go = shifti(go, 2-v);
9517 315 : t = itou( znchareval(gel(CHI,1), gel(CHI,2), d, go) );
9518 315 : if (dk == 1) return t == 0;
9519 154 : o = itou(go);
9520 154 : if (kronecker(c,d) < 0) t = Fl_add(t, o/2, o);
9521 154 : if (Mod4(d) == 1) return t == 0;
9522 14 : t = Fl_sub(t, Fl_mul(o/4, nk, o), o);
9523 14 : return t == 0;
9524 : }
9525 :
9526 : /* Some useful closures */
9527 :
9528 : /* sum_{d|n} d^k */
9529 : static GEN
9530 48020 : mysumdivku(ulong n, ulong k)
9531 : {
9532 48020 : GEN fa = myfactoru(n);
9533 48020 : return k == 1? usumdiv_fact(fa): usumdivk_fact(fa,k);
9534 : }
9535 : static GEN
9536 882 : c_Ek(long n, long d, GEN F)
9537 : {
9538 882 : GEN E = cgetg(n + 2, t_VEC), C = gel(F,2);
9539 882 : long i, k = mf_get_k(F);
9540 882 : gel (E, 1) = gen_1;
9541 26264 : for (i = 1; i <= n; i++)
9542 : {
9543 25382 : pari_sp av = avma;
9544 25382 : gel(E, i+1) = gc_upto(av, gmul(C, mysumdivku(i*d, k-1)));
9545 : }
9546 882 : return E;
9547 : }
9548 :
9549 : GEN
9550 406 : mfEk(long k)
9551 : {
9552 406 : pari_sp av = avma;
9553 : GEN E0, NK;
9554 406 : if (k < 0 || odd(k)) pari_err_TYPE("mfEk [incorrect k]", stoi(k));
9555 406 : if (!k) return mf1();
9556 399 : E0 = gdivsg(-2*k, bernfrac(k));
9557 399 : NK = mkNK(1,k,mfchartrivial());
9558 399 : return gc_GEN(av, tag(t_MF_Ek, NK, E0));
9559 : }
9560 :
9561 : GEN
9562 56 : mfDelta(void)
9563 : {
9564 56 : pari_sp av = avma;
9565 56 : return gc_GEN(av, tag0(t_MF_DELTA, mkNK(1,12,mfchartrivial())));
9566 : }
9567 :
9568 : GEN
9569 805 : mfTheta(GEN psi)
9570 : {
9571 805 : pari_sp av = avma;
9572 : GEN N, gk, psi2;
9573 : long par;
9574 805 : if (!psi) { psi = mfchartrivial(); N = utoipos(4); par = 1; }
9575 : else
9576 : {
9577 : long FC;
9578 21 : psi = get_mfchar(psi);
9579 21 : FC = mfcharconductor(psi);
9580 21 : if (mfcharmodulus(psi) != FC)
9581 0 : pari_err_TYPE("mfTheta [nonprimitive character]", psi);
9582 21 : par = mfcharparity(psi);
9583 21 : N = shifti(sqru(FC),2);
9584 : }
9585 805 : if (par > 0) { gk = ghalf; psi2 = psi; }
9586 7 : else { gk = gsubsg(2, ghalf); psi2 = mfcharmul(psi, get_mfchar(stoi(-4))); }
9587 805 : return gc_GEN(av, tag(t_MF_THETA, mkgNK(N, gk, psi2, pol_x(1)), psi));
9588 : }
9589 :
9590 : /* Output 0 if not desired eta product: if flag=0 (default) require
9591 : * holomorphic at cusps. If flag set, accept meromorphic, but sill in some
9592 : * modular function space */
9593 : GEN
9594 210 : mffrometaquo(GEN eta, long flag)
9595 : {
9596 210 : pari_sp av = avma;
9597 : GEN NK, N, k, BR, P;
9598 210 : long v, cusp = 0;
9599 210 : if (!etaquotype(&eta, &N,&k,&P, &v, NULL, flag? NULL: &cusp) || cusp < 0)
9600 14 : return gc_const(av, gen_0);
9601 196 : if (lg(gel(eta,1)) == 1) { set_avma(av); return mf1(); }
9602 189 : BR = mkvec2(ZV_to_zv(gel(eta,1)), ZV_to_zv(gel(eta,2)));
9603 189 : if (v < 0) v = 0;
9604 189 : NK = mkgNK(N, k, get_mfchar(P), pol_x(1));
9605 189 : return gc_GEN(av, tag2(t_MF_ETAQUO, NK, BR, utoi(v)));
9606 : }
9607 :
9608 : /* Q^(-r) */
9609 : static GEN
9610 375 : RgXn_negpow(GEN Q, long r, long L)
9611 : {
9612 375 : if (r < 0) r = -r; else Q = RgXn_inv_i(Q, L);
9613 375 : if (r != 1) Q = RgXn_powu_i(Q, r, L);
9614 375 : return Q;
9615 : }
9616 : /* flag same as in mffrometaquo: if set, accept meromorphic. */
9617 : static GEN
9618 49 : mfisetaquo_i(GEN F, long flag)
9619 : {
9620 : GEN gk, P, E, M, S, G, CHI, v, w;
9621 : long b, l, L, N, vS, m, j;
9622 49 : const long bextra = 10;
9623 :
9624 49 : if (!checkmf_i(F)) pari_err_TYPE("mfisetaquo",F);
9625 49 : CHI = mf_get_CHI(F); if (mfcharorder(CHI) > 2) return NULL;
9626 49 : N = mf_get_N(F);
9627 49 : gk = mf_get_gk(F);
9628 49 : b = mfsturmNgk(N, gk);
9629 49 : L = maxss(N, b) + bextra;
9630 49 : S = mfcoefs_i(F, L, 1);
9631 49 : if (!RgV_is_ZV(S)) return NULL;
9632 889 : for (vS = 1; vS <= L+1; vS++)
9633 889 : if (signe(gel(S,vS))) break;
9634 49 : vS--;
9635 49 : if (vS >= bextra - 1) { L += vS; S = mfcoefs_i(F, L, 1); }
9636 49 : if (vS) { S = vecslice(S, vS+1, L+1); L -= vS; }
9637 49 : S = RgV_to_RgX(S, 0); l = lg(S)-2;
9638 49 : P = cgetg(l, t_COL);
9639 49 : E = cgetg(l, t_COL); w = v = gen_0; /* w = weight, v = valuation */
9640 1908 : for (m = j = 1; m+2 < lg(S); m++)
9641 : {
9642 1866 : GEN c = gel(S,m+2);
9643 : long r;
9644 1866 : if (is_bigint(c)) return NULL;
9645 1859 : r = -itos(c);
9646 1859 : if (r)
9647 : {
9648 375 : S = ZXn_mul(S, RgXn_negpow(eta_ZXn(m, L), r, L), L);
9649 375 : gel(P,j) = utoipos(m);
9650 375 : gel(E,j) = stoi(r);
9651 375 : v = addmuliu(v, gel(E,j), m);
9652 375 : w = addis(w, r);
9653 375 : j++;
9654 : }
9655 : }
9656 42 : if (!equalii(w, gmul2n(gk, 1)) || (!flag && !equalii(v, muluu(24,vS))))
9657 7 : return NULL;
9658 35 : setlg(P, j);
9659 35 : setlg(E, j); M = mkmat2(P, E); G = mffrometaquo(M, flag);
9660 35 : return (typ(G) != t_INT
9661 35 : && (mfsturmmf(G) <= b + bextra || mfisequal(F, G, b)))? M: NULL;
9662 : }
9663 : GEN
9664 49 : mfisetaquo(GEN F, long flag)
9665 : {
9666 49 : pari_sp av = avma;
9667 49 : GEN M = mfisetaquo_i(F, flag);
9668 49 : return M? gc_GEN(av, M): gc_const(av, gen_0);
9669 : }
9670 :
9671 : #if 0
9672 : /* number of primitive characters modulo N */
9673 : static ulong
9674 : numprimchars(ulong N)
9675 : {
9676 : GEN fa, P, E;
9677 : long i, l;
9678 : ulong n;
9679 : if ((N & 3) == 2) return 0;
9680 : fa = myfactoru(N);
9681 : P = gel(fa,1); l = lg(P);
9682 : E = gel(fa,2);
9683 : for (i = n = 1; i < l; i++)
9684 : {
9685 : ulong p = P[i], e = E[i];
9686 : if (e == 2) n *= p-2; else n *= (p-1)*(p-1)*upowuu(p,e-2);
9687 : }
9688 : return n;
9689 : }
9690 : #endif
9691 :
9692 : /* Space generated by products of two Eisenstein series */
9693 :
9694 : static int
9695 74431 : cmp_small_priority(void *E, GEN a, GEN b)
9696 : {
9697 74431 : GEN prio = (GEN)E;
9698 74431 : return cmpss(prio[(long)a], prio[(long)b]);
9699 : }
9700 : static long
9701 1302 : znstar_get_expo(GEN G) { return itou(cyc_get_expo(znstar_get_cyc(G))); }
9702 :
9703 : /* Return [vchi, bymod, vG]:
9704 : * vG[f] = znstar(f,1) for f a conductor of (at least) a char mod N; else NULL
9705 : * bymod[f] = vecsmall of conrey indexes of chars modulo f | N; else NULL
9706 : * vchi[n] = a list of CHIvec [G0,chi0,o,ncharvecexpo(G0,nchi0),...]:
9707 : * chi0 = primitive char attached to Conrey Mod(n,N)
9708 : * (resp. NULL if (n,N) > 1) */
9709 : static GEN
9710 651 : charsmodN(long N)
9711 : {
9712 651 : GEN D, G, prio, phio, dummy = cgetg(1,t_VEC);
9713 651 : GEN vP, vG = const_vec(N,NULL), vCHI = const_vec(N,NULL);
9714 651 : GEN bymod = const_vec(N,NULL);
9715 651 : long pn, i, l, vt = fetch_user_var("t");
9716 651 : D = mydivisorsu(N); l = lg(D);
9717 3941 : for (i = 1; i < l; i++)
9718 3290 : gel(bymod, D[i]) = vecsmalltrunc_init(myeulerphiu(D[i])+1);
9719 651 : gel(vG,N) = G = znstar0(utoipos(N),1);
9720 651 : pn = znstar_get_expo(G); /* exponent(Z/NZ)^* */
9721 651 : vP = const_vec(pn,NULL);
9722 27069 : for (i = 1; i <= N; i++)
9723 : {
9724 : GEN P, gF, G0, chi0, nchi0, chi, v, go;
9725 : long j, F, o;
9726 26418 : if (ugcd(i,N) != 1) continue;
9727 14147 : chi = znconreylog(G, utoipos(i));
9728 14147 : gF = znconreyconductor(G, chi, &chi0);
9729 14147 : F = (typ(gF) == t_INT)? itou(gF): itou(gel(gF,1));
9730 14147 : G0 = gel(vG, F); if (!G0) G0 = gel(vG,F) = znstar0(gF, 1);
9731 14147 : nchi0 = znconreylog_normalize(G0,chi0);
9732 14147 : go = gel(nchi0,1); o = itou(go); /* order(chi0) */
9733 14147 : v = ncharvecexpo(G0, nchi0);
9734 14147 : if (!equaliu(go, pn)) v = zv_z_mul(v, pn / o);
9735 14147 : P = gel(vP, o); if (!P) P = gel(vP,o) = polcyclo(o,vt);
9736 : /* mfcharcxinit with dummy complex powers */
9737 14147 : gel(vCHI,i) = mkvecn(6, G0, chi0, go, v, dummy, P);
9738 14147 : D = mydivisorsu(N / F); l = lg(D);
9739 40565 : for (j = 1; j < l; j++) vecsmalltrunc_append(gel(bymod, F*D[j]), i);
9740 : }
9741 651 : phio = zero_zv(pn); l = lg(vCHI); prio = cgetg(l, t_VEC);
9742 27069 : for (i = 1; i < l; i++)
9743 : {
9744 26418 : GEN CHI = gel(vCHI,i);
9745 : long o;
9746 26418 : if (!CHI) continue;
9747 14147 : o = CHIvec_ord(CHI);
9748 14147 : if (!phio[o]) phio[o] = myeulerphiu(o);
9749 14147 : prio[i] = phio[o];
9750 : }
9751 651 : l = lg(bymod);
9752 : /* sort characters by increasing value of phi(order) */
9753 27069 : for (i = 1; i < l; i++)
9754 : {
9755 26418 : GEN z = gel(bymod,i);
9756 26418 : if (z) gen_sort_inplace(z, (void*)prio, &cmp_small_priority, NULL);
9757 : }
9758 651 : return mkvec3(vCHI, bymod, vG);
9759 : }
9760 :
9761 : static GEN
9762 5586 : mfeisenstein2pure(long k, GEN CHI1, GEN CHI2, long ord, GEN P, long lim)
9763 : {
9764 5586 : GEN c, V = cgetg(lim+2, t_COL);
9765 : long n;
9766 5586 : c = mfeisenstein2_0(k, CHI1, CHI2, ord);
9767 5586 : if (P) c = grem(c, P);
9768 5586 : gel(V,1) = c;
9769 113400 : for (n=1; n <= lim; n++)
9770 : {
9771 107814 : c = sigchi2(k, CHI1, CHI2, n, ord);
9772 107814 : if (P) c = grem(c, P);
9773 107814 : gel(V,n+1) = c;
9774 : }
9775 5586 : return V;
9776 : }
9777 : static GEN
9778 5054 : mfeisenstein2pure_Fl(long k, GEN CHI1vec, GEN CHI2vec, GEN vz, ulong p, long lim)
9779 : {
9780 5054 : GEN V = cgetg(lim+2, t_VECSMALL);
9781 : long n;
9782 5054 : V[1] = mfeisenstein2_0_Fl(k, CHI1vec, CHI2vec, vz, p);
9783 82845 : for (n=1; n <= lim; n++) V[n+1] = sigchi2_Fl(k, CHI1vec, CHI2vec, n, vz, p);
9784 5054 : return V;
9785 : }
9786 :
9787 : static GEN
9788 252 : getcolswt2(GEN M, GEN D, ulong p)
9789 : {
9790 252 : GEN R, v = gel(M,1);
9791 252 : long i, l = lg(M) - 1;
9792 252 : R = cgetg(l, t_MAT); /* skip D[1] = 1 */
9793 1008 : for (i = 1; i < l; i++)
9794 : {
9795 756 : GEN w = Flv_Fl_mul(gel(M,i+1), D[i+1], p);
9796 756 : gel(R,i) = Flv_sub(v, w, p);
9797 : }
9798 252 : return R;
9799 : }
9800 : static GEN
9801 5852 : expandbd(GEN V, long d)
9802 : {
9803 : long L, n, nd;
9804 : GEN W;
9805 5852 : if (d == 1) return V;
9806 2121 : L = lg(V)-1; W = zerocol(L); /* nd = n/d */
9807 18263 : for (n = nd = 0; n < L; n += d, nd++) gel(W, n+1) = gel(V, nd+1);
9808 2121 : return W;
9809 : }
9810 : static GEN
9811 7714 : expandbd_Fl(GEN V, long d)
9812 : {
9813 : long L, n, nd;
9814 : GEN W;
9815 7714 : if (d == 1) return V;
9816 2660 : L = lg(V)-1; W = zero_Flv(L); /* nd = n/d */
9817 16429 : for (n = nd = 0; n < L; n += d, nd++) W[n+1] = V[nd+1];
9818 2660 : return W;
9819 : }
9820 : static void
9821 5054 : getcols_i(GEN *pM, GEN *pvj, GEN gk, GEN CHI1vec, GEN CHI2vec, long NN1, GEN vz,
9822 : ulong p, long lim)
9823 : {
9824 5054 : GEN CHI1 = CHIvec_CHI(CHI1vec), CHI2 = CHIvec_CHI(CHI2vec);
9825 5054 : long N2 = CHIvec_N(CHI2vec);
9826 5054 : GEN vj, M, D = mydivisorsu(NN1/N2);
9827 5054 : long i, l = lg(D), k = gk[2];
9828 5054 : GEN V = mfeisenstein2pure_Fl(k, CHI1vec, CHI2vec, vz, p, lim);
9829 5054 : M = cgetg(l, t_MAT);
9830 12768 : for (i = 1; i < l; i++) gel(M,i) = expandbd_Fl(V, D[i]);
9831 5054 : if (k == 2 && N2 == 1 && CHIvec_N(CHI1vec) == 1)
9832 : {
9833 252 : M = getcolswt2(M, D, p); l--;
9834 252 : D = vecslice(D, 2, l);
9835 : }
9836 5054 : *pM = M;
9837 5054 : *pvj = vj = cgetg(l, t_VEC);
9838 12516 : for (i = 1; i < l; i++) gel(vj,i) = mkvec4(gk, CHI1, CHI2, utoipos(D[i]));
9839 5054 : }
9840 :
9841 : /* find all CHI1, CHI2 mod N such that CHI1*CHI2 = CHI, f(CHI1)*f(CHI2) | N.
9842 : * set M = mfcoefs(B_e E(CHI1,CHI2), lim), vj = [e,i1,i2] */
9843 : static void
9844 2037 : getcols(GEN *pM, GEN *pv, long k, long nCHI, GEN allN, GEN vz, ulong p,
9845 : long lim)
9846 : {
9847 2037 : GEN vCHI = gel(allN,1), gk = utoi(k);
9848 2037 : GEN M = cgetg(1,t_MAT), v = cgetg(1,t_VEC);
9849 2037 : long i1, N = lg(vCHI)-1;
9850 93527 : for (i1 = 1; i1 <= N; i1++)
9851 : {
9852 91490 : GEN CHI1vec = gel(vCHI, i1), CHI2vec, M1, v1;
9853 : long NN1, i2;
9854 160972 : if (!CHI1vec) continue;
9855 73150 : if (k == 1 && CHIvec_parity(CHI1vec) == -1) continue;
9856 48391 : NN1 = N/CHIvec_N(CHI1vec); /* N/f(chi1) */;
9857 48391 : i2 = Fl_div(nCHI,i1, N);
9858 48391 : if (!i2) i2 = 1;
9859 48391 : CHI2vec = gel(vCHI,i2);
9860 48391 : if (NN1 % CHIvec_N(CHI2vec)) continue; /* f(chi1)f(chi2) | N ? */
9861 3668 : getcols_i(&M1, &v1, gk, CHI1vec, CHI2vec, NN1, vz, p, lim);
9862 3668 : M = shallowconcat(M, M1);
9863 3668 : v = shallowconcat(v, v1);
9864 : }
9865 2037 : *pM = M;
9866 2037 : *pv = v;
9867 2037 : }
9868 :
9869 : static void
9870 1239 : update_Mj(GEN *M, GEN *vecj, GEN *pz, ulong p)
9871 : {
9872 : GEN perm;
9873 1239 : *pz = Flm_indexrank(*M, p); perm = gel(*pz,2);
9874 1239 : *M = vecpermute(*M, perm);
9875 1239 : *vecj = vecpermute(*vecj, perm);
9876 1239 : }
9877 : static int
9878 441 : getcolsgen(long dim, GEN *pM, GEN *pvj, GEN *pz, long k, long ell, long nCHI,
9879 : GEN allN, GEN vz, ulong p, long lim)
9880 : {
9881 441 : GEN vCHI = gel(allN,1), bymod = gel(allN,2), gell = utoi(ell);
9882 441 : long i1, N = lg(vCHI)-1;
9883 441 : long L = lim+1;
9884 441 : if (lg(*pvj)-1 >= dim) update_Mj(pM, pvj, pz, p);
9885 441 : if (lg(*pvj)-1 == dim) return 1;
9886 1806 : for (i1 = 1; i1 <= N; i1++)
9887 : {
9888 1778 : GEN CHI1vec = gel(vCHI, i1), T;
9889 : long par1, j, l, N1, NN1;
9890 :
9891 1778 : if (!CHI1vec) continue;
9892 1750 : par1 = CHIvec_parity(CHI1vec);
9893 1750 : if (ell == 1 && par1 == -1) continue;
9894 1169 : if (odd(ell)) par1 = -par1;
9895 1169 : N1 = CHIvec_N(CHI1vec);
9896 1169 : NN1 = N/N1;
9897 1169 : T = gel(bymod, NN1); l = lg(T);
9898 4277 : for (j = 1; j < l; j++)
9899 : {
9900 3486 : long i2 = T[j], l1, l2, j1, s, nC;
9901 3486 : GEN M, M1, M2, vj, vj1, vj2, CHI2vec = gel(vCHI, i2);
9902 3486 : if (CHIvec_parity(CHI2vec) != par1) continue;
9903 1386 : nC = Fl_div(nCHI, Fl_mul(i1,i2,N), N);
9904 1386 : getcols(&M2, &vj2, k-ell, nC, allN, vz, p, lim);
9905 1386 : l2 = lg(M2); if (l2 == 1) continue;
9906 1386 : getcols_i(&M1, &vj1, gell, CHI1vec, CHI2vec, NN1, vz, p, lim);
9907 1386 : l1 = lg(M1);
9908 1386 : M1 = Flm_to_FlxV(M1, 0);
9909 1386 : M2 = Flm_to_FlxV(M2, 0);
9910 1386 : M = cgetg((l1-1)*(l2-1) + 1, t_MAT);
9911 1386 : vj = cgetg((l1-1)*(l2-1) + 1, t_VEC);
9912 3318 : for (j1 = s = 1; j1 < l1; j1++)
9913 : {
9914 1932 : GEN E = gel(M1,j1), v = gel(vj1,j1);
9915 : long j2;
9916 7805 : for (j2 = 1; j2 < l2; j2++, s++)
9917 : {
9918 5873 : GEN c = Flx_to_Flv(Flxn_mul(E, gel(M2,j2), L, p), L);
9919 5873 : gel(M,s) = c;
9920 5873 : gel(vj,s) = mkvec2(v, gel(vj2,j2));
9921 : }
9922 : }
9923 1386 : *pM = shallowconcat(*pM, M);
9924 1386 : *pvj = shallowconcat(*pvj, vj);
9925 1386 : if (lg(*pvj)-1 >= dim) update_Mj(pM, pvj, pz, p);
9926 1386 : if (lg(*pvj)-1 == dim) return 1;
9927 : }
9928 : }
9929 28 : if (ell == 1)
9930 : {
9931 21 : update_Mj(pM, pvj, pz, p);
9932 21 : return (lg(*pvj)-1 == dim);
9933 : }
9934 7 : return 0;
9935 : }
9936 :
9937 : static GEN
9938 1645 : mkF2bd(long d, long lim)
9939 : {
9940 1645 : GEN V = zerovec(lim + 1);
9941 : long n;
9942 1645 : gel(V, 1) = sstoQ(-1, 24);
9943 24248 : for (n = 1; n <= lim/d; n++) gel(V, n*d + 1) = mysumdivku(n, 1);
9944 1645 : return V;
9945 : }
9946 :
9947 : static GEN
9948 6202 : mkeisen(GEN E, long ord, GEN P, long lim)
9949 : {
9950 6202 : long k = itou(gel(E,1)), e = itou(gel(E,4));
9951 6202 : GEN CHI1 = gel(E,2), CHI2 = gel(E,3);
9952 6202 : if (k == 2 && mfcharistrivial(CHI1) && mfcharistrivial(CHI2))
9953 616 : return gsub(mkF2bd(1,lim), gmulgu(mkF2bd(e,lim), e));
9954 : else
9955 : {
9956 5586 : GEN V = mfeisenstein2pure(k, CHI1, CHI2, ord, P, lim);
9957 5586 : return expandbd(V, e);
9958 : }
9959 : }
9960 : static GEN
9961 609 : mkM(GEN vj, long pn, GEN P, long lim)
9962 : {
9963 609 : long j, l = lg(vj), L = lim+1;
9964 609 : GEN M = cgetg(l, t_MAT);
9965 5061 : for (j = 1; j < l; j++)
9966 : {
9967 : GEN E1, E2;
9968 4452 : parse_vecj(gel(vj,j), &E1,&E2);
9969 4452 : E1 = RgV_to_RgX(mkeisen(E1, pn, P, lim), 0);
9970 4452 : if (E2)
9971 : {
9972 1750 : E2 = RgV_to_RgX(mkeisen(E2, pn, P, lim), 0);
9973 1750 : E1 = RgXn_mul(E1, E2, L);
9974 : }
9975 4452 : E1 = RgX_to_RgC(E1, L);
9976 4452 : if (P && E2) E1 = RgXQV_red(E1, P);
9977 4452 : gel(M,j) = E1;
9978 : }
9979 609 : return M;
9980 : }
9981 :
9982 : /* assume N > 2 */
9983 : static GEN
9984 35 : mffindeisen1(long N)
9985 : {
9986 35 : GEN G = znstar0(utoipos(N), 1), L = chargalois(G, NULL), chi0 = NULL;
9987 35 : long j, m = N, l = lg(L);
9988 259 : for (j = 1; j < l; j++)
9989 : {
9990 245 : GEN chi = gel(L,j);
9991 245 : long r = myeulerphiu(itou(zncharorder(G,chi)));
9992 245 : if (r >= m) continue;
9993 182 : chi = znconreyfromchar(G, chi);
9994 182 : if (zncharisodd(G,chi)) { m = r; chi0 = chi; if (r == 1) break; }
9995 : }
9996 35 : if (!chi0) pari_err_BUG("mffindeisen1 [no Eisenstein series found]");
9997 35 : chi0 = znchartoprimitive(G,chi0);
9998 35 : return mfcharGL(gel(chi0,1), gel(chi0,2));
9999 : }
10000 :
10001 : static GEN
10002 651 : mfeisensteinspaceinit_i(long N, long k, GEN CHI)
10003 : {
10004 651 : GEN M, Minv, vj, vG, GN, allN, P, vz, z = NULL;
10005 651 : long nCHI, lim, ell, ord, dim = mffulldim(N, k, CHI);
10006 : ulong r, p;
10007 :
10008 651 : if (!dim) retmkvec3(cgetg(1,t_VECSMALL),
10009 : mkvec2(cgetg(1,t_MAT),gen_1),cgetg(1,t_VEC));
10010 651 : lim = mfsturmNk(N, k) + 1;
10011 651 : allN = charsmodN(N);
10012 651 : vG = gel(allN,3);
10013 651 : GN = gel(vG,N);
10014 651 : ord = znstar_get_expo(GN);
10015 651 : P = ord <= 2? NULL: polcyclo(ord, varn(mfcharpol(CHI)));
10016 651 : CHI = induce(GN, CHI); /* lift CHI mod N before mfcharno*/
10017 651 : nCHI = mfcharno(CHI);
10018 651 : r = QabM_init(ord, &p);
10019 651 : vz = Fl_powers(r, ord, p);
10020 651 : getcols(&M, &vj, k, nCHI, allN, vz, p, lim);
10021 679 : for (ell = k>>1; ell >= 1; ell--)
10022 441 : if (getcolsgen(dim, &M, &vj, &z, k, ell, nCHI, allN, vz, p, lim)) break;
10023 651 : if (!z) update_Mj(&M, &vj, &z, p);
10024 651 : if (lg(vj) - 1 < dim) return NULL;
10025 609 : M = mkM(vj, ord, P, lim);
10026 609 : Minv = QabM_Minv(rowpermute(M, gel(z,1)), P, ord);
10027 609 : return mkvec4(gel(z,1), Minv, vj, utoi(ord));
10028 : }
10029 : /* true mf */
10030 : static GEN
10031 609 : mfeisensteinspaceinit(GEN mf)
10032 : {
10033 609 : pari_sp av = avma;
10034 609 : GEN z, CHI = MF_get_CHI(mf);
10035 609 : long N = MF_get_N(mf), k = MF_get_k(mf);
10036 609 : if (!CHI) CHI = mfchartrivial();
10037 609 : z = mfeisensteinspaceinit_i(N, k, CHI);
10038 609 : if (!z)
10039 : {
10040 35 : GEN E, CHIN = mffindeisen1(N), CHI0 = mfchartrivial();
10041 35 : z = mfeisensteinspaceinit_i(N, k+1, mfcharmul(CHI, CHIN));
10042 35 : if (z) E = mkvec4(gen_1, CHI0, CHIN, gen_1);
10043 : else
10044 : {
10045 7 : z = mfeisensteinspaceinit_i(N, k+2, CHI);
10046 7 : E = mkvec4(gen_2, CHI0, CHI0, utoipos(N));
10047 : }
10048 35 : z = mkvec2(z, E);
10049 : }
10050 609 : return gc_GEN(av, z);
10051 : }
10052 :
10053 : /* decomposition of modular form on eisenspace */
10054 : static GEN
10055 1218 : mfeisensteindec(GEN mf, GEN F)
10056 : {
10057 1218 : pari_sp av = avma;
10058 : GEN M, Mindex, Mvecj, V, B, CHI;
10059 : long o, ord;
10060 :
10061 1218 : Mvecj = obj_checkbuild(mf, MF_EISENSPACE, &mfeisensteinspaceinit);
10062 1218 : if (lg(Mvecj) < 5)
10063 : {
10064 56 : GEN E, e = gel(Mvecj,2), gkE = gel(e,1);
10065 56 : long dE = itou(gel(e,4));
10066 56 : Mvecj = gel(Mvecj,1);
10067 56 : E = mfeisenstein(itou(gkE), NULL, gel(e,3));
10068 56 : if (dE != 1) E = mfbd_E2(E, dE, gel(e,2)); /* here k = 2 */
10069 56 : F = mfmul(F, E);
10070 : }
10071 1218 : M = gel(Mvecj, 2);
10072 1218 : if (lg(M) == 1) return cgetg(1, t_VEC);
10073 1218 : Mindex = gel(Mvecj, 1);
10074 1218 : ord = itou(gel(Mvecj,4));
10075 1218 : V = mfcoefs(F, Mindex[lg(Mindex)-1]-1, 1); settyp(V, t_COL);
10076 1218 : CHI = mf_get_CHI(F);
10077 1218 : o = mfcharorder(CHI);
10078 1218 : if (o > 2 && o != ord)
10079 : { /* convert Mod(.,polcyclo(o)) to Mod(., polcyclo(N)) for o | N,
10080 : * o and N both != 2 (mod 4) */
10081 84 : GEN z, P = gel(M,4); /* polcyclo(ord) */
10082 84 : long vt = varn(P);
10083 84 : z = gmodulo(pol_xn(ord/o, vt), P);
10084 84 : if (ord % o) pari_err_TYPE("mfeisensteindec", V);
10085 84 : V = gsubst(liftpol_shallow(V), vt, z);
10086 : }
10087 1218 : B = Minv_RgC_mul(M, vecpermute(V, Mindex));
10088 1218 : return gc_upto(av, B);
10089 : }
10090 :
10091 : /*********************************************************************/
10092 : /* END EISENSPACE */
10093 : /*********************************************************************/
10094 :
10095 : static GEN
10096 70 : sertocol2(GEN S, long l)
10097 : {
10098 70 : GEN C = cgetg(l + 2, t_COL);
10099 : long i;
10100 420 : for (i = 0; i <= l; i++) gel(C, i+1) = polcoef_i(S, i, -1);
10101 70 : return C;
10102 : }
10103 :
10104 : /* Compute polynomial P0 such that F=E4^(k/4)P0(E6/E4^(3/2)). */
10105 : static GEN
10106 14 : mfcanfindp0(GEN F, long k)
10107 : {
10108 14 : pari_sp ltop = avma;
10109 : GEN E4, E6, V, V1, Q, W, res, M, B;
10110 : long l, j;
10111 14 : l = k/6 + 2;
10112 14 : V = mfcoefsser(F,l);
10113 14 : E4 = mfcoefsser(mfEk(4),l);
10114 14 : E6 = mfcoefsser(mfEk(6),l);
10115 14 : V1 = gdiv(V, gpow(E4, uutoQ(k,4), 0));
10116 14 : Q = gdiv(E6, gpow(E4, uutoQ(3,2), 0));
10117 14 : W = gpowers(Q, l - 1);
10118 14 : M = cgetg(l + 1, t_MAT);
10119 70 : for (j = 1; j <= l; j++) gel(M,j) = sertocol2(gel(W,j), l);
10120 14 : B = sertocol2(V1, l);
10121 14 : res = inverseimage(M, B);
10122 14 : if (lg(res) == 1) err_space(F);
10123 14 : return gc_GEN(ltop, gtopolyrev(res, 0));
10124 : }
10125 :
10126 : /* Compute the first n+1 Taylor coeffs at tau=I of a modular form
10127 : * on SL_2(Z). */
10128 : GEN
10129 14 : mftaylor(GEN F, long n, long flreal, long prec)
10130 : {
10131 14 : pari_sp ltop = avma;
10132 14 : GEN P0, Pm1 = gen_0, v;
10133 14 : GEN X2 = mkpoln(3, ghalf,gen_0,gneg(ghalf)); /* (x^2-1) / 2 */
10134 : long k, m;
10135 14 : if (!checkmf_i(F)) pari_err_TYPE("mftaylor",F);
10136 14 : k = mf_get_k(F);
10137 14 : if (mf_get_N(F) != 1 || k < 0) pari_err_IMPL("mftaylor for this form");
10138 14 : P0 = mfcanfindp0(F, k);
10139 14 : v = cgetg(n+2, t_VEC); gel(v, 1) = RgX_coeff(P0,0);
10140 154 : for (m = 0; m < n; m++)
10141 : {
10142 140 : GEN P1 = gdivgu(gmulsg(-(k + 2*m), RgX_shift(P0,1)), 12);
10143 140 : P1 = gadd(P1, gmul(X2, RgX_deriv(P0)));
10144 140 : if (m) P1 = gsub(P1, gdivgu(gmulsg(m*(m+k-1), Pm1), 144));
10145 140 : Pm1 = P0; P0 = P1;
10146 140 : gel(v, m+2) = RgX_coeff(P0, 0);
10147 : }
10148 14 : if (flreal)
10149 : {
10150 7 : GEN pi2 = Pi2n(1, prec), pim4 = gmulsg(-2, pi2), VPC;
10151 7 : GEN C = gmulsg(3, gdiv(gpowgs(ggamma(uutoQ(1,4), prec), 8), gpowgs(pi2, 6)));
10152 : /* E_4(i): */
10153 7 : GEN facn = gen_1;
10154 7 : VPC = gpowers(gmul(pim4, gsqrt(C, prec)), n);
10155 7 : C = gpow(C, uutoQ(k,4), prec);
10156 84 : for (m = 0; m <= n; m++)
10157 : {
10158 77 : gel(v, m+1) = gdiv(gmul(C, gmul(gel(v, m+1), gel(VPC, m+1))), facn);
10159 77 : facn = gmulgu(facn, m+1);
10160 : }
10161 : }
10162 14 : return gc_GEN(ltop, v);
10163 : }
10164 :
10165 : #if 0
10166 : /* To be used in mfeigensearch() */
10167 : GEN
10168 : mfreadratfile()
10169 : {
10170 : GEN eqn;
10171 : pariFILE *F = pari_fopengz("rateigen300.gp");
10172 : eqn = gp_readvec_stream(F->file);
10173 : pari_fclose(F);
10174 : return eqn;
10175 : }
10176 : #endif
10177 : /*****************************************************************/
10178 : /* EISENSTEIN CUSPS: COMPLEX DIRECTLY: one F_k */
10179 : /*****************************************************************/
10180 :
10181 : /* CHIvec = charinit(CHI); data = [N1g/g1,N2g/g2,g1/g,g2/g,C/g1,C/g2,
10182 : * (N1g/g1)^{-1},(N2g/g2)^{-1}] */
10183 :
10184 : /* nm = n/m;
10185 : * z1 = powers of \z_{C/g}^{(Ae/g)^{-1}},
10186 : * z2 = powers of \z_N^{A^{-1}(g1g2/C)}]
10187 : * N.B. : we compute value and conjugate at the end, so it is (Ae/g)^{-1}
10188 : * and not -(Ae/g)^{-1} */
10189 : static GEN
10190 9635178 : eiscnm(long nm, long m, GEN CHI1vec, GEN CHI2vec, GEN data, GEN z1)
10191 : {
10192 9635178 : long Cg1 = data[5], s10 = (nm*data[7]) % Cg1, r10 = (nm - data[1]*s10) / Cg1;
10193 9635178 : long Cg2 = data[6], s20 = (m *data[8]) % Cg2, r20 = (m - data[2]*s20) / Cg2;
10194 : long j1, r1, s1;
10195 9635178 : GEN T = gen_0;
10196 22465660 : for (j1 = 0, r1 = r10, s1 = s10; j1 < data[3]; j1++, r1 -= data[1], s1 += Cg1)
10197 : {
10198 12830482 : GEN c1 = mychareval(CHI1vec, r1);
10199 12830482 : if (!gequal0(c1))
10200 : {
10201 : long j2, r2, s2;
10202 9925790 : GEN S = gen_0;
10203 24733030 : for (j2 = 0, r2 = r20, s2 = s20; j2 < data[4]; j2++, r2 -= data[2], s2 += Cg2)
10204 : {
10205 14807240 : GEN c2 = mychareval(CHI2vec, r2);
10206 14807240 : if (!gequal0(c2)) S = gadd(S, gmul(c2, rootsof1pow(z1, s1*s2)));
10207 : }
10208 9925790 : T = gadd(T, gmul(c1, S));
10209 : }
10210 : }
10211 9635178 : return conj_i(T);
10212 : }
10213 :
10214 : static GEN
10215 855267 : fg1g2n(long n, long k, GEN CHI1vec, GEN CHI2vec, GEN data, GEN z1, GEN z2)
10216 : {
10217 855267 : pari_sp av = avma;
10218 855267 : GEN S = gen_0, D = mydivisorsu(n);
10219 855267 : long i, l = lg(D);
10220 5672856 : for (i = 1; i < l; i++)
10221 : {
10222 4817589 : long m = D[i], nm = D[l-i]; /* n/m */
10223 4817589 : GEN u = eiscnm( nm, m, CHI1vec, CHI2vec, data, z1);
10224 4817589 : GEN v = eiscnm(-nm, -m, CHI1vec, CHI2vec, data, z1);
10225 4817589 : GEN w = odd(k) ? gsub(u, v) : gadd(u, v);
10226 4817589 : S = gadd(S, gmul(powuu(m, k-1), w));
10227 : }
10228 855267 : return gc_upto(av, gmul(S, rootsof1pow(z2, n)));
10229 : }
10230 :
10231 : static GEN
10232 33985 : gausssumcx(GEN CHIvec, long prec)
10233 : {
10234 : GEN z, S, V;
10235 33985 : long m, N = CHIvec_N(CHIvec);
10236 33985 : if (N == 1) return gen_1;
10237 18277 : V = CHIvec_val(CHIvec);
10238 18277 : z = rootsof1u_cx(N, prec);
10239 18277 : S = gmul(z, gel(V, N));
10240 431158 : for (m = N-1; m >= 1; m--) S = gmul(z, gadd(gel(V, m), S));
10241 18277 : return S;
10242 : }
10243 :
10244 : /* Computation of Q_k(\z_N^s) as a polynomial in \z_N^s. FIXME: explicit
10245 : * formula ? */
10246 : static GEN
10247 6118 : mfqk(long k, long N)
10248 : {
10249 : GEN X, P, ZI, Q, Xm1, invden;
10250 : long i;
10251 6118 : ZI = gdivgu(RgX_shift_shallow(RgV_to_RgX(identity_ZV(N-1), 0), 1), N);
10252 6118 : if (k == 1) return ZI;
10253 4956 : P = gsubgs(pol_xn(N,0), 1);
10254 4956 : invden = RgXQ_powu(ZI, k, P);
10255 4956 : X = pol_x(0); Q = gneg(X); Xm1 = gsubgs(X, 1);
10256 21784 : for (i = 2; i < k; i++)
10257 16828 : Q = RgX_shift_shallow(ZX_add(gmul(Xm1, ZX_deriv(Q)), gmulsg(-i, Q)), 1);
10258 4956 : return RgXQ_mul(Q, invden, P);
10259 : }
10260 :
10261 : /* CHI mfchar; M is a multiple of the conductor of CHI, but is NOT
10262 : * necessarily its modulus */
10263 : static GEN
10264 7903 : mfskcx(long k, GEN CHI, long M, long prec)
10265 : {
10266 : GEN S, CHIvec, P;
10267 : long F, m, i, l;
10268 7903 : CHI = mfchartoprimitive(CHI, &F);
10269 7903 : CHIvec = mfcharcxinit(CHI, prec);
10270 7903 : if (F == 1) S = gdivgu(bernfrac(k), k);
10271 : else
10272 : {
10273 6118 : GEN Q = mfqk(k, F), V = CHIvec_val(CHIvec);
10274 6118 : S = gmul(gel(V, F), RgX_coeff(Q, 0));
10275 156611 : for (m = 1; m < F; m++) S = gadd(S, gmul(gel(V, m), RgX_coeff(Q, m)));
10276 6118 : S = conj_i(S);
10277 : }
10278 : /* prime divisors of M not dividing f(chi) */
10279 7903 : P = gel(myfactoru(u_ppo(M/F,F)), 1); l = lg(P);
10280 8057 : for (i = 1; i < l; i++)
10281 : {
10282 154 : long p = P[i];
10283 154 : S = gmul(S, gsubsg(1, gdiv(mychareval(CHIvec, p), powuu(p, k))));
10284 : }
10285 7903 : return gmul(gmul(gausssumcx(CHIvec, prec), S), powuu(M/F, k));
10286 : }
10287 :
10288 : static GEN
10289 13727 : f00_i(long k, GEN CHI1vec, GEN CHI2vec, GEN G2, GEN S, long prec)
10290 : {
10291 : GEN c, a;
10292 13727 : long N1 = CHIvec_N(CHI1vec), N2 = CHIvec_N(CHI2vec);
10293 13727 : if (S[2] != N1) return gen_0;
10294 7903 : c = mychareval(CHI1vec, S[3]);
10295 7903 : if (isintzero(c)) return gen_0;
10296 7903 : a = mfskcx(k, mfchardiv(CHIvec_CHI(CHI2vec), CHIvec_CHI(CHI1vec)), N1*N2, prec);
10297 7903 : a = gmul(a, conj_i(gmul(c,G2)));
10298 7903 : return gdiv(a, mulsi(-N2, powuu(S[1], k-1)));
10299 : }
10300 :
10301 : static GEN
10302 12446 : f00(long k, GEN CHI1vec,GEN CHI2vec, GEN G1,GEN G2, GEN data, long prec)
10303 : {
10304 : GEN T1, T2;
10305 12446 : T2 = f00_i(k, CHI1vec, CHI2vec, G2, data, prec);
10306 12446 : if (k > 1) return T2;
10307 1281 : T1 = f00_i(k, CHI2vec, CHI1vec, G1, data, prec);
10308 1281 : return gadd(T1, T2);
10309 : }
10310 :
10311 : /* ga in SL_2(Z), find beta [a,b;c,d] in Gamma_0(N) and mu in Z such that
10312 : * beta * ga * T^u = [A',B';C',D'] with C' | N and N | B', C' > 0 */
10313 : static void
10314 13041 : mfgatogap(GEN ga, long N, long *pA, long *pC, long *pD, long *pd, long *pmu)
10315 : {
10316 13041 : GEN A = gcoeff(ga,1,1), B = gcoeff(ga,1,2);
10317 13041 : GEN C = gcoeff(ga,2,1), D = gcoeff(ga,2,2), a, b, c, d;
10318 : long t, Ap, Cp, B1, D1, mu;
10319 13041 : Cp = itou(bezout(muliu(A,N), C, &c, &d)); /* divides N */
10320 13041 : t = 0;
10321 13041 : if (Cp > 1)
10322 : { /* (d, N/Cp) = 1, find t such that (d - t*(A*N/Cp), N) = 1 */
10323 2604 : long dN = umodiu(d,Cp), Q = (N/Cp * umodiu(A,Cp)) % Cp;
10324 2989 : while (ugcd(dN, Cp) > 1) { t++; dN = Fl_sub(dN, Q, Cp); }
10325 : }
10326 13041 : if (t)
10327 : {
10328 385 : c = addii(c, mului(t, diviuexact(C,Cp)));
10329 385 : d = subii(d, mului(t, muliu(A, N/Cp))); /* (d,N) = 1 */
10330 : }
10331 13041 : D1 = umodiu(mulii(d,D), N);
10332 13041 : (void)bezout(d, mulis(c,-N), &a, &b); /* = 1 */
10333 13041 : t = 0; Ap = umodiu(addii(mulii(a,A), mulii(b,C)), N); /* (Ap,Cp) = 1 */
10334 22267 : while (ugcd(Ap, N) > 1) { t++; Ap = Fl_add(Ap, Cp, N); }
10335 13041 : B1 = umodiu(a,N)*umodiu(B,N) + umodiu(b,N)*umodiu(D,N) + t*D1;
10336 13041 : B1 %= N;
10337 13041 : *pmu = mu = Fl_neg(Fl_div(B1, Ap, N), N);
10338 : /* A', D' and d only needed modulo N */
10339 13041 : *pd = umodiu(d, N);
10340 13041 : *pA = Ap;
10341 13041 : *pC = Cp; *pD = (D1 + Cp*mu) % N;
10342 13041 : }
10343 :
10344 : #if 0
10345 : /* CHI is a mfchar, return alpha(CHI) */
10346 : static long
10347 : mfalchi(GEN CHI, long AN, long cg)
10348 : {
10349 : GEN G = gel(CHI,1), chi = gel(CHI,2), go = gmfcharorder(CHI);
10350 : long o = itou(go), a = itos( znchareval(G, chi, stoi(1 + AN/cg), go) );
10351 : if (a < 0 || (cg * a) % o) pari_err_BUG("mfalchi");
10352 : return (cg * a) / o;
10353 : }
10354 : #endif
10355 : /* return A such that CHI1(t) * CHI2(t) = e(A) or NULL if (t,N1*N2) > 1 */
10356 : static GEN
10357 26082 : mfcharmuleval(GEN CHI1vec, GEN CHI2vec, long t)
10358 : {
10359 26082 : long a1 = mycharexpo(CHI1vec, t), o1 = CHIvec_ord(CHI1vec);
10360 26082 : long a2 = mycharexpo(CHI2vec, t), o2 = CHIvec_ord(CHI2vec);;
10361 26082 : if (a1 < 0 || a2 < 0) return NULL;
10362 26082 : return sstoQ(a1*o2 + a2*o1, o1*o2);
10363 : }
10364 : static GEN
10365 13041 : mfcharmulcxeval(GEN CHI1vec, GEN CHI2vec, long t, long prec)
10366 : {
10367 13041 : GEN A = mfcharmuleval(CHI1vec, CHI2vec, t);
10368 : long n, d;
10369 13041 : if (!A) return gen_0;
10370 13041 : Qtoss(A, &n,&d); return rootsof1q_cx(n, d, prec);
10371 : }
10372 : /* alpha(CHI1 * CHI2) */
10373 : static long
10374 13041 : mfalchi2(GEN CHI1vec, GEN CHI2vec, long AN, long cg)
10375 : {
10376 13041 : GEN A = mfcharmuleval(CHI1vec, CHI2vec, 1 + AN/cg);
10377 : long a;
10378 13041 : if (!A) pari_err_BUG("mfalchi2");
10379 13041 : A = gmulsg(cg, A);
10380 13041 : if (typ(A) != t_INT) pari_err_BUG("mfalchi2");
10381 13041 : a = itos(A) % cg; if (a < 0) a += cg;
10382 13041 : return a;
10383 : }
10384 :
10385 : /* return g = (a,b), set u >= 0 s.t. g = a * u (mod b) */
10386 : static long
10387 52164 : mybezout(long a, long b, long *pu)
10388 : {
10389 52164 : long junk, g = cbezout(a, b, pu, &junk);
10390 52164 : if (*pu < 0) *pu += b/g;
10391 52164 : return g;
10392 : }
10393 :
10394 : /* E = [k, CHI1,CHI2, e], CHI1 and CHI2 primitive mfchars such that,
10395 : * CHI1(-1)*CHI2(-1) = (-1)^k; expansion of (B_e (E_k(CHI1,CHI2))) | ga.
10396 : * w is the width for the space of the calling function. */
10397 : static GEN
10398 13041 : mfeisensteingacx(GEN E, long w, GEN ga, long lim, long prec)
10399 : {
10400 13041 : GEN CHI1vec, CHI2vec, CHI1 = gel(E,2), CHI2 = gel(E,3), v, S, ALPHA;
10401 : GEN G1, G2, z1, z2, data;
10402 13041 : long k = itou(gel(E,1)), e = itou(gel(E,4));
10403 13041 : long N1 = mfcharmodulus(CHI1);
10404 13041 : long N2 = mfcharmodulus(CHI2), N = e * N1 * N2;
10405 : long NsurC, cg, wN, A, C, Ai, d, mu, alchi, na, da;
10406 : long eg, g, gH, U, u0, u1, u2, Aig, H, m, n, t, Cg, NC1, NC2;
10407 :
10408 13041 : mfgatogap(ga, N, &A, &C, &Ai, &d, &mu);
10409 13041 : CHI1vec = mfcharcxinit(CHI1, prec);
10410 13041 : CHI2vec = mfcharcxinit(CHI2, prec);
10411 13041 : NsurC = N/C; cg = ugcd(C, NsurC); wN = NsurC / cg;
10412 13041 : if (w%wN) pari_err_BUG("mfeisensteingacx [wN does not divide w]");
10413 13041 : alchi = mfalchi2(CHI1vec, CHI2vec, A*N, cg);
10414 13041 : ALPHA = sstoQ(alchi, NsurC);
10415 :
10416 13041 : g = mybezout(A*e, C, &u0); Cg = C/g; eg = e/g;
10417 13041 : NC1 = mybezout(N1, Cg, &u1);
10418 13041 : NC2 = mybezout(N2, Cg, &u2);
10419 13041 : H = (NC1*NC2*g)/Cg;
10420 13041 : Aig = (Ai*H)%N; if (Aig < 0) Aig += N;
10421 13041 : z1 = rootsof1powinit(u0, Cg, prec);
10422 13041 : z2 = rootsof1powinit(Aig, N, prec);
10423 13041 : data = mkvecsmalln(8, N1/NC1, N2/NC2, NC1, NC2, Cg/NC1, Cg/NC2, u1, u2);
10424 13041 : v = zerovec(lim + 1);
10425 : /* need n*H = alchi (mod cg) */
10426 13041 : gH = mybezout(H, cg, &U);
10427 13041 : if (gH > 1)
10428 : {
10429 511 : if (alchi % gH) return mkvec2(gen_0, v);
10430 511 : alchi /= gH; cg /= gH; H /= gH;
10431 : }
10432 13041 : G1 = gausssumcx(CHI1vec, prec);
10433 13041 : G2 = gausssumcx(CHI2vec, prec);
10434 13041 : if (!alchi)
10435 12446 : gel(v,1) = f00(k, CHI1vec,CHI2vec,G1,G2, mkvecsmall3(NC2,Cg,A*eg), prec);
10436 13041 : n = Fl_mul(alchi,U,cg); if (!n) n = cg;
10437 13041 : m = (n*H - alchi) / cg; /* positive, exact division */
10438 868308 : for (; m <= lim; n+=cg, m+=H)
10439 855267 : gel(v, m+1) = fg1g2n(n, k, CHI1vec, CHI2vec, data, z1,z2);
10440 13041 : t = (2*e)/g; if (odd(k)) t = -t;
10441 13041 : v = gdiv(v, gmul(conj_i(gmul(G1,G2)), mulsi(t, powuu(eg*N2/NC2, k-1))));
10442 13041 : if (k == 2 && N1 == 1 && N2 == 1) v = gsub(mkF2bd(wN,lim), gmulsg(e,v));
10443 :
10444 13041 : Qtoss(ALPHA, &na,&da);
10445 13041 : S = conj_i( mfcharmulcxeval(CHI1vec,CHI2vec,d,prec) ); /* CHI(1/d) */
10446 13041 : if (wN > 1)
10447 : {
10448 11354 : GEN z = rootsof1powinit(-mu, wN, prec);
10449 11354 : long i, l = lg(v);
10450 823739 : for (i = 1; i < l; i++) gel(v,i) = gmul(gel(v,i), rootsof1pow(z,i-1));
10451 : }
10452 13041 : v = RgV_Rg_mul(v, gmul(S, rootsof1q_cx(-mu*na, da, prec)));
10453 13041 : return mkvec2(ALPHA, bdexpand(v, w/wN));
10454 : }
10455 :
10456 : /*****************************************************************/
10457 : /* END EISENSTEIN CUSPS */
10458 : /*****************************************************************/
10459 :
10460 : static GEN
10461 1596 : mfchisimpl(GEN CHI)
10462 : {
10463 : GEN G, chi;
10464 1596 : if (typ(CHI) == t_INT) return CHI;
10465 1596 : G = gel(CHI, 1); chi = gel(CHI, 2);
10466 1596 : switch(mfcharorder(CHI))
10467 : {
10468 1148 : case 1: chi = gen_1; break;
10469 427 : case 2: chi = znchartokronecker(G,chi,1); break;
10470 21 : default:chi = mkintmod(znconreyexp(G,chi), znstar_get_N(G)); break;
10471 : }
10472 1596 : return chi;
10473 : }
10474 :
10475 : GEN
10476 700 : mfparams(GEN F)
10477 : {
10478 700 : pari_sp av = avma;
10479 : GEN z, mf, CHI;
10480 700 : if ((mf = checkMF_i(F)))
10481 : {
10482 14 : long N = MF_get_N(mf);
10483 14 : GEN gk = MF_get_gk(mf);
10484 14 : CHI = MF_get_CHI(mf);
10485 14 : z = mkvec5(utoi(N), gk, CHI, utoi(MF_get_space(mf)), mfcharpol(CHI));
10486 : }
10487 : else
10488 : {
10489 686 : if (!checkmf_i(F)) pari_err_TYPE("mfparams", F);
10490 686 : z = vec_append(mf_get_NK(F), mfcharpol(mf_get_CHI(F)));
10491 : }
10492 700 : gel(z,3) = mfchisimpl(gel(z,3));
10493 700 : return gc_GEN(av, z);
10494 : }
10495 :
10496 : GEN
10497 14 : mfisCM(GEN F)
10498 : {
10499 14 : pari_sp av = avma;
10500 : forprime_t S;
10501 : GEN D, v;
10502 : long N, k, lD, sb, p, i;
10503 14 : if (!checkmf_i(F)) pari_err_TYPE("mfisCM", F);
10504 14 : N = mf_get_N(F);
10505 14 : k = mf_get_k(F); if (N < 0 || k < 0) pari_err_IMPL("mfisCM for this F");
10506 14 : D = mfunram(N, -1);
10507 14 : lD = lg(D);
10508 14 : sb = maxss(mfsturmNk(N, k), 4*N);
10509 14 : v = mfcoefs_i(F, sb, 1);
10510 14 : u_forprime_init(&S, 2, sb);
10511 504 : while ((p = u_forprime_next(&S)))
10512 : {
10513 490 : GEN ap = gel(v, p+1);
10514 490 : if (!gequal0(ap))
10515 406 : for (i = 1; i < lD; i++)
10516 245 : if (kross(D[i], p) == -1) { D = vecsplice(D, i); lD--; }
10517 : }
10518 14 : if (lD == 1) return gc_const(av, gen_0);
10519 14 : if (lD == 2) return gc_stoi(av, D[1]);
10520 7 : if (k > 1) pari_err_BUG("mfisCM");
10521 7 : return gc_upto(av, zv_to_ZV(D));
10522 : }
10523 :
10524 : static long
10525 287 : mfspace_i(GEN mf, GEN F)
10526 : {
10527 : GEN v, vF, gk;
10528 : long n, nE, i, l, s, N;
10529 :
10530 287 : mf = checkMF(mf); s = MF_get_space(mf);
10531 287 : if (!F) return s;
10532 287 : if (!checkmf_i(F)) pari_err_TYPE("mfspace",F);
10533 287 : v = mftobasis(mf, F, 1);
10534 287 : n = lg(v)-1; if (!n) return -1;
10535 224 : nE = lg(MF_get_E(mf))-1;
10536 224 : switch(s)
10537 : {
10538 56 : case mf_NEW: case mf_OLD: case mf_EISEN: return s;
10539 140 : case mf_FULL:
10540 140 : if (mf_get_type(F) == t_MF_THETA) return mf_EISEN;
10541 133 : if (!gequal0(vecslice(v,1,nE)))
10542 63 : return gequal0(vecslice(v,nE+1,n))? mf_EISEN: mf_FULL;
10543 : }
10544 : /* mf is mf_CUSP or mf_FULL, F a cusp form */
10545 98 : gk = mf_get_gk(F);
10546 98 : if (typ(gk) == t_FRAC || equali1(gk)) return mf_CUSP;
10547 84 : vF = mftonew_i(mf, vecslice(v, nE+1, n), &N);
10548 84 : if (N != MF_get_N(mf)) return mf_OLD;
10549 56 : l = lg(vF);
10550 91 : for (i = 1; i < l; i++)
10551 56 : if (itos(gmael(vF,i,1)) != N) return mf_CUSP;
10552 35 : return mf_NEW;
10553 : }
10554 : long
10555 287 : mfspace(GEN mf, GEN F)
10556 287 : { pari_sp av = avma; return gc_long(av, mfspace_i(mf,F)); }
10557 : static GEN
10558 21 : lfunfindchi(GEN ldata, GEN van, long prec)
10559 : {
10560 21 : GEN gN = ldata_get_conductor(ldata), gk = ldata_get_k(ldata);
10561 21 : GEN G = znstar0(gN,1), cyc = znstar_get_conreycyc(G), L, go, vz;
10562 21 : long N = itou(gN), odd = typ(gk) == t_INT && mpodd(gk);
10563 21 : long i, j, o, l, B0 = 2, B = lg(van)-1, bit = 10 - prec2nbits(prec);
10564 :
10565 : /* if van is integral, chi must be trivial */
10566 21 : if (typ(van) == t_VECSMALL) return mfcharGL(G, zerocol(lg(cyc)-1));
10567 14 : L = cyc2elts(cyc); l = lg(L);
10568 42 : for (i = j = 1; i < l; i++)
10569 : {
10570 28 : GEN chi = zc_to_ZC(gel(L,i));
10571 28 : if (zncharisodd(G,chi) == odd) gel(L,j++) = mfcharGL(G,chi);
10572 : }
10573 14 : setlg(L,j); l = j;
10574 14 : if (l <= 2) return gel(L,1);
10575 0 : o = znstar_get_expo(G); go = utoi(o);
10576 0 : vz = grootsof1(o, prec);
10577 : for (;;)
10578 0 : {
10579 : long n;
10580 0 : for (n = B0; n <= B; n++)
10581 : {
10582 : GEN an, r;
10583 : long j;
10584 0 : if (ugcd(n, N) != 1) continue;
10585 0 : an = gel(van,n); if (gexpo(an) < bit) continue;
10586 0 : r = gdiv(an, conj_i(an));
10587 0 : for (i = 1; i < l; i++)
10588 : {
10589 0 : GEN CHI = gel(L,i);
10590 0 : if (gexpo(gsub(r, gel(vz, znchareval_i(CHI,n,go)+1))) > bit)
10591 0 : gel(L,i) = NULL;
10592 : }
10593 0 : for (i = j = 1; i < l; i++)
10594 0 : if (gel(L,i)) gel(L,j++) = gel(L,i);
10595 0 : l = j; setlg(L,l);
10596 0 : if (l == 2) return gel(L,1);
10597 : }
10598 0 : B0 = B+1; B <<= 1;
10599 0 : van = ldata_vecan(ldata_get_an(ldata), B, prec);
10600 : }
10601 : }
10602 :
10603 : GEN
10604 21 : mffromlfun(GEN L, long prec)
10605 : {
10606 21 : pari_sp av = avma;
10607 21 : GEN ldata = lfunmisc_to_ldata_shallow(L), Vga = ldata_get_gammavec(ldata);
10608 21 : GEN van, a0, CHI, NK, gk = ldata_get_k(ldata);
10609 : long N, space;
10610 21 : if (!gequal(Vga, mkvec2(gen_0, gen_1))) pari_err_TYPE("mffromlfun", L);
10611 21 : N = itou(ldata_get_conductor(ldata));
10612 21 : van = ldata_vecan(ldata_get_an(ldata), mfsturmNgk(N,gk) + 2, prec);
10613 21 : CHI = lfunfindchi(ldata, van, prec);
10614 21 : if (typ(van) != t_VEC) van = vecsmall_to_vec_inplace(van);
10615 21 : space = (lg(ldata) == 7)? mf_CUSP: mf_FULL;
10616 21 : a0 = (space == mf_CUSP)? gen_0: gneg(lfun(L, gen_0, prec2nbits(prec)));
10617 21 : NK = mkvec3(utoi(N), gk, mfchisimpl(CHI));
10618 21 : return gc_GEN(av, mkvec3(NK, utoi(space), shallowconcat(a0, van)));
10619 : }
10620 : /*******************************************************************/
10621 : /* */
10622 : /* HALF-INTEGRAL WEIGHT */
10623 : /* */
10624 : /*******************************************************************/
10625 : /* We use the prefix mf2; k represents the weight -1/2, so e.g.
10626 : k = 2 is weight 5/2. N is the level, so 4\mid N, and CHI is the
10627 : character, always even. */
10628 :
10629 : static long
10630 3360 : lamCO(long r, long s, long p)
10631 : {
10632 3360 : if ((s << 1) <= r)
10633 : {
10634 1232 : long rp = r >> 1;
10635 1232 : if (odd(r)) return upowuu(p, rp) << 1;
10636 336 : else return (p + 1)*upowuu(p, rp - 1);
10637 : }
10638 2128 : else return upowuu(p, r - s) << 1;
10639 : }
10640 :
10641 : static int
10642 1568 : condC(GEN faN, GEN valF)
10643 : {
10644 1568 : GEN P = gel(faN, 1), E = gel(faN, 2);
10645 1568 : long l = lg(P), i;
10646 3696 : for (i = 1; i < l; i++)
10647 3024 : if ((P[i] & 3L) == 3)
10648 : {
10649 1120 : long r = E[i];
10650 1120 : if (odd(r) || r < (valF[i] << 1)) return 1;
10651 : }
10652 672 : return 0;
10653 : }
10654 :
10655 : /* returns 2*zetaCO; weight is k + 1/2 */
10656 : static long
10657 3696 : zeta2CO(GEN faN, GEN valF, long r2, long s2, long k)
10658 : {
10659 3696 : if (r2 >= 4) return lamCO(r2, s2, 2) << 1;
10660 2912 : if (r2 == 3) return 6;
10661 1568 : if (condC(faN, valF)) return 4;
10662 672 : if (odd(k)) return s2 ? 3 : 5; else return s2 ? 5: 3;
10663 : }
10664 :
10665 : /* returns 4 times last term in formula */
10666 : static long
10667 3696 : dim22(long N, long F, long k)
10668 : {
10669 3696 : pari_sp av = avma;
10670 3696 : GEN vF, faN = myfactoru(N), P = gel(faN, 1), E = gel(faN, 2);
10671 3696 : long i, D, l = lg(P);
10672 3696 : vF = cgetg(l, t_VECSMALL);
10673 9968 : for (i = 1; i < l; i++) vF[i] = u_lval(F, P[i]);
10674 3696 : D = zeta2CO(faN, vF, E[1], vF[1], k);
10675 6272 : for (i = 2; i < l; i++) D *= lamCO(E[i], vF[i], P[i]);
10676 3696 : return gc_long(av,D);
10677 : }
10678 :
10679 : /* PSI not necessarily primitive, of conductor F */
10680 : static int
10681 13846 : charistotallyeven(GEN PSI, long F)
10682 : {
10683 13846 : pari_sp av = avma;
10684 13846 : GEN P = gel(myfactoru(F), 1);
10685 13846 : GEN G = gel(PSI,1), psi = gel(PSI,2);
10686 : long i;
10687 14350 : for (i = 1; i < lg(P); i++)
10688 : {
10689 532 : GEN psip = znchardecompose(G, psi, utoipos(P[i]));
10690 532 : if (zncharisodd(G, psip)) return gc_bool(av,0);
10691 : }
10692 13818 : return gc_bool(av,1);
10693 : }
10694 :
10695 : static GEN
10696 299775 : get_PSI(GEN CHI, long t)
10697 : {
10698 299775 : long r = t & 3L, t2 = (r == 2 || r == 3) ? t << 2 : t;
10699 299775 : return mfcharmul_i(CHI, induce(gel(CHI,1), utoipos(t2)));
10700 : }
10701 : /* space = mf_CUSP, mf_EISEN or mf_FULL, weight k + 1/2 */
10702 : static long
10703 41363 : mf2dimwt12(long N, GEN CHI, long space)
10704 : {
10705 41363 : pari_sp av = avma;
10706 41363 : GEN D = mydivisorsu(N >> 2);
10707 41363 : long i, l = lg(D), dim3 = 0, dim4 = 0;
10708 :
10709 41363 : CHI = induceN(N, CHI);
10710 341138 : for (i = 1; i < l; i++)
10711 : {
10712 299775 : long rp, t = D[i], Mt = D[l-i];
10713 299775 : GEN PSI = get_PSI(CHI,t);
10714 299775 : rp = mfcharconductor(PSI);
10715 299775 : if (Mt % (rp*rp) == 0) { dim4++; if (charistotallyeven(PSI,rp)) dim3++; }
10716 : }
10717 41363 : set_avma(av);
10718 41363 : switch (space)
10719 : {
10720 40439 : case mf_CUSP: return dim4 - dim3;
10721 462 : case mf_EISEN:return dim3;
10722 462 : case mf_FULL: return dim4;
10723 : }
10724 : return 0; /*LCOV_EXCL_LINE*/
10725 : }
10726 :
10727 : static long
10728 693 : mf2dimwt32(long N, GEN CHI, long F, long space)
10729 : {
10730 : long D;
10731 693 : switch(space)
10732 : {
10733 231 : case mf_CUSP: D = mypsiu(N) - 6*dim22(N, F, 1);
10734 231 : if (D%24) pari_err_BUG("mfdim");
10735 231 : return D/24 + mf2dimwt12(N, CHI, 4);
10736 231 : case mf_FULL: D = mypsiu(N) + 6*dim22(N, F, 0);
10737 231 : if (D%24) pari_err_BUG("mfdim");
10738 231 : return D/24 + mf2dimwt12(N, CHI, 1);
10739 231 : case mf_EISEN: D = dim22(N, F, 0) + dim22(N, F, 1);
10740 231 : if (D & 3L) pari_err_BUG("mfdim");
10741 231 : return (D >> 2) - mf2dimwt12(N, CHI, 3);
10742 : }
10743 : return 0; /*LCOV_EXCL_LINE*/
10744 : }
10745 :
10746 : /* F = conductor(CHI), weight k = r+1/2 */
10747 : static long
10748 43736 : checkmf2(long N, long r, GEN CHI, long F, long space)
10749 : {
10750 43736 : switch(space)
10751 : {
10752 43715 : case mf_FULL: case mf_CUSP: case mf_EISEN: break;
10753 14 : case mf_NEW: case mf_OLD:
10754 14 : pari_err_TYPE("half-integral weight [new/old spaces]", utoi(space));
10755 7 : default:
10756 7 : pari_err_TYPE("half-integral weight [incorrect space]",utoi(space));
10757 : }
10758 43715 : if (N & 3L)
10759 0 : pari_err_DOMAIN("half-integral weight", "N % 4", "!=", gen_0, stoi(N));
10760 43715 : return r >= 0 && mfcharparity(CHI) == 1 && N % F == 0;
10761 : }
10762 :
10763 : /* weight k = r + 1/2 */
10764 : static long
10765 43463 : mf2dim_Nkchi(long N, long r, GEN CHI, ulong space)
10766 : {
10767 43463 : long D, D2, F = mfcharconductor(CHI);
10768 43463 : if (!checkmf2(N, r, CHI, F, space)) return 0;
10769 43442 : if (r == 0) return mf2dimwt12(N, CHI, space);
10770 2772 : if (r == 1) return mf2dimwt32(N, CHI, F, space);
10771 2079 : if (space == mf_EISEN)
10772 : {
10773 693 : D = dim22(N, F, r) + dim22(N, F, 1-r);
10774 693 : if (D & 3L) pari_err_BUG("mfdim");
10775 693 : return D >> 2;
10776 : }
10777 1386 : D2 = space == mf_FULL? dim22(N, F, 1-r): -dim22(N, F, r);
10778 1386 : D = (2*r-1)*mypsiu(N) + 6*D2;
10779 1386 : if (D%24) pari_err_BUG("mfdim");
10780 1386 : return D/24;
10781 : }
10782 :
10783 : /* weight k=r+1/2 */
10784 : static GEN
10785 273 : mf2init_Nkchi(long N, long r, GEN CHI, long space, long flraw)
10786 : {
10787 273 : GEN CHI1, Minv, Minvmat, B, M, gk = gaddsg(r,ghalf);
10788 273 : GEN mf1 = mkvec4(utoi(N),gk,CHI,utoi(space));
10789 : long L;
10790 273 : if (!checkmf2(N, r, CHI, mfcharconductor(CHI), space)) return mfEMPTY(mf1);
10791 273 : if (space==mf_EISEN) pari_err_IMPL("half-integral weight Eisenstein space");
10792 273 : L = mfsturmNgk(N, gk) + 1;
10793 273 : B = mf2basis(N, r, CHI, &CHI1, space);
10794 273 : M = mflineardivtomat(N,B,L); /* defined modulo T = charpol(CHI) */
10795 273 : if (flraw) M = mkvec3(gen_0,gen_0,M);
10796 : else
10797 : {
10798 273 : long o1 = mfcharorder(CHI1), o = mfcharorder(CHI);
10799 273 : M = mfcleanCHI(M, CHI, 0);
10800 273 : Minv = gel(M,2);
10801 273 : Minvmat = RgM_Minv_mul(NULL, Minv); /* mod T */
10802 273 : if (o1 != o)
10803 : {
10804 140 : GEN tr = Qab_trace_init(o, o1, mfcharpol(CHI), mfcharpol(CHI1));
10805 140 : Minvmat = QabM_tracerel(tr, 0, Minvmat);
10806 : }
10807 : /* Minvmat mod T1 = charpol(CHI1) */
10808 273 : B = vecmflineardiv_linear(B, Minvmat);
10809 273 : gel(M,3) = RgM_Minv_mul(gel(M,3), Minv);
10810 273 : gel(M,2) = mkMinv(matid(lg(B)-1), NULL,NULL,NULL);
10811 : }
10812 273 : return mkmf(mf1, cgetg(1,t_VEC), B, gen_0, M);
10813 : }
10814 :
10815 : /**************************************************************************/
10816 : /* Kohnen + space */
10817 : /**************************************************************************/
10818 :
10819 : static GEN
10820 28 : mfkohnenbasis_i(GEN mf, GEN CHI, long eps, long sb)
10821 : {
10822 28 : GEN M = mfcoefs_mf(mf, sb, 1), p, P;
10823 28 : long c, i, n = mfcharorder(CHI), l = sb + 2;
10824 28 : p = cgetg(l, t_VECSMALL);
10825 : /* keep the a_n, n = (2 or 2+eps) mod 4 */
10826 273 : for (i = 3, c = 1; i < l; i+=4) p[c++] = i;
10827 266 : for (i = 3+eps; i < l; i+=4) p[c++] = i;
10828 28 : P = n <= 2? NULL: mfcharpol(CHI);
10829 28 : setlg(p, c);
10830 28 : return QabM_ker(rowpermute(M, p), P, n);
10831 : }
10832 : GEN
10833 28 : mfkohnenbasis(GEN mf)
10834 : {
10835 28 : pari_sp av = avma;
10836 : GEN gk, CHI, CHIP, K;
10837 : long N4, r, eps, sb;
10838 28 : mf = checkMF(mf);
10839 28 : if (MF_get_space(mf) != mf_CUSP)
10840 0 : pari_err_TYPE("mfkohnenbasis [not a cuspidal space", mf);
10841 28 : if (!MF_get_dim(mf)) return cgetg(1, t_MAT);
10842 28 : N4 = MF_get_N(mf) >> 2; gk = MF_get_gk(mf); CHI = MF_get_CHI(mf);
10843 28 : if (typ(gk) == t_INT) pari_err_TYPE("mfkohnenbasis", gk);
10844 28 : r = MF_get_r(mf);
10845 28 : CHIP = mfcharchiliftprim(CHI, N4);
10846 28 : eps = CHIP==CHI? 1: -1;
10847 28 : if (odd(r)) eps = -eps;
10848 28 : if (uissquarefree(N4))
10849 : {
10850 21 : long d = mfdim_Nkchi(N4, 2*r, mfcharpow(CHI, gen_2), mf_CUSP);
10851 21 : sb = mfsturmNgk(N4 << 2, gk) + 1;
10852 21 : K = mfkohnenbasis_i(mf, CHIP, eps, sb);
10853 21 : if (lg(K) - 1 == d) return gc_GEN(av, K);
10854 : }
10855 7 : sb = mfsturmNgk(N4 << 4, gk) + 1;
10856 7 : K = mfkohnenbasis_i(mf, CHIP, eps, sb);
10857 7 : return gc_GEN(av, K);
10858 : }
10859 :
10860 : static GEN
10861 21 : get_Shimura(GEN mf, GEN CHI, GEN vB, long t)
10862 : {
10863 21 : long N = MF_get_N(mf), r = MF_get_k(mf) >> 1;
10864 21 : long i, d = MF_get_dim(mf), sb = mfsturm_mf(mf);
10865 21 : GEN a = cgetg(d+1, t_MAT);
10866 84 : for (i = 1; i <= d; i++)
10867 : {
10868 63 : pari_sp av = avma;
10869 63 : GEN f = c_deflate(sb*sb, t, gel(vB,i));
10870 63 : f = mftobasis_i(mf, RgV_shimura(f, sb, t, N, r, CHI));
10871 63 : gel(a,i) = gc_upto(av, f);
10872 : }
10873 21 : return a;
10874 : }
10875 : static long
10876 35 : QabM_rank(GEN M, GEN P, long n)
10877 : {
10878 35 : GEN z = QabM_indexrank(M, P, n);
10879 35 : return lg(gel(z,2))-1;
10880 : }
10881 : /* discard T[*i] */
10882 : static void
10883 0 : discard_Ti(GEN T, long *i, long *lt)
10884 : {
10885 0 : long j, l = *lt-1;
10886 0 : for (j = *i; j < l; j++) T[j] = T[j+1];
10887 0 : (*i)--; *lt = l;
10888 0 : }
10889 : /* return [mf3, bijection, mfkohnenbasis, codeshi] */
10890 : static GEN
10891 14 : mfkohnenbijection_i(GEN mf)
10892 : {
10893 14 : GEN CHI = MF_get_CHI(mf), K = mfkohnenbasis(mf);
10894 : GEN mres, dMi, Mi, M, C, vB, mf3, SHI, T, P;
10895 14 : long N4 = MF_get_N(mf)>>2, r = MF_get_r(mf), dK = lg(K) - 1;
10896 : long i, c, n, oldr, lt, ltold, sb3, t, limt;
10897 14 : const long MAXlt = 100;
10898 :
10899 14 : mf3 = mfinit_Nkchi(N4, r<<1, mfcharpow(CHI,gen_2), mf_CUSP, 0);
10900 14 : if (MF_get_dim(mf3) != dK)
10901 0 : pari_err_BUG("mfkohnenbijection [different dimensions]");
10902 14 : if (!dK) return mkvec4(mf3, cgetg(1, t_MAT), K, cgetg(1, t_VEC));
10903 14 : CHI = mfcharchiliftprim(CHI, N4);
10904 14 : n = mfcharorder(CHI);
10905 14 : P = n<=2? NULL: mfcharpol(CHI);
10906 14 : SHI = cgetg(MAXlt, t_COL);
10907 14 : T = cgetg(MAXlt, t_VECSMALL);
10908 14 : sb3 = mfsturm_mf(mf3);
10909 14 : limt = 6; oldr = 0; vB = C = M = NULL;
10910 98 : for (t = lt = ltold = 1; lt < MAXlt; t++)
10911 : {
10912 : pari_sp av;
10913 98 : if (!uissquarefree(t)) continue;
10914 84 : T[lt++] = t; if (t <= limt) continue;
10915 14 : av = avma;
10916 14 : if (vB) gunclone(vB);
10917 : /* could improve the rest but 99% of running time is spent here */
10918 14 : vB = gclone( RgM_mul(mfcoefs_mf(mf, t*sb3*sb3, 1), K) );
10919 14 : set_avma(av);
10920 21 : for (i = ltold; i < lt; i++)
10921 : {
10922 : pari_sp av;
10923 : long r;
10924 21 : M = get_Shimura(mf3, CHI, vB, T[i]);
10925 21 : r = QabM_rank(M, P, n); if (!r) { discard_Ti(T, &i, <); continue; }
10926 21 : gel(SHI, i) = M; setlg(SHI, i+1);
10927 21 : if (r >= dK) { C = vecsmall_ei(dK, i); goto DONE; }
10928 14 : if (i == 1) { oldr = r; continue; }
10929 7 : av = avma; M = shallowmatconcat(SHI);
10930 7 : r = QabM_rank(M, P, n); /* >= rank(sum C[j] SHI[j]), probably sharp */
10931 7 : if (r >= dK)
10932 : {
10933 7 : M = RgV_sum(SHI);
10934 7 : if (QabM_rank(M, P, n) >= dK) { C = const_vecsmall(dK, 1); goto DONE; }
10935 0 : C = random_Flv(dK, 16);
10936 0 : M = RgV_zc_mul(SHI, C);
10937 0 : if (QabM_rank(M, P, n) >= dK) goto DONE;
10938 : }
10939 0 : else if (r == oldr) discard_Ti(T, &i, <);
10940 0 : oldr = r; set_avma(av);
10941 : }
10942 0 : limt *= 2; ltold = lt;
10943 : }
10944 0 : pari_err_BUG("mfkohnenbijection");
10945 14 : DONE:
10946 14 : gunclone(vB); lt = lg(SHI);
10947 14 : Mi = QabM_pseudoinv(M,P,n, NULL,&dMi); Mi = RgM_Rg_div(Mi,dMi);
10948 14 : mres = cgetg(lt, t_VEC);
10949 35 : for (i = c = 1; i < lt; i++)
10950 21 : if (C[i]) gel(mres,c++) = mkvec2s(T[i], C[i]);
10951 14 : setlg(mres,c); return mkvec4(mf3, Mi, K, mres);
10952 : }
10953 : GEN
10954 14 : mfkohnenbijection(GEN mf)
10955 : {
10956 14 : pari_sp av = avma;
10957 : long N;
10958 14 : mf = checkMF(mf); N = MF_get_N(mf);
10959 14 : if (!uissquarefree(N >> 2))
10960 0 : pari_err_TYPE("mfkohnenbijection [N/4 not squarefree]", utoi(N));
10961 14 : if (MF_get_space(mf) != mf_CUSP || MF_get_r(mf) == 0 || !mfshimura_space_cusp(mf))
10962 0 : pari_err_TYPE("mfkohnenbijection [incorrect mf for Kohnen]", mf);
10963 14 : return gc_GEN(av, mfkohnenbijection_i(mf));
10964 : }
10965 :
10966 : static int
10967 7 : checkbij_i(GEN b)
10968 : {
10969 7 : return typ(b) == t_VEC && lg(b) == 5 && checkMF_i(gel(b,1))
10970 7 : && typ(gel(b,2)) == t_MAT
10971 7 : && typ(gel(b,3)) == t_MAT
10972 14 : && typ(gel(b,4)) == t_VEC;
10973 : }
10974 :
10975 : /* bij is the output of mfkohnenbijection */
10976 : GEN
10977 7 : mfkohneneigenbasis(GEN mf, GEN bij)
10978 : {
10979 7 : pari_sp av = avma;
10980 : GEN mf3, mf30, B, KM, M, k;
10981 : long r, i, l, N4;
10982 7 : mf = checkMF(mf);
10983 7 : if (!checkbij_i(bij))
10984 0 : pari_err_TYPE("mfkohneneigenbasis [bijection]", bij);
10985 7 : if (MF_get_space(mf) != mf_CUSP)
10986 0 : pari_err_TYPE("mfkohneneigenbasis [not a cuspidal space]", mf);
10987 7 : if (!MF_get_dim(mf))
10988 0 : retmkvec3(cgetg(1, t_VEC), cgetg(1, t_VEC), cgetg(1, t_VEC));
10989 7 : N4 = MF_get_N(mf) >> 2; k = MF_get_gk(mf);
10990 7 : if (typ(k) == t_INT) pari_err_TYPE("mfkohneneigenbasis", k);
10991 7 : if (!uissquarefree(N4))
10992 0 : pari_err_TYPE("mfkohneneigenbasis [N not squarefree]", utoipos(N4));
10993 7 : r = MF_get_r(mf);
10994 7 : KM = RgM_mul(gel(bij,3), gel(bij,2));
10995 7 : mf3 = gel(bij,1);
10996 7 : mf30 = mfinit_Nkchi(N4, 2*r, MF_get_CHI(mf3), mf_NEW, 0);
10997 7 : B = mfcoefs_mf(mf30, mfsturm_mf(mf3), 1); l = lg(B);
10998 7 : M = cgetg(l, t_MAT);
10999 21 : for (i=1; i<l; i++) gel(M,i) = RgM_RgC_mul(KM, mftobasis_i(mf3, gel(B,i)));
11000 7 : return gc_GEN(av, mkvec3(mf30, M, RgM_mul(M, MF_get_newforms(mf30))));
11001 : }
11002 : /*************************** End Kohnen ************************************/
11003 : /***************************************************************************/
11004 :
11005 : static GEN desc(GEN F);
11006 : static GEN
11007 504 : desc_mfeisen(GEN F)
11008 : {
11009 504 : GEN R, gk = mf_get_gk(F);
11010 504 : if (typ(gk) == t_FRAC)
11011 7 : R = gsprintf("H_{%Ps}", gk);
11012 : else
11013 : {
11014 497 : GEN vchi = gel(F, 2), CHI = mfchisimpl(gel(vchi, 3));
11015 497 : long k = itou(gk);
11016 497 : if (lg(vchi) < 5) R = gsprintf("F_%ld(%Ps)", k, CHI);
11017 : else
11018 : {
11019 294 : GEN CHI2 = mfchisimpl(gel(vchi, 4));
11020 294 : R = gsprintf("F_%ld(%Ps, %Ps)", k, CHI, CHI2);
11021 : }
11022 : }
11023 504 : return R;
11024 : }
11025 : static GEN
11026 35 : desc_hecke(GEN F)
11027 : {
11028 : long n, N;
11029 35 : GEN D = gel(F,2);
11030 35 : if (typ(D) == t_VECSMALL) { N = D[3]; n = D[1]; }
11031 14 : else { GEN nN = gel(D,2); n = nN[1]; N = nN[2]; } /* half integer */
11032 35 : return gsprintf("T_%ld(%ld)(%Ps)", N, n, desc(gel(F,3)));
11033 : }
11034 : static GEN
11035 98 : desc_linear(GEN FLD, GEN dL)
11036 : {
11037 98 : GEN F = gel(FLD,2), L = gel(FLD,3), R = strtoGENstr("LIN([");
11038 98 : long n = lg(F) - 1, i;
11039 168 : for (i = 1; i <= n; i++)
11040 : {
11041 168 : R = shallowconcat(R, desc(gel(F,i))); if (i == n) break;
11042 70 : R = shallowconcat(R, strtoGENstr(", "));
11043 : }
11044 98 : return shallowconcat(R, gsprintf("], %Ps)", gdiv(L, dL)));
11045 : }
11046 : static GEN
11047 21 : desc_dihedral(GEN F)
11048 : {
11049 21 : GEN bnr = gel(F,2), D = nf_get_disc(bnr_get_nf(bnr)), f = bnr_get_mod(bnr);
11050 21 : GEN cyc = bnr_get_cyc(bnr);
11051 21 : GEN w = gel(F,3), chin = zv_to_ZV(gel(w,2)), o = utoi(gel(w,1)[1]);
11052 21 : GEN chi = char_denormalize(cyc, o, chin);
11053 21 : if (lg(gel(f,2)) == 1) f = gel(f,1);
11054 21 : return gsprintf("DIH(%Ps, %Ps, %Ps, %Ps)",D,f,cyc,chi);
11055 : }
11056 :
11057 : static void
11058 1043 : unpack0(GEN *U)
11059 1043 : { if (U) *U = mkvec2(cgetg(1, t_VEC), cgetg(1, t_VEC)); }
11060 : static void
11061 42 : unpack2(GEN F, GEN *U)
11062 42 : { if (U) *U = mkvec2(mkvec2(gel(F,2), gel(F,3)), cgetg(1, t_VEC)); }
11063 : static void
11064 308 : unpack23(GEN F, GEN *U)
11065 308 : { if (U) *U = mkvec2(mkvec(gel(F,2)), mkvec(gel(F,3))); }
11066 : static GEN
11067 1540 : desc_i(GEN F, GEN *U)
11068 : {
11069 1540 : switch(mf_get_type(F))
11070 : {
11071 7 : case t_MF_CONST: unpack0(U); return gsprintf("CONST(%Ps)", gel(F,2));
11072 504 : case t_MF_EISEN: unpack0(U); return desc_mfeisen(F);
11073 154 : case t_MF_Ek: unpack0(U); return gsprintf("E_%ld", mf_get_k(F));
11074 63 : case t_MF_DELTA: unpack0(U); return gsprintf("DELTA");
11075 35 : case t_MF_THETA: unpack0(U);
11076 35 : return gsprintf("THETA(%Ps)", mfchisimpl(gel(F,2)));
11077 56 : case t_MF_ETAQUO: unpack0(U);
11078 56 : return gsprintf("ETAQUO(%Ps, %Ps)", gel(F,2), gel(F,3));
11079 56 : case t_MF_ELL: unpack0(U);
11080 56 : return gsprintf("ELL(%Ps)", vecslice(gel(F,2), 1, 5));
11081 7 : case t_MF_TRACE: unpack0(U); return gsprintf("TR(%Ps)", mfparams(F));
11082 140 : case t_MF_NEWTRACE: unpack0(U); return gsprintf("TR^new(%Ps)", mfparams(F));
11083 21 : case t_MF_DIHEDRAL: unpack0(U); return desc_dihedral(F);
11084 28 : case t_MF_MUL: unpack2(F, U);
11085 28 : return gsprintf("MUL(%Ps, %Ps)", desc(gel(F,2)), desc(gel(F,3)));
11086 14 : case t_MF_DIV: unpack2(F, U);
11087 14 : return gsprintf("DIV(%Ps, %Ps)", desc(gel(F,2)), desc(gel(F,3)));
11088 14 : case t_MF_POW: unpack23(F, U);
11089 14 : return gsprintf("POW(%Ps, %ld)", desc(gel(F,2)), itos(gel(F,3)));
11090 14 : case t_MF_SHIFT: unpack23(F, U);
11091 14 : return gsprintf("SHIFT(%Ps, %ld)", desc(gel(F,2)), itos(gel(F,3)));
11092 14 : case t_MF_DERIV: unpack23(F, U);
11093 14 : return gsprintf("DER^%ld(%Ps)", itos(gel(F,3)), desc(gel(F,2)));
11094 21 : case t_MF_DERIVE2: unpack23(F, U);
11095 21 : return gsprintf("DERE2^%ld(%Ps)", itos(gel(F,3)), desc(gel(F,2)));
11096 14 : case t_MF_TWIST: unpack23(F, U);
11097 14 : return gsprintf("TWIST(%Ps, %Ps)", desc(gel(F,2)), gel(F,3));
11098 231 : case t_MF_BD: unpack23(F, U);
11099 231 : return gsprintf("B(%ld)(%Ps)", itou(gel(F,3)), desc(gel(F,2)));
11100 14 : case t_MF_BRACKET:
11101 14 : if (U) *U = mkvec2(mkvec2(gel(F,2), gel(F,3)), mkvec(gel(F,4)));
11102 14 : return gsprintf("MULRC_%ld(%Ps, %Ps)", itos(gel(F,4)), desc(gel(F,2)), desc(gel(F,3)));
11103 98 : case t_MF_LINEAR_BHN:
11104 : case t_MF_LINEAR:
11105 98 : if (U) *U = mkvec2(gel(F,2), mkvec(gdiv(gel(F,3), gel(F,4))));
11106 98 : return desc_linear(F,gel(F,4));
11107 35 : case t_MF_HECKE:
11108 35 : if (U) *U = mkvec2(mkvec(gel(F,3)), mkvec(stoi(gel(F,2)[1])));
11109 35 : return desc_hecke(F);
11110 0 : default: pari_err_TYPE("mfdescribe",F);
11111 : return NULL;/*LCOV_EXCL_LINE*/
11112 : }
11113 : }
11114 : static GEN
11115 623 : desc(GEN F) { return desc_i(F, NULL); }
11116 : GEN
11117 966 : mfdescribe(GEN F, GEN *U)
11118 : {
11119 966 : pari_sp av = avma;
11120 : GEN mf;
11121 966 : if ((mf = checkMF_i(F)))
11122 : {
11123 49 : const char *f = NULL;
11124 49 : switch (MF_get_space(mf))
11125 : {
11126 7 : case mf_NEW: f = "S_%Ps^new(G_0(%ld, %Ps))"; break;
11127 14 : case mf_CUSP: f = "S_%Ps(G_0(%ld, %Ps))"; break;
11128 7 : case mf_OLD: f = "S_%Ps^old(G_0(%ld, %Ps))"; break;
11129 7 : case mf_EISEN:f = "E_%Ps(G_0(%ld, %Ps))"; break;
11130 14 : case mf_FULL: f = "M_%Ps(G_0(%ld, %Ps))"; break;
11131 : }
11132 49 : if (U) *U = cgetg(1, t_VEC);
11133 49 : return gsprintf(f, MF_get_gk(mf), MF_get_N(mf), mfchisimpl(MF_get_CHI(mf)));
11134 : }
11135 917 : if (!checkmf_i(F)) pari_err_TYPE("mfdescribe", F);
11136 917 : F = desc_i(F, U); return gc_all(av, U ? 2: 1, &F, U);
11137 : }
11138 :
11139 : /***********************************************************************/
11140 : /* Eisenstein series H_r of weight r+1/2 */
11141 : /***********************************************************************/
11142 : /* radical(u_ppo(g,q)) */
11143 : static long
11144 28 : u_pporad(long g, long q)
11145 : {
11146 28 : GEN F = myfactoru(g), P = gel(F,1);
11147 : long i, l, n;
11148 28 : if (q == 1) return zv_prod(P);
11149 28 : l = lg(P);
11150 35 : for (i = n = 1; i < l; i++)
11151 : {
11152 7 : long p = P[i];
11153 7 : if (q % p) n *= p;
11154 : }
11155 28 : return n;
11156 : }
11157 : static void
11158 266 : c_F2TH4(long n, GEN *pF2, GEN *pTH4)
11159 : {
11160 266 : GEN v = mfcoefs_i(mfEk(2), n, 1), v2 = bdexpand(v,2), v4 = bdexpand(v,4);
11161 266 : GEN F2 = gdivgs(ZC_add(ZC_sub(v, ZC_z_mul(v2,3)), ZC_z_mul(v4,2)), -24);
11162 266 : GEN TH4 = gdivgs(ZC_sub(v, ZC_z_mul(v4,4)), -3);
11163 266 : settyp(F2,t_VEC); *pF2 = F2;
11164 266 : settyp(TH4,t_VEC);*pTH4= TH4;
11165 266 : }
11166 : /* r > 0, N >= 0 */
11167 : static GEN
11168 77 : mfEHcoef(long r, long N)
11169 : {
11170 : long D0, f, i, l, s;
11171 : GEN S, Df;
11172 :
11173 77 : if (r == 1) return hclassno(utoi(N));
11174 77 : if (N == 0) return gdivgs(bernfrac(2*r), -2*r);
11175 56 : s = N & 3L;
11176 56 : if (odd(r))
11177 : {
11178 42 : if (s == 2 || s == 1) return gen_0;
11179 14 : D0 = mycoredisc2neg(N,&f);
11180 : }
11181 : else
11182 : {
11183 14 : if (s == 2 || s == 3) return gen_0;
11184 14 : D0 = mycoredisc2pos(N,&f);
11185 : }
11186 28 : Df = mydivisorsu(u_pporad(f, D0)); l = lg(Df);
11187 28 : S = gen_0;
11188 63 : for (i = 1; i < l; i++)
11189 : {
11190 35 : long d = Df[i], s = mymoebiusu(d)*kross(D0, d); /* != 0 */
11191 35 : GEN c = gmul(powuu(d, r-1), mysumdivku(f/d, 2*r-1));
11192 35 : S = s > 0? addii(S, c): subii(S, c);
11193 : }
11194 28 : return gmul(lfunquadneg_naive(D0, r), S);
11195 : }
11196 : static GEN
11197 266 : mfEHmat(long lim, long r)
11198 : {
11199 266 : long j, l, d = r/2;
11200 : GEN f2, th4, th3, v, vth4, vf2;
11201 266 : c_F2TH4(lim, &f2, &th4);
11202 266 : f2 = RgV_to_ser(f2, 0, lim+3);
11203 266 : th4 = RgV_to_ser(th4, 0, lim+3);
11204 266 : th3 = RgV_to_ser(c_theta(lim, 1, mfchartrivial()), 0, lim+3);
11205 266 : if (odd(r)) th3 = gpowgs(th3, 3);
11206 266 : vth4 = gpowers(th4, d);
11207 266 : vf2 = gpowers0(f2, d, th3); /* th3 f2^j */
11208 266 : l = d+2; v = cgetg(l, t_VEC);
11209 924 : for (j = 1; j < l; j++)
11210 658 : gel(v, j) = ser2rfrac_i(gmul(gel(vth4, l-j), gel(vf2, j)));
11211 266 : return RgXV_to_RgM(v, lim);
11212 : }
11213 : static GEN
11214 7 : Hfind(long r, GEN *pden)
11215 : {
11216 7 : long lim = (r/2)+3, i;
11217 : GEN res, M, B;
11218 :
11219 7 : if (r <= 0) pari_err_DOMAIN("mfEH", "r", "<=", gen_0, stoi(r));
11220 7 : M = mfEHmat(lim, r);
11221 7 : B = cgetg(lim+1, t_COL);
11222 56 : for (i = 1; i <= lim; i++) gel(B, i) = mfEHcoef(r, i-1);
11223 7 : res = QM_gauss(M, B);
11224 7 : if (lg(res) == 1) pari_err_BUG("mfEH");
11225 7 : return Q_remove_denom(res,pden);
11226 : }
11227 : GEN
11228 266 : mfEH(GEN gk)
11229 : {
11230 266 : pari_sp av = avma;
11231 266 : GEN v, d, NK, gr = gsub(gk, ghalf);
11232 : long r;
11233 266 : if (typ(gr) != t_INT) pari_err_TYPE("mfEH", gk);
11234 266 : r = itos(gr);
11235 266 : switch (r)
11236 : {
11237 7 : case 1: v=cgetg(1,t_VEC); d=gen_1; break;
11238 133 : case 2: v=mkvec2s(1,-20); d=utoipos(120); break;
11239 56 : case 3: v=mkvec2s(-1,14); d=utoipos(252); break;
11240 35 : case 4: v=mkvec3s(1,-16,16); d=utoipos(240); break;
11241 7 : case 5: v=mkvec3s(-1,22,-88); d=utoipos(132); break;
11242 14 : case 6: v=mkvec4s(691,-18096,110136,-4160); d=utoipos(32760); break;
11243 7 : case 7: v=mkvec4s(-1,30,-240,224); d=utoipos(12); break;
11244 7 : default: v = Hfind(r, &d); break;
11245 : }
11246 266 : NK = mkgNK(utoipos(4), gaddgs(ghalf,r), mfchartrivial(), pol_x(1));
11247 266 : return gc_GEN(av, tag(t_MF_EISEN, NK, mkvec2(v,d)));
11248 : }
11249 :
11250 : /**********************************************************/
11251 : /* T(f^2) for half-integral weight */
11252 : /**********************************************************/
11253 :
11254 : /* T_p^2 V, p2 = p^2, c1 = chi(p) (-1/p)^r p^(r-1), c2 = chi(p^2)*p^(2r-1) */
11255 : static GEN
11256 70 : tp2apply(GEN V, long p, long p2, GEN c1, GEN c2)
11257 : {
11258 70 : long lw = (lg(V) - 2)/p2 + 1, m, n;
11259 70 : GEN a0 = gel(V,1), W = cgetg(lw + 1, t_VEC);
11260 :
11261 70 : gel(W,1) = gequal0(a0)? gen_0: gmul(a0, gaddsg(1, c2));
11262 11109 : for (n = 1; n < lw; n++)
11263 : {
11264 11039 : GEN c = gel(V, p2*n + 1);
11265 11039 : if (n%p) c = gadd(c, gmulsg(kross(n,p), gmul(gel(V,n+1), c1)));
11266 11039 : gel(W, n+1) = c; /* a(p^2*n) + c1 * (n/p) a(n) */
11267 : }
11268 1253 : for (m = 1, n = p2; n < lw; m++, n += p2)
11269 1183 : gel(W, n+1) = gadd(gel(W,n+1), gmul(gel(V,m+1), c2));
11270 70 : return W;
11271 : }
11272 :
11273 : /* T_{p^{2e}} V; can derecursify [Purkait, Hecke operators in half-integral
11274 : * weight, Prop 4.3], not worth it */
11275 : static GEN
11276 70 : tp2eapply(GEN V, long p, long p2, long e, GEN q, GEN c1, GEN c2)
11277 : {
11278 70 : GEN V4 = NULL;
11279 70 : if (e > 1)
11280 : {
11281 21 : V4 = vecslice(V, 1, (lg(V) - 2)/(p2*p2) + 1);
11282 21 : V = tp2eapply(V, p, p2, e-1, q, c1, c2);
11283 : }
11284 70 : V = tp2apply(V, p, p2, c1, c2);
11285 70 : if (e > 1)
11286 28 : V = gsub(V, (e == 2)? gmul(q, V4)
11287 7 : : gmul(c2, tp2eapply(V4, p, p2, e-2, q, c1, c2)));
11288 70 : return V;
11289 : }
11290 : /* weight k = r+1/2 */
11291 : static GEN
11292 98 : RgV_heckef2(long n, long d, GEN V, GEN F, GEN DATA)
11293 : {
11294 98 : GEN CHI = mf_get_CHI(F), fa = gel(DATA,1), P = gel(fa,1), E = gel(fa,2);
11295 98 : long i, l = lg(P), r = mf_get_r(F), s4 = odd(r)? -4: 4, k2m2 = (r<<1)-1;
11296 98 : if (typ(V) == t_COL) V = shallowtrans(V);
11297 140 : for (i = 1; i < l; i++)
11298 : { /* p does not divide N */
11299 42 : long p = P[i], e = E[i], p2 = p*p;
11300 42 : GEN c1, c2, a, b, q = NULL, C = mfchareval(CHI,p), C2 = gsqr(C);
11301 42 : a = r? powuu(p,r-1): mkfrac(gen_1,utoipos(p)); /* p^(r-1) = p^(k-3/2) */
11302 42 : b = r? mulii(powuu(p,r), a): a; /* p^(2r-1) = p^(2k-2) */
11303 42 : c1 = gmul(C, gmulsg(kross(s4,p),a));
11304 42 : c2 = gmul(C2, b);
11305 42 : if (e > 1)
11306 : {
11307 14 : q = r? powuu(p,k2m2): a;
11308 14 : if (e == 2) q = gmul(q, uutoQ(p+1,p)); /* special case T_{p^4} */
11309 14 : q = gmul(C2, q); /* chi(p^2) [ p^(2k-2) or (p+1)p^(2k-3) ] */
11310 : }
11311 42 : V = tp2eapply(V, p, p2, e, q, c1, c2);
11312 : }
11313 98 : return c_deflate(n, d, V);
11314 : }
11315 :
11316 : static GEN
11317 1428 : GL2toSL2(GEN g, GEN *abd)
11318 : {
11319 : GEN A, B, C, D, u, v, a, b, d, q;
11320 1428 : g = Q_primpart(g);
11321 1428 : if (!check_M2Z(g)) pari_err_TYPE("GL2toSL2", g);
11322 1428 : A = gcoeff(g,1,1); B = gcoeff(g,1,2);
11323 1428 : C = gcoeff(g,2,1); D = gcoeff(g,2,2);
11324 1428 : a = bezout(A, C, &u, &v);
11325 1428 : if (!equali1(a)) { A = diviiexact(A,a); C = diviiexact(C,a); }
11326 1428 : d = subii(mulii(A,D), mulii(B,C));
11327 1428 : if (signe(d) <= 0) pari_err_TYPE("GL2toSL2",g);
11328 1421 : q = dvmdii(addii(mulii(u,B), mulii(v,D)), d, &b);
11329 1421 : *abd = (equali1(a) && equali1(d))? NULL: mkvec3(a, b, d);
11330 1421 : return mkmat22(A, subii(mulii(q,A), v), C, addii(mulii(q,C), u));
11331 : }
11332 :
11333 : static GEN
11334 8526 : Rg_approx(GEN t, long bit)
11335 : {
11336 8526 : GEN a = real_i(t), b = imag_i(t);
11337 8526 : long ea = gexpo(a), eb = gexpo(b);
11338 2072 : return (eb < -bit)? ((ea < -bit)? gen_0: a)
11339 10598 : : ((ea < -bit)? mulcxI(b): t);
11340 : }
11341 : static GEN
11342 126 : RgV_approx(GEN x, long bit)
11343 840 : { pari_APPLY_same(Rg_approx(gel(x,i), bit)); }
11344 : /* m != 2 (mod 4), D t_INT; V has "denominator" D, recognize in Q(zeta_m) */
11345 : static GEN
11346 126 : bestapprnf2(GEN V, long m, GEN D, long prec)
11347 : {
11348 126 : long i, j, f, vt = fetch_user_var("t"), bit = prec2nbits_mul(prec, 0.8);
11349 126 : GEN Tinit, Vl, H, Pf, P = polcyclo(m, vt);
11350 :
11351 126 : V = liftpol_shallow(V);
11352 126 : V = gmul(RgV_approx(V, bit), D);
11353 126 : V = bestapprnf(V, P, NULL, prec);
11354 126 : Vl = liftpol_shallow(V);
11355 126 : H = coprimes_zv(m);
11356 672 : for (i = 2; i < m; i++)
11357 : {
11358 546 : if (H[i] != 1) continue;
11359 280 : if (!gequal(Vl, vecGalois(Vl, i, P, m))) H[i] = 0;
11360 14 : else for (j = i; j < m; j *= i) H[i] = 3;
11361 : }
11362 126 : f = znstar_conductor_bits(Flv_to_F2v(H));
11363 126 : if (f == 1) return gdiv(V, D);
11364 98 : if (f == m) return gmodulo(gdiv(V, D), P);
11365 7 : Pf = polcyclo(f, vt);
11366 7 : Tinit = Qab_trace_init(m, f, P, Pf);
11367 7 : return gmodulo(gdiv(QabV_tracerel(Tinit, 0, Vl), D), Pf);
11368 : }
11369 :
11370 : /* f | ga expansion; [f, mf_eisendec(f)]~ allowed */
11371 : GEN
11372 1365 : mfslashexpansion(GEN mf, GEN f, GEN ga, long n, long flrat, GEN *params, long prec)
11373 : {
11374 1365 : pari_sp av = avma;
11375 1365 : GEN a, b, d, res, al, V, M, ad, abd, gk, A, awd = NULL;
11376 : long i, w;
11377 :
11378 1365 : mf = checkMF(mf);
11379 1365 : gk = MF_get_gk(mf);
11380 1365 : M = GL2toSL2(ga, &abd);
11381 1358 : if (abd) { a = gel(abd,1); b = gel(abd,2); d = gel(abd,3); }
11382 903 : else { a = d = gen_1; b = gen_0; }
11383 1358 : ad = gdiv(a,d);
11384 1358 : res = mfgaexpansion(mf, f, M, n, prec);
11385 1358 : al = gel(res,1);
11386 1358 : w = itou(gel(res,2));
11387 1358 : V = gel(res,3);
11388 1358 : if (flrat)
11389 : {
11390 126 : GEN CHI = MF_get_CHI(mf);
11391 126 : long N = MF_get_N(mf), F = mfcharconductor(CHI);
11392 126 : long ord = mfcharorder(CHI), k, deg;
11393 126 : long B = umodiu(gcoeff(M,1,2), N);
11394 126 : long C = umodiu(gcoeff(M,2,1), N);
11395 126 : long D = umodiu(gcoeff(M,2,2), N);
11396 126 : long CD = (C * D) % N, BC = (B * C) % F;
11397 : GEN CV, t;
11398 : /* weight of f * Theta in 1/2-integral weight */
11399 126 : k = typ(gk) == t_INT? (long) itou(gk): MF_get_r(mf)+1;
11400 126 : CV = odd(k) ? powuu(N, k - 1) : powuu(N, k >> 1);
11401 126 : deg = ulcm(ulcm(ord, N/ugcd(N,CD)), F/ugcd(F,BC));
11402 126 : if ((deg & 3) == 2) deg >>= 1;
11403 126 : if (typ(gk) != t_INT && odd(deg) && mfthetaI(C,D)) deg <<= 2;
11404 126 : V = bestapprnf2(V, deg, CV, prec);
11405 126 : if (abd && !signe(b))
11406 : { /* can [a,0; 0,d] be simplified to id ? */
11407 7 : long nk, dk; Qtoss(gk, &nk, &dk);
11408 7 : if (ispower(ad, utoipos(2*dk), &t)) /* t^(2*dk) = a/d or t = NULL */
11409 : {
11410 7 : V = RgV_Rg_mul(V, powiu(t,nk));
11411 7 : awd = gdiv(a, muliu(d,w));
11412 : }
11413 : }
11414 : }
11415 1232 : else if (abd)
11416 : { /* ga = M * [a,b;0,d] * rational, F := f | M = q^al * \sum V[j] q^(j/w) */
11417 448 : GEN u, t = NULL, wd = muliu(d,w);
11418 : /* a > 0, 0 <= b < d; f | ga = (a/d)^(k/2) * F(tau + b/d) */
11419 448 : if (signe(b))
11420 : {
11421 : long ns, ds;
11422 : GEN z;
11423 0 : Qtoss(gdiv(b, wd), &ns, &ds); z = rootsof1powinit(ns, ds, prec);
11424 0 : for (i = 1; i <= n+1; i++) gel(V,i) = gmul(gel(V,i), rootsof1pow(z, i-1));
11425 0 : if (!gequal0(al)) t = gexp(gmul(PiI2(prec), gmul(al, gdiv(b,d))), prec);
11426 : }
11427 448 : awd = gdiv(a, wd);
11428 448 : u = gpow(ad, gmul2n(gk,-1), prec);
11429 448 : t = t? gmul(t, u): u;
11430 448 : V = RgV_Rg_mul(V, t);
11431 : }
11432 1358 : if (!awd) A = mkmat22(a, b, gen_0, d);
11433 : else
11434 : { /* rescale and update w from [a,0; 0,d] */
11435 : long ns;
11436 455 : Qtoss(awd, &ns, &w); /* update w */
11437 455 : V = bdexpand(V, ns);
11438 455 : if (!gequal0(al))
11439 : {
11440 0 : GEN adal = gmul(ad, al), sh = gfloor(adal);
11441 0 : al = gsub(adal, sh);
11442 0 : V = RgV_shift(V, sh);
11443 : }
11444 455 : A = matid(2);
11445 : }
11446 1358 : if (params) *params = mkvec3(al, utoipos(w), A);
11447 1358 : return gc_all(av,params?2:1,&V,params);
11448 : }
11449 :
11450 : /**************************************************************/
11451 : /* Alternative method for 1/2-integral weight */
11452 : /**************************************************************/
11453 : static GEN
11454 273 : mf2basis(long N, long r, GEN CHI, GEN *pCHI1, long space)
11455 : {
11456 : GEN CHI1, CHI2, mf1, mf2, B1, B2, BT, M1, M2, M, M2i, T, Th, v, den;
11457 273 : long sb, N2, o1, o2, k1 = r + 1;
11458 :
11459 273 : if (odd(k1))
11460 : {
11461 161 : CHI1 = mfcharmul(CHI, get_mfchar(stoi(-4)));
11462 161 : CHI2 = mfcharmul(CHI, get_mfchar(stoi(-8)));
11463 : }
11464 : else
11465 : {
11466 112 : CHI1 = CHI;
11467 112 : CHI2 = mfcharmul(CHI, get_mfchar(utoi(8)));
11468 : }
11469 273 : mf1 = mfinit_Nkchi(N, k1, CHI1, space, 1);
11470 273 : if (pCHI1) *pCHI1 = CHI1;
11471 273 : B1 = MF_get_basis(mf1); if (lg(B1) == 1) return cgetg(1,t_VEC);
11472 266 : N2 = ulcm(8, N);
11473 266 : mf2 = mfinit_Nkchi(N2, k1, CHI2, space, 1);
11474 266 : B2 = MF_get_basis(mf2); if (lg(B2) == 1) return cgetg(1,t_VEC);
11475 266 : sb = mfsturmNgk(N2, gaddsg(k1, ghalf));
11476 266 : M1 = mfcoefs_mf(mf1, sb, 1);
11477 266 : M2 = mfcoefs_mf(mf2, sb, 1);
11478 266 : Th = mfTheta(NULL);
11479 266 : BT = mfcoefs_i(Th, sb, 1);
11480 266 : M1 = mfmatsermul(M1, RgV_to_RgX(expandbd(BT,2),0));
11481 266 : M2 = mfmatsermul(M2, RgV_to_RgX(BT,0));
11482 266 : o1= mfcharorder(CHI1);
11483 266 : T = (o1 <= 2)? NULL: mfcharpol(CHI1);
11484 266 : if (o1 > 2) M1 = liftpol_shallow(M1);
11485 266 : o2= mfcharorder(CHI2);
11486 266 : if (T)
11487 : {
11488 14 : if (o2 == o1) M2 = liftpol_shallow(M2);
11489 : else
11490 : {
11491 0 : GEN tr = Qab_trace_init(o2, o1, mfcharpol(CHI2), mfcharpol(CHI1));
11492 0 : M2 = QabM_tracerel(tr, 0, M2);
11493 : }
11494 : }
11495 : /* now everything is defined mod T = mfcharpol(CHI1) */
11496 266 : M2i = QabM_pseudoinv_i(M2, T, o1, &v, &den);
11497 266 : M = RgM_mul(M2i, rowpermute(M1, gel(v,1)));
11498 266 : M = RgM_mul(M2, M);
11499 266 : M1 = RgM_Rg_mul(M1, den);
11500 266 : M = RgM_sub(M1, M); if (T) M = RgXQM_red(M, T);
11501 266 : return vecmflineardiv0(B1, QabM_ker(M, T, o1), Th);
11502 : }
11503 :
11504 : /*******************************************************************/
11505 : /* Integration */
11506 : /*******************************************************************/
11507 : static GEN
11508 490 : vanembed(GEN F, GEN v, long prec)
11509 : {
11510 490 : GEN CHI = mf_get_CHI(F);
11511 490 : long o = mfcharorder(CHI);
11512 490 : if (o > 2 || degpol(mf_get_field(F)) > 1) v = liftpol_shallow(v);
11513 490 : if (o > 2) v = gsubst(v, varn(mfcharpol(CHI)), rootsof1u_cx(o, prec));
11514 490 : return v;
11515 : }
11516 :
11517 : static long
11518 1253 : mfperiod_prelim_double(double t0, long k, long bitprec)
11519 : {
11520 1253 : double nlim, c = 2*M_PI*t0;
11521 1253 : nlim = ceil(bitprec * M_LN2 / c);
11522 1253 : c -= (k - 1)/(2*nlim); if (c < 1) c = 1.;
11523 1253 : nlim += ceil((0.7 + (k-1)/2*log(nlim))/c);
11524 1253 : return (long)nlim;
11525 : }
11526 : static long
11527 301 : mfperiod_prelim(GEN t0, long k, long bitprec)
11528 301 : { return mfperiod_prelim_double(gtodouble(t0), k, bitprec); }
11529 :
11530 : /* (-X)^(k-2) * P(-1/X) = (-1)^{k-2} P|_{k-2} S */
11531 : static GEN
11532 1288 : RgX_act_S(GEN P, long k)
11533 : {
11534 1288 : P = RgX_unscale(RgX_recipspec_shallow(P+2, lgpol(P), k-1), gen_m1);
11535 1288 : setvarn(P,0); return P;
11536 : }
11537 : static int
11538 2842 : RgX_act_typ(GEN P, long k)
11539 : {
11540 2842 : switch(typ(P))
11541 : {
11542 35 : case t_RFRAC: return t_RFRAC;
11543 2793 : case t_POL:
11544 2793 : if (varn(P) == 0)
11545 : {
11546 2758 : long d = degpol(P);
11547 2758 : if (d > k-2) return t_RFRAC;
11548 2604 : if (d) return t_POL;
11549 : }
11550 : }
11551 1211 : return 0;
11552 : }
11553 : static GEN
11554 2576 : act_S(GEN P, long k)
11555 : {
11556 : GEN X;
11557 2576 : switch(RgX_act_typ(P, k))
11558 : {
11559 140 : case t_RFRAC:
11560 140 : X = gneg(pol_x(0));
11561 140 : return gmul(gsubst(P, 0, ginv(X)), gpowgs(X, k - 2));
11562 1288 : case t_POL: return RgX_act_S(P, k);
11563 : }
11564 1148 : return P;
11565 : }
11566 :
11567 : static GEN
11568 203 : AX_B(GEN M)
11569 203 : { GEN A = gcoeff(M,1,1), B = gcoeff(M,1,2); return deg1pol_shallow(A,B,0); }
11570 : static GEN
11571 203 : CX_D(GEN M)
11572 203 : { GEN C = gcoeff(M,2,1), D = gcoeff(M,2,2); return deg1pol_shallow(C,D,0); }
11573 :
11574 : /* P|_{2-k}M = (CX+D)^{k-2}P((AX+B)/(CX+D)) */
11575 : static GEN
11576 154 : RgX_act_gen(GEN P, GEN M, long k)
11577 : {
11578 154 : GEN S = gen_0, PCD, PAB;
11579 : long i;
11580 154 : PCD = gpowers(CX_D(M), k-2);
11581 154 : PAB = gpowers(AX_B(M), k-2);
11582 833 : for (i = 0; i <= k-2; i++)
11583 : {
11584 679 : GEN t = RgX_coeff(P, i);
11585 679 : if (!gequal0(t)) S = gadd(S, gmul(t, gmul(gel(PCD, k-i-1), gel(PAB, i+1))));
11586 : }
11587 154 : return S;
11588 : }
11589 : static GEN
11590 266 : act_GL2(GEN P, GEN M, long k)
11591 : {
11592 266 : switch(RgX_act_typ(P, k))
11593 : {
11594 49 : case t_RFRAC:
11595 : {
11596 49 : GEN AB = AX_B(M), CD = CX_D(M);
11597 49 : return gmul(gsubst(P, 0, gdiv(AB, CD)), gpowgs(CD, k - 2));
11598 : }
11599 154 : case t_POL: return RgX_act_gen(P, M, k);
11600 : }
11601 63 : return P;
11602 : }
11603 : static GEN
11604 7 : vecact_GL2(GEN x, GEN M, long k)
11605 21 : { pari_APPLY_same(act_GL2(gel(x,i), M, k)); }
11606 :
11607 : static GEN
11608 1631 : RgX_approx(GEN x, long bit)
11609 8267 : { pari_APPLY_pol_normalized(Rg_approx(gel(x,i),bit)); }
11610 :
11611 : /* not GC clean */
11612 : static GEN
11613 2898 : normalizeapprox(GEN x, long bit)
11614 : {
11615 2898 : GEN D = NULL;
11616 2954 : if (is_vec_t(typ(x))) pari_APPLY_same(normalizeapprox(gel(x,i), bit));
11617 2870 : if (typ(x) == t_RFRAC && varn(gel(x,2)) == 0) { D = gel(x,2); x = gel(x,1); }
11618 2870 : if (typ(x) == t_POL && varn(x) == 0)
11619 : {
11620 2807 : if (lg(x) == 3)
11621 1176 : x = Rg_approx(gel(x,2), bit);
11622 : else
11623 1631 : x = RgX_approx(x, bit);
11624 : }
11625 2870 : return D? gdiv(x, D): x;
11626 : }
11627 :
11628 : /* make sure T is a t_POL in variable 0 */
11629 : static GEN
11630 2863 : toRgX0(GEN T)
11631 2863 : { return typ(T) == t_POL && varn(T) == 0? T: scalarpol_shallow(T,0); }
11632 :
11633 : /* integrate by summing nlim+1 terms of van [may be < lg(van)]
11634 : * van can be an expansion with vector coefficients
11635 : * \int_A^oo \sum_n van[n] * q^(n/w + al) * P(z-A) dz, q = e(z) */
11636 : static GEN
11637 945 : intAoo(GEN van, long nlim, GEN al, long w, GEN P, GEN A, long k, long prec)
11638 : {
11639 : GEN alw, P1, piI2A, q, S, van0;
11640 945 : long n, vz = varn(gel(P,2));
11641 :
11642 945 : if (nlim < 1) nlim = 1;
11643 945 : alw = gmulsg(w, al);
11644 945 : P1 = RgX_Rg_translate(P, gneg(A));
11645 945 : piI2A = gmul(PiI2n(1, prec), A);
11646 945 : q = gexp(gdivgu(piI2A, w), prec);
11647 945 : S = gen_0;
11648 121674 : for (n = nlim; n >= 1; n--)
11649 : {
11650 120729 : GEN t = gsubst(P1, vz, gdivsg(w, gaddsg(n, alw)));
11651 120729 : S = gadd(gmul(gel(van, n+1), t), gmul(q, S));
11652 : }
11653 945 : S = gmul(q, S);
11654 945 : van0 = gel(van, 1);
11655 945 : if (!gequal0(al))
11656 : {
11657 42 : S = gadd(S, gmul(gsubst(P1, vz, ginv(al)), van0));
11658 42 : S = gmul(S, gexp(gmul(piI2A, al), prec));
11659 : }
11660 903 : else if (!gequal0(van0))
11661 231 : S = gsub(S, gdivgu(gmul(van0, gpowgs(gsub(pol_x(0), A), k-1)), k-1));
11662 945 : if (is_vec_t(typ(S)))
11663 : {
11664 637 : long j, l = lg(S);
11665 3192 : for (j = 1; j < l; j++) gel(S,j) = toRgX0(gel(S,j));
11666 : }
11667 : else
11668 308 : S = toRgX0(S);
11669 945 : return gneg(S);
11670 : }
11671 :
11672 : /* \sum_{j <= k} X^j * (Y / (2I\pi))^{k+1-j} k! / j! */
11673 : static GEN
11674 259 : get_P(long k, long v, long prec)
11675 : {
11676 259 : GEN a, S = cgetg(k + 1, t_POL), u = invr(Pi2n(1, prec+EXTRAPREC64));
11677 259 : long j, K = k-2;
11678 259 : S[1] = evalsigne(1)|evalvarn(0); a = u;
11679 259 : gel(S,K+2) = monomial(mulcxpowIs(a,3), 1, v); /* j = K */
11680 1176 : for(j = K-1; j >= 0; j--)
11681 : {
11682 917 : a = mulrr(mulru(a,j+1), u);
11683 917 : gel(S,j+2) = monomial(mulcxpowIs(a,3*(K+1-j)), K+1-j, v);
11684 : }
11685 259 : return S;
11686 : }
11687 :
11688 : static GEN
11689 2555 : getw1w2(long N, GEN ga)
11690 2555 : { return mkvecsmall2(mfZC_width(N, gel(ga,1)),
11691 2555 : mfZC_width(N, gel(ga,2))); }
11692 :
11693 : static GEN
11694 147 : intAoowithvanall(GEN mf, GEN vanall, GEN P, GEN cosets, long bitprec)
11695 : {
11696 147 : GEN vvan = gel(vanall,1), vaw = gel(vanall,2), W1W2, resall;
11697 147 : long prec = nbits2prec(bitprec), N, k, lco, j;
11698 :
11699 147 : N = MF_get_N(mf); k = MF_get_k(mf);
11700 147 : lco = lg(cosets);
11701 147 : W1W2 = cgetg(lco, t_VEC); resall = cgetg(lco, t_VEC);
11702 2702 : for (j = 1; j < lco; j++) gel(W1W2,j) = getw1w2(N, gel(cosets, j));
11703 2702 : for (j = 1; j < lco; j++)
11704 : {
11705 2555 : GEN w1w2j = gel(W1W2,j), alj, M, VAN, RES, AR, Q;
11706 : long jq, c, w1, w2, w;
11707 2555 : if (!w1w2j) continue;
11708 637 : alj = gel(vaw,j);
11709 637 : w1 = w1w2j[1]; Q = cgetg(lco, t_VECSMALL);
11710 637 : w2 = w1w2j[2]; M = cgetg(lco, t_COL);
11711 8267 : for (c = 1, jq = j; jq < lco; jq++)
11712 : {
11713 7630 : GEN W = gel(W1W2, jq);
11714 7630 : if (jq == j || (W && gequal(W, w1w2j) && gequal(gel(vaw, jq), alj)))
11715 : {
11716 2555 : Q[c] = jq; gel(W1W2, jq) = NULL;
11717 2555 : gel(M, c) = gel(vvan, jq); c++;
11718 : }
11719 : }
11720 637 : setlg(M,c); VAN = shallowmatconcat(M);
11721 637 : AR = mkcomplex(gen_0, sqrtr_abs(divru(utor(w1, prec+EXTRAPREC64), w2)));
11722 637 : w = itos(gel(alj,2));
11723 637 : RES = intAoo(VAN, lg(VAN)-2, gel(alj,1),w, P, AR, k, prec);
11724 3192 : for (jq = 1; jq < c; jq++) gel(resall, Q[jq]) = gel(RES, jq);
11725 : }
11726 147 : return resall;
11727 : }
11728 :
11729 : GEN
11730 539 : mftobasisES(GEN mf, GEN F)
11731 : {
11732 539 : GEN v = mftobasis(mf, F, 0);
11733 532 : long nE = lg(MF_get_E(mf))-1;
11734 532 : return mkvec2(vecslice(v,1,nE), vecslice(v,nE+1,lg(v)-1));
11735 : }
11736 :
11737 : static long
11738 0 : wt1mulcond(GEN F, long D, long space)
11739 : {
11740 0 : GEN E = mfeisenstein_i(1, mfchartrivial(), get_mfchar(stoi(D))), mf;
11741 0 : F = mfmul(F, E);
11742 0 : mf = mfinit_Nkchi(mf_get_N(F), mf_get_k(F), mf_get_CHI(F), space, 0);
11743 0 : return mfconductor(mf, F);
11744 : }
11745 : static int
11746 7 : wt1newlevel(long N)
11747 : {
11748 7 : GEN P = gel(myfactoru(N),1);
11749 7 : long l = lg(P), i;
11750 14 : for (i = 1; i < l; i++)
11751 7 : if (!wt1empty(N/P[i])) return 0;
11752 7 : return 1;
11753 : }
11754 : long
11755 175 : mfconductor(GEN mf, GEN F)
11756 : {
11757 175 : pari_sp av = avma;
11758 : GEN gk;
11759 : long space, N, M;
11760 :
11761 175 : mf = checkMF(mf);
11762 175 : if (!checkmf_i(F)) pari_err_TYPE("mfconductor",F);
11763 175 : if (mfistrivial(F)) return 1;
11764 175 : space = MF_get_space(mf);
11765 175 : if (space == mf_NEW) return mf_get_N(F);
11766 175 : gk = MF_get_gk(mf);
11767 175 : if (isint1(gk))
11768 : {
11769 7 : N = mf_get_N(F);
11770 7 : if (!wt1newlevel(N))
11771 : {
11772 0 : long s = space_is_cusp(space)? mf_CUSP: mf_FULL;
11773 0 : N = ugcd(N, wt1mulcond(F,-3,s));
11774 0 : if (!wt1newlevel(N)) N = ugcd(N, wt1mulcond(F,-4,s));
11775 : }
11776 7 : return gc_long(av,N);
11777 : }
11778 168 : if (typ(gk) != t_INT)
11779 : {
11780 42 : F = mfmultheta(F);
11781 42 : mf = obj_checkbuild(mf, MF_MF2INIT, &mf2init); /* mf_FULL */
11782 : }
11783 168 : N = 1;
11784 168 : if (space_is_cusp(space))
11785 : {
11786 7 : F = mftobasis_i(mf, F);
11787 7 : if (typ(gk) != t_INT) F = vecslice(F, lg(MF_get_E(mf)), lg(F) - 1);
11788 : }
11789 : else
11790 : {
11791 161 : GEN EF = mftobasisES(mf, F), vE = gel(EF,1), B = MF_get_E(mf);
11792 161 : long i, l = lg(B);
11793 1267 : for (i = 1; i < l; i++)
11794 1106 : if (!gequal0(gel(vE,i))) N = ulcm(N, mf_get_N(gel(B, i)));
11795 161 : F = gel(EF,2);
11796 : }
11797 168 : (void)mftonew_i(mf, F, &M); /* M = conductor of cuspidal part */
11798 168 : return gc_long(av, ulcm(M, N));
11799 : }
11800 :
11801 : static GEN
11802 1463 : fs_get_MF(GEN fs) { return gel(fs,1); }
11803 : static GEN
11804 847 : fs_get_vES(GEN fs) { return gel(fs,2); }
11805 : static GEN
11806 1596 : fs_get_pols(GEN fs) { return gel(fs,3); }
11807 : static GEN
11808 2191 : fs_get_cosets(GEN fs) { return gel(fs,4); }
11809 : static long
11810 630 : fs_get_bitprec(GEN fs) { return itou(gel(fs,5)); }
11811 : static GEN
11812 1246 : fs_get_vE(GEN fs) { return gel(fs,6); }
11813 : static GEN
11814 70 : fs_get_EF(GEN fs) { return gel(fs,7); }
11815 : static GEN
11816 1890 : fs_get_expan(GEN fs) { return gel(fs,8); }
11817 : static GEN
11818 28 : fs_set_expan(GEN fs, GEN vanall)
11819 28 : { GEN f = shallowcopy(fs); gel(f,8) = vanall; return f; }
11820 : static int
11821 49 : mfs_checkmf(GEN fs, GEN mf)
11822 49 : { GEN mfF = fs_get_MF(fs); return gequal(gel(mfF,1), gel(mf,1)); }
11823 : static long
11824 798 : checkfs_i(GEN v)
11825 798 : { return typ(v) == t_VEC && lg(v) == 9 && checkMF_i(fs_get_MF(v))
11826 567 : && typ(fs_get_vES(v)) == t_VEC
11827 567 : && typ(fs_get_pols(v)) == t_VEC
11828 567 : && typ(fs_get_cosets(v)) == t_VEC
11829 567 : && typ(fs_get_vE(v)) == t_VEC
11830 567 : && lg(fs_get_pols(v)) == lg(fs_get_cosets(v))
11831 567 : && typ(fs_get_expan(v)) == t_VEC
11832 567 : && lg(fs_get_expan(v)) == 3
11833 567 : && lg(gel(fs_get_expan(v), 1)) == lg(fs_get_cosets(v))
11834 1596 : && typ(gel(v,5)) == t_INT; }
11835 : GEN
11836 19292 : checkMF_i(GEN mf)
11837 : {
11838 19292 : long l = lg(mf);
11839 : GEN v;
11840 19292 : if (typ(mf) != t_VEC) return NULL;
11841 19264 : if (l == 9) return checkMF_i(fs_get_MF(mf));
11842 19264 : if (l != 7) return NULL;
11843 7980 : v = gel(mf,1);
11844 7980 : if (typ(v) != t_VEC || lg(v) != 5) return NULL;
11845 7980 : return (typ(gel(v,1)) == t_INT
11846 7980 : && typ(gmul2n(gel(v,2), 1)) == t_INT
11847 7980 : && typ(gel(v,3)) == t_VEC
11848 15960 : && typ(gel(v,4)) == t_INT)? mf: NULL; }
11849 : GEN
11850 4228 : checkMF(GEN T)
11851 : {
11852 4228 : GEN mf = checkMF_i(T);
11853 4228 : if (!mf) pari_err_TYPE("checkMF [please use mfinit]", T);
11854 4228 : return mf;
11855 : }
11856 :
11857 : /* c,d >= 0; c * Nc = N, find coset whose image in P1(Z/NZ) ~ (c, d + k(N/c)) */
11858 : static GEN
11859 11963 : coset_complete(long c, long d, long Nc)
11860 : {
11861 : long a, b;
11862 13307 : while (ugcd(c, d) > 1) d += Nc;
11863 11963 : (void)cbezout(c, d, &b, &a);
11864 11963 : return mkmat22s(a, -b, c, d);
11865 : }
11866 : /* right cosets of $\G_0(N)$: $\G=\bigsqcup_j \G_0(N)\ga_j$. */
11867 : /* We choose them with c\mid N and d mod N/c, not the reverse */
11868 : GEN
11869 168 : mfcosets(GEN gN)
11870 : {
11871 168 : pari_sp av = avma;
11872 : GEN V, D, mf;
11873 168 : long l, i, ct, N = 0;
11874 168 : if (typ(gN) == t_INT) N = itos(gN);
11875 14 : else if ((mf = checkMF_i(gN))) N = MF_get_N(mf);
11876 7 : else pari_err_TYPE("mfcosets", gN);
11877 161 : if (N <= 0) pari_err_DOMAIN("mfcosets", "N", "<=", gen_0, stoi(N));
11878 161 : V = cgetg(mypsiu(N) + 1, t_VEC);
11879 161 : D = mydivisorsu(N); l = lg(D);
11880 588 : for (i = ct = 1; i < l; i++)
11881 : {
11882 427 : long d, c = D[i], Nc = D[l-i], e = ugcd(Nc, c);
11883 3332 : for (d = 0; d < Nc; d++)
11884 2905 : if (ugcd(d,e) == 1) gel(V, ct++) = coset_complete(c, d, Nc);
11885 : }
11886 161 : return gc_GEN(av, V);
11887 : }
11888 : static int
11889 35469 : cmp_coset(void *E, GEN A, GEN B)
11890 : {
11891 35469 : ulong N = (ulong)E, Nc, c = itou(gcoeff(A,2,1));
11892 35469 : int r = cmpuu(c, itou(gcoeff(B,2,1)));
11893 35469 : if (r) return r;
11894 30660 : Nc = N / c;
11895 30660 : return cmpuu(umodiu(gcoeff(A,2,2), Nc), umodiu(gcoeff(B,2,2), Nc));
11896 : }
11897 : /* M in SL_2(Z) */
11898 : static long
11899 9198 : mftocoset_i(ulong N, GEN M, GEN cosets)
11900 : {
11901 9198 : pari_sp av = avma;
11902 9198 : long A = itos(gcoeff(M,1,1)), c, u, v, Nc, i;
11903 9198 : long C = itos(gcoeff(M,2,1)), D = itos(gcoeff(M,2,2));
11904 : GEN ga;
11905 9198 : c = cbezout(N*A, C, &u, &v); Nc = N/c;
11906 9198 : ga = coset_complete(c, umodsu(v*D, Nc), Nc);
11907 9198 : i = gen_search(cosets, ga, (void*)N, &cmp_coset);
11908 9198 : if (i < 0) pari_err_BUG("mftocoset [no coset found]");
11909 9198 : return gc_long(av,i);
11910 : }
11911 : /* (U * V^(-1))[2,2] mod N, assuming V in SL2(Z) */
11912 : static long
11913 9177 : SL2_div_D(ulong N, GEN U, GEN V)
11914 : {
11915 9177 : long c = umodiu(gcoeff(U,2,1), N), d = umodiu(gcoeff(U,2,2), N);
11916 9177 : long a2 = umodiu(gcoeff(V,1,1), N), b2 = umodiu(gcoeff(V,1,2), N);
11917 9177 : return (a2*d - b2*c) % (long)N;
11918 : }
11919 : static long
11920 9177 : mftocoset_iD(ulong N, GEN M, GEN cosets, long *D)
11921 : {
11922 9177 : long i = mftocoset_i(N, M, cosets);
11923 9177 : *D = SL2_div_D(N, M, gel(cosets,i)); return i;
11924 : }
11925 : GEN
11926 7 : mftocoset(ulong N, GEN M, GEN cosets)
11927 : {
11928 : long i;
11929 7 : if (!check_SL2Z(M)) pari_err_TYPE("mftocoset",M);
11930 7 : i = mftocoset_i(N, M, cosets);
11931 7 : retmkvec2(gdiv(M,gel(cosets,i)), utoipos(i));
11932 : }
11933 :
11934 : static long
11935 2555 : getnlim2(long N, long w1, long w2, long nlim, long k, long bitprec)
11936 : {
11937 2555 : if (w2 == N) return nlim;
11938 483 : return mfperiod_prelim_double(1./sqrt((double)w1*w2), k, bitprec + 32);
11939 : }
11940 :
11941 : /* g * S, g 2x2 */
11942 : static GEN
11943 1337 : ZM_mulS(GEN g)
11944 1337 : { return mkmat2(gel(g,2), ZC_neg(gel(g,1))); }
11945 : /* g * T, g 2x2 */
11946 : static GEN
11947 4634 : ZM_mulT(GEN g)
11948 4634 : { return mkmat2(gel(g,1), ZC_add(gel(g,2), gel(g,1))); }
11949 : /* g * T^(-1), g 2x2 */
11950 : static GEN
11951 2352 : ZM_mulTi(GEN g)
11952 2352 : { return mkmat2(gel(g,1), ZC_sub(gel(g,2), gel(g,1))); }
11953 :
11954 : /* Compute all slashexpansions for all cosets */
11955 : static GEN
11956 175 : mfgaexpansionall(GEN mf, GEN FE, GEN cosets, double height, long prec)
11957 : {
11958 175 : GEN CHI = MF_get_CHI(mf), vres, vresaw;
11959 175 : long lco, j, k = MF_get_k(mf), N = MF_get_N(mf), bitprec = prec2nbits(prec);
11960 :
11961 175 : lco = lg(cosets);
11962 175 : vres = const_vec(lco-1, NULL);
11963 175 : vresaw = cgetg(lco, t_VEC);
11964 2912 : for (j = 1; j < lco; j++) if (!gel(vres,j))
11965 : {
11966 455 : GEN ga = gel(cosets, j), van, aw, al, z, gai;
11967 455 : long w1 = mfZC_width(N, gel(ga,1));
11968 455 : long w2 = mfZC_width(N, gel(ga,2));
11969 : long nlim, nlim2, daw, da, na, i;
11970 455 : double sqNinvdbl = height ? height/w1 : 1./sqrt((double)w1*N);
11971 455 : nlim = mfperiod_prelim_double(sqNinvdbl, k, bitprec + 32);
11972 455 : van = mfslashexpansion(mf, FE, ga, nlim, 0, &aw, prec + EXTRAPREC64);
11973 455 : van = vanembed(gel(FE, 1), van, prec + EXTRAPREC64);
11974 455 : al = gel(aw, 1);
11975 455 : nlim2 = height? nlim: getnlim2(N, w1, w2, nlim, k, bitprec);
11976 455 : gel(vres, j) = vecslice(van, 1, nlim2 + 1);
11977 455 : gel(vresaw, j) = aw;
11978 455 : Qtoss(al, &na, &da); daw = da*w1;
11979 455 : z = rootsof1powinit(1, daw, prec + EXTRAPREC64);
11980 455 : gai = ga;
11981 2737 : for (i = 1; i < w1; i++)
11982 : {
11983 : GEN V, coe;
11984 2282 : long Di, n, ind, w2, s = ((i*na) % da) * w1, t = i*da;
11985 2282 : gai = ZM_mulT(gai);
11986 2282 : ind = mftocoset_iD(N, gai, cosets, &Di);
11987 2282 : w2 = mfZC_width(N, gel(gel(cosets,ind), 2));
11988 2282 : nlim2 = height? nlim: getnlim2(N, w1, w2, nlim, k, bitprec);
11989 2282 : gel(vresaw, ind) = aw;
11990 2282 : V = cgetg(nlim2 + 2, t_VEC);
11991 909034 : for (n = 0; n <= nlim2; n++, s = Fl_add(s, t, daw))
11992 906752 : gel(V, n+1) = gmul(gel(van, n+1), rootsof1pow(z, s));
11993 2282 : coe = mfcharcxeval(CHI, Di, prec + EXTRAPREC64);
11994 2282 : if (!gequal1(coe)) V = RgV_Rg_mul(V, conj_i(coe));
11995 2282 : gel(vres, ind) = V;
11996 : }
11997 : }
11998 175 : return mkvec2(vres, vresaw);
11999 : }
12000 :
12001 : /* Compute all period pols of F|_k\ga_j, vF = mftobasis(F_S) */
12002 : static GEN
12003 168 : mfperiodpols_i(GEN mf, GEN FE, GEN cosets, GEN vanall, long bit)
12004 : {
12005 168 : long N, i, prec = nbits2prec(bit), k = MF_get_k(mf);
12006 168 : GEN vP, P, CHI, intall = gen_0;
12007 :
12008 168 : if (k == 0 && gequal0(gel(FE,2)))
12009 0 : return cosets? const_vec(lg(cosets)-1, pol_0(0)): pol_0(0);
12010 168 : N = MF_get_N(mf);
12011 168 : CHI = MF_get_CHI(mf);
12012 168 : P = get_P(k, fetch_var(), prec);
12013 168 : if (!cosets)
12014 : { /* ga = id */
12015 21 : long nlim, PREC = prec + EXTRAPREC64;
12016 21 : GEN F = gel(FE,1), sqNinv = invr(sqrtr_abs(utor(N, PREC))); /* A/w */
12017 : GEN AR, v, van, T1, T2;
12018 :
12019 21 : nlim = mfperiod_prelim(sqNinv, k, bit + 32);
12020 : /* F|id: al = 0, w = 1 */
12021 21 : v = mfcoefs_i(F, nlim, 1);
12022 21 : van = vanembed(F, v, PREC);
12023 21 : AR = mkcomplex(gen_0, sqNinv);
12024 21 : T1 = intAoo(van, nlim, gen_0,1, P, AR, k, prec);
12025 21 : if (N == 1) T2 = T1;
12026 : else
12027 : { /* F|S: al = 0, w = N */
12028 7 : v = mfgaexpansion(mf, FE, mkS(), nlim, PREC);
12029 7 : van = vanembed(F, gel(v,3), PREC);
12030 7 : AR = mkcomplex(gen_0, mulur(N,sqNinv));
12031 7 : T2 = intAoo(van, nlim, gen_0,N, P, AR, k, prec);
12032 : }
12033 21 : T1 = gsub(T1, act_S(T2, k));
12034 21 : T1 = normalizeapprox(T1, bit-20);
12035 21 : vP = gprec_wtrunc(T1, prec);
12036 : }
12037 : else
12038 : {
12039 147 : long lco = lg(cosets);
12040 147 : intall = intAoowithvanall(mf, vanall, P, cosets, bit);
12041 147 : vP = const_vec(lco-1, NULL);
12042 2702 : for (i = 1; i < lco; i++)
12043 : {
12044 2555 : GEN P, P1, P2, c, ga = gel(cosets, i);
12045 : long iS, DS;
12046 2646 : if (gel(vP,i)) continue;
12047 1323 : P1 = gel(intall, i);
12048 1323 : iS = mftocoset_iD(N, ZM_mulS(ga), cosets, &DS);
12049 1323 : c = mfcharcxeval(CHI, DS, prec + EXTRAPREC64);
12050 1323 : P2 = gel(intall, iS);
12051 :
12052 1323 : P = act_S(isint1(c)? P2: gmul(c, P2), k);
12053 1323 : P = normalizeapprox(gsub(P1, P), bit-20);
12054 1323 : gel(vP,i) = gprec_wtrunc(P, prec);
12055 1323 : if (iS == i) continue;
12056 :
12057 1232 : P = act_S(isint1(c)? P1: gmul(conj_i(c), P1), k);
12058 1232 : if (!odd(k)) P = gneg(P);
12059 1232 : P = normalizeapprox(gadd(P, P2), bit-20);
12060 1232 : gel(vP,iS) = gprec_wtrunc(P, prec);
12061 : }
12062 : }
12063 168 : delete_var(); return vP;
12064 : }
12065 :
12066 : /* when cosets = NULL, return a "fake" symbol containing only fs(oo->0) */
12067 : static GEN
12068 168 : mfsymbol_i(GEN mf, GEN F, GEN cosets, long bit)
12069 : {
12070 168 : GEN FE, van, vP, vE, Mvecj, vES = mftobasisES(mf,F);
12071 168 : long precnew, prec = nbits2prec(bit), k = MF_get_k(mf);
12072 168 : vE = mfgetembed(F, prec);
12073 168 : Mvecj = obj_checkbuild(mf, MF_EISENSPACE, &mfeisensteinspaceinit);
12074 168 : if (lg(Mvecj) >= 5) precnew = prec;
12075 : else
12076 : {
12077 14 : long N = MF_get_N(mf), n = mfperiod_prelim_double(1/(double)N, k, bit + 32);
12078 14 : precnew = prec + inveis_extraprec(N, mkS(), Mvecj, n);
12079 : }
12080 168 : FE = mkcol2(F, mf_eisendec(mf,F,precnew));
12081 168 : van = cosets? mfgaexpansionall(mf, FE, cosets, 0, prec): NULL;
12082 168 : vP = mfperiodpols_i(mf, FE, cosets, van, bit);
12083 168 : return mkvecn(8, mf, vES, vP, cosets, utoi(bit), vE, FE, van);
12084 : }
12085 :
12086 : static GEN
12087 56 : fs2_get_cusps(GEN f) { return gel(f,3); }
12088 : static GEN
12089 56 : fs2_get_MF(GEN f) { return gel(f,1); }
12090 : static GEN
12091 56 : fs2_get_W(GEN f) { return gel(f,2); }
12092 : static GEN
12093 56 : fs2_get_F(GEN f) { return gel(f,4); }
12094 : static long
12095 0 : fs2_get_bitprec(GEN f) { return itou(gel(f,5)); }
12096 : static GEN
12097 56 : fs2_get_al0(GEN f) { return gel(f,6); }
12098 : static GEN
12099 21 : fs2_get_den(GEN f) { return gel(f,7); }
12100 : static int
12101 210 : checkfs2_i(GEN f)
12102 : {
12103 : GEN W, C, F, al0;
12104 : long l;
12105 210 : if (typ(f) != t_VEC || lg(f) != 8 || typ(gel(f,5)) != t_INT) return 0;
12106 35 : C = fs2_get_cusps(f); l = lg(C);
12107 35 : W = fs2_get_W(f);
12108 35 : F = fs2_get_F(f);
12109 35 : al0 = fs2_get_al0(f);
12110 35 : return checkMF_i(fs2_get_MF(f))
12111 35 : && typ(W) == t_VEC && typ(F) == t_VEC && typ(al0) == t_VECSMALL
12112 70 : && lg(W) == l && lg(F) == l && lg(al0) == l;
12113 : }
12114 : static GEN fs2_init(GEN mf, GEN F, long bit);
12115 : GEN
12116 175 : mfsymbol(GEN mf, GEN F, long bit)
12117 : {
12118 175 : pari_sp av = avma;
12119 175 : GEN cosets = NULL;
12120 175 : if (!F)
12121 : {
12122 35 : F = mf;
12123 35 : if (!checkmf_i(F)) pari_err_TYPE("mfsymbol", F);
12124 35 : mf = mfinit_i(F, mf_FULL);
12125 : }
12126 140 : else if (!checkmf_i(F)) pari_err_TYPE("mfsymbol", F);
12127 175 : if (checkfs2_i(mf)) return fs2_init(mf, F, bit);
12128 175 : if (checkfs_i(mf))
12129 : {
12130 0 : cosets = fs_get_cosets(mf);
12131 0 : mf = fs_get_MF(mf);
12132 : }
12133 175 : else if (checkMF_i(mf))
12134 : {
12135 175 : GEN gk = MF_get_gk(mf);
12136 175 : if (typ(gk) != t_INT || equali1(gk)) return fs2_init(mf, F, bit);
12137 154 : if (signe(gk) <= 0) pari_err_TYPE("mfsymbol [k <= 0]", mf);
12138 147 : cosets = mfcosets(MF_get_gN(mf));
12139 : }
12140 0 : else pari_err_TYPE("mfsymbol",mf);
12141 147 : return gc_GEN(av, mfsymbol_i(mf, F, cosets, bit));
12142 : }
12143 :
12144 : static GEN
12145 14 : RgX_by_parity(GEN P, long odd)
12146 : {
12147 14 : long i, l = lg(P);
12148 : GEN Q;
12149 14 : if (l < 4) return odd ? pol_x(0): P;
12150 14 : Q = cgetg(l, t_POL); Q[1] = P[1];
12151 91 : for (i = odd? 2: 3; i < l; i += 2) gel(Q,i) = gen_0;
12152 91 : for (i = odd? 3: 2; i < l; i += 2) gel(Q,i) = gel(P,i);
12153 14 : return normalizepol_lg(Q, l);
12154 : }
12155 : /* flag 0: period polynomial of F, >0 or <0 with corresponding parity */
12156 : GEN
12157 35 : mfperiodpol(GEN mf0, GEN F, long flag, long bit)
12158 : {
12159 35 : pari_sp av = avma;
12160 35 : GEN pol, mf = checkMF_i(mf0);
12161 35 : if (!mf) pari_err_TYPE("mfperiodpol",mf0);
12162 35 : if (checkfs_i(F))
12163 : {
12164 14 : GEN mfpols = fs_get_pols(F);
12165 14 : if (!mfs_checkmf(F, mf)) pari_err_TYPE("mfperiodpol [different mf]",F);
12166 14 : pol = veclast(mfpols); /* trivial coset is last */
12167 : }
12168 : else
12169 : {
12170 21 : GEN gk = MF_get_gk(mf);
12171 21 : if (typ(gk) != t_INT) pari_err_TYPE("mfperiodpol [half-integral k]", mf);
12172 21 : if (equali1(gk)) pari_err_TYPE("mfperiodpol [k = 1]", mf);
12173 21 : F = mfsymbol_i(mf, F, NULL, bit);
12174 21 : pol = fs_get_pols(F);
12175 : }
12176 35 : if (flag) pol = RgX_by_parity(pol, flag < 0);
12177 35 : return gc_GEN(av, RgX_embedall(pol, fs_get_vE(F)));
12178 : }
12179 :
12180 : static int
12181 35 : mfs_iscusp(GEN mfs) { return gequal0(gmael(mfs,2,1)); }
12182 : /* given cusps s1 and s2 (rationals or oo)
12183 : * compute $\int_{s1}^{s2}(X-\tau)^{k-2}F|_k\ga_j(\tau)\,d\tau$ */
12184 : /* If flag = 1, do not give an error message if divergent, but
12185 : give the rational function as result. */
12186 :
12187 : static GEN
12188 126 : col2cusp(GEN v)
12189 : {
12190 : GEN A, C;
12191 126 : if (lg(v) != 3 || !RgV_is_ZV(v)) pari_err_TYPE("col2cusp",v);
12192 126 : A = gel(v,1);
12193 126 : C = gel(v,2);
12194 126 : if (gequal0(C))
12195 : {
12196 0 : if (gequal0(A)) pari_err_TYPE("mfsymboleval", mkvec2(A, C));
12197 0 : return mkoo();
12198 : }
12199 126 : return gdiv(A, C);
12200 : }
12201 : /* g.oo */
12202 : static GEN
12203 112 : mat2cusp(GEN g) { return col2cusp(gel(g,1)); }
12204 :
12205 : static GEN
12206 7 : pathmattovec(GEN path)
12207 7 : { return mkvec2(col2cusp(gel(path,1)), col2cusp(gel(path,2))); }
12208 :
12209 : static void
12210 546 : get_mf_F(GEN fs, GEN *mf, GEN *F)
12211 : {
12212 546 : if (lg(fs) == 3) { *mf = gel(fs,1); *F = gel(fs,2); }
12213 546 : else { *mf = fs_get_MF(fs); *F = NULL; }
12214 546 : }
12215 : static GEN
12216 189 : mfgetvan(GEN fs, GEN ga, GEN *pal, long nlim, long prec)
12217 : {
12218 : GEN van, mf, F, W;
12219 : long PREC;
12220 189 : get_mf_F(fs, &mf, &F);
12221 189 : if (!F)
12222 : {
12223 189 : GEN vanall = fs_get_expan(fs), cosets = fs_get_cosets(fs);
12224 189 : long D, jga = mftocoset_iD(MF_get_N(mf), ga, cosets, &D);
12225 189 : van = gmael(vanall, 1, jga);
12226 189 : W = gmael(vanall, 2, jga);
12227 189 : if (lg(van) >= nlim + 2)
12228 : {
12229 182 : GEN z = mfcharcxeval(MF_get_CHI(mf), D, prec);
12230 182 : if (!gequal1(z)) van = RgV_Rg_mul(van, z);
12231 182 : *pal = gel(W,1); return van;
12232 : }
12233 7 : F = gel(fs_get_EF(fs), 1);
12234 : }
12235 7 : PREC = prec + EXTRAPREC64;
12236 7 : van = mfslashexpansion(mf, F, ga, nlim, 0, &W, PREC);
12237 7 : van = vanembed(F, van, PREC);
12238 7 : *pal = gel(W,1); return van;
12239 : }
12240 : /* Computation of int_A^oo (f | ga)(t)(X-t)^{k-2} dt, assuming convergence;
12241 : * fs is either a symbol or a triple [mf,F,bitprec]. A != oo and im(A) > 0 */
12242 : static GEN
12243 77 : intAoo0(GEN fs, GEN A, GEN ga, GEN P, long bit)
12244 : {
12245 77 : long nlim, N, k, w, prec = nbits2prec(bit);
12246 : GEN van, mf, F, al;
12247 77 : get_mf_F(fs, &mf,&F); N = MF_get_N(mf); k = MF_get_k(mf);
12248 77 : w = mfZC_width(N, gel(ga,1));
12249 77 : nlim = mfperiod_prelim(gdivgu(imag_i(A), w), k, bit + 32);
12250 77 : van = mfgetvan(fs, ga, &al, nlim, prec);
12251 77 : return intAoo(van, nlim, al,w, P, A, k, prec);
12252 : }
12253 :
12254 : /* fs symbol, naive summation, A != oo, im(A) > 0 and B = oo or im(B) > 0 */
12255 : static GEN
12256 112 : mfsymboleval_direct(GEN fs, GEN path, GEN ga, GEN P)
12257 : {
12258 112 : GEN A, B, van, S, al, mf = fs_get_MF(fs);
12259 112 : long w, nlimA, nlimB = 0, N = MF_get_N(mf), k = MF_get_k(mf);
12260 112 : long bit = fs_get_bitprec(fs), prec = nbits2prec(bit);
12261 :
12262 112 : A = gel(path, 1);
12263 112 : B = gel(path, 2); if (typ(B) == t_INFINITY) B = NULL;
12264 112 : w = mfZC_width(N, gel(ga,1));
12265 112 : nlimA = mfperiod_prelim(gdivgu(imag_i(A),w), k, bit + 32);
12266 112 : if (B) nlimB = mfperiod_prelim(gdivgu(imag_i(B),w), k, bit + 32);
12267 112 : van = mfgetvan(fs, ga, &al, maxss(nlimA,nlimB), prec);
12268 112 : S = intAoo(van, nlimA, al,w, P, A, k, prec);
12269 112 : if (B) S = gsub(S, intAoo(van, nlimB, al,w, P, B, k, prec));
12270 112 : return RgX_embedall(S, fs_get_vE(fs));
12271 : }
12272 :
12273 : /* Computation of int_A^oo (f | ga)(t)(X-t)^{k-2} dt, assuming convergence;
12274 : * fs is either a symbol or a pair [mf,F]. */
12275 : static GEN
12276 77 : mfsymbolevalpartial(GEN fs, GEN A, GEN ga, long bit)
12277 : {
12278 : GEN Y, F, S, P, mf;
12279 77 : long N, k, w, prec = nbits2prec(bit);
12280 :
12281 77 : get_mf_F(fs, &mf, &F);
12282 77 : N = MF_get_N(mf); w = mfZC_width(N, gel(ga,1));
12283 77 : k = MF_get_k(mf);
12284 77 : Y = gdivgu(imag_i(A), w);
12285 77 : P = get_P(k, fetch_var(), prec);
12286 77 : if (lg(fs) != 3 && gtodouble(Y)*(2*N) < 1)
12287 21 : { /* true symbol + low imaginary part: use GL_2 action to improve */
12288 21 : GEN U, ga2, czd, A2 = cxredga0N(N, A, &U, &czd, 1);
12289 21 : GEN vE = fs_get_vE(fs);
12290 21 : ga2 = ZM_mul(ga, ZM_inv(U, NULL));
12291 21 : S = RgX_embedall(intAoo0(fs, A2, ga2, P, bit), vE);
12292 21 : S = gsub(S, mfsymboleval(fs, mkvec2(mat2cusp(U), mkoo()), ga2, bit));
12293 21 : S = typ(S) == t_VEC? vecact_GL2(S, U, k): act_GL2(S, U, k);
12294 : }
12295 : else
12296 : {
12297 56 : S = intAoo0(fs, A, ga, P, bit);
12298 56 : S = RgX_embedall(S, F? mfgetembed(F,prec): fs_get_vE(fs));
12299 : }
12300 77 : delete_var(); return normalizeapprox(S, bit-20);
12301 : }
12302 :
12303 : static GEN
12304 42 : actal(GEN x, GEN vabd)
12305 : {
12306 42 : if (typ(x) == t_INFINITY) return x;
12307 35 : return gdiv(gadd(gmul(gel(vabd,1), x), gel(vabd,2)), gel(vabd,3));
12308 : }
12309 :
12310 : static GEN
12311 14 : unact(GEN z, GEN vabd, long k, long prec)
12312 : {
12313 14 : GEN res = gsubst(z, 0, actal(pol_x(0), vabd));
12314 14 : GEN CO = gpow(gdiv(gel(vabd,3), gel(vabd,1)), sstoQ(k-2, 2), prec);
12315 14 : return gmul(CO, res);
12316 : }
12317 :
12318 : GEN
12319 210 : mfsymboleval(GEN fs, GEN path, GEN ga, long bitprec)
12320 : {
12321 210 : pari_sp av = avma;
12322 210 : GEN tau, V, LM, S, CHI, mfpols, cosets, al, be, mf, F, vabd = NULL;
12323 : long D, B, m, u, v, a, b, c, d, j, k, N, prec, tsc1, tsc2;
12324 :
12325 210 : if (checkfs_i(fs))
12326 : {
12327 203 : get_mf_F(fs, &mf, &F);
12328 203 : bitprec = minss(bitprec, fs_get_bitprec(fs));
12329 : }
12330 : else
12331 : {
12332 7 : if (checkfs2_i(fs)) pari_err_TYPE("mfsymboleval [need integral k > 1]",fs);
12333 0 : if (typ(fs) != t_VEC || lg(fs) != 3) pari_err_TYPE("mfsymboleval",fs);
12334 0 : get_mf_F(fs, &mf, &F);
12335 0 : mf = checkMF_i(mf);
12336 0 : if (!mf ||!checkmf_i(F)) pari_err_TYPE("mfsymboleval",fs);
12337 : }
12338 203 : if (lg(path) != 3) pari_err_TYPE("mfsymboleval",path);
12339 203 : if (typ(path) == t_MAT) path = pathmattovec(path);
12340 203 : if (typ(path) != t_VEC) pari_err_TYPE("mfsymboleval",path);
12341 203 : al = gel(path,1);
12342 203 : be = gel(path,2);
12343 203 : ga = ga? GL2toSL2(ga, &vabd): matid(2);
12344 203 : if (vabd)
12345 : {
12346 14 : al = actal(al, vabd);
12347 14 : be = actal(be, vabd); path = mkvec2(al, be);
12348 : }
12349 203 : tsc1 = cusp_AC(al, &a, &c);
12350 203 : tsc2 = cusp_AC(be, &b, &d);
12351 203 : prec = nbits2prec(bitprec);
12352 203 : k = MF_get_k(mf);
12353 203 : if (!tsc1)
12354 : {
12355 42 : GEN z2, z = mfsymbolevalpartial(fs, al, ga, bitprec);
12356 42 : if (tsc2)
12357 28 : z2 = d? mfsymboleval(fs, mkvec2(be, mkoo()), ga, bitprec): gen_0;
12358 : else
12359 14 : z2 = mfsymbolevalpartial(fs, be, ga, bitprec);
12360 42 : z = gsub(z, z2);
12361 42 : if (vabd) z = unact(z, vabd, k, prec);
12362 42 : return gc_GEN(av, normalizeapprox(z, bitprec-20));
12363 : }
12364 161 : else if (!tsc2)
12365 : {
12366 21 : GEN z = mfsymbolevalpartial(fs, be, ga, bitprec);
12367 21 : if (c) z = gsub(mfsymboleval(fs, mkvec2(al, mkoo()), ga, bitprec), z);
12368 7 : else z = gneg(z);
12369 21 : if (vabd) z = unact(z, vabd, k, prec);
12370 21 : return gc_GEN(av, normalizeapprox(z, bitprec-20));
12371 : }
12372 140 : if (F) pari_err_TYPE("mfsymboleval", fs);
12373 140 : D = a*d-b*c;
12374 140 : if (!D) { set_avma(av); return RgX_embedall(gen_0, fs_get_vE(fs)); }
12375 126 : mfpols = fs_get_pols(fs);
12376 126 : cosets = fs_get_cosets(fs);
12377 126 : CHI = MF_get_CHI(mf); N = MF_get_N(mf);
12378 126 : cbezout(a, c, &u, &v); B = u*b + v*d; tau = mkmat22s(a, -v, c, u);
12379 126 : V = gcf(sstoQ(B, D));
12380 126 : LM = shallowconcat(mkcol2(gen_1, gen_0), contfracpnqn(V, lg(V)));
12381 126 : S = gen_0; m = lg(LM) - 2;
12382 364 : for (j = 0; j < m; j++)
12383 : {
12384 : GEN M, P;
12385 : long D, iN;
12386 238 : M = mkmat2(gel(LM, j+2), gel(LM, j+1));
12387 238 : if (!odd(j)) gel(M,1) = ZC_neg(gel(M,1));
12388 238 : M = ZM_mul(tau, M);
12389 238 : iN = mftocoset_iD(N, ZM_mul(ga, M), cosets, &D);
12390 238 : P = gmul(gel(mfpols,iN), mfcharcxeval(CHI,D,prec));
12391 238 : S = gadd(S, act_GL2(P, ZM_inv(M, NULL), k));
12392 : }
12393 126 : if (typ(S) == t_RFRAC)
12394 : {
12395 : GEN R, S1, co;
12396 21 : gel(S,2) = primitive_part(gel(S,2), &co);
12397 21 : if (co) gel(S,1) = gdiv(gel(S,1), gtofp(co,prec));
12398 21 : S1 = poldivrem(gel(S,1), gel(S,2), &R);
12399 21 : if (gexpo(R) < -bitprec + 20) S = S1;
12400 : }
12401 126 : if (vabd) S = unact(S, vabd, k, prec);
12402 126 : S = RgX_embedall(S, fs_get_vE(fs));
12403 126 : return gc_GEN(av, normalizeapprox(S, bitprec-20));
12404 : }
12405 :
12406 : /* v a scalar or t_POL; set *pw = a if expo(a) > E for some coefficient;
12407 : * take the 'a' with largest exponent */
12408 : static void
12409 4984 : improve(GEN v, GEN *pw, long *E)
12410 : {
12411 4984 : if (typ(v) != t_POL)
12412 : {
12413 4354 : long e = gexpo(v);
12414 4354 : if (e > *E) { *E = e; *pw = v; }
12415 : }
12416 : else
12417 : {
12418 630 : long j, l = lg(v);
12419 4144 : for (j = 2; j < l; j++) improve(gel(v,j), pw, E);
12420 : }
12421 4984 : }
12422 : static GEN
12423 518 : polabstorel(GEN rnfeq, GEN x)
12424 : {
12425 518 : if (typ(x) != t_POL) return x;
12426 3500 : pari_APPLY_pol_normalized(eltabstorel(rnfeq, gel(x,i)));
12427 : }
12428 : static GEN
12429 1519 : bestapprnfrel(GEN x, GEN polabs, GEN roabs, GEN rnfeq, long prec)
12430 : {
12431 1519 : x = bestapprnf(x, polabs, roabs, prec);
12432 1519 : if (rnfeq) x = polabstorel(rnfeq, liftpol_shallow(x));
12433 1519 : return x;
12434 : }
12435 : /* v vector of polynomials polynomial in C[X] (possibly scalar).
12436 : * Set *w = coeff with largest exponent and return T / *w, rationalized */
12437 : static GEN
12438 98 : normal(GEN v, GEN polabs, GEN roabs, GEN rnfeq, GEN *w, long prec)
12439 : {
12440 98 : long i, l = lg(v), E = -(long)HIGHEXPOBIT;
12441 : GEN dv;
12442 1568 : for (i = 1; i < l; i++) improve(gel(v,i), w, &E);
12443 98 : v = RgV_Rg_mul(v, ginv(*w));
12444 1568 : for (i = 1; i < l; i++)
12445 1470 : gel(v,i) = bestapprnfrel(gel(v,i), polabs,roabs,rnfeq,prec);
12446 98 : v = Q_primitive_part(v,&dv);
12447 98 : if (dv) *w = gmul(*w,dv);
12448 98 : return v;
12449 : }
12450 :
12451 : static GEN mfpetersson_i(GEN FS, GEN GS);
12452 :
12453 : GEN
12454 42 : mfmanin(GEN FS, long bitprec)
12455 : {
12456 42 : pari_sp av = avma;
12457 : GEN mf, M, vp, vm, cosets, CHI, vpp, vmm, f, T, P, vE, polabs, roabs, rnfeq;
12458 : GEN pet;
12459 : long N, k, lco, i, prec, lvE;
12460 :
12461 42 : if (!checkfs_i(FS))
12462 : {
12463 7 : if (checkfs2_i(FS)) pari_err_TYPE("mfmanin [need integral k > 1]",FS);
12464 0 : pari_err_TYPE("mfmanin",FS);
12465 : }
12466 35 : if (!mfs_iscusp(FS)) pari_err_TYPE("mfmanin [noncuspidal]",FS);
12467 35 : mf = fs_get_MF(FS);
12468 35 : vp = fs_get_pols(FS);
12469 35 : cosets = fs_get_cosets(FS);
12470 35 : bitprec = fs_get_bitprec(FS);
12471 35 : N = MF_get_N(mf); k = MF_get_k(mf); CHI = MF_get_CHI(mf);
12472 35 : lco = lg(cosets); vm = cgetg(lco, t_VEC);
12473 35 : prec = nbits2prec(bitprec);
12474 476 : for (i = 1; i < lco; i++)
12475 : {
12476 441 : GEN g = gel(cosets, i), c;
12477 441 : long A = itos(gcoeff(g,1,1)), B = itos(gcoeff(g,1,2));
12478 441 : long C = itos(gcoeff(g,2,1)), D = itos(gcoeff(g,2,2));
12479 441 : long Dbar, ibar = mftocoset_iD(N, mkmat22s(-B,-A,D,C), cosets, &Dbar);
12480 :
12481 441 : c = mfcharcxeval(CHI, Dbar, prec); if (odd(k)) c = gneg(c);
12482 441 : T = gel(vp,ibar);
12483 441 : if (typ(T) == t_POL && varn(T) == 0)
12484 189 : T = RgX_recip(RgX_Rg_mul(T, c));
12485 : else
12486 252 : T = gmul(T, c);
12487 441 : gel(vm,i) = T;
12488 : }
12489 35 : vpp = gadd(vp,vm);
12490 35 : vmm = gsub(vp,vm);
12491 :
12492 35 : vE = fs_get_vE(FS); lvE = lg(vE);
12493 35 : f = gel(fs_get_EF(FS), 1);
12494 35 : P = mf_get_field(f); if (degpol(P) == 1) P = NULL;
12495 35 : T = mfcharpol(CHI); if (degpol(T) == 1) T = NULL;
12496 35 : if (T && P)
12497 : {
12498 7 : rnfeq = nf_rnfeqsimple(T, P);
12499 7 : polabs = gel(rnfeq,1);
12500 7 : roabs = gel(QX_complex_roots(polabs,prec), 1);
12501 : }
12502 : else
12503 : {
12504 28 : rnfeq = roabs = NULL;
12505 28 : polabs = P? P: T;
12506 : }
12507 35 : pet = mfpetersson_i(FS, NULL);
12508 35 : M = cgetg(lvE, t_VEC);
12509 84 : for (i = 1; i < lvE; i++)
12510 : {
12511 49 : GEN p, m, wp, wm, petdiag, r, E = gel(vE,i);
12512 49 : p = normal(RgXV_embed(vpp, E), polabs, roabs, rnfeq, &wp, prec);
12513 49 : m = normal(RgXV_embed(vmm, E), polabs, roabs, rnfeq, &wm, prec);
12514 49 : petdiag = typ(pet)==t_MAT? gcoeff(pet,i,i): pet;
12515 49 : r = gdiv(mulimag(wp, conj_i(wm)), petdiag);
12516 49 : r = bestapprnfrel(r, polabs, roabs, rnfeq, prec);
12517 49 : gel(M,i) = mkvec2(mkvec2(p,m), mkvec3(wp,wm,r));
12518 : }
12519 35 : return gc_GEN(av, lvE == 2? gel(M,1): M);
12520 : }
12521 :
12522 : /* flag = 0: full, flag = +1 or -1, odd/even */
12523 : /* Basis of period polynomials in level 1. */
12524 : GEN
12525 49 : mfperiodpolbasis(long k, long flag)
12526 : {
12527 49 : pari_sp av = avma;
12528 49 : long i, j, n = k - 2;
12529 : GEN M, C, v;
12530 49 : if (k <= 4) return cgetg(1,t_VEC);
12531 35 : M = cgetg(k, t_MAT);
12532 35 : C = matpascal(n);
12533 35 : if (!flag)
12534 392 : for (j = 0; j <= n; j++)
12535 : {
12536 371 : gel(M, j+1) = v = cgetg(k, t_COL);
12537 4767 : for (i = 0; i <= j; i++) gel(v, i+1) = gcoeff(C, j+1, i+1);
12538 4396 : for (; i <= n; i++) gel(v, i+1) = gcoeff(C, n-j+1, i-j+1);
12539 : }
12540 : else
12541 168 : for (j = 0; j <= n; j++)
12542 : {
12543 154 : gel(M, j+1) = v = cgetg(k, t_COL);
12544 1848 : for (i = 0; i <= n; i++)
12545 : {
12546 1694 : GEN a = i < j ? gcoeff(C, j+1, i+1) : gen_0;
12547 1694 : if (i + j >= n)
12548 : {
12549 924 : GEN b = gcoeff(C, j+1, i+j-n+1);
12550 924 : a = flag < 0 ? addii(a,b) : subii(a,b);
12551 : }
12552 1694 : gel(v, i+1) = a;
12553 : }
12554 : }
12555 35 : return gc_GEN(av, RgM_to_RgXV(ZM_ker(M), 0));
12556 : }
12557 :
12558 : static int
12559 168 : zero_at_cusp(GEN mf, GEN F, GEN c)
12560 : {
12561 168 : GEN v = evalcusp(mf, F, c, LOWDEFAULTPREC);
12562 168 : return (gequal0(v) || gexpo(v) <= -62);
12563 : }
12564 : /* Compute list E of j such that F|_k g_j vanishes at oo: return [E, s(E)] */
12565 : static void
12566 14 : mffvanish(GEN mf, GEN F, GEN G, GEN cosets, GEN *pres, GEN *press)
12567 : {
12568 14 : long j, lc = lg(cosets), N = MF_get_N(mf);
12569 : GEN v, vs;
12570 14 : *pres = v = zero_zv(lc-1);
12571 14 : *press= vs = zero_zv(lc-1);
12572 105 : for (j = 1; j < lc; j++)
12573 : {
12574 91 : GEN ga = gel(cosets,j), c = mat2cusp(ga);
12575 91 : if (zero_at_cusp(mf, F, c))
12576 14 : v[j] = vs[ mftocoset_i(N, ZM_mulS(ga), cosets) ] = 1;
12577 77 : else if (!zero_at_cusp(mf, G, c))
12578 0 : pari_err_IMPL("divergent Petersson product");
12579 : }
12580 14 : }
12581 :
12582 : static GEN
12583 15190 : _RgX_coeff(GEN T, long n)
12584 15190 : { return typ(T) == t_POL && varn(T) == 0? RgX_coeff(T,n): T; }
12585 : static GEN
12586 140 : Haberland(GEN PF, GEN PG, GEN vEF, GEN vEG, long k)
12587 : {
12588 140 : GEN S = gen_0, vC = vecbinomial(k-2); /* vC[n+1] = (-1)^n binom(k-2,n) */
12589 140 : long n, j, l = lg(PG);
12590 406 : for (n = 2; n < k; n+=2) gel(vC,n) = negi(gel(vC,n));
12591 2583 : for (j = 1; j < l; j++)
12592 : {
12593 2443 : GEN PFj = gel(PF,j), PGj = gel(PG,j);
12594 10038 : for (n = 0; n <= k-2; n++)
12595 : {
12596 7595 : GEN a = _RgX_coeff(PGj, k-2-n), b = _RgX_coeff(PFj, n);
12597 7595 : a = Rg_embedall(a, vEG);
12598 7595 : b = Rg_embedall(b, vEF);
12599 7595 : a = conj_i(a); if (typ(a) == t_VEC) settyp(a, t_COL);
12600 : /* a*b = scalar or t_VEC or t_COL or t_MAT */
12601 7595 : S = gadd(S, gdiv(gmul(a,b), gel(vC,n+1)));
12602 : }
12603 : }
12604 140 : S = mulcxpowIs(gmul2n(S, 1-k), 1+k);
12605 140 : return vEF==vEG? real_i(S): S;
12606 : }
12607 : /* F1S, F2S both symbols, same mf */
12608 : static GEN
12609 14 : mfpeterssonnoncusp(GEN F1S, GEN F2S)
12610 : {
12611 14 : pari_sp av = avma;
12612 : GEN mf, F1, F2, GF1, GF2, P2, cosets, vE1, vE2, FE1, FE2, P;
12613 : GEN I, IP1, RHO, RHOP1, INF, res, ress;
12614 14 : const double height = sqrt(3.)/2;
12615 : long k, r, j, bitprec, prec;
12616 :
12617 14 : mf = fs_get_MF(F1S);
12618 14 : FE1 = fs_get_EF(F1S); F1 = gel(FE1, 1);
12619 14 : FE2 = fs_get_EF(F2S); F2 = gel(FE2, 1);
12620 14 : cosets = fs_get_cosets(F1S);
12621 14 : bitprec = minuu(fs_get_bitprec(F1S), fs_get_bitprec(F2S));
12622 14 : prec = nbits2prec(bitprec);
12623 14 : F1S = fs_set_expan(F1S, mfgaexpansionall(mf, FE1, cosets, height, prec));
12624 14 : if (F2S != F1S)
12625 14 : F2S = fs_set_expan(F2S, mfgaexpansionall(mf, FE2, cosets, height, prec));
12626 14 : k = MF_get_k(mf); r = lg(cosets) - 1;
12627 14 : vE1 = fs_get_vE(F1S);
12628 14 : vE2 = fs_get_vE(F2S);
12629 14 : I = gen_I();
12630 14 : IP1 = mkcomplex(gen_1,gen_1);
12631 14 : RHO = rootsof1u_cx(3, prec+EXTRAPREC64);
12632 14 : RHOP1 = gaddsg(1, RHO);
12633 14 : INF = mkoo();
12634 14 : mffvanish(mf, F1, F2, cosets, &res, &ress);
12635 14 : P2 = fs_get_pols(F2S);
12636 14 : GF1 = cgetg(r+1, t_VEC);
12637 14 : GF2 = cgetg(r+1, t_VEC); P = get_P(k, fetch_var(), prec);
12638 105 : for (j = 1; j <= r; j++)
12639 : {
12640 91 : GEN g = gel(cosets,j);
12641 91 : if (res[j]) {
12642 14 : gel(GF1,j) = mfsymboleval_direct(F1S, mkvec2(RHOP1,INF), g, P);
12643 14 : gel(GF2,j) = mfsymboleval_direct(F2S, mkvec2(I,IP1), g, P);
12644 77 : } else if (ress[j]) {
12645 7 : gel(GF1,j) = mfsymboleval_direct(F1S, mkvec2(RHOP1,RHO), g, P);
12646 7 : gel(GF2,j) = mfsymboleval_direct(F2S, mkvec2(I,INF), g, P);
12647 : } else {
12648 70 : gel(GF1,j) = mfsymboleval_direct(F1S, mkvec2(RHO,I), g, P);
12649 70 : gel(GF2,j) = gneg(gel(P2,j)); /* - symboleval(F2S, [0,oo] */
12650 : }
12651 : }
12652 14 : delete_var();
12653 14 : return gc_upto(av, gdivgu(Haberland(GF1,GF2, vE1,vE2, k), r));
12654 : }
12655 :
12656 : /* Petersson product of F and G, given by mfsymbol's [k > 1 integral] */
12657 : static GEN
12658 140 : mfpetersson_i(GEN FS, GEN GS)
12659 : {
12660 140 : pari_sp av = avma;
12661 : GEN mf, ESF, ESG, PF, PG, PH, CHI, cosets, vEF, vEG;
12662 : long k, r, j, N, bitprec, prec;
12663 :
12664 140 : if (!checkfs_i(FS)) pari_err_TYPE("mfpetersson",FS);
12665 140 : mf = fs_get_MF(FS);
12666 140 : ESF = fs_get_vES(FS);
12667 140 : if (!GS) GS = FS;
12668 : else
12669 : {
12670 35 : if (!checkfs_i(GS)) pari_err_TYPE("mfpetersson",GS);
12671 35 : if (!mfs_checkmf(GS, mf))
12672 0 : pari_err_TYPE("mfpetersson [different mf]", mkvec2(FS,GS));
12673 : }
12674 140 : ESG = fs_get_vES(GS);
12675 140 : if (!gequal0(gel(ESF,1)) || !gequal0(gel(ESG,1)))
12676 14 : return mfpeterssonnoncusp(FS, GS);
12677 126 : if (gequal0(gel(ESF,2)) || gequal0(gel(ESG,2))) return gc_const(av, gen_0);
12678 126 : N = MF_get_N(mf);
12679 126 : k = MF_get_k(mf);
12680 126 : CHI = MF_get_CHI(mf);
12681 126 : PF = fs_get_pols(FS); vEF = fs_get_vE(FS);
12682 126 : PG = fs_get_pols(GS); vEG = fs_get_vE(GS);
12683 126 : cosets = fs_get_cosets(FS);
12684 126 : bitprec = minuu(fs_get_bitprec(FS), fs_get_bitprec(GS));
12685 126 : prec = nbits2prec(bitprec);
12686 126 : r = lg(PG)-1;
12687 126 : PH = cgetg(r+1, t_VEC);
12688 2478 : for (j = 1; j <= r; j++)
12689 : {
12690 2352 : GEN ga = gel(cosets,j), P, P1, Pm1;
12691 : long D;
12692 2352 : P = gel(PG, mftocoset_iD(N, ZM_mulTi(ga), cosets, &D));
12693 2352 : if (typ(P) == t_POL && varn(P) == 0)
12694 : {
12695 1372 : P1 = RgX_Rg_translate(P, gen_1);
12696 1372 : P1 = RgX_Rg_mul(P1, mfcharcxeval(CHI, D, prec));
12697 : }
12698 : else
12699 980 : P1 = gmul(P, mfcharcxeval(CHI, D, prec));
12700 :
12701 2352 : P = gel(PG, mftocoset_iD(N, ZM_mulT(ga), cosets, &D));
12702 2352 : if (typ(P) == t_POL && varn(P) == 0)
12703 : {
12704 1372 : Pm1 = RgX_Rg_translate(P, gen_m1);
12705 1372 : Pm1 = RgX_Rg_mul(Pm1, mfcharcxeval(CHI, D, prec));
12706 : }
12707 : else
12708 980 : Pm1 = gmul(P, mfcharcxeval(CHI, D, prec));
12709 2352 : gel(PH,j) = gsub(P1, Pm1);
12710 : }
12711 126 : return gc_upto(av, gdivgu(Haberland(PF, PH, vEF, vEG, k), 6*r));
12712 : }
12713 :
12714 : /****************************************************************/
12715 : /* Petersson products using Nelson-Collins */
12716 : /****************************************************************/
12717 : /* Compute W(k,z) = sum_{m >= 1} (mz)^{k-1}(mzK_{k-2}(mz)-K_{k-1}(mz))
12718 : * for z>0 and absolute accuracy < 2^{-B}.
12719 : * K_k(x) ~ (Pi/(2x))^{1/2} e^{-x} */
12720 :
12721 : static void
12722 10304 : Wparams(GEN *ph, long *pN, long k, double x, long prec)
12723 : {
12724 10304 : double B = prec2nbits(prec) + 10;
12725 10304 : double C = B + k*log(x)/M_LN2 + 1, D = C*M_LN2 + 2.065;
12726 10304 : double F = 2 * M_LN2 * (C - 1 + dbllog2(mpfact(k))) / x;
12727 10304 : double T = log(F) * (1 + 2*k/x/F), PI2 = M_PI*M_PI;
12728 10304 : *pN = (long)ceil((T/PI2) * (D + log(D/PI2)));
12729 10304 : *ph = gprec_w(dbltor(T / *pN), prec);
12730 10304 : }
12731 :
12732 : static void
12733 10304 : Wcoshall(GEN *pCH, GEN *pCHK, GEN *pCHK1, GEN h, long N, long k, long prec)
12734 : {
12735 10304 : GEN CH, CHK, CHK1, z = gexp(h, prec);
12736 10304 : GEN PO = gpowers(z, N), POK1 = gpowers(gpowgs(z, k-1), N);
12737 10304 : GEN E = ginv(gel(PO, N + 1)); /* exp(-hN) */
12738 10304 : GEN E1 = ginv(gel(POK1, N + 1)); /* exp(-(k-1)h) */
12739 : long j;
12740 10304 : *pCH = CH = cgetg(N+1, t_VEC);
12741 10304 : *pCHK = CHK = cgetg(N+1, t_VEC);
12742 10304 : *pCHK1 = CHK1 = cgetg(N+1, t_VEC);
12743 146048 : for (j = 1; j <= N; j++)
12744 : {
12745 135744 : GEN eh = gel(PO, j+1), emh = gmul(gel(PO, N-j+1), E); /* e^{jh}, e^{-jh} */
12746 135744 : GEN ek1h = gel(POK1, j+1), ek1mh = gmul(gel(POK1, N-j+1), E1);
12747 135744 : gel(CH, j) = gmul2n(gadd(eh, emh), -1); /* cosh(jh) */
12748 135744 : gel(CHK1,j) = gmul2n(gadd(ek1h, ek1mh), -1); /* cosh((k-1)jh) */
12749 135744 : gel(CHK, j) = gmul2n(gadd(gmul(eh, ek1h), gmul(emh, ek1mh)), -1);
12750 : }
12751 10304 : }
12752 :
12753 : /* computing W(k,x) via integral */
12754 : static GEN
12755 10304 : Wint(long k, GEN vP, GEN x, long prec)
12756 : {
12757 : GEN P, P1, S1, S, h, CH, CHK, CHK1;
12758 : long N, j;
12759 10304 : Wparams(&h, &N, k, gtodouble(x), prec);
12760 10304 : Wcoshall(&CH, &CHK, &CHK1, h, N, k, prec);
12761 10304 : P = gel(vP, k+1); P1 = gel(vP, k); S = S1 = NULL;
12762 156352 : for (j = 0; j <= N; j++)
12763 : {
12764 146048 : GEN eh = gexp(j? gmul(x, gel(CH, j)): x, prec);
12765 146048 : GEN eh1 = gsubgs(eh, 1), eh1k = gpowgs(eh1, k), t1, t;
12766 146048 : t = gdiv(poleval(P, eh), gmul(eh1, eh1k));
12767 146048 : t1 = gdiv(poleval(P1, eh), eh1k);
12768 146048 : if (j)
12769 : {
12770 135744 : S = gadd(S, gmul(t, gel(CHK, j)));
12771 135744 : S1 = gadd(S1, gmul(t1, gel(CHK1, j)));
12772 : }
12773 : else
12774 : {
12775 10304 : S = gmul2n(t, -1);
12776 10304 : S1 = gmul2n(t1, -1);
12777 : }
12778 : }
12779 10304 : return gmul(gmul(h, gpowgs(x, k-1)), gsub(gmul(x, S), gmulsg(2*k-1, S1)));
12780 : }
12781 :
12782 : static GEN
12783 21 : get_vP(long k)
12784 : {
12785 21 : GEN P, v = cgetg(k+2, t_VEC), Q = deg1pol_shallow(gen_1,gen_m1,0);
12786 : long j;
12787 21 : gel(v,1) = gen_1;
12788 21 : gel(v,2) = P = pol_x(0);
12789 28 : for (j = 2; j <= k; j++)
12790 7 : gel(v,j+1) = P = RgX_shift_shallow(gsub(gmulsg(j, P),
12791 : gmul(Q, ZX_deriv(P))), 1);
12792 21 : return v;
12793 : }
12794 : /* vector of (-1)^j(1/(exp(x)-1))^(j) [x = z] * z^j for 0<=j<=r */
12795 : static GEN
12796 63742 : VS(long r, GEN z, GEN V, long prec)
12797 : {
12798 63742 : GEN e = gexp(z, prec), c = ginv(gsubgs(e,1));
12799 63742 : GEN T = gpowers0(gmul(c, z), r, c);
12800 : long j;
12801 63742 : V = gsubst(V, 0, e);
12802 143864 : for (j = 1; j <= r + 1; j++) gel(V,j) = gmul(gel(V,j), gel(T,j));
12803 63742 : return V;
12804 : }
12805 :
12806 : /* U(r,x)=sum_{m >= 1} (mx)^k K_k(mx), k = r+1/2 */
12807 : static GEN
12808 71932 : Unelson(long r, GEN V)
12809 : {
12810 71932 : GEN S = gel(V,r+1), C = gen_1; /* (r+j)! / j! / (r-j)! */
12811 : long j;
12812 71932 : if (!r) return S;
12813 40950 : for (j = 1; j <= r; j++)
12814 : {
12815 24570 : C = gdivgu(gmulgu(C, (r+j)*(r-j+1)), j);
12816 24570 : S = gadd(S, gmul2n(gmul(C, gel(V, r-j+1)), -j));
12817 : }
12818 16380 : return S;
12819 : }
12820 : /* W(r+1/2,z) / sqrt(Pi/2) */
12821 : static GEN
12822 63742 : Wint2(long r, GEN vP, GEN z, long prec)
12823 : {
12824 63742 : GEN R, V = VS(r, z, vP, prec);
12825 63742 : R = Unelson(r, V);
12826 63742 : if (r) R = gsub(R, gmulsg(2*r, Unelson(r-1, V)));
12827 63742 : return R;
12828 : }
12829 : typedef GEN(*Wfun_t)(long, GEN, GEN, long);
12830 : static GEN
12831 74046 : WfromZ(GEN Z, GEN vP, GEN gkm1, Wfun_t W, long k, GEN pi4, long prec)
12832 : {
12833 74046 : pari_sp av = avma;
12834 74046 : GEN Zk = gpow(Z, gkm1, prec), z = gmul(pi4, gsqrt(Z,prec));
12835 74046 : return gc_upto(av, gdiv(W(k, vP, z, prec), Zk));
12836 : }
12837 : /* mf a true mf or an fs2 */
12838 : static GEN
12839 21 : fs2_init(GEN mf, GEN F, long bit)
12840 : {
12841 21 : pari_sp av = avma;
12842 21 : long i, l, lim, N, k, k2, prec = nbits2prec(bit);
12843 : GEN DEN, cusps, tab, gk, gkm1, W0, vW, vVW, vVF, vP, al0;
12844 21 : GEN vE = mfgetembed(F, prec), pi4 = Pi2n(2, prec);
12845 : Wfun_t Wf;
12846 :
12847 21 : if (lg(mf) == 7)
12848 : {
12849 21 : vW = cusps = NULL; /* true mf */
12850 21 : DEN = tab = NULL; /* -Wall */
12851 : }
12852 : else
12853 : { /* mf already an fs2, reset if its precision is too low */
12854 0 : vW = (fs2_get_bitprec(mf) < bit)? NULL: fs2_get_W(mf);
12855 0 : cusps = fs2_get_cusps(mf);
12856 0 : DEN = fs2_get_den(mf);
12857 0 : mf = fs2_get_MF(mf);
12858 : }
12859 21 : N = MF_get_N(mf);
12860 21 : gk = MF_get_gk(mf); gkm1 = gsubgs(gk, 1);
12861 21 : k2 = itos(gmul2n(gk,1));
12862 21 : Wf = odd(k2)? Wint2: Wint;
12863 21 : k = k2 >> 1; vP = get_vP(k);
12864 21 : if (vW) lim = (lg(gel(vW,1)) - 2) / N; /* vW[1] attached to cusp 0, width N */
12865 : else
12866 : { /* true mf */
12867 21 : double B = (bit + 10)*M_LN2;
12868 21 : double L = (B + k2*log(B)/2 + k2*k2*log(B)/(4*B)) / (4*M_PI);
12869 : long n, Lw;
12870 21 : lim = ((long)ceil(L*L));
12871 21 : Lw = N*lim;
12872 21 : tab = cgetg(Lw+1,t_VEC);
12873 59157 : for (n = 1; n <= Lw; n++)
12874 59136 : gel(tab,n) = WfromZ(uutoQ(n,N), vP, gkm1, Wf, k, pi4, prec);
12875 21 : if (!cusps) cusps = mfcusps_i(N);
12876 21 : DEN = gmul2n(gmulgu(gpow(Pi2n(3, prec), gkm1, prec), mypsiu(N)), -2);
12877 21 : if (odd(k2)) DEN = gdiv(DEN, sqrtr_abs(Pi2n(-1,prec)));
12878 : }
12879 21 : l = lg(cusps);
12880 21 : vVF = cgetg(l, t_VEC);
12881 21 : vVW = cgetg(l, t_VEC);
12882 21 : al0 = cgetg(l, t_VECSMALL);
12883 21 : W0 = k2==1? ginv(pi4): gen_0;
12884 203 : for (i = 1; i < l; i++)
12885 : {
12886 : long A, C, w, wi, Lw, n;
12887 : GEN VF, W, paramsF, al;
12888 182 : (void)cusp_AC(gel(cusps,i), &A,&C);
12889 182 : wi = ugcd(N, C*C); w = N / wi; Lw = w * lim;
12890 182 : VF = mfslashexpansion(mf, F, cusp2mat(A,C), Lw, 0, ¶msF, prec);
12891 : /* paramsF[2] = w */
12892 182 : al = gel(paramsF, 1); if (gequal0(al)) al = NULL;
12893 100240 : for (n = 0; n <= Lw; n++)
12894 : {
12895 100058 : GEN a = gel(VF,n+1);
12896 100058 : gel(VF,n+1) = gequal0(a)? gen_0: Rg_embedall(a, vE);
12897 : }
12898 182 : if (vW)
12899 0 : W = gel(vW, i);
12900 : else
12901 : {
12902 182 : W = cgetg(Lw+2, t_VEC);
12903 100240 : for (n = 0; n <= Lw; n++)
12904 100058 : gel(W, n+1) = al? WfromZ(gadd(al,uutoQ(n,w)),vP,gkm1,Wf,k,pi4, prec)
12905 100058 : : (n? gel(tab, n * wi): W0);
12906 : }
12907 182 : al0[i] = !al;
12908 182 : gel(vVF, i) = VF;
12909 182 : gel(vVW, i) = W;
12910 : }
12911 21 : if (k2 <= 1) al0 = zero_zv(l-1); /* no need to test for convergence */
12912 21 : return gc_GEN(av, mkvecn(7, mf,vVW,cusps,vVF,utoipos(bit),al0,DEN));
12913 : }
12914 :
12915 : static GEN
12916 21 : mfpetersson2(GEN Fs, GEN Gs)
12917 : {
12918 21 : pari_sp av = avma;
12919 21 : GEN VC, RES, vF, vG, vW = fs2_get_W(Fs), al0 = fs2_get_al0(Fs);
12920 21 : long N = MF_get_N(fs2_get_MF(Fs)), j, lC;
12921 :
12922 21 : VC = fs2_get_cusps(Fs); lC = lg(VC);
12923 21 : vF = fs2_get_F(Fs);
12924 21 : vG = Gs? fs2_get_F(Gs): vF;
12925 21 : RES = gen_0;
12926 203 : for (j = 1; j < lC; j++)
12927 : {
12928 182 : GEN W = gel(vW,j), VF = gel(vF,j), VG = gel(vG,j), T = gen_0;
12929 182 : long A, C, w, n, L = lg(W);
12930 182 : pari_sp av = avma;
12931 182 : (void)cusp_AC(gel(VC,j), &A,&C); w = N/ugcd(N, C*C);
12932 182 : if (al0[j] && !isintzero(gel(VF,1)) && !isintzero(gel(VG,1)))
12933 0 : pari_err_IMPL("divergent Petersson product");
12934 100240 : for (n = 1; n < L; n++)
12935 : {
12936 100058 : GEN b = gel(VF,n), a = gel(VG,n);
12937 100058 : if (!isintzero(a) && !isintzero(b))
12938 : {
12939 79964 : T = gadd(T, gmul(gel(W,n), gmul(conj_i(a),b)));
12940 79964 : if (gc_needed(av,2)) T = gc_upto(av,T);
12941 : }
12942 : }
12943 182 : if (w != 1) T = gmulgu(T,w);
12944 182 : RES = gc_upto(av, gadd(RES, T));
12945 : }
12946 21 : if (!Gs) RES = real_i(RES);
12947 21 : return gc_upto(av, gdiv(RES, fs2_get_den(Fs)));
12948 : }
12949 :
12950 : static long
12951 161 : symbol_type(GEN F)
12952 : {
12953 161 : if (checkfs_i(F)) return 1;
12954 21 : if (checkfs2_i(F)) return 2;
12955 0 : return 0;
12956 : }
12957 : static int
12958 35 : symbol_same_mf(GEN F, GEN G) { return gequal(gmael(F,1,1), gmael(G,1,1)); }
12959 : GEN
12960 126 : mfpetersson(GEN F, GEN G)
12961 : {
12962 126 : long tF = symbol_type(F);
12963 126 : if (!tF) pari_err_TYPE("mfpetersson",F);
12964 126 : if (G)
12965 : {
12966 35 : long tG = symbol_type(G);
12967 35 : if (!tG) pari_err_TYPE("mfpetersson",F);
12968 35 : if (tF != tG || !symbol_same_mf(F,G))
12969 0 : pari_err_TYPE("mfpetersson [incompatible symbols]", mkvec2(F,G));
12970 : }
12971 126 : return (tF == 1)? mfpetersson_i(F, G): mfpetersson2(F, G);
12972 : }
12973 :
12974 : /****************************************************************/
12975 : /* projective Galois representation, weight 1 */
12976 : /****************************************************************/
12977 : static void
12978 392 : moreorders(long N, GEN CHI, GEN F, GEN *pP, GEN *pO, ulong *bound)
12979 : {
12980 392 : pari_sp av = avma;
12981 : forprime_t iter;
12982 392 : ulong a = *bound+1, b = 2*(*bound), p;
12983 392 : long i = 1;
12984 392 : GEN P, O, V = mfcoefs_i(F, b, 1);
12985 392 : *bound = b;
12986 392 : P = cgetg(b-a+2, t_VECSMALL);
12987 392 : O = cgetg(b-a+2, t_VECSMALL);
12988 392 : u_forprime_init(&iter, a, b);
12989 2310 : while((p = u_forprime_next(&iter))) if (N % p)
12990 : {
12991 1813 : O[i] = mffindrootof1(V, p, CHI);
12992 1813 : P[i++] = p;
12993 : }
12994 392 : setlg(P, i); *pP = shallowconcat(*pP, P);
12995 392 : setlg(O, i); *pO = shallowconcat(*pO, O);
12996 392 : (void)gc_all(av, 2, pP, pO);
12997 392 : }
12998 :
12999 : static GEN
13000 182 : search_abelian(GEN nf, long n, long k, GEN N, GEN CHI, GEN F,
13001 : GEN *pP, GEN *pO, ulong *bound, long prec)
13002 : {
13003 182 : pari_sp av = avma;
13004 : GEN bnr, cond, H, cyc, gn, T, Bquo, P, E;
13005 182 : long sN = itos(N), r1 = nf_get_r1(nf), i, j, d;
13006 :
13007 182 : cond = idealfactor(nf, N);
13008 182 : P = gel(cond,1);
13009 182 : E = gel(cond,2);
13010 679 : for (i = j = 1; i < lg(P); i++)
13011 : {
13012 497 : GEN pr = gel(P,i), Ej = gen_1;
13013 497 : long p = itos(pr_get_p(pr));
13014 497 : if (p == n)
13015 : {
13016 98 : long e = pr_get_e(pr); /* 1 + [e*p/(p-1)] */
13017 98 : Ej = utoipos(1 + (e*p) / (p-1));
13018 : }
13019 : else
13020 : {
13021 399 : long f = pr_get_f(pr);
13022 399 : if (Fl_powu(p % n, f, n) != 1) continue;
13023 : }
13024 462 : gel(P,j) = pr;
13025 462 : gel(E,j) = Ej; j++;
13026 : }
13027 182 : setlg(P,j);
13028 182 : setlg(E,j);
13029 182 : cond = mkvec2(cond, const_vec(r1, gen_1));
13030 182 : bnr = Buchraymod(Buchall(nf, nf_FORCE, prec), cond, nf_INIT, utoipos(n));
13031 182 : cyc = bnr_get_cyc(bnr);
13032 182 : d = lg(cyc)-1;
13033 182 : H = zv_diagonal(ZV_to_Flv(cyc, n));
13034 182 : gn = utoi(n);
13035 182 : for (i = 1;;)
13036 : {
13037 2646 : for(j = 2; i < lg(*pO); i++)
13038 : {
13039 2072 : long o, q = (*pP)[i];
13040 2072 : GEN pr = idealprimedec_galois(nf, stoi(q));
13041 2072 : o = ((*pO)[i] / pr_get_f(pr)) % n;
13042 2072 : if (o)
13043 : {
13044 1442 : GEN v = ZV_to_Flv(isprincipalray(bnr, pr), n);
13045 1442 : H = vec_append(H, Flv_Fl_mul(v, o, n));
13046 : }
13047 : }
13048 574 : H = Flm_image(H, n); if (lg(cyc)-lg(H) <= k) break;
13049 392 : moreorders(sN, CHI, F, pP, pO, bound);
13050 : }
13051 182 : H = hnfmodid(shallowconcat(zm_to_ZM(H), diagonal_shallow(cyc)), gn);
13052 :
13053 182 : Bquo = cgetg(k+1, t_MAT);
13054 812 : for (i = j = 1; i <= d; i++)
13055 630 : if (!equali1(gcoeff(H,i,i))) gel(Bquo,j++) = col_ei(d,i);
13056 :
13057 441 : for (i = 1, T = NULL; i<=k; i++)
13058 : {
13059 259 : GEN Hi = hnfmodid(shallowconcat(H, vecsplice(Bquo,i)), gn);
13060 259 : GEN pol = rnfkummer(bnr, Hi, prec);
13061 259 : T = T? nfcompositum(nf, T, pol, 2): pol;
13062 : }
13063 182 : T = rnfequation(nf, T); return gc_all(av, 3, &T, pP, pO);
13064 : }
13065 :
13066 : static GEN
13067 77 : search_solvable(GEN LG, GEN mf, GEN F, long prec)
13068 : {
13069 77 : GEN N = MF_get_gN(mf), CHI = MF_get_CHI(mf), pol, O, P, nf, Nfa;
13070 77 : long i, l = lg(LG), v = fetch_var();
13071 77 : ulong bound = 1;
13072 77 : O = cgetg(1, t_VECSMALL); /* projective order of rho(Frob_p) */
13073 77 : P = cgetg(1, t_VECSMALL);
13074 77 : Nfa = Z_factor(N);
13075 77 : pol = pol_x(v);
13076 259 : for (i = 1; i < l; i++)
13077 : { /* n prime, find a (Z/nZ)^k - extension */
13078 182 : GEN G = gel(LG,i);
13079 182 : long n = G[1], k = G[2];
13080 182 : nf = nfinitred(mkvec2(pol,Nfa), prec);
13081 182 : pol = search_abelian(nf, n, k, N, CHI, F, &P, &O, &bound, prec);
13082 182 : setvarn(pol,v);
13083 : }
13084 77 : delete_var(); setvarn(pol,0); return pol;
13085 : }
13086 :
13087 : static GEN
13088 0 : search_A5(GEN mf, GEN F)
13089 : {
13090 0 : GEN CHI = MF_get_CHI(mf), O, P, L;
13091 0 : long N = MF_get_N(mf), i, j, lL, nd, r;
13092 0 : ulong bound = 1;
13093 0 : r = radicalu(N);
13094 0 : L = veccond_to_A5(zv_z_mul(divisorsu(N/r),r), 2); lL = lg(L); nd = lL-1;
13095 0 : if (nd == 1) return gmael(L,1,1);
13096 0 : O = cgetg(1, t_VECSMALL); /* projective order of rho(Frob_p) */
13097 0 : P = cgetg(1, t_VECSMALL);
13098 0 : for(i = 1; nd > 1; )
13099 : {
13100 : long l;
13101 0 : moreorders(N, CHI, F, &P, &O, &bound);
13102 0 : l = lg(P);
13103 0 : for ( ; i < l; i++)
13104 : {
13105 0 : ulong p = P[i], f = O[i];
13106 0 : for (j = 1; j < lL; j++)
13107 0 : if (gel(L,j))
13108 : {
13109 0 : GEN FE = ZpX_primedec(gmael(L,j,1), utoi(p)), F = gel(FE,1);
13110 0 : long nF = lg(F)-1;
13111 0 : if (!equaliu(gel(F, nF), f)) { gel(L,j) = NULL; nd--; }
13112 : }
13113 0 : if (nd <= 1) break;
13114 : }
13115 : }
13116 0 : for (j = 1; j < lL; j++)
13117 0 : if (gel(L,j)) return gmael(L,j,1);
13118 0 : return NULL;
13119 : }
13120 :
13121 : GEN
13122 77 : mfgaloisprojrep(GEN mf, GEN F, long prec)
13123 : {
13124 77 : pari_sp av = avma;
13125 77 : GEN LG = NULL;
13126 77 : if (!checkMF_i(mf) && !checkmf_i(F)) pari_err_TYPE("mfgaloisrep", F);
13127 77 : switch( itos(mfgaloistype(mf,F)) )
13128 : {
13129 49 : case 0: case -12:
13130 49 : LG = mkvec2(mkvecsmall2(3,1), mkvecsmall2(2,2)); break;
13131 28 : case -24:
13132 28 : LG = mkvec3(mkvecsmall2(2,1), mkvecsmall2(3,1), mkvecsmall2(2,2)); break;
13133 0 : case -60: return gc_GEN(av, search_A5(mf, F));
13134 0 : default: pari_err_IMPL("mfgaloisprojrep for types D_n");
13135 : }
13136 77 : return gc_GEN(av, search_solvable(LG, mf, F, prec));
13137 : }
|
