Code coverage tests

This page documents the degree to which the PARI/GP source code is tested by our public test suite, distributed with the source distribution in directory src/test/. This is measured by the gcov utility; we then process gcov output using the lcov frond-end.

We test a few variants depending on Configure flags on the pari.math.u-bordeaux.fr machine (x86_64 architecture), and agregate them in the final report:

The target is 90% coverage for all mathematical modules (given that branches depending on DEBUGLEVEL or DEBUGMEM are not covered). This script is run to produce the results below.

LCOV - code coverage report
Current view: top level - basemath - mftrace.c (source / functions) Hit Total Coverage
Test: PARI/GP v2.10.0 lcov report (development 21947-4fc3047) Lines: 6866 7049 97.4 %
Date: 2018-02-24 06:16:21 Functions: 707 709 99.7 %
Legend: Lines: hit not hit

          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. It is distributed in the hope that it will be useful, but WITHOUT
       8             : ANY WARRANTY WHATSOEVER.
       9             : 
      10             : Check the License for details. You should have received a copy of it, along
      11             : with the package; see the file 'COPYING'. If not, write to the Free Software
      12             : Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
      13             : 
      14             : /*************************************************************************/
      15             : /*                                                                       */
      16             : /*              Modular forms package based on trace formulas            */
      17             : /*                                                                       */
      18             : /*************************************************************************/
      19             : #include "pari.h"
      20             : #include "paripriv.h"
      21             : 
      22             : enum {
      23             :   MF_SPLIT = 1,
      24             :   MF_EISENSPACE,
      25             :   MF_FRICKE,
      26             :   MF_MF2INIT
      27             : };
      28             : 
      29             : typedef struct {
      30             :   GEN vnew, vfull, DATA, VCHIP;
      31             :   long n, newHIT, newTOTAL, cuspHIT, cuspTOTAL;
      32             : } cachenew_t;
      33             : 
      34             : static void init_cachenew(cachenew_t *c, long n, long N, GEN f);
      35             : static GEN mfinit_i(GEN NK, long space);
      36             : static GEN mfinit_Nkchi(long N, long k, GEN CHI, long space, long flraw);
      37             : static GEN mf2init_Nkchi(long N, long k, GEN CHI, long space, long flraw);
      38             : static GEN mf2basis(long N, long r, GEN CHI, long space);
      39             : static GEN mfeisensteinbasis(long N, long k, GEN CHI);
      40             : static GEN mfeisensteindec(GEN mf, GEN F);
      41             : static GEN initwt1newtrace(GEN mf);
      42             : static GEN initwt1trace(GEN mf);
      43             : static GEN myfactoru(long N);
      44             : static GEN mydivisorsu(long N);
      45             : static GEN mygmodulo_lift(long k, long ord, GEN C, long vt);
      46             : static GEN mfcoefs_i(GEN F, long n, long d);
      47             : static GEN bhnmat_extend(GEN M, long m,long l, GEN S, cachenew_t *cache);
      48             : static GEN initnewtrace(long N, GEN CHI);
      49             : static void dbg_cachenew(cachenew_t *C);
      50             : static GEN hecke_i(long m, long l, GEN V, GEN F, GEN DATA);
      51             : static GEN c_Ek(long n, long d, GEN F);
      52             : static GEN RgV_heckef2(long n, long d, GEN V, GEN F, GEN DATA);
      53             : static GEN mfcusptrace_i(long N, long k, long n, GEN Dn, GEN TDATA);
      54             : static GEN mfnewtracecache(long N, long k, long n, cachenew_t *cache);
      55             : static GEN colnewtrace(long n0, long n, long d, long N, long k, cachenew_t *c);
      56             : static GEN dihan(GEN bnr, GEN w, GEN k0j, ulong n);
      57             : static GEN sigchi(long k, GEN CHI, long n);
      58             : static GEN sigchi2(long k, GEN CHI1, GEN CHI2, long n, long ord);
      59             : static GEN mflineardivtomat(long N, GEN vF, long n);
      60             : static GEN mfdihedralcusp(long N, GEN CHI);
      61             : static long mfdihedralcuspdim(long N, GEN CHI);
      62             : static GEN mfdihedralnew(long N, GEN CHI);
      63             : static GEN mfdihedralall(GEN LIM);
      64             : static long mfwt1cuspdim(long N, GEN CHI);
      65             : static long mf2dim_Nkchi(long N, long k, GEN CHI, ulong space);
      66             : static long mfdim_Nkchi(long N, long k, GEN CHI, long space);
      67             : static GEN charLFwtk(long k, GEN CHI, long ord);
      68             : static GEN mfeisensteingacx(GEN E,long w,GEN ga,long n,long prec);
      69             : static GEN mfgaexpansion(GEN mf, GEN F, GEN gamma, long n, long prec);
      70             : static GEN mfEHmat(long n, long r);
      71             : static GEN mfEHcoef(long r, long N);
      72             : static GEN mftobasis_i(GEN mf, GEN F);
      73             : 
      74             : static GEN
      75       25382 : mkgNK(GEN N, GEN k, GEN CHI, GEN P) { return mkvec4(N, k, CHI, P); }
      76             : static GEN
      77       11606 : mkNK(long N, long k, GEN CHI) { return mkgNK(stoi(N), stoi(k), CHI, pol_x(1)); }
      78             : GEN
      79        5817 : MF_get_CHI(GEN mf) { return gmael(mf,1,3); }
      80             : GEN
      81       14994 : MF_get_gN(GEN mf) { return gmael(mf,1,1); }
      82             : long
      83       14392 : MF_get_N(GEN mf) { return itou(MF_get_gN(mf)); }
      84             : GEN
      85        8827 : MF_get_gk(GEN mf) { return gmael(mf,1,2); }
      86             : long
      87        4893 : MF_get_k(GEN mf)
      88             : {
      89        4893 :   GEN gk = MF_get_gk(mf);
      90        4893 :   if (typ(gk)!=t_INT) pari_err_IMPL("half-integral weight");
      91        4893 :   return itou(gk);
      92             : }
      93             : long
      94         147 : MF_get_r(GEN mf)
      95             : {
      96         147 :   GEN gk = MF_get_gk(mf);
      97         147 :   if (typ(gk) == t_INT) pari_err_IMPL("integral weight");
      98         147 :   return itou(gel(gk, 1)) >> 1;
      99             : }
     100             : long
     101        9632 : MF_get_space(GEN mf) { return itos(gmael(mf,1,4)); }
     102             : GEN
     103        3234 : MF_get_E(GEN mf) { return gel(mf,2); }
     104             : GEN
     105       15631 : MF_get_S(GEN mf) { return gel(mf,3); }
     106             : GEN
     107         910 : MF_get_basis(GEN mf) { return shallowconcat(gel(mf,2), gel(mf,3)); }
     108             : long
     109        3227 : MF_get_dim(GEN mf)
     110             : {
     111        3227 :   switch(MF_get_space(mf))
     112             :   {
     113             :     case mf_FULL:
     114         539 :       return lg(MF_get_S(mf)) - 1 + lg(MF_get_E(mf))-1;
     115             :     case mf_EISEN:
     116         140 :       return lg(MF_get_E(mf))-1;
     117             :     default: /* mf_NEW, mf_CUSP, mf_OLD */
     118        2548 :       return lg(MF_get_S(mf)) - 1;
     119             :   }
     120             : }
     121             : GEN
     122        6167 : MFnew_get_vj(GEN mf) { return gel(mf,4); }
     123             : GEN
     124         301 : MFcusp_get_vMjd(GEN mf) { return gel(mf,4); }
     125             : GEN
     126        5376 : MF_get_M(GEN mf) { return gmael(mf,5,3); }
     127             : GEN
     128        2044 : MF_get_Minv(GEN mf) { return gmael(mf,5,2); }
     129             : GEN
     130        6657 : MF_get_Mindex(GEN mf) { return gmael(mf,5,1); }
     131             : 
     132             : /* ordinary gtocol forgets about initial 0s */
     133             : GEN
     134        2527 : sertocol(GEN S) { return gtocol0(S, -(lg(S) - 2 + valp(S))); }
     135             : /*******************************************************************/
     136             : /*     Linear algebra in cyclotomic fields (TODO: export this)     */
     137             : /*******************************************************************/
     138             : /* return r and split prime p giving projection Q(zeta_n) -> Fp, zeta -> r */
     139             : static ulong
     140         371 : QabM_init(long n, ulong *p)
     141             : {
     142         371 :   ulong pinit = 1000000007;
     143             :   forprime_t T;
     144         371 :   if (n <= 1) { *p = pinit; return 0; }
     145         259 :   u_forprime_arith_init(&T, pinit, ULONG_MAX, 1, n);
     146         259 :   *p = u_forprime_next(&T);
     147         259 :   return Flx_oneroot(ZX_to_Flx(polcyclo(n, 0), *p), *p);
     148             : }
     149             : static ulong
     150      405706 : Qab_to_Fl(GEN P, ulong r, ulong p)
     151             : {
     152             :   ulong t;
     153             :   GEN den;
     154      405706 :   P = Q_remove_denom(liftpol_shallow(P), &den);
     155      405706 :   if (typ(P) == t_POL) { GEN Pp = ZX_to_Flx(P, p); t = Flx_eval(Pp, r, p); }
     156      392875 :   else t = umodiu(P, p);
     157      405706 :   if (den) t = Fl_div(t, umodiu(den, p), p);
     158      405706 :   return t;
     159             : }
     160             : static GEN
     161        8267 : QabC_to_Flc(GEN C, ulong r, ulong p)
     162             : {
     163        8267 :   long i, l = lg(C);
     164        8267 :   GEN A = cgetg(l, t_VECSMALL);
     165        8267 :   for (i = 1; i < l; i++) uel(A,i) = Qab_to_Fl(gel(C,i), r, p);
     166        8267 :   return A;
     167             : }
     168             : static GEN
     169         203 : QabM_to_Flm(GEN M, ulong r, ulong p)
     170             : {
     171             :   long i, l;
     172         203 :   GEN A = cgetg_copy(M, &l);
     173        8470 :   for (i = 1; i < l; i++)
     174        8267 :     gel(A, i) = QabC_to_Flc(gel(M, i), r, p);
     175         203 :   return A;
     176             : }
     177             : /* A a t_POL */
     178             : static GEN
     179         287 : QabX_to_Flx(GEN A, ulong r, ulong p)
     180             : {
     181         287 :   long i, l = lg(A);
     182         287 :   GEN a = cgetg(l, t_VECSMALL);
     183         287 :   a[1] = ((ulong)A[1])&VARNBITS;
     184         287 :   for (i = 2; i < l; i++) uel(a,i) = Qab_to_Fl(gel(A,i), r, p);
     185         287 :   return Flx_renormalize(a, l);
     186             : }
     187             : 
     188             : /* FIXME: remove */
     189             : static GEN
     190         658 : ZabM_pseudoinv_i(GEN M, GEN P, long n, GEN *pv, GEN *den, int ratlift)
     191             : {
     192         658 :   GEN v = ZabM_indexrank(M, P, n);
     193         658 :   if (pv) *pv = v;
     194         658 :   M = shallowmatextract(M,gel(v,1),gel(v,2));
     195         658 :   return ratlift? ZabM_inv_ratlift(M, P, n, den): ZabM_inv(M, P, n, den);
     196             : }
     197             : 
     198             : /* M matrix with coeff in Q(\chi)), where Q(\chi) = Q(X)/(P) for
     199             :  * P = cyclotomic Phi_n. Assume M rational if n <= 2 */
     200             : static GEN
     201        1134 : QabM_ker(GEN M, GEN P, long n)
     202             : {
     203             :   GEN B;
     204        1134 :   if (n <= 2)
     205         742 :     B = ZM_ker(Q_primpart(M));
     206             :   else
     207         392 :     B = ZabM_ker(Q_primpart(liftpol_shallow(M)), P, n);
     208        1134 :   return B;
     209             : }
     210             : /* pseudo-inverse of M */
     211             : static GEN
     212         910 : QabM_pseudoinv(GEN M, GEN P, long n, GEN *pv, GEN *pden)
     213             : {
     214             :   GEN cM, Mi;
     215         910 :   if (n <= 2)
     216             :   {
     217         735 :     M = Q_primitive_part(M, &cM);
     218         735 :     Mi = ZM_pseudoinv(M, pv, pden); /* M^(-1) = Mi / (cM * den) */
     219             :   }
     220             :   else
     221             :   {
     222         175 :     M = Q_primitive_part(liftpol_shallow(M), &cM);
     223         175 :     Mi = ZabM_pseudoinv(M, P, n, pv, pden);
     224         175 :     Mi = gmodulo(Mi, P);
     225             :   }
     226         910 :   *pden = mul_content(*pden, cM);
     227         910 :   return Mi;
     228             : }
     229             : 
     230             : static GEN
     231        8988 : QabM_indexrank(GEN M, GEN P, long n)
     232             : {
     233             :   GEN z;
     234        8988 :   if (n <= 2)
     235             :   {
     236        7924 :     M = vec_Q_primpart(M);
     237        7924 :     z = ZM_indexrank(M); /* M^(-1) = Mi / (cM * den) */
     238             :   }
     239             :   else
     240             :   {
     241        1064 :     M = vec_Q_primpart(liftpol_shallow(M));
     242        1064 :     z = ZabM_indexrank(M, P, n);
     243             :   }
     244        8988 :   return z;
     245             : }
     246             : 
     247             : /*********************************************************************/
     248             : /*                    Simple arithmetic functions                    */
     249             : /*********************************************************************/
     250             : /* TODO: most of these should be exported and used in ifactor1.c */
     251             : /* phi(n) */
     252             : static ulong
     253      100100 : myeulerphiu(ulong n)
     254             : {
     255             :   pari_sp av;
     256             :   GEN fa;
     257      100100 :   if (n == 1) return 1;
     258       86660 :   av = avma; fa = myfactoru(n);
     259       86660 :   avma = av; return eulerphiu_fact(fa);
     260             : }
     261             : static long
     262       77336 : mymoebiusu(ulong n)
     263             : {
     264             :   pari_sp av;
     265             :   GEN fa;
     266       77336 :   if (n == 1) return 1;
     267       70077 :   av = avma; fa = myfactoru(n);
     268       70077 :   avma = av; return moebiusu_fact(fa);
     269             : }
     270             : 
     271             : static long
     272        2632 : mynumdivu(long N)
     273             : {
     274             :   pari_sp av;
     275             :   GEN fa;
     276        2632 :   if (N == 1) return 1;
     277        2527 :   av = avma; fa = myfactoru(N);
     278        2527 :   avma = av; return numdivu_fact(fa);
     279             : }
     280             : 
     281             : /* N\prod_{p|N} (1+1/p) */
     282             : static long
     283      253673 : mypsiu(ulong N)
     284             : {
     285      253673 :   pari_sp av = avma;
     286      253673 :   GEN P = gel(myfactoru(N), 1);
     287      253673 :   long j, l = lg(P), res = N;
     288      253673 :   for (j = 1; j < l; j++) res += res/P[j];
     289      253673 :   avma = av; return res;
     290             : }
     291             : /* write n = mf^2. Return m, set f. */
     292             : static ulong
     293         182 : mycore(ulong n, long *pf)
     294             : {
     295         182 :   pari_sp av = avma;
     296         182 :   GEN fa = myfactoru(n), P = gel(fa,1), E = gel(fa,2);
     297         182 :   long i, l = lg(P), m = 1, f = 1;
     298         745 :   for (i = 1; i < l; i++)
     299             :   {
     300         563 :     long j, p = P[i], e = E[i];
     301         563 :     if (e & 1) m *= p;
     302         563 :     for (j = 2; j <= e; j+=2) f *= p;
     303             :   }
     304         182 :   avma = av; *pf = f; return m;
     305             : }
     306             : 
     307             : /* fa = factorization of -D > 0, return -D0 > 0 (where D0 is fundamental) */
     308             : static long
     309     7751520 : corediscs_fact(GEN fa)
     310             : {
     311     7751520 :   GEN P = gel(fa,1), E = gel(fa,2);
     312     7751520 :   long i, l = lg(P), m = 1;
     313    25721850 :   for (i = 1; i < l; i++)
     314             :   {
     315    17970330 :     long p = P[i], e = E[i];
     316    17970330 :     if (e & 1) m *= p;
     317             :   }
     318     7751520 :   if ((m&3L) != 3) m <<= 2;
     319     7751520 :   return m;
     320             : }
     321             : static long
     322        5908 : mubeta(long n)
     323             : {
     324        5908 :   pari_sp av = avma;
     325        5908 :   GEN E = gel(myfactoru(n), 2);
     326        5908 :   long i, s = 1, l = lg(E);
     327       12278 :   for (i = 1; i < l; i++)
     328             :   {
     329        6370 :     long e = E[i];
     330        6370 :     if (e >= 3) { avma = av; return 0; }
     331        6370 :     if (e == 1) s *= -2;
     332             :   }
     333        5908 :   avma = av; return s;
     334             : }
     335             : 
     336             : /* n = n1*n2, n1 = ppo(n, m); return mubeta(n1)*moebiusu(n2).
     337             :  * N.B. If n from newt_params we, in fact, never return 0 */
     338             : static long
     339     3955623 : mubeta2(long n, long m)
     340             : {
     341     3955623 :   pari_sp av = avma;
     342     3955623 :   GEN fa = myfactoru(n), P = gel(fa,1), E = gel(fa,2);
     343     3955623 :   long i, s = 1, l = lg(P);
     344     8087730 :   for (i = 1; i < l; i++)
     345             :   {
     346     4132107 :     long p = P[i], e = E[i];
     347     4132107 :     if (m % p)
     348             :     { /* p^e in n1 */
     349     3281215 :       if (e >= 3) { avma = av; return 0; }
     350     3281215 :       if (e == 1) s *= -2;
     351             :     }
     352             :     else
     353             :     { /* in n2 */
     354      850892 :       if (e >= 2) { avma = av; return 0; }
     355      850892 :       s = -s;
     356             :     }
     357             :   }
     358     3955623 :   avma = av; return s;
     359             : }
     360             : 
     361             : /* write N = prod p^{ep} and n = df^2, d squarefree.
     362             :  * set g  = ppo(gcd(sqfpart(N), f), FC)
     363             :  *     N2 = prod p^if(e==1 || p|n, ep-1, ep-2) */
     364             : static void
     365      893739 : newt_params(long N, long n, long FC, long *pg, long *pN2)
     366             : {
     367      893739 :   GEN fa = myfactoru(N), P = gel(fa,1), E = gel(fa,2);
     368      893739 :   long i, g = 1, N2 = 1, l = lg(P);
     369     2396716 :   for (i = 1; i < l; i++)
     370             :   {
     371     1502977 :     long p = P[i], e = E[i];
     372     1502977 :     if (e == 1)
     373     1272369 :     { if (FC % p && n % (p*p) == 0) g *= p; }
     374             :     else
     375      230608 :       N2 *= upowuu(p,(n % p)? e-2: e-1);
     376             :   }
     377      893739 :   *pg = g; *pN2 = N2;
     378      893739 : }
     379             : /* simplified version of newt_params for n = 1 (newdim) */
     380             : static void
     381       31248 : newd_params(long N, long *pN2)
     382             : {
     383       31248 :   GEN fa = myfactoru(N), P = gel(fa,1), E = gel(fa,2);
     384       31248 :   long i, N2 = 1, l = lg(P);
     385       79786 :   for (i = 1; i < l; i++)
     386             :   {
     387       48538 :     long p = P[i], e = E[i];
     388       48538 :     if (e > 2) N2 *= upowuu(p, e-2);
     389             :   }
     390       31248 :   *pN2 = N2;
     391       31248 : }
     392             : 
     393             : static long
     394          14 : newd_params2(long N)
     395             : {
     396          14 :   GEN fa = myfactoru(N), P = gel(fa,1), E = gel(fa,2);
     397          14 :   long i, N2 = 1, l = lg(P);
     398          35 :   for (i = 1; i < l; i++)
     399             :   {
     400          21 :     long p = P[i], e = E[i];
     401          21 :     if (e >= 2) N2 *= upowuu(p, e);
     402             :   }
     403          14 :   return N2;
     404             : }
     405             : 
     406             : /*******************************************************************/
     407             : /*   Relative trace between cyclotomic fields (TODO: export this)  */
     408             : /*******************************************************************/
     409             : /* g>=1; return g * prod_{p | g, (p,q) = 1} (1-1/p) */
     410             : static long
     411       42567 : phipart(long g, long q)
     412             : {
     413       42567 :   if (g > 1)
     414             :   {
     415       16590 :     GEN P = gel(myfactoru(g), 1);
     416       16590 :     long i, l = lg(P);
     417       16590 :     for (i = 1; i < l; i++) { long p = P[i]; if (q % p) g -= g / p; }
     418             :   }
     419       42567 :   return g;
     420             : }
     421             : /* Trace(zeta_n^k) from Q(\zeta_n) to Q(\zeta_m) with n = m*d; k > 0 */
     422             : static GEN
     423       77273 : tracerelz(long d, long m, long k, long vt)
     424             : {
     425       77273 :   long s, v, g = cgcd(k, d), q = d / g, muq = mymoebiusu(q);
     426       77273 :   if (!muq) return gen_0;
     427       50267 :   if (m == 1)
     428             :   {
     429       17843 :     s = phipart(g, q); if (muq < 0) s = -s;
     430       17843 :     return stoi(s);
     431             :   }
     432       32424 :   if (cgcd(q, m) > 1) return gen_0;
     433       24724 :   s = phipart(g, m*q); if (muq < 0) s = -s;
     434       24724 :   v = Fl_inv(q % m, m);
     435       24724 :   v = (v*(k/g)) % m;
     436       24724 :   return mygmodulo_lift(v, m, stoi(s), vt);
     437             : }
     438             : /* m | n, both not 2 mod 4. Pn = polcyclo(n) */
     439             : GEN
     440       17871 : Qab_trace_init(GEN Pn, long n, long m)
     441             : {
     442             :   GEN T, Pm;
     443             :   long a, i, d, vt;
     444       17871 :   if (m == n) return mkvec(Pn);
     445       12551 :   d = degpol(Pn);
     446       12551 :   vt = varn(Pn);
     447       12551 :   Pm = polcyclo(m, vt);
     448       12551 :   T = cgetg(d+1, t_VEC);
     449       12551 :   gel(T,1) = utoipos(d / degpol(Pm)); /* Tr 1 */
     450       12551 :   a = n / m;
     451       12551 :   for (i = 1; i < d; i++) gel(T,i+1) = tracerelz(a, m, i, vt);
     452       12551 :   return mkvec3(Pm, Pn, T);
     453             : }
     454             : /* x a t_POL modulo Phi_n; n, m not 2 mod 4, degrel != 1*/
     455             : static GEN
     456       39494 : tracerel_i(GEN T, GEN x)
     457             : {
     458       39494 :   long k, l = lg(x);
     459       39494 :   GEN S = gen_0;
     460       39494 :   for (k = 2; k < l; k++) S = gadd(S, gmul(gel(T,k-1), gel(x,k)));
     461       39494 :   return S;
     462             : }
     463             : /* v = Qab_trace_init(n,m); x is a t_VEC of polmodulo Phi_n
     464             :  * Tr_{Q(zeta_n)/Q(zeta_m)} (zeta_n^t * x) */
     465             : GEN
     466        3514 : QabV_tracerel(GEN v, long t, GEN x)
     467             : {
     468             :   long d, dm, lx, j, degrel;
     469             :   GEN y, z, Pm, Pn, T;
     470        3514 :   if (lg(v) != 4) return x;
     471        3514 :   y = cgetg_copy(x, &lx);
     472        3514 :   Pm = gel(v,1);
     473        3514 :   Pn = gel(v,2);
     474        3514 :   T  = gel(v,3);
     475        3514 :   d = degpol(Pn);
     476        3514 :   dm = degpol(Pm); degrel = d / dm;
     477        3514 :   z = RgX_rem(pol_xn(t, varn(Pn)), Pn);
     478       83055 :   for (j = 1; j < lx; j++)
     479             :   {
     480       79541 :     GEN a = liftpol_shallow(gel(x,j));
     481       79541 :     a = simplify_shallow( gmul(a, z) );
     482       79541 :     if (typ(a) == t_POL)
     483             :     {
     484       39494 :       a = gdivgs(tracerel_i(T, RgX_rem(a, Pn)), degrel);
     485       39494 :       if (typ(a) == t_POL) a = RgX_rem(a, Pm);
     486             :     }
     487       79541 :     gel(y,j) = a;
     488             :   }
     489        3514 :   return y;
     490             : }
     491             : 
     492             : /*              Operations on Dirichlet characters                       */
     493             : 
     494             : /* A Dirichlet character can be given in GP in different formats, but in this
     495             :  * package, it will be a vector CHI=[G,chi,ord], where G is the (Z/MZ)^* to
     496             :  * which the character belongs, chi is the character in Conrey format, ord is
     497             :  * the order */
     498             : 
     499             : static GEN
     500      651854 : gmfcharorder(GEN CHI) { return gel(CHI, 3); }
     501             : long
     502      624561 : mfcharorder(GEN CHI) { return itou(gmfcharorder(CHI)); }
     503             : static long
     504        5404 : mfcharistrivial(GEN CHI) { return !CHI || mfcharorder(CHI) == 1; }
     505             : static GEN
     506      461153 : gmfcharmodulus(GEN CHI) { return gmael3(CHI, 1, 1, 1); }
     507             : long
     508      461153 : mfcharmodulus(GEN CHI) { return itou(gmfcharmodulus(CHI)); }
     509             : GEN
     510      128604 : mfcharpol(GEN CHI) { return gel(CHI,4); }
     511             : static long
     512      444969 : ord_canon(long ord)
     513             : {
     514      444969 :   if ((ord & 3L) == 2) ord >>= 1;
     515      444969 :   return ord;
     516             : }
     517             : static long
     518       26348 : mfcharorder_canon(GEN CHI) { return ord_canon(mfcharorder(CHI)); }
     519             : 
     520             : /* t^k mod polcyclo(ord), ord = order(CHI) > 1 */
     521             : static GEN
     522         735 : mygmodulo(GEN CHI, long k)
     523             : {
     524             :   GEN C, Pn;
     525             :   long ord;
     526         735 :   if (!k) return gen_1;
     527         588 :   ord = mfcharorder(CHI);
     528         588 :   if ((k << 1) == ord) return gen_m1;
     529         441 :   Pn = mfcharpol(CHI);
     530         441 :   if ((ord&3L) != 2)
     531          91 :     C = gen_1;
     532             :   else
     533             :   {
     534         350 :     ord >>= 1;
     535         350 :     if (odd(k)) { C = gen_m1; k += ord; } else C = gen_1;
     536         350 :     k >>= 1;
     537             :   }
     538         441 :   return gmodulo(monomial(C, k, varn(Pn)), Pn);
     539             : }
     540             : /* C*zeta_ord^k */
     541             : static GEN
     542      467404 : mygmodulo_lift(long k, long ord, GEN C, long vt)
     543             : {
     544      467404 :   if (!k) return C;
     545      263186 :   if ((k << 1) == ord) return gneg(C);
     546      194810 :   if ((ord&3L) == 2)
     547             :   {
     548       83657 :     if (odd(k)) { C = gneg(C); k += ord >> 1; }
     549       83657 :     k >>= 1;
     550             :   }
     551      194810 :   return monomial(C, k, vt);
     552             : }
     553             : /* vz[i+1] = image of (zeta_ord)^i in Fp */
     554             : static ulong
     555      121604 : mygmodulo_Fl(long k, GEN vz, ulong C, ulong p)
     556             : {
     557             :   long ord;
     558      121604 :   if (!k) return C;
     559       82999 :   ord = lg(vz)-2;
     560       82999 :   if ((k << 1) == ord) return Fl_neg(C,p);
     561       71568 :   if ((ord&3L) == 2)
     562             :   {
     563       69748 :     if (odd(k)) { C = Fl_neg(C,p); k += ord >> 1; }
     564       69748 :     k >>= 1;
     565             :   }
     566       71568 :   return Fl_mul(C, vz[k+1], p);
     567             : }
     568             : 
     569             : static long
     570      287112 : znchareval_i(GEN CHI, long n, GEN ord)
     571      287112 : { return itos(znchareval(gel(CHI,1), gel(CHI,2), stoi(n), ord)); }
     572             : 
     573             : /* G a znstar, L a Conrey log: return a 'mfchar' */
     574             : static GEN
     575      367206 : mfcharGL(GEN G, GEN L)
     576             : {
     577      367206 :   GEN o = zncharorder(G,L);
     578      367206 :   long ord = ord_canon(itou(o)), vt = fetch_user_var("t");
     579      367206 :   return mkvec4(G, L, o, polcyclo(ord,vt));
     580             : }
     581             : static GEN
     582        3570 : mfchartrivial()
     583        3570 : { return mfcharGL(znstar0(gen_1,1), cgetg(1,t_COL)); }
     584             : /* convert a generic character into an 'mfchar' */
     585             : static GEN
     586        3661 : get_mfchar(GEN CHI)
     587             : {
     588             :   GEN G, L;
     589        3661 :   if (typ(CHI) != t_VEC)
     590        2842 :     CHI = znchar(CHI);
     591        3654 :   if (lg(CHI) == 5 && checkznstar_i(gel(CHI, 1))) return CHI;
     592        3647 :   else if (lg(CHI) != 3 || !checkznstar_i(gel(CHI,1)))
     593           7 :     pari_err_TYPE("checkNF [chi]", CHI);
     594        3640 :   G = gel(CHI,1);
     595        3640 :   L = gel(CHI,2); if (typ(L) != t_COL) L = znconreylog(G,L);
     596        3640 :   return mfcharGL(G, L);
     597             : }
     598             : 
     599             : /* parse [N], [N,k], [N,k,CHI]. If 'joker' is set, allow wildcard for CHI */
     600             : static GEN
     601        8834 : checkCHI(GEN NK, long N, int joker)
     602             : {
     603             :   GEN CHI;
     604        8834 :   if (lg(NK) == 3)
     605         539 :     CHI = mfchartrivial();
     606             :   else
     607             :   {
     608             :     long i, l;
     609        8295 :     CHI = gel(NK,3); l = lg(CHI);
     610        8295 :     if (isintzero(CHI) && joker)
     611        4088 :       CHI = NULL; /* all character orbits */
     612        4207 :     else if (isintm1(CHI) && joker > 1)
     613        2373 :       CHI = gen_m1; /* sum over all character orbits */
     614        1967 :     else if ((typ(CHI) == t_VEC &&
     615         189 :              (l == 1 || l != 3 || !checkznstar_i(gel(CHI,1)))) && joker)
     616             :     {
     617         133 :       CHI = shallowtrans(CHI); /* list of characters */
     618         133 :       for (i = 1; i < l; i++) gel(CHI,i) = get_mfchar(gel(CHI,i));
     619             :     }
     620             :     else
     621             :     {
     622        1701 :       CHI = get_mfchar(CHI); /* single char */
     623        1701 :       if (N % mfcharmodulus(CHI)) pari_err_TYPE("checkNF [chi]", NK);
     624             :     }
     625             :   }
     626        8820 :   return CHI;
     627             : }
     628             : /* support half-integral weight */
     629             : static void
     630        8841 : checkNK2(GEN NK, long *N, long *nk, long *dk, GEN *CHI, int joker)
     631             : {
     632        8841 :   long l = lg(NK);
     633             :   GEN T;
     634        8841 :   if (typ(NK) != t_VEC || l < 3 || l > 4) pari_err_TYPE("checkNK", NK);
     635        8841 :   T = gel(NK,1); if (typ(T) != t_INT) pari_err_TYPE("checkNF [N]", NK);
     636        8841 :   *N = itos(T); if (*N <= 0) pari_err_TYPE("checkNF [N <= 0]", NK);
     637        8841 :   T = gel(NK,2);
     638        8841 :   switch(typ(T))
     639             :   {
     640        5509 :     case t_INT:  *nk = itos(T); *dk = 1; break;
     641             :     case t_FRAC:
     642        3325 :       *nk = itos(gel(T,1));
     643        3325 :       *dk = itou(gel(T,2)); if (*dk == 2) break;
     644           7 :     default: pari_err_TYPE("checkNF [k]", NK);
     645             :   }
     646        8834 :   *CHI = checkCHI(NK, *N, joker);
     647        8820 : }
     648             : /* don't support half-integral weight */
     649             : static void
     650         119 : checkNK(GEN NK, long *N, long *k, GEN *CHI, int joker)
     651             : {
     652             :   long d;
     653         119 :   checkNK2(NK, N, k, &d, CHI, joker);
     654         119 :   if (d != 1) pari_err_TYPE("checkNF [k]", NK);
     655         119 : }
     656             : 
     657             : static GEN
     658        4844 : mfchargalois(long N, int odd, GEN flagorder)
     659             : {
     660        4844 :   GEN G = znstar0(utoi(N), 1), L = chargalois(G, flagorder);
     661        4844 :   long l = lg(L), i, j;
     662      112476 :   for (i = j = 1; i < l; i++)
     663             :   {
     664      107632 :     GEN chi = znconreyfromchar(G, gel(L,i));
     665      107632 :     if (zncharisodd(G,chi) == odd) gel(L,j++) = mfcharGL(G,chi);
     666             :   }
     667        4844 :   setlg(L, j); return L;
     668             : }
     669             : /* possible characters for non-trivial S_1(N, chi) */
     670             : static GEN
     671        1701 : mfwt1chars(long N, GEN vCHI)
     672             : {
     673        1701 :   if (vCHI) return vCHI; /*do not filter, user knows best*/
     674             :   /* Tate's theorem */
     675        1631 :   return mfchargalois(N, 1, uisprime(N)? mkvecsmall2(2,4): NULL);
     676             : }
     677             : static GEN
     678        3255 : mfchars(long N, long k, long dk, GEN vCHI)
     679        3255 : { return vCHI? vCHI: mfchargalois(N, (dk == 2)? 0: (k & 1), NULL); }
     680             : 
     681             : /* wrappers from mfchar to znchar */
     682             : static long
     683       64092 : mfcharparity(GEN CHI)
     684             : {
     685       64092 :   if (!CHI) return 1;
     686       64092 :   return zncharisodd(gel(CHI,1), gel(CHI,2)) ? -1 : 1;
     687             : }
     688             : /* if CHI is primitive, return CHI itself, not a copy */
     689             : static GEN
     690       60655 : mfchartoprimitive(GEN CHI, long *pF)
     691             : {
     692             :   pari_sp av;
     693             :   GEN chi, F;
     694       60655 :   if (!CHI) { if (pF) *pF = 1; return mfchartrivial(); }
     695       60655 :   av = avma; F = znconreyconductor(gel(CHI,1), gel(CHI,2), &chi);
     696       60655 :   if (typ(F) == t_INT) avma = av;
     697             :   else
     698             :   {
     699        6916 :     CHI = leafcopy(CHI);
     700        6916 :     gel(CHI,1) = znstar0(F, 1);
     701        6916 :     gel(CHI,2) = chi;
     702             :   }
     703       60655 :   if (pF) *pF = mfcharmodulus(CHI);
     704       60655 :   return CHI;
     705             : }
     706             : static long
     707      389403 : mfcharconductor(GEN CHI)
     708             : {
     709      389403 :   pari_sp ltop = avma;
     710      389403 :   GEN res = znconreyconductor(gel(CHI,1), gel(CHI,2), NULL);
     711             :   long FC;
     712      389403 :   if (typ(res) == t_VEC) res = gel(res, 1);
     713      389403 :   FC = itos(res); avma = ltop; return FC;
     714             : }
     715             : 
     716             : /* n coprime with the modulus of CHI */
     717             : static GEN
     718        4662 : mfchareval_i(GEN CHI, long n)
     719             : {
     720        4662 :   GEN ord = gmfcharorder(CHI);
     721        4662 :   if (equali1(ord)) return gen_1;
     722         735 :   return mygmodulo(CHI, znchareval_i(CHI, n, ord));
     723             : }
     724             : static GEN
     725         777 : mfchareval(GEN CHI, long n)
     726             : {
     727         777 :   long N = mfcharmodulus(CHI);
     728         777 :   return (cgcd(N, n) > 1) ? gen_0 : mfchareval_i(CHI, n);
     729             : }
     730             : /* d a multiple of ord(CHI); n coprime with char modulus;
     731             :  * return x s.t. CHI(n) = \zeta_d^x] */
     732             : static long
     733      535556 : mfcharevalord(GEN CHI, long n, long d)
     734             : {
     735      535556 :   if (mfcharorder(CHI) == 1) return 0;
     736      279825 :   return znchareval_i(CHI, n, utoi(d));
     737             : }
     738             : 
     739             : /*                      Operations on mf closures                    */
     740             : static GEN
     741       44681 : tagparams(long t, GEN NK) { return mkvec2(mkvecsmall(t), NK); }
     742             : static GEN
     743         749 : lfuntag(long t, GEN x) { return mkvec2(mkvecsmall(t), x); }
     744             : static GEN
     745          49 : tag0(long t, GEN NK) { retmkvec(tagparams(t,NK)); }
     746             : static GEN
     747        8134 : tag(long t, GEN NK, GEN x) { retmkvec2(tagparams(t,NK), x); }
     748             : static GEN
     749       25459 : tag2(long t, GEN NK, GEN x, GEN y) { retmkvec3(tagparams(t,NK), x,y); }
     750             : static GEN
     751       10934 : tag3(long t, GEN NK, GEN x,GEN y,GEN z) { retmkvec4(tagparams(t,NK), x,y,z); }
     752             : /* is F a "modular form" ? */
     753             : int
     754       13076 : checkmf_i(GEN F)
     755       26152 : { return typ(F) == t_VEC
     756       12677 :     && lg(F) > 1 && typ(gel(F,1)) == t_VEC
     757        8764 :     && lg(gel(F,1)) == 3
     758        8603 :     && typ(gmael(F,1,1)) == t_VECSMALL
     759       21679 :     && typ(gmael(F,1,2)) == t_VEC; }
     760      119371 : long mf_get_type(GEN F) { return gmael(F,1,1)[1]; }
     761       88172 : GEN mf_get_gN(GEN F) { return gmael3(F,1,2,1); }
     762       75628 : GEN mf_get_gk(GEN F) { return gmael3(F,1,2,2); }
     763             : /* k - 1/2, assume k in 1/2 + Z */
     764         266 : long mf_get_r(GEN F) { return itou(gel(mf_get_gk(F),1)) >> 1; }
     765       62902 : long mf_get_N(GEN F) { return itou(mf_get_gN(F)); }
     766       43638 : long mf_get_k(GEN F)
     767             : {
     768       43638 :   GEN gk = mf_get_gk(F);
     769       43638 :   if (typ(gk)!=t_INT) pari_err_IMPL("half-integral weight");
     770       43638 :   return itou(gk);
     771             : }
     772       26327 : GEN mf_get_CHI(GEN F) { return gmael3(F,1,2,3); }
     773       15708 : GEN mf_get_field(GEN F) { return gmael3(F,1,2,4); }
     774       14630 : GEN mf_get_NK(GEN F) { return gmael(F,1,2); }
     775             : static void
     776         280 : mf_setfield(GEN f, GEN P)
     777             : {
     778         280 :   gel(f,1) = leafcopy(gel(f,1));
     779         280 :   gmael(f,1,2) = leafcopy(gmael(f,1,2));
     780         280 :   gmael3(f,1,2,4) = P;
     781         280 : }
     782             : 
     783             : /* UTILITY FUNCTIONS */
     784             : GEN
     785        3339 : mftocol(GEN F, long lim, long d)
     786        3339 : { GEN c = mfcoefs_i(F, lim, d); settyp(c,t_COL); return c; }
     787             : GEN
     788         945 : mfvectomat(GEN vF, long lim, long d)
     789             : {
     790         945 :   long j, l = lg(vF);
     791         945 :   GEN M = cgetg(l, t_MAT);
     792         945 :   for (j = 1; j < l; j++) gel(M,j) = mftocol(gel(vF,j), lim, d);
     793         945 :   return M;
     794             : }
     795             : 
     796             : static GEN
     797        3234 : RgV_to_ser(GEN x, long v)
     798             : {
     799        3234 :   long j, lx = lg(x);
     800        3234 :   GEN y = cgetg(lx+1, t_SER);
     801        3234 :   y[1] = evalvarn(v)|evalvalp(0);
     802        3234 :   x--;
     803        3234 :   for (j = 2; j <= lx; j++) gel(y, j) = gel(x, j);
     804        3234 :   return normalize(y);
     805             : }
     806             : 
     807             : /* TODO: delete */
     808             : static GEN
     809         770 : mfcoefsser(GEN F, long n) { return RgV_to_ser(mfcoefs_i(F,n,1), 0); }
     810             : static GEN
     811         315 : sertovecslice(GEN S, long n)
     812             : {
     813         315 :   GEN v = gtovec0(S, -(lg(S) - 2 + valp(S)));
     814         315 :   long l = lg(v), n2 = n + 2;
     815         315 :   if (l < n2) pari_err_BUG("sertovecslice [n too large]");
     816         315 :   return (l == n2)? v: vecslice(v, 1, n2-1);
     817             : }
     818             : 
     819             : /* a, b two RgV of the same length, multiply as truncated power series */
     820             : static GEN
     821        2674 : RgV_mul_RgXn(GEN a, GEN b)
     822             : {
     823        2674 :   long n = lg(a)-1;
     824             :   GEN c;
     825        2674 :   a = RgV_to_RgX(a,0);
     826        2674 :   b = RgV_to_RgX(b,0); c = RgXn_mul(a, b, n);
     827        2674 :   c = RgX_to_RgC(c,n); settyp(c,t_VEC); return c;
     828             : }
     829             : /* divide as truncated power series */
     830             : static GEN
     831          63 : RgV_div_RgXn(GEN a, GEN b)
     832             : {
     833          63 :   long n = lg(a)-1;
     834             :   GEN c;
     835          63 :   a = RgV_to_RgX(a,0);
     836          63 :   b = RgV_to_RgX(b,0); c = RgXn_mul(a, RgXn_inv(b,n), n);
     837          63 :   c = RgX_to_RgC(c,n); settyp(c,t_VEC); return c;
     838             : }
     839             : /* a^b */
     840             : static GEN
     841          77 : RgV_pows_RgXn(GEN a, long b)
     842             : {
     843          77 :   long n = lg(a)-1;
     844             :   GEN c;
     845          77 :   a = RgV_to_RgX(a,0);
     846          77 :   if (b < 0) { a = RgXn_inv(a, n); b = -b; }
     847          77 :   c = RgXn_powu_i(a,b,n);
     848          77 :   c = RgX_to_RgC(c,n); settyp(c,t_VEC); return c;
     849             : }
     850             : 
     851             : /* assume lg(V) >= n*d + 2 */
     852             : static GEN
     853        5299 : c_deflate(long n, long d, GEN v)
     854             : {
     855        5299 :   long i, id, l = n+2;
     856             :   GEN w;
     857        5299 :   if (d == 1) return lg(v) == l ? v: vecslice(v, 1, l-1);
     858         259 :   w = cgetg(l, t_VEC);
     859         259 :   for (i = id = 1; i < l; i++, id += d) gel(w, i) = gel(v, id);
     860         259 :   return w;
     861             : }
     862             : static GEN
     863         371 : c_mul(long n, long d, GEN F, GEN G)
     864             : {
     865         371 :   pari_sp av = avma;
     866         371 :   long nd = n*d;
     867         371 :   GEN VF = mfcoefs_i(F, nd, 1);
     868         371 :   GEN VG = mfcoefs_i(G, nd, 1);
     869         371 :   return gerepilecopy(av, c_deflate(n, d, RgV_mul_RgXn(VF,VG)));
     870             : }
     871             : static GEN
     872          77 : c_pow(long n, long d, GEN F, GEN a)
     873             : {
     874          77 :   pari_sp av = avma;
     875          77 :   long nd = n*d;
     876          77 :   GEN f = RgV_pows_RgXn(mfcoefs_i(F,nd,1), itos(a));
     877          77 :   return gerepilecopy(av, c_deflate(n, d, f));
     878             : }
     879             : 
     880             : /* F * Theta */
     881             : static GEN
     882         154 : mfmultheta(GEN F)
     883             : {
     884         154 :   if (typ(mf_get_gk(F)) == t_FRAC && mf_get_type(F) == t_MF_DIV)
     885             :   {
     886          63 :     GEN T = gel(F,3); /* hopefully mfTheta() */
     887          63 :     if (mf_get_type(T) == t_MF_THETA && mf_get_N(T) == 4) return gel(F,2);
     888             :   }
     889          91 :   return mfmul(F, mfTheta(NULL));
     890             : }
     891             : 
     892             : static GEN
     893          21 : c_bracket(long n, long d, GEN F, GEN G, GEN gm)
     894             : {
     895          21 :   pari_sp av = avma;
     896          21 :   long i, nd = n*d;
     897          21 :   GEN VF = mfcoefs_i(F, nd, 1), tF = cgetg(nd+2, t_VEC);
     898          21 :   GEN VG = mfcoefs_i(G, nd, 1), tG = cgetg(nd+2, t_VEC);
     899          21 :   GEN C, mpow, res = NULL, gk = mf_get_gk(F), gl = mf_get_gk(G);
     900          21 :   ulong j, m = itou(gm);
     901             :   /* pow[i,j+1] = i^j */
     902          21 :   mpow = cgetg(m+2, t_MAT);
     903          21 :   gel(mpow,1) = const_col(nd, gen_1);
     904          49 :   for (j = 1; j <= m; j++)
     905             :   {
     906          28 :     GEN c = cgetg(nd+1, t_COL);
     907          28 :     gel(mpow,j+1) = c;
     908          28 :     for (i = 1; i <= nd; i++) gel(c,i) = muliu(gcoeff(mpow,i,j), i);
     909             :   }
     910          21 :   C = binomial(gaddgs(gk, m-1), m);
     911          70 :   for (j = 0; j <= m; j++)
     912             :   { /* C = (-1)^j binom(m+l-1, j) binom(m+k-1,m-j) */
     913             :     GEN c;
     914          49 :     gel(tF,1) = j == 0? gel(VF,1): gen_0;
     915          49 :     gel(tG,1) = j == m? gel(VG,1): gen_0;
     916         462 :     for (i = 1; i <= nd; i++)
     917             :     {
     918         413 :       gel(tF, i+1) = gmul(gcoeff(mpow,i,j+1),   gel(VF, i+1));
     919         413 :       gel(tG, i+1) = gmul(gcoeff(mpow,i,m-j+1), gel(VG, i+1));
     920             :     }
     921          49 :     c = gmul(C, c_deflate(n, d, RgV_mul_RgXn(tF, tG)));
     922          49 :     res = res? gadd(res, c): c;
     923          49 :     if (j < m)
     924          52 :       C = gdiv(gmul(C, gmulsg(m-j, gaddgs(gl,m-j-1))),
     925          24 :                gmulsg(-(j+1), gaddgs(gk,j)));
     926             :   }
     927          21 :   return gerepileupto(av, res);
     928             : }
     929             : /* linear combination \sum L[j] vecF[j] */
     930             : static GEN
     931        2226 : c_linear(long n, long d, GEN F, GEN L, GEN dL)
     932             : {
     933        2226 :   pari_sp av = avma;
     934        2226 :   long j, l = lg(L);
     935        2226 :   GEN S = NULL;
     936        7084 :   for (j = 1; j < l; j++)
     937             :   {
     938        4858 :     GEN c = gel(L,j);
     939        4858 :     if (gequal0(c)) continue;
     940        4291 :     c = gmul(c, mfcoefs_i(gel(F,j), n, d));
     941        4291 :     S = S? gadd(S,c): c;
     942             :   }
     943        2226 :   if (!S) return zerovec(n+1);
     944        2226 :   if (!is_pm1(dL)) S = gdiv(S, dL);
     945        2226 :   return gerepileupto(av, S);
     946             : }
     947             : 
     948             : /* B_d(T_j Trace^new) as t_MF_BD(t_MF_HECKE(t_MF_NEWTRACE)) or
     949             :  * t_MF_HECKE(t_MF_NEWTRACE)
     950             :  * or t_MF_NEWTRACE in level N. Set d and j, return t_MF_NEWTRACE component*/
     951             : static GEN
     952       49637 : bhn_parse(GEN f, long *d, long *j)
     953             : {
     954       49637 :   long t = mf_get_type(f);
     955       49637 :   *d = *j = 1;
     956       49637 :   if (t == t_MF_BD) { *d = itos(gel(f,3)); f = gel(f,2); t = mf_get_type(f); }
     957       49637 :   if (t == t_MF_HECKE) { *j = gel(f,2)[1]; f = gel(f,3); }
     958       49637 :   return f;
     959             : }
     960             : /* f as above, return the t_MF_NEWTRACE component */
     961             : static GEN
     962       12341 : bhn_newtrace(GEN f)
     963             : {
     964       12341 :   long t = mf_get_type(f);
     965       12341 :   if (t == t_MF_BD) { f = gel(f,2); t = mf_get_type(f); }
     966       12341 :   if (t == t_MF_HECKE) f = gel(f,3);
     967       12341 :   return f;
     968             : }
     969             : static int
     970        2219 : ok_bhn_linear(GEN vf)
     971             : {
     972        2219 :   long i, N0 = 0, l = lg(vf);
     973             :   GEN CHI, gk;
     974        2219 :   if (l == 1) return 1;
     975        2219 :   gk = mf_get_gk(gel(vf,1));
     976        2219 :   CHI = mf_get_CHI(gel(vf,1));
     977        8477 :   for (i = 1; i < l; i++)
     978             :   {
     979        7623 :     GEN f = bhn_newtrace(gel(vf,i));
     980        7623 :     long N = mf_get_N(f);
     981        7623 :     if (mf_get_type(f) != t_MF_NEWTRACE) return 0;
     982        6258 :     if (N < N0) return 0; /* largest level must come last */
     983        6258 :     N0 = N;
     984        6258 :     if (!gequal(gk,mf_get_gk(f))) return 0; /* same k */
     985        6258 :     if (!gequal(gel(mf_get_CHI(f),2), gel(CHI,2))) return 0; /* same CHI */
     986             :   }
     987         854 :   return 1;
     988             : }
     989             : 
     990             : /* vF not empty, same hypotheses as bhnmat_extend */
     991             : static GEN
     992        4788 : bhnmat_extend_nocache(GEN M, long N, long n, long d, GEN vF)
     993             : {
     994             :   cachenew_t cache;
     995        4788 :   long l = lg(vF);
     996             :   GEN f;
     997        4788 :   if (l == 1) return M? M: cgetg(1, t_MAT);
     998        4718 :   f = bhn_newtrace(gel(vF,1)); /* N.B. mf_get_N(f) divides N */
     999        4718 :   init_cachenew(&cache, n*d, N, f);
    1000        4718 :   M = bhnmat_extend(M, n, d, vF, &cache);
    1001        4718 :   dbg_cachenew(&cache); return M;
    1002             : }
    1003             : /* c_linear of "bhn" mf closures, same hypotheses as bhnmat_extend */
    1004             : static GEN
    1005         931 : c_linear_bhn(long n, long d, GEN F)
    1006             : {
    1007             :   pari_sp av;
    1008         931 :   GEN M, v, vF = gel(F,2), L = gel(F,3), dL = gel(F,4);
    1009         931 :   if (lg(L) == 1) return zerovec(n+1);
    1010         931 :   av = avma;
    1011         931 :   M = bhnmat_extend_nocache(NULL, mf_get_N(F), n, d, vF);
    1012         931 :   v = RgM_RgC_mul(M,L); settyp(v, t_VEC);
    1013         931 :   if (!is_pm1(dL)) v = gdiv(v, dL);
    1014         931 :   return gerepileupto(av, v);
    1015             : }
    1016             : 
    1017             : /* c in K, K := Q[X]/(T) vz = vector of consecutive powers of root z of T
    1018             :  * attached to an embedding s: K -> C. Return s(c) in C */
    1019             : static GEN
    1020       61166 : Rg_embed1(GEN c, GEN vz)
    1021             : {
    1022       61166 :   long t = typ(c);
    1023       61166 :   if (t == t_POLMOD) { c = gel(c,2); t = typ(c); }
    1024       61166 :   if (t == t_POL) c = RgX_RgV_eval(c, vz);
    1025       61166 :   return c;
    1026             : }
    1027             : /* return s(P) in C[X] */
    1028             : static GEN
    1029         847 : RgX_embed1(GEN P, GEN vz)
    1030             : {
    1031             :   long i, l;
    1032         847 :   GEN Q = cgetg_copy(P, &l);
    1033         847 :   Q[1] = P[1];
    1034         847 :   for (i = 2; i < l; i++) gel(Q,i) = Rg_embed1(gel(P,i), vz);
    1035         847 :   return normalizepol_lg(Q,l); /* normally a no-op */
    1036             : }
    1037             : /* return s(P) in C^n */
    1038             : static GEN
    1039         336 : vecembed1(GEN P, GEN vz)
    1040             : {
    1041             :   long i, l;
    1042         336 :   GEN Q = cgetg_copy(P, &l);
    1043         336 :   for (i = 1; i < l; i++) gel(Q,i) = Rg_embed1(gel(P,i), vz);
    1044         336 :   return Q;
    1045             : }
    1046             : /* P in L = K[X]/(U), K = Q[t]/T; s an embedding of K -> C attached
    1047             :  * to a root of T, extended to an embedding of L -> C attached to a root
    1048             :  * of s(U); vT powers of the root of T, vU powers of the root of s(U).
    1049             :  * Return s(P) in C^n */
    1050             : static GEN
    1051       13286 : Rg_embed2(GEN P, long vt, GEN vT, GEN vU)
    1052             : {
    1053             :   long i, l;
    1054             :   GEN Q;
    1055       13286 :   P = liftpol_shallow(P);
    1056       13286 :   if (typ(P) != t_POL) return P;
    1057       13286 :   if (varn(P) == vt) return Rg_embed1(P, vT);
    1058             :   /* varn(P) == vx */
    1059       13286 :   Q = cgetg_copy(P, &l); Q[1] = P[1];
    1060       13286 :   for (i = 2; i < l; i++) gel(Q,i) = Rg_embed1(gel(P,i), vT);
    1061       13286 :   return Rg_embed1(Q, vU);
    1062             : }
    1063             : static GEN
    1064          28 : vecembed2(GEN P, long vt, GEN vT, GEN vU)
    1065             : {
    1066             :   long i, l;
    1067          28 :   GEN Q = cgetg_copy(P, &l);
    1068          28 :   for (i = 1; i < l; i++) gel(Q,i) = Rg_embed2(gel(P,i), vt, vT, vU);
    1069          28 :   return Q;
    1070             : }
    1071             : static GEN
    1072         532 : RgX_embed2(GEN P, long vt, GEN vT, GEN vU)
    1073             : {
    1074             :   long i, l;
    1075         532 :   GEN Q = cgetg_copy(P, &l);
    1076         532 :   for (i = 2; i < l; i++) gel(Q,i) = Rg_embed2(gel(P,i), vt, vT, vU);
    1077         532 :   Q[1] = P[1]; return normalizepol_lg(Q,l);
    1078             : }
    1079             : /* embed polynomial f in variable vx [ may be a scalar ], E from getembed */
    1080             : static GEN
    1081        1561 : RgX_embed(GEN f, long vx, GEN E)
    1082             : {
    1083             :   GEN vT;
    1084        1561 :   if (typ(f) != t_POL || varn(f) != vx) return mfembed(E, f);
    1085        1540 :   if (lg(E) == 1) return f;
    1086        1344 :   vT = gel(E,2);
    1087        1344 :   if (lg(E) == 3)
    1088         812 :     f = RgX_embed1(f, vT);
    1089             :   else
    1090         532 :     f = RgX_embed2(f, varn(gel(E,1)), vT, gel(E,3));
    1091        1344 :   return f;
    1092             : }
    1093             : /* embed vector, E from getembed */
    1094             : GEN
    1095        1092 : mfvecembed(GEN E, GEN v)
    1096             : {
    1097             :   GEN vT;
    1098        1092 :   if (lg(E) == 1) return v;
    1099         364 :   vT = gel(E,2);
    1100         364 :   if (lg(E) == 3)
    1101         336 :     v = vecembed1(v, vT);
    1102             :   else
    1103          28 :     v = vecembed2(v, varn(gel(E,1)), vT, gel(E,3));
    1104         364 :   return v;
    1105             : }
    1106             : GEN
    1107           0 : mfmatembed(GEN E, GEN f)
    1108             : {
    1109             :   long i, l;
    1110             :   GEN g;
    1111           0 :   if (lg(E) == 1) return f;
    1112           0 :   g = cgetg_copy(f, &l);
    1113           0 :   for (i = 1; i < l; i++) gel(g,i) = mfvecembed(E, gel(f,i));
    1114           0 :   return g;
    1115             : }
    1116             : /* embed vector of polynomials in var vx */
    1117             : static GEN
    1118          98 : RgXV_embed(GEN f, long vx, GEN E)
    1119             : {
    1120             :   long i, l;
    1121             :   GEN v;
    1122          98 :   if (lg(E) == 1) return f;
    1123          70 :   v = cgetg_copy(f, &l);
    1124          70 :   for (i = 1; i < l; i++) gel(v,i) = RgX_embed(gel(f,i), vx, E);
    1125          70 :   return v;
    1126             : }
    1127             : 
    1128             : /* embed scalar */
    1129             : GEN
    1130       19061 : mfembed(GEN E, GEN f)
    1131             : {
    1132             :   GEN vT;
    1133       19061 :   if (lg(E) == 1) return f;
    1134       13321 :   vT = gel(E,2);
    1135       13321 :   if (lg(E) == 3)
    1136        4207 :     f = Rg_embed1(f, vT);
    1137             :   else
    1138        9114 :     f = Rg_embed2(f, varn(gel(E,1)), vT, gel(E,3));
    1139       13321 :   return f;
    1140             : }
    1141             : /* vector of the sigma(f), sigma in vE */
    1142             : static GEN
    1143         259 : RgX_embedall(GEN f, long vx, GEN vE)
    1144             : {
    1145         259 :   long i, l = lg(vE);
    1146         259 :   GEN v = cgetg(l, t_VEC);
    1147         259 :   for (i = 1; i < l; i++) gel(v,i) = RgX_embed(f, vx, gel(vE,i));
    1148         259 :   return l == 2? gel(v,1): v;
    1149             : }
    1150             : /* matrix whose colums are the sigma(v), sigma in vE */
    1151             : static GEN
    1152         280 : RgC_embedall(GEN v, GEN vE)
    1153             : {
    1154         280 :   long j, l = lg(vE);
    1155         280 :   GEN M = cgetg(l, t_MAT);
    1156         280 :   for (j = 1; j < l; j++) gel(M,j) = mfvecembed(gel(vE,j), v);
    1157         280 :   return M;
    1158             : }
    1159             : /* vector of the sigma(v), sigma in vE */
    1160             : static GEN
    1161       13783 : Rg_embedall(GEN v, GEN vE)
    1162             : {
    1163       13783 :   long j, l = lg(vE);
    1164       13783 :   GEN M = cgetg(l, t_VEC);
    1165       13783 :   for (j = 1; j < l; j++) gel(M,j) = mfembed(gel(vE,j), v);
    1166       13783 :   return M;
    1167             : }
    1168             : 
    1169             : static GEN
    1170         224 : c_div_i(long n, GEN F, GEN G)
    1171             : {
    1172             :   GEN VF, VG, a0, a0i, H;
    1173         224 :   VF = mfcoefsser(F, n); VG = mfcoefsser(G, n);
    1174         224 :   a0 = polcoeff_i(VG, 0, -1);
    1175         224 :   if (gequal0(a0) || gequal1(a0)) a0 = a0i = NULL;
    1176             :   else
    1177             :   {
    1178          49 :     a0i = ginv(a0);
    1179          49 :     VG = gmul(ser_unscale(VG,a0), a0i);
    1180          49 :     VF = gmul(ser_unscale(VF,a0), a0i);
    1181             :   }
    1182         224 :   H = gdiv(VF, VG);
    1183         224 :   if (a0) H = ser_unscale(H,a0i);
    1184         224 :   return sertovecslice(H, n);
    1185             : }
    1186             : static GEN
    1187         224 : c_div(long n, long d, GEN F, GEN G)
    1188             : {
    1189         224 :   pari_sp av = avma;
    1190         224 :   GEN D = (d==1)? c_div_i(n, F,G): c_deflate(n, d, c_div_i(n*d, F,G));
    1191         224 :   return gerepilecopy(av, D);
    1192             : }
    1193             : 
    1194             : static GEN
    1195          35 : c_shift(long n, long d, GEN F, GEN gsh)
    1196             : {
    1197          35 :   pari_sp av = avma;
    1198             :   GEN vF;
    1199          35 :   long sh = itos(gsh), n1 = n*d + sh;
    1200          35 :   if (n1 < 0) return zerovec(n+1);
    1201          35 :   vF = mfcoefs_i(F, n1, 1);
    1202          35 :   if (sh < 0) vF = shallowconcat(zerovec(-sh), vF);
    1203          35 :   else vF = vecslice(vF, sh+1, n1+1);
    1204          35 :   return gerepilecopy(av, c_deflate(n, d, vF));
    1205             : }
    1206             : 
    1207             : static GEN
    1208          21 : c_deriv(long n, long d, GEN F, GEN gm)
    1209             : {
    1210          21 :   pari_sp av = avma;
    1211          21 :   GEN V = mfcoefs_i(F, n, d), res;
    1212          21 :   long i, m = itos(gm);
    1213          21 :   if (!m) return V;
    1214          21 :   res = cgetg(n+2, t_VEC); gel(res,1) = gen_0;
    1215          21 :   if (m < 0)
    1216           7 :   { for (i=1; i <= n; i++) gel(res, i+1) = gdiv(gel(V, i+1), powuu(i,-m)); }
    1217             :   else
    1218          14 :   { for (i=1; i <= n; i++) gel(res, i+1) = gmul(gel(V,i+1), powuu(i,m)); }
    1219          21 :   return gerepileupto(av, res);
    1220             : }
    1221             : 
    1222             : static GEN
    1223          14 : c_derivE2(long n, long d, GEN F, GEN gm)
    1224             : {
    1225          14 :   pari_sp av = avma;
    1226             :   GEN VF, VE, res, tmp, gk;
    1227          14 :   long i, m = itos(gm), nd;
    1228          14 :   if (m == 0) return mfcoefs_i(F, n, d);
    1229          14 :   nd = n*d;
    1230          14 :   VF = mfcoefs_i(F, nd, 1); VE = mfcoefs_i(mfEk(2), nd, 1);
    1231          14 :   gk = mf_get_gk(F);
    1232          14 :   if (m == 1)
    1233             :   {
    1234           7 :     res = cgetg(n+2, t_VEC);
    1235           7 :     for (i = 0; i <= n; i++) gel(res, i+1) = gmulsg(i, gel(VF, i*d+1));
    1236           7 :     tmp = c_deflate(n, d, RgV_mul_RgXn(VF, VE));
    1237           7 :     return gerepileupto(av, gsub(res, gmul(gdivgs(gk, 12), tmp)));
    1238             :   }
    1239             :   else
    1240             :   {
    1241             :     long j;
    1242          35 :     for (j = 1; j <= m; j++)
    1243             :     {
    1244          28 :       tmp = RgV_mul_RgXn(VF, VE);
    1245          28 :       for (i = 0; i <= nd; i++) gel(VF, i+1) = gmulsg(i, gel(VF, i+1));
    1246          28 :       VF = gsub(VF, gmul(gdivgs(gaddgs(gk, 2*(j-1)), 12), tmp));
    1247             :     }
    1248           7 :     return gerepilecopy(av, c_deflate(n, d, VF));
    1249             :   }
    1250             : }
    1251             : 
    1252             : /* Twist by the character (D/.) */
    1253             : static GEN
    1254           7 : c_twist(long n, long d, GEN F, GEN D)
    1255             : {
    1256           7 :   pari_sp av = avma;
    1257           7 :   GEN V = mfcoefs_i(F, n, d), res = cgetg(n+2, t_VEC);
    1258             :   long i;
    1259         119 :   for (i = 0; i <= n; i++)
    1260         112 :     gel(res, i + 1) = gmulsg(krois(D, i), gel(V, i+1));
    1261           7 :   return gerepileupto(av, res);
    1262             : }
    1263             : 
    1264             : /* form F given by closure, compute T(n)(F) as closure */
    1265             : static GEN
    1266         399 : c_hecke(long m, long l, GEN DATA, GEN F)
    1267             : {
    1268         399 :   pari_sp av = avma;
    1269         399 :   return gerepilecopy(av, hecke_i(m, l, NULL, F, DATA));
    1270             : }
    1271             : static GEN
    1272         147 : c_const(long n, long d, GEN C)
    1273             : {
    1274         147 :   GEN V = zerovec(n+1);
    1275         147 :   long i, j, l = lg(C);
    1276         147 :   if (l > d*n+2) l = d*n+2;
    1277         147 :   for (i = j = 1; i < l; i+=d, j++) gel(V, j) = gcopy(gel(C,i));
    1278         147 :   return V;
    1279             : }
    1280             : 
    1281             : static GEN
    1282         455 : eta3_ZXn(long m)
    1283             : {
    1284         455 :   long l = m+2, n, k;
    1285         455 :   GEN P = cgetg(l,t_POL);
    1286         455 :   P[1] = evalsigne(1)|evalvarn(0);
    1287         455 :   for (n = 2; n < l; n++) gel(P,n) = gen_0;
    1288        2457 :   for (n = k = 0;; n++)
    1289             :   {
    1290        2457 :     k += n; if (k >= m) break;
    1291             :     /* now k = n(n+1) / 2 */
    1292        2002 :     gel(P, k+2) = odd(n)? utoineg(2*n+1): utoipos(2*n+1);
    1293        2002 :   }
    1294         455 :   return P;
    1295             : }
    1296             : 
    1297             : static GEN
    1298         455 : c_delta(long n, long d)
    1299             : {
    1300         455 :   pari_sp ltop = avma;
    1301         455 :   long N = n*d;
    1302         455 :   GEN e = eta3_ZXn(N);
    1303         455 :   e = ZXn_sqr(e,N);
    1304         455 :   e = ZXn_sqr(e,N);
    1305         455 :   e = ZXn_sqr(e,N); /* eta(x)^24 */
    1306         455 :   settyp(e, t_VEC);
    1307         455 :   gel(e,1) = gen_0; /* Delta(x) = x*eta(x)^24 as a t_VEC */
    1308         455 :   return gerepilecopy(ltop, c_deflate(n, d, e));
    1309             : }
    1310             : 
    1311             : /* return s(d) such that s|f <=> d | f^2 */
    1312             : static long
    1313          21 : mysqrtu(ulong d)
    1314             : {
    1315          21 :   GEN fa = myfactoru(d), P = gel(fa,1), E = gel(fa,2);
    1316          21 :   long l = lg(P), i, s = 1;
    1317          21 :   for (i = 1; i < l; i++) s *= upowuu(P[i], (E[i]+1)>>1);
    1318          21 :   return s;
    1319             : }
    1320             : static GEN
    1321        1064 : c_theta(long n, long d, GEN psi)
    1322             : {
    1323        1064 :   long lim = usqrt(n*d), F = mfcharmodulus(psi), par = mfcharparity(psi);
    1324        1064 :   long f, d2 = d == 1? 1: mysqrtu(d);
    1325        1064 :   GEN V = zerovec(n + 1);
    1326        4298 :   for (f = d2; f <= lim; f += d2)
    1327        3234 :     if (cgcd(F, f) == 1)
    1328             :     {
    1329        3234 :       pari_sp av = avma;
    1330        3234 :       GEN c = mfchareval_i(psi, f);
    1331        3234 :       gel(V, f*f/d + 1) = gerepileupto(av, par < 0 ? gmulgs(c,2*f) : gmul2n(c,1));
    1332             :     }
    1333        1064 :   if (F == 1) gel(V, 1) = gen_1;
    1334        1064 :   return V; /* no gerepile needed */
    1335             : }
    1336             : 
    1337             : static GEN
    1338         112 : c_etaquo(long n, long d, GEN eta, GEN gs)
    1339             : {
    1340         112 :   pari_sp av = avma;
    1341         112 :   GEN B = gel(eta,1), E = gel(eta,2), c = gen_1;
    1342         112 :   long i, s = itos(gs), nd = n*d, nds = nd - s + 1, l = lg(B);
    1343         112 :   if (nds <= 0) return zerovec(n+1);
    1344          91 :   for (i = 1; i < l; i++) c = gmul(c, gpowgs(eta_inflate_ZXn(nds, B[i]), E[i]));
    1345          91 :   if (s > 0) setvalp(c, valp(c) + s);
    1346          91 :   return gerepilecopy(av, c_deflate(n, d, sertovecslice(c, nd)));
    1347             : }
    1348             : 
    1349             : static GEN
    1350          49 : c_ell(long n, long d, GEN E)
    1351             : {
    1352          49 :   pari_sp av = avma;
    1353             :   GEN v;
    1354          49 :   if (d == 1) return concat(gen_0, anell(E, n));
    1355           7 :   v = shallowconcat(gen_0, anell(E, n*d));
    1356           7 :   return gerepilecopy(av, c_deflate(n, d, v));
    1357             : }
    1358             : 
    1359             : static GEN
    1360          21 : c_cusptrace(long n, long d, GEN F)
    1361             : {
    1362          21 :   pari_sp av = avma;
    1363          21 :   GEN D = gel(F,2), res = cgetg(n+2, t_VEC);
    1364          21 :   long i, N = mf_get_N(F), k = mf_get_k(F);
    1365          21 :   gel(res, 1) = gen_0;
    1366         140 :   for (i = 1; i <= n; i++)
    1367         119 :     gel(res, i+1) = mfcusptrace_i(N, k, i*d, mydivisorsu(i*d), D);
    1368          21 :   return gerepilecopy(av, res);
    1369             : }
    1370             : 
    1371             : static GEN
    1372         637 : c_newtrace(long n, long d, GEN F)
    1373             : {
    1374         637 :   pari_sp av = avma;
    1375             :   cachenew_t cache;
    1376         637 :   long N = mf_get_N(F);
    1377             :   GEN v;
    1378         637 :   init_cachenew(&cache, n*d, N, F);
    1379         637 :   v = colnewtrace(0, n, d, N, mf_get_k(F), &cache);
    1380         637 :   settyp(v, t_VEC); return gerepilecopy(av, v);
    1381             : }
    1382             : 
    1383             : static GEN
    1384        3458 : c_Bd(long n, long d, GEN F, GEN A)
    1385             : {
    1386        3458 :   pari_sp av = avma;
    1387        3458 :   long a = itou(A), ad = cgcd(a,d), aad = a/ad, i, j;
    1388        3458 :   GEN w, v = mfcoefs_i(F, n/aad, d/ad);
    1389        3458 :   if (a == 1) return v;
    1390        3458 :   n++; w = zerovec(n);
    1391        3458 :   for (i = j = 1; j <= n; i++, j += aad) gel(w,j) = gcopy(gel(v,i));
    1392        3458 :   return gerepileupto(av, w);
    1393             : }
    1394             : 
    1395             : static GEN
    1396        3311 : c_dihedral(long n, long d, GEN bnr, GEN w, GEN k0j)
    1397             : {
    1398        3311 :   pari_sp av = avma;
    1399        3311 :   GEN V = dihan(bnr, w, k0j, n*d);
    1400        3311 :   GEN Tinit = gel(w,3), Pm = gel(Tinit,1);
    1401        3311 :   GEN A = c_deflate(n, d, V);
    1402        3311 :   if (degpol(Pm) == 1 || RgX_is_QX(A)) return gerepilecopy(av, A);
    1403         728 :   return gerepileupto(av, gmodulo(A, Pm));
    1404             : }
    1405             : 
    1406             : static GEN
    1407         140 : c_mfEH(long n, long d, GEN F)
    1408             : {
    1409         140 :   pari_sp av = avma;
    1410             :   GEN v, M, A;
    1411         140 :   long i, r = mf_get_r(F);
    1412         140 :   if (n == 1)
    1413          14 :     return gerepilecopy(av, mkvec2(mfEHcoef(r,0),mfEHcoef(r,d)));
    1414             :   /* speedup mfcoef */
    1415         126 :   if (r == 1)
    1416             :   {
    1417          70 :     v = cgetg(n+2, t_VEC);
    1418          70 :     gel(v,1) = sstoQ(-1,12);
    1419       83258 :     for (i = 1; i <= n; i++)
    1420             :     {
    1421       83188 :       long id = i*d, a = id & 3;
    1422       83188 :       gel(v,i+1) = (a==1 || a==2)? gen_0: sstoQ(hclassno6u(id), 6);
    1423             :     }
    1424          70 :     return v; /* no gerepile needed */
    1425             :   }
    1426          56 :   M = mfEHmat(n*d+1,r);
    1427          56 :   if (d > 1)
    1428             :   {
    1429           7 :     long l = lg(M);
    1430           7 :     for (i = 1; i < l; i++) gel(M,i) = c_deflate(n, d, gel(M,i));
    1431             :   }
    1432          56 :   A = gel(F,2); /* [num(B), den(B)] */
    1433          56 :   v = RgC_Rg_div(RgM_RgC_mul(M, gel(A,1)), gel(A,2));
    1434          56 :   settyp(v,t_VEC); return gerepileupto(av, v);
    1435             : }
    1436             : 
    1437             : static GEN
    1438        5110 : c_mfeisen(long n, long d, GEN F)
    1439             : {
    1440        5110 :   pari_sp av = avma;
    1441        5110 :   GEN v, vchi, E0, P, T, CHI, gk = mf_get_gk(F);
    1442             :   long i, k;
    1443        5110 :   if (typ(gk) != t_INT) return c_mfEH(n, d, F);
    1444        4970 :   k = itou(gk);
    1445        4970 :   vchi = gel(F,2);
    1446        4970 :   E0 = gel(vchi,1);
    1447        4970 :   T = gel(vchi,2);
    1448        4970 :   P = gel(T,1);
    1449        4970 :   CHI = gel(vchi,3);
    1450        4970 :   v = cgetg(n+2, t_VEC);
    1451        4970 :   gel(v, 1) = gcopy(E0); /* E(0) */
    1452        4970 :   if (lg(vchi) == 5)
    1453             :   { /* E_k(chi1,chi2) */
    1454        3409 :     GEN CHI2 = gel(vchi,4), F3 = gel(F,3);
    1455        3409 :     long ord = F3[1], j = F3[2];
    1456        3409 :     for (i = 1; i <= n; i++) gel(v, i+1) = sigchi2(k, CHI, CHI2, i*d, ord);
    1457        3409 :     if (lg(T) == 4) v = QabV_tracerel(T, j, v);
    1458             :   }
    1459             :   else
    1460             :   { /* E_k(chi) */
    1461        1561 :     for (i = 1; i <= n; i++) gel(v, i+1) = sigchi(k, CHI, i*d);
    1462             :   }
    1463        4970 :   if (degpol(P) != 1 && !RgV_is_QV(v)) return gerepileupto(av, gmodulo(v, P));
    1464        4389 :   return gerepilecopy(av, v);
    1465             : }
    1466             : 
    1467             : /* L(chi_D, 1-k) */
    1468             : static GEN
    1469          28 : lfunquadneg(long D, long k)
    1470             : {
    1471          28 :   GEN B, dS, S = gen_0;
    1472          28 :   long r, N = labs(D);
    1473             :   pari_sp av;
    1474          28 :   if (k == 1 && N == 1) return gneg(ghalf);
    1475             :   /* B = N^k * denom(B) * B(x/N) */
    1476          28 :   B = ZX_rescale(Q_remove_denom(bernpol(k, 0), &dS), utoi(N));
    1477          28 :   dS = mul_denom(dS, stoi(-N*k));
    1478          28 :   av = avma;
    1479        7175 :   for (r = 0; r < N; r++)
    1480             :   {
    1481        7147 :     long c = kross(D, r);
    1482        7147 :     if (c)
    1483             :     {
    1484        5152 :       GEN tmp = poleval(B, utoi(r));
    1485        5152 :       S = c > 0 ? addii(S, tmp) : subii(S, tmp);
    1486        5152 :       S = gerepileuptoint(av, S);
    1487             :     }
    1488             :   }
    1489          28 :   return gdiv(S, dS);
    1490             : }
    1491             : 
    1492             : /* Returns vector of coeffs from F[0], F[d], ..., F[d*n] */
    1493             : static GEN
    1494       19243 : mfcoefs_i(GEN F, long n, long d)
    1495             : {
    1496       19243 :   if (n < 0) return gen_0;
    1497       19243 :   switch(mf_get_type(F))
    1498             :   {
    1499         147 :     case t_MF_CONST: return c_const(n, d, gel(F,2));
    1500        5110 :     case t_MF_EISEN: return c_mfeisen(n, d, F);
    1501         616 :     case t_MF_Ek: return c_Ek(n, d, F);
    1502         455 :     case t_MF_DELTA: return c_delta(n, d);
    1503        1001 :     case t_MF_THETA: return c_theta(n, d, gel(F,2));
    1504         112 :     case t_MF_ETAQUO: return c_etaquo(n, d, gel(F,2), gel(F,3));
    1505          49 :     case t_MF_ELL: return c_ell(n, d, gel(F,2));
    1506         371 :     case t_MF_MUL: return c_mul(n, d, gel(F,2), gel(F,3));
    1507          77 :     case t_MF_POW: return c_pow(n, d, gel(F,2), gel(F,3));
    1508          21 :     case t_MF_BRACKET: return c_bracket(n, d, gel(F,2), gel(F,3), gel(F,4));
    1509        2226 :     case t_MF_LINEAR: return c_linear(n, d, gel(F,2), gel(F,3), gel(F,4));
    1510         931 :     case t_MF_LINEAR_BHN: return c_linear_bhn(n, d, F);
    1511         224 :     case t_MF_DIV: return c_div(n, d, gel(F,2), gel(F,3));
    1512          35 :     case t_MF_SHIFT: return c_shift(n, d, gel(F,2), gel(F,3));
    1513          21 :     case t_MF_DERIV: return c_deriv(n, d, gel(F,2), gel(F,3));
    1514          14 :     case t_MF_DERIVE2: return c_derivE2(n, d, gel(F,2), gel(F,3));
    1515           7 :     case t_MF_TWIST: return c_twist(n, d, gel(F,2), gel(F,3));
    1516         399 :     case t_MF_HECKE: return c_hecke(n, d, gel(F,2), gel(F,3));
    1517        3458 :     case t_MF_BD: return c_Bd(n, d, gel(F,2), gel(F,3));
    1518          21 :     case t_MF_TRACE: return c_cusptrace(n, d, F);
    1519         637 :     case t_MF_NEWTRACE: return c_newtrace(n, d, F);
    1520        3311 :     case t_MF_DIHEDRAL: return c_dihedral(n, d, gel(F,2), gel(F,3), gel(F,4));
    1521           0 :     default: pari_err_TYPE("mfcoefs",F);
    1522             :     return NULL;/*LCOV_EXCL_LINE*/
    1523             :   }
    1524             : }
    1525             : 
    1526             : static GEN
    1527         133 : matdeflate(long n, long d, GEN M)
    1528             : {
    1529             :   long i, l;
    1530             :   GEN A;
    1531             :   /*  if (d == 1) return M; */
    1532         133 :   A = cgetg_copy(M,&l);
    1533         133 :   for (i = 1; i < l; i++) gel(A,i) = c_deflate(n,d,gel(M,i));
    1534         133 :   return A;
    1535             : }
    1536             : static int
    1537        4802 : space_is_cusp(long space) { return space != mf_FULL && space != mf_EISEN; }
    1538             : /* safe with flraw mf */
    1539             : static GEN
    1540        1792 : mfcoefs_mf(GEN mf, long n, long d)
    1541             : {
    1542        1792 :   GEN MS, ME, E = MF_get_E(mf), S = MF_get_S(mf), M = MF_get_M(mf);
    1543        1792 :   long lE = lg(E), lS = lg(S), l = lE+lS-1;
    1544             : 
    1545        1792 :   if (l == 1) return cgetg(1, t_MAT);
    1546        1680 :   if (typ(M) == t_MAT && lg(M) != 1 && (n+1)*d < nbrows(M))
    1547          21 :     return matdeflate(n, d, M); /*cached; lg = 1 is possible from mfinit */
    1548        1659 :   ME = (lE == 1)? cgetg(1, t_MAT): mfvectomat(E, n, d);
    1549        1659 :   if (lS == 1)
    1550         343 :     MS = cgetg(1, t_MAT);
    1551        1316 :   else if (mf_get_type(gel(S,1)) == t_MF_DIV) /*k 1/2-integer or k=1 (exotic)*/
    1552         112 :     MS = matdeflate(n,d, mflineardivtomat(MF_get_N(mf), S, n*d));
    1553        1204 :   else if (MF_get_k(mf) == 1) /* k = 1 (dihedral) */
    1554             :   {
    1555         112 :     GEN M = mfvectomat(gmael(S,1,2), n, d);
    1556             :     long i;
    1557         112 :     MS = cgetg(lS, t_MAT);
    1558         294 :     for (i = 1; i < lS; i++)
    1559             :     {
    1560         182 :       GEN f = gel(S,i), dc = gel(f,4), c = RgM_RgC_mul(M, gel(f,3));
    1561         182 :       if (!equali1(dc)) c = RgC_Rg_div(c,dc);
    1562         182 :       gel(MS,i) = c;
    1563             :     }
    1564             :   }
    1565             :   else /* k >= 2 integer */
    1566        1092 :     MS = bhnmat_extend_nocache(NULL, MF_get_N(mf), n, d, S);
    1567        1659 :   return shallowconcat(ME,MS);
    1568             : }
    1569             : GEN
    1570        3010 : mfcoefs(GEN F, long n, long d)
    1571             : {
    1572        3010 :   if (!checkmf_i(F))
    1573             :   {
    1574          42 :     pari_sp av = avma;
    1575          42 :     if (!checkMF_i(F)) pari_err_TYPE("mfcoefs", F);
    1576          42 :     return gerepilecopy(av, mfcoefs_mf(F,n,d));
    1577             :   }
    1578        2968 :   if (d <= 0) pari_err_DOMAIN("mfcoefs", "d", "<=", gen_0, stoi(d));
    1579        2968 :   if (n < 0) return cgetg(1, t_VEC);
    1580        2968 :   return mfcoefs_i(F, n, d);
    1581             : }
    1582             : 
    1583             : /* assume k >= 0 */
    1584             : static GEN
    1585         168 : mfak_i(GEN F, long k)
    1586             : {
    1587         168 :   if (!k) return gel(mfcoefs_i(F,0,1), 1);
    1588          98 :   return gel(mfcoefs_i(F,1,k), 2);
    1589             : }
    1590             : GEN
    1591          84 : mfcoef(GEN F, long n)
    1592             : {
    1593          84 :   pari_sp av = avma;
    1594          84 :   if (!checkmf_i(F)) pari_err_TYPE("mfcoef",F);
    1595          84 :   return n < 0? gen_0: gerepilecopy(av, mfak_i(F, n));
    1596             : }
    1597             : 
    1598             : static GEN
    1599         105 : paramconst() { return tagparams(t_MF_CONST, mkNK(1,0,mfchartrivial())); }
    1600             : static GEN
    1601          70 : mftrivial(void) { retmkvec2(paramconst(), cgetg(1,t_VEC)); }
    1602             : static GEN
    1603          35 : mf1(void) { retmkvec2(paramconst(), mkvec(gen_1)); }
    1604             : 
    1605             : /* induce mfchar CHI to G */
    1606             : static GEN
    1607      305242 : induce(GEN G, GEN CHI)
    1608             : {
    1609             :   GEN o, chi;
    1610      305242 :   if (typ(CHI) == t_INT) /* Kronecker */
    1611             :   {
    1612      300657 :     chi = znchar_quad(G, CHI);
    1613      300657 :     o = ZV_equal0(chi)? gen_1: gen_2;
    1614      300657 :     CHI = mkvec4(G,chi,o,cgetg(1,t_VEC));
    1615             :   }
    1616             :   else
    1617             :   {
    1618        4585 :     if (mfcharmodulus(CHI) == itos(znstar_get_N(G))) return CHI;
    1619        4368 :     CHI = leafcopy(CHI);
    1620        4368 :     chi = zncharinduce(gel(CHI,1), gel(CHI,2), G);
    1621        4368 :     gel(CHI,1) = G;
    1622        4368 :     gel(CHI,2) = chi;
    1623             :   }
    1624      305025 :   return CHI;
    1625             : }
    1626             : /* induce mfchar CHI to znstar(G) */
    1627             : static GEN
    1628       42238 : induceN(long N, GEN CHI)
    1629             : {
    1630       42238 :   if (mfcharmodulus(CHI) != N) CHI = induce(znstar0(utoipos(N),1), CHI);
    1631       42238 :   return CHI;
    1632             : }
    1633             : /* *pCHI1 and *pCHI2 are mfchar, induce to common modulus */
    1634             : static void
    1635        4592 : char2(GEN *pCHI1, GEN *pCHI2)
    1636             : {
    1637        4592 :   GEN CHI1 = *pCHI1, G1 = gel(CHI1,1), N1 = znstar_get_N(G1);
    1638        4592 :   GEN CHI2 = *pCHI2, G2 = gel(CHI2,1), N2 = znstar_get_N(G2);
    1639        4592 :   if (!equalii(N1,N2))
    1640             :   {
    1641        3262 :     GEN G, d = gcdii(N1,N2);
    1642        3262 :     if      (equalii(N2,d)) *pCHI2 = induce(G1, CHI2);
    1643        1015 :     else if (equalii(N1,d)) *pCHI1 = induce(G2, CHI1);
    1644             :     else
    1645             :     {
    1646         133 :       if (!equali1(d)) N2 = diviiexact(N2,d);
    1647         133 :       G = znstar0(mulii(N1,N2), 1);
    1648         133 :       *pCHI1 = induce(G, CHI1);
    1649         133 :       *pCHI2 = induce(G, CHI2);
    1650             :     }
    1651             :   }
    1652        4592 : }
    1653             : /* mfchar or charinit wrt same modulus; outputs a mfchar */
    1654             : static GEN
    1655      301399 : mfcharmul_i(GEN CHI1, GEN CHI2)
    1656             : {
    1657      301399 :   GEN G = gel(CHI1,1), chi3 = zncharmul(G, gel(CHI1,2), gel(CHI2,2));
    1658      301399 :   return mfcharGL(G, chi3);
    1659             : }
    1660             : /* mfchar or charinit; outputs a mfchar */
    1661             : static GEN
    1662         749 : mfcharmul(GEN CHI1, GEN CHI2)
    1663             : {
    1664         749 :   char2(&CHI1, &CHI2); return mfcharmul_i(CHI1,CHI2);
    1665             : }
    1666             : /* mfchar or charinit; outputs a mfchar */
    1667             : static GEN
    1668         105 : mfcharpow(GEN CHI, GEN n)
    1669             : {
    1670             :   GEN G, chi;
    1671         105 :   G = gel(CHI,1); chi = zncharpow(G, gel(CHI,2), n);
    1672         105 :   return mfcharGL(G, chi);
    1673             : }
    1674             : /* mfchar or charinit wrt same modulus; outputs a mfchar */
    1675             : static GEN
    1676        3843 : mfchardiv_i(GEN CHI1, GEN CHI2)
    1677             : {
    1678        3843 :   GEN G = gel(CHI1,1), chi3 = znchardiv(G, gel(CHI1,2), gel(CHI2,2));
    1679        3843 :   return mfcharGL(G, chi3);
    1680             : }
    1681             : /* mfchar or charinit; outputs a mfchar */
    1682             : static GEN
    1683        3843 : mfchardiv(GEN CHI1, GEN CHI2)
    1684             : {
    1685        3843 :   char2(&CHI1, &CHI2); return mfchardiv_i(CHI1,CHI2);
    1686             : }
    1687             : static GEN
    1688          28 : mfcharconj(GEN CHI)
    1689             : {
    1690          28 :   CHI = leafcopy(CHI);
    1691          28 :   gel(CHI,2) = zncharconj(gel(CHI,1), gel(CHI,2));
    1692          28 :   return CHI;
    1693             : }
    1694             : 
    1695             : /* CHI mfchar, assume 4 | N. Multiply CHI by \chi_{-4} */
    1696             : static GEN
    1697         868 : mfchilift(GEN CHI, long N)
    1698             : {
    1699         868 :   CHI = induceN(N, CHI);
    1700         868 :   return mfcharmul_i(CHI, induce(gel(CHI,1), stoi(-4)));
    1701             : }
    1702             : /* CHI defined mod N, N4 = N/4;
    1703             :  * if CHI is defined mod N4 return CHI;
    1704             :  * else if CHI' = CHI*(-4,.) is defined mod N4, return CHI' (primitive)
    1705             :  * else return NULL */
    1706             : static GEN
    1707          70 : mfcharchiliftprim(GEN CHI, long N4)
    1708             : {
    1709          70 :   long FC = mfcharconductor(CHI);
    1710          70 :   if (N4 % FC == 0) return CHI;
    1711          14 :   CHI = mfchilift(CHI, N4 << 2);
    1712          14 :   CHI = mfchartoprimitive(CHI, &FC);
    1713          14 :   return (N4 % FC == 0)? CHI: NULL;
    1714             : }
    1715             : static GEN
    1716        1904 : mfchiadjust(GEN CHI, GEN gk, long N)
    1717             : {
    1718        1904 :   long par = mfcharparity(CHI);
    1719        1904 :   if (typ(gk) == t_INT &&  mpodd(gk)) par = -par;
    1720        1904 :   return par == 1 ? CHI : mfchilift(CHI, N);
    1721             : }
    1722             : 
    1723             : static GEN
    1724        2534 : mfsamefield(GEN P, GEN Q)
    1725             : {
    1726        2534 :   if (degpol(P) == 1) return Q;
    1727         399 :   if (degpol(Q) == 1) return P;
    1728         399 :   if (!gequal(P,Q)) pari_err_TYPE("mfsamefield [different fields]",mkvec2(P,Q));
    1729         392 :   return P;
    1730             : }
    1731             : 
    1732             : GEN
    1733         189 : mfmul(GEN f, GEN g)
    1734             : {
    1735         189 :   pari_sp av = avma;
    1736             :   GEN N, K, NK, CHI;
    1737         189 :   if (!checkmf_i(f)) pari_err_TYPE("mfmul",f);
    1738         189 :   if (!checkmf_i(g)) pari_err_TYPE("mfmul",g);
    1739         189 :   N = lcmii(mf_get_gN(f), mf_get_gN(g));
    1740         189 :   K = gadd(mf_get_gk(f), mf_get_gk(g));
    1741         189 :   CHI = mfcharmul(mf_get_CHI(f), mf_get_CHI(g));
    1742         189 :   CHI = mfchiadjust(CHI, K, itos(N));
    1743         189 :   NK = mkgNK(N, K, CHI, mfsamefield(mf_get_field(f), mf_get_field(g)));
    1744         182 :   return gerepilecopy(av, tag2(t_MF_MUL, NK, f, g));
    1745             : }
    1746             : GEN
    1747          49 : mfpow(GEN f, long n)
    1748             : {
    1749          49 :   pari_sp av = avma;
    1750             :   GEN KK, NK, gn, CHI;
    1751          49 :   if (!checkmf_i(f)) pari_err_TYPE("mfpow",f);
    1752          49 :   if (!n) return mf1();
    1753          49 :   if (n == 1) return gcopy(f);
    1754          49 :   KK = gmulsg(n,mf_get_gk(f));
    1755          49 :   gn = stoi(n);
    1756          49 :   CHI = mfcharpow(mf_get_CHI(f), gn);
    1757          49 :   CHI = mfchiadjust(CHI, KK, mf_get_N(f));
    1758          49 :   NK = mkgNK(mf_get_gN(f), KK, CHI, mf_get_field(f));
    1759          49 :   return gerepilecopy(av, tag2(t_MF_POW, NK, f, gn));
    1760             : }
    1761             : GEN
    1762          21 : mfbracket(GEN f, GEN g, long m)
    1763             : {
    1764          21 :   pari_sp av = avma;
    1765             :   GEN N, K, NK, CHI;
    1766          21 :   if (!checkmf_i(f)) pari_err_TYPE("mfbracket",f);
    1767          21 :   if (!checkmf_i(g)) pari_err_TYPE("mfbracket",g);
    1768          21 :   if (m < 0) pari_err_TYPE("mfbracket [m<0]",stoi(m));
    1769          21 :   K = gaddgs(gadd(mf_get_gk(f), mf_get_gk(g)), 2*m);
    1770          21 :   if (gsigne(K) < 0) pari_err_IMPL("mfbracket for this form");
    1771          21 :   N = lcmii(mf_get_gN(f), mf_get_gN(g));
    1772          21 :   CHI = mfcharmul(mf_get_CHI(f), mf_get_CHI(g));
    1773          21 :   CHI = mfchiadjust(CHI, K, itou(N));
    1774          21 :   NK = mkgNK(N, K, CHI, mfsamefield(mf_get_field(f), mf_get_field(g)));
    1775          21 :   return gerepilecopy(av, tag3(t_MF_BRACKET, NK, f, g, utoi(m)));
    1776             : }
    1777             : 
    1778             : /* remove 0 entries in L */
    1779             : static int
    1780        1015 : mflinear_strip(GEN *pF, GEN *pL)
    1781             : {
    1782        1015 :   pari_sp av = avma;
    1783        1015 :   GEN F = *pF, L = *pL;
    1784        1015 :   long i, j, l = lg(L);
    1785        1015 :   GEN F2 = cgetg(l, t_VEC), L2 = cgetg(l, t_VEC);
    1786        4865 :   for (i = j = 1; i < l; i++)
    1787             :   {
    1788        3850 :     if (gequal0(gel(L,i))) continue;
    1789        2807 :     gel(F2,j) = gel(F,i);
    1790        2807 :     gel(L2,j) = gel(L,i); j++;
    1791             :   }
    1792        1015 :   if (j == l) avma = av;
    1793             :   else
    1794             :   {
    1795         238 :     setlg(F2,j); *pF = F2;
    1796         238 :     setlg(L2,j); *pL = L2;
    1797             :   }
    1798        1015 :   return (j > 1);
    1799             : }
    1800             : static GEN
    1801        3787 : taglinear_i(long t, GEN NK, GEN F, GEN L)
    1802             : {
    1803             :   GEN dL;
    1804        3787 :   L = Q_remove_denom(L, &dL); if (!dL) dL = gen_1;
    1805        3787 :   return tag3(t, NK, F, L, dL);
    1806             : }
    1807             : static GEN
    1808        1309 : taglinear(GEN NK, GEN F, GEN L)
    1809             : {
    1810        1309 :   long t = ok_bhn_linear(F)? t_MF_LINEAR_BHN: t_MF_LINEAR;
    1811        1309 :    return taglinear_i(t, NK, F, L);
    1812             : }
    1813             : /* assume F has parameters NK = [N,K,CHI] */
    1814             : static GEN
    1815         301 : mflinear_i(GEN NK, GEN F, GEN L)
    1816             : {
    1817         301 :   if (!mflinear_strip(&F,&L)) return mftrivial();
    1818         301 :   return taglinear(NK, F,L);
    1819             : }
    1820             : static GEN
    1821         448 : mflinear_bhn(GEN mf, GEN L)
    1822             : {
    1823             :   long i, l;
    1824         448 :   GEN P, NK, F = MF_get_S(mf);
    1825         448 :   if (!mflinear_strip(&F,&L)) return mftrivial();
    1826         441 :   l = lg(L); P = pol_x(1);
    1827        2457 :   for (i = 1; i < l; i++)
    1828             :   {
    1829        2016 :     GEN c = gel(L,i);
    1830        2016 :     if (typ(c) == t_POLMOD && varn(gel(c,1)) == 1) P = mfsamefield(P,gel(c,1));
    1831             :   }
    1832         441 :   NK = mkgNK(MF_get_gN(mf), MF_get_gk(mf), MF_get_CHI(mf), P);
    1833         441 :   return taglinear_i(t_MF_LINEAR_BHN,  NK, F,L);
    1834             : }
    1835             : 
    1836             : /* F vector of forms with same weight and character but varying level, return
    1837             :  * global [N,k,chi,P] */
    1838             : static GEN
    1839        1792 : vecmfNK(GEN F)
    1840             : {
    1841        1792 :   long i, l = lg(F);
    1842             :   GEN N, f;
    1843        1792 :   if (l == 1) return mkNK(1, 0, mfchartrivial());
    1844        1792 :   f = gel(F,1); N = mf_get_gN(f);
    1845        1792 :   for (i = 2; i < l; i++) N = lcmii(N, mf_get_gN(gel(F,i)));
    1846        1792 :   return mkgNK(N, mf_get_gk(f), mf_get_CHI(f), mf_get_field(f));
    1847             : }
    1848             : /* do not use mflinear: mflineardivtomat rely on F being constant across the
    1849             :  * basis where mflinear strips the ones matched by 0 coeffs. Assume k and CHI
    1850             :  * constant, N is allowed to vary. */
    1851             : static GEN
    1852         910 : vecmflinear(GEN F, GEN C)
    1853             : {
    1854         910 :   long i, t, l = lg(C);
    1855         910 :   GEN NK, v = cgetg(l, t_VEC);
    1856         910 :   if (l == 1) return v;
    1857         910 :   t = ok_bhn_linear(F)? t_MF_LINEAR_BHN: t_MF_LINEAR;
    1858         910 :   NK = vecmfNK(F);
    1859         910 :   for (i = 1; i < l; i++) gel(v,i) = taglinear_i(t, NK, F, gel(C,i));
    1860         910 :   return v;
    1861             : }
    1862             : /* vecmflinear(F,C), then divide everything by E, which has valuation 0 */
    1863             : static GEN
    1864         224 : vecmflineardiv0(GEN F, GEN C, GEN E)
    1865             : {
    1866         224 :   GEN v = vecmflinear(F, C);
    1867         224 :   long i, l = lg(v);
    1868         224 :   for (i = 1; i < l; i++) gel(v,i) = mfdiv_val(gel(v,i), E, 0);
    1869         224 :   return v;
    1870             : }
    1871             : 
    1872             : /* Non empty linear combination of linear combinations of same
    1873             :  * F_j=\sum_i \mu_{i,j}G_i so R = \sum_i (\sum_j(\la_j\mu_{i,j})) G_i */
    1874             : static GEN
    1875         882 : mflinear_linear(GEN F, GEN L, int strip)
    1876             : {
    1877         882 :   long l = lg(F), j;
    1878         882 :   GEN vF, M = cgetg(l, t_MAT);
    1879        6503 :   for (j = 1; j < l; j++)
    1880             :   {
    1881        5621 :     GEN f = gel(F,j), c = gel(f,3), d = gel(f,4);
    1882        5621 :     if (typ(c) == t_VEC) c = shallowtrans(c);
    1883        5621 :     if (!isint1(d)) c = RgC_Rg_div(c, d);
    1884        5621 :     gel(M,j) = c;
    1885             :   }
    1886         882 :   vF = gmael(F,1,2);
    1887         882 :   L = RgM_RgC_mul(M,L);
    1888         882 :   if (strip && !mflinear_strip(&vF,&L)) return mftrivial();
    1889         882 :   return taglinear(vecmfNK(vF), vF, L);
    1890             : }
    1891             : /* F non-empty vector of forms of the form mfdiv(mflinear(B,v), E) where E
    1892             :  * does not vanish at oo, or mflinear(B,v). Apply mflinear(F, L) */
    1893             : static GEN
    1894         882 : mflineardiv_linear(GEN F, GEN L, int strip)
    1895             : {
    1896         882 :   long l = lg(F), j;
    1897             :   GEN v, E, f;
    1898         882 :   if (lg(L) != l) pari_err_DIM("mflineardiv_linear");
    1899         882 :   f = gel(F,1); /* l > 1 */
    1900         882 :   if (mf_get_type(f) != t_MF_DIV) return mflinear_linear(F,L,strip);
    1901         756 :   E = gel(f,3);
    1902         756 :   v = cgetg(l, t_VEC);
    1903         756 :   for (j = 1; j < l; j++) { GEN f = gel(F,j); gel(v,j) = gel(f,2); }
    1904         756 :   return mfdiv_val(mflinear_linear(v,L,strip), E, 0);
    1905             : }
    1906             : static GEN
    1907         217 : vecmflineardiv_linear(GEN F, GEN M)
    1908             : {
    1909         217 :   long i, l = lg(M);
    1910         217 :   GEN v = cgetg(l, t_VEC);
    1911         217 :   for (i = 1; i < l; i++) gel(v,i) = mflineardiv_linear(F, gel(M,i), 0);
    1912         217 :   return v;
    1913             : }
    1914             : 
    1915             : static GEN
    1916         413 : tobasis(GEN mf, GEN F, GEN L)
    1917             : {
    1918         413 :   if (checkmf_i(L) && mf) return mftobasis(mf, L, 0);
    1919         406 :   if (typ(F) != t_VEC) pari_err_TYPE("mflinear",F);
    1920         406 :   if (!is_vec_t(typ(L))) pari_err_TYPE("mflinear",L);
    1921         406 :   if (lg(L) != lg(F)) pari_err_DIM("mflinear");
    1922         406 :   return L;
    1923             : }
    1924             : GEN
    1925         441 : mflinear(GEN F, GEN L)
    1926             : {
    1927         441 :   pari_sp av = avma;
    1928         441 :   GEN G, NK, P, mf = NULL, N = NULL, K = NULL, CHI = NULL;
    1929             :   long i, l;
    1930         441 :   if (checkMF_i(F))
    1931             :   {
    1932             :     GEN gk;
    1933         315 :     mf = F; gk = MF_get_gk(mf);
    1934         315 :     F = MF_get_basis(F);
    1935         315 :     if (typ(gk) != t_INT)
    1936          28 :       return gerepilecopy(av, mflineardiv_linear(F, L, 1));
    1937         287 :     if (itou(gk) > 1 && space_is_cusp(MF_get_space(mf)))
    1938             :     {
    1939         210 :       L = tobasis(mf, F, L);
    1940         210 :       return gerepilecopy(av, mflinear_bhn(mf, L));
    1941             :     }
    1942             :   }
    1943         203 :   L = tobasis(mf, F, L);
    1944         203 :   if (!mflinear_strip(&F,&L)) return mftrivial();
    1945             : 
    1946         196 :   l = lg(F);
    1947         196 :   if (l == 2 && gequal1(gel(L,1))) return gerepilecopy(av, gel(F,1));
    1948         140 :   P = pol_x(1);
    1949         385 :   for (i = 1; i < l; i++)
    1950             :   {
    1951         252 :     GEN f = gel(F,i), c = gel(L,i), Ni, Ki;
    1952         252 :     if (!checkmf_i(f)) pari_err_TYPE("mflinear", f);
    1953         252 :     Ni = mf_get_gN(f); N = N? lcmii(N, Ni): Ni;
    1954         252 :     Ki = mf_get_gk(f);
    1955         252 :     if (!K) K = Ki;
    1956         112 :     else if (!gequal(K, Ki))
    1957           7 :       pari_err_TYPE("mflinear [different weights]", mkvec2(K,Ki));
    1958         245 :     P = mfsamefield(P, mf_get_field(f));
    1959         245 :     if (typ(c) == t_POLMOD && varn(gel(c,1)) == 1) P = mfsamefield(P, gel(c,1));
    1960             :   }
    1961         133 :   G = znstar0(N,1);
    1962         364 :   for (i = 1; i < l; i++)
    1963             :   {
    1964         238 :     GEN CHI2 = mf_get_CHI(gel(F,i));
    1965         238 :     CHI2 = induce(G, CHI2);
    1966         238 :     if (!CHI) CHI = CHI2;
    1967         105 :     else if (!gequal(CHI, CHI2))
    1968           7 :       pari_err_TYPE("mflinear [different characters]", mkvec2(CHI,CHI2));
    1969             :   }
    1970         126 :   NK = mkgNK(N, K, CHI, P);
    1971         126 :   return gerepilecopy(av, taglinear(NK,F,L));
    1972             : }
    1973             : 
    1974             : GEN
    1975          42 : mfshift(GEN F, long sh)
    1976             : {
    1977          42 :   pari_sp av = avma;
    1978          42 :   if (!checkmf_i(F)) pari_err_TYPE("mfshift",F);
    1979          42 :   return gerepilecopy(av, tag2(t_MF_SHIFT, mf_get_NK(F), F, stoi(sh)));
    1980             : }
    1981             : static long
    1982          42 : mfval(GEN F)
    1983             : {
    1984          42 :   pari_sp av = avma;
    1985          42 :   long i = 0, n, sb;
    1986             :   GEN gk, gN;
    1987          42 :   if (!checkmf_i(F)) pari_err_TYPE("mfval", F);
    1988          42 :   gN = mf_get_gN(F);
    1989          42 :   gk = mf_get_gk(F);
    1990          42 :   sb = mfsturmNgk(itou(gN), gk);
    1991         105 :   for (n = 1; n <= sb;)
    1992             :   {
    1993             :     GEN v;
    1994          56 :     if (n > 0.5*sb) n = sb+1;
    1995          56 :     v = mfcoefs_i(F, n, 1);
    1996         112 :     for (; i <= n; i++)
    1997          91 :       if (!gequal0(gel(v, i+1))) { avma = av; return i; }
    1998          21 :     n <<= 1;
    1999             :   }
    2000           7 :   avma = av; return -1;
    2001             : }
    2002             : 
    2003             : GEN
    2004        1596 : mfdiv_val(GEN f, GEN g, long vg)
    2005             : {
    2006             :   GEN N, K, NK, CHI;
    2007        1596 :   if (vg) { f = mfshift(f,vg); g = mfshift(g,vg); }
    2008        1596 :   N = lcmii(mf_get_gN(f), mf_get_gN(g));
    2009        1596 :   K = gsub(mf_get_gk(f), mf_get_gk(g));
    2010        1596 :   CHI = mfchardiv(mf_get_CHI(f), mf_get_CHI(g));
    2011        1596 :   CHI = mfchiadjust(CHI, K, itos(N));
    2012        1596 :   NK = mkgNK(N, K, CHI, mfsamefield(mf_get_field(f), mf_get_field(g)));
    2013        1596 :   return tag2(t_MF_DIV, NK, f, g);
    2014             : }
    2015             : GEN
    2016          42 : mfdiv(GEN F, GEN G)
    2017             : {
    2018          42 :   pari_sp av = avma;
    2019          42 :   long v = mfval(G);
    2020          42 :   if (!checkmf_i(F)) pari_err_TYPE("mfdiv", F);
    2021          35 :   if (v < 0 || (v && !gequal0(mfcoefs(F, v-1, 1))))
    2022          14 :     pari_err_DOMAIN("mfdiv", "ord(G)", ">", strtoGENstr("ord(F)"),
    2023             :                     mkvec2(F, G));
    2024          21 :   return gerepilecopy(av, mfdiv_val(F, G, v));
    2025             : }
    2026             : GEN
    2027          28 : mfderiv(GEN F, long m)
    2028             : {
    2029          28 :   pari_sp av = avma;
    2030             :   GEN NK, gk;
    2031          28 :   if (!checkmf_i(F)) pari_err_TYPE("mfderiv",F);
    2032          28 :   gk = gaddgs(mf_get_gk(F), 2*m);
    2033          28 :   NK = mkgNK(mf_get_gN(F), gk, mf_get_CHI(F), mf_get_field(F));
    2034          28 :   return gerepilecopy(av, tag2(t_MF_DERIV, NK, F, stoi(m)));
    2035             : }
    2036             : GEN
    2037          21 : mfderivE2(GEN F, long m)
    2038             : {
    2039          21 :   pari_sp av = avma;
    2040             :   GEN NK, gk;
    2041          21 :   if (!checkmf_i(F)) pari_err_TYPE("mfderivE2",F);
    2042          21 :   if (m < 0) pari_err_DOMAIN("mfderivE2","m","<",gen_0,stoi(m));
    2043          21 :   gk = gaddgs(mf_get_gk(F), 2*m);
    2044          21 :   NK = mkgNK(mf_get_gN(F), gk, mf_get_CHI(F), mf_get_field(F));
    2045          21 :   return gerepilecopy(av, tag2(t_MF_DERIVE2, NK, F, stoi(m)));
    2046             : }
    2047             : 
    2048             : GEN
    2049          14 : mftwist(GEN F, GEN D)
    2050             : {
    2051          14 :   pari_sp av = avma;
    2052             :   GEN NK, CHI, NT, Da;
    2053             :   long q;
    2054          14 :   if (!checkmf_i(F)) pari_err_TYPE("mftwist", F);
    2055          14 :   if (typ(D) != t_INT) pari_err_TYPE("mftwist", D);
    2056          14 :   Da = mpabs_shallow(D);
    2057          14 :   CHI = mf_get_CHI(F); q = mfcharconductor(CHI);
    2058          14 :   NT = glcm(glcm(mf_get_gN(F), mulsi(q, Da)), sqri(Da));
    2059          14 :   NK = mkgNK(NT, mf_get_gk(F), CHI, mf_get_field(F));
    2060          14 :   return gerepilecopy(av, tag2(t_MF_TWIST, NK, F, D));
    2061             : }
    2062             : 
    2063             : /***************************************************************/
    2064             : /*                 Generic cache handling                      */
    2065             : /***************************************************************/
    2066             : enum { cache_FACT, cache_DIV, cache_H, cache_D, cache_DIH };
    2067             : typedef struct {
    2068             :   const char *name;
    2069             :   GEN cache;
    2070             :   ulong minself;
    2071             :   ulong maxself;
    2072             :   void (*init)(long);
    2073             :   ulong miss;
    2074             :   ulong maxmiss;
    2075             : } cache;
    2076             : 
    2077             : static void constfact(long lim);
    2078             : static void constdiv(long lim);
    2079             : static void consttabh(long lim);
    2080             : static void consttabdihedral(long lim);
    2081             : static void constcoredisc(long lim);
    2082             : static THREAD cache caches[] = {
    2083             : { "Factors",  NULL,  50000,    50000, &constfact, 0, 0 },
    2084             : { "Divisors", NULL,  50000,    50000, &constdiv, 0, 0 },
    2085             : { "H",        NULL, 100000, 10000000, &consttabh, 0, 0 },
    2086             : { "CorediscF",NULL, 100000, 10000000, &constcoredisc, 0, 0 },
    2087             : { "Dihedral", NULL,   1000,     3000, &consttabdihedral, 0, 0 },
    2088             : };
    2089             : 
    2090             : static void
    2091         308 : cache_reset(long id) { caches[id].miss = caches[id].maxmiss = 0; }
    2092             : static void
    2093        6228 : cache_delete(long id) { if (caches[id].cache) gunclone(caches[id].cache); }
    2094             : static void
    2095         315 : cache_set(long id, GEN S)
    2096             : {
    2097         315 :   GEN old = caches[id].cache;
    2098         315 :   caches[id].cache = gclone(S);
    2099         315 :   if (old) gunclone(old);
    2100         315 : }
    2101             : 
    2102             : /* handle a cache miss: store stats, possibly reset table; return value
    2103             :  * if (now) cached; return NULL on failure. HACK: some caches contain an
    2104             :  * ulong where the 0 value is impossible, and return it (typecase to GEN) */
    2105             : static GEN
    2106   135866082 : cache_get(long id, ulong D)
    2107             : {
    2108   135866082 :   cache *S = &caches[id];
    2109             :   /* cache_H is compressed: D=0,1 mod 4 */
    2110   135866082 :   const ulong d = (id == cache_H)? D>>1: D;
    2111             :   ulong max, l;
    2112             : 
    2113   135866082 :   if (!S->cache)
    2114             :   {
    2115         182 :     max = maxuu(minuu(D, S->maxself), S->minself);
    2116         182 :     S->init(max);
    2117         182 :     l = lg(S->cache);
    2118             :   }
    2119             :   else
    2120             :   {
    2121   135865900 :     l = lg(S->cache);
    2122   135865900 :     if (l <= d)
    2123             :     {
    2124         882 :       if (D > S->maxmiss) S->maxmiss = D;
    2125         882 :       if (DEBUGLEVEL >= 3)
    2126           0 :         err_printf("miss in cache %s: %lu, max = %lu\n",
    2127             :                    S->name, D, S->maxmiss);
    2128         882 :       if (S->miss++ >= 5 && D < S->maxself)
    2129             :       {
    2130          77 :         max = minuu(S->maxself, (long)(S->maxmiss * 1.2));
    2131          77 :         if (max <= S->maxself)
    2132             :         {
    2133          77 :           if (DEBUGLEVEL >= 3)
    2134           0 :             err_printf("resetting cache %s to %lu\n", S->name, max);
    2135          77 :           S->init(max); l = lg(S->cache);
    2136             :         }
    2137             :       }
    2138             :     }
    2139             :   }
    2140   135866082 :   return (l <= d)? NULL: gel(S->cache, d);
    2141             : }
    2142             : static GEN
    2143          70 : cache_report(long id)
    2144             : {
    2145          70 :   cache *S = &caches[id];
    2146          70 :   GEN v = zerocol(5);
    2147          70 :   gel(v,1) = strtoGENstr(S->name);
    2148          70 :   if (S->cache)
    2149             :   {
    2150          35 :     gel(v,2) = utoi(lg(S->cache)-1);
    2151          35 :     gel(v,3) = utoi(S->miss);
    2152          35 :     gel(v,4) = utoi(S->maxmiss);
    2153          35 :     gel(v,5) = utoi(gsizebyte(S->cache));
    2154             :   }
    2155          70 :   return v;
    2156             : }
    2157             : GEN
    2158          14 : getcache(void)
    2159             : {
    2160          14 :   pari_sp av = avma;
    2161          14 :   GEN M = cgetg(6, t_MAT);
    2162          14 :   gel(M,1) = cache_report(cache_FACT);
    2163          14 :   gel(M,2) = cache_report(cache_DIV);
    2164          14 :   gel(M,3) = cache_report(cache_H);
    2165          14 :   gel(M,4) = cache_report(cache_D);
    2166          14 :   gel(M,5) = cache_report(cache_DIH);
    2167          14 :   return gerepilecopy(av, shallowtrans(M));
    2168             : }
    2169             : 
    2170             : void
    2171        1557 : pari_close_mf(void)
    2172             : {
    2173        1557 :   cache_delete(cache_DIH);
    2174        1557 :   cache_delete(cache_DIV);
    2175        1557 :   cache_delete(cache_FACT);
    2176        1557 :   cache_delete(cache_H);
    2177        1557 : }
    2178             : 
    2179             : /*************************************************************************/
    2180             : /* a odd, update local cache (recycle memory) */
    2181             : static GEN
    2182        1899 : update_factor_cache(long a, long lim, long *pb)
    2183             : {
    2184        1899 :   const long step = 16000; /* even; don't increase this: RAM cache thrashing */
    2185        1899 :   if (a + 2*step > lim)
    2186         182 :     *pb = lim; /* fuse last 2 chunks */
    2187             :   else
    2188        1717 :     *pb = a + step;
    2189        1899 :   return vecfactoroddu_i(a, *pb);
    2190             : }
    2191             : /* assume lim < MAX_LONG/8 */
    2192             : static void
    2193          63 : constcoredisc(long lim)
    2194             : {
    2195          63 :   pari_sp av2, av = avma;
    2196          63 :   GEN D = caches[cache_D].cache, CACHE = NULL;
    2197          63 :   long cachea, cacheb, N, LIM = !D ? 4 : lg(D)-1;
    2198          63 :   if (lim <= 0) lim = 5;
    2199         126 :   if (lim <= LIM) return;
    2200          63 :   cache_reset(cache_D);
    2201          63 :   D = zero_zv(lim);
    2202          63 :   av2 = avma;
    2203          63 :   cachea = cacheb = 0;
    2204     7751583 :   for (N = 1; N <= lim; N+=2)
    2205             :   { /* N odd */
    2206             :     long i, d, d2;
    2207             :     GEN F;
    2208     7751520 :     if (N > cacheb)
    2209             :     {
    2210         945 :       avma = av2; cachea = N;
    2211         945 :       CACHE = update_factor_cache(N, lim, &cacheb);
    2212             :     }
    2213     7751520 :     F = gel(CACHE, ((N-cachea)>>1)+1); /* factoru(N) */
    2214     7751520 :     D[N] = d = corediscs_fact(F); /* = 3 mod 4 or 4 mod 16 */
    2215     7751520 :     d2 = odd(d)? d<<3: d<<1;
    2216     7751520 :     for (i = 1;;)
    2217             :     {
    2218    10335353 :       if ((N << i) > lim) break;
    2219     5167658 :       D[N<<i] = d2; i++;
    2220     5167658 :       if ((N << i) > lim) break;
    2221     2583833 :       D[N<<i] = d; i++;
    2222     2583833 :     }
    2223             :   }
    2224          63 :   cache_set(cache_D, D);
    2225          63 :   avma = av;
    2226             : }
    2227             : 
    2228             : static void
    2229          70 : constfact(long lim)
    2230             : {
    2231             :   pari_sp av;
    2232          70 :   GEN VFACT = caches[cache_FACT].cache;
    2233          70 :   long LIM = VFACT? lg(VFACT)-1: 4;
    2234          70 :   if (lim <= 0) lim = 5;
    2235         140 :   if (lim <= LIM) return;
    2236          63 :   cache_reset(cache_FACT); av = avma;
    2237          63 :   cache_set(cache_FACT, vecfactoru_i(1,lim)); avma = av;
    2238             : }
    2239             : static void
    2240          63 : constdiv(long lim)
    2241             : {
    2242             :   pari_sp av;
    2243          63 :   GEN VFACT, VDIV = caches[cache_DIV].cache;
    2244          63 :   long N, LIM = VDIV? lg(VDIV)-1: 4;
    2245          63 :   if (lim <= 0) lim = 5;
    2246         126 :   if (lim <= LIM) return;
    2247          63 :   constfact(lim);
    2248          63 :   VFACT = caches[cache_FACT].cache;
    2249          63 :   cache_reset(cache_DIV); av = avma;
    2250          63 :   VDIV  = cgetg(lim+1, t_VEC);
    2251          63 :   for (N = 1; N <= lim; N++) gel(VDIV,N) = divisorsu_fact(gel(VFACT,N));
    2252          63 :   cache_set(cache_DIV, VDIV); avma = av;
    2253             : }
    2254             : 
    2255             : /* n > 1, D = divisors(n); sets L = 2*lambda(n), S = sigma(n) */
    2256             : static void
    2257     9465268 : lamsig(GEN D, long *pL, long *pS)
    2258             : {
    2259     9465268 :   pari_sp av = avma;
    2260     9465268 :   long i, l = lg(D), L = 1, S = D[l-1]+1;
    2261    34176649 :   for (i = 2; i < l; i++) /* skip d = 1 */
    2262             :   {
    2263    34176649 :     long d = D[i], nd = D[l-i]; /* nd = n/d */
    2264    34176649 :     if (d < nd) { L += d; S += d + nd; }
    2265             :     else
    2266             :     {
    2267     9465268 :       L <<= 1; if (d == nd) { L += d; S += d; }
    2268     9465268 :       break;
    2269             :     }
    2270             :   }
    2271     9465268 :   avma = av; *pL = L; *pS = S;
    2272     9465268 : }
    2273             : /* table of 6 * Hurwitz class numbers D <= lim */
    2274             : static void
    2275         119 : consttabh(long lim)
    2276             : {
    2277         119 :   pari_sp av = avma;
    2278         119 :   GEN VHDH0, VDIV, CACHE = NULL;
    2279         119 :   GEN VHDH = caches[cache_H].cache;
    2280         119 :   long r, N, cachea, cacheb, lim0 = VHDH? lg(VHDH)-1: 2, LIM = lim0 << 1;
    2281             : 
    2282         119 :   if (lim <= 0) lim = 5;
    2283         238 :   if (lim <= LIM) return;
    2284         119 :   cache_reset(cache_H);
    2285         119 :   r = lim&3L; if (r) lim += 4-r;
    2286         119 :   cache_get(cache_DIV, lim);
    2287         119 :   VDIV = caches[cache_DIV].cache;
    2288         119 :   VHDH0 = cgetg_block(lim/2 + 1, t_VECSMALL);
    2289         119 :   VHDH0[1] = 2;
    2290         119 :   VHDH0[2] = 3;
    2291         119 :   for (N = 3; N <= lim0; N++) VHDH0[N] = VHDH[N];
    2292         119 :   cachea = cacheb = 0;
    2293     4732753 :   for (N = LIM + 3; N <= lim; N += 4)
    2294             :   {
    2295     4732634 :     long s = 0, limt = usqrt(N>>2), flsq = 0, ind, t, L, S;
    2296             :     GEN DN, DN2;
    2297     4732634 :     if (N + 2 >= lg(VDIV))
    2298             :     { /* use local cache */
    2299             :       GEN F;
    2300     3945260 :       if (N + 2 > cacheb)
    2301             :       {
    2302         954 :         avma = av; cachea = N;
    2303         954 :         CACHE = update_factor_cache(N, lim+2, &cacheb);
    2304             :       }
    2305     3945260 :       F = gel(CACHE, ((N-cachea)>>1)+1); /* factoru(N) */
    2306     3945260 :       DN = divisorsu_fact(F);
    2307     3945260 :       F = gel(CACHE, ((N-cachea)>>1)+2); /* factoru(N+2) */
    2308     3945260 :       DN2 = divisorsu_fact(F);
    2309             :     }
    2310             :     else
    2311             :     { /* use global cache */
    2312      787374 :       DN = gel(VDIV,N);
    2313      787374 :       DN2 = gel(VDIV,N+2);
    2314             :     }
    2315     4732634 :     ind = N >> 1;
    2316  1050365176 :     for (t = 1; t <= limt; t++)
    2317             :     {
    2318  1045632542 :       ind -= (t<<2)-2; /* N/2 - 2t^2 */
    2319  1045632542 :       if (ind) s += VHDH0[ind]; else flsq = 1;
    2320             :     }
    2321     4732634 :     lamsig(DN, &L,&S);
    2322     4732634 :     VHDH0[N >> 1] = 2*S - 3*L - 2*s + flsq;
    2323     4732634 :     s = 0; flsq = 0; limt = (usqrt(N+2) - 1) >> 1;
    2324     4732634 :     ind = (N+1) >> 1;
    2325  1048019675 :     for (t = 1; t <= limt; t++)
    2326             :     {
    2327  1043287041 :       ind -= t<<2; /* (N+1)/2 - 2t(t+1) */
    2328  1043287041 :       if (ind) s += VHDH0[ind]; else flsq = 1;
    2329             :     }
    2330     4732634 :     lamsig(DN2, &L,&S);
    2331     4732634 :     VHDH0[(N+1) >> 1] = S - 3*(L >> 1) - s - flsq;
    2332             :   }
    2333         119 :   cache_set(cache_H, VHDH0); avma = av;
    2334             : }
    2335             : 
    2336             : /*************************************************************************/
    2337             : /* Core functions using factorizations, divisors of class numbers caches */
    2338             : /* TODO: myfactoru and factorization cache should be exported */
    2339             : static GEN
    2340    14560525 : myfactoru(long N)
    2341             : {
    2342    14560525 :   GEN z = cache_get(cache_FACT, N);
    2343    14560525 :   return z? gcopy(z): factoru(N);
    2344             : }
    2345             : static GEN
    2346    35988253 : mydivisorsu(long N)
    2347             : {
    2348    35988253 :   GEN z = cache_get(cache_DIV, N);
    2349    35988253 :   return z? leafcopy(z): divisorsu(N);
    2350             : }
    2351             : /* write -n = Df^2, D < 0 fundamental discriminant. Return D, set f. */
    2352             : static long
    2353    45950359 : mycoredisc2neg(ulong n, long *pf)
    2354             : {
    2355    45950359 :   ulong m, D = (ulong)cache_get(cache_D, n);
    2356    45950359 :   if (D) { *pf = usqrt(n/D); return -(long)D; }
    2357         168 :   m = mycore(n, pf);
    2358         168 :   if ((m&3) != 3) { m <<= 2; *pf >>= 1; }
    2359         168 :   return (long)-m;
    2360             : }
    2361             : /* write n = Df^2, D > 0 fundamental discriminant. Return D, set f. */
    2362             : static long
    2363          14 : mycoredisc2pos(ulong n, long *pf)
    2364             : {
    2365          14 :   ulong m = mycore(n, pf);
    2366          14 :   if ((m&3) != 1) { m <<= 2; *pf >>= 1; }
    2367          14 :   return (long)m;
    2368             : }
    2369             : 
    2370             : /* 1+p+...+p^e, e >= 1 */
    2371             : static ulong
    2372          49 : usumpow(ulong p, long e)
    2373             : {
    2374          49 :   ulong q = 1+p;
    2375             :   long i;
    2376          49 :   for (i = 1; i < e; i++) q = p*q + 1;
    2377          49 :   return q;
    2378             : }
    2379             : /* Hurwitz(D0 F^2)/ Hurwitz(D0)
    2380             :  * = \sum_{f|F}  f \prod_{p|f} (1-kro(D0/p)/p)
    2381             :  * = \prod_{p^e || F} (1 + (p^e-1) / (p-1) * (p-kro(D0/p))) */
    2382             : static long
    2383         259 : get_sh(long F, long D0)
    2384             : {
    2385         259 :   GEN fa = myfactoru(F), P = gel(fa,1), E = gel(fa,2);
    2386         259 :   long i, l = lg(P), t = 1;
    2387         703 :   for (i = 1; i < l; i++)
    2388             :   {
    2389         444 :     long p = P[i], e = E[i], s = kross(D0,p);
    2390         444 :     if (e == 1) { t *= 1 + p - s; continue; }
    2391         132 :     if (s == 1) { t *= upowuu(p,e); continue; }
    2392          49 :     t *= 1 + usumpow(p,e-1)*(p-s);
    2393             :   }
    2394         259 :   return t;
    2395             : }
    2396             : /* d > 0, d = 0,3 (mod 4). Return 6*hclassno(d); -d must be fundamental
    2397             :  * Faster than quadclassunit up to 5*10^5 or so */
    2398             : static ulong
    2399          42 : hclassno6u_count(ulong d)
    2400             : {
    2401          42 :   ulong a, b, b2, h = 0;
    2402          42 :   int f = 0;
    2403             : 
    2404          42 :   if (d > 500000)
    2405           7 :     return 6 * itou(gel(quadclassunit0(utoineg(d), 0, NULL, 0), 1));
    2406             : 
    2407             :   /* this part would work with -d non fundamental */
    2408          35 :   b = d&1; b2 = (1+d)>>2;
    2409          35 :   if (!b)
    2410             :   {
    2411           0 :     for (a=1; a*a<b2; a++)
    2412           0 :       if (b2%a == 0) h++;
    2413           0 :     f = (a*a==b2); b=2; b2=(4+d)>>2;
    2414             :   }
    2415        7168 :   while (b2*3 < d)
    2416             :   {
    2417        7098 :     if (b2%b == 0) h++;
    2418     1188551 :     for (a=b+1; a*a < b2; a++)
    2419     1181453 :       if (b2%a == 0) h += 2;
    2420        7098 :     if (a*a == b2) h++;
    2421        7098 :     b += 2; b2 = (b*b+d)>>2;
    2422             :   }
    2423          35 :   if (b2*3 == d) return 6*h+2;
    2424          35 :   if (f) return 6*h+3;
    2425          35 :   return 6*h;
    2426             : }
    2427             : /* D > 0; 6 * hclassno(D), using D = D0*F^2 */
    2428             : static long
    2429         301 : hclassno6u_2(ulong D, long D0, long F)
    2430             : {
    2431             :   long h;
    2432         301 :   if (F == 1) h = hclassno6u_count(D);
    2433             :   else
    2434             :   { /* second chance */
    2435         259 :     h = (ulong)cache_get(cache_H, -D0);
    2436         259 :     if (!h) h = hclassno6u_count(-D0);
    2437         259 :     h *= get_sh(F,D0);
    2438             :   }
    2439         301 :   return h;
    2440             : }
    2441             : /* D > 0; 6 * hclassno(D) (6*Hurwitz). Beware, cached value for D (=0,3 mod 4)
    2442             :  * is stored at D>>1 */
    2443             : ulong
    2444      155255 : hclassno6u(ulong D)
    2445             : {
    2446      155255 :   ulong z = (ulong)cache_get(cache_H, D);
    2447             :   long D0, F;
    2448      155255 :   if (z) return z;
    2449         301 :   D0 = mycoredisc2neg(D, &F);
    2450         301 :   return hclassno6u_2(D,D0,F);
    2451             : }
    2452             : /* same, where the decomposition D = D0*F^2 is already known */
    2453             : static ulong
    2454    34642769 : hclassno6u_i(ulong D, long D0, long F)
    2455             : {
    2456    34642769 :   ulong z = (ulong)cache_get(cache_H, D);
    2457    34642769 :   if (z) return z;
    2458           0 :   return hclassno6u_2(D,D0,F);
    2459             : }
    2460             : 
    2461             : #if 0
    2462             : /* D > 0, return h(-D) [ordinary class number].
    2463             :  * Assume consttabh(D or more) was previously called */
    2464             : static long
    2465             : hfromH(long D)
    2466             : {
    2467             :   pari_sp ltop = avma;
    2468             :   GEN m, d, fa = myfactoru(D), P = gel(fa,1), E = gel(fa,2);
    2469             :   GEN VH = caches[cache_H].cache;
    2470             :   long i, nd, S, l = lg(P);
    2471             : 
    2472             :   /* n = d[i] loops through squarefree divisors of f, where f^2 = largest square
    2473             :    * divisor of N = |D|; m[i] = moebius(n) */
    2474             :   nd = 1 << (l-1);
    2475             :   d = cgetg(nd+1, t_VECSMALL);
    2476             :   m = cgetg(nd+1, t_VECSMALL);
    2477             :   d[1] = 1; S = VH[D >> 1]; /* 6 hclassno(-D) */
    2478             :   m[1] = 1; nd = 1;
    2479             :   i = 1;
    2480             :   if (P[1] == 2 && E[1] <= 3) /* need D/n^2 to be a discriminant */
    2481             :   { if (odd(E[1]) || (E[1] == 2 && (D & 15) == 4)) i = 2; }
    2482             :   for (; i<l; i++)
    2483             :   {
    2484             :     long j, p = P[i];
    2485             :     if (E[i] == 1) continue;
    2486             :     for (j=1; j<=nd; j++)
    2487             :     {
    2488             :       long n, s, hn;
    2489             :       d[nd+j] = n = d[j] * p;
    2490             :       m[nd+j] = s = - m[j]; /* moebius(n) */
    2491             :       hn = VH[(D/(n*n)) >> 1]; /* 6 hclassno(-D/n^2) */
    2492             :       if (s > 0) S += hn; else S -= hn;
    2493             :     }
    2494             :     nd <<= 1;
    2495             :   }
    2496             :   avma = ltop; return S/6;
    2497             : }
    2498             : #endif
    2499             : /* D < -4 fundamental, h(D), ordinary class number */
    2500             : static long
    2501     4545702 : myh(long D)
    2502             : {
    2503     4545702 :   ulong z = (ulong)cache_get(cache_H, -D);
    2504     4545702 :   if (z) return z/6; /* should be hfromH(-D) if D non-fundamental */
    2505           0 :   return itou(quadclassno(stoi(D)));
    2506             : }
    2507             : 
    2508             : /*************************************************************************/
    2509             : /*                          TRACE FORMULAS                               */
    2510             : /* CHIP primitive, initialize for t_POLMOD output */
    2511             : static GEN
    2512       23702 : mfcharinit(GEN CHIP)
    2513             : {
    2514       23702 :   long n, o, l, vt, N = mfcharmodulus(CHIP);
    2515             :   GEN c, v, V, G, Pn;
    2516       23702 :   if (N == 1) return mkvec2(mkvec(gen_1), pol_x(0));
    2517        3528 :   G = gel(CHIP,1);
    2518        3528 :   v = ncharvecexpo(G, znconrey_normalized(G, gel(CHIP,2)));
    2519        3528 :   l = lg(v); V = cgetg(l, t_VEC);
    2520        3528 :   o = mfcharorder(CHIP);
    2521        3528 :   Pn = mfcharpol(CHIP); vt = varn(Pn);
    2522        3528 :   if (o <= 2)
    2523             :   {
    2524       26418 :     for (n = 1; n < l; n++)
    2525             :     {
    2526       23807 :       if (v[n] < 0) c = gen_0; else c = v[n]? gen_m1: gen_1;
    2527       23807 :       gel(V,n) = c;
    2528             :     }
    2529             :   }
    2530             :   else
    2531             :   {
    2532       16597 :     for (n = 1; n < l; n++)
    2533             :     {
    2534       15680 :       if (v[n] < 0) c = gen_0;
    2535             :       else
    2536             :       {
    2537        8722 :         c = mygmodulo_lift(v[n], o, gen_1, vt);
    2538        8722 :         if (typ(c) == t_POL && lg(c) >= lg(Pn)) c = RgX_rem(c, Pn);
    2539             :       }
    2540       15680 :       gel(V,n) = c;
    2541             :     }
    2542             :   }
    2543        3528 :   return mkvec2(V, Pn);
    2544             : }
    2545             : static GEN
    2546      325703 : vchip_lift(GEN VCHI, long x, GEN C)
    2547             : {
    2548      325703 :   GEN V = gel(VCHI,1);
    2549      325703 :   long F = lg(V)-1;
    2550      325703 :   if (F == 1) return C;
    2551       25669 :   x %= F;
    2552       25669 :   if (!x) return C;
    2553       25669 :   if (x <= 0) x += F;
    2554       25669 :   return gmul(C, gel(V, x));
    2555             : }
    2556             : static long
    2557    76378855 : vchip_FC(GEN VCHI) { return lg(gel(VCHI,1))-1; }
    2558             : static GEN
    2559     3117191 : vchip_mod(GEN VCHI, GEN S)
    2560     3117191 : { return (typ(S) == t_POL)? RgX_rem(S, gel(VCHI,2)): S; }
    2561             : static GEN
    2562      926555 : vchip_polmod(GEN VCHI, GEN S)
    2563      926555 : { return (typ(S) == t_POL)? mkpolmod(S, gel(VCHI,2)): S; }
    2564             : 
    2565             : /* ceil(m/d) */
    2566             : static long
    2567      100471 : ceildiv(long m, long d)
    2568             : {
    2569             :   long q;
    2570      100471 :   if (!m) return 0;
    2571       36505 :   q = m/d; return m%d? q+1: q;
    2572             : }
    2573             : 
    2574             : /* contribution of scalar matrices in dimension formula */
    2575             : static GEN
    2576      217168 : A1(long N, long k)
    2577      217168 : { return sstoQ(mypsiu(N)*(k-1), 12); }
    2578             : static long
    2579        6986 : ceilA1(long N, long k)
    2580        6986 : { return ceildiv(mypsiu(N) * (k-1), 12); }
    2581             : 
    2582             : /* sturm bound, slightly larger than dimension */
    2583             : long
    2584       27125 : mfsturmNk(long N, long k) { return 1 + (mypsiu(N)*k)/12; }
    2585             : long
    2586        1169 : mfsturmNgk(long N, GEN k)
    2587             : {
    2588        1169 :   long n,d; Qtoss(k,&n,&d);
    2589        1169 :   return (d == 1)? mfsturmNk(N,n): 1 + (mypsiu(N)*n)/24;
    2590             : }
    2591             : 
    2592             : /* List of all solutions of x^2 + x + 1 = 0 modulo N, x modulo N */
    2593             : static GEN
    2594         497 : sqrtm3modN(long N)
    2595             : {
    2596             :   pari_sp av;
    2597             :   GEN fa, P, E, B, mB, A, Q, T, R, v, gen_m3;
    2598         497 :   long l, i, n, ct, fl3 = 0, Ninit;
    2599         497 :   if (!odd(N) || (N%9) == 0) return cgetg(1,t_VECSMALL);
    2600         469 :   Ninit = N;
    2601         469 :   if ((N%3) == 0) { N /= 3; fl3 = 1; }
    2602         469 :   fa = myfactoru(N); P = gel(fa, 1); E = gel(fa, 2);
    2603         469 :   l = lg(P);
    2604         651 :   for (i = 1; i < l; i++)
    2605         476 :     if ((P[i]%3) == 2) return cgetg(1,t_VECSMALL);
    2606         175 :   A = cgetg(l, t_VECSMALL);
    2607         175 :   B = cgetg(l, t_VECSMALL);
    2608         175 :   mB= cgetg(l, t_VECSMALL);
    2609         175 :   Q = cgetg(l, t_VECSMALL); gen_m3 = utoineg(3);
    2610         357 :   for (i = 1; i < l; i++)
    2611             :   {
    2612         182 :     long p = P[i], e = E[i];
    2613         182 :     Q[i] = upowuu(p,e);
    2614         182 :     B[i] = itou( Zp_sqrt(gen_m3, utoipos(p), e) );
    2615         182 :     mB[i]= Q[i] - B[i];
    2616             :   }
    2617         175 :   ct = 1 << (l-1);
    2618         175 :   T = ZV_producttree(Q);
    2619         175 :   R = ZV_chinesetree(Q,T);
    2620         175 :   v = cgetg(ct+1, t_VECSMALL);
    2621         175 :   av = avma;
    2622         539 :   for (n = 1; n <= ct; n++)
    2623             :   {
    2624         364 :     long m = n-1, r;
    2625         756 :     for (i = 1; i < l; i++)
    2626             :     {
    2627         392 :       A[i] = (m&1L)? mB[i]: B[i];
    2628         392 :       m >>= 1;
    2629             :     }
    2630         364 :     r = itou( ZV_chinese_tree(A, Q, T, R) );
    2631         364 :     if (fl3) while (r%3) r += N;
    2632         364 :     avma = av; v[n] = odd(r) ? (r-1) >> 1 : (r+Ninit-1) >> 1;
    2633             :   }
    2634         175 :   return v;
    2635             : }
    2636             : 
    2637             : /* number of elliptic points of order 3 in X0(N) */
    2638             : static long
    2639        9100 : nu3(long N)
    2640             : {
    2641             :   long i, l;
    2642             :   GEN P;
    2643        9100 :   if (!odd(N) || (N%9) == 0) return 0;
    2644        8106 :   if ((N%3) == 0) N /= 3;
    2645        8106 :   P = gel(myfactoru(N), 1); l = lg(P);
    2646        8106 :   for (i = 1; i < l; i++) if ((P[i]%3) == 2) return 0;
    2647        3493 :   return 1L<<(l-1);
    2648             : }
    2649             : /* number of elliptic points of order 2 in X0(N) */
    2650             : static long
    2651       15834 : nu2(long N)
    2652             : {
    2653             :   long i, l;
    2654             :   GEN P;
    2655       15834 :   if ((N&3L) == 0) return 0;
    2656       15834 :   if (!odd(N)) N >>= 1;
    2657       15834 :   P = gel(myfactoru(N), 1); l = lg(P);
    2658       15834 :   for (i = 1; i < l; i++) if ((P[i]&3L) == 3) return 0;
    2659        3556 :   return 1L<<(l-1);
    2660             : }
    2661             : 
    2662             : /* contribution of elliptic matrices of order 3 in dimension formula
    2663             :  * Only depends on CHIP the primitive char attached to CHI */
    2664             : static GEN
    2665       38374 : A21(long N, long k, GEN CHI)
    2666             : {
    2667             :   GEN res, G, chi, o;
    2668             :   long a21, i, limx, S;
    2669       38374 :   if ((N&1L) == 0) return gen_0;
    2670       18935 :   a21 = k%3 - 1;
    2671       18935 :   if (!a21) return gen_0;
    2672       18291 :   if (N <= 3) return sstoQ(a21, 3);
    2673        9597 :   if (!CHI) return sstoQ(nu3(N) * a21, 3);
    2674         497 :   res = sqrtm3modN(N); limx = (N - 1) >> 1;
    2675         497 :   G = gel(CHI,1); chi = gel(CHI,2);
    2676         497 :   o = gmfcharorder(CHI);
    2677         861 :   for (S = 0, i = 1; i < lg(res); i++)
    2678             :   { /* (x,N) = 1; S += chi(x) + chi(x^2) */
    2679         364 :     long x = res[i];
    2680         364 :     if (x <= limx)
    2681             :     { /* CHI(x)=e(c/o), 3rd-root of 1 */
    2682         182 :       GEN c = znchareval(G, chi, utoi(x), o);
    2683         182 :       if (!signe(c)) S += 2; else S--;
    2684             :     }
    2685             :   }
    2686         497 :   return sstoQ(a21 * S, 3);
    2687             : }
    2688             : 
    2689             : /* List of all square roots of -1 modulo N */
    2690             : static GEN
    2691         567 : sqrtm1modN(long N)
    2692             : {
    2693             :   pari_sp av;
    2694             :   GEN fa, P, E, B, mB, A, Q, T, R, v;
    2695         567 :   long l, i, n, ct, fleven = 0;
    2696         567 :   if ((N&3L) == 0) return cgetg(1,t_VECSMALL);
    2697         567 :   if ((N&1L) == 0) { N >>= 1; fleven = 1; }
    2698         567 :   fa = myfactoru(N); P = gel(fa,1); E = gel(fa,2);
    2699         567 :   l = lg(P);
    2700         917 :   for (i = 1; i < l; i++)
    2701         637 :     if ((P[i]&3L) == 3) return cgetg(1,t_VECSMALL);
    2702         280 :   A = cgetg(l, t_VECSMALL);
    2703         280 :   B = cgetg(l, t_VECSMALL);
    2704         280 :   mB= cgetg(l, t_VECSMALL);
    2705         280 :   Q = cgetg(l, t_VECSMALL);
    2706         574 :   for (i = 1; i < l; i++)
    2707             :   {
    2708         294 :     long p = P[i], e = E[i];
    2709         294 :     Q[i] = upowuu(p,e);
    2710         294 :     B[i] = itou( Zp_sqrt(gen_m1, utoipos(p), e) );
    2711         294 :     mB[i]= Q[i] - B[i];
    2712             :   }
    2713         280 :   ct = 1 << (l-1);
    2714         280 :   T = ZV_producttree(Q);
    2715         280 :   R = ZV_chinesetree(Q,T);
    2716         280 :   v = cgetg(ct+1, t_VECSMALL);
    2717         280 :   av = avma;
    2718         868 :   for (n = 1; n <= ct; n++)
    2719             :   {
    2720         588 :     long m = n-1, r;
    2721        1232 :     for (i = 1; i < l; i++)
    2722             :     {
    2723         644 :       A[i] = (m&1L)? mB[i]: B[i];
    2724         644 :       m >>= 1;
    2725             :     }
    2726         588 :     r = itou( ZV_chinese_tree(A, Q, T, R) );
    2727         588 :     if (fleven && !odd(r)) r += N;
    2728         588 :     avma = av; v[n] = r;
    2729             :   }
    2730         280 :   return v;
    2731             : }
    2732             : 
    2733             : /* contribution of elliptic matrices of order 4 in dimension formula.
    2734             :  * Only depends on CHIP the primitive char attached to CHI */
    2735             : static GEN
    2736       38374 : A22(long N, long k, GEN CHI)
    2737             : {
    2738             :   GEN G, chi, o, res;
    2739             :   long S, a22, i, limx, o2;
    2740       38374 :   if ((N&3L) == 0) return gen_0;
    2741       27069 :   a22 = (k & 3L) - 1; /* (k % 4) - 1 */
    2742       27069 :   if (!a22) return gen_0;
    2743       27069 :   if (N <= 2) return sstoQ(a22, 4);
    2744       16597 :   if (!CHI) return sstoQ(nu2(N)*a22, 4);
    2745         763 :   if (mfcharparity(CHI) == -1) return gen_0;
    2746         567 :   res = sqrtm1modN(N); limx = (N - 1) >> 1;
    2747         567 :   G = gel(CHI,1); chi = gel(CHI,2);
    2748         567 :   o = gmfcharorder(CHI);
    2749         567 :   o2 = itou(o)>>1;
    2750        1155 :   for (S = 0, i = 1; i < lg(res); i++)
    2751             :   { /* (x,N) = 1, S += real(chi(x)) */
    2752         588 :     long x = res[i];
    2753         588 :     if (x <= limx)
    2754             :     { /* CHI(x)=e(c/o), 4th-root of 1 */
    2755         294 :       long c = itou( znchareval(G, chi, utoi(x), o) );
    2756         294 :       if (!c) S++; else if (c == o2) S--;
    2757             :     }
    2758             :   }
    2759         567 :   return sstoQ(a22 * S, 2);
    2760             : }
    2761             : 
    2762             : /* sumdiv(N,d,eulerphi(gcd(d,N/d))) */
    2763             : static long
    2764       34713 : nuinf(long N)
    2765             : {
    2766       34713 :   GEN fa = myfactoru(N), P = gel(fa,1), E = gel(fa,2);
    2767       34713 :   long i, t = 1, l = lg(P);
    2768       73927 :   for (i=1; i<l; i++)
    2769             :   {
    2770       39214 :     long p = P[i], e = E[i];
    2771       39214 :     if (odd(e))
    2772       31507 :       t *= upowuu(p,e>>1) << 1;
    2773             :     else
    2774        7707 :       t *= upowuu(p,(e>>1)-1) * (p+1);
    2775             :   }
    2776       34713 :   return t;
    2777             : }
    2778             : 
    2779             : /* contribution of hyperbolic matrices in dimension formula */
    2780             : static GEN
    2781       38640 : A3(long N, long FC)
    2782             : {
    2783             :   long i, S, NF, l;
    2784             :   GEN D;
    2785       38640 :   if (FC == 1) return sstoQ(nuinf(N),2);
    2786        3927 :   D = mydivisorsu(N); l = lg(D);
    2787        3927 :   S = 0; NF = N/FC;
    2788       30191 :   for (i = 1; i < l; i++)
    2789             :   {
    2790       26264 :     long g = cgcd(D[i], D[l-i]);
    2791       26264 :     if (NF%g == 0) S += myeulerphiu(g);
    2792             :   }
    2793        3927 :   return sstoQ(S, 2);
    2794             : }
    2795             : 
    2796             : /* special contribution in weight 2 in dimension formula */
    2797             : static long
    2798       38108 : A4(long k, long FC)
    2799       38108 : { return (k==2 && FC==1)? 1: 0; }
    2800             : /* gcd(x,N) */
    2801             : static long
    2802    90488195 : myugcd(GEN GCD, ulong x)
    2803             : {
    2804    90488195 :   ulong N = lg(GCD)-1;
    2805    90488195 :   if (x >= N) x %= N;
    2806    90488195 :   return GCD[x+1];
    2807             : }
    2808             : /* 1_{gcd(x,N) = 1} * chi(x), return NULL if 0 */
    2809             : static GEN
    2810   122922912 : mychicgcd(GEN GCD, GEN VCHI, long x)
    2811             : {
    2812   122922912 :   long N = lg(GCD)-1;
    2813   122922912 :   if (N == 1) return gen_1;
    2814   106621186 :   x = smodss(x, N);
    2815   106621186 :   if (GCD[x+1] != 1) return NULL;
    2816    73142636 :   x %= vchip_FC(VCHI); if (!x) return gen_1;
    2817     6553827 :   return gel(gel(VCHI,1), x);
    2818             : }
    2819             : 
    2820             : /* contribution of scalar matrices to trace formula */
    2821             : static GEN
    2822     2946552 : TA1(long N, long k, GEN VCHI, GEN GCD, long n)
    2823             : {
    2824             :   GEN S;
    2825             :   ulong m;
    2826     2946552 :   if (!uissquareall(n, &m)) return gen_0;
    2827      232694 :   if (m == 1) return A1(N,k); /* common */
    2828      204204 :   S = mychicgcd(GCD, VCHI, m);
    2829      204204 :   return S? gmul(gmul(powuu(m, k-2), A1(N,k)), S): gen_0;
    2830             : }
    2831             : 
    2832             : /* All square roots modulo 4N, x modulo 2N, precomputed to accelerate TA2 */
    2833             : static GEN
    2834       95291 : mksqr(long N)
    2835             : {
    2836       95291 :   pari_sp av = avma;
    2837       95291 :   long x, N2 = N << 1, N4 = N << 2;
    2838       95291 :   GEN v = const_vec(N2, cgetg(1, t_VECSMALL));
    2839       95291 :   gel(v, N2) = mkvecsmall(0); /* x = 0 */
    2840     2163126 :   for (x = 1; x <= N; x++)
    2841             :   {
    2842     2067835 :     long r = (((x*x - 1)%N4) >> 1) + 1;
    2843     2067835 :     gel(v,r) = vecsmall_append(gel(v,r), x);
    2844             :   }
    2845       95291 :   return gerepilecopy(av, v);
    2846             : }
    2847             : 
    2848             : static GEN
    2849       95291 : mkgcd(long N)
    2850             : {
    2851             :   GEN GCD, d;
    2852             :   long i, N2;
    2853       95291 :   if (N == 1) return mkvecsmall(N);
    2854       78757 :   GCD = cgetg(N + 1, t_VECSMALL);
    2855       78757 :   d = GCD+1; /* GCD[i+1] = d[i] = gcd(i,N) = gcd(N-i,N), i = 0..N-1 */
    2856       78757 :   d[0] = N; d[1] = d[N-1] = 1; N2 = N>>1;
    2857       78757 :   for (i = 2; i <= N2; i++) d[i] = d[N-i] = ugcd(N, i);
    2858       78757 :   return GCD;
    2859             : }
    2860             : 
    2861             : /* Table of \sum_{x^2-tx+n=0 mod Ng}chi(x) for all g dividing gcd(N,F),
    2862             :  * F^2 largest such that (t^2-4n)/F^2=0 or 1 mod 4; t >= 0 */
    2863             : static GEN
    2864     9320199 : mutglistall(long t, long N, long NF, GEN VCHI, long n, GEN MUP, GEN li, GEN GCD)
    2865             : {
    2866     9320199 :   long i, lx = lg(li);
    2867     9320199 :   GEN DNF = mydivisorsu(NF), v = zerovec(NF);
    2868     9320199 :   long j, g, lDNF = lg(DNF);
    2869    25655868 :   for (i = 1; i < lx; i++)
    2870             :   {
    2871    16335669 :     long x = (li[i] + t) >> 1, y, lD;
    2872    16335669 :     GEN D, c = mychicgcd(GCD, VCHI, x);
    2873    16335669 :     if (li[i] && li[i] != N)
    2874             :     {
    2875    10840396 :       GEN c2 = mychicgcd(GCD, VCHI, t - x);
    2876    10840396 :       if (c2) c = c? gadd(c, c2): c2;
    2877             :     }
    2878    16335669 :     if (!c) continue;
    2879     9407370 :     y = (x*(x - t) + n) / N; /* exact division */
    2880     9407370 :     D = mydivisorsu(cgcd(y, NF)); lD = lg(D);
    2881     9407370 :     for (j=1; j < lD; j++) { g = D[j]; gel(v,g) = gadd(gel(v,g), c); }
    2882             :   }
    2883             :   /* j = 1 corresponds to g = 1, and MUP[1] = 1 */
    2884     9320199 :   for (j=2; j < lDNF; j++) { g = DNF[j]; gel(v,g) = gmulsg(MUP[g], gel(v,g)); }
    2885     9320199 :   return v;
    2886             : }
    2887             : 
    2888             : /* special case (N,F) = 1: easier */
    2889             : static GEN
    2890    36629845 : mutg1(long t, long N, GEN VCHI, GEN li, GEN GCD)
    2891             : { /* (N,F) = 1 */
    2892    36629845 :   GEN S = NULL;
    2893    36629845 :   long i, lx = lg(li);
    2894    77893816 :   for (i = 1; i < lx; i++)
    2895             :   {
    2896    41263971 :     long x = (li[i] + t) >> 1;
    2897    41263971 :     GEN c = mychicgcd(GCD, VCHI, x);
    2898    41263971 :     if (c) S = S? gadd(S, c): c;
    2899    41263971 :     if (li[i] && li[i] != N)
    2900             :     {
    2901    24330446 :       c = mychicgcd(GCD, VCHI, t - x);
    2902    24330446 :       if (c) S = S? gadd(S, c): c;
    2903             :     }
    2904    41263971 :     if (S && !signe(S)) S = NULL; /* strive hard to add gen_0 */
    2905             :   }
    2906    36629845 :   return S; /* single value */
    2907             : }
    2908             : 
    2909             : /* Gegenbauer pol; n > 2, P = \sum_{0<=j<=n/2} (-1)^j (n-j)!/j!(n-2*j)! X^j */
    2910             : static GEN
    2911      303926 : mfrhopol(long n)
    2912             : {
    2913             : #ifdef LONG_IS_64BIT
    2914      260508 :   const long M = 2642249;
    2915             : #else
    2916       43418 :   const long M = 1629;
    2917             : #endif
    2918      303926 :   long j, d = n >> 1; /* >= 1 */
    2919      303926 :   GEN P = cgetg(d + 3, t_POL);
    2920             : 
    2921      303926 :   if (n > M) pari_err_IMPL("mfrhopol for large weight"); /* avoid overflow */
    2922      303926 :   P[1] = evalvarn(0)|evalsigne(1);
    2923      303926 :   gel(P,2) = gen_1;
    2924      303926 :   gel(P,3) = utoineg(n-1); /* j = 1 */
    2925      303926 :   if (d > 1) gel(P,4) = utoipos(((n-3)*(n-2)) >> 1); /* j = 2 */
    2926      303926 :   if (d > 2) gel(P,5) = utoineg(((n-5)*(n-4)*(n-3)) / 6); /* j = 3 */
    2927      308385 :   for (j = 4; j <= d; j++)
    2928        4459 :     gel(P,j+2) = divis(mulis(gel(P,j+1), (n-2*j+1)*(n-2*j+2)), (n-j+1)*(-j));
    2929      303926 :   return P;
    2930             : }
    2931             : 
    2932             : /* polrecip(Q)(t2), assume Q(0) = 1 */
    2933             : static GEN
    2934     1909775 : ZXrecip_u_eval(GEN Q, ulong t2)
    2935             : {
    2936     1909775 :   GEN T = addiu(gel(Q,3), t2);
    2937     1909775 :   long l = lg(Q), j;
    2938     1909775 :   for (j = 4; j < l; j++) T = addii(gel(Q,j), mului(t2, T));
    2939     1909775 :   return T;
    2940             : }
    2941             : /* return sh * sqrt(n)^nu * G_nu(t/(2*sqrt(n))) for t != 0
    2942             :  * else (sh/2) * sqrt(n)^nu * G_nu(0) [ implies nu is even ]
    2943             :  * G_nu(z) = \sum_{0<=j<=nu/2} (-1)^j (nu-j)!/j!(nu-2*j)! * (2z)^(nu-2*j)) */
    2944             : static GEN
    2945    39669518 : mfrhopowsimp(GEN Q, GEN sh, long nu, long t, long t2, long n)
    2946             : {
    2947             :   GEN T;
    2948    39669518 :   switch (nu)
    2949             :   {
    2950    33084275 :     case 0: return t? sh: gmul2n(sh,-1);
    2951     3434116 :     case 1: return gmulsg(t, sh);
    2952     1228101 :     case 2: return t? gmulsg(t2 - n, sh): gmul(gmul2n(stoi(-n), -1), sh);
    2953         469 :     case 3: return gmul(mulss(t, t2 - 2*n), sh);
    2954             :     default:
    2955     1922557 :       if (!t) return gmul(gmul2n(gel(Q, lg(Q) - 1), -1), sh);
    2956     1909775 :       T = ZXrecip_u_eval(Q, t2); if (odd(nu)) T = mulsi(t, T);
    2957     1909775 :       return gmul(T, sh);
    2958             :   }
    2959             : }
    2960             : 
    2961             : /* contribution of elliptic matrices to trace formula */
    2962             : static GEN
    2963     2946552 : TA2(long N, long k, GEN VCHI, long n, GEN SQRTS, GEN MUP, GEN GCD)
    2964             : {
    2965     2946552 :   const long n4 = n << 2, N4 = N << 2, nu = k - 2;
    2966     2946552 :   const long st = (!odd(N) && odd(n)) ? 2 : 1;
    2967             :   long limt, t;
    2968             :   GEN S, Q;
    2969             : 
    2970     2946552 :   limt = usqrt(n4);
    2971     2946552 :   if (limt*limt == n4) limt--;
    2972     2946552 :   Q = nu > 3 ? ZX_z_unscale(mfrhopol(nu), n) : NULL;
    2973     2946552 :   S = gen_0;
    2974    82496687 :   for (t = odd(k)? st: 0; t <= limt; t += st) /* t^2 < 4n */
    2975             :   {
    2976    79550135 :     pari_sp av = avma;
    2977    79550135 :     long t2 = t*t, D = n4 - t2, F, D0, NF;
    2978             :     GEN sh, li;
    2979             : 
    2980    79550135 :     li = gel(SQRTS, (smodss(-D - 1, N4) >> 1) + 1);
    2981   119430752 :     if (lg(li) == 1) continue;
    2982    45950044 :     D0 = mycoredisc2neg(D, &F);
    2983    45950044 :     NF = myugcd(GCD, F);
    2984    45950044 :     if (NF == 1)
    2985             :     { /* (N,F) = 1 => single value in mutglistall */
    2986    36629845 :       GEN mut = mutg1(t, N, VCHI, li, GCD);
    2987    36629845 :       if (!mut) { avma = av; continue; }
    2988    34642769 :       sh = gmul(sstoQ(hclassno6u_i(D,D0,F),6), mut);
    2989             :     }
    2990             :     else
    2991             :     {
    2992     9320199 :       GEN v = mutglistall(t, N, NF, VCHI, n, MUP, li, GCD);
    2993     9320199 :       GEN DF = mydivisorsu(F);
    2994     9320199 :       long i, lDF = lg(DF);
    2995     9320199 :       sh = gen_0;
    2996    36081059 :       for (i = 1; i < lDF; i++)
    2997             :       {
    2998    26760860 :         long Ff, f = DF[i], g = myugcd(GCD, f);
    2999    26760860 :         GEN mut = gel(v, g);
    3000    26760860 :         if (gequal0(mut)) continue;
    3001    12108558 :         Ff = DF[lDF-i]; /* F/f */
    3002    12108558 :         if (Ff == 1) sh = gadd(sh, mut);
    3003             :         else
    3004             :         {
    3005     8711073 :           GEN P = gel(myfactoru(Ff), 1);
    3006     8711073 :           long j, lP = lg(P);
    3007     8711073 :           for (j = 1; j < lP; j++) { long p = P[j]; Ff -= kross(D0, p)*Ff/p; }
    3008     8711073 :           sh = gadd(sh, gmulsg(Ff, mut));
    3009             :         }
    3010             :       }
    3011     9320199 :       if (gequal0(sh)) { avma = av; continue; }
    3012     5026749 :       if (D0 == -3) sh = gdivgs(sh, 3);
    3013     4785214 :       else if (D0 == -4) sh = gdivgs(sh, 2);
    3014     4545702 :       else sh = gmulgs(sh, myh(D0));
    3015             :     }
    3016    39669518 :     S = gerepileupto(av, gadd(S, mfrhopowsimp(Q,sh,nu,t,t2,n)));
    3017             :   }
    3018     2946552 :   return S;
    3019             : }
    3020             : 
    3021             : /* compute global auxiliary data for TA3 */
    3022             : static GEN
    3023       95291 : mkbez(long N, long FC)
    3024             : {
    3025       95291 :   long ct, i, NF = N/FC;
    3026       95291 :   GEN w, D = mydivisorsu(N);
    3027       95291 :   long l = lg(D);
    3028             : 
    3029       95291 :   w = cgetg(l, t_VEC);
    3030      274442 :   for (i = ct = 1; i < l; i++)
    3031             :   {
    3032      257908 :     long u, v, h, c = D[i], Nc = D[l-i];
    3033      257908 :     if (c > Nc) break;
    3034      179151 :     h = cbezout(c, Nc, &u, &v);
    3035      179151 :     if (h == 1) /* shortcut */
    3036      131684 :       gel(w, ct++) = mkvecsmall4(1,u*c,1,i);
    3037       47467 :     else if (!(NF%h))
    3038       42791 :       gel(w, ct++) = mkvecsmall4(h,u*(c/h),myeulerphiu(h),i);
    3039             :   }
    3040       95291 :   setlg(w,ct); stackdummy((pari_sp)(w+ct),(pari_sp)(w+l));
    3041       95291 :   return w;
    3042             : }
    3043             : 
    3044             : /* contribution of hyperbolic matrices to trace formula, d * nd = n,
    3045             :  * DN = divisorsu(N) */
    3046             : static GEN
    3047    11670666 : auxsum(GEN VCHI, GEN GCD, long d, long nd, GEN DN, GEN BEZ)
    3048             : {
    3049    11670666 :   GEN S = gen_0;
    3050    11670666 :   long ct, g = nd - d, lDN = lg(DN), lBEZ = lg(BEZ);
    3051    32938717 :   for (ct = 1; ct < lBEZ; ct++)
    3052             :   {
    3053    21268051 :     GEN y, B = gel(BEZ, ct);
    3054    21268051 :     long ic, c, Nc, uch, h = B[1];
    3055    21268051 :     if (g%h) continue;
    3056    20800920 :     uch = B[2];
    3057    20800920 :     ic  = B[4];
    3058    20800920 :     c = DN[ic];
    3059    20800920 :     Nc= DN[lDN - ic]; /* Nc = N/c */
    3060    20800920 :     if (cgcd(Nc, nd) == 1)
    3061    15339912 :       y = mychicgcd(GCD, VCHI, d + uch*g); /* 0 if (c,d) > 1 */
    3062             :     else
    3063     5461008 :       y = NULL;
    3064    20800920 :     if (c != Nc && cgcd(Nc, d) == 1)
    3065             :     {
    3066    14608314 :       GEN y2 = mychicgcd(GCD, VCHI, nd - uch*g); /* 0 if (c,nd) > 1 */
    3067    14608314 :       if (y2) y = y? gadd(y, y2): y2;
    3068             :     }
    3069    20800920 :     if (y) S = gadd(S, gmulsg(B[3], y));
    3070             :   }
    3071    11670666 :   return S;
    3072             : }
    3073             : 
    3074             : static GEN
    3075     2946552 : TA3(long N, long k, GEN VCHI, GEN GCD, GEN Dn, GEN BEZ)
    3076             : {
    3077     2946552 :   GEN S = gen_0, DN = mydivisorsu(N);
    3078     2946552 :   long i, l = lg(Dn);
    3079    14617218 :   for (i = 1; i < l; i++)
    3080             :   {
    3081    14588728 :     long d = Dn[i], nd = Dn[l-i]; /* = n/d */
    3082             :     GEN t, u;
    3083    14588728 :     if (d > nd) break;
    3084    11670666 :     t = auxsum(VCHI, GCD, d, nd, DN, BEZ);
    3085    11670666 :     if (isintzero(t)) continue;
    3086    10599778 :     u = powuu(d,k-1); if (d == nd) u = gmul2n(u,-1);
    3087    10599778 :     S = gadd(S, gmul(u,t));
    3088             :   }
    3089     2946552 :   return S;
    3090             : }
    3091             : 
    3092             : /* special contribution in weight 2 in trace formula */
    3093             : static long
    3094     2946552 : TA4(long k, GEN VCHIP, GEN Dn, GEN GCD)
    3095             : {
    3096             :   long i, l, S;
    3097     2946552 :   if (k != 2 || vchip_FC(VCHIP) != 1) return 0;
    3098     2326534 :   l = lg(Dn); S = 0;
    3099    20103825 :   for (i = 1; i < l; i++)
    3100             :   {
    3101    17777291 :     long d = Dn[i]; /* gcd(N,n/d) == 1? */
    3102    17777291 :     if (myugcd(GCD, Dn[l-i]) == 1) S += d;
    3103             :   }
    3104     2326534 :   return S;
    3105             : }
    3106             : 
    3107             : /* precomputation of products occurring im mutg, again to accelerate TA2 */
    3108             : static GEN
    3109       95291 : mkmup(long N)
    3110             : {
    3111       95291 :   GEN fa = myfactoru(N), P = gel(fa,1), D = divisorsu_fact(fa);
    3112       95291 :   long i, lP = lg(P), lD = lg(D);
    3113       95291 :   GEN MUP = zero_zv(N);
    3114       95291 :   MUP[1] = 1;
    3115      330778 :   for (i = 2; i < lD; i++)
    3116             :   {
    3117      235487 :     long j, g = D[i], Ng = D[lD-i]; /*  N/g */
    3118      235487 :     for (j = 1; j < lP; j++) { long p = P[j]; if (Ng%p) g += g/p; }
    3119      235487 :     MUP[D[i]] = g;
    3120             :   }
    3121       95291 :   return MUP;
    3122             : }
    3123             : 
    3124             : /* quadratic non-residues mod p; p odd prime, p^2 fits in a long */
    3125             : static GEN
    3126        1400 : non_residues(long p)
    3127             : {
    3128        1400 :   long i, j, p2 = p >> 1;
    3129        1400 :   GEN v = cgetg(p2+1, t_VECSMALL), w = const_vecsmall(p-1, 1);
    3130        1400 :   for (i = 2; i <= p2; i++) w[(i*i) % p] = 0; /* no need to check 1 */
    3131        1400 :   for (i = 2, j = 1; i < p; i++) if (w[i]) v[j++] = i;
    3132        1400 :   return v;
    3133             : }
    3134             : 
    3135             : /* CHIP primitive. Return t_VECSMALL v of length q such that
    3136             :  * Tr^new_{N,CHIP}(n) = 0 whenever v[(n%q) + 1] is non-zero */
    3137             : static GEN
    3138       23730 : mfnewzerodata(long N, GEN CHIP)
    3139             : {
    3140       23730 :   GEN V, M, L, faN = myfactoru(N), PN = gel(faN,1), EN = gel(faN,2);
    3141       23730 :   GEN G = gel(CHIP,1), chi = gel(CHIP,2);
    3142       23730 :   GEN fa = znstar_get_faN(G), P = ZV_to_zv(gel(fa,1)), E = gel(fa,2);
    3143       23730 :   long i, mod, j = 1, l = lg(PN);
    3144             : 
    3145       23730 :   M = cgetg(l, t_VECSMALL); M[1] = 0;
    3146       23730 :   V = cgetg(l, t_VEC);
    3147             :   /* Tr^new(n) = 0 if (n mod M[i]) in V[i]  */
    3148       23730 :   if ((N & 3) == 0)
    3149             :   {
    3150        8771 :     long e = EN[1];
    3151        8771 :     long c = (lg(P) > 1 && P[1] == 2)? E[1]: 0; /* c = v_2(FC) */
    3152             :     /* e >= 2 */
    3153        8771 :     if (c == e-1) return NULL; /* Tr^new = 0 */
    3154        8736 :     if (c == e)
    3155             :     {
    3156        1960 :       if (e == 2)
    3157             :       { /* sc: -4 */
    3158        1302 :         gel(V,1) = mkvecsmall(3);
    3159        1302 :         M[1] = 4;
    3160             :       }
    3161         658 :       else if (e == 3)
    3162             :       { /* sc: -8 (CHI_2(-1)=-1<=>chi[1]=1) and 8 (CHI_2(-1)=1 <=> chi[1]=0) */
    3163         658 :         long t = signe(gel(chi,1))? 7: 3;
    3164         658 :         gel(V,1) = mkvecsmall2(5, t);
    3165         658 :         M[1] = 8;
    3166             :       }
    3167             :     }
    3168        6776 :     else if (e == 5 && c == 3)
    3169         154 :     { /* sc: -8 (CHI_2(-1)=-1<=>chi[1]=1) and 8 (CHI_2(-1)=1 <=> chi[1]=0) */
    3170         154 :       long t = signe(gel(chi,1))? 7: 3;
    3171         154 :       gel(V,1) = mkvecsmalln(6, 2L,4L,5L,6L,8L,t);
    3172         154 :       M[1] = 8;
    3173             :     }
    3174        6622 :     else if ((e == 4 && c == 2) || (e == 5 && c <= 2) || (e == 6 && c <= 2)
    3175        5453 :          || (e >= 7 && c == e - 3))
    3176             :     { /* sc: 4 */
    3177        1169 :       gel(V,1) = mkvecsmall3(0,2,3);
    3178        1169 :       M[1] = 4;
    3179             :     }
    3180        5453 :     else if ((e <= 4 && c == 0) || (e >= 5 && c == e - 2))
    3181             :     { /* sc: 2 */
    3182        5243 :       gel(V,1) = mkvecsmall(0);
    3183        5243 :       M[1] = 2;
    3184             :     }
    3185         210 :     else if ((e == 6 && c == 3) || (e >= 7 && c <= e - 4))
    3186             :     { /* sc: -2 */
    3187         210 :       gel(V,1) = mkvecsmalln(7, 0L,2L,3L,4L,5L,6L,7L);
    3188         210 :       M[1] = 8;
    3189             :     }
    3190             :   }
    3191       23695 :   j = M[1]? 2: 1;
    3192       51275 :   for (i = odd(N)? 1: 2; i < l; i++) /* skip p=2, done above */
    3193             :   {
    3194       27580 :     long p = PN[i], e = EN[i];
    3195       27580 :     long z = zv_search(P, p), c = z? E[z]: 0; /* c = v_p(FC) */
    3196       27580 :     if ((e <= 2 && c == 1 && itos(gel(chi,z)) == (p>>1)) /* ord(CHI_p)=2 */
    3197       26642 :         || (e >= 3 && c <= e - 2))
    3198        1400 :     { /* sc: -p */
    3199        1400 :       GEN v = non_residues(p);
    3200        1400 :       if (e != 1) v = vecsmall_prepend(v, 0);
    3201        1400 :       gel(V,j) = v;
    3202        1400 :       M[j] = p; j++;
    3203             :     }
    3204       26180 :     else if (e >= 2 && c < e)
    3205             :     { /* sc: p */
    3206        1820 :       gel(V,j) = mkvecsmall(0);
    3207        1820 :       M[j] = p; j++;
    3208             :     }
    3209             :   }
    3210       23695 :   if (j == 1) return cgetg(1, t_VECSMALL);
    3211       10430 :   setlg(V,j); setlg(M,j); mod = zv_prod(M);
    3212       10430 :   L = zero_zv(mod);
    3213       22386 :   for (i = 1; i < j; i++)
    3214             :   {
    3215       11956 :     GEN v = gel(V,i);
    3216       11956 :     long s, m = M[i], lv = lg(v);
    3217       31066 :     for (s = 1; s < lv; s++)
    3218             :     {
    3219       19110 :       long a = v[s] + 1;
    3220       28896 :       do { L[a] = 1; a += m; } while (a <= mod);
    3221             :     }
    3222             :   }
    3223       10430 :   return L;
    3224             : }
    3225             : /* v=mfnewzerodata(N,CHI); returns TRUE if newtrace(n) must be zero,
    3226             :  * (but newtrace(n) may still be zero if we return FALSE) */
    3227             : static long
    3228     1222172 : mfnewchkzero(GEN v, long n) { long q = lg(v)-1; return q && v[(n%q) + 1]; }
    3229             : 
    3230             : /* if (!VCHIP): from mftraceform_cusp;
    3231             :  * else from initnewtrace and CHI is known to be primitive */
    3232             : static GEN
    3233       95291 : inittrace(long N, GEN CHI, GEN VCHIP)
    3234             : {
    3235             :   long FC;
    3236       95291 :   if (VCHIP)
    3237       95284 :     FC = mfcharmodulus(CHI);
    3238             :   else
    3239           7 :     VCHIP = mfcharinit(mfchartoprimitive(CHI, &FC));
    3240       95291 :   return mkvecn(5, mksqr(N), mkmup(N), mkgcd(N), VCHIP, mkbez(N, FC));
    3241             : }
    3242             : 
    3243             : /* p > 2 prime; return a sorted t_VECSMALL of primes s.t Tr^new(p) = 0 for all
    3244             :  * weights > 2 */
    3245             : static GEN
    3246       23695 : inittrconj(long N, long FC)
    3247             : {
    3248             :   GEN fa, P, E, v;
    3249             :   long i, k, l;
    3250             : 
    3251       23695 :   if (FC != 1) return cgetg(1,t_VECSMALL);
    3252             : 
    3253       20167 :   fa = myfactoru(N >> vals(N));
    3254       20167 :   P = gel(fa,1); l = lg(P);
    3255       20167 :   E = gel(fa,2);
    3256       20167 :   v = cgetg(l, t_VECSMALL);
    3257       44527 :   for (i = k = 1; i < l; i++)
    3258             :   {
    3259       24360 :     long j, p = P[i]; /* > 2 */
    3260       59458 :     for (j = 1; j < l; j++)
    3261       35098 :       if (j != i && E[j] == 1 && kross(-p, P[j]) == 1) v[k++] = p;
    3262             :   }
    3263       20167 :   setlg(v,k); return v;
    3264             : }
    3265             : 
    3266             : /* assume CHIP primitive, f(CHIP) | N; NZ = mfnewzerodata(N,CHIP) */
    3267             : static GEN
    3268       23695 : initnewtrace_i(long N, GEN CHIP, GEN NZ)
    3269             : {
    3270       23695 :   GEN T = const_vec(N, cgetg(1,t_VEC)), D, VCHIP;
    3271       23695 :   long FC = mfcharmodulus(CHIP), N1, N2, i, l;
    3272             : 
    3273       23695 :   if (!NZ) NZ = mkvecsmall(1); /*Tr^new = 0; initialize data nevertheless*/
    3274       23695 :   VCHIP = mfcharinit(CHIP);
    3275       23695 :   N1 = N/FC; newd_params(N1, &N2);
    3276       23695 :   D = mydivisorsu(N1/N2); l = lg(D);
    3277       23695 :   N2 *= FC;
    3278      118979 :   for (i = 1; i < l; i++)
    3279             :   {
    3280       95284 :     long M = D[i]*N2;
    3281       95284 :     gel(T,M) = inittrace(M, CHIP, VCHIP);
    3282             :   }
    3283       23695 :   gel(T,N) = shallowconcat(gel(T,N), mkvec2(NZ, inittrconj(N,FC)));
    3284       23695 :   return T;
    3285             : }
    3286             : /* don't initialize if Tr^new = 0, return NULL */
    3287             : static GEN
    3288       23730 : initnewtrace(long N, GEN CHI)
    3289             : {
    3290       23730 :   GEN CHIP = mfchartoprimitive(CHI, NULL), NZ = mfnewzerodata(N,CHIP);
    3291       23730 :   return NZ? initnewtrace_i(N, CHIP, NZ): NULL;
    3292             : }
    3293             : int
    3294       16611 : checkMF_i(GEN mf)
    3295             : {
    3296             :   GEN v;
    3297       16611 :   if (typ(mf) != t_VEC || lg(mf) != 7) return 0;
    3298        6013 :   v = gel(mf,1);
    3299        6013 :   if (typ(v) != t_VEC || lg(v) != 5) return 0;
    3300       12026 :   return typ(gel(v,1)) == t_INT
    3301        6013 :          && typ(gmul2n(gel(v,2), 1)) == t_INT
    3302        6013 :          && typ(gel(v,3)) == t_VEC
    3303       12026 :          && typ(gel(v,4)) == t_INT;
    3304             : }
    3305             : void
    3306        2807 : checkMF(GEN mf)
    3307        2807 : { if (!checkMF_i(mf)) pari_err_TYPE("checkMF [please use mfinit]", mf); }
    3308             : 
    3309             : /* (-1)^k */
    3310             : static long
    3311        6615 : m1pk(long k) { return odd(k)? -1 : 1; }
    3312             : static long
    3313        6405 : badchar(long N, long k, GEN CHI)
    3314        6405 : { return mfcharparity(CHI) != m1pk(k) || (CHI && N % mfcharconductor(CHI)); }
    3315             : 
    3316             : /* dimension of space of cusp forms S_k(\G_0(N),CHI)
    3317             :  * Only depends on CHIP the primitive char attached to CHI */
    3318             : long
    3319       38024 : mfcuspdim(long N, long k, GEN CHI)
    3320             : {
    3321       38024 :   pari_sp av = avma;
    3322             :   long FC;
    3323             :   GEN s;
    3324       38024 :   if (k <= 0) return 0;
    3325       38024 :   if (k == 1) return mfwt1cuspdim(N, CHI);
    3326       37926 :   FC = CHI? mfcharconductor(CHI): 1;
    3327       37926 :   if (FC == 1) CHI = NULL;
    3328       37926 :   s = gsub(A1(N, k), gadd(A21(N, k, CHI), A22(N, k, CHI)));
    3329       37926 :   s = gadd(s, gsubsg(A4(k, FC), A3(N, FC)));
    3330       37926 :   avma = av; return itos(s);
    3331             : }
    3332             : 
    3333             : /* dimension of whole space M_k(\G_0(N),CHI)
    3334             :  * Only depends on CHIP the primitive char attached to CHI; assumes !badchar */
    3335             : long
    3336         483 : mffulldim(long N, long k, GEN CHI)
    3337             : {
    3338         483 :   pari_sp av = avma;
    3339         483 :   long FC = CHI? mfcharconductor(CHI): 1;
    3340             :   GEN s;
    3341         483 :   if (k <= 0) return (k == 0 && FC == 1)? 1: 0;
    3342         483 :   if (k == 1)
    3343             :   {
    3344          35 :     long dim = itos(A3(N, FC));
    3345          35 :     avma = av; return dim + mfwt1cuspdim(N, CHI);
    3346             :   }
    3347         448 :   if (FC == 1) CHI = NULL;
    3348         448 :   s = gsub(A1(N, k), gadd(A21(N, k, CHI), A22(N, k, CHI)));
    3349         448 :   s = gadd(s, A3(N, FC));
    3350         448 :   avma = av; return itos(s);
    3351             : }
    3352             : 
    3353             : /* Dimension of the space of Eisenstein series */
    3354             : long
    3355         231 : mfeisensteindim(long N, long k, GEN CHI)
    3356             : {
    3357         231 :   pari_sp av = avma;
    3358         231 :   long s, FC = CHI? mfcharconductor(CHI): 1;
    3359         231 :   if (k <= 0) return (k == 0 && FC == 1)? 1: 0;
    3360         231 :   s = itos(gmul2n(A3(N, FC), 1));
    3361         231 :   if (k > 1) s -= A4(k, FC);
    3362          49 :   else s >>= 1;
    3363         231 :   avma = av; return s;
    3364             : }
    3365             : 
    3366             : enum { _SQRTS = 1, _MUP, _GCD, _VCHIP, _BEZ, _NEWLZ, _TRCONJ };
    3367             : /* Trace of T(n) on space of cuspforms; only depends on CHIP the primitive char
    3368             :  * attached to CHI */
    3369             : static GEN
    3370     2946552 : mfcusptrace_i(long N, long k, long n, GEN Dn, GEN S)
    3371             : {
    3372     2946552 :   pari_sp av = avma;
    3373             :   GEN a, b, VCHIP, GCD;
    3374             :   long t;
    3375     2946552 :   if (!n) return gen_0;
    3376     2946552 :   VCHIP = gel(S,_VCHIP);
    3377     2946552 :   GCD = gel(S,_GCD);
    3378     2946552 :   t = TA4(k, VCHIP, Dn, GCD);
    3379     2946552 :   a = TA1(N, k, VCHIP, GCD, n); if (t) a = gaddgs(a,t);
    3380     2946552 :   b = TA2(N, k, VCHIP, n, gel(S,_SQRTS), gel(S,_MUP), GCD);
    3381     2946552 :   b = gadd(b, TA3(N, k, VCHIP, GCD, Dn, gel(S,_BEZ)));
    3382     2946552 :   b = gsub(a,b);
    3383     2946552 :   if (typ(b) != t_POL) return gerepileupto(av, b);
    3384       32816 :   return gerepilecopy(av, vchip_polmod(VCHIP, b));
    3385             : }
    3386             : 
    3387             : static GEN
    3388     3955623 : mfcusptracecache(long N, long k, long n, GEN Dn, GEN S, cachenew_t *cache)
    3389             : {
    3390     3955623 :   GEN C = NULL, T = gel(cache->vfull,N);
    3391     3955623 :   long lcache = lg(T);
    3392     3955623 :   if (n < lcache) C = gel(T, n);
    3393     3955623 :   if (C) cache->cuspHIT++; else C = mfcusptrace_i(N, k, n, Dn, S);
    3394     3955623 :   cache->cuspTOTAL++;
    3395     3955623 :   if (n < lcache) gel(T,n) = C;
    3396     3955623 :   return C;
    3397             : }
    3398             : 
    3399             : /* return the divisors of n, known to be among the elements of D */
    3400             : static GEN
    3401      281855 : div_restrict(GEN D, ulong n)
    3402             : {
    3403             :   long i, j, l;
    3404      281855 :   GEN v, VDIV = caches[cache_DIV].cache;
    3405      281855 :   if (lg(VDIV) > n) return gel(VDIV,n);
    3406           0 :   l = lg(D);
    3407           0 :   v = cgetg(l, t_VECSMALL);
    3408           0 :   for (i = j = 1; i < l; i++)
    3409             :   {
    3410           0 :     ulong d = D[i];
    3411           0 :     if (n % d == 0) v[j++] = d;
    3412             :   }
    3413           0 :   setlg(v,j); return v;
    3414             : }
    3415             : 
    3416             : /* for some prime divisors of N, Tr^new(p) = 0 */
    3417             : static int
    3418      192108 : trconj(GEN T, long N, long n)
    3419      192108 : { return (lg(T) > 1 && N % n == 0 && zv_search(T, n)); }
    3420             : 
    3421             : /* n > 0; trace formula on new space */
    3422             : static GEN
    3423     1222172 : mfnewtrace_i(long N, long k, long n, cachenew_t *cache)
    3424             : {
    3425     1222172 :   GEN VCHIP, s, Dn, DN1, SN, S = cache->DATA;
    3426             :   long FC, N1, N2, N1N2, g, i, j, lDN1;
    3427             : 
    3428     1222172 :   if (!S) return gen_0;
    3429     1222172 :   SN = gel(S,N);
    3430     1222172 :   if (mfnewchkzero(gel(SN,_NEWLZ), n)) return gen_0;
    3431      893788 :   if (k > 2 && trconj(gel(SN,_TRCONJ), N, n)) return gen_0;
    3432      893739 :   VCHIP = gel(SN, _VCHIP); FC = vchip_FC(VCHIP);
    3433      893739 :   N1 = N/FC; newt_params(N1, n, FC, &g, &N2);
    3434      893739 :   N1N2 = N1/N2;
    3435      893739 :   DN1 = mydivisorsu(N1N2); lDN1 = lg(DN1);
    3436      893739 :   N2 *= FC;
    3437      893739 :   Dn = mydivisorsu(n); /* this one is probably out of cache */
    3438      893739 :   s = gmulsg(mubeta2(N1N2,n), mfcusptracecache(N2, k, n, Dn, gel(S,N2), cache));
    3439     3673768 :   for (i = 2; i < lDN1; i++)
    3440             :   { /* skip M1 = 1, done above */
    3441     2780029 :     long M1 = DN1[i], N1M1 = DN1[lDN1-i];
    3442     2780029 :     GEN Dg = mydivisorsu(cgcd(M1, g));
    3443     2780029 :     M1 *= N2;
    3444     2780029 :     s = gadd(s, gmulsg(mubeta2(N1M1,n),
    3445     2780029 :                        mfcusptracecache(M1, k, n, Dn, gel(S,M1), cache)));
    3446     3061884 :     for (j = 2; j < lg(Dg); j++) /* skip d = 1, done above */
    3447             :     {
    3448      281855 :       long d = Dg[j], ndd = n/(d*d), M = M1/d;
    3449      281855 :       GEN z = mulsi(mubeta2(N1M1,ndd), powuu(d,k-1)), C = vchip_lift(VCHIP,d,z);
    3450      281855 :       GEN Dndd = div_restrict(Dn, ndd);
    3451      281855 :       s = gadd(s, gmul(C, mfcusptracecache(M, k, ndd, Dndd, gel(S,M), cache)));
    3452             :     }
    3453     2780029 :     s = vchip_mod(VCHIP, s);
    3454             :   }
    3455      893739 :   return vchip_polmod(VCHIP, s);
    3456             : }
    3457             : 
    3458             : /* mfcuspdim(N,k,CHI) - mfnewdim(N,k,CHI); CHIP primitive (for efficiency) */
    3459             : static long
    3460        7084 : mfolddim_i(long N, long k, GEN CHIP)
    3461             : {
    3462        7084 :   long S, i, l, FC = mfcharmodulus(CHIP), N1 = N/FC, N2;
    3463             :   GEN D;
    3464        7084 :   newd_params(N1, &N2); /* will ensure mubeta != 0 */
    3465        7084 :   D = mydivisorsu(N1/N2); l = lg(D);
    3466        7084 :   N2 *= FC; S = 0;
    3467       28273 :   for (i = 2; i < l; i++)
    3468             :   {
    3469       21189 :     long M = D[l-i]*N2, d = mfcuspdim(M, k, CHIP);
    3470       21189 :     if (d) S -= mubeta(D[i]) * d;
    3471             :   }
    3472        7084 :   return S;
    3473             : }
    3474             : long
    3475         294 : mfolddim(long N, long k, GEN CHI)
    3476             : {
    3477         294 :   pari_sp av = avma;
    3478         294 :   GEN CHIP = mfchartoprimitive(CHI, NULL);
    3479         294 :   long S = mfolddim_i(N, k, CHIP);
    3480         294 :   avma = av; return S;
    3481             : }
    3482             : /* Only depends on CHIP the primitive char attached to CHI; assumes !badchar */
    3483             : long
    3484       13888 : mfnewdim(long N, long k, GEN CHI)
    3485             : {
    3486       13888 :   pari_sp av = avma;
    3487             :   long S;
    3488       13888 :   GEN CHIP = mfchartoprimitive(CHI, NULL);
    3489       13888 :   S = mfcuspdim(N, k, CHIP); if (!S) return 0;
    3490        6776 :   S -= mfolddim_i(N, k, CHIP);
    3491        6776 :   avma = av; return S;
    3492             : }
    3493             : 
    3494             : /* trace form, given as closure */
    3495             : static GEN
    3496         819 : mftraceform_new(long N, long k, GEN CHI)
    3497             : {
    3498             :   GEN T;
    3499         819 :   if (k == 1) return initwt1newtrace(mfinit_Nkchi(N, 1, CHI, mf_CUSP, 0));
    3500         805 :   T = initnewtrace(N,CHI); if (!T) return mftrivial();
    3501         805 :   return tag(t_MF_NEWTRACE, mkNK(N,k,CHI), T);
    3502             : }
    3503             : static GEN
    3504          14 : mftraceform_cusp(long N, long k, GEN CHI)
    3505             : {
    3506          14 :   if (k == 1) return initwt1trace(mfinit_Nkchi(N, 1, CHI, mf_CUSP, 0));
    3507           7 :   return tag(t_MF_TRACE, mkNK(N,k,CHI), inittrace(N,CHI,NULL));
    3508             : }
    3509             : static GEN
    3510          84 : mftraceform_i(GEN NK, long space)
    3511             : {
    3512             :   GEN CHI;
    3513             :   long N, k;
    3514          84 :   checkNK(NK, &N, &k, &CHI, 0);
    3515          84 :   if (!mfdim_Nkchi(N, k, CHI, space)) return mftrivial();
    3516          63 :   switch(space)
    3517             :   {
    3518          42 :     case mf_NEW: return mftraceform_new(N, k, CHI);
    3519          14 :     case mf_CUSP:return mftraceform_cusp(N, k, CHI);
    3520             :   }
    3521           7 :   pari_err_DOMAIN("mftraceform", "space", "=", utoi(space), NK);
    3522             :   return NULL;/*LCOV_EXCL_LINE*/
    3523             : }
    3524             : GEN
    3525          84 : mftraceform(GEN NK, long space)
    3526          84 : { pari_sp av = avma; return gerepilecopy(av, mftraceform_i(NK,space)); }
    3527             : 
    3528             : static GEN
    3529       13356 : hecke_data(long N, long n)
    3530       13356 : { return mkvecsmall3(n, u_ppo(n, N), N); }
    3531             : /* 1/2-integral weight */
    3532             : static GEN
    3533          84 : heckef2_data(long N, long n)
    3534             : {
    3535             :   ulong f, fN, fN2;
    3536          84 :   if (!uissquareall(n, &f)) return NULL;
    3537          77 :   fN = u_ppo(f, N); fN2 = fN*fN;
    3538          77 :   return mkvec2(myfactoru(fN), mkvecsmall4(n, N, fN2, n/fN2));
    3539             : }
    3540             : /* N = mf_get_N(F) or a multiple */
    3541             : static GEN
    3542       19691 : mfhecke_i(long n, long N, GEN F)
    3543             : {
    3544       19691 :   if (n == 1) return F;
    3545       13258 :   return tag2(t_MF_HECKE, mf_get_NK(F), hecke_data(N,n), F);
    3546             : }
    3547             : 
    3548             : GEN
    3549          98 : mfhecke(GEN mf, GEN F, long n)
    3550             : {
    3551          98 :   pari_sp av = avma;
    3552             :   GEN NK, CHI, gk, DATA;
    3553             :   long N, nk, dk;
    3554          98 :   checkMF(mf);
    3555          98 :   if (!checkmf_i(F)) pari_err_TYPE("mfhecke",F);
    3556          98 :   if (n <= 0) pari_err_TYPE("mfhecke [n <= 0]", stoi(n));
    3557          98 :   if (n == 1) return gcopy(F);
    3558          98 :   gk = mf_get_gk(F);
    3559          98 :   Qtoss(gk,&nk,&dk);
    3560          98 :   CHI = mf_get_CHI(F);
    3561          98 :   N = MF_get_N(mf);
    3562          98 :   if (dk == 2)
    3563             :   {
    3564          77 :     DATA = heckef2_data(N,n);
    3565          77 :     if (!DATA) return mftrivial();
    3566             :   }
    3567             :   else
    3568          21 :     DATA = hecke_data(N,n);
    3569          91 :   NK = mkgNK(lcmii(stoi(N), mf_get_gN(F)), gk, CHI, mf_get_field(F));
    3570          91 :   return gerepilecopy(av, tag2(t_MF_HECKE, NK, DATA, F));
    3571             : }
    3572             : 
    3573             : /* form F given by closure, compute B(d)(F) as closure (q -> q^d) */
    3574             : static GEN
    3575       25375 : mfbd_i(GEN F, long d)
    3576             : {
    3577             :   GEN D, NK, gk, CHI;
    3578       25375 :   if (d == 1) return F;
    3579        8953 :   if (d <= 0) pari_err_TYPE("mfbd [d <= 0]", stoi(d));
    3580        8953 :   if (mf_get_type(F) != t_MF_BD) D = utoi(d);
    3581           7 :   else { D = mului(d, gel(F,3)); F = gel(F,2); }
    3582        8953 :   gk = mf_get_gk(F); CHI = mf_get_CHI(F);
    3583        8953 :   if (typ(gk) != t_INT) CHI = mfcharmul(CHI, get_mfchar(utoi(d << 2)));
    3584        8953 :   NK = mkgNK(muliu(mf_get_gN(F), d), gk, CHI, mf_get_field(F));
    3585        8953 :   return tag2(t_MF_BD, NK, F, D);
    3586             : }
    3587             : GEN
    3588          35 : mfbd(GEN F, long d)
    3589             : {
    3590          35 :   pari_sp av = avma;
    3591          35 :   if (!checkmf_i(F)) pari_err_TYPE("mfbd",F);
    3592          35 :   return gerepilecopy(av, mfbd_i(F, d));
    3593             : }
    3594             : 
    3595             : /* CHI is a character defined modulo N4 */
    3596             : static GEN
    3597          98 : RgV_shimura(GEN V, long n, long D, long N4, long r, GEN CHI)
    3598             : {
    3599          98 :   GEN R, a0, Pn = mfcharpol(CHI);
    3600          98 :   long m, Da, ND, ord = mfcharorder(CHI), vt = varn(Pn), d4 = D & 3L;
    3601             : 
    3602          98 :   if (d4 == 2 || d4 == 3) D <<= 2;
    3603          98 :   Da = labs(D); ND = N4*Da;
    3604          98 :   R = cgetg(n + 2, t_VEC);
    3605          98 :   a0 = gel(V, 1);
    3606          98 :   if (!gequal0(a0))
    3607             :   {
    3608           7 :     long D4 = D << 2;
    3609           7 :     GEN CHID = induceN(clcm(mfcharmodulus(CHI), labs(D4)), CHI);
    3610           7 :     CHID = mfcharmul_i(CHID, induce(gel(CHID,1), stoi(D4)));
    3611           7 :     a0 = gmul(a0, charLFwtk(r, CHID, mfcharorder(CHID)));
    3612             :   }
    3613          98 :   if (odd(ND) && !odd(mfcharmodulus(CHI))) ND <<= 1;
    3614          98 :   gel(R, 1) = a0;
    3615         567 :   for (m = 1; m <= n; m++)
    3616             :   {
    3617         469 :     GEN Dm = mydivisorsu(u_ppo(m, ND)), S = gel(V, m*m + 1);
    3618         469 :     long i, l = lg(Dm);
    3619         770 :     for (i = 2; i < l; i++)
    3620             :     { /* (e,ND) = 1; skip i = 1: e = 1, done above */
    3621         301 :       long e = Dm[i], me = m / e;
    3622         301 :       long a = mfcharevalord(CHI, e, ord);
    3623         301 :       GEN c, C = powuu(e, r - 1);
    3624         301 :       if (kross(D, e) == -1) C = negi(C);
    3625         301 :       c = mygmodulo_lift(a, ord, C, vt);
    3626         301 :       S = gadd(S, gmul(c, gel(V, me*me + 1)));
    3627             :     }
    3628         469 :     gel(R, m+1) = S;
    3629             :   }
    3630          98 :   return degpol(Pn) > 1? gmodulo(R, Pn): R;
    3631             : }
    3632             : static GEN
    3633          28 : c_shimura(long n, GEN F, long D, GEN CHI)
    3634             : {
    3635          28 :   GEN v = mfcoefs_i(F, n*n, labs(D));
    3636          28 :   return RgV_shimura(v, n, D, mf_get_N(F)>>2, mf_get_r(F), CHI);
    3637             : }
    3638             : 
    3639             : static long
    3640          14 : mfisinkohnen(GEN mf, GEN F)
    3641             : {
    3642          14 :   GEN v, gk = MF_get_gk(mf), CHI = MF_get_CHI(mf);
    3643          14 :   long i, sb, eps, N4 = MF_get_N(mf) >> 2, r = MF_get_r(mf);
    3644          14 :   sb = mfsturmNgk(N4 << 4, gk) + 1;
    3645          14 :   eps = N4 % mfcharconductor(CHI)? -1 : 1;
    3646          14 :   if (odd(r)) eps = -eps;
    3647          14 :   v = mfcoefs(F, sb, 1);
    3648         896 :   for (i = 0; i <= sb; i++)
    3649             :   {
    3650         882 :     long j = i & 3L;
    3651         882 :     if ((j == 2 || j == 2 + eps) && !gequal0(gel(v,i+1))) return 0;
    3652             :   }
    3653          14 :   return 1;
    3654             : }
    3655             : 
    3656             : static long
    3657          35 : mfshimura_space_cusp(GEN mf)
    3658             : {
    3659          35 :   long fl = 1, r = MF_get_r(mf), M = MF_get_N(mf) >> 2;
    3660          35 :   if (r == 1 && M >= 4)
    3661             :   {
    3662          14 :     GEN E = gel(myfactoru(M), 2);
    3663          14 :     long ma = vecsmall_max(E);
    3664          14 :     if (ma > 2 || (ma == 2 && !mfcharistrivial(mf_get_CHI(mf)))) fl = 0;
    3665             :   }
    3666          35 :   return fl;
    3667             : }
    3668             : 
    3669             : /* D is either a discriminant (not necessarily fundamental) with
    3670             :    sign(D)=(-1)^{k-1/2}*eps, or a positive squarefree integer t, which is then
    3671             :    transformed into a fundamental discriminant of the correct sign. */
    3672             : GEN
    3673          35 : mfshimura(GEN mf, GEN F, long D)
    3674             : {
    3675          35 :   pari_sp av = avma;
    3676             :   GEN gk, G, res, mf2, CHI, CHIP;
    3677          35 :   long M, r, space, cusp, N4, flagdisc = 0;
    3678          35 :   if (!checkmf_i(F)) pari_err_TYPE("mfshimura",F);
    3679          35 :   gk = mf_get_gk(F);
    3680          35 :   if (typ(gk) != t_FRAC) pari_err_TYPE("mfshimura [integral weight]", F);
    3681          35 :   r = MF_get_r(mf);
    3682          35 :   if (r <= 0) pari_err_DOMAIN("mfshimura", "weight", "<=", ghalf, gk);
    3683          35 :   N4 = MF_get_N(mf) >> 2; CHI = MF_get_CHI(mf);
    3684          35 :   CHIP = mfcharchiliftprim(CHI, N4);
    3685          35 :   if (!CHIP) CHIP = CHI;
    3686             :   else
    3687             :   {
    3688          35 :     long epsD = CHI == CHIP? D: -D, rd = D & 3L;
    3689          35 :     if (odd(r)) epsD = -epsD;
    3690          35 :     if (epsD > 0 && (rd == 0 || rd == 1)) flagdisc = 1;
    3691             :     else
    3692             :     {
    3693          14 :       if (D < 0 || !uissquarefree(D))
    3694           7 :         pari_err_TYPE("shimura [incorrect D]", stoi(D));
    3695           7 :       D = epsD;
    3696             :     }
    3697             :   }
    3698          28 :   M = N4;
    3699          28 :   cusp = mfiscuspidal(mf,F);
    3700          28 :   space = cusp && mfshimura_space_cusp(mf)? mf_CUSP : mf_FULL;
    3701          28 :   if (!cusp || !flagdisc || !mfisinkohnen(mf,F)) M <<= 1;
    3702          28 :   mf2 = mfinit_Nkchi(M, r << 1, mfcharpow(CHI, gen_2), space, 0);
    3703          28 :   G = c_shimura(mfsturm(mf2), F, D, CHIP);
    3704          28 :   res = mftobasis_i(mf2, G);
    3705             :   /* not mflinear(mf2,): we want lowest possible level */
    3706          28 :   G = mflinear(MF_get_basis(mf2), res);
    3707          28 :   return gerepilecopy(av, mkvec3(mf2, G, res));
    3708             : }
    3709             : 
    3710             : /* W ZabM (ZM if n = 1), a t_INT or NULL, b t_INT, ZXQ mod P or NULL.
    3711             :  * Write a/b = A/d with d t_INT and A Zab return [W,d,A,P] */
    3712             : static GEN
    3713        6118 : mkMinv(GEN W, GEN a, GEN b, GEN P)
    3714             : {
    3715        6118 :   GEN A = (b && typ(b) == t_POL)? Q_remove_denom(QXQ_inv(b,P), &b): NULL;
    3716        6118 :   if (a && b)
    3717             :   {
    3718         805 :     a = Qdivii(a,b);
    3719         805 :     if (typ(a) == t_INT) b = gen_1; else { b = gel(a,2); a = gel(a,1); }
    3720         805 :     if (is_pm1(a)) a = NULL;
    3721             :   }
    3722        6118 :   if (a) A = A? ZX_Z_mul(A,a): a; else if (!A) A = gen_1;
    3723        6118 :   if (!b) b = gen_1;
    3724        6118 :   if (!P) P = gen_0;
    3725        6118 :   return mkvec4(W,b,A,P);
    3726             : }
    3727             : /* M square invertible QabM, return [M',d], M*M' = d*Id */
    3728             : static GEN
    3729         252 : QabM_Minv(GEN M, GEN P, long n)
    3730             : {
    3731             :   GEN dW, W, dM;
    3732         252 :   M = Q_remove_denom(M, &dM);
    3733         252 :   W = P? ZabM_inv(liftpol_shallow(M), P, n, &dW): ZM_inv(M, &dW);
    3734         252 :   return mkMinv(W, dM, dW, P);
    3735             : }
    3736             : /* Simplified form of mfclean, after a QabM_indexrank: M a ZabM with full
    3737             :  * column rank and z = indexrank(M) is known */
    3738             : static GEN
    3739         791 : mfclean2(GEN M, GEN z, GEN P, long n)
    3740             : {
    3741         791 :   GEN d, Minv, y = gel(z,1), W = rowpermute(M, y);
    3742         791 :   W = P? ZabM_inv(liftpol_shallow(W), P, n, &d): ZM_inv(W, &d);
    3743         791 :   M = rowslice(M, 1, y[lg(y)-1]);
    3744         791 :   Minv = mkMinv(W, NULL, d, P);
    3745         791 :   return mkvec3(y, Minv, M);
    3746             : }
    3747             : /* M QabM, lg(M)>1 and [y,z] its rank profile. Let Minv be the inverse of the
    3748             :  * invertible square matrix in mkMinv format. Return [y,Minv, M[..y[#y],]]
    3749             :  * P cyclotomic polynomial of order n != 2 mod 4 or NULL */
    3750             : static GEN
    3751        3983 : mfclean(GEN M, GEN P, long n, int ratlift)
    3752             : {
    3753        3983 :   GEN W, v, y, z, d, Minv, dM, MdM = Q_remove_denom(M, &dM);
    3754        3983 :   if (n == 1)
    3755        3325 :     W = ZM_pseudoinv(MdM, &v, &d);
    3756             :   else
    3757         658 :     W = ZabM_pseudoinv_i(liftpol_shallow(MdM), P, n, &v, &d, ratlift);
    3758        3983 :   y = gel(v,1);
    3759        3983 :   z = gel(v,2);
    3760        3983 :   if (lg(z) != lg(MdM)) M = vecpermute(M,z);
    3761        3983 :   M = rowslice(M, 1, y[lg(y)-1]);
    3762        3983 :   Minv = mkMinv(W, dM, d, P);
    3763        3983 :   return mkvec3(y, Minv, M);
    3764             : }
    3765             : /* call mfclean using only CHI */
    3766             : static GEN
    3767        3241 : mfcleanCHI(GEN M, GEN CHI, int ratlift)
    3768             : {
    3769        3241 :   long n = mfcharorder_canon(CHI);
    3770        3241 :   GEN P = (n == 1)? NULL: mfcharpol(CHI);
    3771        3241 :   return mfclean(M, P, n, ratlift);
    3772             : }
    3773             : 
    3774             : /* DATA component of a t_MF_NEWTRACE. Was it stripped to save memory ? */
    3775             : static int
    3776       24521 : newtrace_stripped(GEN DATA)
    3777       24521 : { return DATA && (lg(DATA) == 5 && typ(gel(DATA,3)) == t_INT); }
    3778             : /* f a t_MF_NEWTRACE */
    3779             : static GEN
    3780       24521 : newtrace_DATA(long N, GEN f)
    3781             : {
    3782       24521 :   GEN DATA = gel(f,2);
    3783       24521 :   return newtrace_stripped(DATA)? initnewtrace(N, DATA): DATA;
    3784             : }
    3785             : /* reset cachenew for new level incorporating new DATA, tf a t_MF_NEWTRACE
    3786             :  * (+ possibly initialize 'full' for new allowed levels) */
    3787             : static void
    3788       24521 : reset_cachenew(cachenew_t *cache, long N, GEN tf)
    3789             : {
    3790             :   long i, n, l;
    3791       24521 :   GEN v, DATA = newtrace_DATA(N,tf);
    3792       24521 :   cache->DATA = DATA;
    3793       49042 :   if (!DATA) return;
    3794       24486 :   n = cache->n;
    3795       24486 :   v = cache->vfull; l = N+1; /* = lg(DATA) */
    3796     1316658 :   for (i = 1; i < l; i++)
    3797     1292172 :     if (typ(gel(v,i)) == t_INT && lg(gel(DATA,i)) != 1)
    3798       38969 :       gel(v,i) = const_vec(n, NULL);
    3799       24486 :   cache->VCHIP = gel(gel(DATA,N),_VCHIP);
    3800             : }
    3801             : /* initialize a cache of newtrace / cusptrace up to index n and level | N;
    3802             :  * DATA may be NULL (<=> Tr^new = 0). tf a t_MF_NEWTRACE */
    3803             : static void
    3804        9254 : init_cachenew(cachenew_t *cache, long n, long N, GEN tf)
    3805             : {
    3806        9254 :   long i, l = N+1; /* = lg(tf.DATA) when DATA != NULL */
    3807             :   GEN v;
    3808        9254 :   cache->n = n;
    3809        9254 :   cache->vnew = v = cgetg(l, t_VEC);
    3810        9254 :   for (i = 1; i < l; i++) gel(v,i) = (N % i)? gen_0: const_vec(n, NULL);
    3811        9254 :   cache->newHIT = cache->newTOTAL = cache->cuspHIT = cache->cuspTOTAL = 0;
    3812        9254 :   cache->vfull = v = zerovec(N);
    3813        9254 :   reset_cachenew(cache, N, tf);
    3814        9254 : }
    3815             : static void
    3816       13874 : dbg_cachenew(cachenew_t *C)
    3817             : {
    3818       13874 :   if (DEBUGLEVEL >= 2 && C)
    3819           0 :     err_printf("newtrace cache hits: new = %ld/%ld, cusp = %ld/%ld\n",
    3820             :                     C->newHIT, C->newTOTAL, C->cuspHIT, C->cuspTOTAL);
    3821       13874 : }
    3822             : 
    3823             : /* newtrace_{N,k}(d*i), i = n0, ..., n */
    3824             : static GEN
    3825      103922 : colnewtrace(long n0, long n, long d, long N, long k, cachenew_t *cache)
    3826             : {
    3827      103922 :   GEN v = cgetg(n-n0+2, t_COL);
    3828             :   long i;
    3829      103922 :   for (i = n0; i <= n; i++) gel(v, i-n0+1) = mfnewtracecache(N, k, i*d, cache);
    3830      103922 :   return v;
    3831             : }
    3832             : /* T_n(l*m0, l*(m0+1), ..., l*m) F, F = t_MF_NEWTRACE [N,k],DATA, cache
    3833             :  * contains DATA != NULL as well as cached values of F */
    3834             : static GEN
    3835       59437 : heckenewtrace(long m0, long m, long l, long N, long NBIG, long k, long n, cachenew_t *cache)
    3836             : {
    3837       59437 :   long lD, a, k1, nl = n*l;
    3838       59437 :   GEN D, V, v = colnewtrace(m0, m, nl, N, k, cache); /* d=1 */
    3839             :   GEN VCHIP;
    3840       59437 :   if (n == 1) return v;
    3841       37730 :   VCHIP = cache->VCHIP;
    3842       37730 :   D = mydivisorsu(u_ppo(n, NBIG)); lD = lg(D);
    3843       37730 :   k1 = k - 1;
    3844       81578 :   for (a = 2; a < lD; a++)
    3845             :   { /* d > 1, (d,NBIG) = 1 */
    3846       43848 :     long i, j, d = D[a], c = cgcd(l, d), dl = d/c, m0d = ceildiv(m0, dl);
    3847       43848 :     GEN C = vchip_lift(VCHIP, d, powuu(d, k1));
    3848             :     /* m0=0: i = 1 => skip F(0) = 0 */
    3849       43848 :     if (!m0) { i = 1; j = dl; } else { i = 0; j = m0d*dl; }
    3850       43848 :     V = colnewtrace(m0d, m/dl, nl/(d*c), N, k, cache);
    3851             :     /* C = chi(d) d^(k-1) */
    3852      381010 :     for (; j <= m; i++, j += dl)
    3853      337162 :       gel(v,j-m0+1) = gadd(gel(v,j-m0+1), vchip_mod(VCHIP, gmul(C,gel(V,i+1))));
    3854             :   }
    3855       37730 :   return v;
    3856             : }
    3857             : 
    3858             : /* Given v = an[i], return an[d*i] */
    3859             : static GEN
    3860         266 : anextract(GEN v, long n, long d)
    3861             : {
    3862         266 :   GEN w = cgetg(n+2, t_VEC);
    3863             :   long i;
    3864         266 :   for (i = 0; i <= n; i++) gel(w, i+1) = gel(v, i*d+1);
    3865         266 :   return w;
    3866             : }
    3867             : /* T_n(F)(0, l, ..., l*m) */
    3868             : static GEN
    3869         567 : hecke_i(long m, long l, GEN V, GEN F, GEN DATA)
    3870             : {
    3871             :   long k, n, nNBIG, NBIG, lD, M, a, t, nl;
    3872             :   GEN D, v, CHI;
    3873         567 :   if (typ(DATA) == t_VEC)
    3874             :   { /* 1/2-integral k */
    3875          98 :     if (!V) { GEN S = gel(DATA,2); V = mfcoefs_i(F, m*l*S[3], S[4]); }
    3876          98 :     return RgV_heckef2(m, l, V, F, DATA);
    3877             :   }
    3878         469 :   k = mf_get_k(F);
    3879         469 :   n = DATA[1]; nl = n*l;
    3880         469 :   nNBIG = DATA[2];
    3881         469 :   NBIG = DATA[3];
    3882         469 :   if (nNBIG == 1) return V? V: mfcoefs_i(F,m,nl);
    3883         343 :   if (!V && mf_get_type(F) == t_MF_NEWTRACE)
    3884             :   { /* inline F to allow cache, T_n at level NBIG acting on Tr^new(N,k,CHI) */
    3885             :     cachenew_t cache;
    3886         210 :     long N = mf_get_N(F);
    3887         210 :     init_cachenew(&cache, m*nl, N, F);
    3888         210 :     v = heckenewtrace(0, m, l, N, NBIG, k, n, &cache);
    3889         210 :     dbg_cachenew(&cache);
    3890         210 :     settyp(v, t_VEC); return v;
    3891             :   }
    3892         133 :   CHI = mf_get_CHI(F);
    3893         133 :   D = mydivisorsu(nNBIG); lD = lg(D);
    3894         133 :   M = m + 1;
    3895         133 :   t = nNBIG * cgcd(nNBIG, l);
    3896         133 :   if (!V) V = mfcoefs_i(F, m * t, nl / t); /* usually nl = t */
    3897         133 :   v = anextract(V, m, t); /* mfcoefs(F, m, nl); d = 1 */
    3898         266 :   for (a = 2; a < lD; a++)
    3899             :   { /* d > 1, (d, NBIG) = 1 */
    3900         133 :     long d = D[a], c = cgcd(l, d), dl = d/c, i, idl;
    3901         133 :     GEN C = gmul(mfchareval_i(CHI, d), powuu(d, k-1));
    3902         133 :     GEN w = anextract(V, m/dl, t/(d*c)); /* mfcoefs(F, m/dl, nl/(d*c)) */
    3903         427 :     for (i = idl = 1; idl <= M; i++, idl += dl)
    3904         294 :       gel(v,idl) = gadd(gel(v,idl), gmul(C, gel(w,i)));
    3905             :   }
    3906         133 :   return v;
    3907             : }
    3908             : 
    3909             : static GEN
    3910       10563 : mkmf(GEN x1, GEN x2, GEN x3, GEN x4, GEN x5)
    3911             : {
    3912       10563 :   GEN MF = obj_init(5, 4);
    3913       10563 :   gel(MF,1) = x1;
    3914       10563 :   gel(MF,2) = x2;
    3915       10563 :   gel(MF,3) = x3;
    3916       10563 :   gel(MF,4) = x4;
    3917       10563 :   gel(MF,5) = x5; return MF;
    3918             : }
    3919             : 
    3920             : /* return an integer b such that p | b => T_p^k Tr^new = 0, for all k > 0 */
    3921             : static long
    3922        6601 : get_badj(long N, long FC)
    3923             : {
    3924        6601 :   GEN fa = myfactoru(N), P = gel(fa,1), E = gel(fa,2);
    3925        6601 :   long i, b = 1, l = lg(P);
    3926       17605 :   for (i = 1; i < l; i++)
    3927       11004 :     if (E[i] > 1 && u_lval(FC, P[i]) < E[i]) b *= P[i];
    3928        6601 :   return b;
    3929             : }
    3930             : /* in place, assume perm strictly increasing */
    3931             : static void
    3932        1036 : vecpermute_inplace(GEN v, GEN perm)
    3933             : {
    3934        1036 :   long i, l = lg(perm);
    3935        1036 :   for (i = 1; i < l; i++) gel(v,i) = gel(v,perm[i]);
    3936        1036 : }
    3937             : 
    3938             : /* Find basis of newspace using closures; assume k >= 2 and !badchar.
    3939             :  * Return NULL if space is empty, else
    3940             :  * [mf1, list of closures T(j)traceform, list of corresponding j, matrix] */
    3941             : static GEN
    3942       13657 : mfnewinit(long N, long k, GEN CHI, cachenew_t *cache, long init)
    3943             : {
    3944             :   GEN S, vj, M, CHIP, mf1, listj, P, tf;
    3945             :   long j, ct, ctlj, dim, jin, SB, sb, two, ord, FC, badj;
    3946             : 
    3947       13657 :   dim = mfnewdim(N, k, CHI);
    3948       13657 :   if (!dim && !init) return NULL;
    3949        6601 :   sb = mfsturmNk(N, k);
    3950        6601 :   CHIP = mfchartoprimitive(CHI, &FC);
    3951             :   /* remove newtrace data from S to save space in output: negligible slowdown */
    3952        6601 :   tf = tag(t_MF_NEWTRACE, mkNK(N,k,CHIP), CHIP);
    3953        6601 :   badj = get_badj(N, FC);
    3954             :   /* try sbsmall first: Sturm bound not sharp for new space */
    3955        6601 :   SB = ceilA1(N, k);
    3956        6601 :   listj = cgetg(2*sb + 3, t_VECSMALL);
    3957      301721 :   for (j = ctlj = 1; ctlj < 2*sb + 3; j++)
    3958      295120 :     if (cgcd(j, badj) == 1) listj[ctlj++] = j;
    3959        6601 :   if (init)
    3960             :   {
    3961        3689 :     init_cachenew(cache, (SB+1)*listj[dim+1], N, tf);
    3962        3689 :     if (init == -1 || !dim) return NULL; /* old space or dim = 0 */
    3963             :   }
    3964             :   else
    3965        2912 :     reset_cachenew(cache, N, tf);
    3966             :   /* cache.DATA is not NULL */
    3967        6181 :   ord = mfcharorder_canon(CHIP);
    3968        6181 :   P = ord == 1? NULL: mfcharpol(CHIP);
    3969        6181 :   vj = cgetg(dim+1, t_VECSMALL);
    3970        6181 :   M = cgetg(dim+1, t_MAT);
    3971        6188 :   for (two = 1, ct = 0, jin = 1; two <= 2; two++)
    3972             :   {
    3973        6188 :     long a, jlim = jin + sb;
    3974       17458 :     for (a = jin; a <= jlim; a++)
    3975             :     {
    3976             :       GEN z, vecz;
    3977       17451 :       ct++; vj[ct] = listj[a];
    3978       17451 :       gel(M, ct) = heckenewtrace(0, SB, 1, N, N, k, vj[ct], cache);
    3979       17451 :       if (ct < dim) continue;
    3980             : 
    3981        6699 :       z = QabM_indexrank(M, P, ord);
    3982        6699 :       vecz = gel(z, 2); ct = lg(vecz) - 1;
    3983        6699 :       if (ct == dim) { M = mkvec3(z, gen_0, M); break; } /*maximal rank, done*/
    3984         518 :       vecpermute_inplace(M, vecz);
    3985         518 :       vecpermute_inplace(vj, vecz);
    3986             :     }
    3987        6188 :     if (a <= jlim) break;
    3988             :     /* sbsmall was not sufficient, use Sturm bound: must extend M */
    3989          70 :     for (j = 1; j <= ct; j++)
    3990             :     {
    3991          63 :       GEN t = heckenewtrace(SB + 1, sb, 1, N, N, k, vj[j], cache);
    3992          63 :       gel(M,j) = shallowconcat(gel(M, j), t);
    3993             :     }
    3994           7 :     jin = jlim + 1; SB = sb;
    3995             :   }
    3996        6181 :   S = cgetg(dim + 1, t_VEC);
    3997        6181 :   for (j = 1; j <= dim; j++) gel(S, j) = mfhecke_i(vj[j], N, tf);
    3998        6181 :   dbg_cachenew(cache);
    3999        6181 :   mf1 = mkvec4(utoipos(N), utoipos(k), CHI, utoi(mf_NEW));
    4000        6181 :   return mkmf(mf1, cgetg(1,t_VEC), S, vj, M);
    4001             : }
    4002             : /* k > 1 integral, mf space is mf_CUSP or mf_FULL */
    4003             : static GEN
    4004          21 : mfinittonew(GEN mf)
    4005             : {
    4006          21 :   GEN CHI = MF_get_CHI(mf), S = MF_get_S(mf), vMjd = MFcusp_get_vMjd(mf);
    4007          21 :   GEN M = MF_get_M(mf), vj, mf1;
    4008          21 :   long i, j, l, l0 = lg(S), N0 = MF_get_N(mf);
    4009         112 :   for (i = l0-1; i > 0; i--)
    4010             :   {
    4011         112 :     long N = gel(vMjd,i)[1];
    4012         112 :     if (N != N0) break;
    4013             :   }
    4014          21 :   if (i == l0-1) return NULL;
    4015          21 :   S = vecslice(S, i+1, l0-1); /* forms of conductor N0 */
    4016          21 :   l = lg(S); vj = cgetg(l, t_VECSMALL);
    4017          21 :   for (j = 1; j < l; j++) vj[j] = gel(vMjd,j+i)[2];
    4018          21 :   M = vecslice(M, lg(M)-lg(S)+1, lg(M)-1); /* their coefficients */
    4019          21 :   M = mfcleanCHI(M, CHI, 0);
    4020          21 :   mf1 = mkvec4(utoipos(N0), MF_get_gk(mf), CHI, utoi(mf_NEW));
    4021          21 :   return mkmf(mf1, cgetg(1,t_VEC), S, vj, M);
    4022             : }
    4023             : 
    4024             : /* Bd(f)[m0..m], v = f[ceil(m0/d)..floor(m/d)], m0d = ceil(m0/d) */
    4025             : static GEN
    4026       49637 : RgC_Bd_expand(long m0, long m, GEN v, long d, long m0d)
    4027             : {
    4028             :   long i, j;
    4029             :   GEN w;
    4030       49637 :   if (d == 1) return v;
    4031       13643 :   w = zerocol(m-m0+1);
    4032       13643 :   if (!m0) { i = 1; j = d; } else { i = 0; j = m0d*d; }
    4033       13643 :   for (; j <= m; i++, j += d) gel(w,j-m0+1) = gel(v,i+1);
    4034       13643 :   return w;
    4035             : }
    4036             : /* S a non-empty vector of t_MF_BD(t_MF_HECKE(t_MF_NEWTRACE)); M the matrix
    4037             :  * of their coefficients r*0, r*1, ..., r*m0 (~ mfvectomat) or NULL (empty),
    4038             :  * extend it to coeffs up to m > m0. The forms B_d(T_j(tf_N))in S should be
    4039             :  * sorted by level N, then j, then increasing d. No reordering here. */
    4040             : static GEN
    4041        6713 : bhnmat_extend(GEN M, long m, long r, GEN S, cachenew_t *cache)
    4042             : {
    4043        6713 :   long i, mr, m0, m0r, Nold = 0, jold = 0, l = lg(S);
    4044        6713 :   GEN MAT = cgetg(l, t_MAT), v = NULL;
    4045        6713 :   if (M) { m0 = nbrows(M); m0r = m0 * r; } else m0 = m0r = 0;
    4046        6713 :   mr = m*r;
    4047       56350 :   for (i = 1; i < l; i++)
    4048             :   {
    4049             :     long d, j, md, N;
    4050       49637 :     GEN c, f = bhn_parse(gel(S,i), &d,&j); /* t_MF_NEWTRACE */
    4051       49637 :     N = mf_get_N(f);
    4052       49637 :     md = ceildiv(m0r,d);
    4053       49637 :     if (N != Nold) { reset_cachenew(cache, N, f); Nold = N; jold = 0; }
    4054       49637 :     if (!cache->DATA) { gel(MAT,i) = zerocol(m+1); continue; }
    4055       49637 :     if (j != jold || md)
    4056       41713 :     { v = heckenewtrace(md, mr/d, 1, N, N, mf_get_k(f), j,cache); jold=j; }
    4057       49637 :     c = RgC_Bd_expand(m0r, mr, v, d, md);
    4058       49637 :     if (r > 1) c = c_deflate(m-m0, r, c);
    4059       49637 :     if (M) c = shallowconcat(gel(M,i), c);
    4060       49637 :     gel(MAT,i) = c;
    4061             :   }
    4062        6713 :   return MAT;
    4063             : }
    4064             : 
    4065             : static GEN
    4066        2765 : mfinitcusp(long N, long k, GEN CHI, cachenew_t *cache, long space)
    4067             : {
    4068             :   long L, l, lDN1, FC, N1, d1, i, init;
    4069        2765 :   GEN vS, vMjd, DN1, vmf, CHIP = mfchartoprimitive(CHI, &FC);
    4070             : 
    4071        2765 :   d1 = (space == mf_OLD)? mfolddim_i(N, k, CHIP): mfcuspdim(N, k, CHIP);
    4072        2765 :   if (!d1) return NULL;
    4073        2527 :   N1 = N/FC; DN1 = mydivisorsu(N1); lDN1 = lg(DN1);
    4074        2527 :   init = (space == mf_OLD)? -1: 1;
    4075        2527 :   vmf = cgetg(lDN1, t_VEC);
    4076       15022 :   for (i = lDN1 - 1, l = 1; i; i--)
    4077             :   { /* by decreasing level to allow cache */
    4078       12495 :     GEN mf = mfnewinit(FC*DN1[i], k, CHIP, cache, init);
    4079       12495 :     if (mf) gel(vmf, l++) = mf;
    4080       12495 :     init = 0;
    4081             :   }
    4082        2527 :   setlg(vmf,l); vmf = vecreverse(vmf); /* reorder by increasing level */
    4083             : 
    4084        2527 :   L = mfsturmNk(N, k)+1;
    4085        2527 :   vS = vectrunc_init(L);
    4086        2527 :   vMjd = vectrunc_init(L);
    4087        7917 :   for (i = 1; i < l; i++)
    4088             :   {
    4089        5390 :     GEN DNM, mf = gel(vmf,i), S = MF_get_S(mf), vj = MFnew_get_vj(mf);
    4090        5390 :     long a, lDNM, lS = lg(S), M = MF_get_N(mf);
    4091        5390 :     DNM = mydivisorsu(N / M); lDNM = lg(DNM);
    4092       20475 :     for (a = 1; a < lS; a++)
    4093             :     {
    4094       15085 :       GEN tf = gel(S,a);
    4095       15085 :       long b, j = vj[a];
    4096       37135 :       for (b = 1; b < lDNM; b++)
    4097             :       {
    4098       22050 :         long d = DNM[b];
    4099       22050 :         vectrunc_append(vS, mfbd_i(tf, d));
    4100       22050 :         vectrunc_append(vMjd, mkvecsmall3(M, j, d));
    4101             :       }
    4102             :     }
    4103             :   }
    4104        2527 :   return mkmf(NULL, cgetg(1, t_VEC), vS, vMjd, NULL);
    4105             : }
    4106             : 
    4107             : long
    4108        2814 : mfsturm_mf(GEN mf)
    4109             : {
    4110        2814 :   GEN Mindex = MF_get_Mindex(mf);
    4111        2814 :   long n = lg(Mindex)-1;
    4112        2814 :   return n? Mindex[n]: 0;
    4113             : }
    4114             : 
    4115             : long
    4116         504 : mfsturm(GEN mf)
    4117             : {
    4118             :   long N, nk, dk;
    4119             :   GEN CHI;
    4120         504 :   if (checkMF_i(mf)) return mfsturm_mf(mf);
    4121           7 :   checkNK2(mf, &N, &nk, &dk, &CHI, 0);
    4122           7 :   return dk == 1 ? mfsturmNk(N, nk) : mfsturmNk(N, (nk + 1) >> 1);
    4123             : }
    4124             : 
    4125             : long
    4126           7 : mfisequal(GEN F, GEN G, long lim)
    4127             : {
    4128           7 :   pari_sp av = avma;
    4129             :   long t, sb;
    4130           7 :   if (!checkmf_i(F)) pari_err_TYPE("mfisequal",F);
    4131           7 :   if (!checkmf_i(G)) pari_err_TYPE("mfisequal",G);
    4132           7 :   if (lim) sb = lim;
    4133             :   else
    4134             :   {
    4135             :     GEN gN, gk;
    4136           7 :     gN = mf_get_gN(F); gk = mf_get_gk(F);
    4137           7 :     sb = mfsturmNgk(itou(gN), gk);
    4138           7 :     gN = mf_get_gN(G); gk = mf_get_gk(G);
    4139           7 :     sb = maxss(sb, mfsturmNgk(itou(gN), gk));
    4140             :   }
    4141           7 :   t = gequal(mfcoefs_i(F, sb+1, 1), mfcoefs_i(G, sb+1, 1));
    4142           7 :   avma = av; return t;
    4143             : }
    4144             : 
    4145             : GEN
    4146          35 : mffields(GEN mf)
    4147             : {
    4148          35 :   if (checkmf_i(mf)) return gcopy(mf_get_field(mf));
    4149          35 :   checkMF(mf); return gcopy(MF_get_fields(mf));
    4150             : }
    4151             : 
    4152             : GEN
    4153         147 : mfeigenbasis(GEN mf)
    4154             : {
    4155         147 :   pari_sp ltop = avma;
    4156             :   GEN F, S, v, vP;
    4157             :   long i, l, k;
    4158             : 
    4159         147 :   checkMF(mf);
    4160         147 :   k = MF_get_k(mf);
    4161         147 :   S = MF_get_S(mf); if (lg(S) == 1) return cgetg(1, t_VEC);
    4162         140 :   F = MF_get_newforms(mf);
    4163         140 :   vP = MF_get_fields(mf);
    4164         140 :   if (k == 1)
    4165             :   {
    4166          42 :     v = vecmflineardiv_linear(S, F);
    4167          42 :     l = lg(v);
    4168             :   }
    4169             :   else
    4170             :   {
    4171          98 :     GEN (*L)(GEN, GEN) = (MF_get_space(mf) == mf_FULL)? mflinear: mflinear_bhn;
    4172          98 :     v = cgetg_copy(F, &l);
    4173          98 :     for (i = 1; i < l; i++) gel(v,i) = L(mf, gel(F,i));
    4174             :   }
    4175         140 :   for (i = 1; i < l; i++) mf_setfield(gel(v,i), gel(vP,i));
    4176         140 :   return gerepilecopy(ltop, v);
    4177             : }
    4178             : 
    4179             : /* Minv = [M, d, A], v a t_COL; A a Zab, d a t_INT; return (A/d) * M*v */
    4180             : static GEN
    4181        4620 : Minv_RgC_mul(GEN Minv, GEN v)
    4182             : {
    4183        4620 :   GEN M = gel(Minv,1), d = gel(Minv,2), A = gel(Minv,3);
    4184        4620 :   v = RgM_RgC_mul(M, v);
    4185        4620 :   if (!equali1(A)) v = RgC_Rg_mul(v, A);
    4186        4620 :   if (!equali1(d)) v = RgC_Rg_div(v, d);
    4187        4620 :   return v;
    4188             : }
    4189             : static GEN
    4190         896 : Minv_RgM_mul(GEN Minv, GEN B)
    4191             : {
    4192         896 :   long j, l = lg(B);
    4193         896 :   GEN M = cgetg(l, t_MAT);
    4194         896 :   for (j = 1; j < l; j++) gel(M,j) = Minv_RgC_mul(Minv, gel(B,j));
    4195         896 :   return M;
    4196             : }
    4197             : /* B * Minv; allow B = NULL for Id */
    4198             : static GEN
    4199        1834 : RgM_Minv_mul(GEN B, GEN Minv)
    4200             : {
    4201        1834 :   GEN M = gel(Minv,1), d = gel(Minv,2), A = gel(Minv,3), P = gel(Minv,4);
    4202        1834 :   if (B) M = RgM_mul(B, M);
    4203        1834 :   if (!equali1(A))
    4204             :   {
    4205         658 :     M = RgM_Rg_mul(M, A);
    4206         658 :     if (typ(A) != t_INT) M = RgXQM_red(M,P);
    4207             :   }
    4208        1834 :   if (!equali1(d)) M = RgM_Rg_div(M,d);
    4209        1834 :   return M;
    4210             : }
    4211             : 
    4212             : /* perm vector of strictly increasing indices, v a vector or arbitrary length;
    4213             :  * the last r entries of perm fall beyond v.
    4214             :  * Return v o perm[1..(-r)], discarding the last r entries of v */
    4215             : static GEN
    4216        1001 : vecpermute_partial(GEN v, GEN perm, long *r)
    4217             : {
    4218        1001 :   long i, n = lg(v)-1, l = lg(perm);
    4219             :   GEN w;
    4220        1001 :   if (perm[l-1] <= n) { *r = 0; return vecpermute(v,perm); }
    4221          63 :   for (i = 1; i < l; i++)
    4222          63 :     if (perm[i] > n) break;
    4223          21 :   *r = l - i; l = i;
    4224          21 :   w = cgetg(l, typ(v));
    4225          21 :   for (i = 1; i < l; i++) gel(w,i) = gel(v,perm[i]);
    4226          21 :   return w;
    4227             : }
    4228             : 
    4229             : /* given form F, find coeffs of F on mfbasis(mf). If power series, not
    4230             :  * guaranteed correct if precision less than Sturm bound */
    4231             : static GEN
    4232         994 : mftobasis_i(GEN mf, GEN F)
    4233             : {
    4234             :   GEN v, Mindex, Minv;
    4235         994 :   if (!MF_get_dim(mf)) return cgetg(1, t_COL);
    4236         987 :   Mindex = MF_get_Mindex(mf);
    4237         987 :   Minv = MF_get_Minv(mf);
    4238         987 :   if (checkmf_i(F))
    4239             :   {
    4240         133 :     long n = Mindex[lg(Mindex)-1];
    4241         133 :     v = vecpermute(mfcoefs_i(F, n, 1), Mindex);
    4242         133 :     return Minv_RgC_mul(Minv, v);
    4243             :   }
    4244             :   else
    4245             :   {
    4246         854 :     GEN A = gel(Minv,1), d = gel(Minv,2);
    4247             :     long r;
    4248         854 :     v = F;
    4249         854 :     switch(typ(F))
    4250             :     {
    4251           0 :       case t_SER: v = sertocol(v);
    4252         854 :       case t_VEC: case t_COL: break;
    4253           0 :       default: pari_err_TYPE("mftobasis", F);
    4254             :     }
    4255         854 :     if (lg(v) == 1) pari_err_TYPE("mftobasis",v);
    4256         854 :     v = vecpermute_partial(v, Mindex, &r);
    4257         854 :     if (!r) return Minv_RgC_mul(Minv, v); /* single solution */
    4258             :     /* affine space of dimension r */
    4259          21 :     v = RgM_RgC_mul(vecslice(A, 1, lg(v)-1), v);
    4260          21 :     if (!equali1(d)) v = RgC_Rg_div(v,d);
    4261          21 :     return mkvec2(v, vecslice(A, lg(A)-r, lg(A)-1));
    4262             :   }
    4263             : }
    4264             : 
    4265             : static GEN
    4266         560 : const_mat(long n, GEN x)
    4267             : {
    4268         560 :   long j, l = n+1;
    4269         560 :   GEN A = cgetg(l,t_MAT);
    4270         560 :   for (j = 1; j < l; j++) gel(A,j) = const_col(n, x);
    4271         560 :   return A;
    4272             : }
    4273             : 
    4274             : /* L is the mftobasis of a form on CUSP space. We allow mf_FULL or mf_CUSP */
    4275             : static GEN
    4276         280 : mftonew_i(GEN mf, GEN L, long *plevel)
    4277             : {
    4278             :   GEN S, listMjd, CHI, res, Aclos, Acoef, D, perm;
    4279         280 :   long N1, LC, lD, i, l, t, level, N = MF_get_N(mf);
    4280             : 
    4281         280 :   if (MF_get_k(mf) == 1) pari_err_IMPL("mftonew in weight 1");
    4282         280 :   listMjd = MFcusp_get_vMjd(mf);
    4283         280 :   CHI = MF_get_CHI(mf); LC = mfcharconductor(CHI);
    4284         280 :   S = MF_get_S(mf);
    4285             : 
    4286         280 :   N1 = N/LC;
    4287         280 :   D = mydivisorsu(N1); lD = lg(D);
    4288         280 :   perm = cgetg(N1+1, t_VECSMALL);
    4289         280 :   for (i = 1; i < lD; i++) perm[D[i]] = i;
    4290         280 :   Aclos = const_mat(lD-1, cgetg(1,t_VEC));
    4291         280 :   Acoef = const_mat(lD-1, cgetg(1,t_VEC));
    4292         280 :   l = lg(listMjd);
    4293        2877 :   for (i = 1; i < l; i++)
    4294             :   {
    4295             :     long M, d;
    4296             :     GEN v;
    4297        2597 :     if (gequal0(gel(L,i))) continue;
    4298         273 :     v = gel(listMjd, i);
    4299         273 :     M = perm[ v[1]/LC ];
    4300         273 :     d = perm[ v[3] ];
    4301         273 :     gcoeff(Aclos,M,d) = vec_append(gcoeff(Aclos,M,d), gel(S,i));
    4302         273 :     gcoeff(Acoef,M,d) = shallowconcat(gcoeff(Acoef,M,d), gel(L,i));
    4303             :   }
    4304         280 :   res = cgetg(l, t_VEC); level = 1;
    4305        2009 :   for (i = t = 1; i < lD; i++)
    4306             :   {
    4307        1729 :     long j, M = D[i]*LC;
    4308        1729 :     GEN gM = utoipos(M);
    4309       15134 :     for (j = 1; j < lD; j++)
    4310             :     {
    4311       13405 :       GEN f = gcoeff(Aclos,i,j), C, NK;
    4312             :       long d;
    4313       13405 :       if (lg(f) == 1) continue;
    4314         245 :       NK = mf_get_NK(gel(f,1));
    4315         245 :       d = D[j];
    4316         245 :       C = gcoeff(Acoef,i,j);
    4317         245 :       level = clcm(level, M*d);
    4318         245 :       gel(res,t++) = mkvec3(gM, utoipos(d), mflinear_i(NK,f,C));
    4319             :     }
    4320             :   }
    4321         280 :   if (plevel) *plevel = level;
    4322         280 :   setlg(res, t); return res;
    4323             : }
    4324             : GEN
    4325          35 : mftonew(GEN mf, GEN F)
    4326             : {
    4327          35 :   pari_sp av = avma;
    4328             :   GEN ES;
    4329             :   long s;
    4330          35 :   checkMF(mf);
    4331          35 :   s = MF_get_space(mf);
    4332          35 :   if (s != mf_FULL && s != mf_CUSP)
    4333           7 :     pari_err_TYPE("mftonew [not a full or cuspidal space]", mf);
    4334          28 :   ES = mftobasisES(mf,F);
    4335          21 :   if (!gequal0(gel(ES,1)))
    4336           0 :     pari_err_TYPE("mftonew [not a cuspidal form]", F);
    4337          21 :   F = gel(ES,2);
    4338          21 :   return gerepilecopy(av, mftonew_i(mf,F, NULL));
    4339             : }
    4340             : 
    4341             : static GEN mfeisenstein_i(long k, GEN CHI1, GEN CHI2);
    4342             : 
    4343             : /* mfinit(F * Theta) */
    4344             : static GEN
    4345          49 : mf2init(GEN mf)
    4346             : {
    4347          49 :   GEN CHI = MF_get_CHI(mf), gk = gadd(MF_get_gk(mf), ghalf);
    4348          49 :   long N = MF_get_N(mf);
    4349          49 :   return mfinit_Nkchi(N, itou(gk), mfchiadjust(CHI, gk, N), mf_FULL, 0);
    4350             : }
    4351             : 
    4352             : static long
    4353         280 : mfvec_first_cusp(GEN v)
    4354             : {
    4355         280 :   long i, l = lg(v);
    4356         707 :   for (i = 1; i < l; i++)
    4357             :   {
    4358         637 :     GEN F = gel(v,i);
    4359         637 :     long t = mf_get_type(F);
    4360         637 :     if (t == t_MF_BD) { F = gel(F,2); t = mf_get_type(F); }
    4361         637 :     if (t == t_MF_HECKE) { F = gel(F,3); t = mf_get_type(F); }
    4362         637 :     if (t == t_MF_NEWTRACE) break;
    4363             :   }
    4364         280 :   return i;
    4365             : }
    4366             : /* vF a vector of mf F of type DIV(LINEAR(BAS,L), f) in (lcm) level N,
    4367             :  * F[2]=LINEAR(BAS,L), F[2][2]=BAS=fixed basis (Eisentstein or bhn type),
    4368             :  * F[2][3]=L, F[3]=f; mfvectomat(vF, n) */
    4369             : static GEN
    4370         287 : mflineardivtomat(long N, GEN vF, long n)
    4371             : {
    4372             :   GEN F, M, f, fc, V, ME, B, a0;
    4373         287 :   long lM, lF = lg(vF), i, j;
    4374             : 
    4375         287 :   if (lF == 1) return cgetg(1,t_MAT);
    4376         280 :   F = gel(vF,1);
    4377         280 :   M = gmael(F,2,2); /* BAS */
    4378         280 :   lM = lg(M);
    4379         280 :   i = mfvec_first_cusp(M);
    4380         280 :   if (i == 1) ME = NULL;
    4381             :   else
    4382             :   { /* BAS starts by Eisenstein */
    4383          98 :     ME = mfvectomat(vecslice(M,1,i-1), n, 1);
    4384          98 :     M = vecslice(M, i,lM-1);
    4385             :   }
    4386         280 :   M = bhnmat_extend_nocache(NULL, N, n, 1, M);
    4387         280 :   if (ME) M = shallowconcat(ME,M);
    4388             :   /* M = mfcoefs of BAS */
    4389         280 :   f = mfcoefsser(gel(F,3),n);
    4390         280 :   a0 = polcoeff_i(f, 0, -1);
    4391         280 :   if (gequal0(a0) || gequal1(a0))
    4392         231 :     a0 = NULL;
    4393             :   else
    4394          49 :     f = gdiv(ser_unscale(f, a0), a0);
    4395         280 :   fc = ginv(f);
    4396         280 :   V = cgetg(lM, t_VEC);
    4397        2744 :   for (i = 1; i < lM; i++)
    4398             :   {
    4399        2464 :     pari_sp av = avma;
    4400        2464 :     GEN LISer = RgV_to_ser(gel(M,i),0), f;
    4401        2464 :     if (a0) LISer = gdiv(ser_unscale(LISer, a0), a0);
    4402        2464 :     f = gmul(LISer, fc);
    4403        2464 :     if (a0) f = ser_unscale(f, ginv(a0));
    4404        2464 :     f = sertocol(f); setlg(f, n+2);
    4405        2464 :     gel(V,i) = gerepileupto(av,f);
    4406             :   }
    4407         280 :   B = cgetg(lF, t_MAT);
    4408        1442 :   for (j = 1; j < lF; j++)
    4409             :   {
    4410        1162 :     pari_sp av = avma;
    4411        1162 :     GEN S = gen_0, coe;
    4412        1162 :     F = gel(vF, j); /* t_MF_DIV */
    4413        1162 :     coe = gdiv(gmael(F,2,3), gmael(F,2,4));
    4414       15855 :     for (i = 1; i < lM; i++)
    4415             :     {
    4416       14693 :       GEN co = gel(coe, i);
    4417       14693 :       if (!gequal0(co)) S = gadd(S, gmul(co, gel(V, i)));
    4418             :     }
    4419        1162 :     gel(B,j) = gerepileupto(av, S);
    4420             :   }
    4421         280 :   return B;
    4422             : }
    4423             : 
    4424             : static GEN
    4425          84 : mfheckemat_mfcoefs(GEN mf, GEN B, GEN DATA)
    4426             : {
    4427          84 :   GEN Mindex = MF_get_Mindex(mf), Minv = MF_get_Minv(mf);
    4428          84 :   long j, l = lg(B), sb = mfsturm_mf(mf)-1;
    4429          84 :   GEN b = MF_get_basis(mf), Q = cgetg(l, t_VEC);
    4430         252 :   for (j = 1; j < l; j++)
    4431             :   {
    4432         168 :     GEN v = hecke_i(sb, 1, gel(B,j), gel(b,j), DATA); /* Tn b[j] */
    4433         168 :     settyp(v,t_COL); gel(Q,j) = vecpermute(v, Mindex);
    4434             :   }
    4435          84 :   return Minv_RgM_mul(Minv,Q);
    4436             : }
    4437             : /* T_p^2, p prime, 1/2-integral weight; B = mfcoefs(mf,sb*p^2,1) or (mf,sb,p^2)
    4438             :  * if p|N */
    4439             : static GEN
    4440           7 : mfheckemat_mfcoefs_p2(GEN mf, long p, GEN B)
    4441             : {
    4442           7 :   pari_sp av = avma;
    4443           7 :   GEN DATA = heckef2_data(MF_get_N(mf), p*p);
    4444           7 :   return gerepileupto(av, mfheckemat_mfcoefs(mf, B, DATA));
    4445             : }
    4446             : /* convert Mindex from row-index to mfcoef indexation: a(n) is stored in
    4447             :  * mfcoefs()[n+1], so subtract 1 from all indices */
    4448             : static GEN
    4449          42 : Mindex_as_coef(GEN mf)
    4450             : {
    4451          42 :   GEN v, Mindex = MF_get_Mindex(mf);
    4452          42 :   long i, l = lg(Mindex);
    4453          42 :   v = cgetg(l, t_VECSMALL);
    4454          42 :   for (i = 1; i < l; i++) v[i] = Mindex[i]-1;
    4455          42 :   return v;
    4456             : }
    4457             : /* T_p, p prime; B = mfcoefs(mf,sb*p,1) or (mf,sb,p) if p|N; integral weight */
    4458             : static GEN
    4459          35 : mfheckemat_mfcoefs_p(GEN mf, long p, GEN B)
    4460             : {
    4461          35 :   pari_sp av = avma;
    4462          35 :   GEN vm, Q, C, Minv = MF_get_Minv(mf);
    4463          35 :   long lm, k, i, j, l = lg(B), N = MF_get_N(mf);
    4464             : 
    4465          35 :   if (N % p == 0) return Minv_RgM_mul(Minv, rowpermute(B, MF_get_Mindex(mf)));
    4466          21 :   k = MF_get_k(mf);
    4467          21 :   C = gmul(mfchareval_i(MF_get_CHI(mf), p), powuu(p, k-1));
    4468          21 :   vm = Mindex_as_coef(mf); lm = lg(vm);
    4469          21 :   Q = cgetg(l, t_MAT);
    4470          21 :   for (j = 1; j < l; j++) gel(Q,j) = cgetg(lm, t_COL);
    4471         147 :   for (i = 1; i < lm; i++)
    4472             :   {
    4473         126 :     long m = vm[i], mp = m*p;
    4474         126 :     GEN Cm = (m % p) == 0? C : NULL;
    4475        1260 :     for (j = 1; j < l; j++)
    4476             :     {
    4477        1134 :       GEN S = gel(B,j), s = gel(S, mp + 1);
    4478        1134 :       if (Cm) s = gadd(s, gmul(C, gel(S, m/p + 1)));
    4479        1134 :       gcoeff(Q, i, j) = s;
    4480             :     }
    4481             :   }
    4482          21 :   return gerepileupto(av, Minv_RgM_mul(Minv,Q));
    4483             : }
    4484             : /* Matrix of T(p), p prime, dim(mf) > 0 and integral weight */
    4485             : static GEN
    4486          77 : mfheckemat_p(GEN mf, long p)
    4487             : {
    4488          77 :   pari_sp av = avma;
    4489          77 :   long N = MF_get_N(mf), sb = mfsturm_mf(mf)-1;
    4490          77 :   GEN B = (N % p)? mfcoefs_mf(mf, sb * p, 1): mfcoefs_mf(mf, sb, p);
    4491          77 :   return gerepileupto(av, mfheckemat_mfcoefs(mf, B, hecke_data(N,p)));
    4492             : }
    4493             : 
    4494             : /* mf_NEW != (0), weight > 1, p prime. Use
    4495             :  * T(p) T(j) = T(j*p) + p^{k-1} \chi(p) 1_{p | j, p \nmid N} T(j/p) */
    4496             : static GEN
    4497         777 : mfnewmathecke_p(GEN mf, long p)
    4498             : {
    4499         777 :   pari_sp av = avma;
    4500         777 :   GEN tf, vj = MFnew_get_vj(mf), CHI = MF_get_CHI(mf);
    4501         777 :   GEN Mindex = MF_get_Mindex(mf), Minv = MF_get_Minv(mf);
    4502         777 :   long N = MF_get_N(mf), k = MF_get_k(mf);
    4503         777 :   long i, j, lvj = lg(vj), lim = vj[lvj-1] * p;
    4504         777 :   GEN perm, V, need = zero_zv(lim);
    4505         777 :   GEN M, C = gmul(mfchareval(CHI, p), powuu(p, k-1));
    4506         777 :   tf = mftraceform_new(N, k, CHI);
    4507        3206 :   for (i = 1; i < lvj; i++)
    4508             :   {
    4509        2429 :     j = vj[i]; need[j*p] = 1;
    4510        2429 :     if (N % p && j % p == 0) need[j/p] = 1;
    4511             :   }
    4512         777 :   perm = zero_zv(lim);
    4513         777 :   V = cgetg(lim+1, t_VEC);
    4514       10227 :   for (i = j = 1; i <= lim; i++)
    4515        9450 :     if (need[i]) { gel(V,j) = mfhecke_i(i, N, tf); perm[i] = j; j++; }
    4516         777 :   setlg(V, j);
    4517         777 :   V = bhnmat_extend_nocache(NULL, N, mfsturm_mf(mf)-1, 1, V);
    4518         777 :   V = rowpermute(V, Mindex); /* V[perm[i]] = coeffs(T_i newtrace) */
    4519         777 :   M = cgetg(lvj, t_MAT);
    4520        3206 :   for (i = 1; i < lvj; i++)
    4521             :   {
    4522             :     GEN t;
    4523        2429 :     j = vj[i]; t = gel(V, perm[j*p]);
    4524        2429 :     if (N % p && j % p == 0) t = RgC_add(t, RgC_Rg_mul(gel(V, perm[j/p]),C));
    4525        2429 :     gel(M,i) = t;
    4526             :   }
    4527         777 :   return gerepileupto(av, Minv_RgM_mul(Minv, M));
    4528             : }
    4529             : 
    4530             : GEN
    4531          70 : mfheckemat(GEN mf, GEN vn)
    4532             : {
    4533          70 :   pari_sp av = avma;
    4534          70 :   long lv, lvP, i, N, dim, nk, dk, p, sb, flint = (typ(vn)==t_INT);
    4535             :   GEN CHI, res, vT, FA, B, vP;
    4536             : 
    4537          70 :   checkMF(mf);
    4538          70 :   if (typ(vn) != t_VECSMALL) vn = gtovecsmall(vn);
    4539          70 :   N = MF_get_N(mf); CHI = MF_get_CHI(mf); Qtoss(MF_get_gk(mf), &nk, &dk);
    4540          70 :   dim = MF_get_dim(mf);
    4541          70 :   lv = lg(vn);
    4542          70 :   res = cgetg(lv, t_VEC);
    4543          70 :   FA = cgetg(lv, t_VEC);
    4544          70 :   vP = cgetg(lv, t_VEC);
    4545          70 :   vT = const_vec(vecsmall_max(vn), NULL);
    4546         168 :   for (i = 1; i < lv; i++)
    4547             :   {
    4548          98 :     ulong n = (ulong)labs(vn[i]);
    4549             :     GEN fa;
    4550          98 :     if (!n) pari_err_TYPE("mfheckemat", vn);
    4551          98 :     if (dk == 1 || uissquareall(n, &n)) fa = myfactoru(n);
    4552           0 :     else { n = 0; fa = myfactoru(1); } /* dummy: T_{vn[i]} = 0 */
    4553          98 :     vn[i] = n;
    4554          98 :     gel(FA,i) = fa;
    4555          98 :     gel(vP,i) = gel(fa,1);
    4556             :   }
    4557          70 :   vP = shallowconcat1(vP); vecsmall_sort(vP);
    4558          70 :   vP = vecsmall_uniq_sorted(vP); /* all primes occurring in vn */
    4559          70 :   lvP = lg(vP); if (lvP == 1) goto END;
    4560          56 :   p = vP[lvP-1];
    4561          56 :   sb = mfsturm_mf(mf)-1;
    4562          56 :   if (dk == 1 && nk != 1 && MF_get_space(mf) == mf_NEW)
    4563          21 :     B = NULL; /* special purpose mfnewmathecke_p is faster */
    4564          35 :   else if (lvP == 2 && N % p == 0)
    4565          21 :     B = mfcoefs_mf(mf, sb, dk==2? p*p: p); /* single prime | N, can optimize */
    4566             :   else
    4567          14 :     B = mfcoefs_mf(mf, sb * (dk==2? p*p: p), 1); /* general initialization */
    4568         126 :   for (i = 1; i < lvP; i++)
    4569             :   {
    4570          70 :     long j, l, q, e = 1;
    4571             :     GEN C, Tp, u1, u0;
    4572          70 :     p = vP[i];
    4573          70 :     for (j = 1; j < lv; j++) e = maxss(e, z_lval(vn[j], p));
    4574          70 :     if (!B)
    4575          28 :       Tp = mfnewmathecke_p(mf, p);
    4576          42 :     else if (dk == 2)
    4577           7 :       Tp = mfheckemat_mfcoefs_p2(mf,p, (lvP==2||N%p)? B: matdeflate(sb,p*p,B));
    4578             :     else
    4579          35 :       Tp = mfheckemat_mfcoefs_p(mf, p, (lvP==2||N%p)? B: matdeflate(sb,p,B));
    4580          70 :     gel(vT, p) = Tp;
    4581          70 :     if (e == 1) continue;
    4582          14 :     u0 = gen_1;
    4583          14 :     if (dk == 2)
    4584             :     {
    4585           0 :       C = N % p? gmul(mfchareval_i(CHI,p*p), powuu(p, nk-2)): NULL;
    4586           0 :       if (e == 2) u0 = sstoQ(p+1,p); /* special case T_{p^4} */
    4587             :     }
    4588             :     else
    4589          14 :       C = N % p? gmul(mfchareval_i(CHI,p),   powuu(p, nk-1)): NULL;
    4590          28 :     for (u1=Tp, q=p, l=2; l <= e; l++)
    4591             :     { /* u0 = T_{p^{l-2}}, u1 = T_{p^{l-1}} for l > 2 */
    4592          14 :       GEN v = gmul(Tp, u1);
    4593          14 :       if (C) v = gsub(v, gmul(C, u0));
    4594             :       /* q = p^l, vT[q] = T_q for k integer else T_{q^2} */
    4595          14 :       q *= p; u0 = u1; gel(vT, q) = u1 = v;
    4596             :     }
    4597             :   }
    4598             : END:
    4599             :   /* vT[p^e] = T_{p^e} for all p^e occurring below */
    4600         168 :   for (i = 1; i < lv; i++)
    4601             :   {
    4602          98 :     long n = vn[i], j, lP;
    4603             :     GEN fa, P, E, M;
    4604          98 :     if (n == 0) { gel(res,i) = zeromat(dim,dim); continue; }
    4605          98 :     if (n == 1) { gel(res,i) = matid(dim); continue; }
    4606          77 :     fa = gel(FA,i);
    4607          77 :     P = gel(fa,1); lP = lg(P);
    4608          77 :     E = gel(fa,2); M = gel(vT, upowuu(P[1], E[1]));
    4609          77 :     for (j = 2; j < lP; j++) M = RgM_mul(M, gel(vT, upowuu(P[j], E[j])));
    4610          77 :     gel(res,i) = M;
    4611             :   }
    4612          70 :   if (flint) res = gel(res,1);
    4613          70 :   return gerepilecopy(av, res);
    4614             : }
    4615             : 
    4616             : 
    4617             : /* f = \sum_i v[i] T_listj[i] (Trace Form) attached to v; replace by f/a_1(f) */
    4618             : static GEN
    4619        1064 : mf_normalize(GEN mf, GEN v)
    4620             : {
    4621        1064 :   GEN c, dc = NULL, M = MF_get_M(mf), Mindex = MF_get_Mindex(mf);
    4622        1064 :   v = Q_primpart(v);
    4623        1064 :   c = RgMrow_RgC_mul(M, v, 2); /* a_1(f) */
    4624        1064 :   if (gequal1(c)) return v;
    4625         616 :   if (typ(c) == t_POL) c = gmodulo(c, mfcharpol(MF_get_CHI(mf)));
    4626         616 :   if (typ(c) == t_POLMOD && varn(gel(c,1)) == 1 && degpol(gel(c,1)) >= 40
    4627           7 :                          && Mindex[1] == 2
    4628           7 :                          && mfcharorder(MF_get_CHI(mf)) <= 2)
    4629           7 :   { /* normalize using expansion at infinity (small coefficients) */
    4630           7 :     GEN w, P = gel(c,1), a1 = gel(c,2);
    4631           7 :     long i, l = lg(Mindex);
    4632           7 :     w = cgetg(l, t_COL);
    4633           7 :     gel(w,1) = gen_1;
    4634         280 :     for (i = 2; i < l; i++)
    4635             :     {
    4636         273 :       c = liftpol_shallow(RgMrow_RgC_mul(M, v, Mindex[i]));
    4637         273 :       gel(w,i) = QXQ_div_ratlift(c, a1, P);
    4638             :     }
    4639             :     /* w = expansion at oo of normalized form */
    4640           7 :     v = Minv_RgC_mul(MF_get_Minv(mf), Q_remove_denom(w, &dc));
    4641           7 :     v = gmodulo(v, P); /* back to mfbasis coefficients */
    4642             :   }
    4643             :   else
    4644             :   {
    4645         609 :     c = ginv(c);
    4646         609 :     if (typ(c) == t_POLMOD) c = Q_remove_denom(c, &dc);
    4647         609 :     v = RgC_Rg_mul(v, c);
    4648             :   }
    4649         616 :   if (dc) v = RgC_Rg_div(v, dc);
    4650         616 :   return v;
    4651             : }
    4652             : static void
    4653         175 : pol_red(GEN NF, GEN *pP, GEN *pa, long flag)
    4654             : {
    4655         175 :   GEN dP, a, P = *pP;
    4656         175 :   long d = degpol(P);
    4657             : 
    4658         175 :   *pa = a = pol_x(varn(P));
    4659         350 :   if (d > 30) return;
    4660             : 
    4661         168 :   dP = RgX_disc(P);
    4662         168 :   if (typ(dP) != t_INT)
    4663          35 :   { dP = gnorm(dP); if (typ(dP) != t_INT) pari_err_BUG("mfnewsplit"); }
    4664         168 :   if (d == 2 || expi(dP) < 62)
    4665             :   {
    4666         154 :     if (expi(dP) < 31)
    4667         154 :       P = NF? rnfpolredabs(NF, P,flag): polredabs0(P,flag);
    4668             :     else
    4669           0 :       P = NF? rnfpolredbest(NF,P,flag): polredbest(P,flag);
    4670         154 :     if (flag)
    4671             :     {
    4672         140 :       a = gel(P,2); if (typ(a) == t_POLMOD) a = gel(a,2);
    4673         140 :       P = gel(P,1);
    4674             :     }
    4675             :   }
    4676         168 :   *pP = P;
    4677         168 :   *pa = a;
    4678             : }
    4679             : 
    4680             : /* Diagonalize and normalize. See mfsplit for meaning of flag. */
    4681             : static GEN
    4682         784 : mfspclean(GEN mf, GEN mf0, GEN NF, long ord, GEN simplesp, long flag)
    4683             : {
    4684         784 :   const long vz = 1;
    4685         784 :   long i, l = lg(simplesp);
    4686         784 :   GEN res = cgetg(l, t_VEC), pols = cgetg(l, t_VEC);
    4687         784 :   GEN zeros = (mf == mf0)? NULL: zerocol(MF_get_dim(mf) - MF_get_dim(mf0));
    4688        1862 :   for (i = 1; i < l; i++)
    4689             :   {
    4690        1078 :     GEN ATP = gel(simplesp, i), A = gel(ATP,1), P = gel(ATP,3);
    4691        1078 :     long d = degpol(P);
    4692        1078 :     GEN a, v = (flag && d > flag)? NULL: gel(A,1);
    4693        1078 :     if (d == 1) P = pol_x(vz);
    4694             :     else
    4695             :     {
    4696         175 :       pol_red(NF, &P, &a, !!v);
    4697         175 :       if (v)
    4698             :       { /* Mod(a,P) root of charpoly(T), K*gpowers(a) = eigenvector of T */
    4699         161 :         GEN K, den, M = cgetg(d+1, t_MAT), T = gel(ATP,2);
    4700             :         long j;
    4701         161 :         T = shallowtrans(T);
    4702         161 :         gel(M,1) = vec_ei(d,1); /* basis of cyclic vectors */
    4703         161 :         for (j = 2; j <= d; j++) gel(M,j) = RgM_RgC_mul(T, gel(M,j-1));
    4704         161 :         M = Q_primpart(M);
    4705         210 :         K = NF? ZabM_inv(liftpol_shallow(M), nf_get_pol(NF), ord, &den)
    4706         210 :               : ZM_inv(M,&den);
    4707         161 :         K = shallowtrans(K);
    4708         161 :         v = gequalX(a)? pol_x_powers(d, vz): RgXQ_powers(a, d-1, P);
    4709         161 :         v = gmodulo(RgM_RgC_mul(A, RgM_RgC_mul(K,v)), P);
    4710             :       }
    4711             :     }
    4712        1078 :     if (v) { v = mf_normalize(mf0, v); if (zeros) v = shallowconcat(zeros,v); }
    4713        1078 :     gel(res, i) = v? : gen_0;
    4714        1078 :     gel(pols,i) = P;
    4715             :   }
    4716         784 :   return mkvec2(res, pols);
    4717             : }
    4718             : 
    4719             : /* return v = v_{X-r}(P), and set Z = P / (X-r)^v */
    4720             : static long
    4721          63 : RgX_valrem_root(GEN P, GEN r, GEN *Z)
    4722             : {
    4723             :   long v;
    4724         126 :   for (v = 0; degpol(P); v++)
    4725             :   {
    4726         126 :     GEN t, Q = RgX_div_by_X_x(P, r, &t);
    4727         126 :     if (!gequal0(t)) break;
    4728          63 :     P = Q;
    4729             :   }
    4730          63 :   *Z = P; return v;
    4731             : }
    4732             : static GEN
    4733         861 : mynffactor(GEN NF, GEN P, long dimlim)
    4734             : {
    4735             :   long i, l, v;
    4736             :   GEN R, E;
    4737         861 :   if (dimlim != 1)
    4738             :   {
    4739         322 :     R = NF? nffactor(NF, P): QX_factor(P);
    4740         322 :     if (!dimlim) return R;
    4741          21 :     E = gel(R,2);
    4742          21 :     R = gel(R,1); l = lg(R);
    4743          98 :     for (i = 1; i < l; i++)
    4744          91 :       if (degpol(gel(R,i)) > dimlim) break;
    4745          21 :     if (i == 1) return NULL;
    4746          21 :     setlg(E,i);
    4747          21 :     setlg(R,i); return mkmat2(R, E);
    4748             :   }
    4749             :   /* dimlim = 1 */
    4750         539 :   R = nfroots(NF, P); l = lg(R);
    4751         539 :   if (l == 1) return NULL;
    4752         476 :   v = varn(P);
    4753         476 :   settyp(R, t_COL);
    4754         476 :   if (degpol(P) == l-1)
    4755         427 :     E = const_vec(l-1, gen_1);
    4756             :   else
    4757             :   {
    4758          49 :     E = cgetg(l, t_COL);
    4759          49 :     for (i = 1; i < l; i++) gel(E,i) = utoi(RgX_valrem_root(P, gel(R,i), &P));
    4760             :   }
    4761         476 :   R = deg1_from_roots(R, v);
    4762         476 :   return mkmat2(R, E);
    4763             : }
    4764             : 
    4765             : /* Let K be a number field attached to NF (Q if NF = NULL). A K-vector
    4766             :  * space of dimension d > 0 is given by a t_MAT A (n x d, full column rank)
    4767             :  * giving a K-basis, X a section (d x n: left pseudo-inverse of A). Return a
    4768             :  * pair (T, fa), where T is an element of the Hecke algebra (a sum of Tp taken
    4769             :  * from vector vTp) acting on A (a d x d t_MAT) and fa is the factorization of
    4770             :  * its characteristic polynomial, limited to factors of degree <= dimlim if
    4771             :  * dimlim != 0 (return NULL if there are no factors of degree <= dimlim) */
    4772             : static GEN
    4773         854 : findbestsplit(GEN NF, GEN vTp, GEN A, GEN X, long dimlim, long vz)
    4774             : {
    4775         854 :   GEN T = NULL, Tkeep = NULL, fakeep = NULL;
    4776         854 :   long lmax = 0, i, lT = lg(vTp);
    4777        1820 :   for (i = 1; i < lT; i++)
    4778             :   {
    4779         910 :     GEN D, P, E, fa, TpA = gel(vTp,i);
    4780             :     long l;
    4781        1701 :     if (typ(TpA) == t_INT) break;
    4782         861 :     if (lg(TpA) > lg(A)) TpA = RgM_mul(X, RgM_mul(TpA, A)); /* Tp | A */
    4783         861 :     T = T ? RgM_add(T, TpA) : TpA;
    4784         861 :     if (!NF) { P = QM_charpoly_ZX(T); setvarn(P, vz); }
    4785             :     else
    4786             :     {
    4787         105 :       P = charpoly(Q_remove_denom(T, &D), vz);
    4788         105 :       if (D) P = gdiv(RgX_unscale(P, D), powiu(D, degpol(P)));
    4789             :     }
    4790         861 :     fa = mynffactor(NF, P, dimlim);
    4791         861 :     if (!fa) return NULL;
    4792         798 :     E = gel(fa, 2);
    4793             :     /* characteristic polynomial is separable ? */
    4794         798 :     if (isint1(vecmax(E))) { Tkeep = T; fakeep = fa; break; }
    4795          56 :     l = lg(E);
    4796             :     /* characteristic polynomial has more factors than before ? */
    4797          56 :     if (l > lmax) { lmax = l; Tkeep = T; fakeep = fa; }
    4798             :   }
    4799         791 :   return mkvec2(Tkeep, fakeep);
    4800             : }
    4801             : 
    4802             : static GEN
    4803         126 : nfcontent(GEN nf, GEN v)
    4804             : {
    4805         126 :   long i, l = lg(v);
    4806         126 :   GEN c = gel(v,1);
    4807         126 :   for (i = 2; i < l; i++) c = idealadd(nf, c, gel(v,i));
    4808         126 :   if (typ(c) == t_MAT && gequal1(gcoeff(c,1,1))) c = gen_1;
    4809         126 :   return c;
    4810             : }
    4811             : static GEN
    4812         189 : nf_primpart(GEN nf, GEN B)
    4813             : {
    4814         189 :   switch(typ(B))
    4815             :   {
    4816             :     case t_COL:
    4817             :     {
    4818         126 :       GEN A = matalgtobasis(nf, B), c = nfcontent(nf, A);
    4819         126 :       if (typ(c) == t_INT) return B;
    4820          14 :       c = idealred_elt(nf,c);
    4821          14 :       A = Q_primpart( nfC_nf_mul(nf, A, Q_primpart(nfinv(nf,c))) );
    4822          14 :       A = liftpol_shallow( matbasistoalg(nf, A) );
    4823          14 :       if (gexpo(A) > gexpo(B)) A = B;
    4824          14 :       return A;
    4825             :     }
    4826             :     case t_MAT:
    4827             :     {
    4828             :       long i, l;
    4829          63 :       GEN A = cgetg_copy(B, &l);
    4830          63 :       for (i = 1; i < l; i++) gel(A,i) = nf_primpart(nf, gel(B,i));
    4831          63 :       return A;
    4832             :     }
    4833             :     default:
    4834           0 :       pari_err_TYPE("nf_primpart", B);
    4835             :       return NULL; /*LCOV_EXCL_LINE*/
    4836             :   }
    4837             : }
    4838             : 
    4839             : /* rotate entries of v to accomodate new entry 'x' (push out oldest entry) */
    4840             : static void
    4841         826 : vecpush(GEN v, GEN x)
    4842             : {
    4843             :   long i;
    4844         826 :   for (i = lg(v)-1; i > 1; i--) gel(v,i) = gel(v,i-1);
    4845         826 :   gel(v,1) = x;
    4846         826 : }
    4847             : 
    4848             : /* sort t_VEC of vector spaces by increasing dimension */
    4849             : static GEN
    4850         784 : sort_by_dim(GEN v)
    4851             : {
    4852         784 :   long i, l = lg(v);
    4853         784 :   GEN D = cgetg(l, t_VECSMALL);
    4854         784 :   for (i = 1; i < l; i++) D[i] = lg(gmael(v,i,2));
    4855         784 :   return vecpermute(v , vecsmall_indexsort(D));
    4856             : }
    4857             : static GEN
    4858         784 : split_starting_space(GEN mf)
    4859             : {
    4860         784 :   long d = MF_get_dim(mf), d2;
    4861         784 :   GEN id = matid(d);
    4862         784 :   switch(MF_get_space(mf))
    4863             :   {
    4864             :     case mf_NEW:
    4865         784 :     case mf_CUSP: return mkvec2(id, id);
    4866             :   }
    4867           0 :   d2 = lg(MF_get_S(mf))-1;
    4868           0 :   return mkvec2(vecslice(id, d-d2+1,d),
    4869             :                 shallowconcat(zeromat(d2,d-d2),matid(d2)));
    4870             : }
    4871             : /* If dimlim > 0, keep only the dimension <= dimlim eigenspaces.
    4872             :  * See mfsplit for the meaning of flag. */
    4873             : static GEN
    4874        1162 : mfsplit_i(GEN mf, long dimlim, long flag)
    4875             : {
    4876             :   forprime_t iter;
    4877        1162 :   GEN CHI = MF_get_CHI(mf), empty = cgetg(1, t_VEC), mf0 = mf;
    4878             :   GEN NF, POLCYC, todosp, Tpbigvec, simplesp;
    4879        1162 :   long N = MF_get_N(mf), k = MF_get_k(mf);
    4880        1162 :   long ord, FC, NEWT, dimsimple = 0, newd = -1;
    4881        1162 :   const long NBH = 5, vz = 1;
    4882             :   ulong p;
    4883             : 
    4884        1162 :   switch(MF_get_space(mf))
    4885             :   {
    4886        1085 :     case mf_NEW: break;
    4887             :     case mf_CUSP:
    4888             :     case mf_FULL:
    4889          70 :       if (k > 1) { mf0 = mfinittonew(mf); break; }
    4890          70 :       newd = lg(MF_get_S(mf))-1 - mfolddim(N, k, CHI);
    4891          70 :       break;
    4892           7 :     default: pari_err_TYPE("mfsplit [space does not contain newspace]", mf);
    4893             :       return NULL; /*LCOV_EXCL_LINE*/
    4894             :   }
    4895        1155 :   if (newd < 0) newd = mf0? MF_get_dim(mf0): 0;
    4896        1155 :   if (!newd) return mkvec2(empty, empty);
    4897             : 
    4898         784 :   NEWT = (k > 1 && MF_get_space(mf0) == mf_NEW);
    4899         784 :   todosp = mkvec( split_starting_space(mf0) );
    4900         784 :   simplesp = empty;
    4901         784 :   FC = mfcharconductor(CHI);
    4902         784 :   ord = mfcharorder_canon(CHI);
    4903         784 :   if (ord == 1) NF = POLCYC = NULL;
    4904             :   else
    4905             :   {
    4906          70 :     POLCYC = mfcharpol(CHI);
    4907          70 :     NF = nfinit(POLCYC,DEFAULTPREC);
    4908             :   }
    4909         784 :   Tpbigvec = zerovec(NBH);
    4910         784 :   u_forprime_init(&iter, 2, ULONG_MAX);
    4911         784 :   while (dimsimple < newd && (p = u_forprime_next(&iter)))
    4912             :   {
    4913             :     GEN nextsp;
    4914             :     long ind;
    4915        1036 :     if (N % (p*p) == 0 && N/p % FC == 0) continue; /* T_p = 0 in this case */
    4916         826 :     vecpush(Tpbigvec, NEWT? mfnewmathecke_p(mf0,p): mfheckemat_p(mf0,p));
    4917         826 :     nextsp = empty;
    4918        1680 :     for (ind = 1; ind < lg(todosp); ind++)
    4919             :     {
    4920         854 :       GEN tmp = gel(todosp, ind), fa, P, E, D, Tp, DTp;
    4921         854 :       GEN A = gel(tmp, 1);
    4922         854 :       GEN X = gel(tmp, 2);
    4923             :       long lP, i;
    4924         854 :       tmp = findbestsplit(NF, Tpbigvec, A, X, dimlim, vz);
    4925        1435 :       if (!tmp) continue; /* nothing there */
    4926         791 :       Tp = gel(tmp, 1);
    4927         791 :       fa = gel(tmp, 2);
    4928         791 :       P = gel(fa, 1);
    4929         791 :       E = gel(fa, 2); lP = lg(P);
    4930             :       /* lP > 1 */
    4931         791 :       if (DEBUGLEVEL) err_printf("Exponents = %Ps\n", E);
    4932         791 :       if (lP == 2)
    4933             :       {
    4934         560 :         GEN P1 = gel(P,1);
    4935         560 :         long e1 = itos(gel(E,1)), d1 = degpol(P1);
    4936         560 :         if (e1 * d1 == lg(Tp)-1)
    4937             :         {
    4938         518 :           if (e1 > 1) nextsp = vec_append(nextsp, mkvec2(A,X));
    4939             :           else
    4940             :           { /* simple module */
    4941         511 :             simplesp = vec_append(simplesp, mkvec3(A,Tp,P1));
    4942         511 :             dimsimple += d1;
    4943             :           }
    4944         518 :           continue;
    4945             :         }
    4946             :       }
    4947             :       /* Found splitting */
    4948         273 :       DTp = Q_remove_denom(Tp, &D);
    4949         910 :       for (i = 1; i < lP; i++)
    4950             :       {
    4951         637 :         GEN Ai, Xi, dXi, AAi, v, y, Pi = gel(P,i);
    4952         637 :         Ai = RgX_RgM_eval(D? RgX_rescale(Pi,D): Pi, DTp);
    4953         637 :         Ai = QabM_ker(Ai, POLCYC, ord);
    4954         637 :         if (NF) Ai = nf_primpart(NF, Ai);
    4955             : 
    4956         637 :         AAi = RgM_mul(A, Ai);
    4957             :         /* gives section, works on nonsquare matrices */
    4958         637 :         Xi = QabM_pseudoinv(Ai, POLCYC, ord, &v, &dXi);
    4959         637 :         Xi = RgM_Rg_div(Xi, dXi);
    4960         637 :         y = gel(v,1);
    4961         637 :         if (isint1(gel(E,i)))
    4962             :         {
    4963         567 :           GEN Tpi = RgM_mul(Xi, RgM_mul(rowpermute(Tp,y), Ai));
    4964         567 :           simplesp = vec_append(simplesp, mkvec3(AAi, Tpi, Pi));
    4965         567 :           dimsimple += degpol(Pi);
    4966             :         }
    4967             :         else
    4968             :         {
    4969          70 :           Xi = RgM_mul(Xi, rowpermute(X,y));
    4970          70 :           nextsp = vec_append(nextsp, mkvec2(AAi, Xi));
    4971             :         }
    4972             :       }
    4973             :     }
    4974         826 :     todosp = nextsp; if (lg(todosp) == 1) break;
    4975             :   }
    4976         784 :   if (DEBUGLEVEL) err_printf("end split, need to clean\n");
    4977         784 :   return mfspclean(mf, mf0, NF, ord, sort_by_dim(simplesp), flag);
    4978             : }
    4979             : /* mf is either already split or output by mfinit. Splitting is done only for
    4980             :  * newspace except in weight 1. If flag = 0 (default) split completely.
    4981             :  * If flag = d > 0, only give the Galois polynomials in degree > d
    4982             :  * Flag is ignored if dimlim = 1. */
    4983             : GEN
    4984         959 : mfsplit(GEN mf, long dimlim, long flag)
    4985             : {
    4986         959 :   pari_sp av = avma;
    4987             :   GEN v;
    4988         959 :   if (!checkMF_i(mf)) pari_err_TYPE("mfsplit", mf);
    4989         959 :   if (obj_check(mf, MF_SPLIT))
    4990             :   { /* already split; apply dimlim filter */
    4991          14 :     GEN pols = MF_get_fields(mf), forms = MF_get_newforms(mf);
    4992          14 :     if (dimlim)
    4993             :     {
    4994          14 :       long j, l = lg(pols);
    4995         112 :       for (j = 1; j < l; j++)
    4996         105 :         if (degpol(gel(pols,j)) > dimlim) break;
    4997          14 :       if (j != l)
    4998             :       {
    4999           7 :         pols = vecslice(pols,1,j-1);
    5000           7 :         forms= vecslice(forms,1,j-1);
    5001             :       }
    5002             :     }
    5003          14 :     v = mkvec2(forms,pols);
    5004             :   }
    5005             :   else
    5006             :   {
    5007         945 :     v = mfsplit_i(mf, dimlim, flag);
    5008         945 :     if (!dimlim && !flag) obj_insert(mf, MF_SPLIT,v);
    5009             :   }
    5010         959 :   return gerepilecopy(av, v);
    5011             : }
    5012             : static GEN
    5013         217 : split(GEN mf) { return mfsplit_i(mf,0,0); }
    5014             : GEN
    5015         329 : MF_get_newforms(GEN mf) { return gel(obj_checkbuild(mf,MF_SPLIT,&split),1); }
    5016             : GEN
    5017         315 : MF_get_fields(GEN mf) { return gel(obj_checkbuild(mf,MF_SPLIT,&split),2); }
    5018             : 
    5019             : /*************************************************************************/
    5020             : /*                     Modular forms of Weight 1                         */
    5021             : /*************************************************************************/
    5022             : /* S_1(G_0(N)), small N. Return 1 if definitely empty; return 0 if maybe
    5023             :  * non-empty  */
    5024             : static int
    5025       15610 : wt1empty(long N)
    5026             : {
    5027       15610 :   if (N <= 100) switch (N)
    5028             :   { /* non-empty [32/100] */
    5029             :     case 23: case 31: case 39: case 44: case 46:
    5030             :     case 47: case 52: case 55: case 56: case 57:
    5031             :     case 59: case 62: case 63: case 68: case 69:
    5032             :     case 71: case 72: case 76: case 77: case 78:
    5033             :     case 79: case 80: case 83: case 84: case 87:
    5034             :     case 88: case 92: case 93: case 94: case 95:
    5035        5271 :     case 99: case 100: return 0;
    5036        3423 :     default: return 1;
    5037             :   }
    5038        6916 :   if (N <= 600) switch(N)
    5039             :   { /* empty [111/500] */
    5040             :     case 101: case 102: case 105: case 106: case 109:
    5041             :     case 113: case 121: case 122: case 123: case 125:
    5042             :     case 130: case 134: case 137: case 146: case 149:
    5043             :     case 150: case 153: case 157: case 162: case 163:
    5044             :     case 169: case 170: case 173: case 178: case 181:
    5045             :     case 182: case 185: case 187: case 193: case 194:
    5046             :     case 197: case 202: case 205: case 210: case 218:
    5047             :     case 221: case 226: case 233: case 241: case 242:
    5048             :     case 245: case 246: case 250: case 257: case 265:
    5049             :     case 267: case 269: case 274: case 277: case 281:
    5050             :     case 289: case 293: case 298: case 305: case 306:
    5051             :     case 313: case 314: case 317: case 326: case 337:
    5052             :     case 338: case 346: case 349: case 353: case 361:
    5053             :     case 362: case 365: case 369: case 370: case 373:
    5054             :     case 374: case 377: case 386: case 389: case 394:
    5055             :     case 397: case 401: case 409: case 410: case 421:
    5056             :     case 425: case 427: case 433: case 442: case 449:
    5057             :     case 457: case 461: case 466: case 481: case 482:
    5058             :     case 485: case 490: case 493: case 509: case 514:
    5059             :     case 521: case 530: case 533: case 534: case 538:
    5060             :     case 541: case 545: case 554: case 557: case 562:
    5061             :     case 565: case 569: case 577: case 578: case 586:
    5062         336 :     case 593: return 1;
    5063        6566 :     default: return 0;
    5064             :   }
    5065          14 :   return 0;
    5066             : }
    5067             : 
    5068             : static GEN
    5069          21 : initwt1trace(GEN mf)
    5070             : {
    5071          21 :   GEN S = MF_get_S(mf), v, H;
    5072             :   long l, i;
    5073          21 :   if (lg(S) == 1) return mftrivial();
    5074          21 :   H = mfheckemat(mf, Mindex_as_coef(mf));
    5075          21 :   l = lg(H); v = cgetg(l, t_VEC);
    5076          21 :   for (i = 1; i < l; i++) gel(v,i) = gtrace(gel(H,i));
    5077          21 :   v = Minv_RgC_mul(MF_get_Minv(mf), v);
    5078          21 :   return mflineardiv_linear(S, v, 1);
    5079             : }
    5080             : static GEN
    5081          14 : initwt1newtrace(GEN mf)
    5082             : {
    5083          14 :   GEN v, D, S, Mindex, CHI = MF_get_CHI(mf);
    5084          14 :   long FC, lD, i, sb, N1, N2, lM, N = MF_get_N(mf);
    5085          14 :   CHI = mfchartoprimitive(CHI, &FC);
    5086          14 :   if (N % FC || mfcharparity(CHI) == 1) return mftrivial();
    5087          14 :   D = mydivisorsu(N/FC); lD = lg(D);
    5088          14 :   S = MF_get_S(mf);
    5089          14 :   if (lg(S) == 1) return mftrivial();
    5090          14 :   N2 = newd_params2(N);
    5091          14 :   N1 = N / N2;
    5092          14 :   Mindex = MF_get_Mindex(mf);
    5093          14 :   lM = lg(Mindex);
    5094          14 :   sb = Mindex[lM-1];
    5095          14 :   v = zerovec(sb+1);
    5096          28 :   for (i = 1; i < lD; i++)
    5097             :   {
    5098          14 :     long M = FC*D[i], j;
    5099          14 :     GEN tf = initwt1trace(M == N? mf: mfinit_Nkchi(M, 1, CHI, mf_CUSP, 0));
    5100             :     GEN listd, w;
    5101          14 :     if (mf_get_type(tf) == t_MF_CONST) continue;
    5102          14 :     w = mfcoefs_i(tf, sb, 1);
    5103          14 :     if (M == N) { v = gadd(v, w); continue; }
    5104           0 :     listd = mydivisorsu(u_ppo(cgcd(N/M, N1), FC));
    5105           0 :     for (j = 1; j < lg(listd); j++)
    5106             :     {
    5107           0 :       long d = listd[j], d2 = d*d; /* coprime to FC */
    5108           0 :       GEN dk = mfchareval_i(CHI, d);
    5109           0 :       long NMd = N/(M*d), m;
    5110           0 :       for (m = 1; m <= sb/d2; m++)
    5111             :       {
    5112           0 :         long be = mubeta2(NMd, m);
    5113           0 :         if (be)
    5114             :         {
    5115           0 :           GEN c = gmul(dk, gmulsg(be, gel(w, m+1)));
    5116           0 :           long n = m*d2;
    5117           0 :           gel(v, n+1) = gadd(gel(v, n+1), c);
    5118             :         }
    5119             :       }
    5120             :     }
    5121             :   }
    5122          14 :   if (gequal0(gel(v,2))) return mftrivial();
    5123          14 :   v = vecpermute(v,Mindex);
    5124          14 :   v = Minv_RgC_mul(MF_get_Minv(mf), v);
    5125          14 :   return mflineardiv_linear(S, v, 1);
    5126             : }
    5127             : 
    5128             : /* Matrix of T(p), p \nmid N */
    5129             : static GEN
    5130         105 : Tpmat(long p, long lim, GEN CHI)
    5131             : {
    5132         105 :   GEN M = zeromatcopy(lim, p*lim), chip = mfchareval_i(CHI, p); /* != 0 */
    5133             :   long i, j, pi, pj;
    5134         105 :   gcoeff(M, 1, 1) = gaddsg(1, chip);
    5135         105 :   for (i = 1, pi = p; i < lim; i++,  pi += p) gcoeff(M, i+1, pi+1) = gen_1;
    5136         105 :   for (j = 1, pj = p; pj < lim; j++, pj += p) gcoeff(M, pj+1, j+1) = chip;
    5137         105 :   return M;
    5138             : }
    5139             : 
    5140             : /* assume !wt1empty(N), in particular N>25 */
    5141             : /* Returns [[lim,p], mf (weight 2), p*lim x dim matrix] */
    5142             : static GEN
    5143        1708 : mfwt1_pre(long N)
    5144             : {
    5145        1708 :   GEN M, mf = mfinit_Nkchi(N, 2, mfchartrivial(), mf_CUSP, 0);
    5146             :   /*not empty for N>25*/
    5147             :   long p, lim;
    5148        1708 :   if (uisprime(N))
    5149             :   {
    5150         385 :     p = 2; /*N>25 is not 2 */
    5151         385 :     lim = ceilA1(N, 3);
    5152             :   }
    5153             :   else
    5154             :   {
    5155             :     forprime_t S;
    5156        1323 :     u_forprime_init(&S, 2, N);
    5157        1323 :     while ((p = u_forprime_next(&S)))
    5158        2394 :       if (N % p) break;
    5159        1323 :     lim = mfsturm_mf(mf) + 1;
    5160             :   }
    5161             :   /* p = smalllest prime not dividing N */
    5162        1708 :   M = bhnmat_extend_nocache(MF_get_M(mf), N, p*lim-1, 1, MF_get_S(mf));
    5163        1708 :   return mkvec3(mkvecsmall2(lim, p), mf, M);
    5164             : }
    5165             : 
    5166             : /* lg(A) > 1, E a t_POL */
    5167             : static GEN
    5168         700 : mfmatsermul(GEN A, GEN E)
    5169             : {
    5170         700 :   long j, l = lg(A), r = nbrows(A);
    5171         700 :   GEN M = cgetg(l, t_MAT);
    5172         700 :   E = RgXn_red_shallow(E, r+1);
    5173        7525 :   for (j = 1; j < l; j++)
    5174             :   {
    5175        6825 :     GEN c = RgV_to_RgX(gel(A,j), 0);
    5176        6825 :     gel(M, j) = RgX_to_RgC(RgXn_mul(c, E, r+1), r);
    5177             :   }
    5178         700 :   return M;
    5179             : }
    5180             : /* lg(Ap) > 1, Ep an Flxn */
    5181             : static GEN
    5182         378 : mfmatsermul_Fl(GEN Ap, GEN Ep, ulong p)
    5183             : {
    5184         378 :   long j, l = lg(Ap), r = nbrows(Ap);
    5185         378 :   GEN M = cgetg(l, t_MAT);
    5186        5334 :   for (j = 1; j < l; j++)
    5187             :   {
    5188        4956 :     GEN c = Flv_to_Flx(gel(Ap,j), 0);
    5189        4956 :     gel(M,j) = Flx_to_Flv(Flxn_mul(c, Ep, r+1, p), r);
    5190             :   }
    5191         378 :   return M;
    5192             : }
    5193             : 
    5194             : /* CHI mod F | N, return mfchar of modulus N.
    5195             :  * FIXME: wasteful, G should be precomputed  */
    5196             : static GEN
    5197       14854 : mfcharinduce(GEN CHI, long N)
    5198             : {
    5199             :   GEN G, chi;
    5200       14854 :   if (mfcharmodulus(CHI) == N) return CHI;
    5201        2793 :   G = znstar0(utoipos(N), 1);
    5202        2793 :   chi = zncharinduce(gel(CHI,1), gel(CHI,2), G);
    5203        2793 :   CHI = leafcopy(CHI);
    5204        2793 :   gel(CHI,1) = G;
    5205        2793 :   gel(CHI,2) = chi; return CHI;
    5206             : }
    5207             : 
    5208             : static GEN
    5209        3983 : gmfcharno(GEN CHI)
    5210             : {
    5211        3983 :   GEN G = gel(CHI,1), chi = gel(CHI,2);
    5212        3983 :   return mkintmod(znconreyexp(G, chi), znstar_get_N(G));
    5213             : }
    5214             : static long
    5215       11760 : mfcharno(GEN CHI)
    5216             : {
    5217       11760 :   GEN n = znconreyexp(gel(CHI,1), gel(CHI,2));
    5218       11760 :   return itou(n);
    5219             : }
    5220             : 
    5221             : /* return k such that minimal mfcharacter in Galois orbit of CHI is CHI^k */
    5222             : static long
    5223       10773 : mfconreyminimize(GEN CHI)
    5224             : {
    5225       10773 :   GEN G = gel(CHI,1), cyc, chi;
    5226       10773 :   cyc = ZV_to_zv(znstar_get_cyc(G));
    5227       10773 :   chi = ZV_to_zv(znconreychar(G, gel(CHI,2)));
    5228       10773 :   return zv_cyc_minimize(cyc, chi, coprimes_zv(mfcharorder(CHI)));
    5229             : }
    5230             : 
    5231             : /* find scalar c such that first non-0 entry of c*v is 1; return c*v
    5232             :  * (set c = NULL for 1) */
    5233             : static GEN
    5234        1435 : RgV_normalize(GEN v, GEN *pc)
    5235             : {
    5236        1435 :   long i, l = lg(v);
    5237        1435 :   *pc = NULL;
    5238        3395 :   for (i = 1; i < l; i++)
    5239             :   {
    5240        3395 :     GEN c = gel(v,i);
    5241        3395 :     if (!gequal0(c))
    5242             :     {
    5243        1435 :       if (gequal1(c)) { *pc = gen_1; return v; }
    5244         392 :       *pc = ginv(c); return RgV_Rg_mul(v, *pc);
    5245             :     }
    5246             :   }
    5247           0 :   return v;
    5248             : }
    5249             : /* ordchi != 2 mod 4 */
    5250             : static GEN
    5251        2212 : mftreatdihedral(GEN DIH, GEN POLCYC, long ordchi, long biglim, GEN *pS)
    5252             : {
    5253             :   GEN M, Minv, C;
    5254             :   long l, i;
    5255        2212 :   l = lg(DIH); if (l == 1) return NULL;
    5256        2212 :   if (!pS) return DIH;
    5257         686 :   C = cgetg(l, t_VEC);
    5258         686 :   M = cgetg(l, t_MAT);
    5259        1904 :   for (i = 1; i < l; i++)
    5260             :   {
    5261        1218 :     GEN c, v = mfcoefs_i(gel(DIH,i), biglim, 1);
    5262        1218 :     gel(M,i) = RgV_normalize(v, &c);
    5263        1218 :     gel(C,i) = Rg_col_ei(c, l-1, i);
    5264             :   }
    5265         686 :   Minv = gel(mfclean(M,POLCYC,ordchi,0),2);
    5266         686 :   M = RgM_Minv_mul(M, Minv);
    5267         686 :   C = RgM_Minv_mul(C, Minv);
    5268         686 :   *pS = vecmflinear(DIH, C);
    5269         686 :   return M;
    5270             : }
    5271             : 
    5272             : static GEN
    5273          98 : mfstabiter(GEN M, GEN A2, GEN E1inv, long lim, GEN P, long ordchi)
    5274             : {
    5275             :   GEN A, VC, con;
    5276          98 :   E1inv = primitive_part(E1inv, &con);
    5277          98 :   VC = con? ginv(con): gen_1;
    5278          98 :   A = mfmatsermul(A2, E1inv);
    5279             :   while(1)
    5280             :   {
    5281         154 :     GEN R = shallowconcat(RgM_mul(M,A), rowslice(A,1,lim));
    5282         154 :     GEN B = QabM_ker(R, P, ordchi);
    5283         154 :     long lA = lg(A), lB = lg(B);
    5284         154 :     if (lB == 1) return NULL;
    5285         154 :     if (lB == lA) return mkvec2(A, VC);
    5286          56 :     B = rowslice(B, 1, lA-1);
    5287          56 :     if (ordchi != 1) B = gmodulo(B, P);
    5288          56 :     A = Q_primitive_part(RgM_mul(A,B), &con);
    5289          56 :     VC = gmul(VC,B); /* first VC is a scalar, then a RgM */
    5290          56 :     if (con) VC = RgM_Rg_div(VC, con);
    5291          56 :   }
    5292             : }
    5293             : static long
    5294          98 : mfstabitermodp(GEN Mp, GEN Ap, long p, long lim)
    5295             : {
    5296          98 :   GEN VC = NULL;
    5297             :   while (1)
    5298             :   {
    5299         105 :     GEN Rp = shallowconcat(Flm_mul(Mp,Ap,p), rowslice(Ap,1,lim));
    5300         105 :     GEN Bp = Flm_ker(Rp, p);
    5301         105 :     long lA = lg(Ap), lB = lg(Bp);
    5302         105 :     if (lB == 1) return 0;
    5303         105 :     if (lB == lA) return lA-1;
    5304           7 :     Bp = rowslice(Bp, 1, lA-1);
    5305           7 :     Ap = Flm_mul(Ap, Bp, p);
    5306           7 :     VC = VC? Flm_mul(VC, Bp, p): Bp;
    5307           7 :   }
    5308             : }
    5309             : 
    5310             : static GEN
    5311         175 : mfintereis(GEN A, GEN M2, GEN y, GEN den, GEN E2, GEN P, long ordchi)
    5312             : {
    5313         175 :   GEN z, M1 = mfmatsermul(A,E2), M1den = is_pm1(den)? M1: RgM_Rg_mul(M1,den);
    5314         175 :   M2 = RgM_mul(M2, rowpermute(M1, y));
    5315         175 :   z = QabM_ker(RgM_sub(M2,M1den), P, ordchi);
    5316         175 :   if (ordchi != 1) z = gmodulo(z, P);
    5317         175 :   return mkvec2(RgM_mul(A,z), z);
    5318             : }
    5319             : static GEN
    5320         182 : mfintereismodp(GEN A, GEN M2, GEN E2, ulong p)
    5321             : {
    5322         182 :   GEN M1 = mfmatsermul_Fl(A, E2, p), z;
    5323         182 :   long j, lx = lg(A);
    5324         182 :   z = Flm_ker(shallowconcat(M1, M2), p);
    5325         182 :   for (j = lg(z) - 1; j; j--) setlg(z[j], lx);
    5326         182 :   return mkvec2(Flm_mul(A,z,p), z);
    5327             : }
    5328             : 
    5329             : static GEN
    5330         105 : mfcharinv_i(GEN CHI)
    5331             : {
    5332         105 :   GEN G = gel(CHI,1);
    5333         105 :   CHI = leafcopy(CHI); gel(CHI,2) =  zncharconj(G, gel(CHI,2)); return CHI;
    5334             : }
    5335             : 
    5336             : /* upper bound dim S_1(Gamma_0(N),chi) performing the linear algebra mod p */
    5337             : static long
    5338         105 : mfwt1dimmodp(GEN A, GEN ES, GEN M, long ordchi, long dih, long lim)
    5339             : {
    5340             :   GEN Ap, ApF, ES1p, VC;
    5341         105 :   ulong p, r = QabM_init(ordchi, &p);
    5342             : 
    5343         105 :   ApF = Ap = QabM_to_Flm(A, r, p);
    5344         105 :   VC = NULL;
    5345         105 :   ES1p = QabX_to_Flx(gel(ES,1), r, p);
    5346         105 :   if (lg(ES) >= 3)
    5347             :   {
    5348          98 :     GEN M2 = mfmatsermul_Fl(ApF, ES1p, p);
    5349          98 :     pari_sp av = avma;
    5350             :     long i;
    5351         273 :     for (i = 2; i < lg(ES); i++)
    5352             :     {
    5353         182 :       GEN ESip = QabX_to_Flx(gel(ES,i), r, p);
    5354         182 :       GEN C, ApC = mfintereismodp(Ap, M2, ESip, p);
    5355         182 :       Ap = gel(ApC,1);
    5356         182 :       if (lg(Ap)-1 == dih) return dih;
    5357         175 :       C = gel(ApC,2); VC = VC? Flm_mul(VC, C, p): C;
    5358         175 :       gerepileall(av, 2, &Ap,&VC);
    5359             :     }
    5360             :   }
    5361             :   /* intersection of Eisenstein series quotients non empty: use Schaeffer */
    5362          98 :   Ap = mfmatsermul_Fl(Ap, Flxn_inv(ES1p,nbrows(Ap),p), p);
    5363          98 :   return mfstabitermodp(QabM_to_Flm(M,r,p), Ap, p, lim);
    5364             : }
    5365             : 
    5366             : /* Compute the full S_1(\G_0(N),\chi). If pS is NULL, only the dimension
    5367             :  * dim, in the form of a vector having dim components. Otherwise output
    5368             :  * a basis: ptvf contains a pointer to the vector of forms, and the
    5369             :  * program returns the corresponding matrix of Fourier expansions.
    5370             :  * ptdimdih gives the dimension of the subspace generated by dihedral forms;
    5371             :  * TMP is from mfwt1_pre or NULL. */
    5372             : static GEN
    5373       10290 : mfwt1basis(long N, GEN CHI, GEN TMP, GEN *pS, long *ptdimdih)
    5374             : {
    5375             :   GEN ES, mf, A, M, Tp, tmp1, tmp2, den;
    5376             :   GEN S, ESA, VC, C, POLCYC, ES1, ES1INV, DIH, a0, a0i;
    5377             :   long plim, lim, biglim, i, p, dA, dimp, ordchi, dih;
    5378             : 
    5379       10290 :   if (ptdimdih) *ptdimdih = 0;
    5380       10290 :   if (pS) *pS = NULL;
    5381       10290 :   if (wt1empty(N) || mfcharparity(CHI) != -1) return NULL;
    5382       10115 :   ordchi = mfcharorder_canon(CHI);
    5383       10115 :   if (uisprime(N) && ordchi > 4) return NULL;
    5384       10087 :   if (!pS)
    5385             :   {
    5386        6867 :     dih = mfdihedralcuspdim(N, CHI);
    5387        6867 :     DIH = zerovec(dih);
    5388             :   }
    5389             :   else
    5390             :   {
    5391        3220 :     DIH = mfdihedralcusp(N, CHI);
    5392        3220 :     dih = lg(DIH) - 1;
    5393             :   }
    5394       10087 :   POLCYC = (ordchi == 1)? NULL: mfcharpol(CHI);
    5395       10087 :   if (ptdimdih) *ptdimdih = dih;
    5396       10087 :   biglim = mfsturmNk(N, 2);
    5397       10087 :   if (N <= 600) switch(N)
    5398             :   {
    5399             :     long m;
    5400             :     case 219: case 273: case 283: case 331: case 333: case 344: case 416:
    5401             :     case 438: case 468: case 491: case 504: case 546: case 553: case 563:
    5402             :     case 566: case 581: case 592:
    5403          14 :       break; /* one chi with both exotic and dihedral forms */
    5404             :     default: /* only dihedral forms */
    5405        9247 :       if (!dih) return NULL;
    5406             :       /* fall through */
    5407             :     case 124: case 133: case 148: case 171: case 201: case 209: case 224:
    5408             :     case 229: case 248: case 261: case 266: case 288: case 296: case 301:
    5409             :     case 309: case 325: case 342: case 371: case 372: case 380: case 399:
    5410             :     case 402: case 403: case 404: case 408: case 418: case 432: case 444:
    5411             :     case 448: case 451: case 453: case 458: case 496: case 497: case 513:
    5412             :     case 522: case 527: case 532: case 576: case 579:
    5413             :       /* no chi with both exotic and dihedral; one chi with exotic forms */
    5414        2926 :       if (dih) return mftreatdihedral(DIH, POLCYC, ordchi, biglim, pS);
    5415         721 :       m = mfcharno(CHI);
    5416         721 :       if (N == 124 && (m != 67 && m != 87)) return NULL;
    5417         595 :       if (N == 133 && (m != 83 && m !=125)) return NULL;
    5418         301 :       if (N == 148 && (m !=105 && m !=117)) return NULL;
    5419         175 :       if (N == 171 && (m != 94 && m !=151)) return NULL;
    5420         175 :       if (N == 201 && (m != 29 && m !=104)) return NULL;
    5421         175 :       if (N == 209 && (m != 87 && m !=197)) return NULL;
    5422         175 :       if (N == 224 && (m != 95 && m !=191)) return NULL;
    5423         175 :       if (N == 229 && (m !=107 && m !=122)) return NULL;
    5424         175 :       if (N == 248 && (m != 87 && m !=191)) return NULL;
    5425          84 :       if (N == 261 && (m != 46 && m !=244)) return NULL;
    5426          84 :       if (N == 266 && (m != 83 && m !=125)) return NULL;
    5427          84 :       if (N == 288 && (m != 31 && m !=223)) return NULL;
    5428          84 :       if (N == 296 && (m !=105 && m !=265)) return NULL;
    5429             :   }
    5430         105 :   if (!TMP) TMP = mfwt1_pre(N);
    5431         105 :   tmp1= gel(TMP,1); lim = tmp1[1]; p = tmp1[2]; plim = p*lim;
    5432         105 :   mf  = gel(TMP,2);
    5433         105 :   A   = gel(TMP,3); /* p*lim x dim matrix */
    5434         105 :   S = MF_get_S(mf);
    5435         105 :   ESA = mfeisensteinbasis(N, 1, mfcharinv_i(CHI));
    5436         105 :   ES = RgM_to_RgXV(mfvectomat(ESA, plim+1, 1), 0);
    5437         105 :   ES1 = gel(ES,1); /* does not vanish at oo */
    5438         105 :   Tp = Tpmat(p, lim, CHI);
    5439         105 :   dimp = mfwt1dimmodp(A, ES, Tp, ordchi, dih, lim);
    5440         105 :   if (!dimp) return NULL;
    5441         105 :   if (dimp == dih) return mftreatdihedral(DIH, POLCYC, ordchi, biglim, pS);
    5442          98 :   VC = gen_1;
    5443          98 :   if (lg(ES) >= 3)
    5444             :   {
    5445             :     pari_sp btop;
    5446          91 :     long lim2 = (3*lim)/2 + 1;
    5447          91 :     GEN Ash = rowslice(A, 1, lim2), M2 = mfmatsermul(Ash, ES1);
    5448             :     GEN v, y, M2M2I, M2I;
    5449          91 :     M2I = QabM_pseudoinv(M2, POLCYC, ordchi, &v, &den);
    5450          91 :     y = gel(v,1);
    5451          91 :     M2M2I = RgM_mul(M2,M2I);
    5452          91 :     btop = avma;
    5453         266 :     for (i = 2; i < lg(ES); i++)
    5454             :     {
    5455         175 :       GEN APC = mfintereis(Ash, M2M2I, y, den, gel(ES,i), POLCYC,ordchi);
    5456         175 :       Ash = gel(APC,1); if (lg(Ash) == 1) return NULL;
    5457         175 :       VC = gmul(VC, gel(APC,2));
    5458         175 :       if (gc_needed(btop, 1))
    5459             :       {
    5460           6 :         if (DEBUGMEM > 1) pari_warn(warnmem,"mfwt1basis i = %ld", i);
    5461           6 :         gerepileall(btop, 2, &Ash, &VC);
    5462             :       }
    5463             :     }
    5464          91 :     A = RgM_mul(A, vecslice(VC,1, lg(Ash)-1));
    5465             :   }
    5466          98 :   a0 = gel(ES1,2); /* non-zero */
    5467          98 :   if (gequal1(a0)) a0 = a0i = NULL;
    5468             :   else
    5469             :   {
    5470          98 :     a0i = ginv(a0);
    5471          98 :     ES1 = RgX_Rg_mul(RgX_unscale(ES1,a0), a0i);
    5472             :   }
    5473          98 :   ES1INV = RgXn_inv(ES1, plim-1);
    5474          98 :   if (a0) ES1INV = RgX_Rg_mul(RgX_unscale(ES1INV, a0i), a0i);
    5475          98 :   tmp2 = mfstabiter(Tp, A, ES1INV, lim, POLCYC, ordchi);
    5476          98 :   if (!tmp2) return NULL;
    5477          98 :   A = gel(tmp2,1); dA = lg(A);
    5478          98 :   VC = gmul(VC, gel(tmp2,2));
    5479          98 :   C = cgetg(dA, t_VEC);
    5480          98 :   M = cgetg(dA, t_MAT);
    5481         315 :   for (i = 1; i < dA; i++)
    5482             :   {
    5483         217 :     GEN c, v = gel(A,i);
    5484         217 :     gel(M,i) = RgV_normalize(v, &c);
    5485         217 :     gel(C,i) = RgC_Rg_mul(gel(VC,i), c);
    5486             :   }
    5487          98 :   if (pS)
    5488             :   {
    5489          56 :     GEN Minv = gel(mfclean(M, POLCYC, ordchi, 0), 2);
    5490          56 :     M = RgM_Minv_mul(M, Minv);
    5491          56 :     C = RgM_Minv_mul(C, Minv);
    5492          56 :     *pS = vecmflineardiv0(S, C, gel(ESA,1));
    5493             :   }
    5494          98 :   return M;
    5495             : }
    5496             : 
    5497             : static void
    5498          70 : mf_set_space(GEN mf, long x) { gmael(mf,1,4) = utoi(x); }
    5499             : static GEN
    5500          70 : mfwt1_cusptonew(GEN mf)
    5501             : {
    5502          70 :   const long vy = 1;
    5503          70 :   GEN vP, F, S, Snew, vF, v = split(mf);
    5504             :   long i, lP, dSnew, ct;
    5505             : 
    5506          70 :   F = gel(v,1);
    5507          70 :   vP= gel(v,2); lP = lg(vP);
    5508          70 :   if (lP == 1) { obj_insert(mf, MF_SPLIT, v); return NULL; }
    5509          70 :   mf_set_space(mf, mf_NEW);
    5510          70 :   S = MF_get_S(mf);
    5511          70 :   dSnew = 0;
    5512          70 :   for (i = 1; i < lP; i++) dSnew += degpol(gel(vP,i));
    5513          70 :   Snew = cgetg(dSnew + 1, t_VEC); ct = 0;
    5514          70 :   vF = cgetg(lP, t_VEC);
    5515         147 :   for (i = 1; i < lP; i++)
    5516             :   {
    5517          77 :     GEN V, P = gel(vP,i), f = liftpol_shallow(gel(F,i));
    5518          77 :     long j, d = degpol(P);
    5519          77 :     gel(vF,i) = V = zerovec(dSnew);
    5520          77 :     if (d == 1)
    5521             :     {
    5522          56 :       gel(Snew, ct+1) = mflineardiv_linear(S, f, 0);
    5523          56 :       gel(V, ct+1) = gen_1;
    5524             :     }
    5525             :     else
    5526             :     {
    5527          21 :       f = RgXV_to_RgM(f,d);
    5528          70 :       for (j = 1; j <= d; j++)
    5529             :       {
    5530          49 :         gel(Snew, ct+j) = mflineardiv_linear(S, row(f,j), 0);
    5531          49 :         gel(V, ct+j) = mkpolmod(pol_xn(j-1,vy), P);
    5532             :       }
    5533             :     }
    5534          77 :     ct += d;
    5535             :   }
    5536          70 :   obj_insert(mf, MF_SPLIT, mkvec2(vF, vP));
    5537          70 :   gel(mf,3) = Snew; return mf;
    5538             : }
    5539             : static GEN
    5540        3304 : mfwt1init(long N, GEN CHI, GEN TMP, long space, long flraw)
    5541             : {
    5542        3304 :   GEN mf, mf1, S, M = mfwt1basis(N, CHI, TMP, &S, NULL);
    5543        3304 :   if (!M) return NULL;
    5544         742 :   mf1 = mkvec4(stoi(N), gen_1, CHI, utoi(mf_CUSP));
    5545         742 :   mf = mkmf(mf1, cgetg(1,t_VEC), S, gen_0, NULL);
    5546         742 :   if (space == mf_NEW)
    5547             :   {
    5548          70 :     gel(mf,5) = mfcleanCHI(M,CHI, 0);
    5549          70 :     mf = mfwt1_cusptonew(mf); if (!mf) return NULL;
    5550          70 :     if (!flraw) M = mfcoefs_mf(mf, mfsturmNk(N,1)+1, 1);
    5551             :   }
    5552         742 :   gel(mf,5) = flraw? zerovec(3): mfcleanCHI(M, CHI, 0);
    5553         742 :   return mf;
    5554             : }
    5555             : 
    5556             : static GEN
    5557         917 : mfEMPTY(GEN mf1)
    5558             : {
    5559         917 :   GEN Minv = mkMinv(cgetg(1,t_MAT), NULL,NULL,NULL);
    5560         917 :   GEN M = mkvec3(cgetg(1,t_VECSMALL), Minv, cgetg(1,t_MAT));
    5561         917 :   return mkmf(mf1, cgetg(1,t_VEC), cgetg(1,t_VEC), cgetg(1,t_VEC), M);
    5562             : }
    5563             : static GEN
    5564         616 : mfEMPTYall(long N, GEN gk, GEN vCHI, long space)
    5565             : {
    5566             :   long i, l;
    5567             :   GEN v, gN, gs;
    5568         616 :   if (!vCHI) return cgetg(1, t_VEC);
    5569          14 :   gN = utoipos(N); gs = utoi(space);
    5570          14 :   l = lg(vCHI); v = cgetg(l, t_VEC);
    5571          14 :   for (i = 1; i < l; i++) gel(v,i) = mfEMPTY(mkvec4(gN,gk,gel(vCHI,i),gs));
    5572          14 :   return v;
    5573             : }
    5574             : 
    5575             : static GEN
    5576        3983 : fmt_dim(GEN CHI, long d, long dih)
    5577        3983 : { return mkvec4(gmfcharorder(CHI), gmfcharno(CHI), utoi(d), stoi(dih)); }
    5578             : /* merge two vector of fmt_dim's for the same vector of characters. If CHI
    5579             :  * is not NULL, remove dim-0 spaces and add character from CHI */
    5580             : static GEN
    5581           7 : merge_dims(GEN V, GEN W, GEN CHI)
    5582             : {
    5583           7 :   long i, j, id, l = lg(V);
    5584           7 :   GEN A = cgetg(l, t_VEC);
    5585           7 :   if (l == 1) return A;
    5586           7 :   id = CHI? 1: 3;
    5587          21 :   for (i = j = 1; i < l; i++)
    5588             :   {
    5589          14 :     GEN v = gel(V,i), w = gel(W,i);
    5590          14 :     long dv = itou(gel(v,id)), dvh = itou(gel(v,id+1)), d;
    5591          14 :     long dw = itou(gel(w,id)), dwh = itou(gel(w,id+1));
    5592          14 :     d = dv + dw;
    5593          14 :     if (d || CHI)
    5594          42 :       gel(A,j++) = CHI? fmt_dim(gel(CHI,i),d, dvh+dwh)
    5595          28 :                       : mkvec2s(d,dvh+dwh);
    5596             :   }
    5597           7 :   setlg(A, j); return A;
    5598             : }
    5599             : static GEN
    5600        3010 : mfdim0all(GEN w)
    5601             : {
    5602        3010 :   if (w) retconst_vec(lg(w)-1, zerovec(2));
    5603        3003 :   return cgetg(1,t_VEC);
    5604             : }
    5605             : static long
    5606        6986 : mfwt1cuspdim_i(long N, GEN CHI, GEN TMP, long *dih)
    5607             : {
    5608        6986 :   pari_sp av = avma;
    5609        6986 :   GEN b = mfwt1basis(N, CHI, TMP, NULL, dih);
    5610        6986 :   avma = av; return b? lg(b)-1: 0;
    5611             : }
    5612             : static long
    5613         133 : mfwt1cuspdim(long N, GEN CHI) { return mfwt1cuspdim_i(N, CHI, NULL, NULL); }
    5614             : static GEN
    5615        4144 : mfwt1cuspdimall(long N, GEN vCHI)
    5616             : {
    5617             :   GEN z, TMP, w;
    5618             :   long i, j, l;
    5619        4144 :   if (wt1empty(N)) return mfdim0all(vCHI);
    5620        1141 :   w = mfwt1chars(N,vCHI);
    5621        1141 :   l = lg(w); if (l == 1) return cgetg(1,t_VEC);
    5622        1141 :   z = cgetg(l, t_VEC);
    5623        1141 :   TMP = mfwt1_pre(N);
    5624        7861 :   for (i = j = 1; i < l; i++)
    5625             :   {
    5626        6720 :     GEN CHI = gel(w,i);
    5627        6720 :     long dih, d = mfwt1cuspdim_i(N, CHI, TMP, &dih);
    5628        6720 :     if (vCHI)
    5629          42 :       gel(z,j++) = mkvec2s(d, dih);
    5630        6678 :     else if (d)
    5631        1428 :       gel(z,j++) = fmt_dim(CHI, d, dih);
    5632             :   }
    5633        1141 :   setlg(z,j); return z;
    5634             : }
    5635             : 
    5636             : /* dimension of S_1(Gamma_1(N)) */
    5637             : static long
    5638        4123 : mfwt1cuspdimsum(long N)
    5639             : {
    5640        4123 :   pari_sp av = avma;
    5641        4123 :   GEN v = mfwt1cuspdimall(N, NULL);
    5642        4123 :   long i, ct = 0, l = lg(v);
    5643        5544 :   for (i = 1; i < l; i++)
    5644             :   {
    5645        1421 :     GEN w = gel(v,i); /* [ord(CHI),*,dim,*] */
    5646        1421 :     ct += itou(gel(w,3))*myeulerphiu(itou(gel(w,1)));
    5647             :   }
    5648        4123 :   avma = av; return ct;
    5649             : }
    5650             : 
    5651             : static GEN
    5652          56 : mfwt1newdimall(long N, GEN vCHI)
    5653             : {
    5654             :   GEN z, w, vTMP;
    5655             :   long i, c, lw;
    5656          56 :   if (wt1empty(N)) return mfdim0all(vCHI);
    5657          56 :   w = mfwt1chars(N,vCHI);
    5658          56 :   lw = lg(w); if (lw == 1) return cgetg(1,t_VEC);
    5659          56 :   vTMP = const_vec(N, NULL);
    5660          56 :   gel(vTMP,N) = mfwt1_pre(N);
    5661          56 :   z = cgetg(lw, t_VEC);
    5662         182 :   for (i = c = 1; i < lw; i++)
    5663             :   {
    5664             :     long j, l, F, dihnew;
    5665         126 :     GEN D, CHI = gel(w,i), CHIP = mfchartoprimitive(CHI,&F);
    5666         126 :     long S = mfwt1cuspdim_i(N, CHI, gel(vTMP,N), &dihnew);
    5667         126 :     if (!S)
    5668             :     {
    5669          56 :       if (vCHI) gel(z, c++) = zerovec(2);
    5670          56 :       continue;
    5671             :     }
    5672          70 :     D = mydivisorsu(N/F); l = lg(D);
    5673          77 :     for (j = l-2; j > 0; j--) /* skip last M = N */
    5674             :     {
    5675           7 :       long M = D[j]*F, m, s, dih;
    5676           7 :       GEN TMP = gel(vTMP,M);
    5677           7 :       if (wt1empty(M) || !(m = mubeta(D[l-j]))) continue; /*m = mubeta(N/M)*/
    5678           7 :       if (!TMP) gel(vTMP,M) = TMP = mfwt1_pre(M);
    5679           7 :       s = mfwt1cuspdim_i(M, CHIP, TMP, &dih);
    5680           7 :       if (s) { S += m * s; dihnew += m * dih; }
    5681             :     }
    5682          70 :     if (vCHI)
    5683          63 :       gel(z,c++) = mkvec2s(S, dihnew);
    5684           7 :     else if (S)
    5685           7 :       gel(z, c++) = fmt_dim(CHI, S, dihnew);
    5686             :   }
    5687          56 :   setlg(z,c); return z;
    5688             : }
    5689             : 
    5690             : static GEN
    5691          28 : mfwt1olddimall(long N, GEN vCHI)
    5692             : {
    5693             :   long i, j, l;
    5694             :   GEN z, w;
    5695          28 :   if (wt1empty(N)) return mfdim0all(vCHI);
    5696          28 :   w = mfwt1chars(N,vCHI);
    5697          28 :   l = lg(w); z = cgetg(l, t_VEC);
    5698          84 :   for (i = j = 1; i < l; i++)
    5699             :   {
    5700          56 :     GEN CHI = gel(w,i);
    5701          56 :     long d = mfolddim(N, 1, CHI);
    5702          56 :     if (vCHI)
    5703          28 :       gel(z,j++) = mkvec2s(d,d?-1:0);
    5704          28 :     else if (d)
    5705           7 :       gel(z, j++) = fmt_dim(CHI, d, -1);
    5706             :   }
    5707          28 :   setlg(z,j); return z;
    5708             : }
    5709             : 
    5710             : static long
    5711         469 : mfwt1olddimsum(long N)
    5712             : {
    5713             :   GEN D;
    5714         469 :   long N2, i, l, S = 0;
    5715         469 :   newd_params(N, &N2); /* will ensure mubeta != 0 */
    5716         469 :   D = mydivisorsu(N/N2); l = lg(D);
    5717        2485 :   for (i = 2; i < l; i++)
    5718             :   {
    5719        2016 :     long M = D[l-i]*N2, d = mfwt1cuspdimsum(M);
    5720        2016 :     if (d) S -= mubeta(D[i]) * d;
    5721             :   }
    5722         469 :   return S;
    5723             : }
    5724             : static long
    5725        1050 : mfwt1newdimsum(long N)
    5726             : {
    5727        1050 :   long S = mfwt1cuspdimsum(N);
    5728        1050 :   return S? S - mfwt1olddimsum(N): 0;
    5729             : }
    5730             : 
    5731             : /* Guess Galois type of wt1 eigenforms. */
    5732             : /* NK can be mf or [N,1,CHI] */
    5733             : static long
    5734          42 : mfisdihedral(GEN F, GEN DIH)
    5735             : {
    5736          42 :   GEN vG = gel(DIH,1), M = gel(DIH,2), v;
    5737             :   long i, l;
    5738          42 :   if (lg(M) == 1) return 0;
    5739          21 :   v = RgM_RgC_invimage(M, mftocol(F, nbrows(M)-1, 1));
    5740          21 :   if (!v) return 0;
    5741          21 :   l = lg(v);
    5742          21 :   for (i = 1; i < l; i++)
    5743          21 :     if (!gequal0(gel(v,i)))
    5744             :     {
    5745          21 :       GEN G = gel(vG,i), bnr = gel(G,2), w = gel(G,3);
    5746          21 :       GEN gen, cyc = bnr_get_cyc(bnr), D = gel(cyc,1);
    5747          21 :       GEN f = bnr_get_mod(bnr), nf = bnr_get_nf(bnr);
    5748          21 :       GEN con = gel(galoisconj(nf,gen_1), 2);
    5749          21 :       GEN f0 = gel(f,1), f0b = galoisapply(nf, con, f0);
    5750          21 :       GEN xin = zv_to_ZV(gel(w,2)); /* xi(bnr.gen[i]) = e(xin[i] / D) */
    5751             :       long e, j, L, n;
    5752          21 :       if (!gequal(f0,f0b))
    5753             :       { /* finite part of conductor not ambiguous */
    5754          14 :         GEN a = idealmul(nf, f0, idealdivexact(nf, f0b, idealadd(nf, f0, f0b)));
    5755          14 :         GEN bnr0 = bnr;
    5756          14 :         bnr = bnrinit0(bnr_get_bnf(bnr), mkvec2(a, gel(f,2)), 1);
    5757          14 :         xin = RgV_RgM_mul(xin, bnrsurjection(bnr, bnr0));
    5758             :         /* still xi(gen[i]) = e(xin[i] / D), for the new generators */
    5759             :       }
    5760          21 :       gen = bnr_get_gen(bnr); L = lg(gen);
    5761          35 :       for (j = 1, e = itou(D); j < L; j++)
    5762             :       {
    5763          28 :         GEN Ng = idealnorm(nf, gel(gen,j));
    5764          28 :         GEN a = shifti(gel(xin,j), 1); /* xi(g_j^2) = e(a/D) */
    5765          28 :         GEN b = FpV_dotproduct(xin, isprincipalray(bnr,Ng), D);
    5766          28 :         GEN m = Fp_sub(a, b, D); /* xi(g_j/\bar{g_j}) = e(m/D) */
    5767          28 :         e = ugcd(e, itou(m)); if (e == 1) break;
    5768             :       }
    5769          21 :       n = itou(D) / e;
    5770          21 :       return n == 1? 4: 2*n;
    5771             :     }
    5772           0 :   return 0;
    5773             : }
    5774             : 
    5775             : static ulong
    5776          21 : radical_u(ulong n)
    5777          21 : { return zv_prod(gel(myfactoru(n),1)); }
    5778             : 
    5779             : /* list of fundamental discriminants unramified outside N, with sign s
    5780             :  * [s = 0 => no sign condition] */
    5781             : static GEN
    5782          21 : mfunram(long N, long s)
    5783             : {
    5784          21 :   long cN = radical_u(N >> vals(N)), p = 1, m = 1, l, c, i;
    5785          21 :   GEN D = mydivisorsu(cN), res;
    5786          21 :   l = lg(D);
    5787          21 :   if (s == 1) m = 0; else if (s == -1) p = 0;
    5788          21 :   res = cgetg(6*l - 5, t_VECSMALL);
    5789          21 :   c = 1;
    5790          21 :   if (!odd(N))
    5791             :   { /* d = 1 */
    5792          14 :     if (p) res[c++] = 8;
    5793          14 :     if (m) { res[c++] =-8; res[c++] =-4; }
    5794             :   }
    5795          56 :   for (i = 2; i < l; i++)
    5796             :   { /* skip d = 1, done above */
    5797          35 :     long d = D[i], d4 = d & 3L; /* d odd, squarefree, d4 = 1 or 3 */
    5798          35 :     if (d4 == 1) { if (p) res[c++] = d; }
    5799          28 :     else         { if (m) res[c++] =-d; }
    5800          35 :     if (!odd(N))
    5801             :     {
    5802          14 :       if (p) { res[c++] = 8*d; if (d4 == 3) res[c++] = 4*d; }
    5803          14 :       if (m) { res[c++] =-8*d; if (d4 == 1) res[c++] =-4*d; }
    5804             :     }
    5805             :   }
    5806          21 :   setlg(res, c); return res;
    5807             : }
    5808             : 
    5809             : /* Return 1 if F is definitely not S4 type; return 0 on failure. */
    5810             : static long
    5811           7 : mfisnotS4(long N, GEN w)
    5812             : {
    5813           7 :   GEN D = mfunram(N, 0);
    5814           7 :   long i, lD = lg(D), lw = lg(w);
    5815          56 :   for (i = 1; i < lD; i++)
    5816             :   {
    5817          49 :     long p, d = D[i], ok = 0;
    5818         154 :     for (p = 2; p < lw; p++)
    5819         154 :       if (w[p] && kross(d,p) == -1) { ok = 1; break; }
    5820          49 :     if (!ok) return 0;
    5821             :   }
    5822           7 :   return 1;
    5823             : }
    5824             : 
    5825             : /* Return 1 if Q(sqrt(5)) \not\subset Q(F), i.e. F is definitely not A5 type;
    5826             :  * return 0 on failure. */
    5827             : static long
    5828           7 : mfisnotA5(GEN F)
    5829             : {
    5830           7 :   GEN CHI = mf_get_CHI(F), P = mfcharpol(CHI), T, Q;
    5831             : 
    5832           7 :   if (mfcharorder(CHI) % 5 == 0) return 0;
    5833           7 :   T = mf_get_field(F); if (degpol(T) == 1) return 1;
    5834           7 :   if (degpol(P) > 1) T = rnfequation(P,T);
    5835           7 :   Q = gsubgs(pol_xn(2,varn(T)), 5);
    5836           7 :   return (typ(nfisincl(Q, T)) == t_INT);
    5837             : }
    5838             : 
    5839             : /* Given x = z + 1/z with z prim. root of unity of order n, find n */
    5840             : static long
    5841         357 : mffindrootof1(GEN u1)
    5842             : {
    5843         357 :   pari_sp av = avma;
    5844         357 :   GEN u0 = gen_2, u1k = u1, u2;
    5845         357 :   long c = 1;
    5846        1379 :   while (!gequalsg(2, liftpol_shallow(u1))) /* u1 = z^c + z^-c */
    5847             :   {
    5848         665 :     u2 = gsub(gmul(u1k, u1), u0);
    5849         665 :     u0 = u1; u1 = u2; c++;
    5850             :   }
    5851         357 :   avma = av; return c;
    5852             : }
    5853             : 
    5854             : /* we known that F is not dihedral */
    5855             : static long
    5856          21 : mfgaloistype_i(long N, GEN CHI, GEN F, long lim)
    5857             : {
    5858             :   forprime_t iter;
    5859          21 :   GEN v = mfcoefs_i(F,lim,1), w = zero_zv(lim);
    5860             :   ulong p;
    5861          21 :   u_forprime_init(&iter, 2, lim);
    5862         406 :   while((p = u_forprime_next(&iter)))
    5863             :   {
    5864             :     GEN u;
    5865             :     long n;
    5866         378 :     if (!(N%p)) continue;
    5867         357 :     u = gdiv(gsqr(gel(v, p+1)), mfchareval_i(CHI, p));
    5868         357 :     n = mffindrootof1(gsubgs(u,2));
    5869         357 :     if (n == 3) w[p] = 1;
    5870         357 :     if (n == 4) return -24; /* S4 */
    5871         350 :     if (n == 5) return -60; /* A5 */
    5872         350 :     if (n > 5) pari_err_DOMAIN("mfgaloistype", "form", "not a",
    5873             :                                strtoGENstr("cuspidal eigenform"), F);
    5874             :   }
    5875           7 :   if (mfisnotS4(N,w) && mfisnotA5(F)) return -12; /* A4 */
    5876           0 :   return 0; /* FAILURE */
    5877             : }
    5878             : 
    5879             : static GEN
    5880          42 : mfgaloistype0(long N, GEN CHI, GEN F, GEN DIH, long lim)
    5881             : {
    5882          42 :   pari_sp av = avma;
    5883          42 :   long t = mfisdihedral(F, DIH);
    5884          42 :   avma = av;
    5885          42 :   if (t) return stoi(t);
    5886             :   for(;;)
    5887             :   {
    5888          21 :     t = mfgaloistype_i(N, CHI, F, lim);
    5889          14 :     avma = av; if (t) return stoi(t);
    5890           0 :     lim += lim >> 1;
    5891           0 :   }
    5892             : }
    5893             : 
    5894             : /* If f is NULL, give all the galoistypes, otherwise just for f */
    5895             : GEN
    5896          49 : mfgaloistype(GEN NK, GEN f)
    5897             : {
    5898          49 :   pari_sp av = avma;
    5899             :   GEN CHI, mf, T, F, DIH;
    5900             :   long N, k, lL, i, lim, SB;
    5901             : 
    5902          49 :   if (checkMF_i(NK))
    5903             :   {
    5904          14 :     mf = NK;
    5905          14 :     N = MF_get_N(mf);
    5906          14 :     k = MF_get_k(mf);
    5907          14 :     CHI = MF_get_CHI(mf);
    5908             :   }
    5909             :   else
    5910             :   {
    5911          35 :     checkNK(NK, &N, &k, &CHI, 0);
    5912          35 :     mf = f? NULL: mfinit_i(NK, mf_NEW);
    5913             :   }
    5914          49 :   if (k != 1) pari_err_DOMAIN("mfgaloistype", "k", "!=", gen_1, stoi(k));
    5915          49 :   SB = mfsturmNk(N,1) + 1;
    5916          49 :   lim = maxss(200, 3*SB);
    5917          49 :   DIH = mfdihedralnew(N,CHI);
    5918          49 :   DIH = mkvec2(DIH, mfvectomat(DIH,SB,1));
    5919          49 :   if (f) return gerepileuptoint(av, mfgaloistype0(N,CHI, f, DIH, lim));
    5920          42 :   F = mfeigenbasis(mf); lL = lg(F);
    5921          42 :   T = cgetg(lL, t_VEC);
    5922          42 :   for (i=1; i < lL; i++) gel(T,i) = mfgaloistype0(N,CHI, gel(F,i), DIH, lim);
    5923          42 :   return gerepileupto(av, T);
    5924             : }
    5925             : 
    5926             : /******************************************************************/
    5927             : /*                   Find all dihedral forms.                     */
    5928             : /******************************************************************/
    5929             : /* lim >= 2 */
    5930             : static void
    5931           7 : consttabdihedral(long lim)
    5932           7 : { cache_set(cache_DIH, mfdihedralall(mkvecsmall2(1,lim))); }
    5933             : 
    5934             : /* a ideal coprime to bnr modulus */
    5935             : static long
    5936       71393 : mfdiheval(GEN bnr, GEN w, GEN a)
    5937             : {
    5938       71393 :   GEN L, cycn = gel(w,1), chin = gel(w,2);
    5939       71393 :   long ordmax = cycn[1];
    5940       71393 :   L = ZV_to_Flv(isprincipalray(bnr,a), ordmax);
    5941       71393 :   return Flv_dotproduct(chin, L, ordmax);
    5942             : }
    5943             : 
    5944             : /* A(x^k) mod T */
    5945             : static GEN
    5946       25963 : Galois(GEN A, long k, GEN T)
    5947             : {
    5948       25963 :   if (typ(A) != t_POL) return A;
    5949        9793 :   return gmod(RgX_inflate(A, k), T);
    5950             : }
    5951             : static GEN
    5952         602 : vecGalois(GEN v, long k, GEN T)
    5953             : {
    5954             :   long i, l;
    5955         602 :   GEN w = cgetg_copy(v,&l);
    5956         602 :   for (i = 1; i < l; i++) gel(w,i) = Galois(gel(v,i), k, T);
    5957         602 :   return w;
    5958             : }
    5959             : 
    5960             : static GEN
    5961      140686 : fix_pol(GEN S, GEN Pn, int *trace)
    5962             : {
    5963      140686 :   if (typ(S) != t_POL) return S;
    5964       97013 :   S = RgX_rem(S, Pn);
    5965       97013 :   if (typ(S) == t_POL)
    5966             :   {
    5967       97013 :     switch(lg(S))
    5968             :     {
    5969       35168 :       case 2: return gen_0;
    5970       15925 :       case 3: return gel(S,2);
    5971             :     }
    5972       45920 :     *trace = 1;
    5973             :   }
    5974       45920 :   return S;
    5975             : }
    5976             : 
    5977             : static GEN
    5978        9933 : dihan(GEN bnr, GEN w, GEN k0j, ulong lim)
    5979             : {
    5980        9933 :   GEN nf = bnr_get_nf(bnr), f = bid_get_ideal(bnr_get_bid(bnr));
    5981        9933 :   GEN v = zerovec(lim+1), cycn = gel(w,1), Tinit = gel(w,3);
    5982        9933 :   GEN Pn = gel(Tinit,lg(Tinit)==4? 2: 1);
    5983        9933 :   long j, ordmax = cycn[1], k0 = k0j[1], jdeg = k0j[2];
    5984        9933 :   long D = itos(nf_get_disc(nf)), vt = varn(Pn);
    5985        9933 :   int trace = 0;
    5986             :   ulong p, n;
    5987             :   forprime_t T;
    5988             : 
    5989        9933 :   gel(v,2) = gen_1;
    5990        9933 :   u_forprime_init(&T, 2, lim);
    5991             :   /* fill in prime powers first */
    5992        9933 :   while ((p = u_forprime_next(&T)))
    5993             :   {
    5994             :     GEN vP, vchiP, S;
    5995             :     long k, lP;
    5996             :     ulong q, qk;
    5997       65779 :     if (kross(D,p) >= 0) q = p;
    5998             :     else
    5999             :     {
    6000       27202 :       q = umuluu_or_0(p,p);
    6001       27202 :       if (!q || q > lim) continue;
    6002             :     }
    6003             :     /* q = Norm P */
    6004       43960 :     vP = idealprimedec(nf, utoipos(p));
    6005       43960 :     lP = lg(vP);
    6006       43960 :     vchiP = cgetg(lP, t_VECSMALL);
    6007      119098 :     for (j = k = 1; j < lP; j++)
    6008             :     {
    6009       75138 :       GEN P = gel(vP,j);
    6010       75138 :       if (!idealval(nf, f, P)) vchiP[k++] = mfdiheval(bnr,w,P);
    6011             :     }
    6012       43960 :     if (k == 1) continue;
    6013       42315 :     setlg(vchiP, k); lP = k;
    6014       42315 :     if (lP == 2)
    6015             :     { /* one prime above p not dividing f */
    6016       13237 :       long s, s0 = vchiP[1];
    6017       22729 :       for (qk=q, s = s0;; s = Fl_add(s,s0,ordmax))
    6018             :       {
    6019       22729 :         S = mygmodulo_lift(s, ordmax, gen_1, vt);
    6020       22729 :         gel(v, qk+1) = fix_pol(S, Pn, &trace);
    6021       22729 :         qk = umuluu_or_0(qk, q); if (!qk || qk > lim) break;
    6022        9492 :       }
    6023             :     }
    6024             :     else /* two primes above p not dividing f */
    6025             :     {
    6026       29078 :       long s, s0 = vchiP[1], s1 = vchiP[2];
    6027       43253 :       for (qk=q, k = 1;; k++)
    6028             :       { /* sum over a,b s.t. Norm( P1^a P2^b ) = q^k, i.e. a+b = k */
    6029             :         long a;
    6030       43253 :         GEN S = gen_0;
    6031      151214 :         for (a = 0; a <= k; a++)
    6032             :         {
    6033      107961 :           s = Fl_add(Fl_mul(a, s0, ordmax), Fl_mul(k-a, s1, ordmax), ordmax);
    6034      107961 :           S = gadd(S, mygmodulo_lift(s, ordmax, gen_1, vt));
    6035             :         }
    6036       43253 :         gel(v, qk+1) = fix_pol(S, Pn, &trace);
    6037       43253 :         qk = umuluu_or_0(qk, q); if (!qk || qk > lim) break;
    6038       14175 :       }
    6039             :     }
    6040             :   }
    6041             :   /* complete with non-prime powers */
    6042      183729 :   for (n = 2; n <= lim; n++)
    6043             :   {
    6044      173796 :     GEN S, fa = myfactoru(n), P = gel(fa, 1), E = gel(fa, 2);
    6045             :     long q;
    6046      173796 :     if (lg(P) == 2) continue;
    6047             :     /* not a prime power */
    6048       74704 :     q = upowuu(P[1],E[1]);
    6049       74704 :     S = gmul(gel(v, q + 1), gel(v, n/q + 1));
    6050       74704 :     gel(v, n+1) = fix_pol(S, Pn, &trace);
    6051             :   }
    6052        9933 :   if (trace)
    6053             :   {
    6054        4851 :     if (lg(Tinit) == 4) v = QabV_tracerel(Tinit, jdeg, v);
    6055             :     /* Apply Galois Mod(k0, ordw) */
    6056        4851 :     if (k0 > 1) { GEN Pm = gel(Tinit,1); v = vecGalois(v, k0, Pm); }
    6057             :   }
    6058        9933 :   return v;
    6059             : }
    6060             : 
    6061             : /* as cyc_normalize for t_VECSMALL cyc */
    6062             : static GEN
    6063       13391 : cyc_normalize_zv(GEN cyc)
    6064             : {
    6065       13391 :   long i, o = cyc[1], l = lg(cyc); /* > 1 */
    6066       13391 :   GEN D = cgetg(l, t_VECSMALL);
    6067       13391 :   D[1] = o; for (i = 2; i < l; i++) D[i] = o / cyc[i];
    6068       13391 :   return D;
    6069             : }
    6070             : /* as char_normalize for t_VECSMALLs */
    6071             : static GEN
    6072       58975 : char_normalize_zv(GEN chi, GEN ncyc)
    6073             : {
    6074       58975 :   long i, l = lg(chi);
    6075       58975 :   GEN c = cgetg(l, t_VECSMALL);
    6076       58975 :   if (l > 1) {
    6077       58975 :     c[1] = chi[1];
    6078       58975 :     for (i = 2; i < l; i++) c[i] = chi[i] * ncyc[i];
    6079             :   }
    6080       58975 :   return c;
    6081             : }
    6082             : 
    6083             : static GEN
    6084        6020 : dihan_bnf(long D)
    6085        6020 : { setrand(gen_1); return Buchall(quadpoly(stoi(D)), 0, LOWDEFAULTPREC); }
    6086             : static GEN
    6087       20307 : dihan_bnr(GEN bnf, GEN A)
    6088       20307 : { setrand(gen_1); return bnrinit0(bnf, A, 1); }
    6089             : 
    6090             : /* Hecke xi * (D/.) = Dirichlet chi, return v in Q^r st chi(g_i) = e(v[i]).
    6091             :  * cycn = cyc_normalize_zv(bnr.cyc), chin = char_normalize_zv(chi,cyc) */
    6092             : static GEN
    6093       17206 : bnrchartwist2conrey(GEN chin, GEN cycn, GEN bnrconreyN, GEN kroconreyN)
    6094             : {
    6095       17206 :   long l = lg(bnrconreyN), c1 = cycn[1], i;
    6096       17206 :   GEN v = cgetg(l, t_COL);
    6097       62566 :   for (i = 1; i < l; i++)
    6098             :   {
    6099       45360 :     GEN d = sstoQ(zv_dotproduct(chin, gel(bnrconreyN,i)), c1);
    6100       45360 :     if (kroconreyN[i] < 0) d = gadd(d, ghalf);
    6101       45360 :     gel(v,i) = d;
    6102             :   }
    6103       17206 :   return v;
    6104             : }
    6105             : 
    6106             : /* chi(g_i) = e(v[i]) denormalize wrt Conrey generators orders */
    6107             : static GEN
    6108       17206 : conreydenormalize(GEN znN, GEN v)
    6109             : {
    6110       17206 :   GEN gcyc = znstar_get_conreycyc(znN), w;
    6111       17206 :   long l = lg(v), i;
    6112       17206 :   w = cgetg(l, t_COL);
    6113       62566 :   for (i = 1; i < l; i++)
    6114       45360 :     gel(w,i) = modii(gmul(gel(v,i), gel(gcyc,i)), gel(gcyc,i));
    6115       17206 :   return w;
    6116             : }
    6117             : 
    6118             : static long
    6119       41769 : Miyake(GEN vchi, GEN gb, GEN cycn)
    6120             : {
    6121       41769 :   long i, e = cycn[1], lb = lg(gb);
    6122       41769 :   GEN v = char_normalize_zv(vchi, cycn);
    6123       62132 :   for (i = 1; i < lb; i++)
    6124       49833 :     if ((zv_dotproduct(v, gel(gb,i)) -  v[i]) % e) return 1;
    6125       12299 :   return 0;
    6126             : }
    6127             : 
    6128             : /* list of Hecke characters not induced by a Dirichlet character up to Galois
    6129             :  * conjugation, whose conductor is bnr.cond; cycn = cyc_normalize(bnr.cyc)*/
    6130             : static GEN
    6131       13391 : mklvchi(GEN bnr, GEN con, GEN cycn)
    6132             : {
    6133       13391 :   GEN gb = NULL, cyc = bnr_get_cyc(bnr), cycsmall = ZV_to_zv(cyc);
    6134       13391 :   GEN vchi = cyc2elts(cycsmall);
    6135       13391 :   long ordmax = cycsmall[1], c, i, l;
    6136       13391 :   if (con)
    6137             :   {
    6138        3892 :     GEN g = bnr_get_gen(bnr), nf = bnr_get_nf(bnr);
    6139        3892 :     long lg = lg(g);
    6140        3892 :     gb = cgetg(lg, t_VEC);
    6141        9135 :     for (i = 1; i < lg; i++)
    6142        5243 :       gel(gb,i) = ZV_to_zv(isprincipalray(bnr, galoisapply(nf, con, gel(g,i))));
    6143             :   }
    6144       13391 :   l = lg(vchi);
    6145      151725 :   for (i = c = 1; i < l; i++)
    6146             :   {
    6147      138334 :     GEN chi = gel(vchi,i);
    6148      138334 :     if (!con || Miyake(chi, gb, cycn)) gel(vchi, c++) = Flv_to_ZV(chi);
    6149             :   }
    6150       13391 :   setlg(vchi, c); l = c;
    6151      139426 :   for (i = 1; i < l; i++)
    6152             :   {
    6153      126035 :     GEN chi = gel(vchi,i);
    6154             :     long n;
    6155      126035 :     if (!chi) continue;
    6156      527289 :     for (n = 2; n < ordmax; n++)
    6157      482748 :       if (cgcd(n, ordmax) == 1)
    6158             :       {
    6159      198597 :         GEN tmp = vecmodii(gmulsg(n, chi), cyc);
    6160             :         long j;
    6161     3809050 :         for (j = i+1; j < l; j++)
    6162     3610453 :           if (gel(vchi,j) && gequal(gel(vchi,j), tmp)) gel(vchi,j) = NULL;
    6163             :       }
    6164             :   }
    6165      139426 :   for (i = c = 1; i < l; i++)
    6166             :   {
    6167      126035 :     GEN chi = gel(vchi,i);
    6168      126035 :     if (chi && bnrisconductor(bnr, chi)) gel(vchi, c++) = chi;
    6169             :   }
    6170       13391 :   setlg(vchi, c); return vchi;
    6171             : }
    6172             : 
    6173             : /* con = NULL if D > 0 or if D < 0 and id != idcon. */
    6174             : static GEN
    6175       16835 : mfdihedralcommon(GEN bnf, GEN id, GEN znN, GEN kroconreyN, long N, long D, GEN con)
    6176             : {
    6177             :   GEN bnr, bnrconreyN, cyc, cycn, cycN, Lvchi, res, g, P;
    6178             :   long i, j, ordmax, l, lc, deghecke, degrel;
    6179             : 
    6180       16835 :   bnr = dihan_bnr(bnf, id);
    6181       16835 :   cyc = ZV_to_zv( bnr_get_cyc(bnr) );
    6182       16835 :   lc = lg(cyc); if (lc == 1) return NULL;
    6183             : 
    6184       13391 :   g = znstar_get_conreygen(znN); l = lg(g);
    6185       13391 :   bnrconreyN = cgetg(l, t_VEC);
    6186       50288 :   for (i = 1; i < l; i++)
    6187       36897 :     gel(bnrconreyN,i) = ZV_to_zv(isprincipalray(bnr,gel(g,i)));
    6188             : 
    6189       13391 :   cycn = cyc_normalize_zv(cyc);
    6190       13391 :   cycN = ZV_to_zv(znstar_get_cyc(znN));
    6191       13391 :   ordmax = cyc[1];
    6192       13391 :   P = polcyclo(ord_canon(ordmax), fetch_user_var("t"));
    6193       13391 :   deghecke = myeulerphiu(ordmax);
    6194       13391 :   Lvchi = mklvchi(bnr, con, cycn); l = lg(Lvchi);
    6195       13391 :   if (l == 1) return NULL;
    6196        7917 :   res = cgetg(l, t_VEC);
    6197       25123 :   for (j = 1; j < l; j++)
    6198             :   {
    6199       17206 :     GEN T, Tinit, v, vchi = ZV_to_zv(gel(Lvchi,j));
    6200       17206 :     GEN chi, chin = char_normalize_zv(vchi, cycn);
    6201             :     long ordw, vnum, k0;
    6202       17206 :     v = bnrchartwist2conrey(chin, cycn, bnrconreyN, kroconreyN);
    6203       17206 :     ordw = itou(Q_denom(v));
    6204       17206 :     Tinit = Qab_trace_init(P, ord_canon(ordmax), ord_canon(ordw));
    6205       17206 :     chi = conreydenormalize(znN, v);
    6206       17206 :     vnum = itou(znconreyexp(znN, chi));
    6207       17206 :     chi = ZV_to_zv(znconreychar(znN,chi));
    6208       17206 :     degrel = deghecke / myeulerphiu(ordw);
    6209       17206 :     k0 = zv_cyc_minimize(cycN, chi, coprimes_zv(ordw));
    6210       17206 :     vnum = Fl_powu(vnum, k0, N);
    6211             :     /* encodes degrel forms: jdeg = 0..degrel-1 */
    6212       17206 :     T = mkvecsmalln(6, N, k0, vnum, D, ordmax, degrel);
    6213       17206 :     gel(res,j) = mkvec3(T, id, mkvec3(cycn,chin,Tinit));
    6214             :   }
    6215        7917 :   return res;
    6216             : }
    6217             : 
    6218             : /* Append to v all dihedral weight 1 forms coming from D, if fundamental. */
    6219             : /* B a t_VECSMALL: if #B=1, only that level; if B=[Bmin,Bmax], Bmin <= Bmax:
    6220             :  * between those levels. */
    6221             : static void
    6222        9289 : append_dihedral(GEN v, long D, GEN B)
    6223             : {
    6224        9289 :   long Da = labs(D), no, N, i, numi, ct, min, max;
    6225             :   GEN bnf, con, LI, resall, varch;
    6226             :   pari_sp av;
    6227             : 
    6228        9289 :   if (lg(B) == 2)
    6229             :   {
    6230           0 :     long b = B[1], m = D > 0? 3: 1;
    6231           0 :     min = b / Da;
    6232           0 :     if (b % Da || min < m) return;
    6233           0 :     max = min;
    6234             :   }
    6235             :   else
    6236             :   { /* assume B[1] < B[2] */
    6237        9289 :     min = (B[1] + Da-1)/Da;
    6238        9289 :     max = B[2]/Da;
    6239             :   }
    6240        9289 :   if (!sisfundamental(D)) return;
    6241             : 
    6242        2842 :   av = avma;
    6243        2842 :   bnf = dihan_bnf(D);
    6244        2842 :   con = gel(galoisconj(bnf,gen_1), 2);
    6245        2842 :   LI = ideallist(bnf, max);
    6246        2842 :   numi = 0; for (i = min; i <= max; i++) numi += lg(gel(LI, i)) - 1;
    6247        2842 :   if (D > 0)
    6248             :   {
    6249         707 :     numi <<= 1;
    6250         707 :     varch = mkvec2(mkvec2(gen_1,gen_0), mkvec2(gen_0,gen_1));
    6251             :   }
    6252             :   else
    6253        2135 :     varch = NULL;
    6254        2842 :   resall = cgetg(numi+1, t_VEC); ct = 1;
    6255       27503 :   for (no = min; no <= max; no++)
    6256             :   {
    6257             :     GEN LIs, znN, conreyN, kroconreyN;
    6258             :     long flcond, lgc, lglis;
    6259       24661 :     if (D < 0)
    6260       15043 :       flcond = (no == 2 || no == 3 || (no == 4 && (D&7L)==1));
    6261             :     else
    6262        9618 :       flcond = (no == 4 && (D&7L) != 1);
    6263       24661 :     if (flcond) continue;
    6264       22302 :     LIs = gel(LI, no);
    6265       22302 :     N = Da*no;
    6266       22302 :     znN = znstar0(utoi(N), 1);
    6267       22302 :     conreyN = znstar_get_conreygen(znN); lgc = lg(conreyN);
    6268       22302 :     kroconreyN = cgetg(lgc, t_VECSMALL);
    6269       22302 :     for (i = 1; i < lgc; i++) kroconreyN[i] = krosi(D, gel(conreyN, i));
    6270       22302 :     lglis = lg(LIs);
    6271       43876 :     for (i = 1; i < lglis; i++)
    6272             :     {
    6273       21574 :       GEN id = gel(LIs, i), idcon, conk;
    6274             :       long j, inf, maxinf;
    6275       21574 :       if (typ(id) == t_INT) continue;
    6276       14077 :       idcon = galoisapply(bnf, con, id);
    6277       14077 :       conk = (D < 0 && gequal(idcon, id)) ? con : NULL;
    6278       42294 :       for (j = i; j < lglis; j++)
    6279       28217 :         if (gequal(idcon, gel(LIs, j))) gel(LIs, j) = gen_0;
    6280       14077 :       maxinf = (D < 0 || gequal(idcon,id))? 1: 2;
    6281       30912 :       for (inf = 1; inf <= maxinf; inf++)
    6282             :       {
    6283       16835 :         GEN ide = (D > 0)? mkvec2(id, gel(varch,inf)): id;
    6284       16835 :         GEN res = mfdihedralcommon(bnf, ide, znN, kroconreyN, N, D, conk);
    6285       16835 :         if (res) gel(resall, ct++) = res;
    6286             :       }
    6287             :     }
    6288             :   }
    6289        2842 :   if (ct == 1) avma = av;
    6290             :   else
    6291             :   {
    6292        2394 :     setlg(resall, ct);
    6293        2394 :     vectrunc_append(v, gerepilecopy(av, shallowconcat1(resall)));
    6294             :   }
    6295             : }
    6296             : 
    6297             : static long
    6298       21021 : di_N(GEN a) { return gel(a,1)[1]; }
    6299             : /* All primitive dihedral wt1 forms: LIM a t_VECSMALL with a single component
    6300             :  * (only level LIM) or 2 components [m,M], m < M (between m and M) */
    6301             : static GEN
    6302           7 : mfdihedralall(GEN LIM)
    6303             : {
    6304             :   GEN res, z;
    6305             :   long limD, ct, i, l1, l2;
    6306             : 
    6307           7 :   if (lg(LIM) == 2) l1 = l2 = LIM[1]; else { l1 = LIM[1]; l2 = LIM[2]; }
    6308           7 :   limD = l2;
    6309           7 :   res = vectrunc_init(2*limD);
    6310           7 :   if (l1 == l2)
    6311             :   {
    6312           0 :     GEN D = mydivisorsu(l1);
    6313           0 :     long l = lg(D), j;
    6314           0 :     for (j = 2; j < l; j++)
    6315             :     {
    6316           0 :       long d = D[j];
    6317           0 :       append_dihedral(res, -d, LIM);
    6318           0 :       if (d >= 5 && D[l-j] >= 3) append_dihedral(res, d, LIM);
    6319             :     }
    6320             :   }
    6321             :   else
    6322             :   {
    6323             :     long D;
    6324           7 :     for (D = -3; D >= -limD; D--) append_dihedral(res, D, LIM);
    6325           7 :     limD /= 3;
    6326           7 :     for (D = 5; D <= limD;   D++) append_dihedral(res, D, LIM);
    6327             :   }
    6328           7 :   if (l1 == l2) return gel(res,1); /* single level */
    6329           7 :   ct = lg(res);
    6330           7 :   if (ct > 1)
    6331             :   { /* concat and sort wrt N */
    6332           7 :     res = shallowconcat1(res);
    6333           7 :     res = vecpermute(res, indexvecsort(res, mkvecsmall(1)));
    6334           7 :     ct = lg(res);
    6335             :   }
    6336           7 :   z = const_vec(l2-l1+1, cgetg(1,t_VEC));
    6337        3836 :   for (i = 1; i < ct;)
    6338             :   { /* regroup result sharing the same N */
    6339        3822 :     long n = di_N(gel(res,i)), j = i+1, k;
    6340             :     GEN v;
    6341        3822 :     while (j < ct && di_N(gel(res,j)) == n) j++;
    6342        3822 :     n -= l1-1;
    6343        3822 :     gel(z, n) = v = cgetg(j-i+1, t_VEC);
    6344        3822 :     for (k = 1; i < j; k++,i++) gel(v,k) = gel(res,i);
    6345             :   }
    6346           7 :   return z;
    6347             : }
    6348             : 
    6349             : /* return [vF, index], where vecpermute(vF,index) generates dihedral forms
    6350             :  * for character CHI */
    6351             : static GEN
    6352       22841 : mfdihedralnew_i(long N, GEN CHI)
    6353             : {
    6354             :   GEN bnf, Tinit, Pm, vf, M, V, NK, SP;
    6355             :   long Dold, d, ordw, i, SB, c, l, k0, k1, chino, chinoorig, lv;
    6356             : 
    6357       22841 :   SP = cache_get(cache_DIH, N);
    6358       22841 :   if (!SP) SP = mfdihedralall(mkvecsmall(N));
    6359       22841 :   lv = lg(SP); if (lv == 1) return NULL;
    6360       10773 :   CHI = mfcharinduce(CHI,N);
    6361       10773 :   ordw = mfcharorder(CHI);
    6362       10773 :   chinoorig = mfcharno(CHI);
    6363       10773 :   k0 = mfconreyminimize(CHI);
    6364       10773 :   chino = Fl_powu(chinoorig, k0, N);
    6365       10773 :   k1 = Fl_inv(k0 % ordw, ordw);
    6366       10773 :   V = cgetg(lv, t_VEC);
    6367       10773 :   d = 0;
    6368       33670 :   for (i = l = 1; i < lv; i++)
    6369             :   {
    6370       22897 :     GEN sp = gel(SP,i), T = gel(sp,1);
    6371       22897 :     if (T[3] != chino) continue;
    6372        3472 :     d += T[6];
    6373        3472 :     if (k1 != 1)
    6374             :     {
    6375          77 :       GEN t = leafcopy(T);
    6376          77 :       t[3] = chinoorig;
    6377          77 :       t[2] = (t[2]*k1)%ordw;
    6378          77 :       sp = mkvec4(t, gel(sp,2), gel(sp,3), gel(sp,4));
    6379             :     }
    6380        3472 :     gel(V, l++) = sp;
    6381             :   }
    6382       10773 :   setlg(V, l); /* dihedral forms of level N and character CHI */
    6383       10773 :   if (l == 1) return NULL;
    6384             : 
    6385        2254 :   SB = myeulerphiu(ordw) * mfsturmNk(N,1) + 1;
    6386        2254 :   M = cgetg(d+1, t_MAT);
    6387        2254 :   vf = cgetg(d+1, t_VEC);
    6388        2254 :   NK = mkNK(N, 1, CHI);
    6389        2254 :   bnf = NULL; Dold = 0;
    6390        5726 :   for (i = c = 1; i < l; i++)
    6391             :   { /* T = [N, k0, conreyno, D, ordmax, degrel] */
    6392        3472 :     GEN bnr, Vi = gel(V,i), T = gel(Vi,1), id = gel(Vi,2), w = gel(Vi,3);
    6393        3472 :     long jdeg, k0i = T[2], D = T[4], degrel = T[6];
    6394             : 
    6395        3472 :     if (D != Dold) { Dold = D; bnf = dihan_bnf(D); }
    6396        3472 :     bnr = dihan_bnr(bnf, id);
    6397       10094 :     for (jdeg = 0; jdeg < degrel; jdeg++,c++)
    6398             :     {
    6399        6622 :       GEN k0j = mkvecsmall2(k0i, jdeg), an = dihan(bnr, w, k0j, SB);
    6400        6622 :       settyp(an, t_COL); gel(M,c) = Q_primpart(an);
    6401        6622 :       gel(vf,c) = tag3(t_MF_DIHEDRAL, NK, bnr, w, k0j);
    6402             :     }
    6403             :   }
    6404        2254 :   Tinit = gmael3(V,1,3,3); Pm = gel(Tinit,1);
    6405        2254 :   V = QabM_indexrank(M, degpol(Pm)==1? NULL: Pm, ord_canon(ordw));
    6406        2254 :   return mkvec2(vf,gel(V,2));
    6407             : }
    6408             : static long
    6409       15491 : mfdihedralnewdim(long N, GEN CHI)
    6410             : {
    6411       15491 :   pari_sp av = avma;
    6412       15491 :   GEN S = mfdihedralnew_i(N, CHI);
    6413       15491 :   long d = S ? lg(gel(S,2))-1: 0;
    6414       15491 :   avma = av; return d;
    6415             : }
    6416             : static GEN
    6417        7350 : mfdihedralnew(long N, GEN CHI)
    6418             : {
    6419        7350 :   pari_sp av = avma;
    6420        7350 :   GEN S = mfdihedralnew_i(N, CHI);
    6421        7350 :   if (!S) { avma = av; return cgetg(1, t_VEC); }
    6422         728 :   return vecpermute(gel(S,1), gel(S,2));
    6423             : }
    6424             : 
    6425             : static long
    6426        6867 : mfdihedralcuspdim(long N, GEN CHI)
    6427             : {
    6428        6867 :   pari_sp av = avma;
    6429             :   GEN D, CHIP;
    6430             :   long F, i, lD, dim;
    6431             : 
    6432        6867 :   CHIP = mfchartoprimitive(CHI, &F);
    6433        6867 :   D = mydivisorsu(N/F); lD = lg(D);
    6434        6867 :   dim = mfdihedralnewdim(N, CHI); /* d = 1 */
    6435       15491 :   for (i = 2; i < lD; i++)
    6436             :   {
    6437        8624 :     long d = D[i], M = N/d, a = mfdihedralnewdim(M, CHIP);
    6438        8624 :     if (a) dim += a * mynumdivu(d);
    6439             :   }
    6440        6867 :   avma = av; return dim;
    6441             : }
    6442             : 
    6443             : static GEN
    6444        5166 : mfbdall(GEN E, long N)
    6445             : {
    6446        5166 :   GEN v, D = mydivisorsu(N);
    6447        5166 :   long i, j, nD = lg(D) - 1, nE = lg(E) - 1;
    6448        5166 :   v = cgetg(nD*nE + 1, t_VEC);
    6449        6503 :   for (j = 1; j <= nE; j++)
    6450             :   {
    6451        1337 :     GEN Ej = gel(E, j);
    6452        1337 :     for (i = 0; i < nD; i++) gel(v, i*nE + j) = mfbd_i(Ej, D[i+1]);
    6453             :   }
    6454        5166 :   return v;
    6455             : }
    6456             : static GEN
    6457        3220 : mfdihedralcusp(long N, GEN CHI)
    6458             : {
    6459        3220 :   pari_sp av = avma;
    6460             :   GEN D, CHIP, z;
    6461             :   long F, i, lD;
    6462             : 
    6463        3220 :   CHIP = mfchartoprimitive(CHI, &F);
    6464        3220 :   D = mydivisorsu(N/F); lD = lg(D);
    6465        3220 :   z = cgetg(lD, t_VEC);
    6466        3220 :   gel(z,1) = mfdihedralnew(N, CHI);
    6467        7301 :   for (i = 2; i < lD; i++) /* skip 1 */
    6468             :   {
    6469        4081 :     long d = D[i], M = N / d;
    6470        4081 :     GEN LF = mfdihedralnew(M, mfcharinduce(CHIP, M));
    6471        4081 :     gel(z,i) = mfbdall(LF, d);
    6472             :   }
    6473        3220 :   return gerepilecopy(av, shallowconcat1(z));
    6474             : }
    6475             : 
    6476             : /* used to decide between ratlift and comatrix for ZM_inv; ratlift is better
    6477             :  * when N has many divisors */
    6478             : static int
    6479        2240 : abundant(ulong N) { return mynumdivu(N) >= 8; }
    6480             : 
    6481             : /* CHI an mfchar */
    6482             : static int
    6483         287 : cmp_ord(void *E, GEN a, GEN b)
    6484             : {
    6485         287 :   GEN chia = MF_get_CHI(a), chib = MF_get_CHI(b);
    6486         287 :   (void)E; return cmpii(gmfcharorder(chia), gmfcharorder(chib));
    6487             : }
    6488             : /* mfinit structure.
    6489             : -- mf[1] contains [N,k,CHI,space],
    6490             : -- mf[2] contains vector of closures of Eisenstein series, empty if not
    6491             :    full space.
    6492             : -- mf[3] contains vector of closures, so #mf[3] = dimension of cusp/new space.
    6493             : -- mf[4] contains the corresponding indices: either j for T(j)tf if newspace,
    6494             :    or [M,j,d] for B(d)T(j)tf_M if cuspspace or oldspace.
    6495             : -- mf[5] contains the matrix M of first coefficients of basis, never cleaned.
    6496             :  * NK is either [N,k] or [N,k,CHI].
    6497             :  * mfinit does not do the splitting, only the basis generation. */
    6498             : 
    6499             : /* Set flraw to 1 if do not need mf[5]: no mftobasis etc..., only the
    6500             :    expansions of the basis elements are needed. */
    6501             : 
    6502             : static GEN
    6503        4340 : mfinit_Nkchi(long N, long k, GEN CHI, long space, long flraw)
    6504             : {
    6505        4340 :   GEN M = NULL, mf = NULL, mf1 = mkvec4(utoi(N), stoi(k), CHI, utoi(space));
    6506        4340 :   long sb = mfsturmNk(N, k);
    6507             :   cachenew_t cache;
    6508        4340 :   if (k < 0 || badchar(N, k, CHI)) return mfEMPTY(mf1);
    6509        4305 :   if (k == 0) /*nothing*/;
    6510        4263 :   else if (k == 1)
    6511             :   {
    6512         224 :     switch (space)
    6513             :     {
    6514             :       case mf_NEW:
    6515             :       case mf_FULL:
    6516         196 :       case mf_CUSP: mf = mfwt1init(N, CHI, NULL, space, flraw); break;
    6517          14 :       case mf_EISEN:break;
    6518           7 :       case mf_OLD: pari_err_IMPL("mfinit in weight 1 for old space");
    6519           7 :       default: pari_err_FLAG("mfinit");
    6520             :     }
    6521             :   }
    6522             :   else /* k >= 2 */
    6523             :   {
    6524        4039 :     long ord = mfcharorder_canon(CHI);
    6525        4039 :     GEN z = NULL, P = (ord == 1)? NULL: mfcharpol(CHI);
    6526        4039 :     switch(space)
    6527             :     {
    6528             :       case mf_EISEN:
    6529         105 :         break;
    6530             :       case mf_NEW:
    6531        1162 :         mf = mfnewinit(N, k, CHI, &cache, 1);
    6532        1162 :         if (mf && !flraw) { M = MF_get_M(mf); z = MF_get_Mindex(mf); }
    6533        1162 :         break;
    6534             :       case mf_OLD:
    6535             :       case mf_CUSP:
    6536             :       case mf_FULL:
    6537        2765 :         mf = mfinitcusp(N, k, CHI, &cache, space);
    6538        2765 :         if (mf && !flraw)
    6539             :         {
    6540        1995 :           GEN S = MF_get_S(mf);
    6541        1995 :           M = bhnmat_extend(M, sb+1, 1, S, &cache);
    6542        1995 :           if (space != mf_FULL) gel(mf,5) = mfcleanCHI(M, CHI, abundant(N));
    6543             :         }
    6544        2765 :         dbg_cachenew(&cache);
    6545        2765 :         break;
    6546           7 :       default: pari_err_FLAG("mfinit");
    6547             :     }
    6548        4032 :     if (z) gel(mf,5) = mfclean2(M, z, P, ord);
    6549             :   }
    6550        4284 :   if (!mf) mf = mfEMPTY(mf1);
    6551             :   else
    6552             :   {
    6553        3430 :     gel(mf,1) = mf1;
    6554        3430 :     if (flraw) gel(mf,5) = zerovec(3);
    6555             :   }
    6556        4284 :   if (!space_is_cusp(space))
    6557             :   {
    6558         581 :     GEN E = mfeisensteinbasis(N, k, CHI);
    6559         581 :     gel(mf,2) = E;
    6560         581 :     if (!flraw)
    6561             :     {
    6562         385 :       if (M)
    6563         140 :         M = shallowconcat(mfvectomat(E, sb+1, 1), M);
    6564             :       else
    6565         245 :         M = mfcoefs_mf(mf, sb+1, 1);
    6566         385 :       gel(mf,5) = mfcleanCHI(M, CHI, abundant(N));
    6567             :     }
    6568             :   }
    6569        4284 :   return mf;
    6570             : }
    6571             : 
    6572             : /* mfinit for k = nk/dk */
    6573             : static GEN
    6574        2338 : mfinit_Nndkchi(long N, long nk, long dk, GEN CHI, long space, long flraw)
    6575        2492 : { return (dk == 2)? mf2init_Nkchi(N, nk >> 1, CHI, space, flraw)
    6576        2513 :                   : mfinit_Nkchi(N, nk, CHI, space, flraw); }
    6577             : static GEN
    6578        2996 : mfinit_i(GEN NK, long space)
    6579             : {
    6580             :   GEN CHI;
    6581             :   long N, k, dk, joker;
    6582        2996 :   if (checkmf_i(NK))
    6583             :   {
    6584         119 :     N = mf_get_N(NK);
    6585         119 :     Qtoss(mf_get_gk(NK), &k, &dk);
    6586         119 :     CHI = mf_get_CHI(NK);
    6587             :   }
    6588        2877 :   else if (checkMF_i(NK))
    6589             :   {
    6590          21 :     long s = MF_get_space(NK);
    6591          21 :     if (s == space) return NK;
    6592          21 :     Qtoss(MF_get_gk(NK), &k, &dk);
    6593          21 :     if (dk == 1 && k > 1 && space == mf_NEW && (s == mf_CUSP || s == mf_FULL))
    6594          21 :       return mfinittonew(NK);
    6595           0 :     N = MF_get_N(NK);
    6596           0 :     CHI = MF_get_CHI(NK);
    6597             :   }
    6598             :   else
    6599        2856 :     checkNK2(NK, &N, &k, &dk, &CHI, 1);
    6600        2954 :   joker = !CHI || typ(CHI) == t_COL;
    6601        2954 :   if (joker)
    6602             :   {
    6603        1134 :     GEN mf, vCHI = CHI;
    6604             :     long i, j, l;
    6605        1134 :     if (CHI && lg(CHI) == 1) return cgetg(1,t_VEC);
    6606        1127 :     if (k < 0) return mfEMPTYall(N, sstoQ(k,dk), CHI, space);
    6607        1113 :     if (k == 1 && space != mf_EISEN)
    6608         476 :     {
    6609             :       GEN TMP, gN, gs;
    6610        1078 :       if (space != mf_CUSP && space != mf_NEW)
    6611           0 :         pari_err_IMPL("mfinit([N,1,wildcard], space != cusp or new space)");
    6612        1078 :       if (wt1empty(N)) return mfEMPTYall(N, gen_1, CHI, space);
    6613         476 :       vCHI = mfwt1chars(N,vCHI);
    6614         476 :       l = lg(vCHI); mf = cgetg(l, t_VEC); if (l == 1) return mf;
    6615         476 :       TMP = mfwt1_pre(N); gN = utoipos(N); gs = utoi(space);
    6616        3584 :       for (i = j = 1; i < l; i++)
    6617             :       {
    6618        3108 :         GEN c = gel(vCHI,i), z = mfwt1init(N, c, TMP, space, 0);
    6619        3108 :         if (CHI && !z) z = mfEMPTY(mkvec4(gN,gen_1,c,gs));
    6620        3108 :         if (z) gel(mf, j++) = z;
    6621             :       }
    6622             :     }
    6623             :     else
    6624             :     {
    6625          35 :       vCHI = mfchars(N,k,dk,vCHI);
    6626          35 :       l = lg(vCHI); mf = cgetg(l, t_VEC);
    6627         119 :       for (i = j = 1; i < l; i++)
    6628             :       {
    6629          84 :         GEN v = mfinit_Nndkchi(N, k, dk, gel(vCHI,i), space, 0);
    6630          84 :         if (MF_get_dim(v) || CHI) gel(mf, j++) = v;
    6631             :       }
    6632             :     }
    6633         511 :     setlg(mf,j);
    6634         511 :     if (!CHI) gen_sort_inplace(mf, NULL, &cmp_ord, NULL);
    6635         511 :     return mf;
    6636             :   }
    6637        1820 :   return mfinit_Nndkchi(N, k, dk, CHI, space, 0);
    6638             : }
    6639             : GEN
    6640        2065 : mfinit(GEN NK, long space)
    6641             : {
    6642        2065 :   pari_sp av = avma;
    6643        2065 :   return gerepilecopy(av, mfinit_i(NK, space));
    6644             : }
    6645             : 
    6646             : /* UTILITY FUNCTIONS */
    6647             : static void
    6648         315 : cusp_canon(GEN cusp, long N, long *pA, long *pC)
    6649             : {
    6650         315 :   pari_sp av = avma;
    6651             :   long A, C, tc, cg;
    6652         315 :   if (N <= 0) pari_err_DOMAIN("mfcuspwidth","N","<=",gen_0,stoi(N));
    6653         616 :   if (!cusp || (tc = typ(cusp)) == t_INFINITY) { *pA = 1; *pC = N; return; }
    6654         301 :   if (tc != t_INT && tc != t_FRAC) pari_err_TYPE("checkcusp", cusp);
    6655         301 :   Qtoss(cusp, &A,&C);
    6656         301 :   if (N % C)
    6657             :   {
    6658             :     ulong uC;
    6659          14 :     long u = Fl_invgen((C-1)%N + 1, N, &uC);
    6660          14 :     A = Fl_mul(A, u, N);
    6661          14 :     C = (long)uC;
    6662             :   }
    6663         301 :   cg = ugcd(C, N/C);
    6664         301 :   while (ugcd(A, N) > 1) A += cg;
    6665         301 :   *pA = A % N; *pC = C; avma = av;
    6666             : }
    6667             : static long
    6668         553 : mfcuspcanon_width(long N, long C)
    6669         553 : { return (C == N)? 1 : N / cgcd(N, Fl_sqr(umodsu(C,N),N)); }
    6670             : /* v = [a,c] a ZC, width of cusp (a:c) */
    6671             : static long
    6672        6391 : mfZC_width(long N, GEN v)
    6673             : {
    6674        6391 :   ulong C = umodiu(gel(v,2), N);
    6675        6391 :   return (C == 0)? 1: N / cgcd(N, Fl_sqr(C,N));
    6676             : }
    6677             : long
    6678         119 : mfcuspwidth(GEN gN, GEN cusp)
    6679             : {
    6680         119 :   long N = 0, A, C;
    6681         119 :   if (typ(gN) == t_INT) N = itos(gN);
    6682           0 :   else if (checkMF_i(gN)) N = MF_get_N(gN);
    6683           0 :   else pari_err_TYPE("mfcuspwidth", gN);
    6684         119 :   cusp_canon(cusp, N, &A, &C);
    6685         112 :   return mfcuspcanon_width(N, C);
    6686             : }
    6687             : 
    6688             : /* Q a t_INT */
    6689             : static GEN
    6690          14 : findq(GEN al, GEN Q)
    6691             : {
    6692             :   long n;
    6693          14 :   if (typ(al) == t_FRAC && cmpii(gel(al,2), Q) <= 0)
    6694           0 :     return mkvec(mkvec2(gel(al,1), gel(al,2)));
    6695          14 :   n = 1 + (long)ceil(2.0781*gtodouble(glog(Q, LOWDEFAULTPREC)));
    6696          14 :   return contfracpnqn(gboundcf(al,n), n);
    6697             : }
    6698             : static GEN
    6699          91 : findqga(long N, GEN z)
    6700             : {
    6701          91 :   GEN Q, LDC, CK = NULL, DK = NULL, ma, x, y = imag_i(z);
    6702             :   long j, l;
    6703          91 :   if (gcmpgs(gmulsg(2*N, y), 1) >= 0) return NULL;
    6704          14 :   x = real_i(z);
    6705          14 :   Q = ground(ginv(gsqrt(gmulsg(N, y), LOWDEFAULTPREC)));
    6706          14 :   LDC = findq(gmulsg(-N,x), Q);
    6707          14 :   ma = gen_1; l = lg(LDC);
    6708          35 :   for (j = 1; j < l; j++)
    6709             :   {
    6710          21 :     GEN D, DC = gel(LDC,j), C1 = gel(DC,2);
    6711          21 :     if (cmpii(C1,Q) > 0) break;
    6712          21 :     D = gel(DC,1);
    6713          21 :     if (ugcd(umodiu(D,N), N) == 1)
    6714             :     {
    6715           7 :       GEN C = mului(N, C1), den;
    6716           7 :       den = gadd(gsqr(gmul(C,y)), gsqr(gadd(D, gmul(C,x))));
    6717           7 :       if (gcmp(den, ma) < 0) { ma = den; CK = C; DK = D; }
    6718             :     }
    6719             :   }
    6720          14 :   return DK? mkvec2(CK, DK): NULL;
    6721             : }
    6722             : 
    6723             : static long
    6724          28 : valNC2(GEN P, GEN E, long e)
    6725             : {
    6726          28 :   long i, d = 1, l = lg(P);
    6727          56 :   for (i = 1; i < l; i++)
    6728             :   {
    6729          28 :     long v = u_lval(e, P[i]) << 1;
    6730          28 :     if (v == E[i] + 1) v--;
    6731          28 :     d *= upowuu(P[i], v);
    6732             :   }
    6733          28 :   return d;
    6734             : }
    6735             : 
    6736             : static GEN
    6737          14 : findqganew(long N, GEN z)
    6738             : {
    6739          14 :   GEN MI, DI, x = real_i(z), y = imag_i(z), fa, P, E;
    6740          14 :   long i, Ck = 0, Dk = 1;
    6741          14 :   MI = ginv(utoi(N));
    6742          14 :   DI = mydivisorsu(mysqrtu(N));
    6743          14 :   fa = myfactoru(N); P = gel(fa,1); E = gel(fa,2);
    6744          42 :   for (i = 1; i < lg(DI); i++)
    6745             :   {
    6746          28 :     long e = DI[i], C, D, g;
    6747             :     GEN U, m;
    6748          28 :     (void)cxredsl2(gmulsg(e, z), &U);
    6749          28 :     C = itos(gcoeff(U,2,1)); if (!C) continue;
    6750          28 :     D = itos(gcoeff(U,2,2));
    6751          28 :     C *= e;
    6752          28 :     g = cgcd(e, D); if (g > 1) { C /= g; D /= g; }
    6753          28 :     m = gadd(gsqr(gaddgs(gmulsg(C, x), D)), gsqr(gmulsg(C, y)));
    6754          28 :     m = gdivgs(m, valNC2(P, E, e));
    6755          28 :     if (gcmp(m, MI) < 0) { MI = m; Ck = C; Dk = D; }
    6756             :   }
    6757          14 :   return Ck? mkvec2s(Ck, Dk): NULL;
    6758             : }
    6759             : 
    6760             : /* Return z' and U \in SL_2(Z), z' = U*z, Im(z')/width(U.oo) > sqrt(3)/(2N) */
    6761             : static GEN
    6762         140 : cxredga0N(long N, GEN z, GEN *pU, long flag)
    6763             : {
    6764         140 :   GEN v = NULL, A, B, C, D, g;
    6765         140 :   if (N == 1) return cxredsl2(z, pU);
    6766         105 :   v = flag? findqganew(N,z): findqga(N,z);
    6767         105 :   if (!v) { *pU = matid(2); return z; }
    6768          21 :   C = gel(v,1);
    6769          21 :   D = gel(v,2); g = bezout(C, D, &B, &A);
    6770          21 :   if (!equali1(g)) pari_err_BUG("cxredga0N [gcd > 1]");
    6771          21 :   B = negi(B);
    6772          21 :   *pU = mkmat2(mkcol2(A,C), mkcol2(B,D));
    6773          21 :   return gdiv(gadd(gmul(A,z), B), gadd(gmul(C,z), D));
    6774             : }
    6775             : 
    6776             : static GEN
    6777         140 : lfunthetaall(GEN b, GEN vL, GEN t, long bitprec)
    6778             : {
    6779         140 :   long i, l = lg(vL);
    6780         140 :   GEN v = cgetg(l, t_VEC);
    6781         308 :   for (i = 1; i < l; i++)
    6782             :   {
    6783         168 :     GEN T, L = gel(vL,i), a0 = gel(L,1), ldata = gel(L,2);
    6784         168 :     GEN van = gel(ldata_get_an(ldata),2);
    6785         168 :     if (lg(van) == 1)
    6786             :     {
    6787           0 :       T = gmul(b, a0);
    6788           0 :       if (isexactzero(T)) { GEN z = real_0_bit(-bitprec); T = mkcomplex(z,z); }
    6789             :     }
    6790             :     else
    6791             :     {
    6792         168 :       T = gmul2n(lfuntheta(ldata, t, 0, bitprec), -1);
    6793         168 :       T = gmul(b, gadd(a0, T));
    6794             :     }
    6795         168 :     gel(v,i) = T;
    6796             :   }
    6797         140 :   return l == 2? gel(v,1): v;
    6798             : }
    6799             : 
    6800             : /* P in ZX */
    6801             : static GEN
    6802         112 : ZX_roots(GEN P, long prec)
    6803             : {
    6804         112 :   long d = degpol(P);
    6805         112 :   if (d == 1) return mkvec(gen_0);
    6806         112 :   if (d == 2 && isint1(gel(P,2)) && isintzero(gel(P,3)) && isint1(gel(P,4)))
    6807           7 :     return mkvec2(powIs(3), gen_I()); /* order as polroots */
    6808         105 :   return (ZX_sturm(P) == d)? realroots(P,NULL,prec): QX_complex_roots(P,prec);
    6809             : }
    6810             : /* initializations for RgX_RgV_eval / RgC_embed */
    6811             : static GEN
    6812         147 : rootspowers(GEN v)
    6813             : {
    6814         147 :   long i, l = lg(v);
    6815         147 :   GEN w = cgetg(l, t_VEC);
    6816         147 :   for (i = 1; i < l; i++) gel(w,i) = gpowers(gel(v,i), l-2);
    6817         147 :   return w;
    6818             : }
    6819             : /* mf embeddings attached to Q(chi)/(T), chi attached to cyclotomic P */
    6820             : static GEN
    6821         728 : getembed(GEN P, GEN T, GEN zcyclo, long prec)
    6822             : {
    6823             :   long i, l;
    6824             :   GEN v;
    6825         728 :   if (degpol(P) == 1) P = NULL; /* mfcharpol for quadratic char */
    6826         728 :   if (degpol(T) == 1) T = NULL; /* dim 1 orbit */
    6827         728 :   if (T && P)
    6828          35 :   { /* K(y) / (T(y)), K = Q(t)/(P) cyclotomic */
    6829          35 :     GEN vr = RgX_is_ZX(T)? ZX_roots(T,prec): roots(RgX_embed1(T,zcyclo), prec);
    6830          35 :     v = rootspowers(vr); l = lg(v);
    6831          35 :     for (i = 1; i < l; i++) gel(v,i) = mkcol3(P,zcyclo,gel(v,i));
    6832             :   }
    6833         693 :   else if (T)
    6834             :   { /* Q(y) / (T(y)), T non-cyclotomic */
    6835         112 :     GEN vr = ZX_roots(T, prec);
    6836         112 :     v = rootspowers(vr); l = lg(v);
    6837         112 :     for (i = 1; i < l; i++) gel(v,i) = mkcol2(T, gel(v,i));
    6838             :   }
    6839             :   else /* cyclotomic or rational */
    6840         581 :     v = mkvec(P? mkvec2(P, zcyclo): cgetg(1,t_VEC));
    6841         728 :   return v;
    6842             : }
    6843             : static GEN
    6844         588 : grootsof1_CHI(GEN CHI, long prec)
    6845         588 : { return grootsof1(mfcharorder_canon(CHI), prec); }
    6846             : /* return the [Q(F):Q(chi)] embeddings of F */
    6847             : static GEN
    6848         490 : mfgetembed(GEN F, long prec)
    6849             : {
    6850         490 :   GEN T = mf_get_field(F), CHI = mf_get_CHI(F), P = mfcharpol(CHI);
    6851         490 :   return getembed(P, T, grootsof1_CHI(CHI, prec), prec);
    6852             : }
    6853             : static GEN
    6854           7 : mfchiembed(GEN mf, long prec)
    6855             : {
    6856           7 :   GEN CHI = MF_get_CHI(mf), P = mfcharpol(CHI);
    6857           7 :   return getembed(P, pol_x(0), grootsof1_CHI(CHI, prec), prec);
    6858             : }
    6859             : /* mfgetembed for the successive eigenforms in MF_get_newforms */
    6860             : static GEN
    6861          91 : mfeigenembed(GEN mf, long prec)
    6862             : {
    6863          91 :   GEN vP = MF_get_fields(mf), CHI = MF_get_CHI(mf), P = mfcharpol(CHI);
    6864          91 :   long i, l = lg(vP);
    6865          91 :   GEN zcyclo = grootsof1_CHI(CHI, prec), vE = cgetg(l, t_VEC);
    6866          91 :   for (i = 1; i < l; i++) gel(vE,i) = getembed(P, gel(vP,i), zcyclo, prec);
    6867          91 :   return vE;
    6868             : }
    6869             : 
    6870             : static int
    6871          21 : checkPv(GEN P, GEN v)
    6872          21 : { return typ(P) == t_POL && typ(v) == t_VEC && lg(v)-1 >= degpol(P); }
    6873             : static int
    6874          21 : checkemb_i(GEN E)
    6875             : {
    6876          21 :   long t = typ(E), l = lg(E);
    6877          21 :   if (t == t_VEC) return l == 1 || (l == 3 && checkPv(gel(E,1), gel(E,2)));
    6878          14 :   if (t != t_COL) return 0;
    6879          14 :   if (l == 3) return checkPv(gel(E,1), gel(E,2));
    6880          14 :   return l == 4 && typ(gel(E,2)) == t_VEC && checkPv(gel(E,1), gel(E,3));
    6881             : }
    6882             : static GEN
    6883          21 : anyembed(GEN v, GEN E)
    6884             : {
    6885          21 :   switch(typ(v))
    6886             :   {
    6887          21 :     case t_VEC: case t_COL: return mfvecembed(E, v);
    6888           0 :     case t_MAT: return mfmatembed(E, v);
    6889             :   }
    6890           0 :   return mfembed(E, v);
    6891             : }
    6892             : GEN
    6893          42 : mfembed0(GEN E, GEN v, long prec)
    6894             : {
    6895          42 :   pari_sp av = avma;
    6896          42 :   GEN vE = NULL;
    6897          42 :   if (checkmf_i(E)) vE = mfgetembed(E, prec);
    6898          28 :   else if (checkMF_i(E)) vE = mfchiembed(E, prec);
    6899          42 :   if (vE)
    6900             :   {
    6901          21 :     long i, l = lg(vE);
    6902             :     GEN w;
    6903          21 :     if (!v) return gerepilecopy(av, l == 2? gel(vE,1): vE);
    6904           0 :     w = cgetg(l, t_VEC);
    6905           0 :     for (i = 1; i < l; i++) gel(w,i) = anyembed(v, gel(vE,i));
    6906           0 :     return gerepilecopy(av, l == 2? gel(w,1): w);
    6907             :   }
    6908          21 :   if (!checkemb_i(E) || !v) pari_err_TYPE("mfembed", E);
    6909          21 :   return gerepilecopy(av, anyembed(v,E));
    6910             : }
    6911             : 
    6912             : /* dummy lfun create for theta evaluation */
    6913             : static GEN
    6914         637 : mfthetaancreate(GEN van, GEN N, GEN k)
    6915             : {
    6916         637 :   GEN L = zerovec(6);
    6917         637 :   gel(L,1) = lfuntag(t_LFUN_GENERIC, van);
    6918         637 :   gel(L,3) = mkvec2(gen_0, gen_1);
    6919         637 :   gel(L,4) = k;
    6920         637 :   gel(L,5) = N; return L;
    6921             : }
    6922             : /* destroy van and prepare to evaluate theta(sigma(van)), for all sigma in
    6923             :  * embeddings vector vE */
    6924             : static GEN
    6925         259 : van_embedall(GEN van, GEN vE, GEN gN, GEN gk)
    6926             : {
    6927         259 :   GEN a0 = gel(van,1), vL;
    6928         259 :   long i, lE = lg(vE), l = lg(van);
    6929         259 :   van++; van[0] = evaltyp(t_VEC) | evallg(l-1); /* remove a0 */
    6930         259 :   vL = cgetg(lE, t_VEC);
    6931         595 :   for (i = 1; i < lE; i++)
    6932             :   {
    6933         336 :     GEN E = gel(vE,i), v = mfvecembed(E, van);
    6934         336 :     gel(vL,i) = mkvec2(mfembed(E,a0), mfthetaancreate(v, gN, gk));
    6935             :   }
    6936         259 :   return vL;
    6937             : }
    6938             : 
    6939             : static int
    6940         574 : cusp_AC(GEN cusp, long *A, long *C)
    6941             : {
    6942         574 :   switch(typ(cusp))
    6943             :   {
    6944          70 :     case t_INFINITY: *A = 1; *C = 0; break;
    6945         231 :     case t_INT:  *A = itos(cusp); *C = 1; break;
    6946          91 :     case t_FRAC: *A = itos(gel(cusp, 1)); *C = itos(gel(cusp, 2)); break;
    6947             :     case t_REAL: case t_COMPLEX:
    6948         182 :       *A = 0; *C = 0;
    6949         182 :       if (gsigne(imag_i(cusp)) <= 0)
    6950           7 :         pari_err_DOMAIN("mfeval","imag(tau)","<=",gen_0,cusp);
    6951         175 :       return 0;
    6952           0 :     default: pari_err_TYPE("cusp_AC", cusp);
    6953             :   }
    6954         392 :   return 1;
    6955             : }
    6956             : static GEN
    6957         329 : cusp2mat(long A, long C)
    6958             : { long B, D;
    6959         329 :   cbezout(A, C, &D, &B);
    6960         329 :   return mkmat22s(A, -B, C, D);
    6961             : }
    6962             : static GEN
    6963           7 : mkS(void) { return mkmat22s(0,-1,1,0); }
    6964             : 
    6965             : /* if t is a cusp, return F(t), else NULL */
    6966             : static GEN
    6967         336 : evalcusp(GEN mf, GEN F, GEN t, long prec)
    6968             : {
    6969             :   long A, C;
    6970             :   GEN R;
    6971         336 :   if (!cusp_AC(t, &A,&C)) return NULL;
    6972         189 :   if (C % mf_get_N(F) == 0) return gel(mfcoefs_i(F, 0, 1), 1);
    6973         175 :   R = mfgaexpansion(mf, F, cusp2mat(A,C), 0, prec);
    6974         175 :   return gequal0(gel(R,1))? gmael(R,3,1): gen_0;
    6975             : }
    6976             : /* Evaluate an mf closure numerically, i.e., in the usual sense, either for a
    6977             :  * single tau or a vector of tau; for each, return a vector of results
    6978             :  * corresponding to all complex embeddings of F. If flag is non-zero, allow
    6979             :  * replacing F by F | gamma to increase imag(gamma^(-1).tau) [ expensive if
    6980             :  * MF_EISENSPACE not present ] */
    6981             : static GEN
    6982         154 : mfeval_i(GEN mf, GEN F, GEN vtau, long flag, long bitprec)
    6983             : {
    6984             :   GEN L0, vL, vb, sqN, vga, vTAU, vs, van, vE;
    6985         154 :   long N = mf_get_N(F), N0, ta, lv, i, prec = nbits2prec(bitprec);
    6986         154 :   GEN gN = utoipos(N), gk = mf_get_gk(F), gk1 = gsubgs(gk,1), vgk;
    6987         154 :   long flscal = 0;
    6988             : 
    6989             :   /* gen_0 is ignored, second component assumes Ramanujan-Petersson in
    6990             :    * 1/2-integer weight */
    6991         154 :   vgk = mkvec2(gen_0, mfiscuspidal(mf,F)? gmul2n(gk1,-1): gk1);
    6992         154 :   ta = typ(vtau);
    6993         154 :   if (!is_vec_t(ta)) { flscal = 1; vtau = mkvec(vtau); ta = t_VEC; }
    6994         154 :   lv = lg(vtau);
    6995         154 :   sqN = sqrtr_abs(utor(N, prec));
    6996         154 :   vs = const_vec(lv-1, NULL);
    6997         154 :   vb = const_vec(lv-1, NULL);
    6998         154 :   vL = cgetg(lv, t_VEC);
    6999         154 :   vTAU = cgetg(lv, t_VEC);
    7000         154 :   vga = cgetg(lv, t_VEC);
    7001         154 :   L0 = mfthetaancreate(NULL, gN, vgk); /* only for thetacost */
    7002         154 :   vE = mfgetembed(F, prec);
    7003         154 :   N0 = 0;
    7004         322 :   for (i = 1; i < lv; i++)
    7005             :   {
    7006         175 :     GEN t = gel(vtau,i), tau, U;
    7007             :     long w, n;
    7008             : 
    7009         175 :     gel(vs,i) = evalcusp(mf, F, t, prec);
    7010         168 :     if (gel(vs,i)) continue;
    7011         140 :     tau = cxredga0N(N, t, &U, flag);
    7012         140 :     if (!flag) w = 0; else { w = mfZC_width(N, gel(U,1)); tau = gdivgs(tau,w); }
    7013         140 :     tau = mulcxmI(gmul(tau, sqN));
    7014         140 :     n = lfunthetacost(L0, real_i(tau), 0, bitprec);
    7015         140 :     if (N0 < n) N0 = n;
    7016         140 :     if (flag)
    7017             :     {
    7018          28 :       GEN A, al, v = mfslashexpansion(mf,F,ginv(U),N0,0,&A,prec);
    7019          28 :       gel(vL,i) = van_embedall(v, vE, gN, vgk);
    7020          28 :       al = gel(A,1);
    7021          28 :       if (!gequal0(al))
    7022           0 :         gel(vb,i) = gexp(gmul(gmul(gmulsg(w,al),PiI2(prec)), tau), prec);
    7023             :     }
    7024         140 :     gel(vTAU,i) = tau;
    7025         140 :     gel(vga,i) = U;
    7026             :   }
    7027         147 :   if (!flag)
    7028             :   {
    7029         119 :     van = mfcoefs_i(F, N0, 1);
    7030         119 :     vL = const_vec(lv-1, van_embedall(van, vE, gN, vgk));
    7031             :   }
    7032         315 :   for (i = 1; i < lv; i++)
    7033             :   {
    7034             :     GEN z, g, c, d, T;
    7035         168 :     if (gel(vs,i)) continue;
    7036         140 :     z = gel(vtau,i); g = gel(vga,i);
    7037         140 :     c = gcoeff(g,2,1); d = gcoeff(g,2,2);
    7038         140 :     T = gpow(gadd(gmul(c,z), d), gneg(gk), prec);
    7039         140 :     if (flag && gel(vb,i)) T = gmul(T, gel(vb,i));
    7040         140 :     gel(vs,i) = lfunthetaall(T, gel(vL,i), gel(vTAU,i), bitprec);
    7041             :   }
    7042         147 :   return flscal? gel(vs,1): vs;
    7043             : }
    7044             : 
    7045             : static long
    7046        1071 : mfistrivial(GEN F)
    7047             : {
    7048        1071 :   switch(mf_get_type(F))
    7049             :   {
    7050          14 :     case t_MF_CONST: return lg(gel(F,2)) == 1;
    7051         224 :     case t_MF_LINEAR: case t_MF_LINEAR_BHN: return gequal0(gel(F,3));
    7052         833 :     default: return 0;
    7053             :   }
    7054             : }
    7055             : 
    7056             : /* check parameters rigorously, but not coefficients */
    7057             : static long
    7058         896 : mfisinspace_i(GEN mf, GEN F)
    7059             : {
    7060             :   GEN CHI1, CHI2, chi1, chi2, F1, F2, gk;
    7061         896 :   long Nmf, N, space = MF_get_space(mf);
    7062             : 
    7063         896 :   if (mfistrivial(F)) return 1;
    7064         889 :   N = mf_get_N(F);
    7065         889 :   Nmf = MF_get_N(mf);
    7066         889 :   if (space == mf_NEW)
    7067         231 :   { if (N != Nmf) return 0; }
    7068             :   else
    7069         658 :   { if (Nmf % N) return 0; }
    7070         826 :   gk = mf_get_gk(F);
    7071         826 :   if (!gequal(MF_get_gk(mf), gk)) return 0;
    7072         826 :   CHI2 = mf_get_CHI(F);
    7073         826 :   CHI1 = MF_get_CHI(mf);
    7074             :   /* are the primitive chars attached to CHI1 and CHI2 equal ? */
    7075         826 :   F1 = znconreyconductor(gel(CHI1,1), gel(CHI1,2), &chi1);
    7076         826 :   if (typ(F1) == t_VEC) F1 = gel(F1,1);
    7077         826 :   F2 = znconreyconductor(gel(CHI2,1), gel(CHI2,2), &chi2);
    7078         826 :   if (typ(F2) == t_VEC) F2 = gel(F2,1);
    7079         826 :   return equalii(F1,F2) && ZV_equal(chi1,chi2);
    7080             : }
    7081             : static void
    7082           7 : err_space(GEN F)
    7083             : {
    7084           7 :   pari_err_DOMAIN("mftobasis", "form", "does not belong to",
    7085             :                   strtoGENstr("space"), F);
    7086           0 : }
    7087             : 
    7088             : static long
    7089         140 : mfcheapeisen(GEN mf)
    7090             : {
    7091         140 :   long k, L, N = MF_get_N(mf);
    7092             :   GEN P;
    7093         140 :   if (N <= 70) return 1;
    7094          84 :   k = itos(gceil(MF_get_gk(mf)));
    7095          84 :   if (odd(k)) k--;
    7096          84 :   switch (k)
    7097             :   {
    7098           0 :     case 2:  L = 190; break;
    7099          14 :     case 4:  L = 162; break;
    7100             :     case 6:
    7101          70 :     case 8:  L = 88; break;
    7102           0 :     case 10: L = 78; break;
    7103           0 :     default: L = 66; break;
    7104             :   }
    7105          84 :   P = gel(myfactoru(N), 1);
    7106          84 :   return P[lg(P)-1] <= L;
    7107             : }
    7108             : 
    7109             : static GEN
    7110         168 : myimag_i(GEN tau)
    7111             : {
    7112         168 :   long tc = typ(tau);
    7113         168 :   if (tc == t_INFINITY || tc == t_INT || tc == t_FRAC)
    7114          28 :     return gen_1;
    7115         140 :   if (tc == t_VEC)
    7116             :   {
    7117             :     long ltau, i;
    7118           7 :     GEN z = cgetg_copy(tau, &ltau);
    7119           7 :     for (i=1; i<ltau; i++) gel(z,i) = myimag_i(gel(tau,i));
    7120           7 :     return z;
    7121             :   }
    7122         133 :   return imag_i(tau);
    7123             : }
    7124             : 
    7125             : static GEN
    7126         140 : mintau(GEN vtau)
    7127             : {
    7128         140 :   if (!is_vec_t(typ(vtau))) return myimag_i(vtau);
    7129           7 :   return (lg(vtau) == 1)? gen_1: vecmin(myimag_i(vtau));
    7130             : }
    7131             : 
    7132             : /* initialization for mfgaexpansion: what does not depend on cusp */
    7133             : static GEN
    7134         644 : mf_eisendec(GEN mf, GEN F, long prec)
    7135             : {
    7136         644 :   GEN B = liftpol_shallow(mfeisensteindec(mf, F)), v = variables_vecsmall(B);
    7137         644 :   GEN Mvecj = obj_check(mf, MF_EISENSPACE);
    7138         644 :   long l = lg(v), i, ord;
    7139         644 :   if (lg(Mvecj) < 5) Mvecj = gel(Mvecj,1);
    7140         644 :   ord = itou(gel(Mvecj,4));
    7141         693 :   for (i = 1; i < l; i++)
    7142         483 :     if (v[i] != 1) { B = gsubst(B, v[i], rootsof1u_cx(ord, prec)); break; }
    7143         644 :   return B;
    7144             : }
    7145             : 
    7146             : GEN
    7147         154 : mfeval(GEN mf, GEN F, GEN vtau, long bitprec)
    7148             : {
    7149         154 :   pari_sp av = avma;
    7150         154 :   long flnew = 1;
    7151         154 :   if (!checkMF_i(mf)) pari_err_TYPE("mfeval", mf);
    7152         154 :   if (!checkmf_i(F)) pari_err_TYPE("mfeval", F);
    7153         154 :   if (!mfisinspace_i(mf, F)) err_space(F);
    7154         154 :   if (!obj_check(mf, MF_EISENSPACE)) flnew = mfcheapeisen(mf);
    7155         154 :   if (flnew && gcmpgs(gmulsg(2*MF_get_N(mf), mintau(vtau)), 1) >= 0) flnew = 0;
    7156         154 :   return gerepilecopy(av, mfeval_i(mf, F, vtau, flnew, bitprec));
    7157             : }
    7158             : 
    7159             : static long
    7160         182 : val(GEN v, long bit)
    7161             : {
    7162         182 :   long c, l = lg(v);
    7163         399 :   for (c = 1; c < l; c++)
    7164         385 :     if (gexpo(gel(v,c)) > -bit) return c-1;
    7165          14 :   return -1;
    7166             : }
    7167             : GEN
    7168         196 : mfcuspval(GEN mf, GEN F, GEN cusp, long bitprec)
    7169             : {
    7170         196 :   pari_sp av = avma;
    7171         196 :   long lvE, w, N, sb, n, A, C, prec = nbits2prec(bitprec);
    7172             :   GEN ga, gk, vE;
    7173         196 :   checkMF(mf);
    7174         196 :   if (!checkmf_i(F)) pari_err_TYPE("mfcuspval",F);
    7175         196 :   N = MF_get_N(mf);
    7176         196 :   cusp_canon(cusp, N, &A, &C);
    7177         196 :   gk = mf_get_gk(F);
    7178         196 :   if (typ(gk) != t_INT)
    7179             :   {
    7180          42 :     GEN FT = mfmultheta(F), mf2 = obj_checkbuild(mf, MF_MF2INIT, &mf2init);
    7181          42 :     GEN r = mfcuspval(mf2, FT, cusp, bitprec);
    7182          42 :     if ((C & 3L) == 2)
    7183             :     {
    7184          14 :       GEN z = sstoQ(1,4);
    7185          14 :       r = gsub(r, typ(r) == t_VEC? const_vec(lg(r)-1, z): z);
    7186             :     }
    7187          42 :     return gerepileupto(av, r);
    7188             :   }
    7189         154 :   vE = mfgetembed(F, prec);
    7190         154 :   lvE = lg(vE);
    7191         154 :   w = mfcuspcanon_width(N, C);
    7192         154 :   sb = w * mfsturmNk(N, itos(gk));
    7193         154 :   ga = cusp2mat(A,C);
    7194         161 :   for (n = 8;; n = minss(sb, n << 1))
    7195             :   {
    7196         161 :     GEN R = mfgaexpansion(mf, F, ga, n, prec), res = liftpol_shallow(gel(R,3));
    7197         161 :     GEN v = cgetg(lvE-1, t_VECSMALL);
    7198         161 :     long j, ok = 1;
    7199         161 :     res = RgC_embedall(res, vE);
    7200         343 :     for (j = 1; j < lvE; j++)
    7201             :     {
    7202         182 :       v[j] = val(gel(res,j), bitprec/2);
    7203         182 :       if (v[j] < 0) ok = 0;
    7204             :     }
    7205         161 :     if (ok)
    7206             :     {
    7207         147 :       res = cgetg(lvE, t_VEC);
    7208         147 :       for (j = 1; j < lvE; j++) gel(res,j) = gadd(gel(R,1), sstoQ(v[j], w));
    7209         147 :       return gerepilecopy(av, lvE==2? gel(res,1): res);
    7210             :     }
    7211          14 :     if (n == sb) return lvE==2? mkoo(): const_vec(lvE-1, mkoo()); /* 0 */
    7212           7 :   }
    7213             : }
    7214             : 
    7215             : long
    7216         196 : mfiscuspidal(GEN mf, GEN F)
    7217             : {
    7218         196 :   pari_sp av = avma;
    7219             :   GEN mf2;
    7220         196 :   if (space_is_cusp(MF_get_space(mf))) return 1;
    7221          77 :   if (typ(mf_get_gk(F)) == t_INT)
    7222             :   {
    7223          49 :     GEN v = mftobasis(mf, F, 0);
    7224          49 :     long s = gequal0(vecslice(v, 1, lg(MF_get_E(mf)) - 1));
    7225          49 :     avma = av; return s;
    7226             :   }
    7227          28 :   if (!gequal0(mfak_i(F, 0))) return 0;
    7228          14 :   mf2 = obj_checkbuild(mf, MF_MF2INIT, &mf2init);
    7229          14 :   return mfiscuspidal(mf2, mfmultheta(F));
    7230             : }
    7231             : 
    7232             : static GEN
    7233          42 : mffrickeeigen_i(GEN mf, GEN vE, long prec)
    7234             : {
    7235          42 :   GEN M, F, Z, L0, gN = MF_get_gN(mf), gk = MF_get_gk(mf);
    7236          42 :   long N0, i, lM, bit = prec2nbits(prec), k = itou(gk);
    7237          42 :   long LIM = 5; /* Sturm bound is enough */
    7238             : 
    7239          42 :   F = MF_get_newforms(mf);
    7240          42 :   L0 = mfthetaancreate(NULL, gN, gk); /* only for thetacost */
    7241             : START:
    7242          42 :   N0 = lfunthetacost(L0, gen_1, LIM, bit);
    7243          42 :   M = mfcoefs_mf(mf, N0, 1);
    7244          42 :   lM = lg(F);
    7245          42 :   Z = cgetg(lM, t_VEC);
    7246         154 :   for (i = 1; i < lM; i++)
    7247             :   { /* expansion of D * F[i] */
    7248         112 :     GEN D, z, van = RgM_RgC_mul(M, Q_remove_denom(gel(F,i), &D));
    7249         112 :     GEN L = van_embedall(van, gel(vE,i), gN, gk);
    7250         112 :     long l = lg(L), j, bit_add = D? expi(D): 0;
    7251         112 :     gel(Z,i) = z = cgetg(l, t_VEC);
    7252         273 :     for (j = 1; j < l; j++)
    7253             :     {
    7254             :       GEN v, C, C0;
    7255             :       long m, e;
    7256         224 :       for (m = 0; m <= LIM; m++)
    7257             :       {
    7258         224 :         v = lfuntheta(gmael(L,j,2), gen_1, m, bit);
    7259         224 :         if (gexpo(v) > bit_add - bit/2) break;
    7260             :       }
    7261         161 :       if (m > LIM) { LIM <<= 1; goto START; }
    7262         161 :       C = mulcxpowIs(gdiv(v,gconj(v)), 2*m - k);
    7263         161 :       C0 = grndtoi(C, &e); if (e < 5-bit) C = C0;
    7264         161 :       gel(z,j) = C;
    7265             :     }
    7266             :   }
    7267          42 :   return Z;
    7268             : }
    7269             : static GEN
    7270          42 : mffrickeeigen(GEN mf, GEN vE, long prec)
    7271             : {
    7272          42 :   GEN D = obj_check(mf, MF_FRICKE);
    7273          42 :   if (D) { long p = gprecision(D); if (!p || p >= prec) return D; }
    7274          42 :   return obj_insert(mf, MF_FRICKE, mffrickeeigen_i(mf,vE,prec));
    7275             : }
    7276             : 
    7277             : /* integral weight, new space for primitive quadratic character CHIP;
    7278             :  * MF = vector of embedded eigenforms coefs on mfbasis, by orbit.
    7279             :  * Assume N > Q > 1 and (Q,f(CHIP)) = 1 */
    7280             : static GEN
    7281          28 : mfatkineigenquad(GEN mf, GEN CHIP, long Q, GEN MF, long bitprec)
    7282             : {
    7283             :   GEN L0, la2, S, F, vP, tau, wtau, Z, va, vb, den, coe, sqrtQ, sqrtN;
    7284          28 :   GEN M, gN, gk = MF_get_gk(mf);
    7285          28 :   long N0, t, yq, i, j, lF, dim, muQ, prec = nbits2prec(bitprec);
    7286          28 :   long N = MF_get_N(mf), k = itos(gk), NQ = N / Q;
    7287             : 
    7288             :   /* Q coprime to FC */
    7289          28 :   F = MF_get_newforms(mf);
    7290          28 :   vP = MF_get_fields(mf);
    7291          28 :   lF = lg(F);
    7292          28 :   Z = cgetg(lF, t_VEC);
    7293          28 :   S = MF_get_S(mf); dim = lg(S) - 1;
    7294          28 :   muQ = mymoebiusu(Q);
    7295          28 :   if (muQ)
    7296             :   {
    7297          14 :     GEN SQ = cgetg(dim+1,t_VEC), Qk = gpow(stoi(Q), sstoQ(k-2, 2), prec);
    7298          14 :     long i, bit2 = bitprec >> 1;
    7299          14 :     for (j = 1; j <= dim; j++) gel(SQ,j) = mfak_i(gel(S,j), Q);
    7300          28 :     for (i = 1; i < lF; i++)
    7301             :     {
    7302          14 :       GEN S = RgV_dotproduct(gel(F,i), SQ), T = gel(vP,i);
    7303             :       long e;
    7304          14 :       if (degpol(T) > 1 && typ(S) != t_POLMOD) S = gmodulo(S, T);
    7305          14 :       S = grndtoi(gdiv(conjvec(S, prec), Qk), &e);
    7306          14 :       if (e > -bit2) pari_err_PREC("mfatkineigenquad");
    7307          14 :       if (muQ == -1) S = gneg(S);
    7308          14 :       gel(Z,i) = S;
    7309             :     }
    7310          14 :     return Z;
    7311             :   }
    7312          14 :   la2 = mfchareval_i(CHIP, Q); /* 1 or -1 */
    7313          14 :   (void)cbezout(Q, NQ, &t, &yq);
    7314          14 :   sqrtQ = sqrtr_abs(utor(Q,prec));
    7315          14 :   tau = mkcomplex(gadd(sstoQ(-t, NQ), ginv(utoi(1000))),
    7316             :                   divru(sqrtQ, N));
    7317          14 :   den = gaddgs(gmulsg(NQ, tau), t);
    7318          14 :   wtau = gdiv(gsub(tau, sstoQ(yq, Q)), den);
    7319          14 :   coe = gpowgs(gmul(sqrtQ, den), k);
    7320             : 
    7321          14 :   sqrtN = sqrtr_abs(utor(N,prec));
    7322          14 :   tau  = mulcxmI(gmul(tau,  sqrtN));
    7323          14 :   wtau = mulcxmI(gmul(wtau, sqrtN));
    7324          14 :   gN = utoipos(N);
    7325          14 :   L0 = mfthetaancreate(NULL, gN, gk); /* only for thetacost */
    7326          14 :   N0 = maxss(lfunthetacost(L0,real_i(tau), 0,bitprec),
    7327             :              lfunthetacost(L0,real_i(wtau),0,bitprec));
    7328          14 :   M = mfcoefs_mf(mf, N0, 1);
    7329          14 :   va = cgetg(dim+1, t_VEC);
    7330          14 :   vb = cgetg(dim+1, t_VEC);
    7331         105 :   for (j = 1; j <= dim; j++)
    7332             :   {
    7333          91 :     GEN L, v = vecslice(gel(M,j), 2, N0+1); /* remove a0 */
    7334          91 :     settyp(v, t_VEC); L = mfthetaancreate(v, gN, gk);
    7335          91 :     gel(va,j) = lfuntheta(L, tau,0,bitprec);
    7336          91 :     gel(vb,j) = lfuntheta(L,wtau,0,bitprec);
    7337             :   }
    7338          84 :   for (i = 1; i < lF; i++)
    7339             :   {
    7340          70 :     GEN z, FE = gel(MF,i);
    7341          70 :     long l = lg(FE);
    7342          70 :     z = cgetg(l, t_VEC);
    7343          70 :     for (j = 1; j < l; j++)
    7344             :     {
    7345          70 :       GEN f = gel(FE,j), a = RgV_dotproduct(va,f), b = RgV_dotproduct(vb,f);
    7346          70 :       GEN la = ground( gdiv(b, gmul(a,coe)) );
    7347          70 :       if (!gequal(gsqr(la), la2)) pari_err_PREC("mfatkineigenquad");
    7348          70 :       if (typ(la) == t_INT)
    7349             :       {
    7350          70 :         if (j != 1) pari_err_BUG("mfatkineigenquad");
    7351          70 :         z = const_vec(l-1, la); break;
    7352             :       }
    7353           0 :       gel(z,j) = la;
    7354             :     }
    7355          70 :     gel(Z,i) = z;
    7356             :   }
    7357          14 :   return Z;
    7358             : }
    7359             : 
    7360             : static GEN
    7361          70 : myusqrt(ulong a, long prec)
    7362             : {
    7363          70 :   if (a == 1UL) return gen_1;
    7364          56 :   if (uissquareall(a, &a)) return utoipos(a);
    7365          42 :   return sqrtr_abs(utor(a, prec));
    7366             : }
    7367             : /* Assume mf is a non-trivial new space, rational primitive character CHIP
    7368             :  * and (Q,FC) = 1 */
    7369             : static GEN
    7370          63 : mfatkinmatnewquad(GEN mf, GEN CHIP, long Q, long flag, long PREC)
    7371             : {
    7372          63 :   GEN cM, M, D, MF, den, vE, F = MF_get_newforms(mf);
    7373          63 :   long i, c, e, prec, bitprec, lF = lg(F), N = MF_get_N(mf), k = MF_get_k(mf);
    7374             : 
    7375          63 :   if (Q == 1) return mkvec4(gen_0, matid(MF_get_dim(mf)), gen_1, mf);
    7376          49 :   den = gel(MF_get_Minv(mf), 2);
    7377          49 :   bitprec = expi(den) + 64;
    7378          49 :   if (!flag) bitprec = maxss(bitprec, prec2nbits(PREC));
    7379             : 
    7380             : START:
    7381          49 :   prec = nbits2prec(bitprec);
    7382          49 :   vE = mfeigenembed(mf, prec);
    7383          49 :   M = cgetg(lF, t_VEC);
    7384          49 :   for (i = 1; i < lF; i++) gel(M,i) = RgC_embedall(gel(F,i), gel(vE,i));
    7385          49 :   if (Q != N)
    7386             :   {
    7387          28 :     D = mfatkineigenquad(mf, CHIP, Q, M, bitprec);
    7388          28 :     c = odd(k)? Q: 1;
    7389             :   }
    7390             :   else
    7391             :   {
    7392          21 :     D = mffrickeeigen(mf, vE, DEFAULTPREC);
    7393          21 :     c = mfcharmodulus(CHIP); if (odd(k)) c = -Q/c;
    7394             :   }
    7395          49 :   D = shallowconcat1(D);
    7396          49 :   if (vec_isconst(D)) { MF = diagonal_shallow(D); flag = 0; }
    7397             :   else
    7398             :   {
    7399          35 :     M = shallowconcat1(M);
    7400          35 :     MF = RgM_mul(matmuldiagonal(M,D), ginv(M));
    7401             :   }
    7402          49 :   if (!flag) return mkvec4(gen_0, MF, gen_1, mf);
    7403             : 
    7404          21 :   if (c > 0)
    7405          21 :     cM = myusqrt(c, PREC);
    7406             :   else
    7407             :   {
    7408           0 :     MF = imag_i(MF); c = -c;
    7409           0 :     cM = mkcomplex(gen_0, myusqrt(c,PREC));
    7410             :   }
    7411          21 :   if (c != 1) MF = RgM_Rg_mul(MF, myusqrt(c,prec));
    7412          21 :   MF = grndtoi(RgM_Rg_mul(MF,den), &e);
    7413          21 :   if (e > -32) { bitprec <<= 1; goto START; }
    7414          21 :   MF = RgM_Rg_div(MF, den);
    7415          21 :   if (is_rational_t(typ(cM)) && !isint1(cM))
    7416           0 :   { MF = RgM_Rg_div(MF, cM); cM = gen_1; }
    7417          21 :   return mkvec4(gen_0, MF, cM, mf);
    7418             : }
    7419             : 
    7420             : /* let CHI mod N, Q || N, return \bar{CHI_Q} * CHI_{N/Q} */
    7421             : static GEN
    7422          70 : mfcharAL(GEN CHI, long Q)
    7423             : {
    7424          70 :   GEN G = gel(CHI,1), c = gel(CHI,2), cycc, d, P, E, F;
    7425          70 :   long l = lg(c), N = mfcharmodulus(CHI), i;
    7426          70 :   if (N == Q) return mfcharconj(CHI);
    7427          42 :   if (N == 1) return CHI;
    7428          42 :   CHI = leafcopy(CHI);
    7429          42 :   gel(CHI,2) = d = leafcopy(c);
    7430          42 :   F = znstar_get_faN(G);
    7431          42 :   P = gel(F,1);
    7432          42 :   E = gel(F,2);
    7433          42 :   cycc = znstar_get_conreycyc(G);
    7434          42 :   if (!odd(Q) && equaliu(gel(P,1), 2) && E[1] >= 3)
    7435          14 :     gel(d,2) = Fp_neg(gel(d,2), gel(cycc,2));
    7436          56 :   else for (i = 1; i < l; i++)
    7437          28 :     if (!umodui(Q, gel(P,i))) gel(d,i) = Fp_neg(gel(d,i), gel(cycc,i));
    7438          42 :   return CHI;
    7439             : }
    7440             : static long
    7441         154 : atkin_get_NQ(long N, long Q, const char *f)
    7442             : {
    7443         154 :   long NQ = N / Q;
    7444         154 :   if (N % Q) pari_err_DOMAIN(f,"N % Q","!=",gen_0,utoi(Q));
    7445         154 :   if (cgcd(NQ, Q) > 1) pari_err_DOMAIN(f,"gcd(Q,N/Q)","!=",gen_1,utoi(Q));
    7446         154 :   return NQ;
    7447             : }
    7448             : /* if flag = 1, rationalize, else don't */
    7449             : static GEN
    7450         133 : mfatkininit_i(GEN mf, long Q, long flag, long prec)
    7451             : {
    7452             :   GEN M, B, C, CHI, CHIAL, G, chi, P, z, g, mfB, s, Mindex, Minv;
    7453         133 :   long j, l, lim, ord, FC, NQ, cQ, nk, dk, N = MF_get_N(mf);
    7454             : 
    7455         133 :   B = MF_get_basis(mf); l = lg(B);
    7456         133 :   M = cgetg(l, t_MAT); if (l == 1) return mkvec4(gen_0,M,gen_1,mf);
    7457         133 :   Qtoss(MF_get_gk(mf), &nk,&dk);
    7458         133 :   Q = labs(Q);
    7459         133 :   NQ = atkin_get_NQ(N, Q, "mfatkininit");
    7460         133 :   CHI = MF_get_CHI(mf);
    7461         133 :   CHI = mfchartoprimitive(CHI, &FC);
    7462         133 :   ord = mfcharorder_canon(CHI);
    7463         133 :   if (MF_get_space(mf) == mf_NEW && ord == 1 && NQ % FC == 0 && dk == 1)
    7464          63 :     return mfatkinmatnewquad(mf, CHI, Q, flag, prec);
    7465             :   /* now flag != 0 */
    7466          70 :   G   = gel(CHI,1);
    7467          70 :   chi = gel(CHI,2);
    7468          70 :   if (Q == N) { g = mkmat22s(0, -1, N, 0); cQ = NQ; } /* Fricke */
    7469             :   else
    7470             :   {
    7471          28 :     GEN F, gQP = utoi(cgcd(Q, FC));
    7472             :     long t, v;
    7473          28 :     chi = znchardecompose(G, chi, gQP);
    7474          28 :     F = znconreyconductor(G, chi, &chi);
    7475          28 :     G = znstar0(F,1);
    7476          28 :     (void)cbezout(Q, NQ, &t, &v);
    7477          28 :     g = mkmat22s(Q, 1, -N*v, Q*t);
    7478          28 :     cQ = -NQ*v;
    7479             :   }
    7480          70 :   C = s = gen_1;
    7481             :   /* N.B. G,chi are G_Q,chi_Q [primitive] at this point */
    7482          70 :   if (lg(chi) != 1) C = ginv( znchargauss(G, chi, gen_1, prec2nbits(prec)) );
    7483          70 :   if (dk == 1)
    7484          63 :   { if (odd(nk)) s = myusqrt(Q,prec); }
    7485             :   else
    7486             :   {
    7487           7 :     long r = nk >> 1; /* k-1/2 */
    7488           7 :     s = gpow(utoipos(Q), mkfracss(odd(r)? 1: 3, 4), prec);
    7489           7 :     if (odd(cQ))
    7490             :     {
    7491           7 :       long t = r + ((cQ-1) >> 1);
    7492           7 :       s = mkcomplex(s, odd(t)? gneg(s): s);
    7493             :     }
    7494             :   }
    7495          70 :   if (!isint1(s)) C = gmul(C, s);
    7496          70 :   CHIAL = mfcharAL(CHI, Q);
    7497          70 :   if (dk == 2)
    7498           7 :     CHIAL = mfcharmul(CHIAL, induce(gel(CHIAL,1), utoipos(odd(Q) ? Q<<2 : Q)));
    7499          70 :   CHIAL = mfchartoprimitive(CHIAL,NULL);
    7500          70 :   mfB = gequal(CHIAL,CHI)? mf: mfinit_Nndkchi(N,nk,dk,CHIAL,MF_get_space(mf),0);
    7501          70 :   Mindex = MF_get_Mindex(mfB);
    7502          70 :   Minv = MF_get_Minv(mfB);
    7503          70 :   P = z = NULL;
    7504          70 :   if (ord != 1) { P = mfcharpol(CHI); z = rootsof1u_cx(ord, prec); }
    7505          70 :   lim = maxss(mfsturm(mfB), mfsturm(mf)) + 1;
    7506         217 :   for (j = 1; j < l; j++)
    7507             :   {
    7508         147 :     GEN v = mfslashexpansion(mf, gel(B,j), g, lim, 0, NULL, prec+1);
    7509             :     long junk;
    7510         147 :     if (!isint1(C)) v = RgV_Rg_mul(v, C);
    7511         147 :     v = bestapprnf(v, P, z, prec);
    7512         147 :     v = vecpermute_partial(v, Mindex, &junk);
    7513         147 :     v = Minv_RgC_mul(Minv, v); /* cf mftobasis_i */
    7514         147 :     gel(M, j) = v;
    7515             :   }
    7516          70 :   if (is_rational_t(typ(C)) && !gequal1(C)) { M = gdiv(M, C); C = gen_1; }
    7517          70 :   if (mfB == mf) mfB = gen_0;
    7518          70 :   return mkvec4(mfB, M, C, mf);
    7519             : }
    7520             : GEN
    7521          77 : mfatkininit(GEN mf, long Q, long prec)
    7522             : {
    7523          77 :   pari_sp av = avma;
    7524          77 :   checkMF(mf); return gerepilecopy(av, mfatkininit_i(mf, Q, 1, prec));
    7525             : }
    7526             : static void
    7527          21 : checkmfa(GEN z)
    7528             : {
    7529          21 :   if (typ(z) != t_VEC || lg(z) != 5 || typ(gel(z,2)) != t_MAT
    7530          21 :       || !checkMF_i(gel(z,4))
    7531          21 :       || (!isintzero(gel(z,1)) && !checkMF_i(gel(z,1))))
    7532           0 :     pari_err_TYPE("mfatkin [please apply mfatkininit()]",z);
    7533          21 : }
    7534             : 
    7535             : /* Apply atkin Q to closure F */
    7536             : GEN
    7537          21 : mfatkin(GEN mfa, GEN F)
    7538             : {
    7539          21 :   pari_sp av = avma;
    7540             :   GEN z, mfB, MQ, mf;
    7541          21 :   checkmfa(mfa);
    7542          21 :   mfB= gel(mfa,1);
    7543          21 :   MQ = gel(mfa,2);
    7544          21 :   mf = gel(mfa,4);
    7545          21 :   if (typ(mfB) == t_INT) mfB = mf;
    7546          21 :   z = RgM_RgC_mul(MQ, mftobasis_i(mf,F));
    7547          21 :   return gerepileupto(av, mflinear(mfB, z));
    7548             : }
    7549             : 
    7550             : GEN
    7551          42 : mfatkineigenvalues(GEN mf, long Q, long prec)
    7552             : {
    7553          42 :   pari_sp av = avma;
    7554             :   GEN vF, L, CHI, M, mfatk, C, MQ, vE, mfB;
    7555             :   long N, NQ, l, i;
    7556             : 
    7557          42 :   checkMF(mf); N = MF_get_N(mf); CHI = MF_get_CHI(mf);
    7558          42 :   vF = MF_get_newforms(mf); l = lg(vF);
    7559          42 :   if (l == 1) { avma = av; return cgetg(1, t_VEC); }
    7560          42 :   L = cgetg(l, t_VEC);
    7561          42 :   if (Q == 1)
    7562             :   {
    7563           7 :     GEN vP = MF_get_fields(mf);
    7564           7 :     for (i = 1; i < l; i++) gel(L,i) = const_vec(degpol(gel(vP,i)), gen_1);
    7565           7 :     return L;
    7566             :   }
    7567          35 :   vE = mfeigenembed(mf,prec);
    7568          35 :   if (Q == N) return gerepileupto(av, mffrickeeigen(mf, vE, prec));
    7569          21 :   Q = labs(Q);
    7570          21 :   NQ = atkin_get_NQ(N, Q, "mfatkineigenvalues");
    7571          21 :   mfatk = mfatkininit(mf, Q, prec);
    7572          21 :   mfB= gel(mfatk,1); if (typ(mfB) != t_VEC) mfB = mf;
    7573          21 :   MQ = gel(mfatk,2);
    7574          21 :   C  = gel(mfatk,3);
    7575          21 :   M = row(mfcoefs_mf(mfB,1,1), 2); /* vec of a_1(b_i) for mfbasis functions */
    7576          56 :   for (i = 1; i < l; i++)
    7577             :   {
    7578          35 :     GEN c = RgV_dotproduct(RgM_RgC_mul(MQ,gel(vF,i)), M); /* C * eigen_i */
    7579          35 :     gel(L,i) = Rg_embedall(c, gel(vE,i));
    7580             :   }
    7581          21 :   if (!gequal1(C)) L = gdiv(L, C);
    7582          21 :   if (MF_get_space(mf) == mf_NEW && mfcharorder(CHI) <= 2
    7583           7 :       && (NQ==1 || NQ % mfcharconductor(CHI) == 0)
    7584           7 :       && typ(MF_get_gk(mf)) == t_INT) L = ground(L);
    7585          21 :   return gerepilecopy(av, L);
    7586             : }
    7587             : 
    7588             : /* expand B_d V, keeping same length */
    7589             : static GEN
    7590        4256 : bdexpand(GEN V, long d)
    7591             : {
    7592             :   GEN W;
    7593             :   long N, n;
    7594        4256 :   if (d == 1) return V;
    7595        1540 :   N = lg(V)-1; W = zerovec(N);
    7596        1540 :   for (n = 0; n <= (N-1)/d; n++) gel(W, n*d+1) = gel(V, n+1);
    7597        1540 :   return W;
    7598             : }
    7599             : /* expand B_d V, increasing length up to lim */
    7600             : static GEN
    7601         231 : bdexpandall(GEN V, long d, long lim)
    7602             : {
    7603             :   GEN W;
    7604             :   long N, n;
    7605         231 :   if (d == 1) return V;
    7606          35 :   N = lg(V)-1; W = zerovec(lim);
    7607          35 :   for (n = 0; n <= N-1 && n*d <= lim; n++) gel(W, n*d+1) = gel(V, n+1);
    7608          35 :   return W;
    7609             : }
    7610             : 
    7611             : static void
    7612        5978 : parse_vecj(GEN T, GEN *E1, GEN *E2)
    7613             : {
    7614        5978 :   if (lg(T)==3) { *E1 = gel(T,1); *E2 = gel(T,2); }
    7615        2807 :   else { *E1 = T; *E2 = NULL; }
    7616        5978 : }
    7617             : 
    7618             : /* g in M_2(Z) ? */
    7619             : static int
    7620        1729 : check_M2Z(GEN g)
    7621        1729 : {  return typ(g) == t_MAT && lg(g) == 3 && lgcols(g) == 3 && RgM_is_ZM(g); }
    7622             : /* g in SL_2(Z) ? */
    7623             : static int
    7624        1050 : check_SL2Z(GEN g) { return check_M2Z(g) && equali1(ZM_det(g)); }
    7625             : 
    7626             : static GEN
    7627        6552 : mfcharcxeval(GEN CHI, long n, long prec)
    7628             : {
    7629             :   GEN ordg;
    7630             :   ulong ord;
    7631        6552 :   if (cgcd(mfcharmodulus(CHI), n) > 1) return gen_0;
    7632        6552 :   ordg = gmfcharorder(CHI);
    7633        6552 :   ord = itou(ordg);
    7634        6552 :   return rootsof1q_cx(znchareval_i(CHI,n,ordg), ord, prec);
    7635             : }
    7636             : 
    7637             : static GEN
    7638        3983 : RgV_shift(GEN V, GEN gn)
    7639             : {
    7640             :   long i, n, l;
    7641             :   GEN W;
    7642        3983 :   if (typ(gn) != t_INT) pari_err_BUG("RgV_shift [n not integral]");
    7643        3983 :   n = itos(gn);
    7644        3983 :   if (n < 0) pari_err_BUG("RgV_shift [n negative]");
    7645        3983 :   if (!n) return V;
    7646          98 :   W = cgetg_copy(V, &l); if (n > l-1) n = l-1;
    7647          98 :   for (i=1; i <= n; i++) gel(W,i) = gen_0;
    7648          98 :   for (    ; i < l; i++) gel(W,i) = gel(V, i-n);
    7649          98 :   return W;
    7650             : }
    7651             : static GEN
    7652        6209 : hash_eisengacx(hashtable *H, void *E, long w, GEN ga, long n, long prec)
    7653             : {
    7654        6209 :   ulong h = H->hash(E);
    7655        6209 :   hashentry *e = hash_search2(H, E, h);
    7656             :   GEN v;
    7657        6209 :   if (e) v = (GEN)e->val;
    7658             :   else
    7659             :   {
    7660        3948 :     v = mfeisensteingacx((GEN)E, w, ga, n, prec);
    7661        3948 :     hash_insert2(H, E, (void*)v, h);
    7662             :   }
    7663        6209 :   return v;
    7664             : }
    7665             : static GEN
    7666        3983 : vecj_expand(GEN B, hashtable *H, long w, GEN ga, long n, long prec)
    7667             : {
    7668             :   GEN E1, E2, v;
    7669        3983 :   parse_vecj(B, &E1, &E2);
    7670        3983 :   v = hash_eisengacx(H, (void*)E1, w, ga, n, prec);
    7671        3983 :   if (E2)
    7672             :   {
    7673        2219 :     GEN u = hash_eisengacx(H, (void*)E2, w, ga, n, prec);
    7674        2219 :     GEN a = gadd(gel(v,1), gel(u,1));
    7675        2219 :     GEN b = RgV_mul_RgXn(gel(v,2), gel(u,2));
    7676        2219 :     v = mkvec2(a,b);
    7677             :   }
    7678        3983 :   return v;
    7679             : }
    7680             : static GEN
    7681         735 : shift_M(GEN M, GEN Valpha, long w)
    7682             : {
    7683         735 :   long i, l = lg(Valpha);
    7684         735 :   GEN almin = vecmin(Valpha);
    7685        4718 :   for (i = 1; i < l; i++)
    7686             :   {
    7687        3983 :     GEN alpha = gel(Valpha, i), gsh = gmulsg(w, gsub(alpha,almin));
    7688        3983 :     gel(M,i) = RgV_shift(gel(M,i), gsh);
    7689             :   }
    7690         735 :   return almin;
    7691             : }
    7692             : #if 0
    7693             : /* ga in M_2^+(Z)), n >= 0 */
    7694             : static GEN
    7695             : mfgaexpansion_init(GEN mf, GEN ga, long n, long prec)
    7696             : {
    7697             :   GEN M, Mvecj, vecj, almin, Valpha;
    7698             :   long i, w, l, N = MF_get_N(mf), c = itos(gcoeff(ga,2,1));
    7699             :   hashtable *H;
    7700             : 
    7701             :   if (c % N == 0)
    7702             :   { /* ga in G_0(N), trivial case; w = 1 */
    7703             :     GEN chid = mfcharcxeval(MF_get_CHI(mf), itos(gcoeff(ga,2,2)), prec);
    7704             :     return mkvec2(chid, utoi(n));
    7705             :   }
    7706             : 
    7707             :   Mvecj = obj_checkbuild(mf, MF_EISENSPACE, &mfeisensteinspaceinit);
    7708             :   if (lg(Mvecj) < 5) pari_err_IMPL("mfgaexpansion_init in this case");
    7709             :   w = mfcuspcanon_width(N, c);
    7710             :   vecj = gel(Mvecj, 3);
    7711             :   l = lg(vecj);
    7712             :   M = cgetg(l, t_VEC);
    7713             :   Valpha = cgetg(l, t_VEC);
    7714             :   H = hash_create(l, (ulong(*)(void*))&hash_GEN,
    7715             :                      (int(*)(void*,void*))&gidentical, 1);
    7716             :   for (i = 1; i < l; i++)
    7717             :   {
    7718             :     GEN v = vecj_expand(gel(vecj,i), H, w, ga, n, prec);
    7719             :     gel(Valpha,i) = gel(v,1);
    7720             :     gel(M,i) = gel(v,2);
    7721             :   }
    7722             :   almin = shift_M(M, Valpha, w);
    7723             :   return mkvec3(almin, utoi(w), M);
    7724             : }
    7725             : /* half-integer weight not supported; vF = [F,eisendec(F)].
    7726             :  * Minit = mfgaexpansion_init(mf, ga, n, prec) */
    7727             : static GEN
    7728             : mfgaexpansion_with_init(GEN Minit, GEN vF)
    7729             : {
    7730             :   GEN v;
    7731             :   if (lg(Minit) == 3)
    7732             :   { /* ga in G_0(N) */
    7733             :     GEN chid = gel(Minit,1), gn = gel(Minit,2);
    7734             :     v = mfcoefs_i(gel(vF,1), itou(gn), 1);
    7735             :     v = mkvec3(gen_0, gen_1, RgV_Rg_mul(v,chid));
    7736             :   }
    7737             :   else
    7738             :   {
    7739             :     GEN V = RgM_RgC_mul(gel(Minit,3), gel(vF,2));
    7740             :     v = mkvec3(gel(Minit,1), gel(Minit,2), V);
    7741             :   }
    7742             :   return v;
    7743             : }
    7744             : #endif
    7745             : 
    7746             : /* B = mfeisensteindec(F) already embedded, ga in M_2^+(Z)), n >= 0 */
    7747             : static GEN
    7748         735 : mfgaexpansion_i(GEN mf, GEN B0, GEN ga, long n, long prec)
    7749             : {
    7750         735 :   GEN M, Mvecj, vecj, almin, Valpha, B, E = NULL;
    7751         735 :   long i, j, w, nw, l, N = MF_get_N(mf), bit = prec2nbits(prec) / 2;
    7752             :   hashtable *H;
    7753             : 
    7754         735 :   Mvecj = obj_checkbuild(mf, MF_EISENSPACE, &mfeisensteinspaceinit);
    7755         735 :   if (lg(Mvecj) < 5) { E = gel(Mvecj, 2); Mvecj = gel(Mvecj, 1); }
    7756         735 :   vecj = gel(Mvecj, 3);
    7757         735 :   l = lg(vecj);
    7758         735 :   B = cgetg(l, t_COL);
    7759         735 :   M = cgetg(l, t_VEC);
    7760         735 :   Valpha = cgetg(l, t_VEC);
    7761         735 :   w = mfZC_width(N, gel(ga,1));
    7762         735 :   nw = E ? n + w : n;
    7763         735 :   H = hash_create(l, (ulong(*)(void*))&hash_GEN,
    7764             :                      (int(*)(void*,void*))&gidentical, 1);
    7765        6482 :   for (i = j = 1; i < l; i++)
    7766             :   {
    7767             :     GEN v;
    7768        5747 :     if (gequal0(gel(B0,i))) continue;
    7769        3983 :     v = vecj_expand(gel(vecj,i), H, w, ga, nw, prec);
    7770        3983 :     gel(B,j) = gel(B0,i);
    7771        3983 :     gel(Valpha,j) = gel(v,1);
    7772        3983 :     gel(M,j) = gel(v,2); j++;
    7773             :   }
    7774         735 :   setlg(Valpha, j);
    7775         735 :   setlg(B, j);
    7776         735 :   setlg(M, j); l = j;
    7777         735 :   if (l == 1) return mkvec3(gen_0, utoi(w), zerovec(n+1));
    7778         735 :   almin = shift_M(M, Valpha, w);
    7779         735 :   B = RgM_RgC_mul(M, B); l = lg(B);
    7780       39067 :   for (i = 1; i < l; i++)
    7781       38332 :     if (gexpo(gel(B,i)) < -bit) gel(B,i) = gen_0;
    7782         735 :   settyp(B, t_VEC);
    7783         735 :   if (E)
    7784             :   {
    7785           7 :     GEN v = hash_eisengacx(H, (void*)E, w, ga, n, prec);
    7786           7 :     long ell = 0;
    7787           7 :     almin = gsub(almin, gel(v,1));
    7788           7 :     if (gsigne(almin) < 0)
    7789             :     {
    7790           0 :       GEN gell = gceil(gmulsg(-w, almin));
    7791           0 :       ell = itos(gell);
    7792           0 :       almin = gadd(almin, gdivgs(gell, w));
    7793           0 :       if (nw < ell) pari_err_IMPL("alpha < 0 in mfgaexpansion");
    7794             :     }
    7795           7 :     B = vecslice(B, ell + 1, n + ell + 1);
    7796           7 :     B = RgV_div_RgXn(B, gel(v,2));
    7797             :   }
    7798         735 :   return mkvec3(almin, utoi(w), B);
    7799             : }
    7800             : 
    7801             : /* Theta multiplier: assume 4 | C, (C,D)=1 */
    7802             : static GEN
    7803          56 : mfthetamultiplier(long C, long D)
    7804             : {
    7805          56 :   long s = kross(C, D);
    7806          56 :   if ((D&3L) == 1) return stoi(s);
    7807           7 :   return s > 0 ? powIs(3) : gen_I();
    7808             : }
    7809             : static GEN
    7810          56 : mfthetaexpansion(GEN M, long n)
    7811             : {
    7812          56 :   GEN s, al, sla, V = zerovec(n + 1);
    7813          56 :   long w, lim, la, f, C = itos(gcoeff(M, 2, 1)), D = itos(gcoeff(M, 2, 2));
    7814          56 :   switch (C & 3L)
    7815             :   {
    7816           0 :     case 0: al = gen_0; w = 1;
    7817           0 :       s = mfthetamultiplier(C,D);
    7818           0 :       lim = usqrt(n); gel(V, 1) = s;
    7819           0 :       s = gmul2n(s, 1);
    7820           0 :       for (f = 1; f <= lim; f++) gel(V, f*f + 1) = s;
    7821           0 :       break;
    7822          21 :     case 2: al = sstoQ(1,4); w = 1;
    7823          21 :       s = gmul2n(mfthetamultiplier(C - 2*D, D), 1);
    7824          21 :       lim = (usqrt(n << 2) - 1) >> 1;
    7825          21 :       for (f = 0; f <= lim; f++) gel(V, f*(f+1) + 1) = s;
    7826          21 :       break;
    7827          35 :     default: al = gen_0; w = 4; la = (-D*C) & 3L;
    7828          35 :       s = mfthetamultiplier(-(D + la*C), C);
    7829          35 :       s = gsub(s, mulcxI(s));
    7830          35 :       sla = gmul(s, powIs(-la));
    7831          35 :       lim = usqrt(n); gel(V, 1) = gmul2n(s, -1);
    7832          35 :       for (f = 1; f <= lim; f++) gel(V, f*f + 1) = odd(f) ? sla : s;
    7833          35 :       break;
    7834             :   }
    7835          56 :   return mkvec3(al, stoi(w), V);
    7836             : }
    7837             : 
    7838             : /* F 1/2 integral weight */
    7839             : static GEN
    7840          56 : mf2gaexpansion(GEN mf2, GEN F, GEN ga, long n, long prec)
    7841             : {
    7842          56 :   GEN FT = mfmultheta(F), mf = obj_checkbuild(mf2, MF_MF2INIT, &mf2init);
    7843             :   GEN res, V1, Tres, V2, al, V, gsh;
    7844          56 :   long w2, C = itos(gcoeff(ga,2,1)), w = mfcuspcanon_width(mf_get_N(FT), C);
    7845          56 :   long ext = ((C & 3L) != 2)? 0: (w+3) >> 2;
    7846             : 
    7847          56 :   res = mfgaexpansion(mf, FT, ga, n + ext, prec);
    7848          56 :   Tres = mfthetaexpansion(ga, n + ext);
    7849          56 :   V1 = gel(res,3);
    7850          56 :   V2 = gel(Tres,3);
    7851          56 :   al = gsub(gel(res,1), gel(Tres,1));
    7852          56 :   w2 = itos(gel(Tres,2));
    7853          56 :   if (w != itos(gel(res,2)) || w % w2)
    7854           0 :     pari_err_BUG("mf2gaexpansion [incorrect w2 or w]");
    7855          56 :   if (w2 != w) V2 = bdexpand(V2, w/w2);
    7856          56 :   V = RgV_div_RgXn(V1, V2);
    7857          56 :   gsh = gfloor(gmulsg(w, al));
    7858          56 :   if (!gequal0(gsh))
    7859             :   {
    7860          14 :     al = gsub(al, gdivgs(gsh, w));
    7861          14 :     if (gsigne(gsh) > 0)
    7862             :     {
    7863           0 :       V = RgV_shift(V, gsh);
    7864           0 :       V = vecslice(V, 1, n + 1);
    7865             :     }
    7866             :     else
    7867             :     {
    7868          14 :       long sh = -itos(gsh), i;
    7869          14 :       if (sh > ext) pari_err_BUG("mf2gaexpansion [incorrect sh]");
    7870          56 :       for (i = 1; i <= sh; i++)
    7871          42 :         if (!gequal0(gel(V,i))) pari_err_BUG("mf2gaexpansion [sh too large]");
    7872          14 :       V = vecslice(V, sh+1, n + sh+1);
    7873             :     }
    7874             :   }
    7875          56 :   obj_free(mf); return mkvec3(al, stoi(w), V);
    7876             : }
    7877             : 
    7878             : static GEN
    7879          21 : mfgaexpansionatkin(GEN mf, GEN F, long C, long D, long Q, long n, long prec)
    7880             : {
    7881          21 :   GEN mfa = mfatkininit_i(mf, Q, 0, prec), MQ = gel(mfa,2);
    7882          21 :   long i, t, v, FC, k = MF_get_k(mf);
    7883          21 :   GEN V, z, s, CHI = mfchartoprimitive(MF_get_CHI(mf), &FC);
    7884             : 
    7885             :   /* V = mfcoefs(F | w_Q, n), can't use mfatkin because MQ non-rational */
    7886          21 :   V = RgM_RgC_mul(mfcoefs_mf(mf,n,1), RgM_RgC_mul(MQ, mftobasis_i(mf,F)));
    7887          21 :   (void)cbezout(Q, C, &t, &v);
    7888          21 :   s = mfchareval_i(CHI, (((t*Q) % FC) * D) % FC);
    7889          21 :   s = gdiv(s, gpow(utoipos(Q), sstoQ(k,2), prec));
    7890          21 :   V = RgV_Rg_mul(V, s);
    7891          21 :   z = rootsof1powinit(D*v % Q, Q, prec);
    7892          21 :   for (i = 1; i <= n+1; i++) gel(V,i) = gmul(gel(V,i), rootsof1pow(z, i-1));
    7893          21 :   return mkvec3(gen_0, utoipos(Q), V);
    7894             : }
    7895             : 
    7896             : /* allow F of the form [F, mf_eisendec(F)]~ */
    7897             : static GEN
    7898        1043 : mfgaexpansion(GEN mf, GEN F, GEN ga, long n, long prec)
    7899             : {
    7900        1043 :   GEN v, EF = NULL;
    7901             :   long c, d;
    7902             : 
    7903        1043 :   if (n < 0) pari_err_DOMAIN("mfgaexpansion", "n", "<", gen_0, stoi(n));
    7904        1043 :   if (typ(F) == t_COL && lg(F) == 3) { EF = gel(F,2); F = gel(F,1); }
    7905        1043 :   if (!checkmf_i(F)) pari_err_TYPE("mfgaexpansion", F);
    7906        1043 :   if (!check_SL2Z(ga)) pari_err_TYPE("mfgaexpansion",ga);
    7907        1043 :   if (typ(mf_get_gk(F)) != t_INT) return mf2gaexpansion(mf, F, ga, n, prec);
    7908         987 :   c = itos(gcoeff(ga,2,1));
    7909         987 :   d = itos(gcoeff(ga,2,2));
    7910         987 :   if (c % mf_get_N(F) == 0)
    7911             :   { /* trivial case: ga in Gamma_0(N) */
    7912         231 :     long N = MF_get_N(mf), w = mfcuspcanon_width(N,c);
    7913         231 :     GEN chid = mfcharcxeval(mf_get_CHI(F), d, prec);
    7914         231 :     v = mfcoefs_i(F, n/w, 1); if (!isint1(chid)) v = RgV_Rg_mul(v,chid);
    7915         231 :     return mkvec3(gen_0, stoi(w), bdexpandall(v,w,n+1));
    7916             :   }
    7917         756 :   if (MF_get_space(mf) == mf_NEW)
    7918             :   {
    7919         266 :     long N = MF_get_N(mf), g = cgcd(c,N), Q = N/g;
    7920         266 :     GEN CHI = MF_get_CHI(mf);
    7921         266 :     if (cgcd(c, Q)==1 && mfcharorder(CHI) <= 2
    7922          98 :                       && g % mfcharconductor(CHI) == 0
    7923          63 :                       && degpol(mf_get_field(F)) == 1)
    7924          21 :       return mfgaexpansionatkin(mf, F, c, d, Q, n, prec);
    7925             :   }
    7926         735 :   if (!EF) EF = mf_eisendec(mf,F,prec);
    7927         735 :   return mfgaexpansion_i(mf, EF, ga, n, prec);
    7928             : }
    7929             : 
    7930             : /* parity = -1 or +1 */
    7931             : static GEN
    7932         217 : findd(long N, long parity)
    7933             : {
    7934         217 :   GEN L, D = mydivisorsu(N);
    7935         217 :   long i, j, l = lg(D);
    7936         217 :   L = cgetg(l, t_VEC);
    7937        1218 :   for (i = j = 1; i < l; i++)
    7938             :   {
    7939        1001 :     long d = D[i];
    7940        1001 :     if (parity == -1) d = -d;
    7941        1001 :     if (sisfundamental(d)) gel(L,j++) = stoi(d);
    7942             :   }
    7943         217 :   setlg(L,j); return L;
    7944             : }
    7945             : /* does ND contain a divisor of N ? */
    7946             : static int
    7947         413 : seenD(long N, GEN ND)
    7948             : {
    7949         413 :   long j, l = lg(ND);
    7950         427 :   for (j = 1; j < l; j++)
    7951          14 :     if (N % ND[j] == 0) return 1;
    7952         413 :   return 0;
    7953             : }
    7954             : static GEN
    7955          42 : search_levels(GEN vN, const char *f)
    7956             : {
    7957          42 :   switch(typ(vN))
    7958             :   {
    7959           7 :     case t_INT: vN = mkvecsmall(itos(vN)); break;
    7960          35 :     case t_VEC: case t_COL: vN = ZV_to_zv(vN); break;
    7961           0 :     case t_VECSMALL: vN = leafcopy(vN); break;
    7962           0 :     default: pari_err_TYPE(f, vN);
    7963             :   }
    7964          42 :   vecsmall_sort(vN); return vN;
    7965             : }
    7966             : GEN
    7967          14 : mfsearch(GEN NK, GEN V, long space)
    7968             : {
    7969          14 :   pari_sp av = avma;
    7970             :   GEN F, gk, NbyD, vN;
    7971             :   long n, nk, dk, parity, nV, i, lvN;
    7972             : 
    7973          14 :   if (typ(NK) != t_VEC || lg(NK) != 3) pari_err_TYPE("mfsearch", NK);
    7974          14 :   gk = gel(NK,2);
    7975          14 :   if (typ(gmul2n(gk, 1)) != t_INT) pari_err_TYPE("mfsearch [k]", gk);
    7976          14 :   switch(typ(V))
    7977             :   {
    7978          14 :     case t_VEC: V = shallowtrans(V);
    7979          14 :     case t_COL: break;
    7980           0 :     default: pari_err_TYPE("mfsearch [V]", V);
    7981             :   }
    7982          14 :   vN = search_levels(gel(NK,1), "mfsearch [N]");
    7983          14 :   lvN = lg(vN);
    7984             : 
    7985          14 :   Qtoss(gk, &nk,&dk);
    7986          14 :   parity = (dk == 1 && odd(nk)) ? -1 : 1;
    7987          14 :   nV = lg(V)-2;
    7988          14 :   F = cgetg(1, t_VEC);
    7989          14 :   NbyD = const_vec(vN[lvN-1], cgetg(1,t_VECSMALL));
    7990         231 :   for (n = 1; n < lvN; n++)
    7991             :   {
    7992         217 :     long N = vN[n];
    7993             :     GEN L;
    7994         217 :     if (N <= 0 || (dk == 2 && (N & 3))) continue;
    7995         217 :     L = findd(N, parity);
    7996         630 :     for (i = 1; i < lg(L); i++)
    7997             :     {
    7998         413 :       GEN mf, M, CO, gD = gel(L,i);
    7999         413 :       GEN *ND = (GEN*)NbyD + itou(gD); /* points to NbyD[|D|] */
    8000             : 
    8001         413 :       if (seenD(N, *ND)) continue;
    8002         413 :       mf = mfinit_Nndkchi(N, nk, dk, get_mfchar(gD), space, 1);
    8003         413 :       M = mfcoefs_mf(mf, nV, 1);
    8004         413 :       CO = inverseimage(M, V); if (lg(CO) == 1) continue;
    8005             : 
    8006          42 :       F = vec_append(F, mflinear(mf,CO));
    8007          42 :       *ND = vecsmall_append(*ND, N); /* add to NbyD[|D|] */
    8008             :     }
    8009             :   }
    8010          14 :   return gerepilecopy(av, F);
    8011             : }
    8012             : 
    8013             : static GEN
    8014         882 : search_from_split(GEN mf, GEN vap, GEN vlp)
    8015             : {
    8016         882 :   pari_sp av = avma;
    8017         882 :   long lvlp = lg(vlp), j, jv, l1;
    8018         882 :   GEN v, NK, S1, S, M = NULL;
    8019             : 
    8020         882 :   S1 = gel(mfsplit(mf, 1, 0), 1); /* rational newforms */
    8021         882 :   l1 = lg(S1);
    8022         882 :   if (l1 == 1) { avma = av; return NULL; }
    8023         448 :   v = cgetg(l1, t_VEC);
    8024         448 :   S = MF_get_S(mf);
    8025         448 :   NK = mf_get_NK(gel(S,1));
    8026         448 :   if (lvlp > 1) M = rowpermute(mfcoefs_mf(mf, vlp[lvlp-1], 1), vlp);
    8027         966 :   for (j = jv = 1; j < l1; j++)
    8028             :   {
    8029         518 :     GEN vF = gel(S1,j);
    8030             :     long t;
    8031         651 :     for (t = lvlp-1; t > 0; t--)
    8032             :     { /* lhs = vlp[j]-th coefficient of eigenform */
    8033         595 :       GEN rhs = gel(vap,t), lhs = RgMrow_RgC_mul(M, vF, t);
    8034         595 :       if (!gequal(lhs, rhs)) break;
    8035             :     }
    8036         518 :     if (!t) gel(v,jv++) = mflinear_i(NK,S,vF);
    8037             :   }
    8038         448 :   if (jv == 1) { avma = av; return NULL; }
    8039          56 :   setlg(v,jv); return v;
    8040             : }
    8041             : GEN
    8042          28 : mfeigensearch(GEN NK, GEN AP)
    8043             : {
    8044          28 :   pari_sp av = avma;
    8045          28 :   GEN k, vN, vap, vlp, vres = cgetg(1, t_VEC), D;
    8046             :   long n, lvN, i, l, even;
    8047             : 
    8048          28 :   if (!AP) l = 1;
    8049             :   else
    8050             :   {
    8051          28 :     l = lg(AP);
    8052          28 :     if (typ(AP) != t_VEC) pari_err_TYPE("mfeigensearch",AP);
    8053             :   }
    8054          28 :   vap = cgetg(l, t_VEC);
    8055          28 :   vlp = cgetg(l, t_VEC);
    8056          28 :   if (l > 1)
    8057             :   {
    8058          28 :     GEN perm = indexvecsort(AP, mkvecsmall(1));
    8059          77 :     for (i = 1; i < l; i++)
    8060             :     {
    8061          49 :       GEN v = gel(AP,perm[i]), gp, ap;
    8062          49 :       if (typ(v) != t_VEC || lg(v) != 3) pari_err_TYPE("mfeigensearch", AP);
    8063          49 :       gp = gel(v,1);
    8064          49 :       ap = gel(v,2);
    8065          49 :       if (typ(gp) != t_INT || (typ(ap) != t_INT && typ(ap) != t_INTMOD))
    8066           0 :         pari_err_TYPE("mfeigensearch", AP);
    8067          49 :       gel(vap,i) = ap;
    8068          49 :       vlp[i] = itos(gp)+1; if (vlp[i] < 0) pari_err_TYPE("mfeigensearch", AP);
    8069             :     }
    8070             :   }
    8071          28 :   l = lg(NK);
    8072          28 :   if (typ(NK) != t_VEC || l != 3) pari_err_TYPE("mfeigensearch",NK);
    8073          28 :   k = gel(NK,2);
    8074          28 :   vN = search_levels(gel(NK,1), "mfeigensearch [N]");
    8075          28 :   lvN = lg(vN);
    8076          28 :   vecsmall_sort(vlp);
    8077          28 :   even = !mpodd(k);
    8078         966 :   for (n = 1; n < lvN; n++)
    8079             :   {
    8080         938 :     pari_sp av2 = avma;
    8081             :     GEN mf, L;
    8082         938 :     long N = vN[n];
    8083         938 :     if (even) D = gen_1;
    8084             :     else
    8085             :     {
    8086         112 :       long r = (N&3L);
    8087         112 :       if (r == 1 || r == 2) continue;
    8088          56 :       D = stoi( corediscs(-N, NULL) ); /* < 0 */
    8089             :     }
    8090         882 :     mf = mfinit_i(mkvec3(utoipos(N), k, D), mf_NEW);
    8091         882 :     L = search_from_split(mf, vap, vlp);
    8092         882 :     if (L) vres = shallowconcat(vres, L); else avma = av2;
    8093             :   }
    8094          28 :   return gerepilecopy(av, vres);
    8095             : }
    8096             : 
    8097             : /* tf_{N,k}(n) */
    8098             : static GEN
    8099     2109023 : mfnewtracecache(long N, long k, long n, cachenew_t *cache)
    8100             : {
    8101     2109023 :   GEN C = NULL, S;
    8102             :   long lcache;
    8103     2109023 :   if (!n) return gen_0;
    8104     2034683 :   S = gel(cache->vnew,N);
    8105     2034683 :   lcache = lg(S);
    8106     2034683 :   if (n < lcache) C = gel(S, n);
    8107     2034683 :   if (C) cache->newHIT++;
    8108     1222172 :   else C = mfnewtrace_i(N,k,n,cache);
    8109     2034683 :   cache->newTOTAL++;
    8110     2034683 :   if (n < lcache) gel(S,n) = C;
    8111     2034683 :   return C;
    8112             : }
    8113             : 
    8114             : static long
    8115        1379 : mfdim_Nkchi(long N, long k, GEN CHI, long space)
    8116             : {
    8117        1379 :   if (k < 0 || badchar(N,k,CHI)) return 0;
    8118        1078 :   if (k == 0)
    8119          35 :     return mfcharistrivial(CHI) && !space_is_cusp(space)? 1: 0;
    8120        1043 :   switch(space)
    8121             :   {
    8122         231 :     case mf_NEW: return mfnewdim(N,k,CHI);
    8123         196 :     case mf_CUSP:return mfcuspdim(N,k,CHI);
    8124         168 :     case mf_OLD: return mfolddim(N,k,CHI);
    8125         217 :     case mf_FULL:return mffulldim(N,k,CHI);
    8126         231 :     case mf_EISEN: return mfeisensteindim(N,k,CHI);
    8127           0 :     default: pari_err_FLAG("mfdim");
    8128             :   }
    8129             :   return 0;/*LCOV_EXCL_LINE*/
    8130             : }
    8131             : static long
    8132        2114 : mfwt1dimsum(long N, long space)
    8133             : {
    8134        2114 :   switch(space)
    8135             :   {
    8136        1050 :     case mf_NEW:  return mfwt1newdimsum(N);
    8137        1057 :     case mf_CUSP: return mfwt1cuspdimsum(N);
    8138           7 :     case mf_OLD:  return mfwt1olddimsum(N);
    8139             :   }
    8140           0 :   pari_err_FLAG("mfdim");
    8141             :   return 0; /*LCOV_EXCL_LINE*/
    8142             : }
    8143             : /* mfdim for k = nk/dk */
    8144             : static long
    8145       44744 : mfdim_Nndkchi(long N, long nk, long dk, GEN CHI, long space)
    8146       88186 : { return (dk == 2)? mf2dim_Nkchi(N, nk >> 1, CHI, space)
    8147       88207 :                   : mfdim_Nkchi(N, nk, CHI, space); }
    8148             : /* FIXME: use direct dim Gamma1(N) formula, don't compute individual spaces */
    8149             : static long
    8150         252 : mfwtkdimsum(long N, long k, long dk, long space)
    8151             : {
    8152         252 :   GEN w = mfchars(N, k, dk, NULL);
    8153         252 :   long i, j, D = 0, l = lg(w);
    8154        1239 :   for (i = j = 1; i < l; i++)
    8155             :   {
    8156         987 :     GEN CHI = gel(w,i);
    8157         987 :     long d = mfdim_Nndkchi(N,k,dk,CHI,space);
    8158         987 :     if (d) D += d * myeulerphiu(mfcharorder(CHI));
    8159             :   }
    8160         252 :   return D;
    8161             : }
    8162             : static GEN
    8163         105 : mfwt1dims(long N, GEN vCHI, long space)
    8164             : {
    8165         105 :   GEN D = NULL;
    8166         105 :   switch(space)
    8167             :   {
    8168          56 :     case mf_NEW: D = mfwt1newdimall(N, vCHI); break;
    8169          21 :     case mf_CUSP:D = mfwt1cuspdimall(N, vCHI); break;
    8170          28 :     case mf_OLD: D = mfwt1olddimall(N, vCHI); break;
    8171           0 :     default: pari_err_FLAG("mfdim");
    8172             :   }
    8173         105 :   return D;
    8174             : }
    8175             : static GEN
    8176        2961 : mfwtkdims(long N, long k, long dk, GEN vCHI, long space)
    8177             : {
    8178        2961 :   GEN D, w = mfchars(N, k, dk, vCHI);
    8179        2961 :   long i, j, l = lg(w);
    8180        2961 :   D = cgetg(l, t_VEC);
    8181       46592 :   for (i = j = 1; i < l; i++)
    8182             :   {
    8183       43631 :     GEN CHI = gel(w,i);
    8184       43631 :     long d = mfdim_Nndkchi(N,k,dk,CHI,space);
    8185       43631 :     if (vCHI)
    8186         574 :       gel(D, j++) = mkvec2s(d, 0);
    8187       43057 :     else if (d)
    8188        2520 :       gel(D, j++) = fmt_dim(CHI, d, 0);
    8189             :   }
    8190        2961 :   setlg(D,j); return D;
    8191             : }
    8192             : GEN
    8193        5719 : mfdim(GEN NK, long space)
    8194             : {
    8195        5719 :   pari_sp av = avma;
    8196             :   long N, k, dk, joker;
    8197             :   GEN CHI;
    8198        5719 :   if (checkMF_i(NK)) return utoi(MF_get_dim(NK));
    8199        5586 :   checkNK2(NK, &N, &k, &dk, &CHI, 2);
    8200        5586 :   if (!CHI) joker = 1;
    8201             :   else
    8202        2611 :     switch(typ(CHI))
    8203             :     {
    8204        2373 :       case t_INT: joker = 2; break;
    8205         112 :       case t_COL: joker = 3; break;
    8206         126 :       default: joker = 0; break;
    8207             :     }
    8208        5586 :   if (joker)
    8209             :   {
    8210             :     long d;
    8211             :     GEN D;
    8212        5460 :     if (k < 0) switch(joker)
    8213             :     {
    8214           0 :       case 1: return cgetg(1,t_VEC);
    8215           7 :       case 2: return gen_0;
    8216           0 :       case 3: return mfdim0all(CHI);
    8217             :     }
    8218        5453 :     if (k == 0)
    8219             :     {
    8220          28 :       if (space_is_cusp(space)) switch(joker)
    8221             :       {
    8222           7 :         case 1: return cgetg(1,t_VEC);
    8223           0 :         case 2: return gen_0;
    8224           7 :         case 3: return mfdim0all(CHI);
    8225             :       }
    8226          14 :       switch(joker)
    8227             :       {
    8228             :         long i, l;
    8229           7 :         case 1: retmkvec(fmt_dim(mfchartrivial(),0,0));
    8230           0 :         case 2: return gen_1;
    8231           7 :         case 3: l = lg(CHI); D = cgetg(l,t_VEC);
    8232          35 :                 for (i = 1; i < l; i++)
    8233             :                 {
    8234          28 :                   long t = mfcharistrivial(gel(CHI,i));
    8235          28 :                   gel(D,i) = mkvec2(t? gen_1: gen_0, gen_0);
    8236             :                 }
    8237           7 :                 return D;
    8238             :       }
    8239             :     }
    8240        5425 :     if (dk == 1 && k == 1 && space != mf_EISEN)
    8241         105 :     {
    8242        2219 :       long fix = 0, space0 = space;
    8243        2219 :       if (space == mf_FULL) space = mf_CUSP; /* remove Eisenstein part */
    8244        2219 :       if (joker == 2)
    8245             :       {
    8246        2114 :         d = mfwt1dimsum(N, space);
    8247        2114 :         if (space0 == mf_FULL) d += mfwtkdimsum(N,k,dk,mf_EISEN);/*add it back*/
    8248        2114 :         avma = av; return utoi(d);
    8249             :       }
    8250             :       /* must initialize explicitly: trivial spaces for E_k/S_k differ */
    8251         105 :       if (space0 == mf_FULL)
    8252             :       {
    8253           7 :         if (!CHI) fix = 1; /* must remove 0 spaces */
    8254           7 :         CHI = mfchars(N, k, dk, CHI);
    8255             :       }
    8256         105 :       D = mfwt1dims(N, CHI, space);
    8257         105 :       if (space0 == mf_FULL)
    8258             :       {
    8259           7 :         GEN D2 = mfwtkdims(N, k, dk, CHI, mf_EISEN);
    8260           7 :         D = merge_dims(D, D2, fix? CHI: NULL);
    8261             :       }
    8262             :     }
    8263             :     else
    8264             :     {
    8265        3206 :       if (joker==2) { d = mfwtkdimsum(N,k,dk,space); avma=av; return utoi(d); }
    8266        2954 :       D = mfwtkdims(N, k, dk, CHI, space);
    8267             :     }
    8268        3059 :     if (!CHI) return gerepileupto(av, vecsort(D, mkvecsmall(1)));
    8269         105 :     return gerepilecopy(av, D);
    8270             :   }
    8271         126 :   return utoi( mfdim_Nndkchi(N, k, dk, CHI, space) );
    8272             : }
    8273             : 
    8274             : GEN
    8275         273 : mfbasis(GEN mf, long space)
    8276             : {
    8277         273 :   pari_sp av = avma;
    8278             :   long N, k, dk;
    8279             :   GEN CHI;
    8280         273 :   if (checkMF_i(mf)) return concat(gel(mf, 2), gel(mf, 3));
    8281           7 :   checkNK2(mf, &N, &k, &dk, &CHI, 0);
    8282           7 :   if (dk == 2) return gerepilecopy(av, mf2basis(N, k>>1, CHI, space));
    8283           7 :   mf = mfinit_Nkchi(N, k, CHI, space, 1);
    8284           7 :   return gerepilecopy(av, MF_get_basis(mf));
    8285             : }
    8286             : 
    8287             : static GEN
    8288          28 : deg1ser_shallow(GEN a1, GEN a0, long v, long e)
    8289          28 : { return RgX_to_ser(deg1pol_shallow(a1, a0, v), e+2); }
    8290             : /* r / x + O(1) */
    8291             : static GEN
    8292          28 : simple_pole(GEN r)
    8293             : {
    8294          28 :   GEN S = deg1ser_shallow(gen_0, r, 0, 1);
    8295          28 :   setvalp(S, -1); return S;
    8296             : }
    8297             : 
    8298             : /* F form, E embedding; mfa = mfatkininit or root number (eigenform case) */
    8299             : static GEN
    8300         105 : mflfuncreate(GEN mfa, GEN F, GEN E, GEN N, GEN gk)
    8301             : {
    8302         105 :   GEN LF = cgetg(8,t_VEC), polar = cgetg(1,t_COL), eps;
    8303         105 :   long k = itou(gk);
    8304         105 :   gel(LF,1) = lfuntag(t_LFUN_MFCLOS, mkvec3(F,E,gen_1));
    8305         105 :   if (typ(mfa) != t_VEC)
    8306          70 :     eps = mfa; /* cuspidal eigenform: root number; no poles */
    8307             :   else
    8308             :   { /* mfatkininit */
    8309          35 :     GEN a0, b0, vF, vG, G = NULL, M = gel(mfa,2), mf = gel(mfa,4);
    8310          35 :     vF = mftobasis_i(mf, F);
    8311          35 :     vG = RgM_RgC_mul(M, vF);
    8312          35 :     if (gequal(vF,vG)) eps = gen_1;
    8313           7 :     else if (gequal(vF,gneg(vG))) eps = gen_m1;
    8314             :     else
    8315             :     { /* not self-dual */
    8316           7 :       eps = NULL;
    8317           7 :       G = mfatkin(mfa, F);
    8318           7 :       gel(LF,2) = lfuntag(t_LFUN_MFCLOS, mkvec3(G,E,ginv(gel(mfa,3))));
    8319           7 :       gel(LF,6) = powIs(k);
    8320             :     }
    8321             :     /* polar part */
    8322          35 :     a0 = mfcoef(F,0);
    8323          35 :     b0 = eps? gmul(eps,a0): mfcoef(G,0);
    8324          35 :     if (!gequal0(b0))
    8325             :     {
    8326          14 :       b0 = mulcxpowIs(gmul2n(b0,1), k);
    8327          14 :       polar = vec_append(polar, mkvec2(gk, simple_pole(b0)));
    8328             :     }
    8329          35 :     if (!gequal0(a0))
    8330             :     {
    8331          14 :       a0 = gneg(gmul2n(a0,1));
    8332          14 :       polar = vec_append(polar, mkvec2(gen_0, simple_pole(a0)));
    8333             :     }
    8334             :   }
    8335         105 :   if (eps) /* self-dual */
    8336             :   {
    8337          98 :     gel(LF,2) = mfcharorder(mf_get_CHI(F)) <= 2? gen_0: gen_1;
    8338          98 :     gel(LF,6) = mulcxpowIs(eps,k);
    8339             :   }
    8340         105 :   gel(LF,3) = mkvec2(gen_0, gen_1);
    8341         105 :   gel(LF,4) = gk;
    8342         105 :   gel(LF,5) = N;
    8343         105 :   if (lg(polar) == 1) setlg(LF,7); else gel(LF,7) = polar;
    8344         105 :   return LF;
    8345             : }
    8346             : static GEN
    8347          91 : mflfuncreateall(long sd, GEN mfa, GEN F, GEN vE, GEN gN, GEN gk)
    8348             : {
    8349          91 :   long i, l = lg(vE);
    8350          91 :   GEN L = cgetg(l, t_VEC);
    8351         196 :   for (i = 1; i < l; i++)
    8352         105 :     gel(L,i) = mflfuncreate(sd? gel(mfa,i): mfa, F, gel(vE,i), gN, gk);
    8353          91 :   return L;
    8354             : }
    8355             : static GEN
    8356          42 : lfunmf_i(GEN mf, GEN F, long bitprec)
    8357             : {
    8358          42 :   long i, l, N = MF_get_N(mf), prec = nbits2prec(bitprec);
    8359          42 :   GEN L, gk = MF_get_gk(mf), gN = utoipos(N);
    8360             : 
    8361          42 :   if (!F)
    8362             :   {
    8363           7 :     GEN M = mfeigenbasis(mf), vE = mfeigenembed(mf, prec);
    8364           7 :     GEN v = mffrickeeigen(mf, vE, prec);
    8365           7 :     l = lg(vE); L = cgetg(l, t_VEC);
    8366          63 :     for (i = 1; i < l; i++)
    8367          56 :       gel(L,i) = mflfuncreateall(1,gel(v,i), gel(M,i), gel(vE,i), gN, gk);
    8368             :   }
    8369             :   else
    8370             :   {
    8371          35 :     GEN mfa = mfatkininit_i(mf, N, 1, prec);
    8372          35 :     L = mflfuncreateall(0,mfa, F, mfgetembed(F,prec), gN, gk);
    8373          35 :     if (lg(L) == 2) L = gel(L,1);
    8374             :   }
    8375          42 :   return L;
    8376             : }
    8377             : GEN
    8378          42 : lfunmf(GEN mf, GEN F, long bitprec)
    8379             : {
    8380          42 :   pari_sp av = avma;
    8381          42 :   checkMF(mf);
    8382          42 :   if (F)
    8383             :   {
    8384          35 :     if (!checkmf_i(F)) pari_err_TYPE("lfunmf", F);
    8385          35 :     if (!mfisinspace_i(mf, F)) err_space(F);
    8386             :   }
    8387          42 :   return gerepilecopy(av, lfunmf_i(mf, F, bitprec));
    8388             : }
    8389             : 
    8390             : GEN
    8391          21 : mffromell(GEN E)
    8392             : {
    8393          21 :   pari_sp av = avma;
    8394             :   GEN mf, F, z, v, S;
    8395             :   long N, i, l;
    8396             : 
    8397          21 :   checkell(E);
    8398          21 :   if (ell_get_type(E) != t_ELL_Q) pari_err_TYPE("mfffromell [E not over Q]", E);
    8399          21 :   N = itos(ellQ_get_N(E));
    8400          21 :   mf = mfinit_i(mkvec2(utoi(N), gen_2), mf_NEW);
    8401          21 :   v = mfsplit(mf, 1, 0);
    8402          21 :   S = gel(v,1); l = lg(S); /* rational newforms */
    8403          21 :   F = tag(t_MF_ELL, mkNK(N,2,mfchartrivial()), E);
    8404          21 :   z = mftobasis_i(mf, F);
    8405          21 :   for(i = 1; i < l; i++)
    8406          21 :     if (gequal(z, gel(S,i))) break;
    8407          21 :   if (i == l) pari_err_BUG("mffromell [E is not modular]");
    8408          21 :   return gerepilecopy(av, mkvec3(mf, F, z));
    8409             : }
    8410             : 
    8411             : /* returns -1 if not, degree otherwise */
    8412             : long
    8413         105 : polishomogeneous(GEN P)
    8414             : {
    8415             :   long i, D, l;
    8416         105 :   if (typ(P) != t_POL) return 0;
    8417          49 :   D = -1; l = lg(P);
    8418         231 :   for (i = 2; i < l; i++)
    8419             :   {
    8420         182 :     GEN c = gel(P,i);
    8421             :     long d;
    8422         182 :     if (gequal0(c)) continue;
    8423          84 :     d = polishomogeneous(c);
    8424          84 :     if (d < 0) return -1;
    8425          84 :     if (D < 0) D = d + i-2; else if (D != d + i-2) return -1;
    8426             :   }
    8427          49 :   return D;
    8428             : }
    8429             : 
    8430             : /* 1 if spherical, 0 otherwise */
    8431             : static long
    8432          21 : polisspherical(GEN Qi, GEN P)
    8433             : {
    8434          21 :   pari_sp av = avma;
    8435             :   GEN va, S;
    8436             :   long lva, i, j, r;
    8437          21 :   if (gequal0(P) || degpol(P) <= 1) return 1;
    8438          14 :   va = variables_vecsmall(P); lva = lg(va);
    8439          14 :   if (lva > lg(Qi)) pari_err(e_MISC, "too many variables in mffromqf");
    8440          14 :   S = gen_0;
    8441          42 :   for (j = 1; j < lva; j++)
    8442             :   {
    8443          28 :     GEN col = gel(Qi, j), Pj = deriv(P, va[j]);
    8444          70 :     for (i = 1; i <= j; i++)
    8445             :     {
    8446          42 :       GEN coe = gel(col, i);
    8447          42 :       if (i != j) coe = gmul2n(coe, 1);
    8448          42 :       if (!gequal0(coe)) S = gadd(S, gmul(coe, deriv(Pj, va[i])));
    8449             :     }
    8450             :   }
    8451          14 :   r = gequal0(S); avma = av; return r;
    8452             : }
    8453             : 
    8454             : static GEN
    8455          28 : c_QFsimple_i(long n, GEN Q, GEN P)
    8456             : {
    8457          28 :   pari_sp av = avma;
    8458          28 :   GEN V, v = qfrep0(Q, utoi(n), 1);
    8459          28 :   long i, l = lg(v);
    8460          28 :   V = cgetg(l+1, t_VEC);
    8461          49 :   if (!P || equali1(P))
    8462             :   {
    8463          21 :     gel(V,1) = gen_1;
    8464          21 :     for (i = 2; i <= l; i++) gel(V,i) = utoi(v[i-1] << 1);
    8465             :   }
    8466             :   else
    8467             :   {
    8468           7 :     gel(V,1) = gcopy(P);
    8469           7 :     for (i = 2; i <= l; i++) gel(V,i) = gmulgs(P, v[i-1] << 1);
    8470             :   }
    8471          28 :   return gerepileupto(av, V);
    8472             : }
    8473             : static GEN
    8474          35 : c_QF_i(long n, GEN Q, GEN P)
    8475             : {
    8476          35 :   pari_sp av = avma;
    8477             :   GEN V, v, va;
    8478             :   long i, lva, lq, l;
    8479          35 :   if (!P || typ(P) != t_POL) return c_QFsimple_i(n, Q, P);
    8480           7 :   v = gel(minim(Q, utoi(2*n), NULL), 3);
    8481           7 :   va = variables_vec(P); lq = lg(Q) - 1; lva = lg(va) - 1;
    8482           7 :   V = zerovec(n + 1); l = lg(v);
    8483          35 :   for (i = 1; i < l; i++)
    8484             :   {
    8485          28 :     GEN X = gel(v,i);
    8486          28 :     long ind = (itos(qfeval0(Q, X, NULL)) >> 1) + 1;
    8487          28 :     if (lq > lva) X = vecslice(X, 1, lva);
    8488          28 :     gel(V, ind) = gadd(gel(V, ind), gsubstvec(P, va, X));
    8489             :   }
    8490           7 :   return gerepilecopy(av, gmul2n(V, 1));
    8491             : }
    8492             : 
    8493             : GEN
    8494          42 : mffromqf(GEN Q, GEN P)
    8495             : {
    8496          42 :   pari_sp av = avma;
    8497             :   GEN G, Qi, F, D, N, mf, v, gk, gwt, chi;
    8498             :   long m, d, space;
    8499          42 :   if (typ(Q) != t_MAT) pari_err_TYPE("mffromqf", Q);
    8500          42 :   if (!RgM_is_ZM(Q) || !qf_iseven(Q))
    8501           0 :     pari_err_TYPE("mffromqf [not integral or even]", Q);
    8502          42 :   m = lg(Q)-1;
    8503          42 :   gk = sstoQ(m, 2);
    8504          42 :   Qi = ZM_inv(Q, &N);
    8505          42 :   if (!qf_iseven(Qi)) N = shifti(N, 1);
    8506          42 :   if (!P || gequal1(P)) { d = 0; P = NULL; }
    8507             :   else
    8508             :   {
    8509          21 :     d = polishomogeneous(P);
    8510          21 :     if (d < 0) pari_err_TYPE("mffromqf [not homogeneous t_POL]", P);
    8511          21 :     if (!polisspherical(Qi, P))
    8512           0 :       pari_err_TYPE("mffromqf [not a spherical t_POL]", P);
    8513          21 :     if (d == 0) P = simplify_shallow(P);
    8514             :   }
    8515          42 :   D = ZM_det(Q);
    8516          42 :   if (typ(gk) == t_INT) { if (mpodd(gk)) D = negi(D); } else D = shifti(D, 1);
    8517          42 :   space = d > 0 ? mf_CUSP : mf_FULL;
    8518          42 :   G = znstar0(N,1);
    8519          42 :   chi = mkvec2(G, znchar_quad(G,D));
    8520          42 :   gwt = gaddgs(gk, d);
    8521          42 :   mf = mfinit(mkvec3(N, gwt, chi), space);
    8522          42 :   if (odd(d))
    8523             :   {
    8524           7 :     F = mftrivial();
    8525           7 :     v = zerocol(MF_get_dim(mf));
    8526             :   }
    8527             :   else
    8528             :   {
    8529          35 :     F = c_QF_i(mfsturm(mf), Q, P);
    8530          35 :     v = mftobasis_i(mf, F);
    8531          35 :     F = mflinear(mf, v);
    8532             :   }
    8533          42 :   return gerepilecopy(av, mkvec3(mf, F, v));
    8534             : }
    8535             : 
    8536             : /***********************************************************************/
    8537             : /*                          Eisenstein Series                          */
    8538             : /***********************************************************************/
    8539             : /* \sigma_{k-1}(\chi,n) */
    8540             : static GEN
    8541       16891 : sigchi(long k, GEN CHI, long n)
    8542             : {
    8543       16891 :   pari_sp av = avma;
    8544       16891 :   GEN S = gen_1, D = mydivisorsu(u_ppo(n,mfcharmodulus(CHI)));
    8545       16891 :   long i, l = lg(D), ord = mfcharorder(CHI), vt = varn(mfcharpol(CHI));
    8546       56826 :   for (i = 2; i < l; i++) /* skip D[1] = 1 */
    8547             :   {
    8548       39935 :     long d = D[i], a = mfcharevalord(CHI, d, ord);
    8549       39935 :     S = gadd(S, mygmodulo_lift(a, ord, powuu(d, k-1), vt));
    8550             :   }
    8551       16891 :   return gerepileupto(av,S);
    8552             : }
    8553             : 
    8554             : /* write n = n0*n1*n2, (n0,N1*N2) = 1, n1 | N1^oo, n2 | N2^oo;
    8555             :  * return NULL if (n,N1,N2) > 1, else return factoru(n0) */
    8556             : static GEN
    8557      122269 : sigchi2_dec(long n, long N1, long N2, long *pn1, long *pn2)
    8558             : {
    8559      122269 :   GEN P0, E0, P, E, fa = myfactoru(n);
    8560             :   long i, j, l;
    8561      122269 :   *pn1 = 1;
    8562      122269 :   *pn2 = 1;
    8563      122269 :   if (N1 == 1 && N2 == 1) return fa;
    8564      109634 :   P = gel(fa,1); l = lg(P);
    8565      109634 :   E = gel(fa,2);
    8566      109634 :   P0 = cgetg(l, t_VECSMALL);
    8567      109634 :   E0 = cgetg(l, t_VECSMALL);
    8568      241934 :   for (i = j = 1; i < l; i++)
    8569             :   {
    8570      141449 :     long p = P[i], e = E[i];
    8571      141449 :     if (N1 % p == 0)
    8572             :     {
    8573       17479 :       if (N2 % p == 0) return NULL;
    8574        8330 :       *pn1 *= upowuu(p,e);
    8575             :     }
    8576      123970 :     else if (N2 % p == 0)
    8577       21259 :       *pn2 *= upowuu(p,e);
    8578      102711 :     else { P0[j] = p; E0[j] = e; j++; }
    8579             :   }
    8580      100485 :   setlg(P0, j);
    8581      100485 :   setlg(E0, j); return mkvec2(P0,E0);
    8582             : }
    8583             : 
    8584             : /* sigma_{k-1}(\chi_1,\chi_2,n), ord multiple of lcm(ord(CHI1),ord(CHI2)) */
    8585             : static GEN
    8586       94451 : sigchi2(long k, GEN CHI1, GEN CHI2, long n, long ord)
    8587             : {
    8588       94451 :   pari_sp av = avma;
    8589       94451 :   GEN S = gen_0, D;
    8590       94451 :   long i, l, n1, n2, vt, N1 = mfcharmodulus(CHI1), N2 = mfcharmodulus(CHI2);
    8591       94451 :   D = sigchi2_dec(n, N1, N2, &n1, &n2); if (!D) { avma = av; return S; }
    8592       86646 :   D = divisorsu_fact(D); l = lg(D);
    8593       86646 :   vt = varn(mfcharpol(CHI1));
    8594      318934 :   for (i = 1; i < l; i++)
    8595             :   { /* S += d^(k-1)*chi1(d)*chi2(n/d) */
    8596      232288 :     long a, d = n2*D[i], nd = n1*D[l-i]; /* (d,N1)=1; (n/d,N2) = 1 */
    8597      232288 :     a = mfcharevalord(CHI1, d, ord) + mfcharevalord(CHI2, nd, ord);
    8598      232288 :     if (a >= ord) a -= ord;
    8599      232288 :     S = gadd(S, mygmodulo_lift(a, ord, powuu(d, k-1), vt));
    8600             :   }
    8601       86646 :   return gerepileupto(av, S);
    8602             : }
    8603             : 
    8604             : /**************************************************************************/
    8605             : /**           Dirichlet characters with precomputed values               **/
    8606             : /**************************************************************************/
    8607             : /* CHI mfchar */
    8608             : static GEN
    8609       10143 : mfcharcxinit(GEN CHI, long prec)
    8610             : {
    8611       10143 :   GEN G = gel(CHI,1), chi = gel(CHI,2), z, V;
    8612       10143 :   GEN v = ncharvecexpo(G, znconrey_normalized(G,chi));
    8613       10143 :   long n, l = lg(v), o = mfcharorder(CHI);
    8614       10143 :   V = cgetg(l, t_VEC);
    8615       10143 :   z = grootsof1(o, prec); /* Mod(t, Phi_o(t)) -> e(1/o) */
    8616       10143 :   for (n = 1; n < l; n++) gel(V,n) = v[n] < 0? gen_0: gel(z, v[n]+1);
    8617       10143 :   return mkvecn(6, G, chi, gmfcharorder(CHI), v, V, mfcharpol(CHI));
    8618             : }
    8619             : /* v a "CHIvec" */
    8620             : static long
    8621     4869529 : CHIvec_N(GEN v) { return itou(znstar_get_N(gel(v,1))); }
    8622             : static GEN
    8623        8568 : CHIvec_CHI(GEN v)
    8624        8568 : { return mkvec4(gel(v,1), gel(v,2), gel(v,3), gel(v,6)); }
    8625             : /* character order */
    8626             : static long
    8627       22127 : CHIvec_ord(GEN v) { return itou(gel(v,3)); }
    8628             : /* character exponents, i.e. t such that chi(n) = e(t) */
    8629             : static GEN
    8630      231427 : CHIvec_expo(GEN v) { return gel(v,4); }
    8631             : /* character values chi(n) */
    8632             : static GEN
    8633     4529700 : CHIvec_val(GEN v) { return gel(v,5); }
    8634             : /* CHI(n) */
    8635             : static GEN
    8636     4518087 : mychareval(GEN v, long n)
    8637             : {
    8638     4518087 :   long N = CHIvec_N(v), ind = n%N;
    8639     4518087 :   if (ind <= 0) ind += N;
    8640     4518087 :   return gel(CHIvec_val(v), ind);
    8641             : }
    8642             : /* return c such that CHI(n) = e(c / ordz) or -1 if (n,N) > 1 */
    8643             : static long
    8644      231427 : mycharexpo(GEN v, long n)
    8645             : {
    8646      231427 :   long N = CHIvec_N(v), ind = n%N;
    8647      231427 :   if (ind <= 0) ind += N;
    8648      231427 :   return CHIvec_expo(v)[ind];
    8649             : }
    8650             : /* faster than mfcharparity */
    8651             : static long
    8652       25431 : CHIvec_parity(GEN v) { return mycharexpo(v,-1) ? -1: 1; }
    8653             : /**************************************************************************/
    8654             : 
    8655             : static ulong
    8656       27818 : sigchi2_Fl(long k, GEN CHI1vec, GEN CHI2vec, long n, GEN vz, ulong p)
    8657             : {
    8658       27818 :   pari_sp av = avma;
    8659       27818 :   long ordz = lg(vz)-2, i, l, n1, n2;
    8660       27818 :   ulong S = 0;
    8661       27818 :   GEN D = sigchi2_dec(n, CHIvec_N(CHI1vec), CHIvec_N(CHI2vec), &n1, &n2);
    8662       27818 :   if (!D) { avma = av; return S; }
    8663       26474 :   D = divisorsu_fact(D);
    8664       26474 :   l = lg(D);
    8665       93870 :   for (i = 1; i < l; i++)
    8666             :   { /* S += d^(k-1)*chi1(d)*chi2(n/d) */
    8667       67396 :     long a, d = n2*D[i], nd = n1*D[l-i]; /* (d,N1)=1, (n/d,N2)=1 */
    8668       67396 :     a = mycharexpo(CHI2vec, nd) + mycharexpo(CHI1vec, d);
    8669       67396 :     if (a >= ordz) a -= ordz;
    8670       67396 :     S = Fl_add(S, mygmodulo_Fl(a, vz, Fl_powu(d,k-1,p), p), p);
    8671             :   }
    8672       26474 :   avma = av; return S;
    8673             : }
    8674             : 
    8675             : /**********************************************************************/
    8676             : /* Fourier expansions of Eisenstein series                            */
    8677             : /**********************************************************************/
    8678             : /* L(CHI,0) / 2, order(CHI) | ord != 0 */
    8679             : static GEN
    8680         882 : charLFwt1(GEN CHI, long ord)
    8681             : {
    8682             :   GEN S;
    8683         882 :   long r, vt, m = mfcharmodulus(CHI);
    8684             : 
    8685         882 :   if (m == 1) return mkfrac(gen_m1,stoi(4));
    8686         882 :   S = gen_0; vt = varn(mfcharpol(CHI));
    8687       30030 :   for (r = 1; r < m; r++)
    8688             :   { /* S += r*chi(r) */
    8689             :     long a;
    8690       29148 :     if (ugcd(m,r) != 1) continue;
    8691       24052 :     a = mfcharevalord(CHI,r,ord);
    8692       24052 :     S = gadd(S, mygmodulo_lift(a, ord, utoi(r), vt));
    8693             :   }
    8694         882 :   return gdivgs(S, -2*m);
    8695             : }
    8696             : /* L(CHI,0) / 2, mod p */
    8697             : static ulong
    8698         805 : charLFwt1_Fl(GEN CHIvec, GEN vz, ulong p)
    8699             : {
    8700         805 :   long r, m = CHIvec_N(CHIvec);
    8701             :   ulong S;
    8702         805 :   if (m == 1) return Rg_to_Fl(mkfrac(gen_m1,stoi(4)), p);
    8703         805 :   S = 0;
    8704       50029 :   for (r = 1; r < m; r++)
    8705             :   { /* S += r*chi(r) */
    8706       49224 :     long a = mycharexpo(CHIvec,r);
    8707       49224 :     if (a < 0) continue;
    8708       48860 :     S = Fl_add(S, mygmodulo_Fl(a, vz, r, p), p);
    8709             :   }
    8710         805 :   return Fl_div(Fl_neg(S,p), 2*m, p);
    8711             : }
    8712             : /* L(CHI,1-k) / 2, order(CHI) | ord != 0 */
    8713             : static GEN
    8714        1267 : charLFwtk(long k, GEN CHI, long ord)
    8715             : {
    8716             :   GEN S, P, dS;
    8717             :   long r, m, vt;
    8718             : 
    8719        1267 :   if (k == 1) return charLFwt1(CHI, ord);
    8720        1267 :   m = mfcharmodulus(CHI);
    8721        1267 :   if (m == 1) return gdivgs(bernfrac(k),-2*k);
    8722         693 :   S = gen_0; vt = varn(mfcharpol(CHI));
    8723         693 :   P = ZX_rescale(Q_remove_denom(bernpol(k,0), &dS), utoi(m));
    8724         693 :   dS = mul_denom(dS, stoi(-2*m*k));
    8725        9086 :   for (r = 1; r < m; r++)
    8726             :   { /* S += P(r)*chi(r) */
    8727             :     long a;
    8728        8393 :     if (ugcd(r,m) != 1) continue;
    8729        6692 :     a = mfcharevalord(CHI,r,ord);
    8730        6692 :     S = gadd(S, mygmodulo_lift(a, ord, poleval(P, utoi(r)), vt));
    8731             :   }
    8732         693 :   return gdiv(S, dS);
    8733             : }
    8734             : /* L(CHI,1-k) / 2, mod p */
    8735             : static ulong
    8736        1337 : charLFwtk_Fl(long k, GEN CHIvec, GEN vz, ulong p)
    8737             : {
    8738             :   GEN P;
    8739             :   long r, m;
    8740             :   ulong S;
    8741        1337 :   if (k == 1) return charLFwt1_Fl(CHIvec, vz, p);
    8742         532 :   m = CHIvec_N(CHIvec);
    8743         532 :   if (m == 1) return Rg_to_Fl(gdivgs(bernfrac(k),-2*k), p);
    8744         301 :   S = 0;
    8745         301 :   P = RgX_to_Flx(RgX_rescale(bernpol(k,0), utoi(m)), p);
    8746        6489 :   for (r = 1; r < m; r++)
    8747             :   { /* S += P(r)*chi(r) */
    8748        6188 :     long a = mycharexpo(CHIvec,r);
    8749        6188 :     if (a < 0) continue;
    8750        5348 :     S = Fl_add(S, mygmodulo_Fl(a, vz, Flx_eval(P,r,p), p), p);
    8751             :   }
    8752         301 :   return Fl_div(Fl_neg(S,p), 2*k*m, p);
    8753             : }
    8754             : 
    8755             : static GEN
    8756        3843 : mfeisenstein2_0(long k, GEN CHI1, GEN CHI2, long ord)
    8757             : {
    8758        3843 :   if (k == 1 && mfcharistrivial(CHI1))
    8759         882 :     return charLFwt1(CHI2, ord);
    8760        2961 :   else if (mfcharistrivial(CHI2))
    8761        1134 :     return charLFwtk(k, CHI1, ord);
    8762        1827 :   else return gen_0;
    8763             : }
    8764             : static ulong
    8765        2037 : mfeisenstein2_0_Fl(long k, GEN CHI1vec, GEN CHI2vec, GEN vz, ulong p)
    8766             : {
    8767        2037 :   if (k == 1 && CHIvec_ord(CHI1vec) == 1)
    8768         805 :     return charLFwtk_Fl(k, CHI2vec, vz, p);
    8769        1232 :   else if (CHIvec_ord(CHI2vec) == 1)
    8770         532 :     return charLFwtk_Fl(k, CHI1vec, vz, p);
    8771         700 :   else return 0;
    8772             : }
    8773             : static GEN
    8774          63 : NK_eisen2(long k, GEN CHI1, GEN CHI2)
    8775             : {
    8776          63 :   long N = mfcharmodulus(CHI1)*mfcharmodulus(CHI2);
    8777          63 :   return mkNK(N, k, mfcharmul(CHI1,CHI2));
    8778             : }
    8779             : static GEN
    8780         224 : mfeisenstein_i(long k, GEN CHI1, GEN CHI2)
    8781             : {
    8782         224 :   long s = 1, ord, vt;
    8783             :   GEN E0, NK, vchi, CHI, T;
    8784         224 :   if (CHI2) { CHI2 = get_mfchar(CHI2); if (mfcharparity(CHI2) < 0) s = -s; }
    8785         224 :   if (CHI1) { CHI1 = get_mfchar(CHI1); if (mfcharparity(CHI1) < 0) s = -s; }
    8786         210 :   if (s != m1pk(k)) return mftrivial();
    8787         189 :   if (!CHI1)
    8788         112 :     CHI = CHI2? CHI2: mfchartrivial();
    8789          77 :   else if (!CHI2)
    8790          14 :     CHI = CHI1;
    8791             :   else
    8792          63 :     CHI = NULL;
    8793         189 :   if (CHI)
    8794             :   { /* E_k(chi) */
    8795         126 :     vt = varn(mfcharpol(CHI));
    8796         126 :     ord = mfcharorder(CHI);
    8797         126 :     NK = mkNK(mfcharmodulus(CHI), k, CHI);
    8798         126 :     E0 = charLFwtk(k, CHI, ord);
    8799         126 :     vchi = mkvec3(E0, mkvec(mfcharpol(CHI)), CHI);
    8800         126 :     return tag(t_MF_EISEN, NK, vchi);
    8801             :   }
    8802             :   /* E_k(chi1,chi2) */
    8803          63 :   vt = varn(mfcharpol(CHI1));
    8804          63 :   NK = NK_eisen2(k, CHI1, CHI2);
    8805          63 :   ord = clcm(mfcharorder(CHI1), mfcharorder(CHI2));
    8806          63 :   E0 = mfeisenstein2_0(k, CHI1, CHI2, ord);
    8807          63 :   T = mkvec(polcyclo(ord_canon(ord), vt));
    8808          63 :   vchi = mkvec4(E0, T, CHI1, CHI2);
    8809          63 :   return tag2(t_MF_EISEN, NK, vchi, mkvecsmall2(ord,0));
    8810             : }
    8811             : GEN
    8812         224 : mfeisenstein(long k, GEN CHI1, GEN CHI2)
    8813             : {
    8814         224 :   pari_sp av = avma;
    8815         224 :   if (k < 1) pari_err_DOMAIN("mfeisenstein", "k", "<", gen_1, stoi(k));
    8816         224 :   return gerepilecopy(av, mfeisenstein_i(k, CHI1, CHI2));
    8817             : }
    8818             : 
    8819             : static GEN
    8820        1085 : mfeisenstein2all(long N0, GEN NK, long k, GEN CHI1, GEN CHI2, GEN T, long o)
    8821             : {
    8822        1085 :   GEN E, E0 = mfeisenstein2_0(k, CHI1,CHI2, o), vchi = mkvec4(E0, T, CHI1,CHI2);
    8823        1085 :   long j, d = (lg(T)==4)? itou(gmael(T,3,1)): 1;
    8824        1085 :   E = cgetg(d+1, t_VEC);
    8825        1085 :   for (j=1; j<=d; j++) gel(E,j) = tag2(t_MF_EISEN, NK,vchi,mkvecsmall2(o,j-1));
    8826        1085 :   return mfbdall(E, N0 / mf_get_N(gel(E,1)));
    8827             : }
    8828             : 
    8829             : static GEN
    8830         476 : zncharsG(GEN G)
    8831             : {
    8832         476 :   long i, l, N = itou(znstar_get_N(G));
    8833             :   GEN vCHI, V;
    8834         476 :   if (N == 1) return mkvec2(gen_1,cgetg(1,t_COL));
    8835         476 :   vCHI = const_vec(N,NULL);
    8836         476 :   V = cyc2elts(znstar_get_conreycyc(G));
    8837         476 :   l = lg(V);
    8838       14504 :   for (i = 1; i < l; i++)
    8839             :   {
    8840       14028 :     GEN chi0, chi = zc_to_ZC(gel(V,i)), n, F;
    8841       14028 :     F = znconreyconductor(G, chi, &chi0);
    8842       14028 :     if (typ(F) != t_INT) F = gel(F,1);
    8843       14028 :     n = znconreyexp(G, chi);
    8844       14028 :     gel(vCHI, itos(n)) = mkvec2(F, chi0);
    8845             :   }
    8846         476 :   return vCHI;
    8847             : }
    8848             : 
    8849             : /* CHI primitive, f(CHI) | N. Return pairs (CHI1,CHI2) both primitive
    8850             :  * such that f(CHI1)*f(CHI2) | N and CHI1 * CHI2 = CHI;
    8851             :  * if k = 1, CHI1 is even; if k = 2, omit (1,1) if CHI = 1 */
    8852             : static GEN
    8853         658 : mfeisensteinbasis_i(long N0, long k, GEN CHI)
    8854             : {
    8855         658 :   GEN G = gel(CHI,1), chi = gel(CHI,2), vT = const_vec(myeulerphiu(N0), NULL);
    8856             :   GEN CHI0, GN, chiN, Lchi, LG, V, RES, NK, T;
    8857         658 :   long i, j, l, n, n1, N, ord = mfcharorder(CHI), OC = ord_canon(ord);
    8858         658 :   long F = mfcharmodulus(CHI), vt = varn(mfcharpol(CHI));
    8859             : 
    8860         658 :   CHI0 = (F == 1)? CHI: mfchartrivial();
    8861         658 :   j = 1; RES = cgetg(N0+1, t_VEC);
    8862         658 :   T = gel(vT,OC) = Qab_trace_init(polcyclo(OC,vt), OC, OC);
    8863         658 :   if (F != 1 || k != 2)
    8864             :   { /* N1 = 1 */
    8865         553 :     NK = mkNK(F, k, CHI);
    8866         553 :     gel(RES, j++) = mfeisenstein2all(N0, NK, k, CHI0, CHI, T, ord);
    8867         553 :     if (F != 1 && k != 1)
    8868         196 :       gel(RES, j++) = mfeisenstein2all(N0, NK, k, CHI, CHI0, T, ord);
    8869             :   }
    8870         658 :   if (N0 == 1) { setlg(RES,j); return RES; }
    8871         588 :   GN = G; chiN = chi;
    8872         588 :   if (F == N0) N = N0;
    8873             :   else
    8874             :   {
    8875         350 :     GEN faN = myfactoru(N0), P = gel(faN,1), E = gel(faN,2);
    8876         350 :     long lP = lg(P);
    8877         875 :     for (i = N = 1; i < lP; i++)
    8878             :     {
    8879         525 :       long p = P[i];
    8880         525 :       N *= upowuu(p, maxuu(E[i]/2, z_lval(F,p)));
    8881             :     }
    8882         350 :     if ((N & 3) == 2) N >>= 1;
    8883         350 :     if (N == 1) { setlg(RES,j); return RES; }
    8884         238 :     if (F != N)
    8885             :     {
    8886          84 :       GN = znstar0(utoipos(N),1);
    8887          84 :       chiN = zncharinduce(G, chi, GN);
    8888             :     }
    8889             :   }
    8890         476 :   LG = const_vec(N, NULL); /* LG[d] = znstar(d,1) or NULL */
    8891         476 :   gel(LG,1) = gel(CHI0,1);
    8892         476 :   gel(LG,F) = G;
    8893         476 :   gel(LG,N) = GN;
    8894         476 :   Lchi = coprimes_zv(N);
    8895         476 :   n = itou(znconreyexp(GN,chiN));
    8896         476 :   V = zncharsG(GN); l = lg(V);
    8897       18627 :   for (n1 = 2; n1 < l; n1++) /* skip 1 (trivial char) */
    8898             :   {
    8899       18151 :     GEN v = gel(V,n1), w, chi1, chi2, G1, G2, CHI1, CHI2;
    8900             :     long N12, N1, N2, no, oc, o12, t, m;
    8901       18151 :     if (!Lchi[n1]) continue;
    8902       13538 :     chi1 = gel(v,2); N1 = itou(gel(v,1)); /* conductor of chi1 */
    8903       13538 :     w = gel(V, Fl_div(n,n1,N));
    8904       13538 :     chi2 = gel(w,2); N2 = itou(gel(w,1)); /* conductor of chi2 */
    8905       13538 :     N12 = N1 * N2;
    8906       13538 :     if (N2 == 1 || N0 % N12) continue;
    8907             : 
    8908         406 :     G1 = gel(LG,N1); if (!G1) gel(LG,N1) = G1 = znstar0(utoipos(N1), 1);
    8909         406 :     if (k == 1 && zncharisodd(G1,chi1)) continue;
    8910         336 :     G2 = gel(LG,N2); if (!G2) gel(LG,N2) = G2 = znstar0(utoipos(N2), 1);
    8911         336 :     CHI1 = mfcharGL(G1, chi1);
    8912         336 :     CHI2 = mfcharGL(G2, chi2);
    8913         336 :     o12 = clcm(mfcharorder(CHI1), mfcharorder(CHI2));
    8914             :     /* remove Galois orbit: same trace */
    8915         336 :     no = Fl_powu(n1, ord, N);
    8916         546 :     for (t = 1+ord, m = n1; t <= o12; t += ord)
    8917             :     { /* m <-> CHI1^t, if t in Gal(Q(chi1,chi2)/Q), omit (CHI1^t,CHI2^t) */
    8918         210 :       m = Fl_mul(m, no, N); if (!m) break;
    8919         210 :       if (ugcd(t, o12) == 1) Lchi[m] = 0;
    8920             :     }
    8921         336 :     oc = ord_canon(o12); T = gel(vT,oc);
    8922         336 :     if (!T) T = gel(vT,oc) = Qab_trace_init(polcyclo(oc,vt), oc, OC);
    8923         336 :     NK = mkNK(N12, k, CHI);
    8924         336 :     gel(RES, j++) = mfeisenstein2all(N0, NK, k, CHI1, CHI2, T, o12);
    8925             :   }
    8926         476 :   setlg(RES,j); return RES;
    8927             : }
    8928             : 
    8929             : static GEN
    8930         504 : mfbd_E2(GEN E2, long d, GEN CHI)
    8931             : {
    8932         504 :   GEN E2d = mfbd_i(E2, d);
    8933         504 :   GEN F = mkvec2(E2, E2d), L = mkvec2(gen_1, utoineg(d));
    8934             :   /* cannot use mflinear_i: E2 and E2d do not have the same level */
    8935         504 :   return tag3(t_MF_LINEAR, mkNK(d,2,CHI), F, L, gen_1);
    8936             : }
    8937             : /* C-basis of E_k(Gamma_0(N),chi). If k = 1, the first basis element must not
    8938             :  * vanish at oo [used in mfwt1basis]. Here E_1(CHI), whose q^0 coefficient
    8939             :  * does not vanish (since L(CHI,0) does not) *if* CHI is not trivial; which
    8940             :  * must be the case in weight 1.
    8941             :  *
    8942             :  * (k>=3): In weight k >= 3, basis is B(d) E(CHI1,(CHI/CHI1)_prim), where
    8943             :  * CHI1 is primitive modulo N1, and if N2 is the conductor of CHI/CHI1
    8944             :  * then d*N1*N2 | N.
    8945             :  * (k=2): In weight k=2, same if CHI is nontrivial. If CHI is trivial, must
    8946             :  * not take CHI1 trivial, and must add E_2(tau)-dE_2(d tau)), where
    8947             :  * d|N, d > 1.
    8948             :  * (k=1): In weight k=1, same as k >= 3 except that we restrict to CHI1 even */
    8949             : static GEN
    8950         686 : mfeisensteinbasis(long N, long k, GEN CHI)
    8951             : {
    8952             :   long i, F;
    8953             :   GEN L;
    8954         686 :   if (badchar(N, k, CHI)) return cgetg(1, t_VEC);
    8955         686 :   if (k == 0) return mfcharistrivial(CHI)? mkvec(mf1()): cgetg(1, t_VEC);
    8956         658 :   CHI = mfchartoprimitive(CHI, &F);
    8957         658 :   L = mfeisensteinbasis_i(N, k, CHI);
    8958         658 :   if (F == 1 && k == 2)
    8959             :   {
    8960         105 :     GEN v, E2 = mfeisenstein(2, NULL, NULL), D = mydivisorsu(N);
    8961         105 :     long nD = lg(D)-1;
    8962         105 :     v = cgetg(nD, t_VEC); L = vec_append(L,v);
    8963         105 :     for (i = 1; i < nD; i++) gel(v,i) = mfbd_E2(E2, D[i+1], CHI);
    8964             :   }
    8965         658 :   return lg(L) == 1? L: shallowconcat1(L);
    8966             : }
    8967             : 
    8968             : /* when flag set, do not return error message */
    8969             : GEN
    8970         798 : mftobasis(GEN mf, GEN F, long flag)
    8971             : {
    8972         798 :   pari_sp av2, av = avma;
    8973             :   GEN G, v, y;
    8974         798 :   long B, ismf = checkmf_i(F);
    8975             : 
    8976         798 :   checkMF(mf);
    8977         798 :   if (ismf && !mfisinspace_i(mf, F))
    8978             :   {
    8979          63 :     if (flag) return cgetg(1, t_COL);
    8980           0 :     err_space(F);
    8981             :   }
    8982             :   /* at least the parameters are right */
    8983         735 :   B = mfsturmNgk(MF_get_N(mf), MF_get_gk(mf)) + 1;
    8984         735 :   if (ismf) v = mfcoefs_i(F,B,1);
    8985             :   else
    8986             :   {
    8987          91 :     switch(typ(F))
    8988             :     { /* F(0),...,F(lg(v)-2) */
    8989          63 :       case t_SER: v = sertocol(F); settyp(v,t_VEC); break;
    8990          14 :       case t_VEC: v = F; break;
    8991           7 :       case t_COL: v = shallowtrans(F); break;
    8992           7 :       default: pari_err_TYPE("mftobasis",F);
    8993             :                v = NULL;/*LCOV_EXCL_LINE*/
    8994             :     }
    8995          84 :     if (flag) B = minss(B, lg(v)-2);
    8996             :   }
    8997         728 :   y = mftobasis_i(mf, v);
    8998         728 :   if (typ(y) == t_VEC)
    8999             :   {
    9000          21 :     if (flag) return gerepilecopy(av, y);
    9001           0 :     pari_err(e_MISC, "not enough coefficients in mftobasis");
    9002             :   }
    9003         707 :   av2 = avma;
    9004         707 :   if (MF_get_space(mf) == mf_FULL || mfsturm(mf)+1 == B) return y;
    9005         182 :   G = mflinear(mf, y);
    9006         182 :   if (!gequal(v, mfcoefs_i(G, lg(v)-2,1))) y = NULL;
    9007         182 :   avma = av2;
    9008         182 :   if (!y)
    9009             :   {
    9010           7 :     if (flag) { avma = av; return cgetg(1, t_COL); }
    9011           7 :     err_space(F);
    9012             :   }
    9013         175 :   return gerepileupto(av, y);
    9014             : }
    9015             : 
    9016             : /* List of cusps of Gamma_0(N) */
    9017             : GEN
    9018          28 : mfcusps(GEN gN)
    9019             : {
    9020          28 :   pari_sp av = avma;
    9021             :   GEN D, v;
    9022          28 :   long i, c, l, N = 0;
    9023             : 
    9024          28 :   if (typ(gN) == t_INT) N = itos(gN);
    9025          14 :   else if (checkMF_i(gN)) N = MF_get_N(gN);
    9026           0 :   else pari_err_TYPE("mfcusps", gN);
    9027          28 :   if (N <= 0) pari_err_DOMAIN("mfcusps", "N", "<=", gen_0, stoi(N));
    9028          28 :   if (N == 1) return mkvec(gen_0);
    9029          28 :   D = mydivisorsu(N); l = lg(D);
    9030          28 :   c = mfnumcuspsu_fact(myfactoru(N));
    9031          28 :   v = cgetg(c + 1, t_VEC);
    9032         210 :   for (i = c = 1; i < l; i++)
    9033             :   {
    9034         182 :     long C = D[i], NC = D[l-i], lima = ugcd(C, NC), A0, A;
    9035         504 :     for (A0 = 0; A0 < lima; A0++)
    9036         322 :       if (cgcd(A0, lima) == 1)
    9037             :       {
    9038         210 :         A = A0; while (ugcd(A,C) > 1) A += lima;
    9039         210 :         gel(v, c++) = sstoQ(A, C);
    9040             :       }
    9041             :   }
    9042          28 :   return gerepileupto(av, v);
    9043             : }
    9044             : 
    9045             : long
    9046         315 : mfcuspisregular(GEN NK, GEN cusp)
    9047             : {
    9048             :   long v, N, dk, nk, t, o;
    9049             :   GEN CHI, go, A, C, g, c, d;
    9050         315 :   if (checkMF_i(NK))
    9051             :   {
    9052          49 :     GEN gk = MF_get_gk(NK);
    9053          49 :     N = MF_get_N(NK);
    9054          49 :     CHI = MF_get_CHI(NK);
    9055          49 :     Qtoss(gk, &nk, &dk);
    9056             :   }
    9057             :   else
    9058         266 :     checkNK2(NK, &N, &nk, &dk, &CHI, 0);
    9059         315 :   if (typ(cusp) == t_INFINITY) return 1;
    9060         315 :   if (typ(cusp) == t_FRAC) { A = gel(cusp,1); C = gel(cusp,2); }
    9061          28 :   else { A = cusp; C = gen_1; }
    9062         315 :   g = diviuexact(mului(N,C), ugcd(N, Fl_sqr(umodiu(C,N), N)));
    9063         315 :   c = mulii(negi(C),g);
    9064         315 :   d = addiu(mulii(A,g), 1);
    9065         315 :   if (!CHI) return 1;
    9066         315 :   go = gmfcharorder(CHI);
    9067         315 :   v = vali(go); if (v < 2) go = shifti(go, 2-v);
    9068         315 :   t = itou( znchareval(gel(CHI,1), gel(CHI,2), d, go) );
    9069         315 :   if (dk == 1) return t == 0;
    9070         154 :   o = itou(go);
    9071         154 :   if (kronecker(c,d) < 0) t = Fl_add(t, o/2, o);
    9072         154 :   if (Mod4(d) == 1) return t == 0;
    9073          14 :   t = Fl_sub(t, Fl_mul(o/4, nk, o), o);
    9074          14 :   return t == 0;
    9075             : }
    9076             : 
    9077             : /* Some useful closures */
    9078             : 
    9079             : /* sum_{d|n} d^k */
    9080             : static GEN
    9081       10878 : mysumdivku(ulong n, ulong k)
    9082             : {
    9083       10878 :   GEN fa = myfactoru(n);
    9084       10878 :   return k == 1? usumdiv_fact(fa): usumdivk_fact(fa,k);
    9085             : }
    9086             : static GEN
    9087         616 : c_Ek(long n, long d, GEN F)
    9088             : {
    9089         616 :   GEN E = cgetg(n + 2, t_VEC), C = gel(F,2);
    9090         616 :   long i, k = mf_get_k(F);
    9091         616 :   gel (E, 1) = gen_1;
    9092        7203 :   for (i = 1; i <= n; i++)
    9093             :   {
    9094        6587 :     pari_sp av = avma;
    9095        6587 :     gel(E, i+1) = gerepileupto(av, gmul(C, mysumdivku(i*d, k-1)));
    9096             :   }
    9097         616 :   return E;
    9098             : }
    9099             : 
    9100             : GEN
    9101         182 : mfEk(long k)
    9102             : {
    9103         182 :   pari_sp av = avma;
    9104             :   GEN E0, NK;
    9105         182 :   if (k <= 0 || (k & 1L)) pari_err_TYPE("mfEk [incorrect k]", stoi(k));
    9106         182 :   E0 = gdivsg(-2*k, bernfrac(k));
    9107         182 :   NK = mkNK(1,k,mfchartrivial());
    9108         182 :   return gerepilecopy(av, tag(t_MF_Ek, NK, E0));
    9109             : }
    9110             : 
    9111             : GEN
    9112          49 : mfDelta(void)
    9113             : {
    9114          49 :   pari_sp av = avma;
    9115          49 :   return gerepilecopy(av, tag0(t_MF_DELTA, mkNK(1,12,mfchartrivial())));
    9116             : }
    9117             : 
    9118             : GEN
    9119         329 : mfTheta(GEN psi)
    9120             : {
    9121         329 :   pari_sp av = avma;
    9122             :   GEN N, gk, psi2;
    9123             :   long par;
    9124         329 :   if (!psi) { psi = mfchartrivial(); N = utoipos(4); par = 1; }
    9125             :   else
    9126             :   {
    9127             :     long FC;
    9128          14 :     psi = get_mfchar(psi);
    9129          14 :     FC = mfcharconductor(psi);
    9130          14 :     if (mfcharmodulus(psi) != FC)
    9131           0 :       pari_err_TYPE("mfTheta [nonprimitive character]", psi);
    9132          14 :     par = mfcharparity(psi);
    9133          14 :     N = shifti(sqru(FC),2);
    9134             :   }
    9135         329 :   if (par > 0) { gk = ghalf; psi2 = psi; }
    9136           7 :   else { gk = gsubsg(2, ghalf); psi2 = mfcharmul(psi, get_mfchar(stoi(-4))); }
    9137         329 :   return gerepilecopy(av, tag(t_MF_THETA, mkgNK(N, gk, psi2, pol_x(1)), psi));
    9138             : }
    9139             : 
    9140             : /* FIXME: unify with etaquotype */
    9141             : static GEN
    9142          77 : eta_NK(GEN M, GEN R)
    9143             : {
    9144          77 :   long N, k, i, lD, lM = lg(M);
    9145             :   GEN gN, S0, S1, P, D;
    9146          77 :   N = 1; for(i = 1; i < lM; i++) N = clcm(N, M[i]);
    9147          77 :   D = mydivisorsu(N); lD = lg(D);
    9148          77 :   S0 = gen_0; S1 = gen_0; P = gen_1; k = 0;
    9149         434 :   for (i = 1; i < lD; i++)
    9150             :   {
    9151         357 :     long m = D[i], r = 0, j;
    9152        1505 :     for (j = 1; j < lM; j++)
    9153        1148 :       if (m == M[j]) r += R[j];
    9154         357 :     S0 = gaddgs(S0, r*m);
    9155         357 :     S1 = gadd(S1, sstoQ(r, 24*m));
    9156         357 :     if (odd(r)) P = mulis(P, m);
    9157         357 :     k += r;
    9158             :   }
    9159          77 :   if (smodis(S0, 24)) return NULL;
    9160          70 :   gN = lcmii(stoi(N), Q_denom(S1));
    9161          70 :   D = (k & 3L) == 2 ? negi(P): P;
    9162          70 :   if (odd(k)) D = gmul2n(D, 1);
    9163          70 :   return mkgNK(gN, sstoQ(k,2), get_mfchar(coredisc(D)), pol_x(1));
    9164             : }
    9165             : 
    9166             : /* check holomorphy at all cusps */
    9167             : static int
    9168          63 : eta_holomorphic(GEN B, GEN E, GEN NK)
    9169             : {
    9170          63 :   long N = itos(gel(NK, 1)), i, j, lD, lb;
    9171             :   GEN D;
    9172          63 :   if (gsigne(gel(NK,2)) < 0) return 0;
    9173          56 :   D = mydivisorsu(N); lD = lg(D); lb = lg(B);
    9174         455 :   for (i = 1; i < lD; i++)
    9175             :   {
    9176         399 :     GEN S = gen_0;
    9177         399 :     long d = D[i];
    9178        1631 :     for (j = 1; j < lb; j++)
    9179             :     {
    9180        1232 :       long g = cgcd(B[j], d), nu = g*g*E[j];
    9181        1232 :       S = gadd(S, sstoQ(nu, B[j]));
    9182             :     }
    9183         399 :     if (gsigne(S) < 0) return 0;
    9184             :   }
    9185          56 :   return 1;
    9186             : }
    9187             : 
    9188             : /* Output 0 if not desired eta product: if flag=0 (default) require
    9189             :  * holomorphic at cusps. If flag set, accept meromorphic, but sill in some
    9190             :  * modular function space */
    9191             : GEN
    9192          84 : mffrometaquo(GEN eta, long flag)
    9193             : {
    9194          84 :   pari_sp av = avma;
    9195             :   GEN B, E, NK;
    9196             :   long l, s;
    9197          84 :   if (typ(eta) != t_MAT || lg(eta) != 3 || !RgM_is_ZM(eta))
    9198           0 :     pari_err_TYPE("mffrometaquo", eta);
    9199          84 :   B = gel(eta,1); l = lg(B);
    9200          84 :   E = gel(eta,2);
    9201          84 :   if (lg(E) != l) pari_err_TYPE("mffrometaquo [not a factorization]", eta);
    9202          84 :   if (l == 1) return mf1();
    9203          77 :   s = maxss(0, itos(ZV_dotproduct(B,E)) / 24);
    9204          77 :   B = ZV_to_zv(B);
    9205          77 :   E = ZV_to_zv(E); NK = eta_NK(B,E);
    9206          77 :   if (!NK || (!flag && !eta_holomorphic(B,E,NK))) { avma = av; return gen_0; }
    9207          63 :   return gerepilecopy(av, tag2(t_MF_ETAQUO, NK, mkvec2(B,E), stoi(s)));
    9208             : }
    9209             : 
    9210             : #if 0
    9211             : /* number of primitive characters modulo N */
    9212             : static ulong
    9213             : numprimchars(ulong N)
    9214             : {
    9215             :   GEN fa, P, E;
    9216             :   long i, l;
    9217             :   ulong n;
    9218             :   if ((N & 3) == 2) return 0;
    9219             :   fa = myfactoru(N);
    9220             :   P = gel(fa,1); l = lg(P);
    9221             :   E = gel(fa,2);
    9222             :   for (i = n = 1; i < l; i++)
    9223             :   {
    9224             :     ulong p = P[i], e = E[i];
    9225             :     if (e == 2) n *= p-2; else n *= (p-1)*(p-1)*upowuu(p,e-2);
    9226             :   }
    9227             :   return n;
    9228             : }
    9229             : #endif
    9230             : 
    9231             : /* Space generated by products of two Eisenstein series */
    9232             : 
    9233             : INLINE int
    9234       57253 : cmp_small(long a, long b) { return a>b? 1: (a<b? -1: 0); }
    9235             : static int
    9236       16044 : cmp_small_priority(void *E, GEN a, GEN b)
    9237             : {
    9238       16044 :   GEN prio = (GEN)E;
    9239       16044 :   return cmp_small(prio[(long)a], prio[(long)b]);
    9240             : }
    9241             : static long
    9242         532 : znstar_get_expo(GEN G)
    9243             : {
    9244         532 :   GEN cyc = znstar_get_cyc(G);
    9245         532 :   return (lg(cyc) == 1)? 1: itou(gel(cyc,1));
    9246             : }
    9247             : 
    9248             : /* Return [vchi, bymod, vG]:
    9249             :  * vG[f] = znstar(f,1) for f a conductor of (at least) a char mod N; else NULL
    9250             :  * bymod[f] = vecsmall of conrey indexes of chars modulo f | N; else NULL
    9251             :  * vchi[n] = a list of CHIvec [G0,chi0,o,ncharvecexpo(G0,nchi0),...]:
    9252             :  *   chi0 = primitive char attached to Conrey Mod(n,N)
    9253             :  * (resp. NULL if (n,N) > 1) */
    9254             : static GEN
    9255         266 : charsmodN(long N)
    9256             : {
    9257         266 :   GEN D, G, prio, phio, dummy = cgetg(1,t_VEC);
    9258         266 :   GEN vP, vG = const_vec(N,NULL), vCHI  = const_vec(N,NULL);
    9259         266 :   GEN bymod = const_vec(N,NULL);
    9260         266 :   long pn, i, l, vt = fetch_user_var("t");
    9261         266 :   D = mydivisorsu(N); l = lg(D);
    9262        1379 :   for (i = 1; i < l; i++)
    9263        1113 :     gel(bymod, D[i]) = vecsmalltrunc_init(myeulerphiu(D[i])+1);
    9264         266 :   gel(vG,N) = G = znstar0(utoipos(N),1);
    9265         266 :   pn = znstar_get_expo(G);  /* exponent(Z/NZ)^* */
    9266         266 :   vP = const_vec(pn,NULL);
    9267        6881 :   for (i = 1; i <= N; i++)
    9268             :   {
    9269             :     GEN P, gF, G0, chi0, nchi0, chi, v, go;
    9270             :     long j, F, o;
    9271        6615 :     if (ugcd(i,N) != 1) continue;
    9272        4277 :     chi = znconreylog(G, utoipos(i));
    9273        4277 :     gF = znconreyconductor(G, chi, &chi0);
    9274        4277 :     F = (typ(gF) == t_INT)? itou(gF): itou(gel(gF,1));
    9275        4277 :     G0 = gel(vG, F); if (!G0) G0 = gel(vG,F) = znstar0(gF, 1);
    9276        4277 :     nchi0 = znconreylog_normalize(G0,chi0);
    9277        4277 :     go = gel(nchi0,1); o = itou(go); /* order(chi0) */
    9278        4277 :     v = ncharvecexpo(G0, nchi0);
    9279        4277 :     if (!equaliu(go, pn)) v = zv_z_mul(v, pn / o);
    9280        4277 :     P = gel(vP, o); if (!P) P = gel(vP,o) = polcyclo(o,vt);
    9281             :     /* mfcharcxinit with dummy complex powers */
    9282        4277 :     gel(vCHI,i) = mkvecn(6, G0, chi0, go, v, dummy, P);
    9283        4277 :     D = mydivisorsu(N / F); l = lg(D);
    9284        4277 :     for (j = 1; j < l; j++) vecsmalltrunc_append(gel(bymod, F*D[j]), i);
    9285             :   }
    9286         266 :   phio = zero_zv(pn); l = lg(vCHI); prio = cgetg(l, t_VEC);
    9287        6881 :   for (i = 1; i < l; i++)
    9288             :   {
    9289        6615 :     GEN CHI = gel(vCHI,i);
    9290             :     long o;
    9291        6615 :     if (!CHI) continue;
    9292        4277 :     o = CHIvec_ord(CHI);
    9293        4277 :     if (!phio[o]) phio[o] = myeulerphiu(o);
    9294        4277 :     prio[i] = phio[o];
    9295             :   }
    9296         266 :   l = lg(bymod);
    9297             :   /* sort characters by increasing value of phi(order) */
    9298        6881 :   for (i = 1; i < l; i++)
    9299             :   {
    9300        6615 :     GEN z = gel(bymod,i);
    9301        6615 :     if (z) gen_sort_inplace(z, (void*)prio, &cmp_small_priority, NULL);
    9302             :   }
    9303         266 :   return mkvec3(vCHI, bymod, vG);
    9304             : }
    9305             : 
    9306             : static GEN
    9307        2695 : mfeisenstein2pure(long k, GEN CHI1, GEN CHI2, long ord, GEN P, long lim)
    9308             : {
    9309        2695 :   GEN c, V = cgetg(lim+2, t_COL);
    9310             :   long n;
    9311        2695 :   c = mfeisenstein2_0(k, CHI1, CHI2, ord);
    9312        2695 :   if (P) c = grem(c, P);
    9313        2695 :   gel(V,1) = c;
    9314       45423 :   for (n=1; n <= lim; n++)
    9315             :   {
    9316       42728 :     c = sigchi2(k, CHI1, CHI2, n, ord);
    9317       42728 :     if (P) c = grem(c, P);
    9318       42728 :     gel(V,n+1) = c;
    9319             :   }
    9320        2695 :   return V;
    9321             : }
    9322             : static GEN
    9323        2037 : mfeisenstein2pure_Fl(long k, GEN CHI1vec, GEN CHI2vec, GEN vz, ulong p, long lim)
    9324             : {
    9325        2037 :   GEN V = cgetg(lim+2, t_VECSMALL);
    9326             :   long n;
    9327        2037 :   V[1] = mfeisenstein2_0_Fl(k, CHI1vec, CHI2vec, vz, p);
    9328        2037 :   for (n=1; n <= lim; n++) V[n+1] = sigchi2_Fl(k, CHI1vec, CHI2vec, n, vz, p);
    9329        2037 :   return V;
    9330             : }
    9331             : 
    9332             : static GEN
    9333         140 : getcolswt2(GEN M, GEN D, ulong p)
    9334             : {
    9335         140 :   GEN R, v = gel(M,1);
    9336         140 :   long i, l = lg(M) - 1;
    9337         140 :   R = cgetg(l, t_MAT); /* skip D[1] = 1 */
    9338         455 :   for (i = 1; i < l; i++)
    9339             :   {
    9340         315 :     GEN w = Flv_Fl_mul(gel(M,i+1), D[i+1], p);
    9341         315 :     gel(R,i) = Flv_sub(v, w, p);
    9342             :   }
    9343         140 :   return R;
    9344             : }
    9345             : static GEN
    9346        2695 : expandbd(GEN V, long d)
    9347             : {
    9348             :   long L, n, nd;
    9349             :   GEN W;
    9350        2695 :   if (d == 1) return V;
    9351         973 :   L = lg(V)-1; W = zerocol(L); /* nd = n/d */
    9352         973 :   for (n = nd = 0; n < L; n += d, nd++) gel(W, n+1) = gel(V, nd+1);
    9353         973 :   return W;
    9354             : }
    9355             : static GEN
    9356        3276 : expandbd_Fl(GEN V, long d)
    9357             : {
    9358             :   long L, n, nd;
    9359             :   GEN W;
    9360        3276 :   if (d == 1) return V;
    9361        1239 :   L = lg(V)-1; W = zero_Flv(L); /* nd = n/d */
    9362        1239 :   for (n = nd = 0; n < L; n += d, nd++) W[n+1] = V[nd+1];
    9363        1239 :   return W;
    9364             : }
    9365             : static void
    9366        2037 : getcols_i(GEN *pM, GEN *pvj, GEN gk, GEN CHI1vec, GEN CHI2vec, long NN1, GEN vz,
    9367             :           ulong p, long lim)
    9368             : {
    9369        2037 :   GEN CHI1 = CHIvec_CHI(CHI1vec), CHI2 = CHIvec_CHI(CHI2vec);
    9370        2037 :   long N2 = CHIvec_N(CHI2vec);
    9371        2037 :   GEN vj, M, D = mydivisorsu(NN1/N2);
    9372        2037 :   long i, l = lg(D), k = gk[2];
    9373        2037 :   GEN V = mfeisenstein2pure_Fl(k, CHI1vec, CHI2vec, vz, p, lim);
    9374        2037 :   M = cgetg(l, t_MAT);
    9375        2037 :   for (i = 1; i < l; i++) gel(M,i) = expandbd_Fl(V, D[i]);
    9376        2037 :   if (k == 2 && N2 == 1 && CHIvec_N(CHI1vec) == 1)
    9377             :   {
    9378         140 :     M = getcolswt2(M, D, p); l--;
    9379         140 :     D = vecslice(D, 2, l);
    9380             :   }
    9381        2037 :   *pM = M;
    9382        2037 :   *pvj = vj = cgetg(l, t_VEC);
    9383        2037 :   for (i = 1; i < l; i++) gel(vj,i) = mkvec4(gk, CHI1, CHI2, utoipos(D[i]));
    9384        2037 : }
    9385             : 
    9386             : /* find all CHI1, CHI2 mod N such that CHI1*CHI2 = CHI, f(CHI1)*f(CHI2) | N.
    9387             :  * set M = mfcoefs(B_e E(CHI1,CHI2), lim), vj = [e,i1,i2] */
    9388             : static void
    9389         840 : getcols(GEN *pM, GEN *pv, long k, long nCHI, GEN allN, GEN vz, ulong p,
    9390             :         long lim)
    9391             : {
    9392         840 :   GEN vCHI = gel(allN,1), gk = utoi(k);
    9393         840 :   GEN M = cgetg(1,t_MAT), v = cgetg(1,t_VEC);
    9394         840 :   long i1, N = lg(vCHI)-1;
    9395       38507 :   for (i1 = 1; i1 <= N; i1++)
    9396             :   {
    9397       37667 :     GEN CHI1vec = gel(vCHI, i1), CHI2vec, M1, v1;
    9398             :     long NN1, i2;
    9399       73871 :     if (!CHI1vec) continue;
    9400       32704 :     if (k == 1 && CHIvec_parity(CHI1vec) == -1) continue;
    9401       21070 :     NN1 = N/CHIvec_N(CHI1vec); /* N/f(chi1) */;
    9402       21070 :     i2 = Fl_div(nCHI,i1, N);
    9403       21070 :     if (!i2) i2 = 1;
    9404       21070 :     CHI2vec = gel(vCHI,i2);
    9405       21070 :     if (NN1 % CHIvec_N(CHI2vec)) continue; /* f(chi1)f(chi2) | N ? */
    9406        1463 :     getcols_i(&M1, &v1, gk, CHI1vec, CHI2vec, NN1, vz, p, lim);
    9407        1463 :     M = shallowconcat(M, M1);
    9408        1463 :     v = shallowconcat(v, v1);
    9409             :   }
    9410         840 :   *pM = M;
    9411         840 :   *pv = v;
    9412         840 : }
    9413             : 
    9414             : static void
    9415         511 : update_Mj(GEN *M, GEN *vecj, GEN *pz, ulong p)
    9416             : {
    9417             :   GEN perm;
    9418         511 :   *pz = Flm_indexrank(*M, p); perm = gel(*pz,2);
    9419         511 :   *M = vecpermute(*M, perm);
    9420         511 :   *vecj = vecpermute(*vecj, perm);
    9421         511 : }
    9422             : static int
    9423         231 : getcolsgen(long dim, GEN *pM, GEN *pvj, GEN *pz, long k, long ell, long nCHI,
    9424             :            GEN allN, GEN vz, ulong p, long lim)
    9425             : {
    9426         231 :   GEN vCHI = gel(allN,1), bymod = gel(allN,2), gell = utoi(ell);
    9427         231 :   long i1, N = lg(vCHI)-1;
    9428         231 :   long L = lim+1;
    9429         231 :   if (lg(*pvj)-1 >= dim) update_Mj(pM, pvj, pz, p);
    9430         231 :   if (lg(*pvj)-1 == dim) return 1;
    9431         770 :   for (i1 = 1; i1 <= N; i1++)
    9432             :   {
    9433         763 :     GEN CHI1vec = gel(vCHI, i1), T;
    9434             :     long par1, j, l, N1, NN1;
    9435             : 
    9436         763 :     if (!CHI1vec) continue;
    9437         756 :     par1 = CHIvec_parity(CHI1vec);
    9438         756 :     if (ell == 1 && par1 == -1) continue;
    9439         483 :     if (odd(ell)) par1 = -par1;
    9440         483 :     N1 = CHIvec_N(CHI1vec);
    9441         483 :     NN1 = N/N1;
    9442         483 :     T = gel(bymod, NN1); l = lg(T);
    9443        1680 :     for (j = 1; j < l; j++)
    9444             :     {
    9445        1407 :       long i2 = T[j], l1, l2, j1, s, nC;
    9446        1407 :       GEN M, M1, M2, vj, vj1, vj2, CHI2vec = gel(vCHI, i2);
    9447        2240 :       if (CHIvec_parity(CHI2vec) != par1) continue;
    9448         574 :       nC = Fl_div(nCHI, Fl_mul(i1,i2,N), N);
    9449         574 :       getcols(&M2, &vj2, k-ell, nC, allN, vz, p, lim);
    9450         574 :       l2 = lg(M2); if (l2 == 1) continue;
    9451         574 :       getcols_i(&M1, &vj1, gell, CHI1vec, CHI2vec, NN1, vz, p, lim);
    9452         574 :       l1 = lg(M1);
    9453         574 :       M1 = Flm_to_FlxV(M1, 0);
    9454         574 :       M2 = Flm_to_FlxV(M2, 0);
    9455         574 :       M  = cgetg((l1-1)*(l2-1) + 1, t_MAT);
    9456         574 :       vj = cgetg((l1-1)*(l2-1) + 1, t_VEC);
    9457        1421 :       for (j1 = s = 1; j1 < l1; j1++)
    9458             :       {
    9459         847 :         GEN E = gel(M1,j1), v = gel(vj1,j1);
    9460             :         long j2;
    9461        3577 :         for (j2 = 1; j2 < l2; j2++, s++)
    9462             :         {
    9463        2730 :           GEN c = Flx_to_Flv(Flxn_mul(E, gel(M2,j2), L, p), L);
    9464        2730 :           gel(M,s) = c;
    9465        2730 :           gel(vj,s) = mkvec2(v, gel(vj2,j2));
    9466             :         }
    9467             :       }
    9468         574 :       *pM = shallowconcat(*pM, M);
    9469         574 :       *pvj = shallowconcat(*pvj, vj);
    9470         574 :       if (lg(*pvj)-1 >= dim) update_Mj(pM, pvj, pz, p);
    9471         574 :       if (lg(*pvj)-1 == dim) return 1;
    9472             :     }
    9473             :   }
    9474           7 :   if (ell == 1)
    9475             :   {
    9476           7 :     update_Mj(pM, pvj, pz, p);
    9477           7 :     return (lg(*pvj)-1 == dim);
    9478             :   }
    9479           0 :   return 0;
    9480             : }
    9481             : 
    9482             : static GEN
    9483         686 : mkF2bd(long d, long lim)
    9484             : {
    9485         686 :   GEN V = zerovec(lim + 1);
    9486             :   long n;
    9487         686 :   gel(V, 1) = ginv(stoi(-24));
    9488         686 :   for (n = 1; n <= lim/d; n++) gel(V, n*d + 1) = mysumdivku(n, 1);
    9489         686 :   return V;
    9490             : }
    9491             : 
    9492             : static GEN
    9493        2947 : mkeisen(GEN E, long ord, GEN P, long lim)
    9494             : {
    9495        2947 :   long k = itou(gel(E,1)), e = itou(gel(E,4));
    9496        2947 :   GEN CHI1 = gel(E,2), CHI2 = gel(E,3);
    9497        2947 :   if (k == 2 && mfcharistrivial(CHI1) && mfcharistrivial(CHI2))
    9498         252 :     return gsub(mkF2bd(1,lim), gmulgs(mkF2bd(e,lim), e));
    9499             :   else
    9500             :   {
    9501        2695 :     GEN V = mfeisenstein2pure(k, CHI1, CHI2, ord, P, lim);
    9502        2695 :     return expandbd(V, e);
    9503             :   }
    9504             : }
    9505             : static GEN
    9506         252 : mkM(GEN vj, long pn, GEN P, long lim)
    9507             : {
    9508         252 :   long j, l = lg(vj), L = lim+1;
    9509         252 :   GEN M = cgetg(l, t_MAT);
    9510        2247 :   for (j = 1; j < l; j++)
    9511             :   {
    9512             :     GEN E1, E2;
    9513        1995 :     parse_vecj(gel(vj,j), &E1,&E2);
    9514        1995 :     E1 = RgV_to_RgX(mkeisen(E1, pn, P, lim), 0);
    9515        1995 :     if (E2)
    9516             :     {
    9517         952 :       E2 = RgV_to_RgX(mkeisen(E2, pn, P, lim), 0);
    9518         952 :       E1 = RgXn_mul(E1, E2, L);
    9519             :     }
    9520        1995 :     E1 = RgX_to_RgC(E1, L);
    9521        1995 :     if (P && E2) E1 = RgXQV_red(E1, P);
    9522        1995 :     gel(M,j) = E1;
    9523             :   }
    9524         252 :   return M;
    9525             : }
    9526             : 
    9527             : /* assume N > 2 */
    9528             : static GEN
    9529           7 : mffindeisen1(long N)
    9530             : {
    9531           7 :   GEN G = znstar0(utoipos(N), 1), L = chargalois(G, NULL), chi0 = NULL;
    9532           7 :   long j, m = N, l = lg(L);
    9533          56 :   for (j = 1; j < l; j++)
    9534             :   {
    9535          56 :     GEN chi = gel(L,j);
    9536          56 :     long r = myeulerphiu(itou(zncharorder(G,chi)));
    9537          56 :     if (r >= m) continue;
    9538          35 :     chi = znconreyfromchar(G, chi);
    9539          35 :     if (zncharisodd(G,chi)) { m = r; chi0 = chi; if (r == 1) break; }
    9540             :   }
    9541           7 :   if (!chi0) pari_err_BUG("mffindeisen1 [no Eisenstein series found]");
    9542           7 :   chi0 = znchartoprimitive(G,chi0);
    9543           7 :   return mfcharGL(gel(chi0,1), gel(chi0,2));
    9544             : }
    9545             : 
    9546             : static GEN
    9547         266 : mfeisensteinspaceinit_i(long N, long k, GEN CHI)
    9548             : {
    9549         266 :   GEN M, Minv, vj, vG, GN, allN, P, vz, z = NULL;
    9550         266 :   long nCHI, lim, ell, ord, pn, dim = mffulldim(N, k, CHI);
    9551             :   ulong r, p;
    9552             : 
    9553         266 :   if (!dim) retmkvec3(cgetg(1,t_VECSMALL),
    9554             :                       mkvec2(cgetg(1,t_MAT),gen_1),cgetg(1,t_VEC));
    9555         266 :   lim = mfsturmNk(N, k) + 1;
    9556         266 :   allN = charsmodN(N);
    9557         266 :   vG = gel(allN,3);
    9558         266 :   GN = gel(vG,N);
    9559         266 :   pn = znstar_get_expo(GN);
    9560         266 :   ord = ord_canon(pn);
    9561         266 :   P = ord == 1? NULL: polcyclo(ord, varn(mfcharpol(CHI)));
    9562         266 :   CHI = induce(GN, CHI); /* lift CHI mod N before mfcharno*/
    9563         266 :   nCHI = mfcharno(CHI);
    9564         266 :   r = QabM_init(ord, &p);
    9565         266 :   vz = Fl_powers(r, pn, p);
    9566         266 :   getcols(&M, &vj, k, nCHI, allN, vz, p, lim);
    9567         273 :   for (ell = k>>1; ell >= 1; ell--)
    9568         231 :     if (getcolsgen(dim, &M, &vj, &z, k, ell, nCHI, allN, vz, p, lim)) break;
    9569         266 :   if (!z) update_Mj(&M, &vj, &z, p);
    9570         266 :   if (lg(vj) - 1 < dim) return NULL;
    9571         252 :   M = mkM(vj, pn, P, lim);
    9572         252 :   Minv = QabM_Minv(rowpermute(M, gel(z,1)), P, ord);
    9573         252 :   return mkvec4(gel(z,1), Minv, vj, utoi(ord));
    9574             : }
    9575             : GEN
    9576         252 : mfeisensteinspaceinit(GEN NK)
    9577             : {
    9578         252 :   pari_sp av = avma;
    9579             :   GEN z, CHI;
    9580             :   long N, k;
    9581         252 :   if (checkMF_i(NK)) { N=MF_get_N(NK); k=MF_get_k(NK); CHI=MF_get_CHI(NK); }
    9582             :   else
    9583           0 :     checkNK(NK, &N, &k, &CHI, 0);
    9584         252 :   if (!CHI) CHI = mfchartrivial();
    9585         252 :   z = mfeisensteinspaceinit_i(N, k, CHI);
    9586         252 :   if (!z)
    9587             :   {
    9588           7 :     GEN E, CHIN = mffindeisen1(N), CHI0 = mfchartrivial();
    9589           7 :     z = mfeisensteinspaceinit_i(N, k+1, mfcharmul(CHI, CHIN));
    9590           7 :     if (z) E = mkvec4(gen_1, CHI0, CHIN, gen_1);
    9591             :     else
    9592             :     {
    9593           7 :       z = mfeisensteinspaceinit_i(N, k+2, CHI);
    9594           7 :       E = mkvec4(gen_2, CHI0, CHI0, utoipos(N));
    9595             :     }
    9596           7 :     z = mkvec2(z, E);
    9597             :   }
    9598         252 :   return gerepilecopy(av, z);
    9599             : }
    9600             : 
    9601             : /* decomposition of modular form on eisenspace */
    9602             : static GEN
    9603         644 : mfeisensteindec(GEN mf, GEN F)
    9604             : {
    9605         644 :   pari_sp av = avma;
    9606             :   GEN M, Mindex, Mvecj, V, B, CHI;
    9607             :   long o, ord;
    9608             : 
    9609         644 :   Mvecj = obj_checkbuild(mf, MF_EISENSPACE, &mfeisensteinspaceinit);
    9610         644 :   if (lg(Mvecj) < 5)
    9611             :   {
    9612           7 :     GEN E, e = gel(Mvecj,2), gkE = gel(e,1);
    9613           7 :     long dE = itou(gel(e,4));
    9614           7 :     Mvecj = gel(Mvecj,1);
    9615           7 :     E = mfeisenstein(itou(gkE), NULL, gel(e,3));
    9616           7 :     if (dE != 1) E = mfbd_E2(E, dE, gel(e,2)); /* here k = 2 */
    9617           7 :     F = mfmul(F, E);
    9618             :   }
    9619         644 :   M = gel(Mvecj, 2);
    9620         644 :   if (lg(M) == 1) return cgetg(1, t_VEC);
    9621         644 :   Mindex = gel(Mvecj, 1);
    9622         644 :   ord = itou(gel(Mvecj,4));
    9623         644 :   V = mfcoefs(F, Mindex[lg(Mindex)-1]-1, 1); settyp(V, t_COL);
    9624         644 :   CHI = mf_get_CHI(F);
    9625         644 :   o = mfcharorder_canon(CHI);
    9626         644 :   if (o > 1 && o != ord)
    9627             :   { /* convert Mod(.,polcyclo(o)) to Mod(., polcyclo(N)) for o | N,
    9628             :      * o and N both != 2 (mod 4) */
    9629          42 :     GEN z, P = mfcharpol(CHI);
    9630          42 :     long vt = varn(P);
    9631          42 :     if (ord % o) pari_err_TYPE("mfeisensteindec", V);
    9632          42 :     z = gmodulo(pol_xn(ord/o, vt), polcyclo(ord, vt));
    9633          42 :     V = gsubst(liftpol_shallow(V), vt, z);
    9634             :   }
    9635         644 :   B = Minv_RgC_mul(M, vecpermute(V, Mindex));
    9636         644 :   return gerepileupto(av, B);
    9637             : }
    9638             : 
    9639             : /*********************************************************************/
    9640             : /*                        END EISENSPACE                             */
    9641             : /*********************************************************************/
    9642             : 
    9643             : static GEN
    9644          70 : sertocol2(GEN S, long l)
    9645             : {
    9646          70 :   GEN C = cgetg(l + 2, t_COL);
    9647             :   long i;
    9648          70 :   for (i = 0; i <= l; i++) gel(C, i+1) = polcoeff_i(S, i, -1);
    9649          70 :   return C;
    9650             : }
    9651             : 
    9652             : /* Compute polynomial P0 such that F=E4^(k/4)P0(E6/E4^(3/2)). */
    9653             : static GEN
    9654          14 : mfcanfindp0(GEN F, long k)
    9655             : {
    9656          14 :   pari_sp ltop = avma;
    9657             :   GEN E4, E6, V, V1, Q, W, res, M, B;
    9658             :   long l, j;
    9659          14 :   l = k/6 + 2;
    9660          14 :   V = mfcoefsser(F,l);
    9661          14 :   E4 = mfcoefsser(mfEk(4),l);
    9662          14 :   E6 = mfcoefsser(mfEk(6),l);
    9663          14 :   V1 = gdiv(V, gpow(E4, sstoQ(k,4), 0));
    9664          14 :   Q = gdiv(E6, gpow(E4, sstoQ(3,2), 0));
    9665          14 :   W = gpowers(Q, l - 1);
    9666          14 :   M = cgetg(l + 1, t_MAT);
    9667          14 :   for (j = 1; j <= l; j++) gel(M,j) = sertocol2(gel(W,j), l);
    9668          14 :   B = sertocol2(V1, l);
    9669          14 :   res = inverseimage(M, B);
    9670          14 :   if (lg(res) == 1) err_space(F);
    9671          14 :   return gerepilecopy(ltop, gtopolyrev(res, 0));
    9672             : }
    9673             : 
    9674             : /* Compute the first n+1 Taylor coeffs at tau=I of a modular form
    9675             :  * on SL_2(Z). */
    9676             : GEN
    9677          14 : mftaylor(GEN F, long n, long flreal, long prec)
    9678             : {
    9679          14 :   pari_sp ltop = avma;
    9680          14 :   GEN P0, Pm1 = gen_0, v;
    9681          14 :   GEN X2 = mkpoln(3, ghalf,gen_0,gneg(ghalf)); /* (x^2-1) / 2 */
    9682             :   long k, m;
    9683          14 :   if (!checkmf_i(F)) pari_err_TYPE("mftaylor",F);
    9684          14 :   k = mf_get_k(F);
    9685          14 :   if (mf_get_N(F) != 1 || k < 0) pari_err_IMPL("mftaylor for this form");
    9686          14 :   P0 = mfcanfindp0(F, k);
    9687          14 :   v = cgetg(n+2, t_VEC); gel(v, 1) = RgX_coeff(P0,0);
    9688         154 :   for (m = 0; m < n; m++)
    9689             :   {
    9690         140 :     GEN P1 = gdivgs(gmulsg(-(k + 2*m), RgX_shift(P0,1)), 12);
    9691         140 :     P1 = gadd(P1, gmul(X2, RgX_deriv(P0)));
    9692         140 :     if (m) P1 = gsub(P1, gdivgs(gmulsg(m*(m+k-1), Pm1), 144));
    9693         140 :     Pm1 = P0; P0 = P1;
    9694         140 :     gel(v, m+2) = RgX_coeff(P0, 0);
    9695             :   }
    9696          14 :   if (flreal)
    9697             :   {
    9698           7 :     GEN pi2 = Pi2n(1, prec), pim4 = gmulsg(-2, pi2), VPC;
    9699           7 :     GEN C = gmulsg(3, gdiv(gpowgs(ggamma(ginv(utoi(4)), prec), 8), gpowgs(pi2, 6)));
    9700             :     /* E_4(i): */
    9701           7 :     GEN facn = gen_1;
    9702           7 :     VPC = gpowers(gmul(pim4, gsqrt(C, prec)), n);
    9703           7 :     C = gpow(C, sstoQ(k,4), prec);
    9704          84 :     for (m = 0; m <= n; m++)
    9705             :     {
    9706          77 :       gel(v, m+1) = gdiv(gmul(C, gmul(gel(v, m+1), gel(VPC, m+1))), facn);
    9707          77 :       facn = gmulgs(facn, m+1);
    9708             :     }
    9709             :   }
    9710          14 :   return gerepilecopy(ltop, v);
    9711             : }
    9712             : 
    9713             : #if 0
    9714             : /* To be used in mfeigensearch() */
    9715             : GEN
    9716             : mfreadratfile()
    9717             : {
    9718             :   GEN eqn;
    9719             :   pariFILE *F = pari_fopengz("rateigen300.gp");
    9720             :   eqn = gp_readvec_stream(F->file);
    9721             :   pari_fclose(F);
    9722             :   return eqn;
    9723             : }
    9724             : #endif
    9725             :  /*****************************************************************/
    9726             : /*           EISENSTEIN CUSPS: COMPLEX DIRECTLY: one F_k         */
    9727             : /*****************************************************************/
    9728             : 
    9729             : /* CHIvec = charinit(CHI); data = [N1g/g1,N2g/g2,g1/g,g2/g,C/g1,C/g2,
    9730             :  * (N1g/g1)^{-1},(N2g/g2)^{-1}] */
    9731             : 
    9732             : /* nm = n/m;
    9733             :  * z1 = powers of \z_{C/g}^{(Ae/g)^{-1}},
    9734             :  * z2 = powers of \z_N^{A^{-1}(g1g2/C)}]
    9735             :  * N.B. : we compute value and conjugate at the end, so it is (Ae/g)^{-1}
    9736             :  * and not -(Ae/g)^{-1} */
    9737             : static GEN
    9738     1640002 : eiscnm(long nm, long m, GEN CHI1vec, GEN CHI2vec, GEN data, GEN z1)
    9739             : {
    9740     1640002 :   long Cg1 = data[5], s10 = (nm*data[7]) % Cg1, r10 = (nm - data[1]*s10) / Cg1;
    9741     1640002 :   long Cg2 = data[6], s20 = (m *data[8]) % Cg2, r20 = (m  - data[2]*s20) / Cg2;
    9742             :   long j1, r1, s1;
    9743     1640002 :   GEN T = gen_0;
    9744     3587612 :   for (j1 = 0, r1 = r10, s1 = s10; j1 < data[3]; j1++, r1 -= data[1], s1 += Cg1)
    9745             :   {
    9746     1947610 :     GEN c1 = mychareval(CHI1vec, r1);
    9747     1947610 :     if (!gequal0(c1))
    9748             :     {
    9749             :       long j2, r2, s2;
    9750     1746122 :       GEN S = gen_0;
    9751     4314338 :       for (j2 = 0, r2 = r20, s2 = s20; j2 < data[4]; j2++, r2 -= data[2], s2 += Cg2)
    9752             :       {
    9753     2568216 :         GEN c2 = mychareval(CHI2vec, r2);
    9754     2568216 :         if (!gequal0(c2)) S = gadd(S, gmul(c2, rootsof1pow(z1, s1*s2)));
    9755             :       }
    9756     1746122 :       T = gadd(T, gmul(c1, S));
    9757             :     }
    9758             :   }
    9759     1640002 :   return gconj(T);
    9760             : }
    9761             : 
    9762             : static GEN
    9763      168462 : fg1g2n(long n, long k, GEN CHI1vec, GEN CHI2vec, GEN data, GEN z1, GEN z2)
    9764             : {
    9765      168462 :   GEN S = gen_0, D = mydivisorsu(n);
    9766      168462 :   long i, l = lg(D);
    9767      988463 :   for (i = 1; i < l; i++)
    9768             :   {
    9769      820001 :     long m = D[i], nm = D[l-i]; /* n/m */
    9770      820001 :     GEN u = eiscnm( nm,  m, CHI1vec, CHI2vec, data, z1);
    9771      820001 :     GEN v = eiscnm(-nm, -m, CHI1vec, CHI2vec, data, z1);
    9772      820001 :     GEN w = odd(k) ? gsub(u, v) : gadd(u, v);
    9773      820001 :     S = gadd(S, gmul(powuu(m, k-1), w));
    9774             :   }
    9775      168462 :   return gmul(S, rootsof1pow(z2, n));
    9776             : }
    9777             : 
    9778             : static GEN
    9779       10143 : gausssumcx(GEN CHIvec, long prec)
    9780             : {
    9781       10143 :   GEN z, S, V = CHIvec_val(CHIvec);
    9782       10143 :   long m, N = CHIvec_N(CHIvec);
    9783       10143 :   z = rootsof1u_cx(N, prec);
    9784       10143 :   S = gmul(z, gel(V, N));
    9785       10143 :   for (m = N-1; m >= 1; m--) S = gmul(z, gadd(gel(V, m), S));
    9786       10143 :   return S;
    9787             : }
    9788             : 
    9789             : /* Computation of Q_k(\z_N^s) as a polynomial in \z_N^s. FIXME: explicit
    9790             :  * formula ? */
    9791             : static GEN
    9792        1470 : mfqk(long k, long N)
    9793             : {
    9794        1470 :   GEN X = pol_x(0), P = gsubgs(gpowgs(X,N), 1), ZI, Q, Xm1, invden;
    9795             :   long i;
    9796        1470 :   ZI = cgetg(N, t_VEC);
    9797        1470 :   for (i = 1; i < N; i++) gel(ZI, i) = utoi(i);
    9798        1470 :   ZI = gdivgs(gmul(X, gtopolyrev(ZI, 0)), N);
    9799        1470 :   if (k == 1) return ZI;
    9800        1050 :   invden = RgXQ_powu(ZI, k, P);
    9801        1050 :   Q = gneg(X); Xm1 = gsubgs(X, 1);
    9802        2681 :   for (i = 2; i < k; i++)
    9803        1631 :     Q = gmul(X, ZX_add(gmul(Xm1, ZX_deriv(Q)), gmulsg(-i, Q)));
    9804        1050 :   return RgXQ_mul(Q, invden, P);
    9805             : }
    9806             : /* CHI mfchar */
    9807             : /* Warning: M is a multiple of the conductor of CHI, but is NOT
    9808             :    necessarily its modulus */
    9809             : 
    9810             : static GEN
    9811        2247 : mfskcx(long k, GEN CHI, long M, long prec)
    9812             : {
    9813             :   GEN S, CHIvec, P;
    9814             :   long F, m, i, l;
    9815        2247 :   CHI = mfchartoprimitive(CHI, &F);
    9816        2247 :   CHIvec = mfcharcxinit(CHI, prec);
    9817        2247 :   if (F == 1) S = gdivgs(bernfrac(k), k);
    9818             :   else
    9819             :   {
    9820        1470 :     GEN Q = mfqk(k, F), V = CHIvec_val(CHIvec);
    9821        1470 :     S = gmul(gel(V, F), RgX_coeff(Q, 0));
    9822        1470 :     for (m = 1; m < F; m++) S = gadd(S, gmul(gel(V, m), RgX_coeff(Q, m)));
    9823        1470 :     S = gconj(S);
    9824             :   }
    9825             :   /* prime divisors of M not dividing f(chi) */
    9826        2247 :   P = gel(myfactoru(u_ppo(M/F,F)), 1); l = lg(P);
    9827        2261 :   for (i = 1; i < l; i++)
    9828             :   {
    9829          14 :     long p = P[i];
    9830          14 :     S = gmul(S, gsubsg(1, gdiv(mychareval(CHIvec, p), powuu(p, k))));
    9831             :   }
    9832        2247 :   return gmul(gmul(gausssumcx(CHIvec, prec), S), powuu(M/F, k));
    9833             : }
    9834             : 
    9835             : static GEN
    9836        3983 : f00_i(long k, GEN CHI1vec, GEN CHI2vec, GEN G2, GEN S, long prec)
    9837             : {
    9838             :   GEN c, a;
    9839        3983 :   long N1 = CHIvec_N(CHI1vec), N2 = CHIvec_N(CHI2vec);
    9840        3983 :   if (S[2] != N1) return gen_0;
    9841        2247 :   c = mychareval(CHI1vec, S[3]);
    9842        2247 :   if (isintzero(c)) return gen_0;
    9843        2247 :   a = mfskcx(k, mfchardiv(CHIvec_CHI(CHI2vec), CHIvec_CHI(CHI1vec)), N1*N2, prec);
    9844        2247 :   a = gmul(a, gconj(gmul(c,G2)));
    9845        2247 :   return gdiv(a, mulsi(-N2, powuu(S[1], k-1)));
    9846             : }
    9847             : 
    9848             : static GEN
    9849        3507 : f00(long k, GEN CHI1vec,GEN CHI2vec, GEN G1,GEN G2, GEN data, long prec)
    9850             : {
    9851             :   GEN T1, T2;
    9852        3507 :   T2 = f00_i(k, CHI1vec, CHI2vec, G2, data, prec);
    9853        3507 :   if (k > 1) return T2;
    9854         476 :   T1 = f00_i(k, CHI2vec, CHI1vec, G1, data, prec);
    9855         476 :   return gadd(T1, T2);
    9856             : }
    9857             : 
    9858             : /* ga in SL_2(Z), find beta [a,b;c,d] in Gamma_0(N) and mu in Z such that
    9859             :  * beta * ga * T^u = [A',B';C',D'] with C' | N and N | B' */
    9860             : static void
    9861        3948 : mfgatogap(GEN ga, long N, long *pA, long *pC, long *pD, long *pd, long *pmu)
    9862             : {
    9863        3948 :   long A = itos(gcoeff(ga,1,1)), B = itos(gcoeff(ga,1,2));
    9864        3948 :   long C = itos(gcoeff(ga,2,1)), D = itos(gcoeff(ga,2,2));
    9865             :   long a, b, c, d, t, u, v, w, mu, ANsurCp, B1, Ap, D1, Cp, cN;
    9866        3948 :   Cp = cbezout(A*N, C, &c, &d);
    9867        3948 :   w = 0; ANsurCp = A*N/Cp;
    9868        3948 :   while (cgcd(d, N) > 1) { w++; d -= ANsurCp; }
    9869        3948 :   c += w*C/Cp; cN = c*N;
    9870        3948 :   D1 = cN*B + d*D;
    9871        3948 :   cbezout(d, -cN, &a, &b);
    9872        3948 :   t = 0; Ap = a*A + b*C;
    9873        3948 :   while (cgcd(Ap, N) > 1) { t++; Ap += Cp; }
    9874        3948 :   B1 = a*B + b*D + t*D1;
    9875        3948 :   cbezout(Ap, N, &u, &v);
    9876        3948 :   *pmu = mu = (-B1*u)%N;
    9877        3948 :   *pd = d; /* other coeffs of beta are useless */
    9878        3948 :   *pA = Ap; /* *pB = B1 + Ap*mu; useless */
    9879        3948 :   *pC = Cp; *pD = D1 + Cp*mu;
    9880        3948 : }
    9881             : 
    9882             : #if 0
    9883             : /* CHI is a mfchar, return alpha(CHI) */
    9884             : static long
    9885             : mfalchi(GEN CHI, long AN, long cg)
    9886             : {
    9887             :   GEN G = gel(CHI,1), chi = gel(CHI,2), go = gmfcharorder(CHI);
    9888             :   long o = itou(go), a = itos( znchareval(G, chi, stoi(1 + AN/cg), go) );
    9889             :   if (a < 0 || (cg * a) % o) pari_err_BUG("mfalchi");
    9890             :   return (cg * a) / o;
    9891             : }
    9892             : #endif
    9893             : /* return A such that CHI1(t) * CHI2(t) = e(A) or NULL if (t,N1*N2) > 1 */
    9894             : static GEN
    9895        7896 : mfcharmuleval(GEN CHI1vec, GEN CHI2vec, long t)
    9896             : {
    9897        7896 :   long a1 = mycharexpo(CHI1vec, t), o1 = CHIvec_ord(CHI1vec);
    9898        7896 :   long a2 = mycharexpo(CHI2vec, t), o2 = CHIvec_ord(CHI2vec);;
    9899        7896 :   if (a1 < 0 || a2 < 0) return NULL;
    9900        7896 :   return sstoQ(a1*o2 + a2*o1, o1*o2);
    9901             : }
    9902             : static GEN
    9903        3948 : mfcharmulcxeval(GEN CHI1vec, GEN CHI2vec, long t, long prec)
    9904             : {
    9905        3948 :   GEN A = mfcharmuleval(CHI1vec, CHI2vec, t);
    9906             :   long n, d;
    9907        3948 :   if (!A) return gen_0;
    9908        3948 :   Qtoss(A, &n,&d); return rootsof1q_cx(n, d, prec);
    9909             : }
    9910             : /* alpha(CHI1 * CHI2) */
    9911             : static long
    9912        3948 : mfalchi2(GEN CHI1vec, GEN CHI2vec, long AN, long cg)
    9913             : {
    9914        3948 :   GEN A = mfcharmuleval(CHI1vec, CHI2vec, 1 + AN/cg);
    9915             :   long a;
    9916        3948 :   if (!A) pari_err_BUG("mfalchi2");
    9917        3948 :   A = gmulsg(cg, A);
    9918        3948 :   if (typ(A) != t_INT) pari_err_BUG("mfalchi2");
    9919        3948 :   a = itos(A) % cg; if (a < 0) a += cg;
    9920        3948 :   return a;
    9921             : }
    9922             : 
    9923             : /* return g = (a,b), set u >= 0 s.t. g = a * u (mod b) */
    9924             : static long
    9925       15792 : mybezout(long a, long b, long *pu)
    9926             : {
    9927       15792 :   long junk, g = cbezout(a, b, pu, &junk);
    9928       15792 :   if (*pu < 0) *pu += b/g;
    9929       15792 :   return g;
    9930             : }
    9931             : 
    9932             : /* E = [k, CHI1,CHI2, e], CHI1 and CHI2 primitive mfchars such that,
    9933             :  * CHI1(-1)*CHI2(-1) = (-1)^k; expansion of (B_e (E_k(CHI1,CHI2))) | ga.
    9934             :  * w is the width for the space of the calling function. */
    9935             : static GEN
    9936        3948 : mfeisensteingacx(GEN E, long w, GEN ga, long lim, long prec)
    9937             : {
    9938        3948 :   GEN CHI1vec, CHI2vec, CHI1 = gel(E,2), CHI2 = gel(E,3), v, S, ALPHA;
    9939             :   GEN G1, G2, z1, z2, data;
    9940        3948 :   long k = itou(gel(E,1)), e = itou(gel(E,4));
    9941        3948 :   long N1 = mfcharmodulus(CHI1);
    9942        3948 :   long N2 = mfcharmodulus(CHI2), N = e * N1 * N2;
    9943             :   long NsurC, cg, wN, A, C, Ai, d, mu, alchi, na, da;
    9944             :   long eg, g, gH, U, u0, u1, u2, Aig, H, m, n, t, Cg, NC1, NC2;
    9945             : 
    9946        3948 :   mfgatogap(ga, N, &A, &C, &Ai, &d, &mu);
    9947        3948 :   CHI1vec = mfcharcxinit(CHI1, prec);
    9948        3948 :   CHI2vec = mfcharcxinit(CHI2, prec);
    9949        3948 :   NsurC = N/C; cg  = cgcd(C, NsurC); wN = NsurC / cg;
    9950        3948 :   if (w%wN) pari_err_BUG("mfeisensteingacx [wN does not divide w]");
    9951        3948 :   alchi = mfalchi2(CHI1vec, CHI2vec, A*N, cg);
    9952        3948 :   ALPHA = sstoQ(alchi, NsurC);
    9953             : 
    9954        3948 :   g = mybezout(A*e, C, &u0); Cg = C/g; eg = e/g;
    9955        3948 :   NC1 = mybezout(N1, Cg, &u1);
    9956        3948 :   NC2 = mybezout(N2, Cg, &u2);
    9957        3948 :   H = (NC1*NC2*g)/Cg;
    9958        3948 :   Aig = (Ai*H)%N; if (Aig < 0) Aig += N;
    9959        3948 :   z1 = rootsof1powinit(u0, Cg, prec);
    9960        3948 :   z2 = rootsof1powinit(Aig, N, prec);
    9961        3948 :   data = mkvecsmalln(8, N1/NC1, N2/NC2, NC1, NC2, Cg/NC1, Cg/NC2, u1, u2);
    9962        3948 :   v = zerovec(lim + 1);
    9963             :   /* need n*H = alchi (mod cg) */
    9964        3948 :   gH = mybezout(H, cg, &U);
    9965        3948 :   if (gH > 1)
    9966             :   {
    9967         133 :     if (alchi % gH) return mkvec2(gen_0, v);
    9968         133 :     alchi /= gH; cg /= gH; H /= gH;
    9969             :   }
    9970        3948 :   G1 = gausssumcx(CHI1vec, prec);
    9971        3948 :   G2 = gausssumcx(CHI2vec, prec);
    9972        3948 :   if (!alchi)
    9973        3507 :     gel(v,1) = f00(k, CHI1vec,CHI2vec,G1,G2, mkvecsmall3(NC2,Cg,A*eg), prec);
    9974        3948 :   n = Fl_mul(alchi,U,cg); if (!n) n = cg;
    9975        3948 :   m = (n*H - alchi) / cg; /* positive, exact division */
    9976      172410 :   for (; m <= lim; n+=cg, m+=H)
    9977      168462 :     gel(v, m+1) = fg1g2n(n, k, CHI1vec, CHI2vec, data, z1,z2);
    9978        3948 :   t = (2*e)/g; if (odd(k)) t = -t;
    9979        3948 :   v = gdiv(v, gmul(gconj(gmul(G1,G2)), mulsi(t, powuu(eg*N2/NC2, k-1))));
    9980        3948 :   if (k == 2 && N1 == 1 && N2 == 1) v = gsub(mkF2bd(wN,lim), gmulsg(e,v));
    9981             : 
    9982        3948 :   Qtoss(ALPHA, &na,&da);
    9983        3948 :   S = gconj( mfcharmulcxeval(CHI1vec,CHI2vec,d,prec) ); /* CHI(1/d) */
    9984        3948 :   if (wN > 1)
    9985             :   {
    9986        3024 :     GEN z = rootsof1powinit(-mu, wN, prec);
    9987        3024 :     long i, l = lg(v);
    9988        3024 :     for (i = 1; i < l; i++) gel(v,i) = gmul(gel(v,i), rootsof1pow(z,i-1));
    9989             :   }
    9990        3948 :   v = RgV_Rg_mul(v, gmul(S, rootsof1q_cx(-mu*na, da, prec)));
    9991        3948 :   return mkvec2(ALPHA, bdexpand(v, w/wN));
    9992             : }
    9993             : 
    9994             : /*****************************************************************/
    9995             : /*                       END EISENSTEIN CUSPS                    */
    9996             : /*****************************************************************/
    9997             : 
    9998             : static GEN
    9999        1533 : mfchisimpl(GEN CHI)
   10000             : {
   10001             :   GEN G, chi;
   10002        1533 :   if (typ(CHI) == t_INT) return CHI;
   10003        1533 :   G = gel(CHI, 1); chi = gel(CHI, 2);
   10004        1533 :   switch(mfcharorder(CHI))
   10005             :   {
   10006        1106 :     case 1: chi = gen_1; break;
   10007         406 :     case 2: chi = znchartokronecker(G,chi,1); break;
   10008          21 :     default:chi = mkintmod(znconreyexp(G,chi), znstar_get_N(G)); break;
   10009             :   }
   10010        1533 :   return chi;
   10011             : }
   10012             : 
   10013             : GEN
   10014         651 : mfparams(GEN F)
   10015             : {
   10016         651 :   pari_sp av = avma;
   10017             :   GEN z;
   10018         651 :   if (checkMF_i(F))
   10019             :   {
   10020          14 :     long N = MF_get_N(F);
   10021          14 :     GEN gk = MF_get_gk(F);
   10022          14 :     z = mkvec4(utoi(N), gk, MF_get_CHI(F), utoi(MF_get_space(F)));
   10023             :   }
   10024             :   else
   10025             :   {
   10026         637 :     if (!checkmf_i(F)) pari_err_TYPE("mfparams", F);
   10027         637 :     z = shallowcopy( mf_get_NK(F) );
   10028             :   }
   10029         651 :   gel(z,3) = mfchisimpl(gel(z,3));
   10030         651 :   return gerepilecopy(av, z);
   10031             : }
   10032             : 
   10033             : GEN
   10034          14 : mfisCM(GEN F)
   10035             : {
   10036          14 :   pari_sp av = avma;
   10037             :   forprime_t S;
   10038             :   GEN D, v;
   10039             :   long N, k, lD, sb, p, i;
   10040          14 :   if (!checkmf_i(F)) pari_err_TYPE("mfisCM", F);
   10041          14 :   N = mf_get_N(F);
   10042          14 :   k = mf_get_k(F); if (N < 0 || k < 0) pari_err_IMPL("mfisCM for this F");
   10043          14 :   D = mfunram(N, -1);
   10044          14 :   lD = lg(D);
   10045          14 :   sb = maxss(mfsturmNk(N, k), 4*N);
   10046          14 :   v = mfcoefs_i(F, sb, 1);
   10047          14 :   u_forprime_init(&S, 2, sb);
   10048         518 :   while ((p = u_forprime_next(&S)))
   10049             :   {
   10050         490 :     GEN ap = gel(v, p+1);
   10051         490 :     if (!gequal0(ap))
   10052         406 :       for (i = 1; i < lD; i++)
   10053         245 :         if (kross(D[i], p) == -1) { D = vecsplice(D, i); lD--; }
   10054             :   }
   10055          14 :   if (lD == 1) { avma = av; return gen_0; }
   10056          14 :   if (lD == 2) { avma = av; return stoi(D[1]); }
   10057           7 :   if (k > 1) pari_err_BUG("mfisCM");
   10058           7 :   return gerepileupto(av, zv_to_ZV(D));
   10059             : }
   10060             : 
   10061             : static long
   10062         287 : mfspace_i(GEN mf, GEN F)
   10063             : {
   10064             :   GEN v, vF, gk;
   10065             :   long n, nE, i, l, s, N;
   10066             : 
   10067         287 :   checkMF(mf); s = MF_get_space(mf);
   10068         287 :   if (!F) return s;
   10069         287 :   if (!checkmf_i(F)) pari_err_TYPE("mfspace",F);
   10070         287 :   v = mftobasis(mf, F, 1);
   10071         287 :   n = lg(v)-1; if (!n) return -1;
   10072         231 :   nE = lg(MF_get_E(mf))-1;
   10073         231 :   switch(s)
   10074             :   {
   10075          63 :     case mf_NEW: case mf_OLD: case mf_EISEN: return s;
   10076             :     case mf_FULL:
   10077         140 :       if (mf_get_type(F) == t_MF_THETA) return mf_EISEN;
   10078         133 :       if (!gequal0(vecslice(v,1,nE)))
   10079          63 :         return gequal0(vecslice(v,nE+1,n))? mf_EISEN: mf_FULL;
   10080             :   }
   10081             :   /* mf is mf_CUSP or mf_FULL, F a cusp form */
   10082          98 :   gk = mf_get_gk(F);
   10083          98 :   if (typ(gk) == t_FRAC || equali1(gk)) return mf_CUSP;
   10084          91 :   vF = mftonew_i(mf, vecslice(v, nE+1, n), &N);
   10085          91 :   if (N != MF_get_N(mf)) return mf_OLD;
   10086          63 :   l = lg(vF);
   10087         105 :   for (i = 1; i < l; i++)
   10088          63 :     if (itos(gmael(vF,i,1)) != N) return mf_CUSP;
   10089          42 :   return mf_NEW;
   10090             : }
   10091             : long
   10092         287 : mfspace(GEN mf, GEN F)
   10093             : {
   10094         287 :   pari_sp av = avma;
   10095         287 :   long s = mfspace_i(mf,F);
   10096         287 :   avma = av; return s;
   10097             : }
   10098             : static GEN
   10099           7 : lfunfindchi(GEN ldata, GEN van, long prec)
   10100             : {
   10101           7 :   GEN gN = ldata_get_conductor(ldata), G = znstar0(gN,1), L, go, vz;
   10102           7 :   long k = ldata_get_k(ldata), N = itou(gN), bit = 10 - prec2nbits(prec);
   10103           7 :   long i, j, o, l, odd = k & 1, B0 = 2, B = lg(van)-1;
   10104             : 
   10105           7 :   van = shallowcopy(van);
   10106           7 :   L = cyc2elts(znstar_get_conreycyc(G));
   10107           7 :   l = lg(L);
   10108          21 :   for (i = j = 1; i < l; i++)
   10109             :   {
   10110          14 :     GEN chi = zc_to_ZC(gel(L,i));
   10111          14 :     if (zncharisodd(G,chi) == odd) gel(L,j++) = mfcharGL(G,chi);
   10112             :   }
   10113           7 :   setlg(L,j); l = j;
   10114           7 :   if (l <= 2) return gel(L,1);
   10115           0 :   o = znstar_get_expo(G); go = utoi(o);
   10116           0 :   vz = grootsof1(o, prec);
   10117             :   for (;;)
   10118             :   {
   10119             :     long n;
   10120           0 :     for (n = B0; n <= B; n++)
   10121             :     {
   10122           0 :       GEN an = gel(van,n), r;
   10123             :       long j;
   10124           0 :       if (cgcd(n, N) != 1 || gexpo(an) < bit) continue;
   10125           0 :       r = gdiv(an, gconj(an));
   10126           0 :       for (i = 1; i < l; i++)
   10127             :       {
   10128           0 :         GEN CHI = gel(L,i);
   10129           0 :         if (gexpo(gsub(r, gel(vz, znchareval_i(CHI,n,go)+1))) > bit)
   10130           0 :           gel(L,i) = NULL;
   10131             :       }
   10132           0 :       for (i = j = 1; i < l; i++)
   10133           0 :         if (gel(L,i)) gel(L,j++) = gel(L,i);
   10134           0 :       l = j; setlg(L,l);
   10135           0 :       if (l == 2) return gel(L,1);
   10136             :     }
   10137           0 :     B0 = B+1; B <<= 1;
   10138           0 :     van = ldata_vecan(ldata_get_an(ldata), B, prec);
   10139           0 :   }
   10140             : }
   10141             : 
   10142             : GEN
   10143           7 : mffromlfun(GEN L, long prec)
   10144             : {
   10145           7 :   pari_sp av = avma;
   10146           7 :   GEN ldata = lfunmisc_to_ldata_shallow(L), Vga = ldata_get_gammavec(ldata);
   10147             :   GEN van, a0, CHI, NK;
   10148             :   long k, N, space;
   10149           7 :   if (!gequal(Vga, mkvec2(gen_0, gen_1))) pari_err_TYPE("mffromlfun", L);
   10150           7 :   k = ldata_get_k(ldata);
   10151           7 :   N = itou(ldata_get_conductor(ldata));
   10152           7 :   van = ldata_vecan(ldata_get_an(ldata), mfsturmNk(N,k) + 2, prec);
   10153           7 :   CHI = lfunfindchi(ldata, van, prec);
   10154           7 :   space = (lg(ldata) == 7)? mf_CUSP: mf_FULL;
   10155           7 :   a0 = (space == mf_CUSP)? gen_0: gneg(lfun(L, gen_0, prec2nbits(prec)));
   10156           7 :   NK = mkvec3(utoi(N), utoi(k), mfchisimpl(CHI));
   10157           7 :   return gerepilecopy(av, mkvec3(NK, utoi(space), shallowconcat(a0, van)));
   10158             : }
   10159             : /*******************************************************************/
   10160             : /*                                                                 */
   10161             : /*                       HALF-INTEGRAL WEIGHT                      */
   10162             : /*                                                                 */
   10163             : /*******************************************************************/
   10164             : /* We use the prefix mf2; k represents the weight -1/2, so e.g.
   10165             :    k = 2 is weight 5/2. N is the level, so 4\mid N, and CHI is the
   10166             :    character, always even. */
   10167             : 
   10168             : static long
   10169        3360 : lamCO(long r, long s, long p)
   10170             : {
   10171        3360 :   if ((s << 1) <= r)
   10172             :   {
   10173        1232 :     long rp = r >> 1;
   10174        1232 :     if (odd(r)) return upowuu(p, rp) << 1;
   10175         336 :     else return (p + 1)*upowuu(p, rp - 1);
   10176             :   }
   10177        2128 :   else return upowuu(p, r - s) << 1;
   10178             : }
   10179             : 
   10180             : static int
   10181        1568 : condC(GEN faN, GEN valF)
   10182             : {
   10183        1568 :   GEN P = gel(faN, 1), E = gel(faN, 2);
   10184        1568 :   long l = lg(P), i;
   10185        3696 :   for (i = 1; i < l; i++)
   10186        3024 :     if ((P[i] & 3L) == 3)
   10187             :     {
   10188        1120 :       long r = E[i];
   10189        1120 :       if (odd(r) || r < (valF[i] << 1)) return 1;
   10190             :     }
   10191         672 :   return 0;
   10192             : }
   10193             : 
   10194             : /* returns 2*zetaCO; weight is k + 1/2 */
   10195             : static long
   10196        3696 : zeta2CO(GEN faN, GEN valF, long r2, long s2, long k)
   10197             : {
   10198        3696 :   if (r2 >= 4) return lamCO(r2, s2, 2) << 1;
   10199        2912 :   if (r2 == 3) return 6;
   10200        1568 :   if (condC(faN, valF)) return 4;
   10201         672 :   if (odd(k)) return s2 ? 3 : 5; else return s2 ? 5: 3;
   10202             : }
   10203             : 
   10204             : /* returns 4 times last term in formula */
   10205             : static long
   10206        3696 : dim22(long N, long F, long k)
   10207             : {
   10208        3696 :   pari_sp av = avma;
   10209        3696 :   GEN vF, faN = myfactoru(N), P = gel(faN, 1), E = gel(faN, 2);
   10210        3696 :   long i, D, l = lg(P);
   10211        3696 :   vF = cgetg(l, t_VECSMALL);
   10212        3696 :   for (i = 1; i < l; i++) vF[i] = u_lval(F, P[i]);
   10213        3696 :   D = zeta2CO(faN, vF, E[1], vF[1], k);
   10214        3696 :   for (i = 2; i < l; i++) D *= lamCO(E[i], vF[i], P[i]);
   10215        3696 :   avma = av; return D;
   10216             : }
   10217             : 
   10218             : /* PSI not necessarily primitive, of conductor F */
   10219             : static int
   10220       13846 : charistotallyeven(GEN PSI, long F)
   10221             : {
   10222       13846 :   pari_sp av = avma;
   10223       13846 :   GEN P = gel(myfactoru(F), 1);
   10224       13846 :   GEN G = gel(PSI,1), psi = gel(PSI,2);
   10225             :   long i;
   10226       14350 :   for (i = 1; i < lg(P); i++)
   10227             :   {
   10228         532 :     GEN psip = znchardecompose(G, psi, utoipos(P[i]));
   10229         532 :     if (zncharisodd(G, psip)) { avma = av; return 0; }
   10230             :   }
   10231       13818 :   avma = av; return 1;
   10232             : }
   10233             : 
   10234             : static GEN
   10235      299775 : get_PSI(GEN CHI, long t)
   10236             : {
   10237      299775 :   long r = t & 3L, t2 = (r == 2 || r == 3) ? t << 2 : t;
   10238      299775 :   return mfcharmul_i(CHI, induce(gel(CHI,1), utoipos(t2)));
   10239             : }
   10240             : /* space = mf_CUSP, mf_EISEN or mf_FULL, weight k + 1/2 */
   10241             : static long
   10242       41363 : mf2dimwt12(long N, GEN CHI, long space)
   10243             : {
   10244       41363 :   pari_sp av = avma;
   10245       41363 :   GEN D = mydivisorsu(N >> 2);
   10246       41363 :   long i, l = lg(D), dim3 = 0, dim4 = 0;
   10247             : 
   10248       41363 :   CHI = induceN(N, CHI);
   10249      341138 :   for (i = 1; i < l; i++)
   10250             :   {
   10251      299775 :     long rp, t = D[i], Mt = D[l-i];
   10252      299775 :     GEN PSI = get_PSI(CHI,t);
   10253      299775 :     rp = mfcharconductor(PSI);
   10254      299775 :     if (Mt % (rp*rp) == 0) { dim4++; if (charistotallyeven(PSI,rp)) dim3++; }
   10255             :   }
   10256       41363 :   avma = av;
   10257       41363 :   switch (space)
   10258             :   {
   10259       40439 :     case mf_CUSP: return dim4 - dim3;
   10260         462 :     case mf_EISEN:return dim3;
   10261         462 :     case mf_FULL: return dim4;
   10262             :   }
   10263             :   return 0; /*LCOV_EXCL_LINE*/
   10264             : }
   10265             : 
   10266             : static long
   10267         693 : mf2dimwt32(long N, GEN CHI, long F, long space)
   10268             : {
   10269             :   long D;
   10270         693 :   switch(space)
   10271             :   {
   10272         231 :     case mf_CUSP: D = mypsiu(N) - 6*dim22(N, F, 1);
   10273         231 :       if (D%24) pari_err_BUG("mfdim");
   10274         231 :       return D/24 + mf2dimwt12(N, CHI, 4);
   10275         231 :     case mf_FULL: D = mypsiu(N) + 6*dim22(N, F, 0);
   10276         231 :       if (D%24) pari_err_BUG("mfdim");
   10277         231 :       return D/24 + mf2dimwt12(N, CHI, 1);
   10278         231 :     case mf_EISEN: D = dim22(N, F, 0) + dim22(N, F, 1);
   10279         231 :       if (D & 3L) pari_err_BUG("mfdim");
   10280         231 :       return (D >> 2) - mf2dimwt12(N, CHI, 3);
   10281             :   }
   10282             :   return 0; /*LCOV_EXCL_LINE*/
   10283             : }
   10284             : 
   10285             : /* F = conductor(CHI), weight k = r+1/2 */
   10286             : static long
   10287       43638 : checkmf2(long N, long r, GEN CHI, long F, long space)
   10288             : {
   10289       43638 :   switch(space)
   10290             :   {
   10291       43617 :     case mf_FULL: case mf_CUSP: case mf_EISEN: break;
   10292             :     case mf_NEW: case mf_OLD:
   10293          14 :       pari_err_TYPE("half-integral weight [new/old spaces]", utoi(space));
   10294             :     default:
   10295           7 :       pari_err_TYPE("half-integral weight [incorrect space]",utoi(space));
   10296             :   }
   10297       43617 :   if (N & 3L)
   10298           0 :     pari_err_DOMAIN("half-integral weight", "N % 4", "!=", gen_0, stoi(N));
   10299       43617 :   return r >= 0 && mfcharparity(CHI) == 1 && N % F == 0;
   10300             : }
   10301             : 
   10302             : /* weight k = r + 1/2 */
   10303             : static long
   10304       43463 : mf2dim_Nkchi(long N, long r, GEN CHI, ulong space)
   10305             : {
   10306       43463 :   long D, D2, F = mfcharconductor(CHI);
   10307       43463 :   if (!checkmf2(N, r, CHI, F, space)) return 0;
   10308       43442 :   if (r == 0) return mf2dimwt12(N, CHI, space);
   10309        2772 :   if (r == 1) return mf2dimwt32(N, CHI, F, space);
   10310        2079 :   if (space == mf_EISEN)
   10311             :   {
   10312         693 :     D = dim22(N, F, r) + dim22(N, F, 1-r);
   10313         693 :     if (D & 3L) pari_err_BUG("mfdim");
   10314         693 :     return D >> 2;
   10315             :   }
   10316        1386 :   D2 = space == mf_FULL? dim22(N, F, 1-r): -dim22(N, F, r);
   10317        1386 :   D = (2*r-1)*mypsiu(N) + 6*D2;
   10318        1386 :   if (D%24) pari_err_BUG("mfdim");
   10319        1386 :   return D/24;
   10320             : }
   10321             : 
   10322             : /* weight k=r+1/2 */
   10323             : static GEN
   10324         175 : mf2init_Nkchi(long N, long r, GEN CHI, long space, long flraw)
   10325             : {
   10326         175 :   GEN Minv, Minvmat, B, M, gk = gaddsg(r,ghalf);
   10327         175 :   GEN mf1 = mkvec4(utoi(N),gk,CHI,utoi(space));
   10328             :   long L;
   10329         175 :   if (!checkmf2(N, r, CHI, mfcharconductor(CHI), space)) return mfEMPTY(mf1);
   10330         175 :   if (space==mf_EISEN) pari_err_IMPL("half-integral weight Eisenstein space");
   10331         175 :   L = mfsturmNgk(N, gk) + 1;
   10332         175 :   B = mf2basis(N, r, CHI, space);
   10333         175 :   M = mflineardivtomat(N,B,L);
   10334         175 :   if (flraw) M = mkvec3(gen_0,gen_0,M);
   10335             :   else
   10336             :   {
   10337         175 :     M = mfcleanCHI(M, CHI, 0);
   10338         175 :     Minv = gel(M,2);
   10339         175 :     Minvmat = RgM_Minv_mul(NULL, Minv);
   10340         175 :     B = vecmflineardiv_linear(B, Minvmat);
   10341         175 :     gel(M,3) = RgM_Minv_mul(gel(M,3), Minv);
   10342         175 :     gel(M,2) = mkMinv(matid(lg(B)-1), NULL,NULL,NULL);
   10343             :   }
   10344         175 :   return mkmf(mf1, cgetg(1,t_VEC), B, gen_0, M);
   10345             : }
   10346             : 
   10347             : /**************************************************************************/
   10348             : /*                          Kohnen + space                                */
   10349             : /**************************************************************************/
   10350             : 
   10351             : static GEN
   10352          21 : mfkohnenbasis_i(GEN mf, GEN CHIP, long eps, long sb)
   10353             : {
   10354          21 :   GEN M = shallowtrans(mfcoefs_mf(mf, sb, 1)), ME;
   10355             :   long c, i, n;
   10356          21 :   ME = cgetg(sb + 2, t_MAT);
   10357         784 :   for (i = 0, c = 1; i <= sb; i++)
   10358             :   {
   10359         763 :     long j = i & 3L;
   10360         763 :     if (j == 2 || j == 2 + eps) gel(ME, c++) = gel(M, i+1);
   10361             :   }
   10362          21 :   setlg(ME, c); ME = shallowtrans(Q_primpart(ME));
   10363          21 :   n = mfcharorder_canon(CHIP);
   10364          21 :   return n == 1? ZM_ker(ME): ZabM_ker(liftpol_shallow(ME), mfcharpol(CHIP), n);
   10365             : }
   10366             : GEN
   10367          21 : mfkohnenbasis(GEN mf)
   10368             : {
   10369          21 :   pari_sp av = avma;
   10370             :   GEN gk, CHI, CHIP, K;
   10371             :   long N4, r, eps, sb;
   10372          21 :   checkMF(mf);
   10373          21 :   if (MF_get_space(mf) != mf_CUSP)
   10374           0 :     pari_err_TYPE("mfkohnenbasis [not a cuspidal space", mf);
   10375          21 :   if (!MF_get_dim(mf)) return cgetg(1, t_MAT);
   10376          21 :   N4 = MF_get_N(mf) >> 2; gk = MF_get_gk(mf); CHI = MF_get_CHI(mf);
   10377          21 :   if (typ(gk) == t_INT) pari_err_TYPE("mfkohnenbasis", gk);
   10378          21 :   r = MF_get_r(mf);
   10379          21 :   CHIP = mfcharchiliftprim(CHI, N4);
   10380          21 :   eps = CHIP==CHI? 1: -1;
   10381          21 :   if (!CHIP) pari_err_TYPE("mfkohnenbasis [incorrect CHI]", CHI);
   10382          21 :   if (odd(r)) eps = -eps;
   10383          21 :   if (uissquarefree(N4))
   10384             :   {
   10385          14 :     long d = mfdim_Nkchi(N4, 2*r, mfcharpow(CHI, gen_2), mf_CUSP);
   10386          14 :     sb = mfsturmNgk(N4 << 2, gk) + 1;
   10387          14 :     K = mfkohnenbasis_i(mf, CHIP, eps, sb);
   10388          14 :     if (lg(K) - 1 == d) return gerepilecopy(av, K);
   10389             :   }
   10390           7 :   sb = mfsturmNgk(N4 << 4, gk) + 1;
   10391           7 :   K = mfkohnenbasis_i(mf, CHIP, eps, sb);
   10392           7 :   return gerepilecopy(av, K);
   10393             : }
   10394             : 
   10395             : /* return [mf3, bijection, mfkohnenbasis, codeshi] */
   10396             : static GEN
   10397          14 : mfkohnenbijection_i(GEN mf)
   10398             : {
   10399          14 :   GEN vB, mf3, K, SHI, P, CHI = MF_get_CHI(mf);
   10400          14 :   long n, lK, i, dim, m, lw, sb3, N4 = MF_get_N(mf)>>2, r = MF_get_r(mf);
   10401          14 :   long Dp[] = {1, 5, 8, 12, 13, 17, 21, 24};
   10402          14 :   long Dm[] = {-3, -4, -7, -8, -11, -15, -19, -20}, *D = odd(r)? Dm: Dp;
   10403          14 :   const long nbD = 8, MAXm = 6560; /* #D, 3^#D - 1 */
   10404             : 
   10405          14 :   if (!uissquarefree(N4))
   10406           0 :     pari_err_TYPE("mfkohnenbijection [N/4 not squarefree]", utoi(4*N4));
   10407          14 :   K = mfkohnenbasis(mf); lK = lg(K);
   10408          14 :   mf3 = mfinit_Nkchi(N4, r<<1, mfcharpow(CHI,gen_2), mf_CUSP, 0);
   10409          14 :   if (MF_get_dim(mf3) != lK - 1)
   10410           0 :     pari_err_BUG("mfkohnenbijection [different dimensions]");
   10411          14 :   if (lK == 1) return mkvec4(mf3, cgetg(1, t_MAT), K, cgetg(1, t_VECSMALL));
   10412          14 :   CHI = mfcharchiliftprim(CHI, N4);
   10413          14 :   if (!CHI) pari_err_TYPE("mfkohnenbijection [incorrect CHI]", CHI);
   10414          14 :   n = mfcharorder_canon(CHI);
   10415          14 :   P = n==1? NULL: mfcharpol(CHI);
   10416          14 :   SHI = cgetg(nbD+1, t_VEC);
   10417          14 :   sb3 = mfsturm(mf3);
   10418          14 :   vB = RgM_mul(mfcoefs_mf(mf, labs(D[nbD-1])*sb3*sb3, 1), K);
   10419          14 :   dim = MF_get_dim(mf3);
   10420          35 :   for (m = 1, lw = 0; m <= MAXm; m += (m%3)? 2: 1)
   10421             :   {
   10422             :     pari_sp av;
   10423          35 :     ulong m1, y, v = u_lvalrem(m, 3, &y);
   10424             :     GEN z, M;
   10425             :     long j;
   10426          35 :     if (y == 1)
   10427             :     {
   10428          28 :       long d = D[v];
   10429          28 :       GEN a = cgetg(lK, t_MAT);
   10430          98 :       for (i = 1; i < lK; i++)
   10431             :       {
   10432          70 :         pari_sp av2 = avma;
   10433          70 :         GEN f = c_deflate(sb3*sb3, labs(d), gel(vB,i));
   10434          70 :         f = mftobasis_i(mf3, RgV_shimura(f, sb3, d, N4, r, CHI));
   10435          70 :         gel(a,i) = gerepileupto(av2, f);
   10436             :       }
   10437          28 :       lw++; gel(SHI,v+1) = a;
   10438             :     }
   10439          35 :     av = avma; M = NULL;
   10440          91 :     for (j = 1, m1 = m; j <= lw; j++, m1/=3)
   10441             :     {
   10442          56 :       long s = m1%3;
   10443          56 :       if (s)
   10444             :       {
   10445          42 :         GEN t = gel(SHI,j);
   10446          42 :         if (M) M = (s == 2)? RgM_sub(M, t): RgM_add(M, t);
   10447          35 :         else   M = (s == 2)? RgM_neg(t): t;
   10448             :       }
   10449             :     }
   10450          35 :     z = QabM_indexrank(M,P,n);
   10451          35 :     if (lg(gel(z,2)) > dim)
   10452             :     {
   10453          14 :       GEN d = ZV_to_zv( digits(utoipos(m), utoipos(3)) );
   10454          14 :       GEN mres, dMi, Mi = QabM_pseudoinv(M,P,n, NULL,&dMi);
   10455          14 :       long ld = lg(d), c = 1;
   10456          14 :       if (DEBUGLEVEL>1)
   10457           0 :         err_printf("mfkohnenbijection: used %ld discriminants\n",lw);
   10458          14 :       mres = cgetg(ld, t_VEC);
   10459          42 :       for (j = ld-1; j >= 1; j--)
   10460          28 :         if (d[j]) gel(mres,c++) = mkvec2s(D[ld-j-1], d[j]);
   10461          14 :       setlg(mres,c); return mkvec4(mf3, RgM_Rg_div(Mi,dMi), K, mres);
   10462             :     }
   10463          21 :     avma = av;
   10464             :   }
   10465           0 :   pari_err_BUG("mfkohnenbijection failed");
   10466             :   return NULL; /*LCOV_EXCL_LINE*/
   10467             : }
   10468             : GEN
   10469          14 : mfkohnenbijection(GEN mf)
   10470             : {
   10471          14 :   pari_sp av = avma;
   10472          14 :   checkMF(mf);
   10473          14 :   if (MF_get_space(mf) != mf_CUSP || MF_get_r(mf) == 0 || !mfshimura_space_cusp(mf))
   10474           0 :     pari_err_TYPE("mfkohnenbijection [incorrect mf for Kohnen]", mf);
   10475          14 :   return gerepilecopy(av, mfkohnenbijection_i(mf));
   10476             : }
   10477             : 
   10478             : static int
   10479           7 : checkbij_i(GEN b)
   10480             : {
   10481          21 :   return typ(b) == t_VEC && lg(b) == 5 && checkMF_i(gel(b,1))
   10482           7 :          && typ(gel(b,2)) == t_MAT
   10483           7 :          && typ(gel(b,3)) == t_MAT
   10484          14 :          && typ(gel(b,4)) == t_VEC;
   10485             : }
   10486             : 
   10487             : /* bij is the output of mfkohnenbijection */
   10488             : GEN
   10489           7 : mfkohneneigenbasis(GEN mf, GEN bij)
   10490             : {
   10491           7 :   pari_sp av = avma;
   10492             :   GEN mf3, mf30, B0, BE, K, KM, BNEW, BEIGEN, k;
   10493             :   long r, i, l0, lE, N4;
   10494           7 :   checkMF(mf);
   10495           7 :   if (!checkbij_i(bij))
   10496           0 :     pari_err_TYPE("mfkohneneigenbasis [bijection]", bij);
   10497           7 :   if (MF_get_space(mf) != mf_CUSP)
   10498           0 :     pari_err_TYPE("mfkohneneigenbasis [not a cuspidal space]", mf);
   10499           7 :   if (!MF_get_dim(mf))
   10500           0 :     return gcopy(mkvec2(cgetg(1, t_VEC), cgetg(1, t_VEC)));
   10501           7 :   N4 = MF_get_N(mf) >> 2; k = MF_get_gk(mf);
   10502           7 :   if (typ(k) == t_INT) pari_err_TYPE("mfkohneneigenbasis", k);
   10503           7 :   if (!uissquarefree(N4))
   10504           0 :     pari_err_TYPE("mfkohneneigenbasis [N not squarefree]", utoipos(N4));
   10505           7 :   r = MF_get_r(mf);
   10506           7 :   K = gel(bij, 3);
   10507           7 :   KM = RgM_mul(K, gel(bij, 2));
   10508           7 :   mf3 = gel(bij, 1);
   10509           7 :   mf30 = mfinit_Nkchi(N4, 2*r, MF_get_CHI(mf3), mf_NEW, 0);
   10510           7 :   B0 = MF_get_S(mf30); l0 = lg(B0);
   10511           7 :   BNEW = cgetg(l0, t_MAT);
   10512          21 :   for (i = 1; i < l0; i++)
   10513          14 :     gel(BNEW, i) = RgM_RgC_mul(KM, mftobasis_i(mf3, gel(B0,i)));
   10514           7 :   BE = mfeigenbasis(mf30); lE = lg(BE);
   10515           7 :   BEIGEN = cgetg(lE, t_MAT);
   10516          21 :   for (i = 1; i < lE; i++)
   10517          14 :     gel(BEIGEN, i) = RgM_RgC_mul(KM, mftobasis_i(mf3, gel(BE,i)));
   10518           7 :   return gerepilecopy(av, mkvec3(mf30, BNEW, BEIGEN));
   10519             : }
   10520             : /*************************** End Kohnen ************************************/
   10521             : /***************************************************************************/
   10522             : 
   10523             : static GEN desc(GEN F);
   10524             : static GEN
   10525         504 : desc_mfeisen(GEN F)
   10526             : {
   10527         504 :   GEN R, gk = mf_get_gk(F);
   10528         504 :   if (typ(gk) == t_FRAC)
   10529           7 :     R = gsprintf("H_{%Ps}", gk);
   10530             :   else
   10531             :   {
   10532         497 :     GEN vchi = gel(F, 2), CHI = mfchisimpl(gel(vchi, 3));
   10533         497 :     long k = itou(gk);
   10534         497 :     if (lg(vchi) < 5) R = gsprintf("F_%ld(%Ps)", k, CHI);
   10535             :     else
   10536             :     {
   10537         294 :       GEN CHI2 = mfchisimpl(gel(vchi, 4));
   10538         294 :       R = gsprintf("F_%ld(%Ps, %Ps)", k, CHI, CHI2);
   10539             :     }
   10540             :   }
   10541         504 :   return R;
   10542             : }
   10543             : static GEN
   10544          35 : desc_hecke(GEN F)
   10545             : {
   10546             :   long n, N;
   10547          35 :   GEN D = gel(F,2);
   10548          35 :   if (typ(D) == t_VECSMALL) { N = D[3]; n = D[1]; }
   10549          14 :   else { GEN nN = gel(D,2); n = nN[1]; N = nN[2]; } /* half integer */
   10550          35 :   return gsprintf("T_%ld(%ld)(%Ps)", N, n, desc(gel(F,3)));
   10551             : }
   10552             : static GEN
   10553          98 : desc_linear(GEN FLD, GEN dL)
   10554             : {
   10555          98 :   GEN F = gel(FLD,2), L = gel(FLD,3), R = strtoGENstr("LIN([");
   10556          98 :   long n = lg(F) - 1, i;
   10557         168 :   for (i = 1; i <= n; i++)
   10558             :   {
   10559         168 :     R = shallowconcat(R, desc(gel(F,i))); if (i == n) break;
   10560          70 :     R = shallowconcat(R, strtoGENstr(", "));
   10561             :   }
   10562          98 :   return shallowconcat(R, gsprintf("], %Ps)", gdiv(L, dL)));
   10563             : }
   10564             : static GEN
   10565          21 : desc_dihedral(GEN F)
   10566             : {
   10567          21 :   GEN bnr = gel(F,2), D = nf_get_disc(bnr_get_nf(bnr)), f = bnr_get_mod(bnr);
   10568          21 :   GEN cyc = bnr_get_cyc(bnr);
   10569          21 :   GEN w = gel(F,3), chin = zv_to_ZV(gel(w,2)), o = utoi(gel(w,1)[1]);
   10570          21 :   GEN chi = char_denormalize(cyc, o, chin);
   10571          21 :   if (lg(gel(f,2)) == 1) f = gel(f,1);
   10572          21 :   return gsprintf("DIH(%Ps, %Ps, %Ps, %Ps)",D,f,cyc,chi);
   10573             : }
   10574             : 
   10575             : static void
   10576        1043 : unpack0(GEN *U)
   10577        1043 : { if (U) *U = mkvec2(cgetg(1, t_VEC), cgetg(1, t_VEC)); }
   10578             : static void
   10579          42 : unpack2(GEN F, GEN *U)
   10580          42 : { if (U) *U = mkvec2(mkvec2(gel(F,2), gel(F,3)), cgetg(1, t_VEC)); }
   10581             : static void
   10582         308 : unpack23(GEN F, GEN *U)
   10583         308 : { if (U) *U = mkvec2(mkvec(gel(F,2)), mkvec(gel(F,3))); }
   10584             : static GEN
   10585        1540 : desc_i(GEN F, GEN *U)
   10586             : {
   10587        1540 :   switch(mf_get_type(F))
   10588             :   {
   10589           7 :     case t_MF_CONST: unpack0(U); return gsprintf("CONST(%Ps)", gel(F,2));
   10590         504 :     case t_MF_EISEN: unpack0(U); return desc_mfeisen(F);
   10591         154 :     case t_MF_Ek: unpack0(U); return gsprintf("E_%ld", mf_get_k(F));
   10592          63 :     case t_MF_DELTA: unpack0(U); return gsprintf("DELTA");
   10593          35 :     case t_MF_THETA: unpack0(U);
   10594          35 :       return gsprintf("THETA(%Ps)", mfchisimpl(gel(F,2)));
   10595          56 :     case t_MF_ETAQUO: unpack0(U);
   10596          56 :       return gsprintf("ETAQUO(%Ps, %Ps)", gel(F,2), gel(F,3));
   10597          56 :     case t_MF_ELL: unpack0(U);
   10598          56 :       return gsprintf("ELL(%Ps)", vecslice(gel(F,2), 1, 5));
   10599           7 :     case t_MF_TRACE: unpack0(U); return gsprintf("TR(%Ps)", mfparams(F));
   10600         140 :     case t_MF_NEWTRACE: unpack0(U); return gsprintf("TR^new(%Ps)", mfparams(F));
   10601          21 :     case t_MF_DIHEDRAL: unpack0(U); return desc_dihedral(F);
   10602          28 :     case t_MF_MUL: unpack2(F, U);
   10603