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 21348-d75f58f) Lines: 6271 6434 97.5 %
Date: 2017-11-20 06:21:05 Functions: 645 647 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 D);
      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);
      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 F, GEN DATA);
      51             : static GEN c_Ek(long n, long d, GEN F);
      52             : static GEN c_mfheckef2(long n, long d, 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 mfheckematwt1(GEN mf, long n, GEN B);
      60             : static GEN mflineardivtomat(GEN vF, long n);
      61             : static GEN mfheckemat_i(GEN mf, long n);
      62             : static GEN mfdihedralcusp(long N, GEN CHI);
      63             : static long mfdihedralcuspdim(long N, GEN CHI);
      64             : static GEN mfdihedralnew(long N, GEN CHI);
      65             : static GEN mfdihedralall(GEN LIM);
      66             : static long mfwt1cuspdim(long N, GEN CHI);
      67             : static long mf2dim_Nkchi(long N, long k, GEN CHI, ulong space);
      68             : static long mfdim_Nkchi(long N, long k, GEN CHI, long space);
      69             : static GEN charLFwtk(long k, GEN CHI, long ord);
      70             : static GEN mfeisensteingacx(GEN E,long w,GEN ga,long n,long prec);
      71             : static GEN mfgaexpansion(GEN mf, GEN F, GEN gamma, long n, long prec);
      72             : static GEN mfEHmat(long n, long r);
      73             : static GEN mfEHcoef(long r, long N);
      74             : static GEN mftobasis_i(GEN mf, GEN F);
      75             : static GEN mfcharcxeval(GEN CHI, long n, long prec);
      76             : 
      77             : static GEN
      78       34538 : mkgNK(GEN N, GEN k, GEN CHI, GEN P) { return mkvec4(N, k, CHI, P); }
      79             : static GEN
      80       10395 : mkNK(long N, long k, GEN CHI) { return mkgNK(stoi(N), stoi(k), CHI, pol_x(1)); }
      81             : GEN
      82        5145 : MF_get_CHI(GEN mf) { return gmael(mf,1,3); }
      83             : GEN
      84       14588 : MF_get_gN(GEN mf) { return gmael(mf,1,1); }
      85             : long
      86       14469 : MF_get_N(GEN mf) { return itou(MF_get_gN(mf)); }
      87             : GEN
      88        8148 : MF_get_gk(GEN mf) { return gmael(mf,1,2); }
      89             : long
      90        4683 : MF_get_k(GEN mf)
      91             : {
      92        4683 :   GEN gk = MF_get_gk(mf);
      93        4683 :   if (typ(gk)!=t_INT) pari_err_IMPL("half-integral weight");
      94        4683 :   return itou(gk);
      95             : }
      96             : long
      97        7637 : MF_get_space(GEN mf) { return itos(gmael(mf,1,4)); }
      98             : GEN
      99        2485 : MF_get_E(GEN mf) { return gel(mf,2); }
     100             : GEN
     101       13867 : MF_get_S(GEN mf) { return gel(mf,3); }
     102             : GEN
     103        1645 : MF_get_basis(GEN mf) { return shallowconcat(gel(mf,2), gel(mf,3)); }
     104             : long
     105        2177 : MF_get_dim(GEN mf)
     106             : {
     107        2177 :   switch(MF_get_space(mf))
     108             :   {
     109             :     case mf_FULL:
     110         315 :       return lg(MF_get_S(mf)) - 1 + lg(MF_get_E(mf))-1;
     111             :     case mf_EISEN:
     112         105 :       return lg(MF_get_E(mf))-1;
     113             :     default: /* mf_NEW, mf_CUSP, mf_OLD */
     114        1757 :       return lg(MF_get_S(mf)) - 1;
     115             :   }
     116             : }
     117             : GEN
     118        5824 : MFnew_get_vj(GEN mf) { return gel(mf,4); }
     119             : GEN
     120         112 : MFcusp_get_vMjd(GEN mf) { return gel(mf,4); }
     121             : GEN
     122        3577 : MF_get_M(GEN mf) { return gmael(mf,5,3); }
     123             : GEN
     124        1960 : MF_get_Minv(GEN mf) { return gmael(mf,5,2); }
     125             : GEN
     126        7714 : MF_get_Mindex(GEN mf) { return gmael(mf,5,1); }
     127             : 
     128             : /* ordinary gtocol forgets about initial 0s */
     129             : GEN
     130        1666 : sertocol(GEN S) { return gtocol0(S, -(lg(S) - 2 + valp(S))); }
     131             : /*******************************************************************/
     132             : /*     Linear algebra in cyclotomic fields (TODO: export this)     */
     133             : /*******************************************************************/
     134             : /* return r and split prime p giving projection Q(zeta_n) -> Fp, zeta -> r */
     135             : static ulong
     136         308 : QabM_init(long n, ulong *p)
     137             : {
     138         308 :   ulong pinit = 1000000007;
     139             :   forprime_t T;
     140         308 :   if (n <= 1) { *p = pinit; return 0; }
     141         217 :   u_forprime_arith_init(&T, pinit, ULONG_MAX, 1, n);
     142         217 :   *p = u_forprime_next(&T);
     143         217 :   return Flx_oneroot(ZX_to_Flx(polcyclo(n, 0), *p), *p);
     144             : }
     145             : static ulong
     146      405706 : Qab_to_Fl(GEN P, ulong r, ulong p)
     147             : {
     148             :   ulong t;
     149             :   GEN den;
     150      405706 :   P = Q_remove_denom(liftpol_shallow(P), &den);
     151      405706 :   if (typ(P) == t_POL) { GEN Pp = ZX_to_Flx(P, p); t = Flx_eval(Pp, r, p); }
     152      392875 :   else t = umodiu(P, p);
     153      405706 :   if (den) t = Fl_div(t, umodiu(den, p), p);
     154      405706 :   return t;
     155             : }
     156             : static GEN
     157        8267 : QabC_to_Flc(GEN C, ulong r, ulong p)
     158             : {
     159        8267 :   long i, l = lg(C);
     160        8267 :   GEN A = cgetg(l, t_VECSMALL);
     161        8267 :   for (i = 1; i < l; i++) uel(A,i) = Qab_to_Fl(gel(C,i), r, p);
     162        8267 :   return A;
     163             : }
     164             : static GEN
     165         203 : QabM_to_Flm(GEN M, ulong r, ulong p)
     166             : {
     167             :   long i, l;
     168         203 :   GEN A = cgetg_copy(M, &l);
     169        8470 :   for (i = 1; i < l; i++)
     170        8267 :     gel(A, i) = QabC_to_Flc(gel(M, i), r, p);
     171         203 :   return A;
     172             : }
     173             : /* A a t_POL */
     174             : static GEN
     175         287 : QabX_to_Flx(GEN A, ulong r, ulong p)
     176             : {
     177         287 :   long i, l = lg(A);
     178         287 :   GEN a = cgetg(l, t_VECSMALL);
     179         287 :   a[1] = ((ulong)A[1])&VARNBITS;
     180         287 :   for (i = 2; i < l; i++) uel(a,i) = Qab_to_Fl(gel(A,i), r, p);
     181         287 :   return Flx_renormalize(a, l);
     182             : }
     183             : 
     184             : /* FIXME: remove */
     185             : static GEN
     186        2044 : ZM_pseudoinv_i(GEN M, GEN *pv, GEN *den)
     187             : {
     188        2044 :   GEN v = ZM_indexrank(M);
     189        2044 :   if (pv) *pv = v;
     190        2044 :   M = shallowmatextract(M,gel(v,1),gel(v,2));
     191        2044 :   return ZM_inv(M, den);
     192             : }
     193             : 
     194             : /* M matrix with coeff in Q(\chi)), where Q(\chi) = Q(X)/(P) for
     195             :  * P = cyclotomic Phi_n. Assume M rational if n <= 2 */
     196             : static GEN
     197        1078 : QabM_ker(GEN M, GEN P, long n)
     198             : {
     199             :   GEN B;
     200        1078 :   if (n <= 2)
     201         693 :     B = ZM_ker(Q_primpart(M));
     202             :   else
     203         385 :     B = ZabM_ker(Q_primpart(liftpol_shallow(M)), P, n);
     204        1078 :   return vec_Q_primpart(B);
     205             : }
     206             : /* pseudo-inverse of M */
     207             : static GEN
     208         840 : QabM_pseudoinv(GEN M, GEN P, long n, GEN *pv, GEN *pden)
     209             : {
     210             :   GEN cM, Mi;
     211         840 :   if (n <= 2)
     212             :   {
     213         679 :     M = Q_primitive_part(M, &cM);
     214         679 :     Mi = ZM_pseudoinv_i(M, pv, pden); /* M^(-1) = Mi / (cM * den) */
     215             :   }
     216             :   else
     217             :   {
     218         161 :     M = Q_primitive_part(liftpol_shallow(M), &cM);
     219         161 :     Mi = ZabM_pseudoinv(M, P, n, pv, pden);
     220         161 :     Mi = gmodulo(Mi, P);
     221             :   }
     222         840 :   *pden = mul_content(*pden, cM);
     223         840 :   return Mi;
     224             : }
     225             : 
     226             : static GEN
     227       10682 : QabM_indexrank(GEN M, GEN P, long n)
     228             : {
     229             :   GEN z;
     230       10682 :   if (n <= 2)
     231             :   {
     232        9667 :     M = vec_Q_primpart(M);
     233        9667 :     z = ZM_indexrank(M); /* M^(-1) = Mi / (cM * den) */
     234             :   }
     235             :   else
     236             :   {
     237        1015 :     M = vec_Q_primpart(liftpol_shallow(M));
     238        1015 :     z = ZabM_indexrank(M, P, n);
     239             :   }
     240       10682 :   return z;
     241             : }
     242             : 
     243             : /*******************************************************************/
     244             : /*   Relative trace between cyclotomic fields (TODO: export this)  */
     245             : /*******************************************************************/
     246             : /* g>=1; return g * prod_{p | g, (p,q) = 1} (1-1/p) */
     247             : static long
     248       42567 : phipart(long g, long q)
     249             : {
     250       42567 :   if (g > 1)
     251             :   {
     252       16590 :     GEN P = gel(myfactoru(g), 1);
     253       16590 :     long i, l = lg(P);
     254       16590 :     for (i = 1; i < l; i++) { long p = P[i]; if (q % p) g -= g / p; }
     255             :   }
     256       42567 :   return g;
     257             : }
     258             : 
     259             : /* Trace(zeta_n^k) from Q(\zeta_n) to Q; k > 0 */
     260             : static GEN
     261       33446 : tracerelzQ(long n, long k)
     262             : {
     263       33446 :   long s, g = cgcd(k, n), q = n/g, muq = moebiusu(q);
     264       33446 :   if (!muq) return gen_0;
     265       17843 :   s = phipart(g, q); if (muq < 0) s = -s;
     266       17843 :   return stoi(s);
     267             : }
     268             : /* Trace(zeta_n^k) from Q(\zeta_n) to Q(\zeta_m) with m|n; k > 0 */
     269             : static GEN
     270       77266 : tracerelz(long n, long m, long k, long vt)
     271             : {
     272             :   long s, d, g, q, muq, v;
     273       77266 :   if (m == 1) return tracerelzQ(n, k);
     274       43820 :   d = n / m;
     275       43820 :   g = cgcd(k, d);
     276       43820 :   q = d / g; if (cgcd(q, m) > 1) return gen_0;
     277       34412 :   muq = moebiusu(q); if (!muq) return gen_0;
     278       24724 :   k /= g;
     279             :   /* (m,q) = 1 */
     280       24724 :   s = phipart(g, m*q); if (muq < 0) s = -s;
     281       24724 :   v = Fl_inv(q % m, m);
     282       24724 :   v = (v*k) % m;
     283       24724 :   return mygmodulo_lift(v, m, stoi(s), vt);
     284             : }
     285             : /* x a t_POL modulo Phi_n; n, m not 2 mod 4, degrel != 1*/
     286             : static GEN
     287       38556 : tracerel_i(GEN T, GEN x)
     288             : {
     289       38556 :   long k, l = lg(x);
     290       38556 :   GEN S = gen_0;
     291       38556 :   for (k = 2; k < l; k++) S = gadd(S, gmul(gel(T,k-1), gel(x,k)));
     292       38556 :   return S;
     293             : }
     294             : /* m | n, both not 2 mod 4. Pn = polcyclo(n) */
     295             : GEN
     296       17745 : Qab_trace_init(GEN Pn, long n, long m)
     297             : {
     298             :   GEN T, Pm;
     299             :   long i, d, vt;
     300       17745 :   if (m == n) return mkvec(Pn);
     301       12544 :   d = degpol(Pn);
     302       12544 :   vt = varn(Pn);
     303       12544 :   Pm = polcyclo(m, vt);
     304       12544 :   T = cgetg(d+1, t_VEC);
     305       12544 :   gel(T,1) = utoipos(d / degpol(Pm)); /* Tr 1 */
     306       12544 :   for (i = 1; i < d; i++) gel(T,i+1) = tracerelz(n, m, i, vt);
     307       12544 :   return mkvec3(Pm, Pn, T);
     308             : }
     309             : /* v = Qab_trace_init(n,m); x is a t_VEC of polmodulo Phi_n
     310             :  * Tr_{Q(zeta_n)/Q(zeta_m)} (zeta_n^t * x) */
     311             : GEN
     312        3486 : QabV_tracerel(GEN v, long t, GEN x)
     313             : {
     314             :   long d, dm, lx, j, degrel;
     315             :   GEN y, z, Pm, Pn, T;
     316        3486 :   if (lg(v) != 4) return x;
     317        3486 :   y = cgetg_copy(x, &lx);
     318        3486 :   Pm = gel(v,1);
     319        3486 :   Pn = gel(v,2);
     320        3486 :   T  = gel(v,3);
     321        3486 :   d = degpol(Pn);
     322        3486 :   dm = degpol(Pm); degrel = d / dm;
     323        3486 :   z = RgX_rem(pol_xn(t, varn(Pn)), Pn);
     324       81067 :   for (j = 1; j < lx; j++)
     325             :   {
     326       77581 :     GEN a = liftpol_shallow(gel(x,j));
     327       77581 :     a = simplify_shallow( gmul(a, z) );
     328       77581 :     if (typ(a) == t_POL)
     329             :     {
     330       38556 :       a = gdivgs(tracerel_i(T, RgX_rem(a, Pn)), degrel);
     331       38556 :       if (typ(a) == t_POL) a = RgX_rem(a, Pm);
     332             :     }
     333       77581 :     gel(y,j) = a;
     334             :   }
     335        3486 :   return y;
     336             : }
     337             : 
     338             : /*********************************************************************/
     339             : /*                    Simple arithmetic functions                    */
     340             : /*********************************************************************/
     341             : /* TODO: most of these should be exported and used in ifactor1.c */
     342             : /* phi(n) */
     343             : static ulong
     344       94955 : myeulerphiu(ulong n)
     345             : {
     346             :   pari_sp av;
     347             :   GEN fa;
     348       94955 :   if (n == 1) return 1;
     349       84245 :   av = avma; fa = myfactoru(n);
     350       84245 :   avma = av; return eulerphiu_fact(fa);
     351             : }
     352             : 
     353             : static long
     354         392 : mynumdivu(long N)
     355             : {
     356             :   pari_sp av;
     357             :   GEN fa;
     358         392 :   if (N == 1) return 1;
     359         392 :   av = avma; fa = myfactoru(N);
     360         392 :   avma = av; return numdivu_fact(fa);
     361             : }
     362             : 
     363             : /* N\prod_{p|N} (1+1/p) */
     364             : static long
     365      259441 : mypsiu(ulong N)
     366             : {
     367      259441 :   pari_sp av = avma;
     368      259441 :   GEN P = gel(myfactoru(N), 1);
     369      259441 :   long j, l = lg(P), res = N;
     370      259441 :   for (j = 1; j < l; j++) res += res/P[j];
     371      259441 :   avma = av; return res;
     372             : }
     373             : /* write n = mf^2. Return m, set f. */
     374             : static ulong
     375         175 : mycore(ulong n, long *pf)
     376             : {
     377         175 :   pari_sp av = avma;
     378         175 :   GEN fa = myfactoru(n), P = gel(fa,1), E = gel(fa,2);
     379         175 :   long i, l = lg(P), m = 1, f = 1;
     380         731 :   for (i = 1; i < l; i++)
     381             :   {
     382         556 :     long j, p = P[i], e = E[i];
     383         556 :     if (e & 1) m *= p;
     384         556 :     for (j = 2; j <= e; j+=2) f *= p;
     385             :   }
     386         175 :   avma = av; *pf = f; return m;
     387             : }
     388             : 
     389             : /* fa = factorization of -D > 0, return -D0 > 0 (where D0 is fundamental) */
     390             : static long
     391    16234273 : corediscs_fact(GEN fa)
     392             : {
     393    16234273 :   GEN P = gel(fa,1), E = gel(fa,2);
     394    16234273 :   long i, l = lg(P), m = 1;
     395    61252270 :   for (i = 1; i < l; i++)
     396             :   {
     397    45017997 :     long p = P[i], e = E[i];
     398    45017997 :     if (e & 1) m *= p;
     399             :   }
     400    16234273 :   if ((m&3L) != 3) m <<= 2;
     401    16234273 :   return m;
     402             : }
     403             : static long
     404        5789 : mubeta(long n)
     405             : {
     406        5789 :   pari_sp av = avma;
     407        5789 :   GEN E = gel(myfactoru(n), 2);
     408        5789 :   long i, s = 1, l = lg(E);
     409       12047 :   for (i = 1; i < l; i++)
     410             :   {
     411        6258 :     long e = E[i];
     412        6258 :     if (e >= 3) { avma = av; return 0; }
     413        6258 :     if (e == 1) s *= -2;
     414             :   }
     415        5789 :   avma = av; return s;
     416             : }
     417             : 
     418             : /* n = n1*n2, n1 = ppo(n, m); return mubeta(n1)*moebiusu(n2).
     419             :  * N.B. If n from newt_params we, in fact, never return 0 */
     420             : static long
     421     3701271 : mubeta2(long n, long m)
     422             : {
     423     3701271 :   pari_sp av = avma;
     424     3701271 :   GEN fa = myfactoru(n), P = gel(fa,1), E = gel(fa,2);
     425     3701271 :   long i, s = 1, l = lg(P);
     426     7349867 :   for (i = 1; i < l; i++)
     427             :   {
     428     3648596 :     long p = P[i], e = E[i];
     429     3648596 :     if (m % p)
     430             :     { /* p^e in n1 */
     431     2955904 :       if (e >= 3) { avma = av; return 0; }
     432     2955904 :       if (e == 1) s *= -2;
     433             :     }
     434             :     else
     435             :     { /* in n2 */
     436      692692 :       if (e >= 2) { avma = av; return 0; }
     437      692692 :       s = -s;
     438             :     }
     439             :   }
     440     3701271 :   avma = av; return s;
     441             : }
     442             : 
     443             : /* write N = prod p^{ep} and n = df^2, d squarefree.
     444             :  * set g  = ppo(gcd(sqfpart(N), f), FC)
     445             :  *     N2 = prod p^if(e==1 || p|n, ep-1, ep-2) */
     446             : static void
     447      949382 : newt_params(long N, long n, long FC, long *pg, long *pN2)
     448             : {
     449      949382 :   GEN fa = myfactoru(N), P = gel(fa,1), E = gel(fa,2);
     450      949382 :   long i, g = 1, N2 = 1, l = lg(P);
     451     2389345 :   for (i = 1; i < l; i++)
     452             :   {
     453     1439963 :     long p = P[i], e = E[i];
     454     1439963 :     if (e == 1)
     455     1234268 :     { if (FC % p && n % (p*p) == 0) g *= p; }
     456             :     else
     457      205695 :       N2 *= upowuu(p,(n % p)? e-2: e-1);
     458             :   }
     459      949382 :   *pg = g; *pN2 = N2;
     460      949382 : }
     461             : /* simplified version of newt_params for n = 1 (newdim) */
     462             : static void
     463       32452 : newd_params(long N, long *pN2)
     464             : {
     465       32452 :   GEN fa = myfactoru(N), P = gel(fa,1), E = gel(fa,2);
     466       32452 :   long i, N2 = 1, l = lg(P);
     467       82313 :   for (i = 1; i < l; i++)
     468             :   {
     469       49861 :     long p = P[i], e = E[i];
     470       49861 :     if (e > 2) N2 *= upowuu(p, e-2);
     471             :   }
     472       32452 :   *pN2 = N2;
     473       32452 : }
     474             : 
     475             : static long
     476          14 : newd_params2(long N)
     477             : {
     478          14 :   GEN fa = myfactoru(N), P = gel(fa,1), E = gel(fa,2);
     479          14 :   long i, N2 = 1, l = lg(P);
     480          35 :   for (i = 1; i < l; i++)
     481             :   {
     482          21 :     long p = P[i], e = E[i];
     483          21 :     if (e >= 2) N2 *= upowuu(p, e);
     484             :   }
     485          14 :   return N2;
     486             : }
     487             : 
     488             : /*              Operations on Dirichlet characters                       */
     489             : 
     490             : /* A Dirichlet character can be given in GP in different formats, but in this
     491             :  * package, it will be a vector CHI=[G,chi,ord], where G is the (Z/MZ)^* to
     492             :  * which the character belongs, chi is the character in Conrey format, ord is
     493             :  * the order */
     494             : 
     495             : static GEN
     496      532728 : gmfcharorder(GEN CHI) { return gel(CHI, 3); }
     497             : static long
     498      518406 : mfcharorder(GEN CHI) { return itou(gmfcharorder(CHI)); }
     499             : static long
     500        4102 : mfcharistrivial(GEN CHI) { return !CHI || mfcharorder(CHI) == 1; }
     501             : static GEN
     502      427847 : gmfcharmodulus(GEN CHI) { return gmael3(CHI, 1, 1, 1); }
     503             : static long
     504      427847 : mfcharmodulus(GEN CHI) { return itou(gmfcharmodulus(CHI)); }
     505             : static GEN
     506       93044 : mfcharpol(GEN CHI) { return gel(CHI,4); }
     507             : static long
     508      444367 : ord_canon(long ord)
     509             : {
     510      444367 :   if ((ord & 3L) == 2) ord >>= 1;
     511      444367 :   return ord;
     512             : }
     513             : static long
     514       24479 : mfcharorder_canon(GEN CHI) { return ord_canon(mfcharorder(CHI)); }
     515             : 
     516             : /* t^k mod polcyclo(ord), ord = order(CHI) > 1 */
     517             : static GEN
     518         777 : mygmodulo(GEN CHI, long k)
     519             : {
     520             :   GEN C, Pn;
     521             :   long ord;
     522         777 :   if (!k) return gen_1;
     523         637 :   ord = mfcharorder(CHI);
     524         637 :   if ((k << 1) == ord) return gen_m1;
     525         504 :   Pn = mfcharpol(CHI);
     526         504 :   if ((ord&3L) != 2)
     527         154 :     C = gen_1;
     528             :   else
     529             :   {
     530         350 :     ord >>= 1;
     531         350 :     if (odd(k)) { C = gen_m1; k += ord; } else C = gen_1;
     532         350 :     k >>= 1;
     533             :   }
     534         504 :   return gmodulo(monomial(C, k, varn(Pn)), Pn);
     535             : }
     536             : /* C*zeta_ord^k */
     537             : static GEN
     538      403088 : mygmodulo_lift(long k, long ord, GEN C, long vt)
     539             : {
     540      403088 :   if (!k) return C;
     541      247695 :   if ((k << 1) == ord) return gneg(C);
     542      190456 :   if ((ord&3L) == 2)
     543             :   {
     544       84448 :     if (odd(k)) { C = gneg(C); k += ord >> 1; }
     545       84448 :     k >>= 1;
     546             :   }
     547      190456 :   return monomial(C, k, vt);
     548             : }
     549             : /* vz[i+1] = image of (zeta_ord)^i in Fp */
     550             : static ulong
     551      113659 : mygmodulo_Fl(long k, GEN vz, ulong C, ulong p)
     552             : {
     553             :   long ord;
     554      113659 :   if (!k) return C;
     555       80437 :   ord = lg(vz)-2;
     556       80437 :   if ((k << 1) == ord) return Fl_neg(C,p);
     557       70644 :   if ((ord&3L) == 2)
     558             :   {
     559       68824 :     if (odd(k)) { C = Fl_neg(C,p); k += ord >> 1; }
     560       68824 :     k >>= 1;
     561             :   }
     562       70644 :   return Fl_mul(C, vz[k+1], p);
     563             : }
     564             : 
     565             : static long
     566      235200 : znchareval_i(GEN CHI, long n, GEN ord)
     567      235200 : { return itos(znchareval(gel(CHI,1), gel(CHI,2), stoi(n), ord)); }
     568             : 
     569             : /* G a znstar, L a Conrey log: return a 'mfchar' */
     570             : static GEN
     571      368711 : mfcharGL(GEN G, GEN L)
     572             : {
     573      368711 :   GEN o = zncharorder(G,L);
     574      368711 :   long ord = ord_canon(itou(o)), vt = fetch_user_var("t");
     575      368711 :   return mkvec4(G, L, o, polcyclo(ord,vt));
     576             : }
     577             : static GEN
     578        3290 : mfchartrivial()
     579        3290 : { return mfcharGL(znstar0(gen_1,1), cgetg(1,t_COL)); }
     580             : /* convert a generic character into an 'mfchar' */
     581             : static GEN
     582        3521 : get_mfchar(GEN CHI)
     583             : {
     584             :   GEN G, L;
     585        3521 :   if (typ(CHI) != t_VEC)
     586        2716 :     CHI = znchar(CHI);
     587        3514 :   if (lg(CHI) == 5 && checkznstar_i(gel(CHI, 1))) return CHI;
     588        3507 :   else if (lg(CHI) != 3 || !checkznstar_i(gel(CHI,1)))
     589           7 :     pari_err_TYPE("checkNF [chi]", CHI);
     590        3500 :   G = gel(CHI,1);
     591        3500 :   L = gel(CHI,2); if (typ(L) != t_COL) L = znconreylog(G,L);
     592        3500 :   return mfcharGL(G, L);
     593             : }
     594             : 
     595             : /* parse [N], [N,k], [N,k,CHI]. If 'joker' is set, allow wildcard for CHI */
     596             : static GEN
     597        8715 : checkCHI(GEN NK, long N, int joker)
     598             : {
     599             :   GEN CHI;
     600        8715 :   if (lg(NK) == 3)
     601         483 :     CHI = mfchartrivial();
     602             :   else
     603             :   {
     604             :     long i, l;
     605        8232 :     CHI = gel(NK,3); l = lg(CHI);
     606        8232 :     if (isintzero(CHI) && joker)
     607        4081 :       CHI = NULL; /* all character orbits */
     608        4151 :     else if (isintm1(CHI) && joker > 1)
     609        2359 :       CHI = gen_m1; /* sum over all character orbits */
     610        1925 :     else if ((typ(CHI) == t_VEC &&
     611         175 :              (l == 1 || l != 3 || !checkznstar_i(gel(CHI,1)))) && joker)
     612             :     {
     613         133 :       CHI = shallowtrans(CHI); /* list of characters */
     614         133 :       for (i = 1; i < l; i++) gel(CHI,i) = get_mfchar(gel(CHI,i));
     615             :     }
     616             :     else
     617             :     {
     618        1659 :       CHI = get_mfchar(CHI); /* single char */
     619        1659 :       if (N % mfcharmodulus(CHI)) pari_err_TYPE("checkNF [chi]", NK);
     620             :     }
     621             :   }
     622        8701 :   return CHI;
     623             : }
     624             : /* support half-integral weight */
     625             : static void
     626        8722 : checkNK2(GEN NK, long *N, long *nk, long *dk, GEN *CHI, int joker)
     627             : {
     628        8722 :   long l = lg(NK);
     629             :   GEN T;
     630        8722 :   if (typ(NK) != t_VEC || l < 3 || l > 4) pari_err_TYPE("checkNK", NK);
     631        8722 :   T = gel(NK,1); if (typ(T) != t_INT) pari_err_TYPE("checkNF [N]", NK);
     632        8722 :   *N = itos(T); if (*N <= 0) pari_err_TYPE("checkNF [N <= 0]", NK);
     633        8722 :   T = gel(NK,2);
     634        8722 :   switch(typ(T))
     635             :   {
     636        5411 :     case t_INT:  *nk = itos(T); *dk = 1; break;
     637             :     case t_FRAC:
     638        3304 :       *nk = itos(gel(T,1));
     639        3304 :       *dk = itou(gel(T,2)); if (*dk == 2) break;
     640           7 :     default: pari_err_TYPE("checkNF [k]", NK);
     641             :   }
     642        8715 :   *CHI = checkCHI(NK, *N, joker);
     643        8701 : }
     644             : /* don't support half-integral weight */
     645             : static void
     646         119 : checkNK(GEN NK, long *N, long *k, GEN *CHI, int joker)
     647             : {
     648             :   long d;
     649         119 :   checkNK2(NK, N, k, &d, CHI, joker);
     650         119 :   if (d != 1) pari_err_TYPE("checkNF [k]", NK);
     651         119 : }
     652             : 
     653             : static GEN
     654        4823 : mfchargalois(long N, int odd, GEN flagorder)
     655             : {
     656        4823 :   GEN G = znstar0(utoi(N), 1), L = chargalois(G, flagorder);
     657        4823 :   long l = lg(L), i, j;
     658      112371 :   for (i = j = 1; i < l; i++)
     659             :   {
     660      107548 :     GEN chi = znconreyfromchar(G, gel(L,i));
     661      107548 :     if (zncharisodd(G,chi) == odd) gel(L,j++) = mfcharGL(G,chi);
     662             :   }
     663        4823 :   setlg(L, j); return L;
     664             : }
     665             : /* possible characters for non-trivial S_1(N, chi) */
     666             : static GEN
     667        1694 : mfwt1chars(long N, GEN vCHI)
     668             : {
     669        1694 :   if (vCHI) return vCHI; /*do not filter, user knows best*/
     670             :   /* Tate's theorem */
     671        1631 :   return mfchargalois(N, 1, uisprime(N)? mkvecsmall2(2,4): NULL);
     672             : }
     673             : static GEN
     674        3227 : mfchars(long N, long k, long dk, GEN vCHI)
     675        3227 : { return vCHI? vCHI: mfchargalois(N, (dk == 2)? 0: (k & 1), NULL); }
     676             : 
     677             : /* wrappers from mfchar to znchar */
     678             : static long
     679       62762 : mfcharparity(GEN CHI)
     680             : {
     681       62762 :   if (!CHI) return 1;
     682       62762 :   return zncharisodd(gel(CHI,1), gel(CHI,2)) ? -1 : 1;
     683             : }
     684             : /* if CHI is primitive, return CHI itself, not a copy */
     685             : static GEN
     686       64337 : mfchartoprimitive(GEN CHI, long *pF)
     687             : {
     688             :   pari_sp av;
     689             :   GEN chi, F;
     690       64337 :   if (!CHI) { if (pF) *pF = 1; return mfchartrivial(); }
     691       64337 :   av = avma; F = znconreyconductor(gel(CHI,1), gel(CHI,2), &chi);
     692       64337 :   if (typ(F) == t_INT) avma = av;
     693             :   else
     694             :   {
     695        6958 :     CHI = leafcopy(CHI);
     696        6958 :     gel(CHI,1) = znstar0(F, 1);
     697        6958 :     gel(CHI,2) = chi;
     698             :   }
     699       64337 :   if (pF) *pF = mfcharmodulus(CHI);
     700       64337 :   return CHI;
     701             : }
     702             : static long
     703      387583 : mfcharconductor(GEN CHI)
     704             : {
     705      387583 :   pari_sp ltop = avma;
     706      387583 :   GEN res = znconreyconductor(gel(CHI,1), gel(CHI,2), NULL);
     707             :   long FC;
     708      387583 :   if (typ(res) == t_VEC) res = gel(res, 1);
     709      387583 :   FC = itos(res); avma = ltop; return FC;
     710             : }
     711             : 
     712             : /* n coprime with the modulus of CHI */
     713             : static GEN
     714        3857 : mfchareval_i(GEN CHI, long n)
     715             : {
     716        3857 :   GEN ord = gmfcharorder(CHI);
     717        3857 :   if (equali1(ord)) return gen_1;
     718         777 :   return mygmodulo(CHI, znchareval_i(CHI, n, ord));
     719             : }
     720             : static GEN
     721         805 : mfchareval(GEN CHI, long n)
     722             : {
     723         805 :   long N = mfcharmodulus(CHI);
     724         805 :   return (cgcd(N, n) > 1) ? gen_0 : mfchareval_i(CHI, n);
     725             : }
     726             : /* d a multiple of ord(CHI); n coprime with char modulus;
     727             :  * return x s.t. CHI(n) = \zeta_d^x] */
     728             : static long
     729      430017 : mfcharevalord(GEN CHI, long n, long d)
     730             : {
     731      430017 :   if (mfcharorder(CHI) == 1) return 0;
     732      229677 :   return znchareval_i(CHI, n, utoi(d));
     733             : }
     734             : 
     735             : /*                      Operations on mf closures                    */
     736             : static GEN
     737       40614 : tagparams(long t, GEN NK) { return mkvec2(mkvecsmall(t), NK); }
     738             : static GEN
     739         721 : lfuntag(long t, GEN x) { return mkvec2(mkvecsmall(t), x); }
     740             : static GEN
     741          49 : tag0(long t, GEN NK) { retmkvec(tagparams(t,NK)); }
     742             : static GEN
     743        7252 : tag(long t, GEN NK, GEN x) { retmkvec2(tagparams(t,NK), x); }
     744             : static GEN
     745       23142 : tag2(long t, GEN NK, GEN x, GEN y) { retmkvec3(tagparams(t,NK), x,y); }
     746             : static GEN
     747       10094 : tag3(long t, GEN NK, GEN x,GEN y,GEN z) { retmkvec4(tagparams(t,NK), x,y,z); }
     748             : /* is F a "modular form" ? */
     749             : int
     750       12922 : checkmf_i(GEN F)
     751       25844 : { return typ(F) == t_VEC
     752       12579 :     && lg(F) > 1 && typ(gel(F,1)) == t_VEC
     753        9268 :     && lg(gel(F,1)) == 3
     754        8694 :     && typ(gmael(F,1,1)) == t_VECSMALL
     755       21616 :     && typ(gmael(F,1,2)) == t_VEC; }
     756       97874 : long mf_get_type(GEN F) { return gmael(F,1,1)[1]; }
     757       77791 : GEN mf_get_gN(GEN F) { return gmael3(F,1,2,1); }
     758       65401 : GEN mf_get_gk(GEN F) { return gmael3(F,1,2,2); }
     759             : /* k - 1/2, assume k in 1/2 + Z */
     760         273 : long mf_get_r(GEN F) { return itou(gel(mf_get_gk(F),1)) >> 1; }
     761       58660 : long mf_get_N(GEN F) { return itou(mf_get_gN(F)); }
     762       45717 : long mf_get_k(GEN F)
     763             : {
     764       45717 :   GEN gk = mf_get_gk(F);
     765       45717 :   if (typ(gk)!=t_INT) pari_err_IMPL("half-integral weight");
     766       45717 :   return itou(gk);
     767             : }
     768       15722 : GEN mf_get_CHI(GEN F) { return gmael3(F,1,2,3); }
     769       27244 : GEN mf_get_field(GEN F) { return gmael3(F,1,2,4); }
     770        1666 : GEN mf_get_NK(GEN F) { return gmael(F,1,2); }
     771             : static void
     772         364 : mf_setfield(GEN f, GEN P)
     773             : {
     774         364 :   gel(f,1) = leafcopy(gel(f,1));
     775         364 :   gmael(f,1,2) = leafcopy(gmael(f,1,2));
     776         364 :   gmael3(f,1,2,4) = P;
     777         364 : }
     778             : 
     779             : /* UTILITY FUNCTIONS */
     780             : GEN
     781        1981 : mftocol(GEN F, long lim, long d)
     782        1981 : { GEN c = mfcoefs_i(F, lim, d); settyp(c,t_COL); return c; }
     783             : GEN
     784         651 : mfvectomat(GEN vF, long lim, long d)
     785             : {
     786         651 :   long j, l = lg(vF);
     787         651 :   GEN M = cgetg(l, t_MAT);
     788         651 :   for (j = 1; j < l; j++) gel(M,j) = mftocol(gel(vF,j), lim, d);
     789         651 :   return M;
     790             : }
     791             : 
     792             : static GEN
     793        2275 : RgV_to_ser(GEN x, long v)
     794             : {
     795        2275 :   long j, lx = lg(x);
     796        2275 :   GEN y = cgetg(lx+1, t_SER);
     797        2275 :   y[1] = evalvarn(v)|evalvalp(0);
     798        2275 :   x--;
     799        2275 :   for (j = 2; j <= lx; j++) gel(y, j) = gel(x, j);
     800        2275 :   return normalize(y);
     801             : }
     802             : 
     803             : /* TODO: delete */
     804             : static GEN
     805        2275 : mfcoefsser(GEN F, long n) { return RgV_to_ser(mfcoefs_i(F,n,1), 0); }
     806             : static GEN
     807         273 : sertovecslice(GEN S, long n)
     808             : {
     809         273 :   GEN v = gtovec0(S, -(lg(S) - 2 + valp(S)));
     810         273 :   long l = lg(v), n2 = n + 2;
     811         273 :   if (l < n2) pari_err_BUG("sertovecslice [n too large]");
     812         273 :   return (l == n2)? v: vecslice(v, 1, n2-1);
     813             : }
     814             : 
     815             : /* a, b two RgV of the same length, multiply as truncated power series */
     816             : static GEN
     817        5677 : RgV_mul_RgXn(GEN a, GEN b)
     818             : {
     819        5677 :   long n = lg(a)-1;
     820             :   GEN c;
     821        5677 :   a = RgV_to_RgX(a,0);
     822        5677 :   b = RgV_to_RgX(b,0); c = RgXn_mul(a, b, n);
     823        5677 :   c = RgX_to_RgC(c,n); settyp(c,t_VEC); return c;
     824             : }
     825             : /* divide as truncated power series */
     826             : static GEN
     827          49 : RgV_div_RgXn(GEN a, GEN b)
     828             : {
     829          49 :   long n = lg(a)-1;
     830             :   GEN c;
     831          49 :   a = RgV_to_RgX(a,0);
     832          49 :   b = RgV_to_RgX(b,0); c = RgXn_mul(a, RgXn_inv(b,n), n);
     833          49 :   c = RgX_to_RgC(c,n); settyp(c,t_VEC); return c;
     834             : }
     835             : /* a^b */
     836             : static GEN
     837          70 : RgV_pows_RgXn(GEN a, long b)
     838             : {
     839          70 :   long n = lg(a)-1;
     840             :   GEN c;
     841          70 :   a = RgV_to_RgX(a,0);
     842          70 :   if (b < 0) { a = RgXn_inv(a, n); b = -b; }
     843          70 :   c = RgXn_powu_i(a,b,n);
     844          70 :   c = RgX_to_RgC(c,n); settyp(c,t_VEC); return c;
     845             : }
     846             : 
     847             : /* assume lg(V) >= n*d + 2 */
     848             : static GEN
     849        4732 : c_deflate(long n, long d, GEN v)
     850             : {
     851        4732 :   long i, id, l = n+2;
     852             :   GEN w;
     853        4732 :   if (d == 1) return lg(v) == l ? v: vecslice(v, 1, l-1);
     854          77 :   w = cgetg(l, t_VEC);
     855          77 :   for (i = id = 1; i < l; i++, id += d) gel(w, i) = gel(v, id);
     856          77 :   return w;
     857             : }
     858             : static GEN
     859         336 : c_mul(long n, long d, GEN F, GEN G)
     860             : {
     861         336 :   pari_sp av = avma;
     862         336 :   long nd = n*d;
     863         336 :   GEN VF = mfcoefs_i(F, nd, 1);
     864         336 :   GEN VG = mfcoefs_i(G, nd, 1);
     865         336 :   return gerepilecopy(av, c_deflate(n, d, RgV_mul_RgXn(VF,VG)));
     866             : }
     867             : static GEN
     868          70 : c_pow(long n, long d, GEN F, GEN a)
     869             : {
     870          70 :   pari_sp av = avma;
     871          70 :   long nd = n*d;
     872          70 :   GEN f = RgV_pows_RgXn(mfcoefs_i(F,nd,1), itos(a));
     873          70 :   return gerepilecopy(av, c_deflate(n, d, f));
     874             : }
     875             : 
     876             : /* F * Theta */
     877             : static GEN
     878          84 : mfmultheta(GEN F)
     879             : {
     880          84 :   if (typ(mf_get_gk(F)) == t_FRAC && mf_get_type(F) == t_MF_DIV
     881          14 :       && mf_get_type(gel(F,3)) == t_MF_THETA) return gel(F,2);
     882          70 :   return mfmul(F, mfTheta(NULL));
     883             : }
     884             : 
     885             : static GEN
     886          14 : c_bracket(long n, long d, GEN F, GEN G, GEN gm)
     887             : {
     888          14 :   pari_sp av = avma;
     889          14 :   long i, nd = n*d;
     890          14 :   GEN VF = mfcoefs_i(F, nd, 1), tF = cgetg(nd+2, t_VEC);
     891          14 :   GEN VG = mfcoefs_i(G, nd, 1), tG = cgetg(nd+2, t_VEC);
     892          14 :   GEN C, mpow, res = NULL, gk = mf_get_gk(F), gl = mf_get_gk(G);
     893          14 :   ulong j, m = itou(gm);
     894             :   /* pow[i,j+1] = i^j */
     895          14 :   mpow = cgetg(m+2, t_MAT);
     896          14 :   gel(mpow,1) = const_col(nd, gen_1);
     897          35 :   for (j = 1; j <= m; j++)
     898             :   {
     899          21 :     GEN c = cgetg(nd+1, t_COL);
     900          21 :     gel(mpow,j+1) = c;
     901          21 :     for (i = 1; i <= nd; i++) gel(c,i) = muliu(gcoeff(mpow,i,j), i);
     902             :   }
     903          14 :   C = binomial(gaddgs(gk, m-1), m);
     904          49 :   for (j = 0; j <= m; j++)
     905             :   { /* C = (-1)^j binom(m+l-1, j) binom(m+k-1,m-j) */
     906             :     GEN c;
     907          35 :     gel(tF,1) = j == 0? gel(VF,1): gen_0;
     908          35 :     gel(tG,1) = j == m? gel(VG,1): gen_0;
     909         238 :     for (i = 1; i <= nd; i++)
     910             :     {
     911         203 :       gel(tF, i+1) = gmul(gcoeff(mpow,i,j+1),   gel(VF, i+1));
     912         203 :       gel(tG, i+1) = gmul(gcoeff(mpow,i,m-j+1), gel(VG, i+1));
     913             :     }
     914          35 :     c = gmul(C, c_deflate(n, d, RgV_mul_RgXn(tF, tG)));
     915          35 :     res = res? gadd(res, c): c;
     916          35 :     if (j < m)
     917             :     {
     918          42 :       C = gdiv(gmul(C, gmulsg(m-j, gaddgs(gl,m-j-1))),
     919          21 :                gmulsg(j+1, gaddgs(gk,j)));
     920          21 :       togglesign_safe(&C);
     921             :     }
     922             :   }
     923          14 :   return gerepileupto(av, res);
     924             : }
     925             : /* linear combination \sum L[j] vecF[j] */
     926             : static GEN
     927        2205 : c_linear(long n, long d, GEN F, GEN L, GEN dL)
     928             : {
     929        2205 :   pari_sp av = avma;
     930        2205 :   long j, l = lg(L);
     931        2205 :   GEN S = NULL;
     932        7945 :   for (j = 1; j < l; j++)
     933             :   {
     934        5740 :     GEN c = gel(L,j);
     935        5740 :     if (gequal0(c)) continue;
     936        5033 :     c = gmul(c, mfcoefs_i(gel(F,j), n, d));
     937        5033 :     S = S? gadd(S,c): c;
     938             :   }
     939        2205 :   if (!S) return zerovec(n+1);
     940        2205 :   if (!is_pm1(dL)) S = gdiv(S, dL);
     941        2205 :   return gerepileupto(av, S);
     942             : }
     943             : 
     944             : /* B_d(T_j Trace^new) as t_MF_BD(t_MF_HECKE(t_MF_NEWTRACE)) or
     945             :  * t_MF_HECKE(t_MF_NEWTRACE)
     946             :  * or t_MF_NEWTRACE in level N. Set d and j, return t_MF_NEWTRACE component*/
     947             : static GEN
     948       47278 : bhn_parse(GEN f, long *d, long *j)
     949             : {
     950       47278 :   long t = mf_get_type(f);
     951       47278 :   *d = *j = 1;
     952       47278 :   if (t == t_MF_BD) { *d = itos(gel(f,3)); f = gel(f,2); t = mf_get_type(f); }
     953       47278 :   if (t == t_MF_HECKE) { *j = gel(f,2)[1]; f = gel(f,3); }
     954       47278 :   return f;
     955             : }
     956             : /* f as above, return the t_MF_NEWTRACE component */
     957             : static GEN
     958        4319 : bhn_newtrace(GEN f)
     959             : {
     960        4319 :   long t = mf_get_type(f);
     961        4319 :   if (t == t_MF_BD) { f = gel(f,2); t = mf_get_type(f); }
     962        4319 :   if (t == t_MF_HECKE) f = gel(f,3);
     963        4319 :   return f;
     964             : }
     965             : static int
     966       19768 : newtrace_stripped(GEN DATA)
     967       19768 : { return lg(DATA) == 5 && typ(gel(DATA,3)) == t_INT; }
     968             : static GEN
     969       19768 : newtrace_DATA(long N, GEN DATA)
     970       19768 : { return newtrace_stripped(DATA)? initnewtrace(N, DATA): DATA; }
     971             : /* vF not empty, same hypotheses as bhnmat_extend */
     972             : static GEN
     973        4319 : bhnmat_extend_nocache(GEN M, long n, long d, GEN vF)
     974             : {
     975        4319 :   GEN DATA, f, F = gel(vF, lg(vF)-1); /* vF[#vF-1] has largest level */
     976        4319 :   long N = mf_get_N(F);
     977             :   cachenew_t cache;
     978        4319 :   f = bhn_newtrace(F);
     979        4319 :   DATA = newtrace_DATA(N, gel(f,2)); /* N.B. mf_get_N(f) divides N */
     980        4319 :   init_cachenew(&cache, n*d, N, DATA);
     981        4319 :   M = bhnmat_extend(M, n, d, vF, &cache);
     982        4319 :   dbg_cachenew(&cache);
     983        4319 :   return M;
     984             : }
     985             : /* c_linear of "bhn" mf closures, same hypotheses as bhnmat_extend */
     986             : static GEN
     987         742 : c_linear_bhn(long n, long d, GEN F, GEN L, GEN dL)
     988             : {
     989             :   pari_sp av;
     990             :   GEN M, v;
     991         742 :   if (lg(L) == 1) return zerovec(n+1);
     992         742 :   av = avma;
     993         742 :   M = bhnmat_extend_nocache(NULL, n, d, F);
     994         742 :   v = RgM_RgC_mul(M,L); settyp(v, t_VEC);
     995         742 :   if (!is_pm1(dL)) v = gdiv(v, dL);
     996         742 :   return gerepileupto(av, v);
     997             : }
     998             : 
     999             : /* c in K, K := Q[X]/(T) vz = vector of consecutive powers of root z of T
    1000             :  * attached to an embedding s: K -> C. Return s(c) in C */
    1001             : static GEN
    1002       63686 : Rg_embed(GEN c, GEN vz)
    1003             : {
    1004       63686 :   long t = typ(c);
    1005       63686 :   if (t == t_POLMOD) { c = gel(c,2); t = typ(c); }
    1006       63686 :   if (t == t_POL) c = RgX_RgV_eval(c, vz);
    1007       63686 :   return c;
    1008             : }
    1009             : /* return s(P) in C[X] */
    1010             : static GEN
    1011         833 : RgX_embed(GEN P, GEN vz)
    1012             : {
    1013             :   long i, l;
    1014         833 :   GEN Q = cgetg_copy(P, &l);
    1015         833 :   Q[1] = P[1];
    1016         833 :   for (i = 2; i < l; i++) gel(Q,i) = Rg_embed(gel(P,i), vz);
    1017         833 :   return normalizepol_lg(Q,l); /* normally a no-op */
    1018             : }
    1019             : /* return s(P) in C^n */
    1020             : static GEN
    1021         903 : RgC_embed(GEN P, GEN vz)
    1022             : {
    1023             :   long i, l;
    1024         903 :   GEN Q = cgetg_copy(P, &l);
    1025         903 :   for (i = 1; i < l; i++) gel(Q,i) = Rg_embed(gel(P,i), vz);
    1026         903 :   return Q;
    1027             : }
    1028             : static GEN
    1029           0 : RgM_embed(GEN P, GEN vz)
    1030             : {
    1031             :   long i, l;
    1032           0 :   GEN Q = cgetg_copy(P, &l);
    1033           0 :   for (i = 1; i < l; i++) gel(Q,i) = RgC_embed(gel(P,i), vz);
    1034           0 :   return Q;
    1035             : }
    1036             : /* P in L = K[X]/(U), K = Q[t]/T; s an embedding of K -> C attached
    1037             :  * to a root of T, extended to an embedding of L -> C attached to a root
    1038             :  * of s(U); vT powers of the root of T, vU powers of the root of s(U).
    1039             :  * Return s(P) in C^n */
    1040             : static GEN
    1041       13216 : Rg_embed2(GEN P, long vt, GEN vT, GEN vU)
    1042             : {
    1043             :   long i, l;
    1044             :   GEN Q;
    1045       13216 :   P = liftpol_shallow(P);
    1046       13216 :   if (typ(P) != t_POL) return P;
    1047       13216 :   if (varn(P) == vt) return Rg_embed(P, vT);
    1048             :   /* varn(P) == vx */
    1049       13216 :   Q = cgetg_copy(P, &l); Q[1] = P[1];
    1050       13216 :   for (i = 2; i < l; i++) gel(Q,i) = Rg_embed(gel(P,i), vT);
    1051       13216 :   return Rg_embed(Q, vU);
    1052             : }
    1053             : static GEN
    1054          14 : RgC_embed2(GEN P, long vt, GEN vT, GEN vU)
    1055             : {
    1056             :   long i, l;
    1057          14 :   GEN Q = cgetg_copy(P, &l);
    1058          14 :   for (i = 1; i < l; i++) gel(Q,i) = Rg_embed2(gel(P,i), vt, vT, vU);
    1059          14 :   return Q;
    1060             : }
    1061             : static GEN
    1062         532 : RgX_embed2(GEN P, long vt, GEN vT, GEN vU)
    1063             : {
    1064             :   long i, l;
    1065         532 :   GEN Q = cgetg_copy(P, &l);
    1066         532 :   for (i = 2; i < l; i++) gel(Q,i) = Rg_embed2(gel(P,i), vt, vT, vU);
    1067         532 :   Q[1] = P[1]; return normalizepol_lg(Q,l);
    1068             : }
    1069             : /* embed polynomial f in variable vx [ may be a scalar ], E from getembed */
    1070             : static GEN
    1071        1365 : polembed(GEN f, long vx, GEN E)
    1072             : {
    1073             :   GEN vT;
    1074        1365 :   if (typ(f) != t_POL || varn(f) != vx) return mfembed(f, E);
    1075        1365 :   if (lg(E) == 1) return f;
    1076        1337 :   vT = gel(E,2);
    1077        1337 :   if (lg(E) == 3)
    1078         805 :     f = RgX_embed(f, vT);
    1079             :   else
    1080         532 :     f = RgX_embed2(f, varn(gel(E,1)), vT, gel(E,3));
    1081        1337 :   return f;
    1082             : }
    1083             : /* embed vector, E from getembed */
    1084             : GEN
    1085        1645 : mfvecembed(GEN f, GEN E)
    1086             : {
    1087             :   GEN vT;
    1088        1645 :   if (lg(E) == 1) return f;
    1089         917 :   vT = gel(E,2);
    1090         917 :   if (lg(E) == 3)
    1091         903 :     f = RgC_embed(f, vT);
    1092             :   else
    1093          14 :     f = RgC_embed2(f, varn(gel(E,1)), vT, gel(E,3));
    1094         917 :   return f;
    1095             : }
    1096             : /* embed vector of polynomials in var vx */
    1097             : static GEN
    1098          98 : vecpolembed(GEN f, long vx, GEN E)
    1099             : {
    1100             :   long i, l;
    1101             :   GEN v;
    1102          98 :   if (lg(E) == 1) return f;
    1103          70 :   v = cgetg_copy(f, &l);
    1104          70 :   for (i = 1; i < l; i++) gel(v,i) = polembed(gel(f,i), vx, E);
    1105          70 :   return v;
    1106             : }
    1107             : 
    1108             : /* embed scalar */
    1109             : GEN
    1110       18522 : mfembed(GEN f, GEN E)
    1111             : {
    1112             :   GEN vT;
    1113       18522 :   if (lg(E) == 1) return f;
    1114       13321 :   vT = gel(E,2);
    1115       13321 :   if (lg(E) == 3)
    1116        4207 :     f = Rg_embed(f, vT);
    1117             :   else
    1118        9114 :     f = Rg_embed2(f, varn(gel(E,1)), vT, gel(E,3));
    1119       13321 :   return f;
    1120             : }
    1121             : /* vector of the sigma(f), sigma in vE */
    1122             : static GEN
    1123          63 : polembedall(GEN f, long vx, GEN vE)
    1124             : {
    1125          63 :   long i, l = lg(vE);
    1126          63 :   GEN v = cgetg(l, t_VEC);
    1127          63 :   for (i = 1; i < l; i++) gel(v,i) = polembed(f, vx, gel(vE,i));
    1128          63 :   return l == 2? gel(v,1): v;
    1129             : }
    1130             : /* matrix whose colums are the sigma(v), sigma in vE */
    1131             : static GEN
    1132         427 : mfvecembedall(GEN v, GEN vE)
    1133             : {
    1134         427 :   long j, l = lg(vE);
    1135         427 :   GEN M = cgetg(l, t_MAT);
    1136         427 :   for (j = 1; j < l; j++) gel(M,j) = mfvecembed(v, gel(vE,j));
    1137         427 :   return M;
    1138             : }
    1139             : /* vector of the sigma(v), sigma in vE */
    1140             : static GEN
    1141       13279 : mfembedall(GEN v, GEN vE)
    1142             : {
    1143       13279 :   long j, l = lg(vE);
    1144       13279 :   GEN M = cgetg(l, t_VEC);
    1145       13279 :   for (j = 1; j < l; j++) gel(M,j) = mfembed(v, gel(vE,j));
    1146       13279 :   return M;
    1147             : }
    1148             : 
    1149             : static GEN
    1150         231 : c_div_i(long n, GEN F, GEN G)
    1151             : {
    1152             :   GEN VF, VG, a0, a0i, H;
    1153         231 :   VF = mfcoefsser(F, n); VG = mfcoefsser(G, n);
    1154         231 :   a0 = polcoeff_i(VG, 0, -1);
    1155         231 :   if (gequal0(a0) || gequal1(a0)) a0 = a0i = NULL;
    1156             :   else
    1157             :   {
    1158          49 :     a0i = ginv(a0);
    1159          49 :     VG = gmul(ser_unscale(VG,a0), a0i);
    1160          49 :     VF = gmul(ser_unscale(VF,a0), a0i);
    1161             :   }
    1162         231 :   H = gdiv(VF, VG);
    1163         231 :   if (a0) H = ser_unscale(H,a0i);
    1164         231 :   return sertovecslice(H, n);
    1165             : }
    1166             : static GEN
    1167         231 : c_div(long n, long d, GEN F, GEN G)
    1168             : {
    1169         231 :   pari_sp av = avma;
    1170         231 :   GEN D = (d==1)? c_div_i(n, F,G): c_deflate(n, d, c_div_i(n*d, F,G));
    1171         231 :   return gerepilecopy(av, D);
    1172             : }
    1173             : 
    1174             : static GEN
    1175          35 : c_shift(long n, long d, GEN F, GEN gsh)
    1176             : {
    1177          35 :   pari_sp av = avma;
    1178             :   GEN vF;
    1179          35 :   long sh = itos(gsh), n1 = n*d + sh;
    1180          35 :   if (n1 < 0) return zerovec(n+1);
    1181          35 :   vF = mfcoefs_i(F, n1, 1);
    1182          35 :   if (sh < 0) vF = shallowconcat(zerovec(-sh), vF);
    1183          35 :   else vF = vecslice(vF, sh+1, n1+1);
    1184          35 :   return gerepilecopy(av, c_deflate(n, d, vF));
    1185             : }
    1186             : 
    1187             : static GEN
    1188          21 : c_deriv(long n, long d, GEN F, GEN gm)
    1189             : {
    1190          21 :   pari_sp av = avma;
    1191          21 :   GEN V = mfcoefs_i(F, n, d), res;
    1192          21 :   long i, m = itos(gm);
    1193          21 :   if (!m) return V;
    1194          21 :   res = cgetg(n+2, t_VEC); gel(res,1) = gen_0;
    1195          21 :   if (m < 0)
    1196           7 :   { for (i=1; i <= n; i++) gel(res, i+1) = gdiv(gel(V, i+1), powuu(i,-m)); }
    1197             :   else
    1198          14 :   { for (i=1; i <= n; i++) gel(res, i+1) = gmul(gel(V,i+1), powuu(i,m)); }
    1199          21 :   return gerepileupto(av, res);
    1200             : }
    1201             : 
    1202             : static GEN
    1203          14 : c_derivE2(long n, long d, GEN F, GEN gm)
    1204             : {
    1205          14 :   pari_sp av = avma;
    1206             :   GEN VF, VE, res, tmp, gk;
    1207          14 :   long i, m = itos(gm), nd;
    1208          14 :   if (m == 0) return mfcoefs_i(F, n, d);
    1209          14 :   nd = n*d;
    1210          14 :   VF = mfcoefs_i(F, nd, 1); VE = mfcoefs_i(mfEk(2), nd, 1);
    1211          14 :   gk = mf_get_gk(F);
    1212          14 :   if (m == 1)
    1213             :   {
    1214           7 :     res = cgetg(n+2, t_VEC);
    1215           7 :     for (i = 0; i <= n; i++) gel(res, i+1) = gmulsg(i, gel(VF, i*d+1));
    1216           7 :     tmp = c_deflate(n, d, RgV_mul_RgXn(VF, VE));
    1217           7 :     return gerepileupto(av, gsub(res, gmul(gdivgs(gk, 12), tmp)));
    1218             :   }
    1219             :   else
    1220             :   {
    1221             :     long j;
    1222          35 :     for (j = 1; j <= m; j++)
    1223             :     {
    1224          28 :       tmp = RgV_mul_RgXn(VF, VE);
    1225          28 :       for (i = 0; i <= nd; i++) gel(VF, i+1) = gmulsg(i, gel(VF, i+1));
    1226          28 :       VF = gsub(VF, gmul(gdivgs(gaddgs(gk, 2*(j-1)), 12), tmp));
    1227             :     }
    1228           7 :     return gerepilecopy(av, c_deflate(n, d, VF));
    1229             :   }
    1230             : }
    1231             : 
    1232             : /* Twist by the character (D/.) */
    1233             : static GEN
    1234           7 : c_twist(long n, long d, GEN F, GEN D)
    1235             : {
    1236           7 :   pari_sp av = avma;
    1237           7 :   GEN V = mfcoefs_i(F, n, d), res = cgetg(n+2, t_VEC);
    1238             :   long i;
    1239         119 :   for (i = 0; i <= n; i++)
    1240         112 :     gel(res, i + 1) = gmulsg(krois(D, i), gel(V, i+1));
    1241           7 :   return gerepileupto(av, res);
    1242             : }
    1243             : 
    1244             : /* form F given by closure, compute T(n)(F) as closure */
    1245             : static GEN
    1246        2296 : c_hecke(long m, long l, GEN DATA, GEN F)
    1247             : {
    1248        2296 :   pari_sp av = avma;
    1249        2296 :   return gerepilecopy(av, hecke_i(m, l, F, DATA));
    1250             : }
    1251             : static GEN
    1252          77 : c_const(long n, long d, GEN C)
    1253             : {
    1254          77 :   GEN V = zerovec(n+1);
    1255          77 :   long i, j, l = lg(C);
    1256          77 :   if (l > d*n+2) l = d*n+2;
    1257          77 :   for (i = j = 1; i < l; i+=d, j++) gel(V, j) = gcopy(gel(C,i));
    1258          77 :   return V;
    1259             : }
    1260             : 
    1261             : static GEN
    1262         406 : eta3_ZXn(long m)
    1263             : {
    1264         406 :   long l = m+2, n, k;
    1265         406 :   GEN P = cgetg(l,t_POL);
    1266         406 :   P[1] = evalsigne(1)|evalvarn(0);
    1267         406 :   for (n = 2; n < l; n++) gel(P,n) = gen_0;
    1268        2240 :   for (n = k = 0;; n++)
    1269             :   {
    1270        2240 :     k += n; if (k >= m) break;
    1271             :     /* now k = n(n+1) / 2 */
    1272        1834 :     gel(P, k+2) = odd(n)? utoineg(2*n+1): utoipos(2*n+1);
    1273        1834 :   }
    1274         406 :   return P;
    1275             : }
    1276             : 
    1277             : static GEN
    1278        1218 : ZXn_sqr(GEN f, long n) { return RgXn_red_shallow(ZX_sqr(f), n); }
    1279             : static GEN
    1280         406 : c_delta(long n, long d)
    1281             : {
    1282         406 :   pari_sp ltop = avma;
    1283         406 :   long N = n*d;
    1284         406 :   GEN e = eta3_ZXn(N);
    1285         406 :   e = ZXn_sqr(e,N);
    1286         406 :   e = ZXn_sqr(e,N);
    1287         406 :   e = ZXn_sqr(e,N); /* eta(x)^24 */
    1288         406 :   settyp(e, t_VEC);
    1289         406 :   gel(e,1) = gen_0; /* Delta(x) = x*eta(x)^24 as a t_VEC */
    1290         406 :   return gerepilecopy(ltop, c_deflate(n, d, e));
    1291             : }
    1292             : 
    1293             : /* return s(d) such that s|f <=> d | f^2 */
    1294             : static long
    1295          21 : mysqrtu(ulong d)
    1296             : {
    1297          21 :   GEN fa = myfactoru(d), P = gel(fa,1), E = gel(fa,2);
    1298          21 :   long l = lg(P), i, s = 1;
    1299          21 :   for (i = 1; i < l; i++) s *= upowuu(P[i], (E[i]+1)>>1);
    1300          21 :   return s;
    1301             : }
    1302             : static GEN
    1303         833 : c_theta(long n, long d, GEN psi)
    1304             : {
    1305         833 :   long lim = usqrt(n*d), F = mfcharmodulus(psi), par = mfcharparity(psi);
    1306         833 :   long f, d2 = d == 1? 1: mysqrtu(d);
    1307         833 :   GEN V = zerovec(n + 1);
    1308        3073 :   for (f = d2; f <= lim; f += d2)
    1309        2240 :     if (cgcd(F, f) == 1)
    1310             :     {
    1311        2240 :       GEN c = mfchareval_i(psi, f);
    1312        2240 :       gel(V, f*f/d + 1) = par < 0 ? gmulgs(c, 2*f) : gmul2n(c, 1);
    1313             :     }
    1314         833 :   if (F == 1) gel(V, 1) = gen_1;
    1315         833 :   return V;
    1316             : }
    1317             : 
    1318             : static GEN
    1319          42 : c_etaquo(long n, long d, GEN eta, GEN gs)
    1320             : {
    1321          42 :   pari_sp av = avma;
    1322          42 :   GEN B = gel(eta,1), E = gel(eta,2), c = gen_1;
    1323          42 :   long i, s = itos(gs), nd = n*d, nds = nd - s + 1, l = lg(B);
    1324          42 :   for (i = 1; i < l; i++) c = gmul(c, gpowgs(eta_inflate_ZXn(nds, B[i]), E[i]));
    1325          42 :   if (s > 0) setvalp(c, valp(c) + s);
    1326          42 :   return gerepilecopy(av, c_deflate(n, d, sertovecslice(c, nd)));
    1327             : }
    1328             : 
    1329             : static GEN
    1330          49 : c_ell(long n, long d, GEN E)
    1331             : {
    1332          49 :   pari_sp av = avma;
    1333             :   GEN v;
    1334          49 :   if (d == 1) return concat(gen_0, anell(E, n));
    1335           7 :   v = shallowconcat(gen_0, anell(E, n*d));
    1336           7 :   return gerepilecopy(av, c_deflate(n, d, v));
    1337             : }
    1338             : 
    1339             : static GEN
    1340          21 : c_cusptrace(long n, long d, GEN F)
    1341             : {
    1342          21 :   GEN D = gel(F,2), res = cgetg(n+2, t_VEC);
    1343          21 :   long i, N = mf_get_N(F), k = mf_get_k(F);
    1344          21 :   gel(res, 1) = gen_0;
    1345         140 :   for (i = 1; i <= n; i++)
    1346         119 :     gel(res, i+1) = mfcusptrace_i(N, k, i*d, mydivisorsu(i*d), D);
    1347          21 :   return res;
    1348             : }
    1349             : 
    1350             : static GEN
    1351        1946 : c_newtrace(long n, long d, GEN F)
    1352             : {
    1353        1946 :   pari_sp av = avma;
    1354             :   cachenew_t cache;
    1355        1946 :   long N = mf_get_N(F);
    1356             :   GEN v;
    1357        1946 :   init_cachenew(&cache, n*d, N, newtrace_DATA(N, gel(F,2)));
    1358        1946 :   v = colnewtrace(0, n, d, N, mf_get_k(F), &cache);
    1359        1946 :   settyp(v, t_VEC); return gerepilecopy(av, v);
    1360             : }
    1361             : 
    1362             : static GEN
    1363        3136 : c_Bd(long n, long d, GEN F, GEN A)
    1364             : {
    1365        3136 :   pari_sp av = avma;
    1366        3136 :   long a = itou(A), ad = cgcd(a,d), aad = a/ad, i, j;
    1367        3136 :   GEN w, v = mfcoefs_i(F, n/aad, d/ad);
    1368        3136 :   if (a == 1) return v;
    1369        3136 :   n++; w = zerovec(n);
    1370        3136 :   for (i = j = 1; j <= n; i++, j += aad) gel(w,j) = gcopy(gel(v,i));
    1371        3136 :   return gerepileupto(av, w);
    1372             : }
    1373             : 
    1374             : static GEN
    1375        3374 : c_dihedral(long n, long d, GEN bnr, GEN w, GEN k0j)
    1376             : {
    1377        3374 :   pari_sp av = avma;
    1378        3374 :   GEN V = dihan(bnr, w, k0j, n*d);
    1379        3374 :   GEN Tinit = gel(w,3), Pm = gel(Tinit,1);
    1380        3374 :   GEN A = c_deflate(n, d, V);
    1381        3374 :   if (degpol(Pm) == 1 || RgX_is_QX(A)) return gerepilecopy(av, A);
    1382         784 :   return gerepileupto(av, gmodulo(A, Pm));
    1383             : }
    1384             : 
    1385             : static GEN
    1386         140 : c_mfEH(long n, long d, GEN F)
    1387             : {
    1388         140 :   long i, r = mf_get_r(F);
    1389             :   GEN v, M, A;
    1390         140 :   if (n == 1) return mkvec2(mfEHcoef(r,0),mfEHcoef(r,d)); /* speedup mfcoef */
    1391         126 :   if (r == 1)
    1392             :   {
    1393          70 :     v = cgetg(n+2, t_VEC);
    1394          70 :     gel(v,1) = sstoQ(-1,12);
    1395       83258 :     for (i = 1; i <= n; i++)
    1396             :     {
    1397       83188 :       long id = i*d, a = id & 3;
    1398       83188 :       gel(v,i+1) = (a==1 || a==2)? gen_0: sstoQ(hclassno6u(id), 6);
    1399             :     }
    1400          70 :     return v;
    1401             :   }
    1402          56 :   M = mfEHmat(n*d+1,r);
    1403          56 :   if (d > 1)
    1404             :   {
    1405           7 :     long l = lg(M);
    1406           7 :     for (i = 1; i < l; i++) gel(M,i) = c_deflate(n, d, gel(M,i));
    1407             :   }
    1408          56 :   A = gel(F,2); /* [num(B), den(B)] */
    1409          56 :   v = RgC_Rg_div(RgM_RgC_mul(M, gel(A,1)), gel(A,2));
    1410          56 :   settyp(v,t_VEC); return v;
    1411             : }
    1412             : 
    1413             : static GEN
    1414        3346 : c_mfeisen(long n, long d, GEN F)
    1415             : {
    1416        3346 :   GEN v, vchi, E0, P, T, CHI, gk = mf_get_gk(F);
    1417             :   long i, k;
    1418        3346 :   if (typ(gk) != t_INT) return c_mfEH(n, d, F);
    1419        3206 :   k = itou(gk);
    1420        3206 :   vchi = gel(F,2);
    1421        3206 :   E0 = gel(vchi,1);
    1422        3206 :   T = gel(vchi,2);
    1423        3206 :   P = gel(T,1);
    1424        3206 :   CHI = gel(vchi,3);
    1425        3206 :   v = cgetg(n+2, t_VEC);
    1426        3206 :   gel(v, 1) = gcopy(E0); /* E(0) */
    1427        3206 :   if (lg(vchi) == 5)
    1428             :   { /* E_k(chi1,chi2) */
    1429        2023 :     GEN CHI2 = gel(vchi,4), F3 = gel(F,3);
    1430        2023 :     long ord = F3[1], j = F3[2];
    1431        2023 :     for (i = 1; i <= n; i++) gel(v, i+1) = sigchi2(k, CHI, CHI2, i*d, ord);
    1432        2023 :     if (lg(T) == 4) v = QabV_tracerel(T, j, v);
    1433             :   }
    1434             :   else
    1435             :   { /* E_k(chi) */
    1436        1183 :     for (i = 1; i <= n; i++) gel(v, i+1) = sigchi(k, CHI, i*d);
    1437             :   }
    1438        3206 :   if (degpol(P) != 1 && !RgV_is_QV(v)) v = gmodulo(v, P);
    1439        3206 :   return v;
    1440             : }
    1441             : 
    1442             : /* L(chi_D, 1-k) */
    1443             : static GEN
    1444          28 : lfunquadneg(long D, long k)
    1445             : {
    1446          28 :   GEN B, dS, S = gen_0;
    1447          28 :   long r, N = labs(D);
    1448             :   pari_sp av;
    1449          28 :   if (k == 1 && N == 1) return gneg(ghalf);
    1450             :   /* B = N^k * denom(B) * B(x/N) */
    1451          28 :   B = ZX_rescale(Q_remove_denom(bernpol(k, 0), &dS), utoi(N));
    1452          28 :   dS = mul_denom(dS, stoi(-N*k));
    1453          28 :   av = avma;
    1454        7175 :   for (r = 0; r < N; r++)
    1455             :   {
    1456        7147 :     long c = kross(D, r);
    1457        7147 :     if (c)
    1458             :     {
    1459        5152 :       GEN tmp = poleval(B, utoi(r));
    1460        5152 :       S = c > 0 ? addii(S, tmp) : subii(S, tmp);
    1461        5152 :       S = gerepileuptoint(av, S);
    1462             :     }
    1463             :   }
    1464          28 :   return gdiv(S, dS);
    1465             : }
    1466             : 
    1467             : /* Returns vector of coeffs from F[0], F[d], ..., F[d*n] */
    1468             : static GEN
    1469       19705 : mfcoefs_i(GEN F, long n, long d)
    1470             : {
    1471       19705 :   if (n < 0) return gen_0;
    1472       19705 :   switch(mf_get_type(F))
    1473             :   {
    1474          77 :     case t_MF_CONST: return c_const(n, d, gel(F,2));
    1475        3346 :     case t_MF_EISEN: return c_mfeisen(n, d, F);
    1476         567 :     case t_MF_Ek: return c_Ek(n, d, F);
    1477         406 :     case t_MF_DELTA: return c_delta(n, d);
    1478         770 :     case t_MF_THETA: return c_theta(n, d, gel(F,2));
    1479          42 :     case t_MF_ETAQUO: return c_etaquo(n, d, gel(F,2), gel(F,3));
    1480          49 :     case t_MF_ELL: return c_ell(n, d, gel(F,2));
    1481         336 :     case t_MF_MUL: return c_mul(n, d, gel(F,2), gel(F,3));
    1482          70 :     case t_MF_POW: return c_pow(n, d, gel(F,2), gel(F,3));
    1483          14 :     case t_MF_BRACKET: return c_bracket(n, d, gel(F,2), gel(F,3), gel(F,4));
    1484        2205 :     case t_MF_LINEAR: return c_linear(n, d, gel(F,2), gel(F,3), gel(F,4));
    1485         742 :     case t_MF_LINEAR_BHN: return c_linear_bhn(n, d, gel(F,2),gel(F,3),gel(F,4));
    1486         231 :     case t_MF_DIV: return c_div(n, d, gel(F,2), gel(F,3));
    1487          35 :     case t_MF_SHIFT: return c_shift(n, d, gel(F,2), gel(F,3));
    1488          21 :     case t_MF_DERIV: return c_deriv(n, d, gel(F,2), gel(F,3));
    1489          14 :     case t_MF_DERIVE2: return c_derivE2(n, d, gel(F,2), gel(F,3));
    1490           7 :     case t_MF_TWIST: return c_twist(n, d, gel(F,2), gel(F,3));
    1491        2296 :     case t_MF_HECKE: return c_hecke(n, d, gel(F,2), gel(F,3));
    1492        3136 :     case t_MF_BD: return c_Bd(n, d, gel(F,2), gel(F,3));
    1493          21 :     case t_MF_TRACE: return c_cusptrace(n, d, F);
    1494        1946 :     case t_MF_NEWTRACE: return c_newtrace(n, d, F);
    1495        3374 :     case t_MF_DIHEDRAL: return c_dihedral(n, d, gel(F,2), gel(F,3), gel(F,4));
    1496           0 :     default: pari_err_TYPE("mfcoefs",F);
    1497           0 :     return NULL;/* not reached */
    1498             :   }
    1499             : }
    1500             : 
    1501             : static GEN
    1502          77 : matdeflate(long n, long d, GEN M)
    1503             : {
    1504             :   long i, l;
    1505             :   GEN A;
    1506             :   /*  if (d == 1) return M; */
    1507          77 :   A = cgetg_copy(M,&l);
    1508          77 :   for (i = 1; i < l; i++) gel(A,i) = c_deflate(n,d,gel(M,i));
    1509          77 :   return A;
    1510             : }
    1511             : static int
    1512        6636 : space_is_cusp(long space) { return space != mf_FULL && space != mf_EISEN; }
    1513             : static GEN
    1514        1743 : mfcoefs_mf(GEN mf, long n, long d)
    1515             : {
    1516        1743 :   GEN MS, ME, E = MF_get_E(mf), S = MF_get_S(mf);
    1517        1743 :   long lE = lg(E), lS = lg(S), l = lE+lS-1;
    1518             : 
    1519        1743 :   if (l == 1) return cgetg(1, t_MAT);
    1520        1540 :   if (n*d < mfsturm_mf(mf)) return matdeflate(n, d, MF_get_M(mf)); /*cached*/
    1521        1498 :   ME = (lE == 1)? cgetg(1, t_MAT): mfvectomat(E, n, d);
    1522        1498 :   if (lS == 1)
    1523         301 :     MS = cgetg(1, t_MAT);
    1524        1197 :   else if (mf_get_type(gel(S,1)) == t_MF_DIV) /* k 1/2-integer or k=1 (exotic) */
    1525          35 :     MS = matdeflate(n,d, mflineardivtomat(S, n*d));
    1526        1162 :   else if (MF_get_k(mf) == 1) /* k = 1 (dihedral) */
    1527             :   {
    1528          49 :     GEN M = mfvectomat(gmael(S,1,2), n, d);
    1529             :     long i;
    1530          49 :     MS = cgetg(lS, t_MAT);
    1531         119 :     for (i = 1; i < lS; i++)
    1532             :     {
    1533          70 :       GEN f = gel(S,i), d = gel(f,4), c = RgM_RgC_mul(M, gel(f,3));
    1534          70 :       if (!equali1(d)) c = RgC_Rg_div(c,d);
    1535          70 :       gel(MS,i) = c;
    1536             :     }
    1537             :   }
    1538             :   else /* k >= 2 integer */
    1539        1113 :     MS = bhnmat_extend_nocache(NULL, n, d, S);
    1540        1498 :   return shallowconcat(ME,MS);
    1541             : }
    1542             : GEN
    1543        3143 : mfcoefs(GEN F, long n, long d)
    1544             : {
    1545        3143 :   if (!checkmf_i(F))
    1546             :   {
    1547         511 :     pari_sp av = avma;
    1548         511 :     if (!checkMF_i(F)) pari_err_TYPE("mfcoefs", F);
    1549         511 :     return gerepilecopy(av, mfcoefs_mf(F,n,d));
    1550             :   }
    1551        2632 :   if (d <= 0) pari_err_DOMAIN("mfcoefs", "d", "<=", gen_0, stoi(d));
    1552        2632 :   if (n < 0) return cgetg(1, t_VEC);
    1553        2632 :   return mfcoefs_i(F, n, d);
    1554             : }
    1555             : 
    1556             : /* assume k >= 0 */
    1557             : static GEN
    1558         140 : mfak_i(GEN F, long k)
    1559             : {
    1560         140 :   if (!k) return gel(mfcoefs_i(F,0,1), 1);
    1561          98 :   return gel(mfcoefs_i(F,1,k), 2);
    1562             : }
    1563             : GEN
    1564          84 : mfcoef(GEN F, long n)
    1565             : {
    1566          84 :   pari_sp av = avma;
    1567          84 :   if (!checkmf_i(F)) pari_err_TYPE("mfcoef",F);
    1568          84 :   return n < 0? gen_0: gerepilecopy(av, mfak_i(F, n));
    1569             : }
    1570             : 
    1571             : static GEN
    1572          77 : paramconst() { return tagparams(t_MF_CONST, mkNK(1,0,mfchartrivial())); }
    1573             : static GEN
    1574          56 : mftrivial(void) { retmkvec2(paramconst(), cgetg(1,t_VEC)); }
    1575             : static GEN
    1576          21 : mf1(void) { retmkvec2(paramconst(), mkvec(gen_1)); }
    1577             : 
    1578             : /* induce mfchar CHI to G */
    1579             : static GEN
    1580      307097 : induce(GEN G, GEN CHI)
    1581             : {
    1582             :   GEN o, chi;
    1583      307097 :   if (typ(CHI) == t_INT) /* Kronecker */
    1584             :   {
    1585      300398 :     chi = znchar_quad(G, CHI);
    1586      300398 :     o = ZV_equal0(chi)? gen_1: gen_2;
    1587      300398 :     CHI = mkvec4(G,chi,o,cgetg(1,t_VEC));
    1588             :   }
    1589             :   else
    1590             :   {
    1591        6699 :     if (mfcharmodulus(CHI) == itos(znstar_get_N(G))) return CHI;
    1592        6489 :     CHI = leafcopy(CHI);
    1593        6489 :     chi = zncharinduce(gel(CHI,1), gel(CHI,2), G);
    1594        6489 :     gel(CHI,1) = G;
    1595        6489 :     gel(CHI,2) = chi;
    1596             :   }
    1597      306887 :   return CHI;
    1598             : }
    1599             : /* induce mfchar CHI to znstar(G) */
    1600             : static GEN
    1601       41979 : induceN(long N, GEN CHI)
    1602             : {
    1603       41979 :   if (mfcharmodulus(CHI) != N) CHI = induce(znstar0(utoipos(N),1), CHI);
    1604       41979 :   return CHI;
    1605             : }
    1606             : /* *pCHI1 and *pCHI2 are mfchar, induce to common modulus */
    1607             : static void
    1608        7070 : char2(GEN *pCHI1, GEN *pCHI2)
    1609             : {
    1610        7070 :   GEN CHI1 = *pCHI1, G1 = gel(CHI1,1), N1 = znstar_get_N(G1);
    1611        7070 :   GEN CHI2 = *pCHI2, G2 = gel(CHI2,1), N2 = znstar_get_N(G2);
    1612        7070 :   if (!equalii(N1,N2))
    1613             :   {
    1614        5642 :     GEN G, d = gcdii(N1,N2);
    1615        5642 :     if      (equalii(N2,d)) *pCHI2 = induce(G1, CHI2);
    1616        1008 :     else if (equalii(N1,d)) *pCHI1 = induce(G2, CHI1);
    1617             :     else
    1618             :     {
    1619         161 :       if (!equali1(d)) N2 = diviiexact(N2,d);
    1620         161 :       G = znstar0(mulii(N1,N2), 1);
    1621         161 :       *pCHI1 = induce(G, CHI1);
    1622         161 :       *pCHI2 = induce(G, CHI2);
    1623             :     }
    1624             :   }
    1625        7070 : }
    1626             : /* mfchar or charinit wrt same modulus; outputs a mfchar */
    1627             : static GEN
    1628      300986 : mfcharmul_i(GEN CHI1, GEN CHI2)
    1629             : {
    1630      300986 :   GEN G = gel(CHI1,1), chi3 = zncharmul(G, gel(CHI1,2), gel(CHI2,2));
    1631      300986 :   return mfcharGL(G, chi3);
    1632             : }
    1633             : /* mfchar or charinit; outputs a mfchar */
    1634             : static GEN
    1635         595 : mfcharmul(GEN CHI1, GEN CHI2)
    1636             : {
    1637         595 :   char2(&CHI1, &CHI2); return mfcharmul_i(CHI1,CHI2);
    1638             : }
    1639             : /* mfchar or charinit; outputs a mfchar */
    1640             : static GEN
    1641          63 : mfcharpow(GEN CHI, GEN n)
    1642             : {
    1643             :   GEN G, chi;
    1644          63 :   G = gel(CHI,1); chi = zncharpow(G, gel(CHI,2), n);
    1645          63 :   return mfcharGL(G, chi);
    1646             : }
    1647             : /* mfchar or charinit wrt same modulus; outputs a mfchar */
    1648             : static GEN
    1649        6475 : mfchardiv_i(GEN CHI1, GEN CHI2)
    1650             : {
    1651        6475 :   GEN G = gel(CHI1,1), chi3 = znchardiv(G, gel(CHI1,2), gel(CHI2,2));
    1652        6475 :   return mfcharGL(G, chi3);
    1653             : }
    1654             : /* mfchar or charinit; outputs a mfchar */
    1655             : static GEN
    1656        6475 : mfchardiv(GEN CHI1, GEN CHI2)
    1657             : {
    1658        6475 :   char2(&CHI1, &CHI2); return mfchardiv_i(CHI1,CHI2);
    1659             : }
    1660             : static GEN
    1661          28 : mfcharconj(GEN CHI)
    1662             : {
    1663          28 :   CHI = leafcopy(CHI);
    1664          28 :   gel(CHI,2) = zncharconj(gel(CHI,1), gel(CHI,2));
    1665          28 :   return CHI;
    1666             : }
    1667             : 
    1668             : /* CHI mfchar, assume 4 | N. Multiply CHI by \chi_{-4}^k */
    1669             : static GEN
    1670         609 : mfchilift(GEN CHI, long k, long N)
    1671             : {
    1672         609 :   if (!odd(k)) return CHI;
    1673         609 :   CHI = induceN(N, CHI);
    1674         609 :   return mfcharmul_i(CHI, induce(gel(CHI,1), stoi(-4)));
    1675             : }
    1676             : 
    1677             : /* (-1)^k */
    1678             : static long
    1679        6685 : m1pk(long k) { return odd(k)? -1 : 1; }
    1680             : 
    1681             : static GEN
    1682        1358 : mfchiadjust(GEN CHI, GEN gk, long N)
    1683             : {
    1684        1358 :   long par = mfcharparity(CHI);
    1685        1358 :   if (typ(gk) == t_INT) par *= m1pk(itos(gk));
    1686        1358 :   return par == 1 ? CHI : mfchilift(CHI, 1, N);
    1687             : }
    1688             : 
    1689             : static GEN
    1690        1988 : mfsamefield(GEN P, GEN Q)
    1691             : {
    1692        1988 :   if (degpol(P) == 1) return Q;
    1693         413 :   if (degpol(Q) == 1) return P;
    1694         413 :   if (!gequal(P,Q)) pari_err_TYPE("mfsamefield [different fields]",mkvec2(P,Q));
    1695         406 :   return P;
    1696             : }
    1697             : 
    1698             : GEN
    1699         168 : mfmul(GEN f, GEN g)
    1700             : {
    1701         168 :   pari_sp av = avma;
    1702             :   GEN N, K, NK, CHI;
    1703         168 :   if (!checkmf_i(f)) pari_err_TYPE("mfmul",f);
    1704         168 :   if (!checkmf_i(g)) pari_err_TYPE("mfmul",g);
    1705         168 :   N = lcmii(mf_get_gN(f), mf_get_gN(g));
    1706         168 :   K = gadd(mf_get_gk(f), mf_get_gk(g));
    1707         168 :   CHI = mfcharmul(mf_get_CHI(f), mf_get_CHI(g));
    1708         168 :   CHI = mfchiadjust(CHI, K, itos(N));
    1709         168 :   NK = mkgNK(N, K, CHI, mfsamefield(mf_get_field(f), mf_get_field(g)));
    1710         161 :   return gerepilecopy(av, tag2(t_MF_MUL, NK, f, g));
    1711             : }
    1712             : GEN
    1713          49 : mfpow(GEN f, long n)
    1714             : {
    1715          49 :   pari_sp av = avma;
    1716             :   GEN KK, NK, gn, CHI;
    1717          49 :   if (!checkmf_i(f)) pari_err_TYPE("mfpow",f);
    1718          49 :   if (!n) return mf1();
    1719          49 :   if (n == 1) return gcopy(f);
    1720          49 :   KK = gmulsg(n,mf_get_gk(f));
    1721          49 :   gn = stoi(n);
    1722          49 :   CHI = mfcharpow(mf_get_CHI(f), gn);
    1723          49 :   CHI = mfchiadjust(CHI, KK, mf_get_N(f));
    1724          49 :   NK = mkgNK(mf_get_gN(f), KK, CHI, mf_get_field(f));
    1725          49 :   return gerepilecopy(av, tag2(t_MF_POW, NK, f, gn));
    1726             : }
    1727             : GEN
    1728          14 : mfbracket(GEN f, GEN g, long m)
    1729             : {
    1730          14 :   pari_sp av = avma;
    1731             :   GEN N, K, NK, CHI;
    1732          14 :   if (!checkmf_i(f)) pari_err_TYPE("mfbracket",f);
    1733          14 :   if (!checkmf_i(g)) pari_err_TYPE("mfbracket",g);
    1734          14 :   if (m < 0) pari_err_TYPE("mfbracket [m<0]",stoi(m));
    1735          14 :   K = gaddgs(gadd(mf_get_gk(f), mf_get_gk(g)), 2*m);
    1736          14 :   if (signe(K) < 0) pari_err_IMPL("mfbracket for this form");
    1737          14 :   N = lcmii(mf_get_gN(f), mf_get_gN(g));
    1738          14 :   CHI = mfcharmul(mf_get_CHI(f), mf_get_CHI(g));
    1739          14 :   CHI = mfchiadjust(CHI, K, itou(N));
    1740          14 :   NK = mkgNK(N, K, CHI, mfsamefield(mf_get_field(f), mf_get_field(g)));
    1741          14 :   return gerepilecopy(av, tag3(t_MF_BRACKET, NK, f, g, utoi(m)));
    1742             : }
    1743             : 
    1744             : /* remove 0 entries in L */
    1745             : static int
    1746         791 : mflinear_strip(GEN *pF, GEN *pL)
    1747             : {
    1748         791 :   pari_sp av = avma;
    1749         791 :   GEN F = *pF, L = *pL;
    1750         791 :   long i, j, l = lg(L);
    1751         791 :   GEN F2 = cgetg(l, t_VEC), L2 = cgetg(l, t_VEC);
    1752        3577 :   for (i = j = 1; i < l; i++)
    1753             :   {
    1754        2786 :     if (gequal0(gel(L,i))) continue;
    1755        2380 :     gel(F2,j) = gel(F,i);
    1756        2380 :     gel(L2,j) = gel(L,i); j++;
    1757             :   }
    1758         791 :   if (j == l) avma = av;
    1759             :   else
    1760             :   {
    1761         161 :     setlg(F2,j); *pF = F2;
    1762         161 :     setlg(L2,j); *pL = L2;
    1763             :   }
    1764         791 :   return (j > 1);
    1765             : }
    1766             : static GEN
    1767        3129 : taglinear_i(long t, GEN NK, GEN F, GEN L)
    1768             : {
    1769             :   GEN dL;
    1770        3129 :   L = Q_remove_denom(L, &dL); if (!dL) dL = gen_1;
    1771        3129 :   return tag3(t, NK, F, L, dL);
    1772             : }
    1773             : static GEN
    1774        2681 : taglinear(GEN NK, GEN F, GEN L) { return taglinear_i(t_MF_LINEAR, NK, F,L);}
    1775             : /* assume F has parameters NK = [N,K,CHI] */
    1776             : static GEN
    1777         182 : mflinear_i(GEN NK, GEN F, GEN L)
    1778             : {
    1779         182 :   if (!mflinear_strip(&F,&L)) return mftrivial();
    1780         182 :   return taglinear(NK, F,L);
    1781             : }
    1782             : /* assume F has homogeneous [N,K,CHI] */
    1783             : static GEN
    1784         455 : mflinear_bhn(GEN F, GEN L)
    1785             : {
    1786             :   long i, l;
    1787             :   GEN P, f;
    1788         455 :   if (!mflinear_strip(&F,&L)) return mftrivial();
    1789         448 :   f = gel(F,1); l = lg(L); P = mf_get_field(f);
    1790        2380 :   for (i = 1; i < l; i++)
    1791             :   {
    1792        1932 :     GEN c = gel(L,i);
    1793        1932 :     if (typ(c) == t_POLMOD && varn(gel(c,1)) == 1) P = mfsamefield(P,gel(c,1));
    1794             :   }
    1795         448 :   f = taglinear_i(t_MF_LINEAR_BHN, mf_get_NK(f), F,L);
    1796         448 :   if (degpol(P) > 1) mf_setfield(f, P);
    1797         448 :   return f;
    1798             : }
    1799             : static GEN
    1800         301 : tobasis(GEN mf, GEN F, GEN L)
    1801             : {
    1802         301 :   if (checkmf_i(L) && mf) return mftobasis(mf, L, 0);
    1803         294 :   if (typ(F) != t_VEC) pari_err_TYPE("mflinear",F);
    1804         294 :   if (!is_vec_t(typ(L))) pari_err_TYPE("mflinear",L);
    1805         294 :   if (lg(L) != lg(F)) pari_err_DIM("mflinear");
    1806         294 :   return L;
    1807             : }
    1808             : GEN
    1809         301 : mflinear(GEN F, GEN L)
    1810             : {
    1811         301 :   pari_sp av = avma;
    1812         301 :   GEN G, NK, P, mf = NULL, N = NULL, K = NULL, CHI = NULL;
    1813             :   long i, l;
    1814         301 :   if (checkMF_i(F))
    1815             :   {
    1816         224 :     mf = F; F = MF_get_basis(F);
    1817         224 :     if (space_is_cusp(MF_get_space(mf)))
    1818             :     {
    1819         161 :       GEN gk = MF_get_gk(mf);
    1820         161 :       if (typ(gk) == t_INT && itou(gk) > 1)
    1821             :       {
    1822         147 :         L = tobasis(mf, F, L);
    1823         147 :         return gerepilecopy(av, mflinear_bhn(F, L));
    1824             :       }
    1825             :     }
    1826             :   }
    1827         154 :   L = tobasis(mf, F, L);
    1828         154 :   if (!mflinear_strip(&F,&L)) return mftrivial();
    1829             : 
    1830         147 :   l = lg(F);
    1831         147 :   if (l == 2 && gequal1(gel(L,1))) return gerepilecopy(av, gel(F,1));
    1832         105 :   P = pol_x(1);
    1833         301 :   for (i = 1; i < l; i++)
    1834             :   {
    1835         203 :     GEN f = gel(F,i), c = gel(L,i), Ni, Ki;
    1836         203 :     if (!checkmf_i(f)) pari_err_TYPE("mflinear", f);
    1837         203 :     Ni = mf_get_gN(f); N = N? lcmii(N, Ni): Ni;
    1838         203 :     Ki = mf_get_gk(f);
    1839         203 :     if (!K) K = Ki;
    1840          98 :     else if (!gequal(K, Ki))
    1841           7 :       pari_err_TYPE("mflinear [different weights]", mkvec2(K,Ki));
    1842         196 :     P = mfsamefield(P, mf_get_field(f));
    1843         196 :     if (typ(c) == t_POLMOD && varn(gel(c,1)) == 1) P = mfsamefield(P, gel(c,1));
    1844             :   }
    1845          98 :   G = znstar0(N,1);
    1846         280 :   for (i = 1; i < l; i++)
    1847             :   {
    1848         189 :     GEN CHI2 = mf_get_CHI(gel(F,i));
    1849         189 :     CHI2 = induce(G, CHI2);
    1850         189 :     if (!CHI) CHI = CHI2;
    1851          91 :     else if (!gequal(CHI, CHI2))
    1852           7 :       pari_err_TYPE("mflinear [different characters]", mkvec2(CHI,CHI2));
    1853             :   }
    1854          91 :   NK = mkgNK(N, K, CHI, P);
    1855          91 :   return gerepilecopy(av, taglinear(NK,F,L));
    1856             : }
    1857             : /* F vector of forms with same weight and character but varying level, return
    1858             :  * global [N,k,chi,P] */
    1859             : static GEN
    1860        1484 : vecmfNK(GEN F)
    1861             : {
    1862        1484 :   long i, l = lg(F);
    1863             :   GEN N, f;
    1864        1484 :   if (l == 1) return mkNK(1, 0, mfchartrivial());
    1865        1484 :   f = gel(F,1); N = mf_get_gN(f);
    1866        1484 :   for (i = 2; i < l; i++) N = lcmii(N, mf_get_gN(gel(F,i)));
    1867        1484 :   return mkgNK(N, mf_get_gk(f), mf_get_CHI(f), mf_get_field(f));
    1868             : }
    1869             : /* do not use mflinear: mflineardivtomat rely on F being constant across the
    1870             :  * basis where mflinear strips the ones matched by 0 coeffs. Assume k and CHI
    1871             :  * constant, N is allowed to vary. */
    1872             : static GEN
    1873         861 : vecmflinear(GEN F, GEN C)
    1874             : {
    1875         861 :   long i, l = lg(C);
    1876         861 :   GEN NK, v = cgetg(l, t_VEC);
    1877         861 :   if (l == 1) return v;
    1878         861 :   NK = vecmfNK(F);
    1879         861 :   for (i = 1; i < l; i++) gel(v,i) = taglinear(NK, F, gel(C,i));
    1880         861 :   return v;
    1881             : }
    1882             : /* vecmflinear(F,C), then divide everything by E, which has valuation 0 */
    1883             : static GEN
    1884         182 : vecmflineardiv0(GEN F, GEN C, GEN E)
    1885             : {
    1886         182 :   GEN v = vecmflinear(F, C);
    1887         182 :   long i, l = lg(v);
    1888         182 :   for (i = 1; i < l; i++) gel(v,i) = mfdiv_val(gel(v,i), E, 0);
    1889         182 :   return v;
    1890             : }
    1891             : 
    1892             : /* Non empty linear combination of linear combinations of same
    1893             :  * F_j=\sum_i \mu_{i,j}G_i so R = \sum_i (\sum_j(\la_j\mu_{i,j})) G_i */
    1894             : static GEN
    1895         623 : mflinear_linear(GEN F, GEN L)
    1896             : {
    1897         623 :   long l = lg(F), j;
    1898         623 :   GEN vF, M = cgetg(l, t_MAT);
    1899        3808 :   for (j = 1; j < l; j++)
    1900             :   {
    1901        3185 :     GEN f = gel(F,j), c = gel(f,3), d = gel(f,4);
    1902        3185 :     if (typ(c) == t_VEC) c = shallowtrans(c);
    1903        3185 :     if (!isint1(d)) c = RgC_Rg_div(c, d);
    1904        3185 :     gel(M,j) = c;
    1905             :   }
    1906         623 :   vF = gmael(F,1,2);
    1907         623 :   return taglinear(vecmfNK(vF), vF, RgM_RgC_mul(M,L));
    1908             : }
    1909             : 
    1910             : GEN
    1911          42 : mfshift(GEN F, long sh)
    1912             : {
    1913          42 :   pari_sp av = avma;
    1914          42 :   if (!checkmf_i(F)) pari_err_TYPE("mfshift",F);
    1915          42 :   return gerepilecopy(av, tag2(t_MF_SHIFT, mf_get_NK(F), F, stoi(sh)));
    1916             : }
    1917             : static long
    1918          35 : mfval(GEN F)
    1919             : {
    1920          35 :   pari_sp av = avma;
    1921          35 :   long i = 0, n, sb;
    1922             :   GEN gk, gN;
    1923          35 :   if (!checkmf_i(F)) pari_err_TYPE("mfval", F);
    1924          35 :   gN = mf_get_gN(F);
    1925          35 :   gk = mf_get_gk(F);
    1926          35 :   sb = mfsturmNgk(itou(gN), gk);
    1927          91 :   for (n = 1; n <= sb;)
    1928             :   {
    1929             :     GEN v;
    1930          49 :     if (n > 0.5*sb) n = sb+1;
    1931          49 :     v = mfcoefs_i(F, n, 1);
    1932         105 :     for (; i <= n; i++)
    1933          84 :       if (!gequal0(gel(v, i+1))) { avma = av; return i; }
    1934          21 :     n <<= 1;
    1935             :   }
    1936           7 :   avma = av; return -1;
    1937             : }
    1938             : 
    1939             : GEN
    1940        1106 : mfdiv_val(GEN f, GEN g, long vg)
    1941             : {
    1942             :   GEN N, K, NK, CHI;
    1943        1106 :   if (vg) { f = mfshift(f,vg); g = mfshift(g,vg); }
    1944        1106 :   N = lcmii(mf_get_gN(f), mf_get_gN(g));
    1945        1106 :   K = gsub(mf_get_gk(f), mf_get_gk(g));
    1946        1106 :   CHI = mfchardiv(mf_get_CHI(f), mf_get_CHI(g));
    1947        1106 :   CHI = mfchiadjust(CHI, K, itos(N));
    1948        1106 :   NK = mkgNK(N, K, CHI, mfsamefield(mf_get_field(f), mf_get_field(g)));
    1949        1106 :   return tag2(t_MF_DIV, NK, f, g);
    1950             : }
    1951             : GEN
    1952          35 : mfdiv(GEN F, GEN G)
    1953             : {
    1954          35 :   pari_sp av = avma;
    1955          35 :   long v = mfval(G);
    1956          35 :   if (v < 0 || (v && !gequal0(mfcoefs(F, v-1, 1))))
    1957          14 :     pari_err_DOMAIN("mfdiv", "ord(G)", ">", strtoGENstr("ord(F)"),
    1958             :                     mkvec2(F, G));
    1959          21 :   return gerepilecopy(av, mfdiv_val(F, G, v));
    1960             : }
    1961             : GEN
    1962          28 : mfderiv(GEN F, long m)
    1963             : {
    1964          28 :   pari_sp av = avma;
    1965             :   GEN NK, gk;
    1966          28 :   if (!checkmf_i(F)) pari_err_TYPE("mfderiv",F);
    1967          28 :   gk = gaddgs(mf_get_gk(F), 2*m);
    1968          28 :   NK = mkgNK(mf_get_gN(F), gk, mf_get_CHI(F), mf_get_field(F));
    1969          28 :   return gerepilecopy(av, tag2(t_MF_DERIV, NK, F, stoi(m)));
    1970             : }
    1971             : GEN
    1972          21 : mfderivE2(GEN F, long m)
    1973             : {
    1974          21 :   pari_sp av = avma;
    1975             :   GEN NK, gk;
    1976          21 :   if (!checkmf_i(F)) pari_err_TYPE("mfderivE2",F);
    1977          21 :   if (m < 0) pari_err_DOMAIN("mfderivE2","m","<",gen_0,stoi(m));
    1978          21 :   gk = gaddgs(mf_get_gk(F), 2*m);
    1979          21 :   NK = mkgNK(mf_get_gN(F), gk, mf_get_CHI(F), mf_get_field(F));
    1980          21 :   return gerepilecopy(av, tag2(t_MF_DERIVE2, NK, F, stoi(m)));
    1981             : }
    1982             : 
    1983             : GEN
    1984          14 : mftwist(GEN F, GEN D)
    1985             : {
    1986          14 :   pari_sp av = avma;
    1987             :   GEN NK, CHI, NT, Da;
    1988             :   long q;
    1989          14 :   if (!checkmf_i(F)) pari_err_TYPE("mftwist", F);
    1990          14 :   if (typ(D) != t_INT) pari_err_TYPE("mftwist", D);
    1991          14 :   Da = mpabs_shallow(D);
    1992          14 :   CHI = mf_get_CHI(F); q = mfcharconductor(CHI);
    1993          14 :   NT = glcm(glcm(mf_get_gN(F), mulsi(q, Da)), sqri(Da));
    1994          14 :   NK = mkgNK(NT, mf_get_gk(F), CHI, mf_get_field(F));
    1995          14 :   return gerepilecopy(av, tag2(t_MF_TWIST, NK, F, D));
    1996             : }
    1997             : 
    1998             : /***************************************************************/
    1999             : /*                 Generic cache handling                      */
    2000             : /***************************************************************/
    2001             : enum { cache_FACT, cache_DIV, cache_H, cache_D, cache_DIH };
    2002             : typedef struct {
    2003             :   const char *name;
    2004             :   GEN cache;
    2005             :   ulong minself;
    2006             :   ulong maxself;
    2007             :   void (*init)(long);
    2008             :   ulong miss;
    2009             :   ulong maxmiss;
    2010             : } cache;
    2011             : 
    2012             : static void constfact(long lim);
    2013             : static void constdiv(long lim);
    2014             : static void consttabh(long lim);
    2015             : static void consttabdihedral(long lim);
    2016             : static void constcoredisc(long lim);
    2017             : static THREAD cache caches[] = {
    2018             : { "Factors",  NULL,  50000,    50000, &constfact, 0, 0 },
    2019             : { "Divisors", NULL,  50000,    50000, &constdiv, 0, 0 },
    2020             : { "H",        NULL, 100000, 10000000, &consttabh, 0, 0 },
    2021             : { "CorediscF",NULL, 100000, 10000000, &constcoredisc, 0, 0 },
    2022             : { "Dihedral", NULL,   1000,     3000, &consttabdihedral, 0, 0 },
    2023             : };
    2024             : 
    2025             : static void
    2026         259 : cache_reset(long id) { caches[id].miss = caches[id].maxmiss = 0; }
    2027             : static void
    2028        6144 : cache_delete(long id) { if (caches[id].cache) gunclone(caches[id].cache); }
    2029             : static void
    2030         266 : cache_set(long id, GEN S)
    2031             : {
    2032         266 :   GEN old = caches[id].cache;
    2033         266 :   caches[id].cache = gclone(S);
    2034         266 :   if (old) gunclone(old);
    2035         266 : }
    2036             : 
    2037             : /* handle a cache miss: store stats, possibly reset table; return value
    2038             :  * if (now) cached; return NULL on failure. HACK: some caches contain an
    2039             :  * ulong where the 0 value is impossible, and return it (typecase to GEN) */
    2040             : static GEN
    2041   143219085 : cache_get(long id, ulong D)
    2042             : {
    2043   143219085 :   cache *S = &caches[id];
    2044             :   /* cache_H is compressed: D=0,1 mod 4 */
    2045   143219085 :   const ulong d = (id == cache_H)? D>>1: D;
    2046             :   ulong max, l;
    2047             : 
    2048   143219085 :   if (!S->cache)
    2049             :   {
    2050         140 :     max = maxuu(minuu(D, S->maxself), S->minself);
    2051         140 :     S->init(max);
    2052         140 :     l = lg(S->cache);
    2053             :   }
    2054             :   else
    2055             :   {
    2056   143218945 :     l = lg(S->cache);
    2057   143218945 :     if (l <= d)
    2058             :     {
    2059         861 :       if (D > S->maxmiss) S->maxmiss = D;
    2060         861 :       if (DEBUGLEVEL >= 3)
    2061           0 :         err_printf("miss in cache %s: %lu, max = %lu\n",
    2062             :                    S->name, D, S->maxmiss);
    2063         861 :       if (S->miss++ >= 5 && D < S->maxself)
    2064             :       {
    2065          77 :         max = minuu(S->maxself, (long)(S->maxmiss * 1.2));
    2066          77 :         if (max <= S->maxself)
    2067             :         {
    2068          77 :           if (DEBUGLEVEL >= 3)
    2069           0 :             err_printf("resetting cache %s to %lu\n", S->name, max);
    2070          77 :           S->init(max); l = lg(S->cache);
    2071             :         }
    2072             :       }
    2073             :     }
    2074             :   }
    2075   143219085 :   return (l <= d)? NULL: gel(S->cache, d);
    2076             : }
    2077             : static GEN
    2078          70 : cache_report(long id)
    2079             : {
    2080          70 :   cache *S = &caches[id];
    2081          70 :   GEN v = zerocol(5);
    2082          70 :   gel(v,1) = strtoGENstr(S->name);
    2083          70 :   if (S->cache)
    2084             :   {
    2085          35 :     gel(v,2) = utoi(lg(S->cache)-1);
    2086          35 :     gel(v,3) = utoi(S->miss);
    2087          35 :     gel(v,4) = utoi(S->maxmiss);
    2088          35 :     gel(v,5) = utoi(gsizebyte(S->cache));
    2089             :   }
    2090          70 :   return v;
    2091             : }
    2092             : GEN
    2093          14 : getcache(void)
    2094             : {
    2095          14 :   pari_sp av = avma;
    2096          14 :   GEN M = cgetg(6, t_MAT);
    2097          14 :   gel(M,1) = cache_report(cache_FACT);
    2098          14 :   gel(M,2) = cache_report(cache_DIV);
    2099          14 :   gel(M,3) = cache_report(cache_H);
    2100          14 :   gel(M,4) = cache_report(cache_D);
    2101          14 :   gel(M,5) = cache_report(cache_DIH);
    2102          14 :   return gerepilecopy(av, shallowtrans(M));
    2103             : }
    2104             : 
    2105             : void
    2106        1536 : pari_close_mf(void)
    2107             : {
    2108        1536 :   cache_delete(cache_DIH);
    2109        1536 :   cache_delete(cache_DIV);
    2110        1536 :   cache_delete(cache_FACT);
    2111        1536 :   cache_delete(cache_H);
    2112        1536 : }
    2113             : 
    2114             : /*************************************************************************/
    2115             : static void
    2116          56 : constcoredisc(long lim)
    2117             : {
    2118          56 :   pari_sp av2, av = avma;
    2119          56 :   const long cachestep = 1000; /* don't increase this: RAM cache thrashing */
    2120          56 :   GEN D = caches[cache_D].cache, CACHE = NULL;
    2121          56 :   long cachea, cacheb, N, LIM = !D ? 4 : lg(D)-1;
    2122          56 :   if (lim <= 0) lim = 5;
    2123         112 :   if (lim <= LIM) return;
    2124          56 :   cache_reset(cache_D);
    2125          56 :   D = zero_zv(lim);
    2126          56 :   av2 = avma;
    2127          56 :   cachea = cacheb = 0;
    2128    16234329 :   for (N = 1; N <= lim; ++N)
    2129             :   {
    2130             :     GEN F;
    2131    16234273 :     if (N > cacheb)
    2132             :     { /* update local cache (recycle memory) */
    2133       16184 :       cachea = N;
    2134       16184 :       if (cachea + 2*cachestep > lim)
    2135          56 :         cacheb = lim; /* fuse last 2 chunks */
    2136             :       else
    2137       16128 :         cacheb = cachea + cachestep;
    2138       16184 :       avma = av2; /* FIXME: need only factor odd integers in the range */
    2139       16184 :       CACHE = vecfactoru_i(cachea, cacheb);
    2140             :     }
    2141    16234273 :     F = gel(CACHE,N - cachea + 1); /* factoru(N) */
    2142    16234273 :     D[N] = corediscs_fact(F);
    2143             :   }
    2144          56 :   cache_set(cache_D, D);
    2145          56 :   avma = av;
    2146             : }
    2147             : 
    2148             : static void
    2149          49 : constfact(long lim)
    2150             : {
    2151             :   pari_sp av;
    2152          49 :   GEN VFACT = caches[cache_FACT].cache;
    2153          49 :   long LIM = VFACT? lg(VFACT)-1: 4;
    2154          49 :   if (lim <= 0) lim = 5;
    2155          98 :   if (lim <= LIM) return;
    2156          49 :   cache_reset(cache_FACT); av = avma;
    2157          49 :   cache_set(cache_FACT, vecfactoru_i(1,lim)); avma = av;
    2158             : }
    2159             : static void
    2160          49 : constdiv(long lim)
    2161             : {
    2162             :   pari_sp av;
    2163          49 :   GEN VFACT, VDIV = caches[cache_DIV].cache;
    2164          49 :   long N, LIM = VDIV? lg(VDIV)-1: 4;
    2165          49 :   if (lim <= 0) lim = 5;
    2166          98 :   if (lim <= LIM) return;
    2167          49 :   constfact(lim);
    2168          49 :   VFACT = caches[cache_FACT].cache;
    2169          49 :   cache_reset(cache_DIV); av = avma;
    2170          49 :   VDIV  = cgetg(lim+1, t_VEC);
    2171          49 :   for (N = 1; N <= lim; N++) gel(VDIV,N) = divisorsu_fact(gel(VFACT,N));
    2172          49 :   cache_set(cache_DIV, VDIV); avma = av;
    2173             : }
    2174             : 
    2175             : /* n > 1, D = divisors(n); sets L = 2*lambda(n), S = sigma(n) */
    2176             : static void
    2177     9063342 : lamsig(GEN D, long *pL, long *pS)
    2178             : {
    2179     9063342 :   pari_sp av = avma;
    2180     9063342 :   long i, l = lg(D), L = 1, S = D[l-1]+1;
    2181    33068094 :   for (i = 2; i < l; i++) /* skip d = 1 */
    2182             :   {
    2183    33068094 :     long d = D[i], nd = D[l-i]; /* nd = n/d */
    2184    33068094 :     if (d < nd) { L += d; S += d + nd; }
    2185             :     else
    2186             :     {
    2187     9063342 :       L <<= 1; if (d == nd) { L += d; S += d; }
    2188     9063342 :       break;
    2189             :     }
    2190             :   }
    2191     9063342 :   avma = av; *pL = L; *pS = S;
    2192     9063342 : }
    2193             : /* table of 6 * Hurwitz class numbers D <= lim */
    2194             : static void
    2195         105 : consttabh(long lim)
    2196             : {
    2197         105 :   pari_sp av = avma;
    2198         105 :   GEN VHDH0, VDIV, CACHE = NULL;
    2199         105 :   GEN VHDH = caches[cache_H].cache;
    2200         105 :   const long cachestep = 1000; /* don't increase this: RAM cache thrashing */
    2201         105 :   long r, N, cachea, cacheb, lim0 = VHDH? lg(VHDH)-1: 2, LIM = lim0 << 1;
    2202             : 
    2203         105 :   if (lim <= 0) lim = 5;
    2204         210 :   if (lim <= LIM) return;
    2205         105 :   cache_reset(cache_H);
    2206         105 :   r = lim&3L; if (r) lim += 4-r;
    2207         105 :   cache_get(cache_DIV, lim);
    2208         105 :   VDIV = caches[cache_DIV].cache;
    2209         105 :   VHDH0 = cgetg_block(lim/2 + 1, t_VECSMALL);
    2210         105 :   VHDH0[1] = 2;
    2211         105 :   VHDH0[2] = 3;
    2212         105 :   for (N = 3; N <= lim0; N++) VHDH0[N] = VHDH[N];
    2213         105 :   cachea = cacheb = 0;
    2214     4531776 :   for (N = LIM + 3; N <= lim; N += 4)
    2215             :   {
    2216     4531671 :     long s = 0, limt = usqrt(N>>2), flsq = 0, ind, t, L, S;
    2217             :     GEN DN, DN2;
    2218     4531671 :     if (N + 2 >= lg(VDIV))
    2219             :     {
    2220             :       GEN F;
    2221     3919269 :       if (N + 2 > cacheb)
    2222             :       { /* update local cache (recycle memory) */
    2223       15643 :         cachea = N;
    2224       15643 :         if (cachea + 2*cachestep > lim)
    2225         105 :           cacheb = lim+2; /* fuse last 2 chunks */
    2226             :         else
    2227       15538 :           cacheb = cachea + cachestep;
    2228       15643 :         avma = av; /* FIXME: need only factor odd integers in the range */
    2229       15643 :         CACHE = vecfactoru_i(cachea, cacheb);
    2230             :       }
    2231             :       /* use local cache */
    2232     3919269 :       F = gel(CACHE,N - cachea + 1); /* factoru(N) */
    2233     3919269 :       DN = divisorsu_fact(F);
    2234     3919269 :       F = gel(CACHE,N - cachea + 3); /* factoru(N+2) */
    2235     3919269 :       DN2 = divisorsu_fact(F);
    2236             :     }
    2237             :     else
    2238             :     { /* use global cache */
    2239      612402 :       DN = gel(VDIV,N);
    2240      612402 :       DN2 = gel(VDIV,N+2);
    2241             :     }
    2242     4531671 :     ind = N >> 1;
    2243  1068829174 :     for (t = 1; t <= limt; t++)
    2244             :     {
    2245  1064297503 :       ind -= (t<<2)-2; /* N/2 - 2t^2 */
    2246  1064297503 :       if (ind) s += VHDH0[ind]; else flsq = 1;
    2247             :     }
    2248     4531671 :     lamsig(DN, &L,&S);
    2249     4531671 :     VHDH0[N >> 1] = 2*S - 3*L - 2*s + flsq;
    2250     4531671 :     s = 0; flsq = 0; limt = (usqrt(N+2) - 1) >> 1;
    2251     4531671 :     ind = (N+1) >> 1;
    2252  1066581561 :     for (t = 1; t <= limt; t++)
    2253             :     {
    2254  1062049890 :       ind -= t<<2; /* (N+1)/2 - 2t(t+1) */
    2255  1062049890 :       if (ind) s += VHDH0[ind]; else flsq = 1;
    2256             :     }
    2257     4531671 :     lamsig(DN2, &L,&S);
    2258     4531671 :     VHDH0[(N+1) >> 1] = S - 3*(L >> 1) - s - flsq;
    2259             :   }
    2260         105 :   cache_set(cache_H, VHDH0); avma = av;
    2261             : }
    2262             : 
    2263             : /*************************************************************************/
    2264             : /* Core functions using factorizations, divisors of class numbers caches */
    2265             : /* TODO: myfactoru and factorization cache should be exported */
    2266             : static GEN
    2267    13547702 : myfactoru(long N)
    2268             : {
    2269    13547702 :   GEN z = cache_get(cache_FACT, N);
    2270    13547702 :   return z? gcopy(z): factoru(N);
    2271             : }
    2272             : static GEN
    2273    29246042 : mydivisorsu(long N)
    2274             : {
    2275    29246042 :   GEN z = cache_get(cache_DIV, N);
    2276    29246042 :   return z? leafcopy(z): divisorsu(N);
    2277             : }
    2278             : /* write -n = Df^2, D < 0 fundamental discriminant. Return D, set f. */
    2279             : static long
    2280    51985346 : mycoredisc2neg(ulong n, long *pf)
    2281             : {
    2282    51985346 :   ulong m, D = (ulong)cache_get(cache_D, n);
    2283    51985346 :   if (D) { *pf = usqrt(n/D); return -(long)D; }
    2284         161 :   m = mycore(n, pf);
    2285         161 :   if ((m&3) != 3) { m <<= 2; *pf >>= 1; }
    2286         161 :   return (long)-m;
    2287             : }
    2288             : /* write n = Df^2, D > 0 fundamental discriminant. Return D, set f. */
    2289             : static long
    2290          14 : mycoredisc2pos(ulong n, long *pf)
    2291             : {
    2292          14 :   ulong m = mycore(n, pf);
    2293          14 :   if ((m&3) != 1) { m <<= 2; *pf >>= 1; }
    2294          14 :   return (long)m;
    2295             : }
    2296             : 
    2297             : /* 1+p+...+p^e, e >= 1 */
    2298             : static ulong
    2299          56 : usumpow(ulong p, long e)
    2300             : {
    2301          56 :   ulong q = 1+p;
    2302             :   long i;
    2303          56 :   for (i = 1; i < e; i++) q = p*q + 1;
    2304          56 :   return q;
    2305             : }
    2306             : /* Hurwitz(D0 F^2)/ Hurwitz(D0)
    2307             :  * = \sum_{f|F}  f \prod_{p|f} (1-kro(D0/p)/p)
    2308             :  * = \prod_{p^e || F} (1 + (p^e-1) / (p-1) * (p-kro(D0/p))) */
    2309             : static long
    2310         259 : get_sh(long F, long D0)
    2311             : {
    2312         259 :   GEN fa = myfactoru(F), P = gel(fa,1), E = gel(fa,2);
    2313         259 :   long i, l = lg(P), t = 1;
    2314         682 :   for (i = 1; i < l; i++)
    2315             :   {
    2316         423 :     long p = P[i], e = E[i], s = kross(D0,p);
    2317         423 :     if (e == 1) { t *= 1 + p - s; continue; }
    2318         139 :     if (s == 1) { t *= upowuu(p,e); continue; }
    2319          56 :     t *= 1 + usumpow(p,e-1)*(p-s);
    2320             :   }
    2321         259 :   return t;
    2322             : }
    2323             : /* d > 0, d = 0,3 (mod 4). Return 6*hclassno(d); -d must be fundamental
    2324             :  * Faster than quadclassunit up to 5*10^5 or so */
    2325             : static ulong
    2326          42 : hclassno6u_count(ulong d)
    2327             : {
    2328          42 :   ulong a, b, b2, h = 0;
    2329          42 :   int f = 0;
    2330             : 
    2331          42 :   if (d > 500000)
    2332           7 :     return 6 * itou(gel(quadclassunit0(utoineg(d), 0, NULL, 0), 1));
    2333             : 
    2334             :   /* this part would work with -d non fundamental */
    2335          35 :   b = d&1; b2 = (1+d)>>2;
    2336          35 :   if (!b)
    2337             :   {
    2338           0 :     for (a=1; a*a<b2; a++)
    2339           0 :       if (b2%a == 0) h++;
    2340           0 :     f = (a*a==b2); b=2; b2=(4+d)>>2;
    2341             :   }
    2342        7168 :   while (b2*3 < d)
    2343             :   {
    2344        7098 :     if (b2%b == 0) h++;
    2345     1188551 :     for (a=b+1; a*a < b2; a++)
    2346     1181453 :       if (b2%a == 0) h += 2;
    2347        7098 :     if (a*a == b2) h++;
    2348        7098 :     b += 2; b2 = (b*b+d)>>2;
    2349             :   }
    2350          35 :   if (b2*3 == d) return 6*h+2;
    2351          35 :   if (f) return 6*h+3;
    2352          35 :   return 6*h;
    2353             : }
    2354             : /* D > 0; 6 * hclassno(D), using D = D0*F^2 */
    2355             : static long
    2356         301 : hclassno6u_2(ulong D, long D0, long F)
    2357             : {
    2358             :   long h;
    2359         301 :   if (F == 1) h = hclassno6u_count(D);
    2360             :   else
    2361             :   { /* second chance */
    2362         259 :     h = (ulong)cache_get(cache_H, -D0);
    2363         259 :     if (!h) h = hclassno6u_count(-D0);
    2364         259 :     h *= get_sh(F,D0);
    2365             :   }
    2366         301 :   return h;
    2367             : }
    2368             : /* D > 0; 6 * hclassno(D) (6*Hurwitz). Beware, cached value for D (=0,3 mod 4)
    2369             :  * is stored at D>>1 */
    2370             : ulong
    2371      154170 : hclassno6u(ulong D)
    2372             : {
    2373      154170 :   ulong z = (ulong)cache_get(cache_H, D);
    2374             :   long D0, F;
    2375      154170 :   if (z) return z;
    2376         301 :   D0 = mycoredisc2neg(D, &F);
    2377         301 :   return hclassno6u_2(D,D0,F);
    2378             : }
    2379             : /* same, where the decomposition D = D0*F^2 is already known */
    2380             : static ulong
    2381    44274580 : hclassno6u_i(ulong D, long D0, long F)
    2382             : {
    2383    44274580 :   ulong z = (ulong)cache_get(cache_H, D);
    2384    44274580 :   if (z) return z;
    2385           0 :   return hclassno6u_2(D,D0,F);
    2386             : }
    2387             : 
    2388             : #if 0
    2389             : /* D > 0, return h(-D) [ordinary class number].
    2390             :  * Assume consttabh(D or more) was previously called */
    2391             : static long
    2392             : hfromH(long D)
    2393             : {
    2394             :   pari_sp ltop = avma;
    2395             :   GEN m, d, fa = myfactoru(D), P = gel(fa,1), E = gel(fa,2);
    2396             :   GEN VH = caches[cache_H].cache;
    2397             :   long i, nd, S, l = lg(P);
    2398             : 
    2399             :   /* n = d[i] loops through squarefree divisors of f, where f^2 = largest square
    2400             :    * divisor of N = |D|; m[i] = moebius(n) */
    2401             :   nd = 1 << (l-1);
    2402             :   d = cgetg(nd+1, t_VECSMALL);
    2403             :   m = cgetg(nd+1, t_VECSMALL);
    2404             :   d[1] = 1; S = VH[D >> 1]; /* 6 hclassno(-D) */
    2405             :   m[1] = 1; nd = 1;
    2406             :   i = 1;
    2407             :   if (P[1] == 2 && E[1] <= 3) /* need D/n^2 to be a discriminant */
    2408             :   { if (odd(E[1]) || (E[1] == 2 && (D & 15) == 4)) i = 2; }
    2409             :   for (; i<l; i++)
    2410             :   {
    2411             :     long j, p = P[i];
    2412             :     if (E[i] == 1) continue;
    2413             :     for (j=1; j<=nd; j++)
    2414             :     {
    2415             :       long n, s, hn;
    2416             :       d[nd+j] = n = d[j] * p;
    2417             :       m[nd+j] = s = - m[j]; /* moebius(n) */
    2418             :       hn = VH[(D/(n*n)) >> 1]; /* 6 hclassno(-D/n^2) */
    2419             :       if (s > 0) S += hn; else S -= hn;
    2420             :     }
    2421             :     nd <<= 1;
    2422             :   }
    2423             :   avma = ltop; return S/6;
    2424             : }
    2425             : #endif
    2426             : /* D < -4 fundamental, h(D), ordinary class number */
    2427             : static long
    2428     3988068 : myh(long D)
    2429             : {
    2430     3988068 :   ulong z = (ulong)cache_get(cache_H, -D);
    2431     3988068 :   if (z) return z/6; /* should be hfromH(-D) if D non-fundamental */
    2432           0 :   return itou(quadclassno(stoi(D)));
    2433             : }
    2434             : 
    2435             : /*************************************************************************/
    2436             : /*                          TRACE FORMULAS                               */
    2437             : /* CHIP primitive, initialize for t_POLMOD output */
    2438             : static GEN
    2439       25242 : mfcharinit(GEN CHIP)
    2440             : {
    2441       25242 :   long n, o, l, vt, N = mfcharmodulus(CHIP);
    2442             :   GEN c, v, V, G, Pn;
    2443       25242 :   if (N == 1) return mkvec2(mkvec(gen_1), pol_x(0));
    2444        3318 :   G = gel(CHIP,1);
    2445        3318 :   v = ncharvecexpo(G, znconrey_normalized(G, gel(CHIP,2)));
    2446        3318 :   l = lg(v); V = cgetg(l, t_VEC);
    2447        3318 :   o = mfcharorder(CHIP);
    2448        3318 :   Pn = mfcharpol(CHIP); vt = varn(Pn);
    2449        3318 :   if (o <= 2)
    2450             :   {
    2451       24199 :     for (n = 1; n < l; n++)
    2452             :     {
    2453       21861 :       if (v[n] < 0) c = gen_0; else c = v[n]? gen_m1: gen_1;
    2454       21861 :       gel(V,n) = c;
    2455             :     }
    2456             :   }
    2457             :   else
    2458             :   {
    2459       17591 :     for (n = 1; n < l; n++)
    2460             :     {
    2461       16611 :       if (v[n] < 0) c = gen_0;
    2462             :       else
    2463             :       {
    2464        8456 :         c = mygmodulo_lift(v[n], o, gen_1, vt);
    2465        8456 :         if (typ(c) == t_POL && lg(c) >= lg(Pn)) c = RgX_rem(c, Pn);
    2466             :       }
    2467       16611 :       gel(V,n) = c;
    2468             :     }
    2469             :   }
    2470        3318 :   return mkvec2(V, Pn);
    2471             : }
    2472             : static GEN
    2473      279048 : vchip_lift(GEN VCHI, long x, GEN C)
    2474             : {
    2475      279048 :   GEN V = gel(VCHI,1);
    2476      279048 :   long F = lg(V)-1;
    2477      279048 :   if (F == 1) return C;
    2478        5131 :   x %= F;
    2479        5131 :   if (!x) return C;
    2480        5131 :   if (x <= 0) x += F;
    2481        5131 :   return gmul(C, gel(V, x));
    2482             : }
    2483             : static long
    2484    75281878 : vchip_FC(GEN VCHI) { return lg(gel(VCHI,1))-1; }
    2485             : static GEN
    2486     2905609 : vchip_mod(GEN VCHI, GEN S)
    2487     2905609 : { return (typ(S) == t_POL)? RgX_rem(S, gel(VCHI,2)): S; }
    2488             : static GEN
    2489      976934 : vchip_polmod(GEN VCHI, GEN S)
    2490      976934 : { return (typ(S) == t_POL)? mkpolmod(S, gel(VCHI,2)): S; }
    2491             : 
    2492             : /* ceil(m/d) */
    2493             : static long
    2494      101500 : ceildiv(long m, long d)
    2495             : {
    2496             :   long q;
    2497      101500 :   if (!m) return 0;
    2498       39662 :   q = m/d; return m%d? q+1: q;
    2499             : }
    2500             : 
    2501             : /* contribution of scalar matrices in dimension formula */
    2502             : static GEN
    2503      222453 : A1(long N, long k)
    2504      222453 : { return sstoQ(mypsiu(N)*(k-1), 12); }
    2505             : static long
    2506        8736 : ceilA1(long N, long k)
    2507        8736 : { return ceildiv(mypsiu(N) * (k-1), 12); }
    2508             : 
    2509             : /* sturm bound, slightly larger than dimension */
    2510             : long
    2511       26026 : mfsturmNk(long N, long k) { return 1 + (mypsiu(N)*k)/12; }
    2512             : long
    2513         742 : mfsturmNgk(long N, GEN k)
    2514             : {
    2515         742 :   long n,d; Qtoss(k,&n,&d);
    2516         742 :   return (d == 1)? mfsturmNk(N,n): 1 + (mypsiu(N)*n)/24;
    2517             : }
    2518             : 
    2519             : /* List of all solutions of x^2 + x + 1 = 0 modulo N, x modulo N */
    2520             : static GEN
    2521         427 : sqrtm3modN(long N)
    2522             : {
    2523             :   pari_sp av;
    2524             :   GEN fa, P, E, B, mB, A, Q, T, R, v, gen_m3;
    2525         427 :   long l, i, n, ct, fl3 = 0, Ninit;
    2526         427 :   if (!odd(N) || (N%9) == 0) return cgetg(1,t_VECSMALL);
    2527         399 :   Ninit = N;
    2528         399 :   if ((N%3) == 0) { N /= 3; fl3 = 1; }
    2529         399 :   fa = myfactoru(N); P = gel(fa, 1); E = gel(fa, 2);
    2530         399 :   l = lg(P);
    2531         553 :   for (i = 1; i < l; i++)
    2532         406 :     if ((P[i]%3) == 2) return cgetg(1,t_VECSMALL);
    2533         147 :   A = cgetg(l, t_VECSMALL);
    2534         147 :   B = cgetg(l, t_VECSMALL);
    2535         147 :   mB= cgetg(l, t_VECSMALL);
    2536         147 :   Q = cgetg(l, t_VECSMALL); gen_m3 = utoineg(3);
    2537         301 :   for (i = 1; i < l; i++)
    2538             :   {
    2539         154 :     long p = P[i], e = E[i];
    2540         154 :     Q[i] = upowuu(p,e);
    2541         154 :     B[i] = itou( Zp_sqrt(gen_m3, utoipos(p), e) );
    2542         154 :     mB[i]= Q[i] - B[i];
    2543             :   }
    2544         147 :   ct = 1 << (l-1);
    2545         147 :   T = ZV_producttree(Q);
    2546         147 :   R = ZV_chinesetree(Q,T);
    2547         147 :   v = cgetg(ct+1, t_VECSMALL);
    2548         147 :   av = avma;
    2549         455 :   for (n = 1; n <= ct; n++)
    2550             :   {
    2551         308 :     long m = n-1, r;
    2552         644 :     for (i = 1; i < l; i++)
    2553             :     {
    2554         336 :       A[i] = (m&1L)? mB[i]: B[i];
    2555         336 :       m >>= 1;
    2556             :     }
    2557         308 :     r = itou( ZV_chinese_tree(A, Q, T, R) );
    2558         308 :     if (fl3) while (r%3) r += N;
    2559         308 :     avma = av; v[n] = odd(r) ? (r-1) >> 1 : (r+Ninit-1) >> 1;
    2560             :   }
    2561         147 :   return v;
    2562             : }
    2563             : 
    2564             : /* number of elliptic points of order 3 in X0(N) */
    2565             : static long
    2566        9044 : nu3(long N)
    2567             : {
    2568             :   long i, l;
    2569             :   GEN P;
    2570        9044 :   if (!odd(N) || (N%9) == 0) return 0;
    2571        8043 :   if ((N%3) == 0) N /= 3;
    2572        8043 :   P = gel(myfactoru(N), 1); l = lg(P);
    2573        8043 :   for (i = 1; i < l; i++) if ((P[i]%3) == 2) return 0;
    2574        3500 :   return 1L<<(l-1);
    2575             : }
    2576             : /* number of elliptic points of order 2 in X0(N) */
    2577             : static long
    2578       15512 : nu2(long N)
    2579             : {
    2580             :   long i, l;
    2581             :   GEN P;
    2582       15512 :   if ((N&3L) == 0) return 0;
    2583       15512 :   if (!odd(N)) N >>= 1;
    2584       15512 :   P = gel(myfactoru(N), 1); l = lg(P);
    2585       15512 :   for (i = 1; i < l; i++) if ((P[i]&3L) == 3) return 0;
    2586        3472 :   return 1L<<(l-1);
    2587             : }
    2588             : 
    2589             : /* contribution of elliptic matrices of order 3 in dimension formula
    2590             :  * Only depends on CHIP the primitive char attached to CHI */
    2591             : static GEN
    2592       36918 : A21(long N, long k, GEN CHI)
    2593             : {
    2594             :   GEN res, G, chi, o;
    2595             :   long a21, i, limx, S;
    2596       36918 :   if ((N&1L) == 0) return gen_0;
    2597       18417 :   a21 = k%3 - 1;
    2598       18417 :   if (!a21) return gen_0;
    2599       18074 :   if (N <= 3) return sstoQ(a21, 3);
    2600        9471 :   if (!CHI) return sstoQ(nu3(N) * a21, 3);
    2601         427 :   res = sqrtm3modN(N); limx = (N - 1) >> 1;
    2602         427 :   G = gel(CHI,1); chi = gel(CHI,2);
    2603         427 :   o = gmfcharorder(CHI);
    2604         735 :   for (S = 0, i = 1; i < lg(res); i++)
    2605             :   { /* (x,N) = 1; S += chi(x) + chi(x^2) */
    2606         308 :     long x = res[i];
    2607         308 :     if (x <= limx)
    2608             :     { /* CHI(x)=e(c/o), 3rd-root of 1 */
    2609         154 :       GEN c = znchareval(G, chi, utoi(x), o);
    2610         154 :       if (!signe(c)) S += 2; else S--;
    2611             :     }
    2612             :   }
    2613         427 :   return sstoQ(a21 * S, 3);
    2614             : }
    2615             : 
    2616             : /* List of all square roots of -1 modulo N */
    2617             : static GEN
    2618         455 : sqrtm1modN(long N)
    2619             : {
    2620             :   pari_sp av;
    2621             :   GEN fa, P, E, B, mB, A, Q, T, R, v;
    2622         455 :   long l, i, n, ct, fleven = 0;
    2623         455 :   if ((N&3L) == 0) return cgetg(1,t_VECSMALL);
    2624         455 :   if ((N&1L) == 0) { N >>= 1; fleven = 1; }
    2625         455 :   fa = myfactoru(N); P = gel(fa,1); E = gel(fa,2);
    2626         455 :   l = lg(P);
    2627         742 :   for (i = 1; i < l; i++)
    2628         525 :     if ((P[i]&3L) == 3) return cgetg(1,t_VECSMALL);
    2629         217 :   A = cgetg(l, t_VECSMALL);
    2630         217 :   B = cgetg(l, t_VECSMALL);
    2631         217 :   mB= cgetg(l, t_VECSMALL);
    2632         217 :   Q = cgetg(l, t_VECSMALL);
    2633         448 :   for (i = 1; i < l; i++)
    2634             :   {
    2635         231 :     long p = P[i], e = E[i];
    2636         231 :     Q[i] = upowuu(p,e);
    2637         231 :     B[i] = itou( Zp_sqrt(gen_m1, utoipos(p), e) );
    2638         231 :     mB[i]= Q[i] - B[i];
    2639             :   }
    2640         217 :   ct = 1 << (l-1);
    2641         217 :   T = ZV_producttree(Q);
    2642         217 :   R = ZV_chinesetree(Q,T);
    2643         217 :   v = cgetg(ct+1, t_VECSMALL);
    2644         217 :   av = avma;
    2645         679 :   for (n = 1; n <= ct; n++)
    2646             :   {
    2647         462 :     long m = n-1, r;
    2648         980 :     for (i = 1; i < l; i++)
    2649             :     {
    2650         518 :       A[i] = (m&1L)? mB[i]: B[i];
    2651         518 :       m >>= 1;
    2652             :     }
    2653         462 :     r = itou( ZV_chinese_tree(A, Q, T, R) );
    2654         462 :     if (fleven && !odd(r)) r += N;
    2655         462 :     avma = av; v[n] = r;
    2656             :   }
    2657         217 :   return v;
    2658             : }
    2659             : 
    2660             : /* contribution of elliptic matrices of order 4 in dimension formula.
    2661             :  * Only depends on CHIP the primitive char attached to CHI */
    2662             : static GEN
    2663       36918 : A22(long N, long k, GEN CHI)
    2664             : {
    2665             :   GEN G, chi, o, res;
    2666             :   long S, a22, i, limx, o2;
    2667       36918 :   if ((N&3L) == 0) return gen_0;
    2668       26411 :   a22 = (k & 3L) - 1; /* (k % 4) - 1 */
    2669       26411 :   if (!a22) return gen_0;
    2670       26411 :   if (N <= 2) return sstoQ(a22, 4);
    2671       16163 :   if (!CHI) return sstoQ(nu2(N)*a22, 4);
    2672         651 :   if (mfcharparity(CHI) == -1) return gen_0;
    2673         455 :   res = sqrtm1modN(N); limx = (N - 1) >> 1;
    2674         455 :   G = gel(CHI,1); chi = gel(CHI,2);
    2675         455 :   o = gmfcharorder(CHI);
    2676         455 :   o2 = itou(o)>>1;
    2677         917 :   for (S = 0, i = 1; i < lg(res); i++)
    2678             :   { /* (x,N) = 1, S += real(chi(x)) */
    2679         462 :     long x = res[i];
    2680         462 :     if (x <= limx)
    2681             :     { /* CHI(x)=e(c/o), 4th-root of 1 */
    2682         231 :       long c = itou( znchareval(G, chi, utoi(x), o) );
    2683         231 :       if (!c) S++; else if (c == o2) S--;
    2684             :     }
    2685             :   }
    2686         455 :   return sstoQ(a22 * S, 2);
    2687             : }
    2688             : 
    2689             : /* sumdiv(N,d,eulerphi(gcd(d,N/d))) */
    2690             : static long
    2691       33929 : nuinf(long N)
    2692             : {
    2693       33929 :   GEN fa = myfactoru(N), P = gel(fa,1), E = gel(fa,2);
    2694       33929 :   long i, t = 1, l = lg(P);
    2695       72380 :   for (i=1; i<l; i++)
    2696             :   {
    2697       38451 :     long p = P[i], e = E[i];
    2698       38451 :     if (odd(e))
    2699       30961 :       t *= upowuu(p,e>>1) << 1;
    2700             :     else
    2701        7490 :       t *= upowuu(p,(e>>1)-1) * (p+1);
    2702             :   }
    2703       33929 :   return t;
    2704             : }
    2705             : 
    2706             : /* contribution of hyperbolic matrices in dimension formula */
    2707             : static GEN
    2708       37156 : A3(long N, long FC)
    2709             : {
    2710             :   long i, S, NF, l;
    2711             :   GEN D;
    2712       37156 :   if (FC == 1) return sstoQ(nuinf(N),2);
    2713        3227 :   D = mydivisorsu(N); l = lg(D);
    2714        3227 :   S = 0; NF = N/FC;
    2715       25501 :   for (i = 1; i < l; i++)
    2716             :   {
    2717       22274 :     long g = cgcd(D[i], D[l-i]);
    2718       22274 :     if (NF%g == 0) S += myeulerphiu(g);
    2719             :   }
    2720        3227 :   return sstoQ(S, 2);
    2721             : }
    2722             : 
    2723             : /* special contribution in weight 2 in dimension formula */
    2724             : static long
    2725       36729 : A4(long k, long FC)
    2726       36729 : { return (k==2 && FC==1)? 1: 0; }
    2727             : /* gcd(x,N) */
    2728             : static long
    2729    85319108 : myugcd(GEN GCD, ulong x)
    2730             : {
    2731    85319108 :   ulong N = lg(GCD)-1;
    2732    85319108 :   if (x >= N) x %= N;
    2733    85319108 :   return GCD[x+1];
    2734             : }
    2735             : /* 1_{gcd(x,N) = 1} * chi(x), return NULL if 0 */
    2736             : static GEN
    2737   116296712 : mychicgcd(GEN GCD, GEN VCHI, long x)
    2738             : {
    2739   116296712 :   long N = lg(GCD)-1;
    2740   116296712 :   if (N == 1) return gen_1;
    2741    89455107 :   x = smodss(x, N);
    2742    89455107 :   if (GCD[x+1] != 1) return NULL;
    2743    72279725 :   x %= vchip_FC(VCHI); if (!x) return gen_1;
    2744     1014951 :   return gel(gel(VCHI,1), x);
    2745             : }
    2746             : 
    2747             : /* contribution of scalar matrices to trace formula */
    2748             : static GEN
    2749     2923060 : TA1(long N, long k, GEN VCHI, GEN GCD, long n)
    2750             : {
    2751             :   GEN S;
    2752             :   ulong m;
    2753     2923060 :   if (!uissquareall(n, &m)) return gen_0;
    2754      228452 :   if (m == 1) return A1(N,k); /* common */
    2755      196364 :   S = mychicgcd(GCD, VCHI, m);
    2756      196364 :   return S? gmul(gmul(powuu(m, k-2), A1(N,k)), S): gen_0;
    2757             : }
    2758             : 
    2759             : /* All square roots modulo 4N, x modulo 2N, precomputed to accelerate TA2 */
    2760             : static GEN
    2761       98637 : mksqr(long N)
    2762             : {
    2763       98637 :   pari_sp av = avma;
    2764       98637 :   long x, N2 = N << 1, N4 = N << 2;
    2765       98637 :   GEN v = const_vec(N2, cgetg(1, t_VECSMALL));
    2766       98637 :   gel(v, N2) = mkvecsmall(0); /* x = 0 */
    2767     2369857 :   for (x = 1; x <= N; x++)
    2768             :   {
    2769     2271220 :     long r = (((x*x - 1)%N4) >> 1) + 1;
    2770     2271220 :     gel(v,r) = vecsmall_append(gel(v,r), x);
    2771             :   }
    2772       98637 :   return gerepilecopy(av, v);
    2773             : }
    2774             : 
    2775             : static GEN
    2776       98637 : mkgcd(long N)
    2777             : {
    2778             :   GEN GCD, d;
    2779             :   long i, N2;
    2780       98637 :   if (N == 1) return mkvecsmall(N);
    2781       80290 :   GCD = cgetg(N + 1, t_VECSMALL);
    2782       80290 :   d = GCD+1; /* GCD[i+1] = d[i] = gcd(i,N) = gcd(N-i,N), i = 0..N-1 */
    2783       80290 :   d[0] = N; d[1] = d[N-1] = 1; N2 = N>>1;
    2784       80290 :   for (i = 2; i <= N2; i++) d[i] = d[N-i] = ugcd(N, i);
    2785       80290 :   return GCD;
    2786             : }
    2787             : 
    2788             : /* Table of \sum_{x^2-tx+n=0 mod Ng}chi(x) for all g dividing gcd(N,F),
    2789             :  * F^2 largest such that (t^2-4n)/F^2=0 or 1 mod 4; t >= 0 */
    2790             : static GEN
    2791     6159300 : mutglistall(long t, long N, long NF, GEN VCHI, long n, GEN MUP, GEN li, GEN GCD)
    2792             : {
    2793     6159300 :   long i, lx = lg(li);
    2794     6159300 :   GEN DNF = mydivisorsu(NF), v = zerovec(NF);
    2795     6159300 :   long j, g, lDNF = lg(DNF);
    2796    16897160 :   for (i = 1; i < lx; i++)
    2797             :   {
    2798    10737860 :     long x = (li[i] + t) >> 1, y, lD;
    2799    10737860 :     GEN D, c = mychicgcd(GCD, VCHI, x);
    2800    10737860 :     if (li[i] && li[i] != N)
    2801             :     {
    2802     6996283 :       GEN c2 = mychicgcd(GCD, VCHI, t - x);
    2803     6996283 :       if (c2) c = c? gadd(c, c2): c2;
    2804             :     }
    2805    10737860 :     if (!c) continue;
    2806     8394512 :     y = (x*(x - t) + n) / N; /* exact division */
    2807     8394512 :     D = mydivisorsu(cgcd(y, NF)); lD = lg(D);
    2808     8394512 :     for (j=1; j < lD; j++) { g = D[j]; gel(v,g) = gadd(gel(v,g), c); }
    2809             :   }
    2810             :   /* j = 1 corresponds to g = 1, and MUP[1] = 1 */
    2811     6159300 :   for (j=2; j < lDNF; j++) { g = DNF[j]; gel(v,g) = gmulsg(MUP[g], gel(v,g)); }
    2812     6159300 :   return v;
    2813             : }
    2814             : 
    2815             : /* special case (N,F) = 1: easier */
    2816             : static GEN
    2817    45825731 : mutg1(long t, long N, GEN VCHI, GEN li, GEN GCD)
    2818             : { /* (N,F) = 1 */
    2819    45825731 :   GEN S = NULL;
    2820    45825731 :   long i, lx = lg(li);
    2821    93999262 :   for (i = 1; i < lx; i++)
    2822             :   {
    2823    48173531 :     long x = (li[i] + t) >> 1;
    2824    48173531 :     GEN c = mychicgcd(GCD, VCHI, x);
    2825    48173531 :     if (c) S = S? gadd(S, c): c;
    2826    48173531 :     if (li[i] && li[i] != N)
    2827             :     {
    2828    21543494 :       c = mychicgcd(GCD, VCHI, t - x);
    2829    21543494 :       if (c) S = S? gadd(S, c): c;
    2830             :     }
    2831    48173531 :     if (S && !signe(S)) S = NULL; /* strive hard to add gen_0 */
    2832             :   }
    2833    45825731 :   return S; /* single value */
    2834             : }
    2835             : 
    2836             : /* Gegenbauer pol; n > 2, P = \sum_{0<=j<=n/2} (-1)^j (n-j)!/j!(n-2*j)! X^j */
    2837             : static GEN
    2838      301147 : mfrhopol(long n)
    2839             : {
    2840             : #ifdef LONG_IS_64BIT
    2841      258126 :   const long M = 2642249;
    2842             : #else
    2843       43021 :   const long M = 1629;
    2844             : #endif
    2845      301147 :   long j, d = n >> 1; /* >= 1 */
    2846      301147 :   GEN P = cgetg(d + 3, t_POL);
    2847             : 
    2848      301147 :   if (n > M) pari_err_IMPL("mfrhopol for large weight"); /* avoid overflow */
    2849      301147 :   P[1] = evalvarn(0)|evalsigne(1);
    2850      301147 :   gel(P,2) = gen_1;
    2851      301147 :   gel(P,3) = utoineg(n-1); /* j = 1 */
    2852      301147 :   if (d > 1) gel(P,4) = utoipos(((n-3)*(n-2)) >> 1); /* j = 2 */
    2853      301147 :   if (d > 2) gel(P,5) = utoineg(((n-5)*(n-4)*(n-3)) / 6); /* j = 3 */
    2854      305648 :   for (j = 4; j <= d; j++)
    2855        4501 :     gel(P,j+2) = divis(mulis(gel(P,j+1), (n-2*j+1)*(n-2*j+2)), (n-j+1)*(-j));
    2856      301147 :   return P;
    2857             : }
    2858             : 
    2859             : /* polrecip(Q)(t2), assume Q(0) = 1 */
    2860             : static GEN
    2861     1874558 : ZXrecip_u_eval(GEN Q, ulong t2)
    2862             : {
    2863     1874558 :   GEN T = addiu(gel(Q,3), t2);
    2864     1874558 :   long l = lg(Q), j;
    2865     1874558 :   for (j = 4; j < l; j++) T = addii(gel(Q,j), mului(t2, T));
    2866     1874558 :   return T;
    2867             : }
    2868             : /* return sh * sqrt(n)^nu * G_nu(t/(2*sqrt(n))) for t != 0
    2869             :  * else (sh/2) * sqrt(n)^nu * G_nu(0) [ implies nu is even ]
    2870             :  * G_nu(z) = \sum_{0<=j<=nu/2} (-1)^j (nu-j)!/j!(nu-2*j)! * (2z)^(nu-2*j)) */
    2871             : static GEN
    2872    48694933 : mfrhopowsimp(GEN Q, GEN sh, long nu, long t, long t2, long n)
    2873             : {
    2874             :   GEN T;
    2875    48694933 :   switch (nu)
    2876             :   {
    2877    27377847 :     case 0: return t? sh: gmul2n(sh,-1);
    2878      173544 :     case 1: return gmulsg(t, sh);
    2879    19257973 :     case 2: return t? gmulsg(t2 - n, sh): gmul(gmul2n(stoi(-n), -1), sh);
    2880         455 :     case 3: return gmul(mulss(t, t2 - 2*n), sh);
    2881             :     default:
    2882     1885114 :       if (!t) return gmul(gmul2n(gel(Q, lg(Q) - 1), -1), sh);
    2883     1874558 :       T = ZXrecip_u_eval(Q, t2); if (odd(nu)) T = mulsi(t, T);
    2884     1874558 :       return gmul(T, sh);
    2885             :   }
    2886             : }
    2887             : 
    2888             : /* contribution of elliptic matrices to trace formula */
    2889             : static GEN
    2890     2923060 : TA2(long N, long k, GEN VCHI, long n, GEN SQRTS, GEN MUP, GEN GCD)
    2891             : {
    2892     2923060 :   const long n4 = n << 2, N4 = N << 2, nu = k - 2;
    2893     2923060 :   const long st = (!odd(N) && odd(n)) ? 2 : 1;
    2894             :   long limt, t;
    2895             :   GEN S, Q;
    2896             : 
    2897     2923060 :   limt = usqrt(n4);
    2898     2923060 :   if (limt*limt == n4) limt--;
    2899     2923060 :   Q = nu > 3 ? ZX_z_unscale(mfrhopol(nu), n) : NULL;
    2900     2923060 :   S = gen_0;
    2901    85994797 :   for (t = odd(k)? st: 0; t <= limt; t += st) /* t^2 < 4n */
    2902             :   {
    2903    83071737 :     pari_sp av = avma;
    2904    83071737 :     long t2 = t*t, D = n4 - t2, F, D0, NF;
    2905             :     GEN sh, li;
    2906             : 
    2907    83071737 :     li = gel(SQRTS, (smodss(-D - 1, N4) >> 1) + 1);
    2908   117448541 :     if (lg(li) == 1) continue;
    2909    51985031 :     D0 = mycoredisc2neg(D, &F);
    2910    51985031 :     NF = myugcd(GCD, F);
    2911    51985031 :     if (NF == 1)
    2912             :     { /* (N,F) = 1 => single value in mutglistall */
    2913    45825731 :       GEN mut = mutg1(t, N, VCHI, li, GCD);
    2914    45825731 :       if (!mut) { avma = av; continue; }
    2915    44274580 :       sh = gmul(sstoQ(hclassno6u_i(D,D0,F),6), mut);
    2916             :     }
    2917             :     else
    2918             :     {
    2919     6159300 :       GEN v = mutglistall(t, N, NF, VCHI, n, MUP, li, GCD);
    2920     6159300 :       GEN DF = mydivisorsu(F);
    2921     6159300 :       long i, lDF = lg(DF);
    2922     6159300 :       sh = gen_0;
    2923    24204523 :       for (i = 1; i < lDF; i++)
    2924             :       {
    2925    18045223 :         long Ff, f = DF[i], g = myugcd(GCD, f);
    2926    18045223 :         GEN mut = gel(v, g);
    2927    18045223 :         if (gequal0(mut)) continue;
    2928    10809085 :         Ff = DF[lDF-i]; /* F/f */
    2929    10809085 :         if (Ff == 1) sh = gadd(sh, mut);
    2930             :         else
    2931             :         {
    2932     7977683 :           GEN P = gel(myfactoru(Ff), 1);
    2933     7977683 :           long j, lP = lg(P);
    2934     7977683 :           for (j = 1; j < lP; j++) { long p = P[j]; Ff -= kross(D0, p)*Ff/p; }
    2935     7977683 :           sh = gadd(sh, gmulsg(Ff, mut));
    2936             :         }
    2937             :       }
    2938     6159300 :       if (gequal0(sh)) { avma = av; continue; }
    2939     4420353 :       if (D0 == -3) sh = gdivgs(sh, 3);
    2940     4199356 :       else if (D0 == -4) sh = gdivgs(sh, 2);
    2941     3988068 :       else sh = gmulgs(sh, myh(D0));
    2942             :     }
    2943    48694933 :     S = gerepileupto(av, gadd(S, mfrhopowsimp(Q,sh,nu,t,t2,n)));
    2944             :   }
    2945     2923060 :   return S;
    2946             : }
    2947             : 
    2948             : /* compute global auxiliary data for TA3 */
    2949             : static GEN
    2950       98637 : mkbez(long N, long FC)
    2951             : {
    2952       98637 :   long ct, i, NF = N/FC;
    2953       98637 :   GEN w, D = mydivisorsu(N);
    2954       98637 :   long l = lg(D);
    2955             : 
    2956       98637 :   w = cgetg(l, t_VEC);
    2957      279461 :   for (i = ct = 1; i < l; i++)
    2958             :   {
    2959      261114 :     long u, v, h, c = D[i], Nc = D[l-i];
    2960      261114 :     if (c > Nc) break;
    2961      180824 :     h = cbezout(c, Nc, &u, &v);
    2962      180824 :     if (h == 1) /* shortcut */
    2963      134813 :       gel(w, ct++) = mkvecsmall4(1,u*c,1,i);
    2964       46011 :     else if (!(NF%h))
    2965       42196 :       gel(w, ct++) = mkvecsmall4(h,u*(c/h),myeulerphiu(h),i);
    2966             :   }
    2967       98637 :   setlg(w,ct); stackdummy((pari_sp)(w+ct),(pari_sp)(w+l));
    2968       98637 :   return w;
    2969             : }
    2970             : 
    2971             : /* contribution of hyperbolic matrices to trace formula, d * nd = n,
    2972             :  * DN = divisorsu(N) */
    2973             : static GEN
    2974    11599063 : auxsum(GEN VCHI, GEN GCD, long d, long nd, GEN DN, GEN BEZ)
    2975             : {
    2976    11599063 :   GEN S = gen_0;
    2977    11599063 :   long ct, g = nd - d, lDN = lg(DN), lBEZ = lg(BEZ);
    2978    30730462 :   for (ct = 1; ct < lBEZ; ct++)
    2979             :   {
    2980    19131399 :     GEN y, B = gel(BEZ, ct);
    2981    19131399 :     long ic, c, Nc, uch, h = B[1];
    2982    19131399 :     if (g%h) continue;
    2983    18699310 :     uch = B[2];
    2984    18699310 :     ic  = B[4];
    2985    18699310 :     c = DN[ic];
    2986    18699310 :     Nc= DN[lDN - ic]; /* Nc = N/c */
    2987    18699310 :     if (cgcd(Nc, nd) == 1)
    2988    15402177 :       y = mychicgcd(GCD, VCHI, d + uch*g); /* 0 if (c,d) > 1 */
    2989             :     else
    2990     3297133 :       y = NULL;
    2991    18699310 :     if (c != Nc && cgcd(Nc, d) == 1)
    2992             :     {
    2993    13247003 :       GEN y2 = mychicgcd(GCD, VCHI, nd - uch*g); /* 0 if (c,nd) > 1 */
    2994    13247003 :       if (y2) y = y? gadd(y, y2): y2;
    2995             :     }
    2996    18699310 :     if (y) S = gadd(S, gmulsg(B[3], y));
    2997             :   }
    2998    11599063 :   return S;
    2999             : }
    3000             : 
    3001             : static GEN
    3002     2923060 : TA3(long N, long k, GEN VCHI, GEN GCD, GEN Dn, GEN BEZ)
    3003             : {
    3004     2923060 :   GEN S = gen_0, DN = mydivisorsu(N);
    3005     2923060 :   long i, l = lg(Dn);
    3006    14522123 :   for (i = 1; i < l; i++)
    3007             :   {
    3008    14490035 :     long d = Dn[i], nd = Dn[l-i]; /* = n/d */
    3009             :     GEN t, u;
    3010    14490035 :     if (d > nd) break;
    3011    11599063 :     t = auxsum(VCHI, GCD, d, nd, DN, BEZ);
    3012    11599063 :     if (isintzero(t)) continue;
    3013    11055926 :     u = powuu(d,k-1); if (d == nd) u = gmul2n(u,-1);
    3014    11055926 :     S = gadd(S, gmul(u,t));
    3015             :   }
    3016     2923060 :   return S;
    3017             : }
    3018             : 
    3019             : /* special contribution in weight 2 in trace formula */
    3020             : static long
    3021     2923060 : TA4(long k, GEN VCHIP, GEN Dn, GEN GCD)
    3022             : {
    3023             :   long i, l, S;
    3024     2923060 :   if (k != 2 || vchip_FC(VCHIP) != 1) return 0;
    3025     2045477 :   l = lg(Dn); S = 0;
    3026    17334331 :   for (i = 1; i < l; i++)
    3027             :   {
    3028    15288854 :     long d = Dn[i]; /* gcd(N,n/d) == 1? */
    3029    15288854 :     if (myugcd(GCD, Dn[l-i]) == 1) S += d;
    3030             :   }
    3031     2045477 :   return S;
    3032             : }
    3033             : 
    3034             : /* precomputation of products occurring im mutg, again to accelerate TA2 */
    3035             : static GEN
    3036       98637 : mkmup(long N)
    3037             : {
    3038       98637 :   GEN fa = myfactoru(N), P = gel(fa,1), D = divisorsu_fact(fa);
    3039       98637 :   long i, lP = lg(P), lD = lg(D);
    3040       98637 :   GEN MUP = const_vecsmall(N, 0);
    3041       98637 :   MUP[1] = 1;
    3042      332724 :   for (i = 2; i < lD; i++)
    3043             :   {
    3044      234087 :     long j, g = D[i], Ng = D[lD-i]; /*  N/g */
    3045      234087 :     for (j = 1; j < lP; j++) { long p = P[j]; if (Ng%p) g += g/p; }
    3046      234087 :     MUP[D[i]] = g;
    3047             :   }
    3048       98637 :   return MUP;
    3049             : }
    3050             : 
    3051             : /* quadratic non-residues mod p; p odd prime, p^2 fits in a long */
    3052             : static GEN
    3053        1484 : non_residues(long p)
    3054             : {
    3055        1484 :   long i, j, p2 = p >> 1;
    3056        1484 :   GEN v = cgetg(p2+1, t_VECSMALL), w = const_vecsmall(p-1, 1);
    3057        1484 :   for (i = 2; i <= p2; i++) w[(i*i) % p] = 0; /* no need to check 1 */
    3058        1484 :   for (i = 2, j = 1; i < p; i++) if (w[i]) v[j++] = i;
    3059        1484 :   return v;
    3060             : }
    3061             : 
    3062             : /* CHIP primitive. Return t_VECSMALL v of length q such that
    3063             :  * Tr^new_{N,CHIP}(n) = 0 whenever v[(n%q) + 1] is non-zero */
    3064             : static GEN
    3065       25256 : mfnewzerodata(long N, GEN CHIP)
    3066             : {
    3067       25256 :   GEN V, M, L, faN = myfactoru(N), PN = gel(faN,1), EN = gel(faN,2);
    3068       25256 :   GEN G = gel(CHIP,1), chi = gel(CHIP,2);
    3069       25256 :   GEN fa = znstar_get_faN(G), P = ZV_to_zv(gel(fa,1)), E = gel(fa,2);
    3070       25256 :   long i, mod, j = 1, l = lg(PN);
    3071             : 
    3072       25256 :   M = cgetg(l, t_VECSMALL); M[1] = 0;
    3073       25256 :   V = cgetg(l, t_VEC);
    3074             :   /* Tr^new(n) = 0 if (n mod M[i]) in V[i]  */
    3075       25256 :   if ((N & 3) == 0)
    3076             :   {
    3077        8449 :     long e = EN[1];
    3078        8449 :     long c = (lg(P) > 1 && P[1] == 2)? E[1]: 0; /* c = v_2(FC) */
    3079             :     /* e >= 2 */
    3080        8449 :     if (c == e-1) return NULL; /* Tr^new = 0 */
    3081        8428 :     if (c == e)
    3082             :     {
    3083        1946 :       if (e == 2)
    3084             :       { /* sc: -4 */
    3085        1393 :         gel(V,1) = mkvecsmall(3);
    3086        1393 :         M[1] = 4;
    3087             :       }
    3088         553 :       else if (e == 3)
    3089             :       { /* sc: -8 (CHI_2(-1)=-1<=>chi[1]=1) and 8 (CHI_2(-1)=1 <=> chi[1]=0) */
    3090         553 :         long t = signe(gel(chi,1))? 7: 3;
    3091         553 :         gel(V,1) = mkvecsmall2(5, t);
    3092         553 :         M[1] = 8;
    3093             :       }
    3094             :     }
    3095        6482 :     else if (e == 5 && c == 3)
    3096         126 :     { /* sc: -8 (CHI_2(-1)=-1<=>chi[1]=1) and 8 (CHI_2(-1)=1 <=> chi[1]=0) */
    3097         126 :       long t = signe(gel(chi,1))? 7: 3;
    3098         126 :       gel(V,1) = mkvecsmalln(6, 2L,4L,5L,6L,8L,t);
    3099         126 :       M[1] = 8;
    3100             :     }
    3101        6356 :     else if ((e == 4 && c == 2) || (e == 5 && c <= 2) || (e == 6 && c <= 2)
    3102        5222 :          || (e >= 7 && c == e - 3))
    3103             :     { /* sc: 4 */
    3104        1134 :       gel(V,1) = mkvecsmall3(0,2,3);
    3105        1134 :       M[1] = 4;
    3106             :     }
    3107        5222 :     else if ((e <= 4 && c == 0) || (e >= 5 && c == e - 2))
    3108             :     { /* sc: 2 */
    3109        5103 :       gel(V,1) = mkvecsmall(0);
    3110        5103 :       M[1] = 2;
    3111             :     }
    3112         119 :     else if ((e == 6 && c == 3) || (e >= 7 && c <= e - 4))
    3113             :     { /* sc: -2 */
    3114         119 :       gel(V,1) = mkvecsmalln(7, 0L,2L,3L,4L,5L,6L,7L);
    3115         119 :       M[1] = 8;
    3116             :     }
    3117             :   }
    3118       25235 :   j = M[1]? 2: 1;
    3119       54523 :   for (i = odd(N)? 1: 2; i < l; i++) /* skip p=2, done above */
    3120             :   {
    3121       29288 :     long p = PN[i], e = EN[i];
    3122       29288 :     long z = zv_search(P, p), c = z? E[z]: 0; /* c = v_p(FC) */
    3123       29288 :     if ((e <= 2 && c == 1 && itos(gel(chi,z)) == (p>>1)) /* ord(CHI_p)=2 */
    3124       28336 :         || (e >= 3 && c <= e - 2))
    3125        1484 :     { /* sc: -p */
    3126        1484 :       GEN v = non_residues(p);
    3127        1484 :       if (e != 1) v = vecsmall_prepend(v, 0);
    3128        1484 :       gel(V,j) = v;
    3129        1484 :       M[j] = p; j++;
    3130             :     }
    3131       27804 :     else if (e >= 2 && c < e)
    3132             :     { /* sc: p */
    3133        1771 :       gel(V,j) = mkvecsmall(0);
    3134        1771 :       M[j] = p; j++;
    3135             :     }
    3136             :   }
    3137       25235 :   if (j == 1) return cgetg(1, t_VECSMALL);
    3138       10192 :   setlg(V,j); setlg(M,j); mod = zv_prod(M);
    3139       10192 :   L = const_vecsmall(mod, 0);
    3140       21875 :   for (i = 1; i < j; i++)
    3141             :   {
    3142       11683 :     GEN v = gel(V,i);
    3143       11683 :     long s, m = M[i], lv = lg(v);
    3144       30037 :     for (s = 1; s < lv; s++)
    3145             :     {
    3146       18354 :       long a = v[s] + 1;
    3147       27104 :       do { L[a] = 1; a += m; } while (a <= mod);
    3148             :     }
    3149             :   }
    3150       10192 :   return L;
    3151             : }
    3152             : /* v=mfnewzerodata(N,CHI); returns TRUE if newtrace(n) must be zero,
    3153             :  * (but newtrace(n) may still be zero if we return FALSE) */
    3154             : static long
    3155     1239868 : mfnewchkzero(GEN v, long n) { long q = lg(v)-1; return q && v[(n%q) + 1]; }
    3156             : 
    3157             : /* if (!VCHIP): from mftraceform_cusp;
    3158             :  * else from initnewtrace and CHI is known to be primitive */
    3159             : static GEN
    3160       98637 : inittrace(long N, GEN CHI, GEN VCHIP)
    3161             : {
    3162             :   long FC;
    3163       98637 :   if (VCHIP)
    3164       98630 :     FC = mfcharmodulus(CHI);
    3165             :   else
    3166           7 :     VCHIP = mfcharinit(mfchartoprimitive(CHI, &FC));
    3167       98637 :   return mkvecn(5, mksqr(N), mkmup(N), mkgcd(N), VCHIP, mkbez(N, FC));
    3168             : }
    3169             : 
    3170             : /* p > 2 prime; return a sorted t_VECSMALL of primes s.t Tr^new(p) = 0 for all
    3171             :  * weights > 2 */
    3172             : static GEN
    3173       25235 : inittrconj(long N, long FC)
    3174             : {
    3175             :   GEN fa, P, E, v;
    3176             :   long i, k, l;
    3177             : 
    3178       25235 :   if (FC != 1) return cgetg(1,t_VECSMALL);
    3179             : 
    3180       21917 :   fa = myfactoru(N >> vals(N));
    3181       21917 :   P = gel(fa,1); l = lg(P);
    3182       21917 :   E = gel(fa,2);
    3183       21917 :   v = cgetg(l, t_VECSMALL);
    3184       48202 :   for (i = k = 1; i < l; i++)
    3185             :   {
    3186       26285 :     long j, p = P[i]; /* > 2 */
    3187       63294 :     for (j = 1; j < l; j++)
    3188       37009 :       if (j != i && E[j] == 1 && kross(-p, P[j]) == 1) v[k++] = p;
    3189             :   }
    3190       21917 :   setlg(v,k); return v;
    3191             : }
    3192             : 
    3193             : /* assume CHIP primitive, f(CHIP) | N; NZ = mfnewzerodata(N,CHIP) */
    3194             : static GEN
    3195       25235 : initnewtrace_i(long N, GEN CHIP, GEN NZ)
    3196             : {
    3197       25235 :   GEN T = const_vec(N, cgetg(1,t_VEC)), D, VCHIP;
    3198       25235 :   long FC = mfcharmodulus(CHIP), N1, N2, i, l;
    3199             : 
    3200       25235 :   if (!NZ) NZ = mkvecsmall(1); /*Tr^new = 0; initialize data nevertheless*/
    3201       25235 :   VCHIP = mfcharinit(CHIP);
    3202       25235 :   N1 = N/FC; newd_params(N1, &N2);
    3203       25235 :   D = mydivisorsu(N1/N2); l = lg(D);
    3204       25235 :   N2 *= FC;
    3205      123865 :   for (i = 1; i < l; i++)
    3206             :   {
    3207       98630 :     long M = D[i]*N2;
    3208       98630 :     gel(T,M) = inittrace(M, CHIP, VCHIP);
    3209             :   }
    3210       25235 :   gel(T,N) = shallowconcat(gel(T,N), mkvec2(NZ, inittrconj(N,FC)));
    3211       25235 :   return T;
    3212             : }
    3213             : /* don't initialize if Tr^new = 0, return NULL */
    3214             : static GEN
    3215       25256 : initnewtrace(long N, GEN CHI)
    3216             : {
    3217       25256 :   GEN CHIP = mfchartoprimitive(CHI, NULL), NZ = mfnewzerodata(N,CHIP);
    3218       25256 :   return NZ? initnewtrace_i(N, CHIP, NZ): NULL;
    3219             : }
    3220             : int
    3221       16555 : checkMF_i(GEN mf)
    3222             : {
    3223             :   GEN v;
    3224       16555 :   if (typ(mf) != t_VEC || lg(mf) != 7) return 0;
    3225        6279 :   v = gel(mf,1);
    3226        6279 :   if (typ(v) != t_VEC || lg(v) != 5) return 0;
    3227       12558 :   return typ(gel(v,1)) == t_INT
    3228        6279 :          && typ(gmul2n(gel(v,2), 1)) == t_INT
    3229        6279 :          && typ(gel(v,3)) == t_VEC
    3230       12558 :          && typ(gel(v,4)) == t_INT;
    3231             : }
    3232             : void
    3233        3080 : checkMF(GEN mf)
    3234        3080 : { if (!checkMF_i(mf)) pari_err_TYPE("checkMF [please use mfinit]", mf); }
    3235             : 
    3236             : /* Given an ordered Vecsmall vecn, return the vector of mfheckemat
    3237             :    of its entries. */
    3238             : GEN
    3239          70 : mfheckemat(GEN mf, GEN vecn)
    3240             : {
    3241          70 :   pari_sp ltop = avma;
    3242             :   long lv, lvP, i, N, dim, k;
    3243             :   GEN CHI, S, res, vT, FA, B, vP;
    3244             : 
    3245          70 :   checkMF(mf);
    3246          70 :   if (typ(vecn) == t_INT)
    3247             :   {
    3248          35 :     long n = itos(vecn); if (!n) pari_err_TYPE("mfheckemat", vecn);
    3249          35 :     return mfheckemat_i(mf, labs(n));
    3250             :   }
    3251          35 :   N = MF_get_N(mf); dim = MF_get_dim(mf); k = MF_get_k(mf);
    3252          35 :   CHI = MF_get_CHI(mf); S = MF_get_S(mf);
    3253          35 :   if (typ(vecn) != t_VECSMALL) vecn = gtovecsmall(vecn);
    3254          35 :   lv = lg(vecn);
    3255          35 :   res = cgetg(lv, t_VEC);
    3256          35 :   FA = cgetg(lv, t_VEC);
    3257          35 :   vP = cgetg(lv, t_VEC);
    3258          35 :   vT = const_vec(vecsmall_max(vecn), NULL);
    3259          98 :   for (i = 1; i < lv; i++)
    3260             :   {
    3261          63 :     long n = vecn[i];
    3262             :     GEN fa;
    3263          63 :     if (!n) pari_err_TYPE("mfheckemat", vecn);
    3264          63 :     gel(FA, i) = fa = myfactoru(labs(n));
    3265          63 :     gel(vP, i) = gel(fa,1);
    3266             :   }
    3267          35 :   vP = shallowconcat1(vP); vecsmall_sort(vP);
    3268          35 :   vP = vecsmall_uniq_sorted(vP); /* all primes occurring in vecn */
    3269          35 :   lvP = lg(vP);
    3270          35 :   if (lvP != 1 && k == 1 && mf_get_type(gel(S,1)) == t_MF_DIV)
    3271           7 :     B = mflineardivtomat(S, vP[lvP-1] * mfsturm_mf(mf));
    3272             :   else
    3273          28 :     B = NULL;
    3274          70 :   for (i = 1; i < lvP; i++)
    3275             :   {
    3276          35 :     long j, e = 1, p = vP[i];
    3277          35 :     GEN Tp, u1, u0 = gen_1;
    3278          35 :     for (j = 1; j < lv; j++) e = maxss(e, z_lval(vecn[j], p));
    3279          35 :     Tp = B? mfheckematwt1(mf, p, B): mfheckemat_i(mf, p);
    3280          35 :     gel(vT, p) = Tp;
    3281          35 :     if (e > 1)
    3282             :     {
    3283          14 :       GEN fac = (N % p)? gmul(mfchareval_i(CHI,p), powuu(p, k-1)): NULL;
    3284          14 :       long jj, q = p;
    3285          28 :       for (u1=Tp, jj=2; jj <= e; jj++)
    3286             :       {
    3287          14 :         GEN u2 = gmul(Tp, u1);
    3288          14 :         if (fac) u2 = gsub(u2, gmul(fac, u0));
    3289          14 :         u0 = u1; u1 = u2;
    3290          14 :         q *= p; gel(vT, q) = u1; /* T_q, q = p^jj */
    3291             :       }
    3292             :     }
    3293             :   }
    3294             :   /* vT[p^e] = T_{p^e} for all p^e occurring below */
    3295          98 :   for (i = 1; i < lv; i++)
    3296             :   {
    3297          63 :     long n = vecn[i], j, lP;
    3298             :     GEN fa, P, E, M;
    3299          63 :     if (n == 1) { gel(res, i) = matid(dim); continue; }
    3300          42 :     fa = gel(FA,i);
    3301          42 :     P = gel(fa,1); lP = lg(P);
    3302          42 :     E = gel(fa,2); M = gen_1;
    3303          42 :     for (j = 1; j < lP; j++) M = gmul(M, gel(vT, upowuu(P[j], E[j])));
    3304          42 :     gel(res, i) = M;
    3305             :   }
    3306          35 :   return gerepilecopy(ltop, res);
    3307             : }
    3308             : 
    3309             : static long
    3310        6055 : badchar(long N, long k, GEN CHI)
    3311        6055 : { return mfcharparity(CHI) != m1pk(k) || (CHI && N % mfcharconductor(CHI)); }
    3312             : 
    3313             : /* dimension of space of cusp forms S_k(\G_0(N),CHI)
    3314             :  * Only depends on CHIP the primitive char attached to CHI */
    3315             : long
    3316       36645 : mfcuspdim(long N, long k, GEN CHI)
    3317             : {
    3318       36645 :   pari_sp av = avma;
    3319             :   long FC;
    3320             :   GEN s;
    3321       36645 :   if (k <= 0) return 0;
    3322       36645 :   if (k == 1) return mfwt1cuspdim(N, CHI);
    3323       36547 :   FC = CHI? mfcharconductor(CHI): 1;
    3324       36547 :   if (FC == 1) CHI = NULL;
    3325       36547 :   s = gsub(A1(N, k), gadd(A21(N, k, CHI), A22(N, k, CHI)));
    3326       36547 :   s = gadd(s, gsubsg(A4(k, FC), A3(N, FC)));
    3327       36547 :   avma = av; return itos(s);
    3328             : }
    3329             : 
    3330             : /* dimension of whole space M_k(\G_0(N),CHI)
    3331             :  * Only depends on CHIP the primitive char attached to CHI; assumes !badchar */
    3332             : long
    3333         406 : mffulldim(long N, long k, GEN CHI)
    3334             : {
    3335         406 :   pari_sp av = avma;
    3336         406 :   long FC = CHI? mfcharconductor(CHI): 1;
    3337             :   GEN s;
    3338         406 :   if (k <= 0) return (k == 0 && FC == 1)? 1: 0;
    3339         406 :   if (k == 1)
    3340             :   {
    3341          35 :     long dim = itos(A3(N, FC));
    3342          35 :     avma = av; return dim + mfwt1cuspdim(N, CHI);
    3343             :   }
    3344         371 :   if (FC == 1) CHI = NULL;
    3345         371 :   s = gsub(A1(N, k), gadd(A21(N, k, CHI), A22(N, k, CHI)));
    3346         371 :   s = gadd(s, A3(N, FC));
    3347         371 :   avma = av; return itos(s);
    3348             : }
    3349             : 
    3350             : /* Dimension of the space of Eisenstein series */
    3351             : long
    3352         203 : mfeisensteindim(long N, long k, GEN CHI)
    3353             : {
    3354         203 :   pari_sp av = avma;
    3355         203 :   long s, FC = CHI? mfcharconductor(CHI): 1;
    3356         203 :   if (k <= 0) return (k == 0 && FC == 1)? 1: 0;
    3357         203 :   s = itos(gmul2n(A3(N, FC), 1));
    3358         203 :   if (k > 1) s -= A4(k, FC);
    3359          21 :   else s >>= 1;
    3360         203 :   avma = av; return s;
    3361             : }
    3362             : 
    3363             : enum { _SQRTS = 1, _MUP, _GCD, _VCHIP, _BEZ, _NEWLZ, _TRCONJ };
    3364             : /* Trace of T(n) on space of cuspforms; only depends on CHIP the primitive char
    3365             :  * attached to CHI */
    3366             : static GEN
    3367     2923060 : mfcusptrace_i(long N, long k, long n, GEN Dn, GEN S)
    3368             : {
    3369     2923060 :   pari_sp av = avma;
    3370             :   GEN a, b, VCHIP, GCD;
    3371             :   long t;
    3372     2923060 :   if (!n) return gen_0;
    3373     2923060 :   VCHIP = gel(S,_VCHIP);
    3374     2923060 :   GCD = gel(S,_GCD);
    3375     2923060 :   t = TA4(k, VCHIP, Dn, GCD);
    3376     2923060 :   a = TA1(N, k, VCHIP, GCD, n); if (t) a = gaddgs(a,t);
    3377     2923060 :   b = TA2(N, k, VCHIP, n, gel(S,_SQRTS), gel(S,_MUP), GCD);
    3378     2923060 :   b = gadd(b, TA3(N, k, VCHIP, GCD, Dn, gel(S,_BEZ)));
    3379     2923060 :   b = gsub(a,b);
    3380     2923060 :   if (typ(b) != t_POL) return gerepileupto(av, b);
    3381       27552 :   return gerepilecopy(av, vchip_polmod(VCHIP, b));
    3382             : }
    3383             : 
    3384             : static GEN
    3385     3701271 : mfcusptracecache(long N, long k, long n, GEN Dn, GEN S, cachenew_t *cache)
    3386             : {
    3387     3701271 :   GEN C = NULL, T = gel(cache->vfull,N);
    3388     3701271 :   long lcache = lg(T);
    3389     3701271 :   if (n < lcache) C = gel(T, n);
    3390     3701271 :   if (C) cache->cuspHIT++; else C = mfcusptrace_i(N, k, n, Dn, S);
    3391     3701271 :   cache->cuspTOTAL++;
    3392     3701271 :   if (n < lcache) gel(T,n) = C;
    3393     3701271 :   return C;
    3394             : }
    3395             : 
    3396             : /* return the divisors of n, known to be among the elements of D */
    3397             : static GEN
    3398      233562 : div_restrict(GEN D, ulong n)
    3399             : {
    3400             :   long i, j, l;
    3401      233562 :   GEN v, VDIV = caches[cache_DIV].cache;
    3402      233562 :   if (lg(VDIV) > n) return gel(VDIV,n);
    3403           0 :   l = lg(D);
    3404           0 :   v = cgetg(l, t_VECSMALL);
    3405           0 :   for (i = j = 1; i < l; i++)
    3406             :   {
    3407           0 :     ulong d = D[i];
    3408           0 :     if (n % d == 0) v[j++] = d;
    3409             :   }
    3410           0 :   setlg(v,j); return v;
    3411             : }
    3412             : 
    3413             : /* for some prime divisors of N, Tr^new(p) = 0 */
    3414             : static int
    3415      354186 : trconj(GEN T, long N, long n)
    3416      354186 : { return (lg(T) > 1 && N % n == 0 && zv_search(T, n)); }
    3417             : 
    3418             : /* n > 0; trace formula on new space */
    3419             : static GEN
    3420     1239868 : mfnewtrace_i(long N, long k, long n, cachenew_t *cache)
    3421             : {
    3422     1239868 :   GEN VCHIP, s, Dn, DN1, SN, S = cache->DATA;
    3423             :   long FC, N1, N2, N1N2, g, i, j, lDN1;
    3424             : 
    3425     1239868 :   if (!S) return gen_0;
    3426     1239868 :   SN = gel(S,N);
    3427     1239868 :   if (mfnewchkzero(gel(SN,_NEWLZ), n)) return gen_0;
    3428      949389 :   if (k > 2 && trconj(gel(SN,_TRCONJ), N, n)) return gen_0;
    3429      949382 :   VCHIP = gel(SN, _VCHIP); FC = vchip_FC(VCHIP);
    3430      949382 :   N1 = N/FC; newt_params(N1, n, FC, &g, &N2);
    3431      949382 :   N1N2 = N1/N2;
    3432      949382 :   DN1 = mydivisorsu(N1N2); lDN1 = lg(DN1);
    3433      949382 :   N2 *= FC;
    3434      949382 :   Dn = mydivisorsu(n); /* this one is probably out of cache */
    3435      949382 :   s = gmulsg(mubeta2(N1N2,n), mfcusptracecache(N2, k, n, Dn, gel(S,N2), cache));
    3436     3467709 :   for (i = 2; i < lDN1; i++)
    3437             :   { /* skip M1 = 1, done above */
    3438     2518327 :     long M1 = DN1[i], N1M1 = DN1[lDN1-i];
    3439     2518327 :     GEN Dg = mydivisorsu(cgcd(M1, g));
    3440     2518327 :     M1 *= N2;
    3441     2518327 :     s = gadd(s, gmulsg(mubeta2(N1M1,n),
    3442     2518327 :                        mfcusptracecache(M1, k, n, Dn, gel(S,M1), cache)));
    3443     2751889 :     for (j = 2; j < lg(Dg); j++) /* skip d = 1, done above */
    3444             :     {
    3445      233562 :       long d = Dg[j], ndd = n/(d*d), M = M1/d;
    3446      233562 :       GEN z = mulsi(mubeta2(N1M1,ndd), powuu(d,k-1)), C = vchip_lift(VCHIP,d,z);
    3447      233562 :       GEN Dndd = div_restrict(Dn, ndd);
    3448      233562 :       s = gadd(s, gmul(C, mfcusptracecache(M, k, ndd, Dndd, gel(S,M), cache)));
    3449             :     }
    3450     2518327 :     s = vchip_mod(VCHIP, s);
    3451             :   }
    3452      949382 :   return vchip_polmod(VCHIP, s);
    3453             : }
    3454             : 
    3455             : /* mfcuspdim(N,k,CHI) - mfnewdim(N,k,CHI); CHIP primitive (for efficiency) */
    3456             : static long
    3457        6748 : mfolddim_i(long N, long k, GEN CHIP)
    3458             : {
    3459        6748 :   long S, i, l, FC = mfcharmodulus(CHIP), N1 = N/FC, N2;
    3460             :   GEN D;
    3461        6748 :   newd_params(N1, &N2); /* will ensure mubeta != 0 */
    3462        6748 :   D = mydivisorsu(N1/N2); l = lg(D);
    3463        6748 :   N2 *= FC; S = 0;
    3464       27363 :   for (i = 2; i < l; i++)
    3465             :   {
    3466       20615 :     long M = D[l-i]*N2, d = mfcuspdim(M, k, CHIP);
    3467       20615 :     if (d) S -= mubeta(D[i]) * d;
    3468             :   }
    3469        6748 :   return S;
    3470             : }
    3471             : long
    3472         294 : mfolddim(long N, long k, GEN CHI)
    3473             : {
    3474         294 :   pari_sp av = avma;
    3475         294 :   GEN CHIP = mfchartoprimitive(CHI, NULL);
    3476         294 :   long S = mfolddim_i(N, k, CHIP);
    3477         294 :   avma = av; return S;
    3478             : }
    3479             : /* Only depends on CHIP the primitive char attached to CHI; assumes !badchar */
    3480             : long
    3481       13223 : mfnewdim(long N, long k, GEN CHI)
    3482             : {
    3483       13223 :   pari_sp av = avma;
    3484             :   long S;
    3485       13223 :   GEN CHIP = mfchartoprimitive(CHI, NULL);
    3486       13223 :   S = mfcuspdim(N, k, CHIP); if (!S) return 0;
    3487        6440 :   S -= mfolddim_i(N, k, CHIP);
    3488        6440 :   avma = av; return S;
    3489             : }
    3490             : 
    3491             : /* trace form, given as closure */
    3492             : static GEN
    3493         805 : mftraceform_new(long N, long k, GEN CHI)
    3494             : {
    3495             :   GEN T;
    3496         805 :   if (k == 1) return initwt1newtrace(mfinit_Nkchi(N, 1, CHI, mf_CUSP, 0));
    3497         791 :   T = initnewtrace(N,CHI); if (!T) return mftrivial();
    3498         791 :   return tag(t_MF_NEWTRACE, mkNK(N,k,CHI), T);
    3499             : }
    3500             : static GEN
    3501          14 : mftraceform_cusp(long N, long k, GEN CHI)
    3502             : {
    3503          14 :   if (k == 1) return initwt1trace(mfinit_Nkchi(N, 1, CHI, mf_CUSP, 0));
    3504           7 :   return tag(t_MF_TRACE, mkNK(N,k,CHI), inittrace(N,CHI,NULL));
    3505             : }
    3506             : static GEN
    3507          84 : mftraceform_i(GEN NK, long space)
    3508             : {
    3509             :   GEN CHI;
    3510             :   long N, k;
    3511          84 :   checkNK(NK, &N, &k, &CHI, 0);
    3512          84 :   if (!mfdim_Nkchi(N, k, CHI, space)) return mftrivial();
    3513          63 :   switch(space)
    3514             :   {
    3515          42 :     case mf_NEW: return mftraceform_new(N, k, CHI);
    3516          14 :     case mf_CUSP:return mftraceform_cusp(N, k, CHI);
    3517             :   }
    3518           7 :   pari_err_DOMAIN("mftraceform", "space", "=", utoi(space), NK);
    3519             :   return NULL;/*LCOV_EXCL_LINE*/
    3520             : }
    3521             : GEN
    3522          84 : mftraceform(GEN NK, long space)
    3523          84 : { pari_sp av = avma; return gerepilecopy(av, mftraceform_i(NK,space)); }
    3524             : 
    3525             : static GEN
    3526       12691 : hecke_data(long N, long n)
    3527       12691 : { return mkvecsmall3(n, u_ppo(n, N), N); }
    3528             : /* 1/2-integral weight */
    3529             : static GEN
    3530          84 : heckef2_data(long N, long n)
    3531             : {
    3532             :   ulong f, fN, fN2;
    3533          84 :   if (!uissquareall(n, &f)) return NULL;
    3534          77 :   fN = u_ppo(f, N); fN2 = fN*fN;
    3535          77 :   return mkvec2(myfactoru(fN), mkvecsmall4(n, N, fN2, n/fN2));
    3536             : }
    3537             : static GEN
    3538       18683 : mfhecke_i(long N, long k, GEN CHI, GEN F, long n)
    3539             : {
    3540             :   GEN NK;
    3541       18683 :   if (n == 1) return F;
    3542       12593 :   if (!CHI) CHI = mfchartrivial();
    3543       12593 :   NK = mkgNK(utoi(N), utoi(k), CHI, mf_get_field(F));
    3544       12593 :   return tag2(t_MF_HECKE, NK, hecke_data(N,n), F);
    3545             : }
    3546             : 
    3547             : GEN
    3548          98 : mfhecke(GEN mf, GEN F, long n)
    3549             : {
    3550          98 :   pari_sp av = avma;
    3551             :   GEN NK, CHI, gk, DATA;
    3552             :   long N, nk, dk;
    3553          98 :   checkMF(mf);
    3554          98 :   if (!checkmf_i(F)) pari_err_TYPE("mfhecke",F);
    3555          98 :   if (n <= 0) pari_err_TYPE("mfhecke [n <= 0]", stoi(n));
    3556          98 :   if (n == 1) return gcopy(F);
    3557          98 :   gk = mf_get_gk(F);
    3558          98 :   Qtoss(gk,&nk,&dk);
    3559          98 :   CHI = mf_get_CHI(F);
    3560          98 :   N = MF_get_N(mf);
    3561          98 :   if (dk == 2)
    3562             :   {
    3563          77 :     DATA = heckef2_data(N,n);
    3564          77 :     if (!DATA) return mftrivial();
    3565             :   }
    3566             :   else
    3567          21 :     DATA = hecke_data(N,n);
    3568          91 :   NK = mkgNK(lcmii(stoi(N), mf_get_gN(F)), gk, CHI, mf_get_field(F));
    3569          91 :   return gerepilecopy(av, tag2(t_MF_HECKE, NK, DATA, F));
    3570             : }
    3571             : 
    3572             : /* form F given by closure, compute B(d)(F) as closure (q -> q^d) */
    3573             : static GEN
    3574       23268 : mfbd_i(GEN F, long d)
    3575             : {
    3576             :   GEN D, NK, gk, CHI;
    3577       23268 :   if (d == 1) return F;
    3578        8127 :   if (d <= 0) pari_err_TYPE("mfbd [d <= 0]", stoi(d));
    3579        8127 :   if (mf_get_type(F) != t_MF_BD) D = utoi(d);
    3580           7 :   else { D = mului(d, gel(F,3)); F = gel(F,2); }
    3581        8127 :   gk = mf_get_gk(F); CHI = mf_get_CHI(F);
    3582        8127 :   if (typ(gk) != t_INT) CHI = mfcharmul(CHI, get_mfchar(utoi(d << 2)));
    3583        8127 :   NK = mkgNK(muliu(mf_get_gN(F), d), gk, CHI, mf_get_field(F));
    3584        8127 :   return tag2(t_MF_BD, NK, F, D);
    3585             : }
    3586             : GEN
    3587          28 : mfbd(GEN F, long d)
    3588             : {
    3589          28 :   pari_sp av = avma;
    3590          28 :   if (!checkmf_i(F)) pari_err_TYPE("mfbd",F);
    3591          28 :   return gerepilecopy(av, mfbd_i(F, d));
    3592             : }
    3593             : 
    3594             : static GEN
    3595          14 : c_shimura(long n, GEN F, long t)
    3596             : {
    3597          14 :   GEN Pn, V, R, a0, CHI = mf_get_CHI(F);
    3598          14 :   long m, ND, D, Da, vt, ord = mfcharorder(CHI);
    3599          14 :   long N = mf_get_N(F), r = mf_get_r(F), D4;
    3600          14 :   D = odd(r) ? -t : t; if ((D & 3L) != 1) D <<= 2;
    3601          14 :   Da = labs(D); ND = N*Da; D4 = D << 2;
    3602          14 :   V = mfcoefs_i(F, n*n, t); a0 = gel(V, 1);
    3603          14 :   R = cgetg(n + 2, t_VEC);
    3604          14 :   Pn = mfcharpol(CHI); vt = varn(Pn);
    3605          14 :   if (gequal0(a0)) gel(R, 1) = gen_0;
    3606             :   else
    3607             :   {
    3608           7 :     GEN CHID = induceN(clcm(mfcharmodulus(CHI), labs(D4)), CHI);
    3609           7 :     CHID = mfcharmul_i(CHID, induce(gel(CHID,1), stoi(D4)));
    3610           7 :     gel(R, 1) = gmul(a0, charLFwtk(r, CHID, mfcharorder(CHID)));
    3611             :   }
    3612         147 :   for (m = 1; m <= n; m++)
    3613             :   {
    3614         133 :     long m2 = m >> vals(m), i;
    3615         133 :     GEN Dm = mydivisorsu(m2), S = gen_0;
    3616         371 :     for (i = 1; i < lg(Dm); i++)
    3617             :     {
    3618         238 :       long e = Dm[i];
    3619         238 :       if (cgcd(e, ND) == 1)
    3620             :       {
    3621         238 :         long me = m/e, a = mfcharevalord(CHI, e, ord);
    3622         238 :         GEN c, C = powuu(e,r-1);
    3623         238 :         if (kross(D4, e) == -1) C = negi(C);
    3624         238 :         c = mygmodulo_lift(a, ord, C, vt);
    3625         238 :         S = gadd(S, gmul(c, gel(V, me*me + 1)));
    3626             :       }
    3627             :     }
    3628         133 :     gel(R, m+1) = S;
    3629             :   }
    3630          14 :   return degpol(Pn) > 1? gmodulo(R, Pn): R;
    3631             : }
    3632             : GEN
    3633          21 : mfshimura(GEN F, long t)
    3634             : {
    3635          21 :   pari_sp av = avma;
    3636             :   GEN gk, CHI, G, res, mf;
    3637             :   long r;
    3638          21 :   if (!checkmf_i(F)) pari_err_TYPE("mfshimura",F);
    3639          21 :   gk = mf_get_gk(F);
    3640          21 :   if (typ(gk) != t_FRAC) pari_err_TYPE("mfshimura [integral weight]", F);
    3641          21 :   r = mf_get_r(F);
    3642          21 :   if (r <= 0) pari_err_DOMAIN("mfshimura", "weight", "<=", ghalf, gk);
    3643          21 :   if (t <= 0 || !uissquarefree(t))
    3644           7 :     pari_err_TYPE("shimura [t not positive squarefree]", stoi(t));
    3645          14 :   CHI = mf_get_CHI(F);
    3646          14 :   mf = mfinit_Nkchi(mf_get_N(F) >> 1, r << 1, mfcharpow(CHI, gen_2), mf_FULL, 0);
    3647          14 :   G = c_shimura(mfsturm(mf), F, t);
    3648          14 :   res = mftobasis_i(mf, G);
    3649          14 :   G = mflinear(mf, res);
    3650          14 :   return gerepilecopy(av, mkvec3(mf, G, res));
    3651             : }
    3652             : 
    3653             : /* W ZabM (ZM if n = 1), a t_INT or NULL, b t_INT, ZXQ mod P or NULL.
    3654             :  * Write a/b = A/d with d t_INT and A Zab return [W,d,A,P] */
    3655             : static GEN
    3656        6125 : mkMinv(GEN W, GEN a, GEN b, GEN P)
    3657             : {
    3658        6125 :   GEN A = (b && typ(b) == t_POL)? Q_remove_denom(QXQ_inv(b,P), &b): NULL;
    3659        6125 :   if (a && b)
    3660             :   {
    3661         672 :     a = Qdivii(a,b);
    3662         672 :     if (typ(a) == t_INT) b = gen_1; else { b = gel(a,2); a = gel(a,1); }
    3663         672 :     if (is_pm1(a)) a = NULL;
    3664             :   }
    3665        6125 :   if (a) A = A? ZX_Z_mul(A,a): a; else if (!A) A = gen_1;
    3666        6125 :   if (!b) b = gen_1;
    3667        6125 :   if (!P) P = gen_0;
    3668        6125 :   return mkvec4(W,b,A,P);
    3669             : }
    3670             : /* M square invertible QabM, return [M',d], M*M' = d*Id */
    3671             : static GEN
    3672         189 : QabM_Minv(GEN M, GEN P, long n)
    3673             : {
    3674             :   GEN dW, W, dM;
    3675         189 :   M = Q_remove_denom(M, &dM);
    3676         189 :   W = P? ZabM_inv(liftpol_shallow(M), P, n, &dW): ZM_inv(M, &dW);
    3677         189 :   return mkMinv(W, dM, dW, P);
    3678             : }
    3679             : /* Simplified form of mfclean, after a QabM_indexrank: M a ZabM with full
    3680             :  * column rank and z = indexrank(M) is known */
    3681             : static GEN
    3682        2849 : mfclean2(GEN M, GEN z, GEN P, long n)
    3683             : {
    3684        2849 :   GEN d, Minv, y = gel(z,1), W = rowpermute(M, y);
    3685        2849 :   W = P? ZabM_inv(liftpol_shallow(W), P, n, &d): ZM_inv(W, &d);
    3686        2849 :   M = rowslice(M, 1, y[lg(y)-1]);
    3687        2849 :   Minv = mkMinv(W, NULL, d, P);
    3688        2849 :   return mkvec3(y, Minv, M);
    3689             : }
    3690             : /* M QabM, lg(M)>1 and [y,z] its rank profile. Let Minv be the inverse of the
    3691             :  * invertible square matrix in mkMinv format. Return [y,Minv, M[..y[#y],]]
    3692             :  * P cyclotomic polynomial of order n != 2 mod 4 or NULL */
    3693             : static GEN
    3694        2002 : mfclean(GEN M, GEN P, long n)
    3695             : {
    3696        2002 :   GEN W, v, y, z, d, Minv, dM, MdM = Q_remove_denom(M, &dM);
    3697        2002 :   if (n == 1)
    3698        1365 :     W = ZM_pseudoinv_i(MdM, &v, &d);
    3699             :   else
    3700         637 :     W = ZabM_pseudoinv(liftpol_shallow(MdM), P, n, &v, &d);
    3701        2002 :   y = gel(v,1);
    3702        2002 :   z = gel(v,2);
    3703        2002 :   if (lg(z) != lg(MdM)) M = vecpermute(M,z);
    3704        2002 :   M = rowslice(M, 1, y[lg(y)-1]);
    3705        2002 :   Minv = mkMinv(W, dM, d, P);
    3706        2002 :   return mkvec3(y, Minv, M);
    3707             : }
    3708             : /* call mfclean using only CHI */
    3709             : static GEN
    3710        1267 : mfcleanCHI(GEN M, GEN CHI)
    3711             : {
    3712        1267 :   long n = mfcharorder_canon(CHI);
    3713        1267 :   GEN P = (n == 1)? NULL: mfcharpol(CHI);
    3714        1267 :   return mfclean(M, P, n);
    3715             : }
    3716             : 
    3717             : /* in place, so that lg(v) is unaffected even if < lg(perm) */
    3718             : void
    3719         994 : vecpermute_inplace(GEN v, GEN perm)
    3720             : {
    3721         994 :   pari_sp av = avma;
    3722         994 :   long i, l = lg(perm);
    3723         994 :   GEN w = cgetg(l,t_VEC);
    3724         994 :   for (i = 1; i < l; i++) gel(w,i) = gel(v,perm[i]);
    3725         994 :   for (i = 1; i < l; i++) gel(v,i) = gel(w,i);
    3726         994 :   avma = av;
    3727         994 : }
    3728             : 
    3729             : /* reset cachenew for new level incorporating new DATA
    3730             :  * (+ possibly initialize 'full' for new allowed levels) */
    3731             : static void
    3732       26033 : reset_cachenew(cachenew_t *cache, long N, GEN DATA)
    3733             : {
    3734             :   long i, n, l;
    3735             :   GEN v;
    3736       26033 :   cache->DATA = DATA;
    3737       52066 :   if (!DATA) return;
    3738       26012 :   n = cache->n;
    3739       26012 :   v = cache->vfull; l = N+1; /* = lg(DATA) */
    3740     1504447 :   for (i = 1; i < l; i++)
    3741     1478435 :     if (typ(gel(v,i)) == t_INT && lg(gel(DATA,i)) != 1)
    3742       43729 :       gel(v,i) = const_vec(n, NULL);
    3743       26012 :   cache->VCHIP = gel(gel(DATA,N),_VCHIP);
    3744             : }
    3745             : /* initialize a cache of newtrace / cusptrace up to index n and level N;
    3746             :  * DATA may be NULL (<=> Tr^new = 0) */
    3747             : static void
    3748       11396 : init_cachenew(cachenew_t *cache, long n, long N, GEN DATA)
    3749             : {
    3750       11396 :   long i, l = N+1; /* = lg(DATA) when DATA != NULL */
    3751             :   GEN v;
    3752       11396 :   cache->n = n;
    3753       11396 :   cache->vnew = v = cgetg(l, t_VEC);
    3754       11396 :   for (i = 1; i < l; i++) gel(v,i) = (N % i)? gen_0: const_vec(n, NULL);
    3755       11396 :   cache->newHIT = cache->newTOTAL = cache->cuspHIT = cache->cuspTOTAL = 0;
    3756       11396 :   cache->vfull = v = zerovec(N);
    3757       11396 :   reset_cachenew(cache, N, DATA);
    3758       11396 : }
    3759             : static void
    3760       14448 : dbg_cachenew(cachenew_t *C)
    3761             : {
    3762       14448 :   if (DEBUGLEVEL >= 2 && C)
    3763           0 :     err_printf("newtrace cache hits: new = %ld/%ld, cusp = %ld/%ld\n",
    3764             :                     C->newHIT, C->newTOTAL, C->cuspHIT, C->cuspTOTAL);
    3765       14448 : }
    3766             : 
    3767             : /* newtrace_{N,k}(d*i), i = n0, ..., n */
    3768             : static GEN
    3769      106099 : colnewtrace(long n0, long n, long d, long N, long k, cachenew_t *cache)
    3770             : {
    3771      106099 :   GEN v = cgetg(n-n0+2, t_COL);
    3772             :   long i;
    3773      106099 :   for (i = n0; i <= n; i++) gel(v, i-n0+1) = mfnewtracecache(N, k, i*d, cache);
    3774      106099 :   return v;
    3775             : }
    3776             : /* T_n(l*m0, l*(m0+1), ..., l*m) F, F = t_MF_NEWTRACE [N,k],DATA, cache
    3777             :  * contains DATA != NULL as well as cached values of F */
    3778             : static GEN
    3779       58667 : heckenewtrace(long m0, long m, long l, long N, long NBIG, long k, long n, cachenew_t *cache)
    3780             : {
    3781       58667 :   long lD, a, k1, nl = n*l;
    3782       58667 :   GEN D, V, v = colnewtrace(m0, m, nl, N, k, cache); /* d=1 */
    3783             :   GEN VCHIP;
    3784       58667 :   if (n == 1) return v;
    3785       37583 :   VCHIP = cache->VCHIP;
    3786       37583 :   D = mydivisorsu(u_ppo(n, NBIG)); lD = lg(D);
    3787       37583 :   k1 = k - 1;
    3788       83069 :   for (a = 2; a < lD; a++)
    3789             :   { /* d > 1, (d,N) = 1 */
    3790       45486 :     long i, j, d = D[a], c = cgcd(l, d), dl = d/c, m0d = ceildiv(m0, dl);
    3791       45486 :     GEN C = vchip_lift(VCHIP, d, powuu(d, k1));
    3792             :     /* m0=0: i = 1 => skip F(0) = 0 */
    3793       45486 :     if (!m0) { i = 1; j = dl; } else { i = 0; j = m0d*dl; }
    3794       45486 :     V = colnewtrace(m0d, m/dl, nl/(d*c), N, k, cache);
    3795             :     /* C = chi(d) d^(k-1) */
    3796      432768 :     for (; j <= m; i++, j += dl)
    3797      387282 :       gel(v,j-m0+1) = gadd(gel(v,j-m0+1), vchip_mod(VCHIP, gmul(C,gel(V,i+1))));
    3798             :   }
    3799       37583 :   return v;
    3800             : }
    3801             : 
    3802             : /* tf a t_MF_NEWTRACE */
    3803             : static GEN
    3804        1638 : tf_get_DATA(GEN tf) { return gel(tf,2); }
    3805             : 
    3806             : /* Given v = an[i], return an[d*i] */
    3807             : static GEN
    3808         350 : anextract(GEN v, long n, long d)
    3809             : {
    3810         350 :   GEN w = cgetg(n+2, t_VEC);
    3811             :   long i;
    3812         350 :   for (i = 0; i <= n; i++) gel(w, i+1) = gel(v, i*d+1);
    3813         350 :   return w;
    3814             : }
    3815             : /* T_n(F)(0, l, ..., l*m) */
    3816             : static GEN
    3817        2604 : hecke_i(long m, long l, GEN F, GEN DATA)
    3818             : {
    3819             :   long k, n, nN, NBIG, lD, M, a, t, nl;
    3820             :   GEN D, v, AN, CHI;
    3821        2604 :   if (typ(DATA) == t_VEC) return c_mfheckef2(m, l, F, DATA);/* 1/2-integral k */
    3822        2506 :   k = mf_get_k(F);
    3823        2506 :   n = DATA[1]; nl = n*l;
    3824        2506 :   nN = DATA[2];
    3825        2506 :   NBIG = DATA[3];
    3826        2506 :   if (nN == 1) return mfcoefs_i(F,m,nl);
    3827        1813 :   if (mf_get_type(F) == t_MF_NEWTRACE)
    3828             :   { /* inline F to allow cache */
    3829             :     cachenew_t cache;
    3830        1638 :     long N = mf_get_N(F);
    3831        1638 :     GEN DATA = newtrace_DATA(N, tf_get_DATA(F)); /* != NULL */
    3832        1638 :     init_cachenew(&cache, m*nl, N, DATA);
    3833        1638 :     v = heckenewtrace(0, m, l, N, NBIG, k, n, &cache);
    3834        1638 :     dbg_cachenew(&cache);
    3835        1638 :     settyp(v, t_VEC); return v;
    3836             :   }
    3837         175 :   CHI = mf_get_CHI(F);
    3838         175 :   D = mydivisorsu(nN); lD = lg(D);
    3839         175 :   M = m + 1;
    3840         175 :   t = nN * cgcd(nN, l);
    3841         175 :   AN = mfcoefs_i(F, m * t, nl / t); /* usually nl = t and we gain nothing */
    3842         175 :   v = anextract(AN, m, t); /* mfcoefs(F, m, nl); d = 1 */
    3843         350 :   for (a = 2; a < lD; a++)
    3844             :   { /* d > 1, (d, N) = 1 */
    3845         175 :     long d = D[a], c = cgcd(l, d), dl = d/c, i, idl;
    3846         175 :     GEN C = gmul(mfchareval_i(CHI, d), powuu(d, k-1));
    3847         175 :     GEN V = anextract(AN, m/dl, t/(d*c)); /* mfcoefs(F, m/dl, nl/(d*c)) */
    3848         889 :     for (i = idl = 1; idl <= M; i++, idl += dl)
    3849         714 :       gel(v,idl) = gadd(gel(v,idl), gmul(C, gel(V,i)));
    3850             :   }
    3851         175 :   return v;
    3852             : }
    3853             : 
    3854             : static GEN
    3855       10003 : mkmf(GEN x1, GEN x2, GEN x3, GEN x4, GEN x5)
    3856             : {
    3857       10003 :   GEN MF = obj_init(5, 4);
    3858       10003 :   gel(MF,1) = x1;
    3859       10003 :   gel(MF,2) = x2;
    3860       10003 :   gel(MF,3) = x3;
    3861       10003 :   gel(MF,4) = x4;
    3862       10003 :   gel(MF,5) = x5; return MF;
    3863             : }
    3864             : 
    3865             : /* return an integer b such that p | b => T_p^k Tr^new = 0, for all k > 0 */
    3866             : static long
    3867        6265 : get_badj(long N, long FC)
    3868             : {
    3869        6265 :   GEN fa = myfactoru(N), P = gel(fa,1), E = gel(fa,2);
    3870        6265 :   long i, b = 1, l = lg(P);
    3871       16723 :   for (i = 1; i < l; i++)
    3872       10458 :     if (E[i] > 1 && u_lval(FC, P[i]) < E[i]) b *= P[i];
    3873        6265 :   return b;
    3874             : }
    3875             : 
    3876             : /* Find basis of newspace using closures; assume k >= 2 and !badchar.
    3877             :  * Return NULL if space is empty, else
    3878             :  * [mf1, list of closures T(j)traceform, list of corresponding j, matrix] */
    3879             : static GEN
    3880       12992 : mfnewinit(long N, long k, GEN CHI, cachenew_t *cache, long init)
    3881             : {
    3882             :   GEN S, vj, M, CHIP, mf1, listj, DATA, P;
    3883             :   long j, ct, ctlj, dim, jin, SB, sb, two, ord, FC, badj;
    3884             : 
    3885       12992 :   dim = mfnewdim(N, k, CHI);
    3886       12992 :   if (!dim && !init) return NULL;
    3887        6265 :   sb = mfsturmNk(N, k);
    3888        6265 :   CHIP = mfchartoprimitive(CHI, &FC);
    3889        6265 :   DATA = initnewtrace(N,CHIP); /* NULL if dim = 0 and init */
    3890        6265 :   badj = get_badj(N, FC);
    3891             :   /* try sbsmall first: Sturm bound not sharp for new space */
    3892        6265 :   SB = ceilA1(N, k);
    3893        6265 :   listj = cgetg(2*sb + 3, t_VECSMALL);
    3894      290647 :   for (j = ctlj = 1; ctlj < 2*sb + 3; j++)
    3895      284382 :     if (cgcd(j, badj) == 1) listj[ctlj++] = j;
    3896        6265 :   if (init)
    3897             :   {
    3898        3493 :     init_cachenew(cache, (SB+1)*listj[dim+1], N, DATA);
    3899        3493 :     if (init == -1 || !dim) return NULL; /* old space or dim = 0 */
    3900             :   }
    3901             :   else
    3902        2772 :     reset_cachenew(cache, N, DATA);
    3903             :   /* cache.DATA is not NULL */
    3904        5852 :   ord = mfcharorder_canon(CHIP);
    3905        5852 :   P = ord == 1? NULL: mfcharpol(CHIP);
    3906        5852 :   vj = cgetg(dim+1, t_VECSMALL);
    3907        5852 :   M = cgetg(dim+1, t_MAT);
    3908        5859 :   for (two = 1, ct = 0, jin = 1; two <= 2; two++)
    3909             :   {
    3910        5859 :     long a, jlim = jin + sb;
    3911       16471 :     for (a = jin; a <= jlim; a++)
    3912             :     {
    3913             :       GEN z, vecz;
    3914       16464 :       ct++; vj[ct] = listj[a];
    3915       16464 :       gel(M, ct) = heckenewtrace(0, SB, 1, N, N, k, vj[ct], cache);
    3916       16464 :       if (ct < dim) continue;
    3917             : 
    3918        6349 :       z = QabM_indexrank(M, P, ord);
    3919        6349 :       vecz = gel(z, 2); ct = lg(vecz) - 1;
    3920        6349 :       if (ct == dim) { M = mkvec3(z, gen_0, M); break; } /*maximal rank, done*/
    3921         497 :       vecpermute_inplace(M, vecz);
    3922         497 :       vecpermute_inplace(vj, vecz);
    3923             :     }
    3924        5859 :     if (a <= jlim) break;
    3925             :     /* sbsmall was not sufficient, use Sturm bound: must extend M */
    3926          70 :     for (j = 1; j <= ct; j++)
    3927             :     {
    3928          63 :       GEN t = heckenewtrace(SB + 1, sb, 1, N, N, k, vj[j], cache);
    3929          63 :       gel(M,j) = shallowconcat(gel(M, j), t);
    3930             :     }
    3931           7 :     jin = jlim + 1; SB = sb;
    3932             :   }
    3933        5852 :   S = cgetg(dim + 1, t_VEC);
    3934        5852 :   if (dim)
    3935             :   { /* remove newtrace data from S to save space: negligible slowdown */
    3936        5852 :     GEN tf = tag(t_MF_NEWTRACE, mkNK(N,k,CHI), CHI);
    3937        5852 :     for (j = 1; j <= dim; j++) gel(S, j) = mfhecke_i(N, k, CHIP, tf, vj[j]);
    3938             :   }
    3939        5852 :   dbg_cachenew(cache);
    3940        5852 :   mf1 = mkvec4(utoipos(N), utoipos(k), CHI, utoi(mf_NEW));
    3941        5852 :   return mkmf(mf1, cgetg(1, t_VEC), S, vj, M);
    3942             : }
    3943             : 
    3944             : /* Bd(f)[m0..m], v = f[ceil(m0/d)..floor(m/d)], m0d = ceil(m0/d) */
    3945             : static GEN
    3946       47278 : RgC_Bd_expand(long m0, long m, GEN v, long d, long m0d)
    3947             : {
    3948             :   long i, j;
    3949             :   GEN w;
    3950       47278 :   if (d == 1) return v;
    3951       12901 :   w = zerocol(m-m0+1);
    3952       12901 :   if (!m0) { i = 1; j = d; } else { i = 0; j = m0d*d; }
    3953       12901 :   for (; j <= m; i++, j += d) gel(w,j-m0+1) = gel(v,i+1);
    3954       12901 :   return w;
    3955             : }
    3956             : /* S a non-empty vector of t_MF_BD(t_MF_HECKE(t_MF_NEWTRACE)); M the matrix
    3957             :  * of their coefficients up to m0 (~ mfvectomat) or NULL (empty),
    3958             :  * extend it to coeffs up to m > m0. The forms B_d(T_j(tf_N))in S should be
    3959             :  * sorted by level N, then j, then increasing d. No reordering here. */
    3960             : static GEN
    3961        6531 : bhnmat_extend(GEN M, long m, long r, GEN S, cachenew_t *cache)
    3962             : {
    3963        6531 :   long i, m0, Nold = 0, jold = 0, l = lg(S);
    3964        6531 :   GEN MAT = cgetg(l, t_MAT), v = NULL;
    3965        6531 :   m0 = M? nbrows(M): 0;
    3966       53809 :   for (i = 1; i < l; i++)
    3967             :   {
    3968             :     long d, j, m0d, N;
    3969       47278 :     GEN DATA, c, f = bhn_parse(gel(S,i), &d,&j); /* t_MF_NEWTRACE */
    3970       47278 :     N = mf_get_N(f); DATA = gel(f,2);
    3971       47278 :     m0d = ceildiv(m0,d);
    3972       47278 :     if (N!=Nold)
    3973       11865 :     { reset_cachenew(cache, N, newtrace_DATA(N,DATA)); Nold=N; jold=0; }
    3974       47278 :     if (!cache->DATA) { gel(MAT,i) = zerocol(m+1); continue; }
    3975       47278 :     if (j!=jold || m0)
    3976       40502 :     { v = heckenewtrace(m0d, m/d, r, N, N, mf_get_k(f), j,cache); jold=j; }
    3977       47278 :     c = RgC_Bd_expand(m0, m, v, d, m0d);
    3978       47278 :     if (M) c = shallowconcat(gel(M,i), c);
    3979       47278 :     gel(MAT,i) = c;
    3980             :   }
    3981        6531 :   return MAT;
    3982             : }
    3983             : 
    3984             : static GEN
    3985        2639 : mfinitcusp(long N, long k, GEN CHI, cachenew_t *cache, long space)
    3986             : {
    3987             :   long L, l, lDN1, FC, N1, d1, i, init;
    3988        2639 :   GEN vS, vMjd, DN1, vmf, CHIP = mfchartoprimitive(CHI, &FC);
    3989             : 
    3990        2639 :   d1 = (space == mf_OLD)? mfolddim_i(N, k, CHIP): mfcuspdim(N, k, CHIP);
    3991        2639 :   if (!d1) return NULL;
    3992        2331 :   N1 = N/FC; DN1 = mydivisorsu(N1); lDN1 = lg(DN1);
    3993        2331 :   init = (space == mf_OLD)? -1: 1;
    3994        2331 :   vmf = cgetg(lDN1, t_VEC);
    3995       14161 :   for (i = lDN1 - 1, l = 1; i; i--)
    3996             :   { /* by decreasing level to allow cache */
    3997       11830 :     GEN mf = mfnewinit(FC*DN1[i], k, CHIP, cache, init);
    3998       11830 :     if (mf) gel(vmf, l++) = mf;
    3999       11830 :     init = 0;
    4000             :   }
    4001        2331 :   setlg(vmf,l); vmf = vecreverse(vmf); /* reorder by increasing level */
    4002             : 
    4003        2331 :   L = mfsturmNk(N, k)+1;
    4004        2331 :   vS = vectrunc_init(L);
    4005        2331 :   vMjd = vectrunc_init(L);
    4006        7392 :   for (i = 1; i < l; i++)
    4007             :   {
    4008        5061 :     GEN DNM, mf = gel(vmf,i), S = MF_get_S(mf), vj = MFnew_get_vj(mf);
    4009        5061 :     long a, lDNM, lS = lg(S), M = MF_get_N(mf);
    4010        5061 :     DNM = mydivisorsu(N / M); lDNM = lg(DNM);
    4011       19159 :     for (a = 1; a < lS; a++)
    4012             :     {
    4013       14098 :       GEN tf = gel(S,a);
    4014       14098 :       long b, j = vj[a];
    4015       34867 :       for (b = 1; b < lDNM; b++)
    4016             :       {
    4017       20769 :         long d = DNM[b];
    4018       20769 :         vectrunc_append(vS, mfbd_i(tf, d));
    4019       20769 :         vectrunc_append(vMjd, mkvecsmall3(M, j, d));
    4020             :       }
    4021             :     }
    4022             :   }
    4023        2331 :   return mkmf(NULL, cgetg(1, t_VEC), vS, vMjd, NULL);
    4024             : }
    4025             : 
    4026             : long
    4027        4130 : mfsturm_mf(GEN mf)
    4028             : {
    4029        4130 :   GEN Mindex = MF_get_Mindex(mf);
    4030        4130 :   long n = lg(Mindex)-1;
    4031        4130 :   return n? Mindex[n]: 0;
    4032             : }
    4033             : 
    4034             : long
    4035         399 : mfsturm(GEN mf)
    4036             : {
    4037             :   long N, nk, dk;
    4038             :   GEN CHI;
    4039         399 :   if (checkMF_i(mf)) return mfsturm_mf(mf);
    4040           7 :   checkNK2(mf, &N, &nk, &dk, &CHI, 0);
    4041           7 :   return dk == 1 ? mfsturmNk(N, nk) : mfsturmNk(N, (nk + 1) >> 1);
    4042             : }
    4043             : 
    4044             : long
    4045           7 : mfisequal(GEN F, GEN G, long lim)
    4046             : {
    4047           7 :   pari_sp av = avma;
    4048             :   long t, sb;
    4049           7 :   if (!checkmf_i(F)) pari_err_TYPE("mfisequal",F);
    4050           7 :   if (!checkmf_i(G)) pari_err_TYPE("mfisequal",G);
    4051           7 :   if (lim) sb = lim;
    4052             :   else
    4053             :   {
    4054             :     GEN gN, gk;
    4055           7 :     gN = mf_get_gN(F); gk = mf_get_gk(F);
    4056           7 :     sb = mfsturmNgk(itou(gN), gk);
    4057           7 :     gN = mf_get_gN(G); gk = mf_get_gk(G);
    4058           7 :     sb = maxss(sb, mfsturmNgk(itou(gN), gk));
    4059             :   }
    4060           7 :   t = gequal(mfcoefs_i(F, sb+1, 1), mfcoefs_i(G, sb+1, 1));
    4061           7 :   avma = av; return t;
    4062             : }
    4063             : 
    4064             : GEN
    4065          35 : mffields(GEN mf)
    4066             : {
    4067          35 :   if (checkmf_i(mf)) return gcopy(mf_get_field(mf));
    4068          35 :   checkMF(mf); return gcopy(MF_get_fields(mf));
    4069             : }
    4070             : 
    4071             : /* F non-empty vector of forms of the form mfdiv(mflinear(B,v), E) where E
    4072             :  * does not vanish at oo, or mflinear(B,v). Apply mflinear(F, L) */
    4073             : static GEN
    4074         623 : mflineardiv_linear(GEN F, GEN L)
    4075             : {
    4076         623 :   long l = lg(F), j;
    4077             :   GEN v, E, f;
    4078         623 :   if (lg(L) != l) pari_err_DIM("mflineardiv_linear");
    4079         623 :   f = gel(F,1); /* l > 1 */
    4080         623 :   if (mf_get_type(f) != t_MF_DIV) return mflinear_linear(F, L);
    4081         497 :   E = gel(f,3);
    4082         497 :   v = cgetg(l, t_VEC);
    4083         497 :   for (j = 1; j < l; j++) { GEN f = gel(F,j); gel(v,j) = gel(f,2); }
    4084         497 :   return mfdiv_val(mflinear_linear(v,L), E, 0);
    4085             : }
    4086             : static GEN
    4087         175 : vecmflineardiv_linear(GEN F, GEN M)
    4088             : {
    4089         175 :   long i, l = lg(M);
    4090         175 :   GEN v = cgetg(l, t_VEC);
    4091         175 :   for (i = 1; i < l; i++) gel(v,i) = mflineardiv_linear(F, gel(M,i));
    4092         175 :   return v;
    4093             : }
    4094             : GEN
    4095         126 : mfeigenbasis(GEN mf)
    4096             : {
    4097         126 :   pari_sp ltop = avma;
    4098             :   GEN mfsplit, S, res, vP;
    4099             :   long i, l, k;
    4100             : 
    4101         126 :   checkMF(mf);
    4102         126 :   k = MF_get_k(mf);
    4103         126 :   S = MF_get_S(mf); if (lg(S) == 1) return cgetg(1, t_VEC);
    4104         126 :   mfsplit = MF_get_newforms(mf);
    4105         126 :   vP = MF_get_fields(mf);
    4106         126 :   if (k == 1)
    4107             :   {
    4108          42 :     res = vecmflineardiv_linear(S, mfsplit);
    4109          42 :     l = lg(res);
    4110             :   }
    4111             :   else
    4112             :   {
    4113          84 :     res = cgetg_copy(mfsplit, &l);
    4114         301 :     for (i = 1; i < l; i++)
    4115         217 :       gel(res,i) = mflinear_bhn(S, gel(mfsplit,i));
    4116             :   }
    4117         126 :   for (i = 1; i < l; i++) mf_setfield(gel(res,i), gel(vP,i));
    4118         126 :   return gerepilecopy(ltop, res);
    4119             : }
    4120             : 
    4121             : /* Minv = [M, d, A], v a t_COL; A a Zab, d a t_INT; return (A/d) * M*v */
    4122             : static GEN
    4123        4130 : Minv_RgC_mul(GEN Minv, GEN v)
    4124             : {
    4125        4130 :   GEN M = gel(Minv,1), d = gel(Minv,2), A = gel(Minv,3);
    4126        4130 :   v = RgM_RgC_mul(M, v);
    4127        4130 :   if (!equali1(A)) v = RgC_Rg_mul(v, A);
    4128        4130 :   if (!equali1(d)) v = RgC_Rg_div(v, d);
    4129        4130 :   return v;
    4130             : }
    4131             : /* map to C an Minv struct */
    4132             : static GEN
    4133           0 : Minv_embed(GEN Minv, GEN vz)
    4134             : {
    4135           0 :   GEN M = gel(Minv,1), d = gel(Minv,2), A = gel(Minv,3);
    4136           0 :   M = RgM_embed(M, vz);
    4137           0 :   if (!equali1(A))
    4138             :   {
    4139           0 :     A = Rg_embed(A, vz);
    4140           0 :     M = RgM_Rg_mul(M, gdiv(A,d));
    4141             :   }
    4142           0 :   else if (!equali1(d)) M = RgM_Rg_div(M, d);
    4143           0 :   return mkvec2(M,gen_1);
    4144             : }
    4145             : static GEN
    4146         882 : Minv_RgM_mul(GEN Minv, GEN B)
    4147             : {
    4148         882 :   long j, l = lg(B);
    4149         882 :   GEN M = cgetg(l, t_MAT);
    4150         882 :   for (j = 1; j < l; j++) gel(M,j) = Minv_RgC_mul(Minv, gel(B,j));
    4151         882 :   return M;
    4152             : }
    4153             : /* B * Minv; allow B = NULL for Id */
    4154             : static GEN
    4155        1736 : RgM_Minv_mul(GEN B, GEN Minv)
    4156             : {
    4157        1736 :   GEN M = gel(Minv,1), d = gel(Minv,2), A = gel(Minv,3), P = gel(Minv,4);
    4158        1736 :   if (B) M = RgM_mul(B, M);
    4159        1736 :   if (!equali1(A))
    4160             :   {
    4161         644 :     M = RgM_Rg_mul(M, A);
    4162         644 :     if (typ(A) != t_INT) M = RgXQM_red(M,P);
    4163             :   }
    4164        1736 :   if (!equali1(d)) M = RgM_Rg_div(M,d);
    4165        1736 :   return M;
    4166             : }
    4167             : 
    4168             : /* perm vector of strictly increasing indices, v a vector or arbitrary length;
    4169             :  * the last r entries of perm fall beyond v.
    4170             :  * Return v o perm[1..(-r)], discarding the last r entries of v */
    4171             : static GEN
    4172         637 : vecpermute_partial(GEN v, GEN perm, long *r)
    4173             : {
    4174         637 :   long i, n = lg(v)-1, l = lg(perm);
    4175             :   GEN w;
    4176         637 :   if (perm[l-1] <= n) { *r = 0; return vecpermute(v,perm); }
    4177          63 :   for (i = 1; i < l; i++)
    4178          63 :     if (perm[i] > n) break;
    4179          21 :   *r = l - i; l = i;
    4180          21 :   w = cgetg(l, typ(v));
    4181          21 :   for (i = 1; i < l; i++) gel(w,i) = gel(v,perm[i]);
    4182          21 :   return w;
    4183             : }
    4184             : 
    4185             : /* given form F, find coeffs of F on mfbasis(mf). If power series, not
    4186             :  * guaranteed correct if precision less than Sturm bound */
    4187             : static GEN
    4188         763 : mftobasis_i(GEN mf, GEN F)
    4189             : {
    4190             :   GEN v, Mindex, Minv;
    4191         763 :   if (!MF_get_dim(mf)) return cgetg(1, t_COL);
    4192         763 :   Mindex = MF_get_Mindex(mf);
    4193         763 :   Minv = MF_get_Minv(mf);
    4194         763 :   if (checkmf_i(F))
    4195             :   {
    4196         266 :     long n = Mindex[lg(Mindex)-1];
    4197         266 :     v = vecpermute(mfcoefs_i(F, n, 1), Mindex);
    4198         266 :     return Minv_RgC_mul(Minv, v);
    4199             :   }
    4200             :   else
    4201             :   {
    4202         497 :     GEN A = gel(Minv,1), d = gel(Minv,2);
    4203             :     long r;
    4204         497 :     v = F;
    4205         497 :     switch(typ(F))
    4206             :     {
    4207           7 :       case t_SER: v = sertocol(v);
    4208         490 :       case t_VEC: case t_COL: break;
    4209           7 :       default: pari_err_TYPE("mftobasis", F);
    4210             :     }
    4211         490 :     if (lg(v) == 1) pari_err_TYPE("mftobasis",v);
    4212         490 :     v = vecpermute_partial(v, Mindex, &r);
    4213         490 :     if (!r) return Minv_RgC_mul(Minv, v); /* single solution */
    4214             :     /* affine space of dimension r */
    4215          21 :     v = RgM_RgC_mul(vecslice(A, 1, lg(v)-1), v);
    4216          21 :     if (!equali1(d)) v = RgC_Rg_div(v,d);
    4217          21 :     return mkvec2(v, vecslice(A, lg(A)-r, lg(A)-1));
    4218             :   }
    4219             : }
    4220             : 
    4221             : static GEN
    4222         224 : const_mat(long n, GEN x)
    4223             : {
    4224         224 :   long j, l = n+1;
    4225         224 :   GEN A = cgetg(l,t_MAT);
    4226         224 :   for (j = 1; j < l; j++) gel(A,j) = const_col(n, x);
    4227         224 :   return A;
    4228             : }
    4229             : 
    4230             : /* L is the mftobasis of a form on CUSP space */
    4231             : static GEN
    4232         112 : mftonew_i(GEN mf, GEN L, long *plevel)
    4233             : {
    4234             :   GEN S, listMjd, CHI, res, Aclos, Acoef, D, perm;
    4235         112 :   long N1, LC, lD, i, l, t, level, N = MF_get_N(mf);
    4236             : 
    4237         112 :   if (MF_get_k(mf) == 1) pari_err_IMPL("mftonew in weight 1");
    4238         112 :   listMjd = MFcusp_get_vMjd(mf);
    4239         112 :   CHI = MF_get_CHI(mf); LC = mfcharconductor(CHI);
    4240         112 :   S = MF_get_S(mf);
    4241             : 
    4242         112 :   N1 = N/LC;
    4243         112 :   D = mydivisorsu(N1); lD = lg(D);
    4244         112 :   perm = cgetg(N1+1, t_VECSMALL);
    4245         112 :   for (i = 1; i < lD; i++) perm[D[i]] = i;
    4246         112 :   Aclos = const_mat(lD-1, cgetg(1,t_VEC));
    4247         112 :   Acoef = const_mat(lD-1, cgetg(1,t_VEC));
    4248         112 :   l = lg(listMjd);
    4249        1631 :   for (i = 1; i < l; i++)
    4250             :   {
    4251             :     long M, d;
    4252             :     GEN v;
    4253        1519 :     if (gequal0(gel(L,i))) continue;
    4254         126 :     v = gel(listMjd, i);
    4255         126 :     M = perm[ v[1]/LC ];
    4256         126 :     d = perm[ v[3] ];
    4257         126 :     gcoeff(Aclos,M,d) = vec_append(gcoeff(Aclos,M,d), gel(S,i));
    4258         126 :     gcoeff(Acoef,M,d) = shallowconcat(gcoeff(Acoef,M,d), gel(L,i));
    4259             :   }
    4260         112 :   res = cgetg(l, t_VEC); level = 1;
    4261         791 :   for (i = t = 1; i < lD; i++)
    4262             :   {
    4263         679 :     long j, M = D[i]*LC;
    4264         679 :     GEN gM = utoipos(M);
    4265        6398 :     for (j = 1; j < lD; j++)
    4266             :     {
    4267        5719 :       GEN f = gcoeff(Aclos,i,j), C, NK;
    4268             :       long d;
    4269        5719 :       if (lg(f) == 1) continue;
    4270         126 :       NK = mf_get_NK(gel(f,1));
    4271         126 :       d = D[j];
    4272         126 :       C = gcoeff(Acoef,i,j);
    4273         126 :       level = clcm(level, M*d);
    4274         126 :       gel(res,t++) = mkvec3(gM, utoipos(d), mflinear_i(NK,f,C));
    4275             :     }
    4276             :   }
    4277         112 :   if (plevel) *plevel = level;
    4278         112 :   setlg(res, t); return res;
    4279             : }
    4280             : GEN
    4281          28 : mftonew(GEN mf, GEN F)
    4282             : {
    4283          28 :   pari_sp av = avma;
    4284          28 :   checkMF(mf);
    4285          28 :   if (MF_get_space(mf) != mf_CUSP)
    4286           7 :     pari_err_TYPE("mftonew [not a cuspidal space]", mf);
    4287          21 :   F = mftobasis_i(mf, F);
    4288          14 :   return gerepilecopy(av, mftonew_i(mf,F, NULL));
    4289             : }
    4290             : long
    4291          14 : mfconductor(GEN mf, GEN F)
    4292             : {
    4293          14 :   pari_sp av = avma;
    4294             :   long N;
    4295          14 :   checkMF(mf);
    4296          14 :   if (MF_get_space(mf) != mf_CUSP)
    4297           7 :     pari_err_TYPE("mfconductor [not a cuspidal space]", mf);
    4298           7 :   F = mftobasis_i(mf, F);
    4299           7 :   (void)mftonew_i(mf, F, &N);
    4300           7 :   avma = av; return N;
    4301             : }
    4302             : 
    4303             : /* vF a vector of mf F of type DIV(LINEAR(BAS,L), f),
    4304             :  * F[2]=LINEAR(BAS,L), F[2][2]=BAS=fixed basis, F[2][3]=L
    4305             :  * F[3]=f; mfvectomat(vF, n) */
    4306             : static GEN
    4307         196 : mflineardivtomat(GEN vF, long n)
    4308             : {
    4309             :   pari_sp btop;
    4310             :   GEN F, BAS, f, fc, V, B, a0;
    4311         196 :   long lBAS, lF = lg(vF), i, j;
    4312             : 
    4313         196 :   if (lF == 1) return cgetg(1,t_MAT);
    4314         189 :   F = gel(vF,1); BAS = gmael(F,2,2); lBAS = lg(BAS);
    4315         189 :   f = mfcoefsser(gel(F,3),n);
    4316         189 :   a0 = polcoeff_i(f, 0, -1);
    4317         189 :   if (gequal0(a0) || gequal1(a0))
    4318         140 :     a0 = NULL;
    4319             :   else
    4320          49 :     f = gdiv(ser_unscale(f, a0), a0);
    4321         189 :   fc = ginv(f);
    4322         189 :   btop = avma;
    4323         189 :   V = zerovec(lBAS - 1);
    4324        1792 :   for (i = 1; i < lBAS; i++)
    4325             :   {
    4326        1603 :     GEN LISer = mfcoefsser(gel(BAS,i),n), f;
    4327        1603 :     if (a0) LISer = gdiv(ser_unscale(LISer, a0), a0);
    4328        1603 :     f = gmul(LISer, fc);
    4329        1603 :     if (a0) f = ser_unscale(f, ginv(a0));
    4330        1603 :     f = sertocol(f);
    4331        1603 :     setlg(f, n+2);
    4332        1603 :     gel(V, i) = f;
    4333        1603 :     if (gc_needed(btop, 1))
    4334             :     {
    4335           0 :       if (DEBUGMEM > 1) pari_warn(warnmem,"mflineardivtomat i = %ld", i);
    4336           0 :       V = gerepilecopy(btop, V);
    4337             :     }
    4338             :   }
    4339         189 :   V = gerepilecopy(btop, V);
    4340         189 :   btop = avma;
    4341         189 :   B = zerovec(lF-1);
    4342         189 :   if (DEBUGLEVEL) err_printf("%ld divs to do\n", lF-1);
    4343         784 :   for (j = 1; j < lF; j++)
    4344             :   {
    4345         595 :     GEN S = gen_0, coe;
    4346         595 :     F = gel(vF, j); /* t_MF_DIV */
    4347         595 :     coe = gdiv(gmael(F,2,3), gmael(F,2,4));
    4348        6636 :     for (i = 1; i < lBAS; i++)
    4349             :     {
    4350        6041 :       GEN co = gel(coe, i);
    4351        6041 :       if (!gequal0(co)) S = gadd(S, gmul(co, gel(V, i)));
    4352             :     }
    4353         595 :     gel(B, j) = S;
    4354         595 :     if (gc_needed(btop, 1))
    4355             :     {
    4356           0 :       if (DEBUGMEM > 1) pari_warn(warnmem,"mflineardivtomat j = %ld", j);
    4357           0 :       gerepileall(btop, 1, &B);
    4358             :     }
    4359             :   }
    4360         189 :   settyp(B, t_MAT); return B;
    4361             : }
    4362             : 
    4363             : /* convert Mindex from row-index to mfcoef indexation: a(n) is stored in
    4364             :  * mfcoefs()[n+1], so subtract 1 from all indices */
    4365             : static GEN
    4366          56 : Mindex_as_coef(GEN mf)
    4367             : {
    4368          56 :   GEN v, Mindex = MF_get_Mindex(mf);
    4369          56 :   long i, l = lg(Mindex);
    4370          56 :   v = cgetg(l, t_VECSMALL);
    4371          56 :   for (i = 1; i < l; i++) v[i] = Mindex[i]-1;
    4372          56 :   return v;
    4373             : }
    4374             : /* B from mflineardivtomat */
    4375             : static GEN
    4376          35 : mfheckematwt1(GEN mf, long n, GEN B)
    4377             : {
    4378          35 :   pari_sp av = avma;
    4379             :   GEN CHI, vm, Minv, D, Q, vC;
    4380             :   long lm, l, lD, k, N, nN, i, j;
    4381             : 
    4382          35 :   l = lg(B);
    4383          35 :   k = MF_get_k(mf);
    4384          35 :   N = MF_get_N(mf);
    4385          35 :   nN = u_ppo(n, N); /* largest divisor of n coprime to N */
    4386          35 :   CHI = MF_get_CHI(mf);
    4387          35 :   vm = Mindex_as_coef(mf); lm = lg(vm);
    4388          35 :   Minv = MF_get_Minv(mf);
    4389          35 :   Q = cgetg(l, t_MAT);
    4390          35 :   for (j = 1; j < l; j++) gel(Q,j) = cgetg(lm, t_COL);
    4391          35 :   D = mydivisorsu(nN); lD = lg(D);
    4392          35 :   vC = cgetg(nN+1, t_VEC);
    4393          63 :   for (j = 2; j < lD; j++) /* skip d = 1 */
    4394             :   {
    4395          28 :     long d = D[j];
    4396          28 :     gel(vC, d) = gmul(mfchareval_i(CHI, d), powuu(d, k-1));
    4397             :   }
    4398             : 
    4399         119 :   for (i = 1; i < lm; i++)
    4400             :   {
    4401          84 :     long m = vm[i], mn = m*n;
    4402          84 :     D = mydivisorsu(cgcd(m, nN)); lD = lg(D);
    4403         308 :     for (j = 1; j < l; j++)
    4404             :     {
    4405         224 :       GEN S = gel(B,j), s = gel(S, mn + 1);
    4406             :       long jj;
    4407         308 :       for (jj = 2; jj < lD; jj++) /* skip d = 1 */
    4408             :       {
    4409          84 :         long d = D[jj]; /* coprime to N */
    4410          84 :         s = gadd(s, gmul(gel(vC,d), gel(S, mn/(d*d) + 1)));
    4411             :       }
    4412         224 :       gcoeff(Q, i, j) = s;
    4413             :     }
    4414             :   }
    4415          35 :   return gerepileupto(av, Minv_RgM_mul(Minv, Q));
    4416             : }
    4417             : 
    4418             : /* mf_NEW != (0), weight > 1, p prime. Use
    4419             :  * T(p) T(j) = T(j*p) + p^{k-1} \chi(p) 1_{p | j, p \nmid N} T(j/p) */
    4420             : static GEN
    4421         763 : mfnewmathecke_p(GEN mf, long p)
    4422             : {
    4423         763 :   pari_sp av = avma;
    4424         763 :   GEN tf, vj = MFnew_get_vj(mf), CHI = MF_get_CHI(mf);
    4425         763 :   GEN Mindex = MF_get_Mindex(mf), Minv = MF_get_Minv(mf);
    4426         763 :   long N = MF_get_N(mf), k = MF_get_k(mf);
    4427         763 :   long i, j, lvj = lg(vj), lim = vj[lvj-1] * p;
    4428         763 :   GEN perm, V, need = zero_zv(lim);
    4429         763 :   GEN M, C = gmul(mfchareval(CHI, p), powuu(p, k-1));
    4430         763 :   tf = mftraceform_new(N, k, CHI);
    4431        3164 :   for (i = 1; i < lvj; i++)
    4432             :   {
    4433        2401 :     j = vj[i]; need[j*p] = 1;
    4434        2401 :     if (N % p && j % p == 0) need[j/p] = 1;
    4435             :   }
    4436         763 :   perm = zero_zv(lim);
    4437         763 :   V = cgetg(lim+1, t_VEC);
    4438       10157 :   for (i = j = 1; i <= lim; i++)
    4439        9394 :     if (need[i]) { gel(V,j) = mfhecke_i(N, k, CHI, tf, i); perm[i] = j; j++; }
    4440         763 :   setlg(V, j);
    4441         763 :   V = bhnmat_extend_nocache(NULL, mfsturm_mf(mf)-1, 1, V);
    4442         763 :   V = rowpermute(V, Mindex); /* V[perm[i]] = coeffs(T_i newtrace) */
    4443         763 :   M = cgetg(lvj, t_MAT);
    4444        3164 :   for (i = 1; i < lvj; i++)
    4445             :   {
    4446             :     GEN t;
    4447        2401 :     j = vj[i]; t = gel(V, perm[j*p]);
    4448        2401 :     if (N % p && j % p == 0) t = RgC_add(t, RgC_Rg_mul(gel(V, perm[j/p]),C));
    4449        2401 :     gel(M,i) = t;
    4450             :   }
    4451         763 :   return gerepileupto(av, Minv_RgM_mul(Minv, M));
    4452             : }
    4453             : 
    4454             : /* Matrix of T(n), assume n > 0 */
    4455             : static GEN
    4456         868 : mfheckemat_i(GEN mf, long n)
    4457             : {
    4458         868 :   pari_sp av = avma;
    4459             :   GEN Minv, v, b, Mindex, DATA, gk;
    4460             :   long j, l, sb, N;
    4461             : 
    4462         868 :   b = MF_get_basis(mf); l = lg(b);
    4463         868 :   if (l == 1) return cgetg(1, t_MAT);
    4464         868 :   if (n == 1) return matid(l-1);
    4465         868 :   gk = MF_get_gk(mf);
    4466         868 :   N = MF_get_N(mf);
    4467         868 :   if (typ(gk) == t_INT)
    4468             :   {
    4469         861 :     if (itou(gk) == 1 && mf_get_type(gel(b,1)) == t_MF_DIV)
    4470             :     {
    4471          21 :       GEN M = mflineardivtomat(MF_get_S(mf), n * mfsturm_mf(mf));
    4472          21 :       return mfheckematwt1(mf, n, M);
    4473             :     }
    4474         840 :     if (MF_get_space(mf) == mf_NEW && uisprime(n))
    4475         763 :       return mfnewmathecke_p(mf, n);
    4476          77 :     DATA = hecke_data(N, n);
    4477             :   }
    4478             :   else
    4479             :   {
    4480           7 :     DATA = heckef2_data(N,n);
    4481           7 :     if (!DATA) return zeromat(l-1,l-1);
    4482             :   }
    4483          84 :   sb = mfsturm_mf(mf)-1;
    4484          84 :   Mindex = MF_get_Mindex(mf);
    4485          84 :   Minv = MF_get_Minv(mf);
    4486          84 :   v = cgetg(l, t_VEC);
    4487         392 :   for (j = 1; j < l; j++)
    4488             :   {
    4489         308 :     GEN vj = hecke_i(sb, 1, gel(b,j), DATA); /* Tn f[j] */
    4490         308 :     settyp(vj,t_COL); gel(v, j) = vecpermute(vj, Mindex);
    4491             :   }
    4492          84 :   return gerepileupto(av, Minv_RgM_mul(Minv,v));
    4493             : }
    4494             : 
    4495             : /* f = \sum_i v[i] T_listj[i] (Trace Form) attached to v; replace by f/a_1(f) */
    4496             : static GEN
    4497        1043 : mf_normalize(GEN mf, GEN v)
    4498             : {
    4499        1043 :   GEN c, dc = NULL, M = MF_get_M(mf), Mindex = MF_get_Mindex(mf);
    4500        1043 :   v = Q_primpart(v);
    4501        1043 :   c = RgMrow_RgC_mul(M, v, 2); /* a_1(f) */
    4502        1043 :   if (gequal1(c)) return v;
    4503         595 :   if (typ(c) == t_POL) c = gmodulo(c, mfcharpol(MF_get_CHI(mf)));
    4504         595 :   if (typ(c) == t_POLMOD && varn(gel(c,1)) == 1 && degpol(gel(c,1)) >= 40
    4505           7 :                          && Mindex[1] == 2
    4506           7 :                          && mfcharorder(MF_get_CHI(mf)) <= 2)
    4507           7 :   { /* normalize using expansion at infinity (small coefficients) */
    4508           7 :     GEN w, P = gel(c,1), a1 = gel(c,2);
    4509           7 :     long i, l = lg(Mindex);
    4510           7 :     w = cgetg(l, t_COL);
    4511           7 :     gel(w,1) = gen_1;
    4512         280 :     for (i = 2; i < l; i++)
    4513             :     {
    4514         273 :       c = liftpol_shallow(RgMrow_RgC_mul(M, v, Mindex[i]));
    4515         273 :       gel(w,i) = QXQ_div_ratlift(c, a1, P);
    4516             :     }
    4517             :     /* w = expansion at oo of normalized form */
    4518           7 :     v = Minv_RgC_mul(MF_get_Minv(mf), Q_remove_denom(w, &dc));
    4519           7 :     v = gmodulo(v, P); /* back to mfbasis coefficients */
    4520             :   }
    4521             :   else
    4522             :   {
    4523         588 :     c = ginv(c);
    4524         588 :     if (typ(c) == t_POLMOD) c = Q_remove_denom(c, &dc);
    4525         588 :     v = RgC_Rg_mul(v, c);
    4526             :   }
    4527         595 :   if (dc) v = RgC_Rg_div(v, dc);
    4528         595 :   return v;
    4529             : }
    4530             : static void
    4531         168 : pol_red(GEN NF, GEN *pP, GEN *pa, long flag)
    4532             : {
    4533         168 :   GEN dP, a, P = *pP;
    4534         168 :   long d = degpol(P);
    4535             : 
    4536         168 :   *pa = a = pol_x(varn(P));
    4537         336 :   if (d > 30) return;
    4538             : 
    4539         161 :   dP = RgX_disc(P);
    4540         161 :   if (typ(dP) != t_INT)
    4541          35 :   { dP = gnorm(dP); if (typ(dP) != t_INT) pari_err_BUG("mfnewsplit"); }
    4542         161 :   if (d == 2 || expi(dP) < 62)
    4543             :   {
    4544         147 :     if (expi(dP) < 31)
    4545         147 :       P = NF? rnfpolredabs(NF, P,flag): polredabs0(P,flag);
    4546             :     else
    4547           0 :       P = NF? rnfpolredbest(NF,P,flag): polredbest(P,flag);
    4548         147 :     if (flag)
    4549             :     {
    4550         133 :       a = gel(P,2); if (typ(a) == t_POLMOD) a = gel(a,2);
    4551         133 :       P = gel(P,1);
    4552             :     }
    4553             :   }
    4554         161 :   *pP = P;
    4555         161 :   *pa = a;
    4556             : }
    4557             : 
    4558             : /* Diagonalize and normalize. See mfsplit for meaning of flag. */
    4559             : static GEN
    4560         770 : mfspclean(GEN mf, GEN NF, long ord, GEN simplesp, long flag)
    4561             : {
    4562         770 :   const long vz = 1;
    4563         770 :   long i, l = lg(simplesp);
    4564         770 :   GEN res = cgetg(l, t_VEC), pols = cgetg(l, t_VEC);
    4565        1827 :   for (i = 1; i < l; i++)
    4566             :   {
    4567        1057 :     GEN ATP = gel(simplesp, i), A = gel(ATP,1), P = gel(ATP,3);
    4568        1057 :     long d = degpol(P);
    4569        1057 :     GEN a, v = (flag && d > flag)? NULL: gel(A,1);
    4570        1057 :     if (d == 1) P = pol_x(vz);
    4571             :     else
    4572             :     {
    4573         168 :       pol_red(NF, &P, &a, !!v);
    4574         168 :       if (v)
    4575             :       { /* Mod(a,P) root of charpoly(T), K*gpowers(a) = eigenvector of T */
    4576         154 :         GEN K, den, M = cgetg(d+1, t_MAT), T = gel(ATP,2);
    4577             :         long j;
    4578         154 :         T = shallowtrans(T);
    4579         154 :         gel(M,1) = vec_ei(d,1); /* basis of cyclic vectors */
    4580         154 :         for (j = 2; j <= d; j++) gel(M,j) = RgM_RgC_mul(T, gel(M,j-1));
    4581         154 :         M = Q_primpart(M);
    4582         196 :         K = NF? ZabM_inv(liftpol_shallow(M), nf_get_pol(NF), ord, &den)
    4583         196 :               : ZM_inv(M,&den);
    4584         154 :         K = shallowtrans(K);
    4585         154 :         v = gequalX(a)? pol_x_powers(d, vz): RgXQ_powers(a, d-1, P);
    4586         154 :         v = gmodulo(RgM_RgC_mul(A, RgM_RgC_mul(K,v)), P);
    4587             :       }
    4588             :     }
    4589        1057 :     gel(res, i) = v? mf_normalize(mf, v): gen_0;
    4590        1057 :     gel(pols,i) = P;
    4591             :   }
    4592         770 :   return mkvec2(res, pols);
    4593             : }
    4594             : 
    4595             : /* return v = v_{X-r}(P), and set Z = P / (X-r)^v */
    4596             : static long
    4597          63 : RgX_valrem_root(GEN P, GEN r, GEN *Z)
    4598             : {
    4599             :   long v;
    4600         126 :   for (v = 0; degpol(P); v++)
    4601             :   {
    4602         126 :     GEN t, Q = RgX_div_by_X_x(P, r, &t);
    4603         126 :     if (!gequal0(t)) break;
    4604          63 :     P = Q;
    4605             :   }
    4606          63 :   *Z = P; return v;
    4607             : }
    4608             : static GEN
    4609         847 : mynffactor(GEN NF, GEN P, long dimlim)
    4610             : {
    4611             :   long i, l, v;
    4612             :   GEN R, E;
    4613         847 :   if (dimlim != 1)
    4614             :   {
    4615         308 :     R = NF? nffactor(NF, P): QX_factor(P);
    4616         308 :     if (!dimlim) return R;
    4617          21 :     E = gel(R,2);
    4618          21 :     R = gel(R,1); l = lg(R);
    4619          98 :     for (i = 1; i < l; i++)
    4620          91 :       if (degpol(gel(R,i)) > dimlim) break;
    4621          21 :     if (i == 1) return NULL;
    4622          21 :     setlg(E,i);
    4623          21 :     setlg(R,i); return mkmat2(R, E);
    4624             :   }
    4625             :   /* dimlim = 1 */
    4626         539 :   R = nfroots(NF, P); l = lg(R);
    4627         539 :   if (l == 1) return NULL;
    4628         476 :   v = varn(P);
    4629         476 :   settyp(R, t_COL);
    4630         476 :   if (degpol(P) == l-1)
    4631         427 :     E = const_vec(l-1, gen_1);
    4632             :   else
    4633             :   {
    4634          49 :     E = cgetg(l, t_COL);
    4635          49 :     for (i = 1; i < l; i++) gel(E,i) = utoi(RgX_valrem_root(P, gel(R,i), &P));
    4636             :   }
    4637         476 :   R = deg1_from_roots(R, v);
    4638         476 :   return mkmat2(R, E);
    4639             : }
    4640             : 
    4641             : /* Let K be a number field attached to NF (Q if NF = NULL). A K-vector
    4642             :  * space of dimension d > 0 is given by a t_MAT A (n x d, full column rank)
    4643             :  * giving a K-basis, X a section (d x n: left pseudo-inverse of A). Return a
    4644             :  * pair (T, fa), where T is an element of the Hecke algebra (a sum of Tp taken
    4645             :  * from vector vTp) acting on A (a d x d t_MAT) and fa is the factorization of
    4646             :  * its characteristic polynomial, limited to factors of degree <= dimlim if
    4647             :  * dimlim != 0 (return NULL if there are no factors of degree <= dimlim) */
    4648             : static GEN
    4649         840 : findbestsplit(GEN NF, GEN vTp, GEN A, GEN X, long dimlim, long vz)
    4650             : {
    4651         840 :   GEN T = NULL, Tkeep = NULL, fakeep = NULL;
    4652         840 :   long lmax = 0, i, lT = lg(vTp);
    4653        1792 :   for (i = 1; i < lT; i++)
    4654             :   {
    4655         896 :     GEN D, P, E, fa, TpA = gel(vTp,i);
    4656             :     long l;
    4657        1673 :     if (typ(TpA) == t_INT) break;
    4658         847 :     if (lg(TpA) > lg(A)) TpA = RgM_mul(X, RgM_mul(TpA, A)); /* Tp | A */
    4659         847 :     T = T ? RgM_add(T, TpA) : TpA;
    4660         847 :     if (!NF) { P = QM_charpoly_ZX(T); setvarn(P, vz); }
    4661             :     else
    4662             :     {
    4663          98 :       P = charpoly(Q_remove_denom(T, &D), vz);
    4664          98 :       if (D) P = gdiv(RgX_unscale(P, D), powiu(D, degpol(P)));
    4665             :     }
    4666         847 :     fa = mynffactor(NF, P, dimlim);
    4667         847 :     if (!fa) return NULL;
    4668         784 :     E = gel(fa, 2);
    4669             :     /* characteristic polynomial is separable ? */
    4670         784 :     if (isint1(vecmax(E))) { Tkeep = T; fakeep = fa; break; }
    4671          56 :     l = lg(E);
    4672             :     /* characteristic polynomial has more factors than before ? */
    4673          56 :     if (l > lmax) { lmax = l; Tkeep = T; fakeep = fa; }
    4674             :   }
    4675         777 :   return mkvec2(Tkeep, fakeep);
    4676             : }
    4677             : 
    4678             : static GEN
    4679         126 : nfcontent(GEN nf, GEN v)
    4680             : {
    4681         126 :   long i, l = lg(v);
    4682         126 :   GEN c = gel(v,1);
    4683         126 :   for (i = 2; i < l; i++) c = idealadd(nf, c, gel(v,i));
    4684         126 :   if (typ(c) == t_MAT && gequal1(gcoeff(c,1,1))) c = gen_1;
    4685         126 :   return c;
    4686             : }
    4687             : static GEN
    4688         189 : nf_primpart(GEN nf, GEN B)
    4689             : {
    4690         189 :   switch(typ(B))
    4691             :   {
    4692             :     case t_COL:
    4693             :     {
    4694         126 :       GEN A = matalgtobasis(nf, B), c = nfcontent(nf, A);
    4695         126 :       if (typ(c) == t_INT) return B;
    4696          14 :       c = idealred_elt(nf,c);
    4697          14 :       A = Q_primpart( nfC_nf_mul(nf, A, Q_primpart(nfinv(nf,c))) );
    4698          14 :       A = liftpol_shallow( matbasistoalg(nf, A) );
    4699          14 :       if (gexpo(A) > gexpo(B)) A = B;
    4700          14 :       return A;
    4701             :     }
    4702             :     case t_MAT:
    4703             :     {
    4704             :       long i, l;
    4705          63 :       GEN A = cgetg_copy(B, &l);
    4706          63 :       for (i = 1; i < l; i++) gel(A,i) = nf_primpart(nf, gel(B,i));
    4707          63 :       return A;
    4708             :     }
    4709             :     default:
    4710           0 :       pari_err_TYPE("nf_primpart", B);
    4711             :       return NULL; /*LCOV_EXCL_LINE*/
    4712             :   }
    4713             : }
    4714             : 
    4715             : /* rotate entries of v to accomodate new entry 'x' (push out oldest entry) */
    4716             : static void
    4717         812 : vecpush(GEN v, GEN x)
    4718             : {
    4719             :   long i;
    4720         812 :   for (i = lg(v)-1; i > 1; i--) gel(v,i) = gel(v,i-1);
    4721         812 :   gel(v,1) = x;
    4722         812 : }
    4723             : 
    4724             : /* A non-empty matrix */
    4725             : static GEN
    4726          35 : RgM_getnf(GEN A)
    4727             : {
    4728          35 :   long i, j, l = lg(A), m = lgcols(A);
    4729          98 :   for (j = 1; j < l; j++)
    4730         210 :     for (i = 1; i < m; i++)
    4731             :     {
    4732         147 :       GEN c = gcoeff(A,i,j);
    4733         147 :       if (typ(c) == t_POLMOD) return nfinit(gel(c,1), DEFAULTPREC);
    4734             :     }
    4735          35 :   return NULL;
    4736             : }
    4737             : 
    4738             : /* sort t_VEC of vector spaces by increasing dimension */
    4739             : static GEN
    4740         770 : sort_by_dim(GEN v)
    4741             : {
    4742         770 :   long i, l = lg(v);
    4743         770 :   GEN D = cgetg(l, t_VECSMALL);
    4744         770 :   for (i = 1; i < l; i++) D[i] = lg(gmael(v,i,2));
    4745         770 :   return vecpermute(v , vecsmall_indexsort(D));
    4746             : }
    4747             : /* mf is either new space of whole cuspidal space in weight 1. If dimlim > 0,
    4748             :  * keep only the dimension <= dimlim eigenspaces. See mfsplit for the meaning
    4749             :  * of flag. */
    4750             : static GEN
    4751        1148 : mfsplit_i(GEN mf, long dimlim, long flag)
    4752             : {
    4753             :   forprime_t iter;
    4754        1148 :   GEN NF, POLCYC, CHI, todosp, Tpbigvec, simplesp, empty = cgetg(1, t_VEC);
    4755        1148 :   long N, k, ord, FC, newdim, dim = MF_get_dim(mf), dimsimple = 0;
    4756        1148 :   const long NBH = 5, vz = 1;
    4757             :   ulong p;
    4758             : 
    4759        1148 :   newdim = dim;
    4760        1148 :   switch(MF_get_space(mf))
    4761             :   {
    4762        1071 :     case mf_NEW: break;
    4763             :     case mf_CUSP: /* in wt1 much faster to compute mfolddim */
    4764          70 :       if (dimlim) pari_err_FLAG("mfsplit [cusp space]");
    4765          70 :       newdim -= mfolddim(MF_get_N(mf), MF_get_k(mf), MF_get_CHI(mf));
    4766          70 :       break;
    4767           7 :     default: pari_err_TYPE("mfsplit [cannot split old/fullspace]", mf);
    4768             :   }
    4769        1141 :   if (!newdim) return mkvec2(empty, empty);
    4770         770 :   N = MF_get_N(mf);
    4771         770 :   k = MF_get_k(mf);
    4772         770 :   CHI = MF_get_CHI(mf);
    4773         770 :   FC = mfcharconductor(CHI);
    4774         770 :   ord = mfcharorder_canon(CHI);
    4775         770 :   if (ord > 1)
    4776             :   {
    4777          63 :     POLCYC = mfcharpol(CHI);
    4778          63 :     NF = nfinit(POLCYC, DEFAULTPREC);
    4779             :   }
    4780             :   else
    4781             :   {
    4782         707 :     POLCYC = NULL;
    4783         707 :     NF = NULL;
    4784             :   }
    4785         770 :   todosp = mkvec(mkvec2(matid(dim), matid(dim)));
    4786         770 :   simplesp = empty;
    4787         770 :   Tpbigvec = zerovec(NBH);
    4788         770 :   u_forprime_init(&iter, 2, ULONG_MAX);
    4789         770 :   while (dimsimple < newdim && (p = u_forprime_next(&iter)))
    4790             :   {
    4791             :     GEN nextsp;
    4792             :     long ind;
    4793        1022 :     if (N % (p*p) == 0 && N/p % FC == 0) continue; /* T_p = 0 in this case */
    4794         812 :     vecpush(Tpbigvec, mfheckemat_i(mf,p));
    4795         812 :     if (k == 1 && !NF) NF = RgM_getnf(gel(Tpbigvec,1));
    4796         812 :     nextsp = empty;
    4797        1652 :     for (ind = 1; ind < lg(todosp); ind++)
    4798             :     {
    4799         840 :       GEN tmp = gel(todosp, ind), fa, P, E, D, Tp, DTp;
    4800         840 :       GEN A = gel(tmp, 1);
    4801         840 :       GEN X = gel(tmp, 2);
    4802             :       long lP, i;
    4803         840 :       tmp = findbestsplit(NF, Tpbigvec, A, X, dimlim, vz);
    4804        1414 :       if (!tmp) continue; /* nothing there */
    4805         777 :       Tp = gel(tmp, 1);
    4806         777 :       fa = gel(tmp, 2);
    4807         777 :       P = gel(fa, 1);
    4808         777 :       E = gel(fa, 2); lP = lg(P);
    4809             :       /* lP > 1 */
    4810         777 :       if (DEBUGLEVEL) err_printf("Exponents = %Ps\n", E);
    4811         777 :       if (lP == 2)
    4812             :       {
    4813         553 :         GEN P1 = gel(P,1);
    4814         553 :         long e1 = itos(gel(E,1)), d1 = degpol(P1);
    4815         553 :         if (e1 * d1 == lg(Tp)-1)
    4816             :         {
    4817         511 :           if (e1 > 1) nextsp = vec_append(nextsp, mkvec2(A,X));
    4818             :           else
    4819             :           { /* simple module */
    4820         504 :             simplesp = vec_append(simplesp, mkvec3(A,Tp,P1));
    4821         504 :             dimsimple += d1;
    4822             :           }
    4823         511 :           continue;
    4824             :         }
    4825             :       }
    4826             :       /* Found splitting */
    4827         266 :       DTp = Q_remove_denom(Tp, &D);
    4828         889 :       for (i = 1; i < lP; i++)
    4829             :       {
    4830         623 :         GEN Ai, Xi, dXi, AAi, v, y, Pi = gel(P,i);
    4831         623 :         Ai = RgX_RgM_eval(D? RgX_rescale(Pi,D): Pi, DTp);
    4832         623 :         Ai = QabM_ker(Ai, POLCYC, ord);
    4833         623 :         if (NF) Ai = nf_primpart(NF, Ai);
    4834             : 
    4835         623 :         AAi = RgM_mul(A, Ai);
    4836             :         /* gives section, works on nonsquare matrices */
    4837         623 :         Xi = QabM_pseudoinv(Ai, POLCYC, ord, &v, &dXi);
    4838         623 :         Xi = RgM_Rg_div(Xi, dXi);
    4839         623 :         y = gel(v,1);
    4840         623 :         if (isint1(gel(E,i)))
    4841             :         {
    4842         553 :           GEN Tpi = RgM_mul(Xi, RgM_mul(rowpermute(Tp,y), Ai));
    4843         553 :           simplesp = vec_append(simplesp, mkvec3(AAi, Tpi, Pi));
    4844         553 :           dimsimple += degpol(Pi);
    4845             :         }
    4846             :         else
    4847             :         {
    4848          70 :           Xi = RgM_mul(Xi, rowpermute(X,y));
    4849          70 :           nextsp = vec_append(nextsp, mkvec2(AAi, Xi));
    4850             :         }
    4851             :       }
    4852             :     }
    4853         812 :     todosp = nextsp; if (lg(todosp) == 1) break;
    4854             :   }
    4855         770 :   if (DEBUGLEVEL) err_printf("end split, need to clean\n");
    4856         770 :   return mfspclean(mf, NF, ord, sort_by_dim(simplesp), flag);
    4857             : }
    4858             : /* mf is either already split or output by mfinit. Splitting is done only for
    4859             :  * newspace except in weight 1. If flag = 0 (default) split completely.
    4860             :  * If flag = d > 0, only give the Galois polynomials in degree > d
    4861             :  * Flag is ignored if dimlim = 1. */
    4862             : GEN
    4863         959 : mfsplit(GEN mf, long dimlim, long flag)
    4864             : {
    4865         959 :   pari_sp av = avma;
    4866             :   GEN v;
    4867         959 :   if (!checkMF_i(mf)) pari_err_TYPE("mfsplit", mf);
    4868         959 :   if (obj_check(mf, MF_SPLIT))
    4869             :   { /* already split; apply dimlim filter */
    4870          14 :     GEN pols = MF_get_fields(mf), forms = MF_get_newforms(mf);
    4871          14 :     if (dimlim)
    4872             :     {
    4873          14 :       long j, l = lg(pols);
    4874         112 :       for (j = 1; j < l; j++)
    4875         105 :         if (degpol(gel(pols,j)) > dimlim) break;
    4876          14 :       if (j != l)
    4877             :       {
    4878           7 :         pols = vecslice(pols,1,j-1);
    4879           7 :         forms= vecslice(forms,1,j-1);
    4880             :       }
    4881             :     }
    4882          14 :     v = mkvec2(forms,pols);
    4883             :   }
    4884             :   else
    4885             :   {
    4886         945 :     v = mfsplit_i(mf, dimlim, flag);
    4887         945 :     if (!dimlim && !flag) obj_insert(mf, MF_SPLIT,v);
    4888             :   }
    4889         959 :   return gerepilecopy(av, v);
    4890             : }
    4891             : static GEN
    4892         133 : split(GEN mf) { return mfsplit_i(mf,0,0); }
    4893             : GEN
    4894         469 : MF_get_newforms(GEN mf) { return gel(obj_checkbuild(mf,MF_SPLIT,&split),1); }
    4895             : GEN
    4896         455 : MF_get_fields(GEN mf) { return gel(obj_checkbuild(mf,MF_SPLIT,&split),2); }
    4897             : 
    4898             : /*************************************************************************/
    4899             : /*                     Modular forms of Weight 1                         */
    4900             : /*************************************************************************/
    4901             : /* S_1(G_0(N)), small N. Return 1 if definitely empty; return 0 if maybe
    4902             :  * non-empty  */
    4903             : static int
    4904       15575 : wt1empty(long N)
    4905             : {
    4906       15575 :   if (N <= 100) switch (N)
    4907             :   { /* non-empty [32/100] */
    4908             :     case 23: case 31: case 39: case 44: case 46:
    4909             :     case 47: case 52: case 55: case 56: case 57:
    4910             :     case 59: case 62: case 63: case 68: case 69:
    4911             :     case 71: case 72: case 76: case 77: case 78:
    4912             :     case 79: case 80: case 83: case 84: case 87:
    4913             :     case 88: case 92: case 93: case 94: case 95:
    4914        5243 :     case 99: case 100: return 0;
    4915        3416 :     default: return 1;
    4916             :   }
    4917        6916 :   if (N <= 600) switch(N)
    4918             :   { /* empty [111/500] */
    4919             :     case 101: case 102: case 105: case 106: case 109:
    4920             :     case 113: case 121: case 122: case 123: case 125:
    4921             :     case 130: case 134: case 137: case 146: case 149:
    4922             :     case 150: case 153: case 157: case 162: case 163:
    4923             :     case 169: case 170: case 173: case 178: case 181:
    4924             :     case 182: case 185: case 187: case 193: case 194:
    4925             :     case 197: case 202: case 205: case 210: case 218:
    4926             :     case 221: case 226: case 233: case 241: case 242:
    4927             :     case 245: case 246: case 250: case 257: case 265:
    4928             :     case 267: case 269: case 274: case 277: case 281:
    4929             :     case 289: case 293: case 298: case 305: case 306:
    4930             :     case 313: case 314: case 317: case 326: case 337:
    4931             :     case 338: case 346: case 349: case 353: case 361:
    4932             :     case 362: case 365: case 369: case 370: case 373:
    4933             :     case 374: case 377: case 386: case 389: case 394:
    4934             :     case 397: case 401: case 409: case 410: case 421:
    4935             :     case 425: case 427: case 433: case 442: case 449:
    4936             :     case 457: case 461: case 466: case 481: case 482:
    4937             :     case 485: case 490: case 493: case 509: case 514:
    4938             :     case 521: case 530: case 533: case 534: case 538:
    4939             :     case 541: case 545: case 554: case 557: case 562:
    4940             :     case 565: case 569: case 577: case 578: case 586:
    4941         336 :     case 593: return 1;
    4942        6566 :     default: return 0;
    4943             :   }
    4944          14 :   return 0;
    4945             : }
    4946             : 
    4947             : static GEN
    4948          21 : initwt1trace(GEN mf)
    4949             : {
    4950          21 :   GEN S = MF_get_S(mf), v, H;
    4951             :   long l, i;
    4952          21 :   if (lg(S) == 1) return mftrivial();
    4953          21 :   H = mfheckemat(mf, Mindex_as_coef(mf));
    4954          21 :   l = lg(H); v = cgetg(l, t_VEC);
    4955          21 :   for (i = 1; i < l; i++) gel(v, i) = gtrace(gel(H,i));
    4956          21 :   return mflineardiv_linear(S, Minv_RgC_mul(MF_get_Minv(mf),v));
    4957             : }
    4958             : static GEN
    4959          14 : initwt1newtrace(GEN mf)
    4960             : {
    4961          14 :   GEN D, S, Mindex, res, CHI = MF_get_CHI(mf);
    4962          14 :   long FC, lD, i, sb, N1, N2, lM, N = MF_get_N(mf);
    4963          14 :   CHI = mfchartoprimitive(CHI, &FC);
    4964          14 :   if (N % FC || mfcharparity(CHI) == 1) return mftrivial();
    4965          14 :   D = mydivisorsu(N/FC); lD = lg(D);
    4966          14 :   S = MF_get_S(mf);
    4967          14 :   if (lg(S) == 1) return mftrivial();
    4968          14 :   N2 = newd_params2(N);
    4969          14 :   N1 = N / N2;
    4970          14 :   Mindex = MF_get_Mindex(mf);
    4971          14 :   lM = lg(Mindex);
    4972          14 :   sb = Mindex[lM-1];
    4973          14 :   res = zerovec(sb+1);
    4974          28 :   for (i = 1; i < lD; i++)
    4975             :   {
    4976          14 :     long M = FC*D[i], j;
    4977          14 :     GEN tf = initwt1trace(M == N? mf: mfinit_Nkchi(M, 1, CHI, mf_CUSP, 0));
    4978             :     GEN listd, v;
    4979          14 :     if (mf_get_type(tf) == t_MF_CONST) continue;
    4980          14 :     v = mfcoefs_i(tf, sb, 1);
    4981          14 :     if (M == N) { res = gadd(res, v); continue; }
    4982           0 :     listd = mydivisorsu(u_ppo(cgcd(N/M, N1), FC));
    4983           0 :     for (j = 1; j < lg(listd); j++)
    4984             :     {
    4985           0 :       long d = listd[j], d2 = d*d; /* coprime to FC */
    4986           0 :       GEN dk = mfchareval_i(CHI, d);
    4987           0 :       long NMd = N/(M*d), m;
    4988           0 :       for (m = 1; m <= sb/d2; m++)
    4989             :       {
    4990           0 :         long be = mubeta2(NMd, m);
    4991           0 :         if (be)
    4992             :         {
    4993           0 :           GEN c = gmul(dk, gmulsg(be, gel(v, m+1)));
    4994           0 :           long n = m*d2;
    4995           0 :           gel(res, n+1) = gadd(gel(res, n+1), c);
    4996             :         }
    4997             :       }
    4998             :     }
    4999             :   }
    5000          14 :   if (gequal0(gel(res,2))) return mftrivial();
    5001          14 :   res = vecpermute(res,Mindex);
    5002          14 :   return mflineardiv_linear(S, Minv_RgC_mul(MF_get_Minv(mf), res));
    5003             : }
    5004             : 
    5005             : /* Matrix of T(p), p \nmid N */
    5006             : static GEN
    5007         105 : Tpmat(long p, long lim, GEN CHI)
    5008             : {
    5009         105 :   GEN M = zeromatcopy(lim, p*lim), chip = mfchareval_i(CHI, p); /* != 0 */
    5010             :   long i, j, pi, pj;
    5011         105 :   gcoeff(M, 1, 1) = gaddsg(1, chip);
    5012         105 :   for (i = 1, pi = p; i < lim; i++,  pi += p) gcoeff(M, i+1, pi+1) = gen_1;
    5013         105 :   for (j = 1, pj = p; pj < lim; j++, pj += p) gcoeff(M, pj+1, j+1) = chip;
    5014         105 :   return M;
    5015             : }
    5016             : 
    5017             : /* assume !wt1empty(N), in particular N>25 */
    5018             : /* Returns [[lim,p], mf (weight 2), p*lim x dim matrix] */
    5019             : static GEN
    5020        1701 : mfwt1_pre(long N)
    5021             : {
    5022        1701 :   GEN M, mf = mfinit_Nkchi(N, 2, mfchartrivial(), mf_CUSP, 0);
    5023             :   /*not empty for N>25*/
    5024             :   long p, lim;
    5025        1701 :   if (uisprime(N))
    5026             :   {
    5027         378 :     p = 2; /*N>25 is not 2 */
    5028         378 :     lim = ceilA1(N, 3);
    5029             :   }
    5030             :   else
    5031             :   {
    5032             :     forprime_t S;
    5033        1323 :     u_forprime_init(&S, 2, N);
    5034        1323 :     while ((p = u_forprime_next(&S)))
    5035        2394 :       if (N % p) break;
    5036        1323 :     lim = mfsturm_mf(mf) + 1;
    5037             :   }
    5038             :   /* p = smalllest prime not dividing N */
    5039        1701 :   M = bhnmat_extend_nocache(MF_get_M(mf), p*lim-1, 1, MF_get_S(mf));
    5040        1701 :   return mkvec3(mkvecsmall2(lim, p), mf, M);
    5041             : }
    5042             : 
    5043             : /* lg(A) > 1, E a t_POL */
    5044             : static GEN
    5045         616 : mfmatsermul(GEN A, GEN E)
    5046             : {
    5047         616 :   long j, l = lg(A), r = nbrows(A);
    5048         616 :   GEN M = cgetg(l, t_MAT);
    5049         616 :   E = RgXn_red_shallow(E, r+1);
    5050        6468 :   for (j = 1; j < l; j++)
    5051             :   {
    5052        5852 :     GEN c = RgV_to_RgX(gel(A,j), 0);
    5053        5852 :     gel(M, j) = RgX_to_RgC(RgXn_mul(c, E, r+1), r);
    5054             :   }
    5055         616 :   return M;
    5056             : }
    5057             : /* lg(Ap) > 1, Ep an Flxn */
    5058             : static GEN
    5059         378 : mfmatsermul_Fl(GEN Ap, GEN Ep, ulong p)
    5060             : {
    5061         378 :   long j, l = lg(Ap), r = nbrows(Ap);
    5062         378 :   GEN M = cgetg(l, t_MAT);
    5063        5334 :   for (j = 1; j < l; j++)
    5064             :   {
    5065        4956 :     GEN c = Flv_to_Flx(gel(Ap,j), 0);
    5066        4956 :     gel(M,j) = Flx_to_Flv(Flxn_mul(c, Ep, r+1, p), r);
    5067             :   }
    5068         378 :   return M;
    5069             : }
    5070             : 
    5071             : /* CHI mod F | N, return mfchar of modulus N.
    5072             :  * FIXME: wasteful, G should be precomputed  */
    5073             : static GEN
    5074       14826 : mfcharinduce(GEN CHI, long N)
    5075             : {
    5076             :   GEN G, chi;
    5077       14826 :   if (mfcharmodulus(CHI) == N) return CHI;
    5078        2786 :   G = znstar0(utoipos(N), 1);
    5079        2786 :   chi = zncharinduce(gel(CHI,1), gel(CHI,2), G);
    5080        2786 :   CHI = leafcopy(CHI);
    5081        2786 :   gel(CHI,1) = G;
    5082        2786 :   gel(CHI,2) = chi; return CHI;
    5083             : }
    5084             : 
    5085             : static GEN
    5086        3955 : gmfcharno(GEN CHI)
    5087             : {
    5088        3955 :   GEN G = gel(CHI,1), chi = gel(CHI,2);
    5089        3955 :   return mkintmod(znconreyexp(G, chi), znstar_get_N(G));
    5090             : }
    5091             : static long
    5092       11683 : mfcharno(GEN CHI)
    5093             : {
    5094       11683 :   GEN n = znconreyexp(gel(CHI,1), gel(CHI,2));
    5095       11683 :   return itou(n);
    5096             : }
    5097             : 
    5098             : /* return k such that minimal mfcharacter in Galois orbit of CHI is CHI^k */
    5099             : static long
    5100       10759 : mfconreyminimize(GEN CHI)
    5101             : {
    5102       10759 :   GEN G = gel(CHI,1), cyc, chi;
    5103       10759 :   cyc = ZV_to_zv(znstar_get_cyc(G));
    5104       10759 :   chi = ZV_to_zv(znconreychar(G, gel(CHI,2)));
    5105       10759 :   return zv_cyc_minimize(cyc, chi, coprimes_zv(mfcharorder(CHI)));
    5106             : }
    5107             : 
    5108             : /* find scalar c such that first non-0 entry of c*v is 1; return c*v
    5109             :  * (set c = NULL for 1) */
    5110             : static GEN
    5111        1414 : RgV_normalize(GEN v, GEN *pc)
    5112             : {
    5113        1414 :   long i, l = lg(v);
    5114        1414 :   *pc = NULL;
    5115        3325 :   for (i = 1; i < l; i++)
    5116             :   {
    5117        3325 :     GEN c = gel(v,i);
    5118        3325 :     if (!gequal0(c))
    5119             :     {
    5120        1414 :       if (gequal1(c)) { *pc = gen_1; return v; }
    5121         392 :       *pc = ginv(c); return RgV_Rg_mul(v, *pc);
    5122             :     }
    5123             :   }
    5124           0 :   return v;
    5125             : }
    5126             : /* ordchi != 2 mod 4 */
    5127             : static GEN
    5128        2198 : mftreatdihedral(GEN DIH, GEN POLCYC, long ordchi, long biglim, GEN *pS)
    5129             : {
    5130             :   GEN M, Minv, C;
    5131             :   long l, i;
    5132        2198 :   l = lg(DIH); if (l == 1) return NULL;
    5133        2198 :   if (!pS) return DIH;
    5134         679 :   C = cgetg(l, t_VEC);
    5135         679 :   M = cgetg(l, t_MAT);
    5136        1876 :   for (i = 1; i < l; i++)
    5137             :   {
    5138        1197 :     GEN c, v = mfcoefs_i(gel(DIH,i), biglim, 1);
    5139        1197 :     gel(M,i) = RgV_normalize(v, &c);
    5140        1197 :     gel(C,i) = Rg_col_ei(c, l-1, i);
    5141             :   }
    5142         679 :   Minv = gel(mfclean(M,POLCYC,ordchi),2);
    5143         679 :   M = RgM_Minv_mul(M, Minv);
    5144         679 :   C = RgM_Minv_mul(C, Minv);
    5145         679 :   *pS = vecmflinear(DIH, C);
    5146         679 :   return M;
    5147             : }
    5148             : 
    5149             : static GEN
    5150          98 : mfstabiter(GEN M, GEN A2, GEN E1inv, long lim, GEN P, long ordchi)
    5151             : {
    5152             :   GEN A, VC, con;
    5153          98 :   E1inv = primitive_part(E1inv, &con);
    5154          98 :   VC = con? ginv(con): gen_1;
    5155          98 :   A = mfmatsermul(A2, E1inv);
    5156             :   while(1)
    5157             :   {
    5158         154 :     long lA = lg(A);
    5159         154 :     GEN Ash = rowslice(A, 1, lim);
    5160         154 :     GEN R = shallowconcat(RgM_mul(M, A), Ash);
    5161         154 :     GEN B = QabM_ker(R, P, ordchi);
    5162         154 :     if (lg(B) == 1) return mkvec2(A, VC);
    5163         154 :     if (lg(B) == lA) break;
    5164          56 :     B = rowslice(B, 1, lA-1);
    5165          56 :     if (ordchi != 1) B = gmodulo(B, P);
    5166          56 :     A = Q_primitive_part(RgM_mul(A,B), &con);
    5167          56 :     VC = gmul(VC,B); /* first VC is a scalar, then a RgM */
    5168          56 :     if (con) VC = RgM_Rg_div(VC, con);
    5169          56 :   }
    5170          98 :   return mkvec2(A, VC);
    5171             : }
    5172             : static long
    5173          98 : mfstabitermodp(GEN Mp, GEN Ap, long p, long lim)
    5174             : {
    5175          98 :   GEN VC = NULL;
    5176             :   while (1)
    5177             :   {
    5178         105 :     long lAp = lg(Ap);
    5179         105 :     GEN Ashp = rowslice(Ap, 1, lim);
    5180         105 :     GEN Rp = shallowconcat(Flm_mul(Mp, Ap, p), Ashp);
    5181         105 :     GEN Bp = Flm_ker(Rp, p);
    5182         105 :     if (lg(Bp) == 1) return 0;
    5183         105 :     if (lg(Bp) == lAp) return lAp-1;
    5184           7 :     Bp = rowslice(Bp, 1, lAp-1);
    5185           7 :     Ap = Flm_mul(Ap, Bp, p);
    5186           7 :     VC = VC? Flm_mul(VC, Bp, p): Bp;
    5187           7 :   }
    5188             : }
    5189             : 
    5190             : static GEN
    5191         175 : mfintereis(GEN A, GEN M2, GEN y, GEN den, GEN E2, GEN P, long ordchi)
    5192             : {
    5193         175 :   pari_sp av = avma;
    5194         175 :   GEN z, M1 = mfmatsermul(A,E2), M1den = is_pm1(den)? M1: RgM_Rg_mul(M1,den);
    5195         175 :   M2 = RgM_mul(M2, rowpermute(M1, y));
    5196         175 :   z = QabM_ker(RgM_sub(M2,M1den), P, ordchi);
    5197         175 :   if (ordchi != 1) z = gmodulo(z, P);
    5198         175 :   return gerepilecopy(av, mkvec2(RgM_mul(A, z), z));
    5199             : }
    5200             : static GEN
    5201         182 : mfintereismodp(GEN A, GEN M2, GEN E2, ulong p)
    5202             : {
    5203         182 :   pari_sp av = avma;
    5204         182 :   GEN M1 = mfmatsermul_Fl(A, E2, p), z;
    5205         182 :   long j, lx = lg(A);
    5206         182 :   z = Flm_ker(shallowconcat(M1, M2), p);
    5207         182 :   for (j = lg(z) - 1; j; j--) setlg(z[j], lx);
    5208         182 :   return gerepilecopy(av, mkvec2(Flm_mul(A, z, p), z));
    5209             : }
    5210             : 
    5211             : static GEN
    5212         105 : mfcharinv_i(GEN CHI)
    5213             : {
    5214         105 :   GEN G = gel(CHI,1);
    5215         105 :   CHI = leafcopy(CHI); gel(CHI,2) =  zncharconj(G, gel(CHI,2)); return CHI;
    5216             : }
    5217             : 
    5218             : /* upper bound dim S_1(Gamma_0(N),chi) performing the linear algebra mod p */
    5219             : static long
    5220         105 : mfwt1dimmodp(GEN A, GEN ES, GEN M, long ordchi, long dih, long lim)
    5221             : {
    5222             :   GEN Ap, C, ApF, ES1p, ES1INVp, Mp, VC, ApC;
    5223             :   ulong r, p;
    5224         105 :   long i, plim = nbrows(A);
    5225             : 
    5226         105 :   ordchi = ord_canon(ordchi);
    5227         105 :   r = QabM_init(ordchi, &p);
    5228         105 :   ApF = Ap = QabM_to_Flm(A, r, p);
    5229         105 :   VC = NULL;
    5230         105 :   ES1p = QabX_to_Flx(gel(ES,1), r, p);
    5231         105 :   if (lg(ES) >= 3)
    5232             :   {
    5233          98 :     GEN M2 = mfmatsermul_Fl(ApF, ES1p, p);
    5234         273 :     for (i = 2; i < lg(ES); i++)
    5235             :     {
    5236         182 :       GEN ESip = QabX_to_Flx(gel(ES,i), r, p);
    5237         182 :       ApC = mfintereismodp(Ap, M2, ESip, p);
    5238         182 :       Ap = gel(ApC,1);
    5239         182 :       if (lg(Ap)-1 == dih) return dih;
    5240         175 :       C = gel(ApC,2); VC = VC? Flm_mul(VC, C, p): C;
    5241             :     }
    5242             :   }
    5243             :   /* intersection of Eisenstein series quotients non empty: use Schaeffer */
    5244          98 :   ES1INVp = Flxn_inv(ES1p, plim, p);
    5245          98 :   Ap = mfmatsermul_Fl(Ap, ES1INVp, p);
    5246          98 :   Mp = QabM_to_Flm(M, r, p);
    5247          98 :   return mfstabitermodp(Mp, Ap, p, lim);
    5248             : }
    5249             : 
    5250             : /* Compute the full S_1(\G_0(N),\chi). If pS is NULL, only the dimension
    5251             :  * dim, in the form of a vector having dim components. Otherwise output
    5252             :  * a basis: ptvf contains a pointer to the vector of forms, and the
    5253             :  * program returns the corresponding matrix of Fourier expansions.
    5254             :  * ptdimdih gives the dimension of the subspace generated by dihedral forms;
    5255             :  * TMP is from mfwt1_pre or NULL. */
    5256             : static GEN
    5257       10269 : mfwt1basis(long N, GEN CHI, GEN TMP, GEN *pS, long *ptdimdih)
    5258             : {
    5259             :   GEN ES, mf, A, M, Tp, tmp1, tmp2, den;
    5260             :   GEN S, ESA, VC, C, Ash, POLCYC, ES1, ES1INV, DIH, a0, a0i;
    5261             :   long plim, lim, biglim, i, p, dA, dimp, ordchi, dih, lim2;
    5262             : 
    5263       10269 :   if (ptdimdih) *ptdimdih = 0;
    5264       10269 :   if (pS) *pS = NULL;
    5265       10269 :   if (wt1empty(N) || mfcharparity(CHI) != -1) return NULL;
    5266       10094 :   ordchi = mfcharorder_canon(CHI);
    5267       10094 :   if (uisprime(N) && ordchi > 4) return NULL;
    5268       10073 :   if (!pS)
    5269             :   {
    5270        6860 :     dih = mfdihedralcuspdim(N, CHI);
    5271        6860 :     DIH = zerovec(dih);
    5272             :   }
    5273             :   else
    5274             :   {
    5275        3213 :     DIH = mfdihedralcusp(N, CHI);
    5276        3213 :     dih = lg(DIH) - 1;
    5277             :   }
    5278       10073 :   POLCYC = (ordchi == 1)? NULL: mfcharpol(CHI);
    5279       10073 :   if (ptdimdih) *ptdimdih = dih;
    5280       10073 :   biglim = mfsturmNk(N, 2);
    5281       10073 :   if (N <= 600) switch(N)
    5282             :   {
    5283             :     long m;
    5284             :     case 219: case 273: case 283: case 331: case 333: case 344: case 416:
    5285             :     case 438: case 468: case 491: case 504: case 546: case 553: case 563:
    5286             :     case 566: case 581: case 592:
    5287          14 :       break; /* one chi with both exotic and dihedral forms */
    5288             :     default: /* only dihedral forms */
    5289        9233 :       if (!dih) return NULL;
    5290             :       /* fall through */
    5291             :     case 124: case 133: case 148: case 171: case 201: case 209: case 224:
    5292             :     case 229: case 248: case 261: case 266: case 288: case 296: case 301:
    5293             :     case 309: case 325: case 342: case 371: case 372: case 380: case 399:
    5294             :     case 402: case 403: case 404: case 408: case 418: case 432: case 444:
    5295             :     case 448: case 451: case 453: case 458: case 496: case 497: case 513:
    5296             :     case 522: case 527: case 532: case 576: case 579:
    5297             :       /* no chi with both exotic and dihedral; one chi with exotic forms */
    5298        2912 :       if (dih) return mftreatdihedral(DIH, POLCYC, ordchi, biglim, pS);
    5299         721 :       m = mfcharno(CHI);
    5300         721 :       if (N == 124 && (m != 67 && m != 87)) return NULL;
    5301         595 :       if (N == 133 && (m != 83 && m !=125)) return NULL;
    5302         301 :       if (N == 148 && (m !=105 && m !=117)) return NULL;
    5303         175 :       if (N == 171 && (m != 94 && m !=151)) return NULL;
    5304         175 :       if (N == 201 && (m != 29 && m !=104)) return NULL;
    5305         175 :       if (N == 209 && (m != 87 && m !=197)) return NULL;
    5306         175 :       if (N == 224 && (m != 95 && m !=191)) return NULL;
    5307         175 :       if (N == 229 && (m !=107 && m !=122)) return NULL;
    5308         175 :       if (N == 248 && (m != 87 && m !=191)) return NULL;
    5309          84 :       if (N == 261 && (m != 46 && m !=244)) return NULL;
    5310          84 :       if (N == 266 && (m != 83 && m !=125)) return NULL;
    5311          84 :       if (N == 288 && (m != 31 && m !=223)) return NULL;
    5312          84 :       if (N == 296 && (m !=105 && m !=265)) return NULL;
    5313             :   }
    5314         105 :   if (!TMP) TMP = mfwt1_pre(N);
    5315         105 :   tmp1= gel(TMP,1); lim = tmp1[1]; p = tmp1[2]; plim = p*lim;
    5316         105 :   mf  = gel(TMP,2);
    5317         105 :   A   = gel(TMP,3); /* p*lim x dim matrix */
    5318         105 :   S = MF_get_S(mf);
    5319         105 :   ESA = mfeisensteinbasis(N, 1, mfcharinv_i(CHI));
    5320         105 :   ES = RgM_to_RgXV(mfvectomat(ESA, plim+1, 1), 0);
    5321         105 :   ES1 = gel(ES,1); /* does not vanish at oo */
    5322         105 :   Tp = Tpmat(p, lim, CHI);
    5323         105 :   dimp = mfwt1dimmodp(A, ES, Tp, ordchi, dih, lim);
    5324         105 :   if (!dimp)
    5325           0 :     return NULL;
    5326         105 :   if (dimp == dih)
    5327           7 :     return mftreatdihedral(DIH, POLCYC, ordchi, biglim, pS);
    5328          98 :   VC = matid(lg(A) - 1);
    5329          98 :   lim2 = (3*lim)/2 + 1;
    5330          98 :   Ash = rowslice(A, 1, lim2);
    5331          98 :   if (lg(ES) >= 3)
    5332             :   {
    5333             :     pari_sp btop;
    5334          91 :     GEN v, y, M2M2I, M2I, M2 = mfmatsermul(Ash, ES1);
    5335          91 :     M2I = QabM_pseudoinv(M2, POLCYC, ordchi, &v, &den);
    5336          91 :     y = gel(v,1);
    5337          91 :     M2M2I = RgM_mul(M2,M2I);
    5338          91 :     btop = avma;
    5339         266 :     for (i = 2; i < lg(ES); i++)
    5340             :     {
    5341         175 :       GEN APC = mfintereis(Ash, M2M2I, y, den, gel(ES,i), POLCYC,ordchi);
    5342         175 :       Ash = gel(APC,1);
    5343         175 :       if (lg(Ash) == 1) return NULL;
    5344         175 :       VC = RgM_mul(VC, gel(APC,2));
    5345         175 :       if (gc_needed(btop, 1))
    5346             :       {
    5347           0 :         if (DEBUGMEM > 1) pari_warn(warnmem,"mfwt1basis i = %ld", i);
    5348           0 :         gerepileall(btop, 2, &Ash, &VC);
    5349             :       }
    5350             :     }
    5351             :   }
    5352          98 :   A = RgM_mul(A, vecslice(VC,1, lg(Ash)-1));
    5353          98 :   a0 = gel(ES1,2); /* non-zero */
    5354          98 :   if (gequal1(a0)) a0 = a0i = NULL;
    5355             :   else
    5356             :   {
    5357          98 :     a0i = ginv(a0);
    5358          98 :     ES1 = RgX_Rg_mul(RgX_unscale(ES1,a0), a0i);
    5359             :   }
    5360          98 :   ES1INV = RgXn_inv(ES1, plim-1);
    5361          98 :   if (a0) ES1INV = RgX_Rg_mul(RgX_unscale(ES1INV, a0i), a0i);
    5362          98 :   tmp2 = mfstabiter(Tp, A, ES1INV, lim, POLCYC, ordchi);
    5363          98 :   A = gel(tmp2,1); dA = lg(A);
    5364          98 :   if (dA == 1) return NULL;
    5365          98 :   VC = gmul(VC, gel(tmp2,2));
    5366          98 :   C = cgetg(dA, t_VEC);
    5367          98 :   M = cgetg(dA, t_MAT);
    5368         315 :   for (i = 1; i < dA; i++)
    5369             :   {
    5370         217 :     GEN c, v = gel(A,i);
    5371         217 :     gel(M,i) = RgV_normalize(v, &c);
    5372         217 :     gel(C,i) = RgC_Rg_mul(gel(VC,i), c);
    5373             :   }
    5374          98 :   if (pS)
    5375             :   {
    5376          56 :     GEN Minv = gel(mfclean(M, POLCYC, ordchi), 2);
    5377          56 :     M = RgM_Minv_mul(M, Minv);
    5378          56 :     C = RgM_Minv_mul(C, Minv);
    5379          56 :     *pS = vecmflineardiv0(S, C, gel(ESA,1));
    5380             :   }
    5381          98 :   return M;
    5382             : }
    5383             : 
    5384             : static void
    5385          70 : mf_set_space(GEN mf, long x) { gmael(mf,1,4) = utoi(x); }
    5386             : static GEN
    5387          70 : mfwt1_cusptonew(GEN mf)
    5388             : {
    5389          70 :   const long vy = 1;
    5390             :   GEN v, vP, F, S, Snew, vF;
    5391             :   long i, lP, dSnew, ct;
    5392             : 
    5393          70 :   v = mfsplit_i(mf, 0, 0);
    5394          70 :   F = gel(v,1);
    5395          70 :   vP= gel(v,2); lP = lg(vP);
    5396          70 :   if (lP == 1) { obj_insert(mf, MF_SPLIT, v); return NULL; }
    5397          70 :   mf_set_space(mf, mf_NEW);
    5398          70 :   S = MF_get_S(mf);
    5399          70 :   dSnew = 0;
    5400          70 :   for (i = 1; i < lP; i++) dSnew += degpol(gel(vP,i));
    5401          70 :   Snew = cgetg(dSnew + 1, t_VEC); ct = 0;
    5402          70 :   vF = cgetg(lP, t_VEC);
    5403         147 :   for (i = 1; i < lP; i++)
    5404             :   {
    5405          77 :     GEN V, P = gel(vP,i), f = liftpol_shallow(gel(F,i));
    5406          77 :     long j, d = degpol(P);
    5407          77 :     gel(vF,i) = V = zerovec(dSnew);
    5408          77 :     if (d == 1)
    5409             :     {
    5410          56 :       gel(Snew, ct+1) = mflineardiv_linear(S, f);
    5411          56 :       gel(V, ct+1) = gen_1;
    5412             :     }
    5413             :     else
    5414             :     {
    5415          21 :       f = RgXV_to_RgM(f,d);
    5416          70 :       for (j = 1; j <= d; j++)
    5417             :       {
    5418          49 :         gel(Snew, ct+j) = mflineardiv_linear(S, row(f,j));
    5419          49 :         gel(V, ct+j) = mkpolmod(pol_xn(j-1,vy), P);
    5420             :       }
    5421             :     }
    5422          77 :     ct += d;
    5423             :   }
    5424          70 :   obj_insert(mf, MF_SPLIT, mkvec2(vF, vP));
    5425          70 :   gel(mf,3) = Snew; return mf;
    5426             : }
    5427             : static GEN
    5428        3297 : mfwt1init(long N, GEN CHI, GEN TMP, long space, long flraw)
    5429             : {
    5430        3297 :   GEN mf, mf1, S, M = mfwt1basis(N, CHI, TMP, &S, NULL);
    5431        3297 :   if (!M) return NULL;
    5432         735 :   mf1 = mkvec4(stoi(N), gen_1, CHI, utoi(mf_CUSP));
    5433         735 :   mf = mkmf(mf1, cgetg(1,t_VEC), S, gen_0, NULL);
    5434         735 :   if (space == mf_NEW)
    5435             :   {
    5436          70 :     gel(mf,5) = mfcleanCHI(M,CHI);
    5437          70 :     mf = mfwt1_cusptonew(mf); if (!mf) return NULL;
    5438          70 :     if (!flraw) M = mfcoefs_mf(mf, mfsturmNk(N,1)+1, 1);
    5439             :   }
    5440         735 :   gel(mf,5) = flraw? zerovec(3): mfcleanCHI(M, CHI);
    5441         735 :   return mf;
    5442             : }
    5443             : 
    5444             : static GEN
    5445         952 : mfEMPTY(GEN mf1)
    5446             : {
    5447         952 :   GEN Minv = mkMinv(cgetg(1,t_MAT), NULL,NULL,NULL);
    5448         952 :   GEN M = mkvec3(cgetg(1,t_VECSMALL), Minv, cgetg(1,t_MAT));
    5449         952 :   return mkmf(mf1, cgetg(1,t_VEC), cgetg(1,t_VEC), cgetg(1,t_VEC), M);
    5450             : }
    5451             : static GEN
    5452         616 : mfEMPTYall(long N, GEN gk, GEN vCHI, long space)
    5453             : {
    5454             :   long i, l;
    5455             :   GEN v, gN, gs;
    5456         616 :   if (!vCHI) return cgetg(1, t_VEC);
    5457          14 :   gN = utoipos(N); gs = utoi(space);
    5458          14 :   l = lg(vCHI); v = cgetg(l, t_VEC);
    5459          14 :   for (i = 1; i < l; i++) gel(v,i) = mfEMPTY(mkvec4(gN,gk,gel(vCHI,i),gs));
    5460          14 :   return v;
    5461             : }
    5462             : 
    5463             : static GEN
    5464        3955 : fmt_dim(GEN CHI, long d, long dih)
    5465        3955 : { return mkvec4(gmfcharorder(CHI), gmfcharno(CHI), utoi(d), stoi(dih)); }
    5466             : static GEN
    5467        3010 : mfdim0all(GEN w)
    5468             : {
    5469        3010 :   if (w) retconst_vec(lg(w)-1, zerovec(2));
    5470        3003 :   return cgetg(1,t_VEC);
    5471             : }
    5472             : static long
    5473        6972 : mfwt1cuspdim_i(long N, GEN CHI, GEN TMP, long *dih)
    5474             : {
    5475        6972 :   pari_sp av = avma;
    5476        6972 :   GEN b = mfwt1basis(N, CHI, TMP, NULL, dih);
    5477        6972 :   avma = av; return b? lg(b)-1: 0;
    5478             : }
    5479             : static long
    5480         133 : mfwt1cuspdim(long N, GEN CHI) { return mfwt1cuspdim_i(N, CHI, NULL, NULL); }
    5481             : static GEN
    5482        4137 : mfwt1cuspdimall(long N, GEN vCHI)
    5483             : {
    5484             :   GEN z, TMP, w;
    5485             :   long i, j, l;
    5486        4137 :   if (wt1empty(N)) return mfdim0all(vCHI);
    5487        1134 :   w = mfwt1chars(N,vCHI);
    5488        1134 :   l = lg(w); if (l == 1) return cgetg(1,t_VEC);
    5489        1134 :   z = cgetg(l, t_VEC);
    5490        1134 :   TMP = mfwt1_pre(N);
    5491        7840 :   for (i = j = 1; i < l; i++)
    5492             :   {
    5493        6706 :     GEN CHI = gel(w,i);
    5494        6706 :     long dih, d = mfwt1cuspdim_i(N, CHI, TMP, &dih);
    5495        6706 :     if (vCHI)
    5496          28 :       gel(z,j++) = mkvec2s(d, dih);
    5497        6678 :     else if (d)
    5498        1428 :       gel(z,j++) = fmt_dim(CHI, d, dih);
    5499             :   }
    5500        1134 :   setlg(z,j); return z;
    5501             : }
    5502             : 
    5503             : /* dimension of S_1(Gamma_1(N)) */
    5504             : static long
    5505        4123 : mfwt1cuspdimsum(long N)
    5506             : {
    5507        4123 :   pari_sp av = avma;
    5508        4123 :   GEN v = mfwt1cuspdimall(N, NULL);
    5509        4123 :   long i, ct = 0, l = lg(v);
    5510        5544 :   for (i = 1; i < l; i++)
    5511             :   {
    5512        1421 :     GEN w = gel(v,i); /* [ord(CHI),*,dim,*] */
    5513        1421 :     ct += itou(gel(w,3))*myeulerphiu(itou(gel(w,1)));
    5514             :   }
    5515        4123 :   avma = av; return ct;
    5516             : }
    5517             : 
    5518             : static GEN
    5519          56 : mfwt1newdimall(long N, GEN vCHI)
    5520             : {
    5521             :   GEN z, w, vTMP;
    5522             :   long i, c, lw;
    5523          56 :   if (wt1empty(N)) return mfdim0all(vCHI);
    5524          56 :   w = mfwt1chars(N,vCHI);
    5525          56 :   lw = lg(w); if (lw == 1) return cgetg(1,t_VEC);
    5526          56 :   vTMP = const_vec(N, NULL);
    5527          56 :   gel(vTMP,N) = mfwt1_pre(N);
    5528          56 :   z = cgetg(lw, t_VEC);
    5529         182 :   for (i = c = 1; i < lw; i++)
    5530             :   {
    5531             :     long j, l, F, dihnew;
    5532         126 :     GEN D, CHI = gel(w,i), CHIP = mfchartoprimitive(CHI,&F);
    5533         126 :     long S = mfwt1cuspdim_i(N, CHI, gel(vTMP,N), &dihnew);
    5534         126 :     if (!S)
    5535             :     {
    5536          56 :       if (vCHI) gel(z, c++) = zerovec(2);
    5537          56 :       continue;
    5538             :     }
    5539          70 :     D = mydivisorsu(N/F); l = lg(D);
    5540          77 :     for (j = l-2; j > 0; j--) /* skip last M = N */
    5541             :     {
    5542           7 :       long M = D[j]*F, m, s, dih;
    5543           7 :       GEN TMP = gel(vTMP,M);
    5544           7 :       if (wt1empty(M) || !(m = mubeta(D[l-j]))) continue; /*m = mubeta(N/M)*/
    5545           7 :       if (!TMP) gel(vTMP,M) = TMP = mfwt1_pre(M);
    5546           7 :       s = mfwt1cuspdim_i(M, CHIP, TMP, &dih);
    5547           7 :       if (s) { S += m * s; dihnew += m * dih; }
    5548             :     }
    5549          70 :     if (vCHI)
    5550          63 :       gel(z,c++) = mkvec2s(S, dihnew);
    5551           7 :     else if (S)
    5552           7 :       gel(z, c++) = fmt_dim(CHI, S, dihnew);
    5553             :   }
    5554          56 :   setlg(z,c); return z;
    5555             : }
    5556             : 
    5557             : static GEN
    5558          28 : mfwt1olddimall(long N, GEN vCHI)
    5559             : {
    5560             :   long i, j, l;
    5561             :   GEN z, w;
    5562          28 :   if (wt1empty(N)) return mfdim0all(vCHI);
    5563          28 :   w = mfwt1chars(N,vCHI);
    5564          28 :   l = lg(w); z = cgetg(l, t_VEC);
    5565          84 :   for (i = j = 1; i < l; i++)
    5566             :   {
    5567          56 :     GEN CHI = gel(w,i);
    5568          56 :     long d = mfolddim(N, 1, CHI);
    5569          56 :     if (vCHI)
    5570          28 :       gel(z,j++) = mkvec2s(d,d?-1:0);
    5571          28 :     else if (d)
    5572           7 :       gel(z, j++) = fmt_dim(CHI, d, -1);
    5573             :   }
    5574          28 :   setlg(z,j); return z;
    5575             : }
    5576             : 
    5577             : static long
    5578         469 : mfwt1olddimsum(long N)
    5579             : {
    5580             :   GEN D;
    5581         469 :   long N2, i, l, S = 0;
    5582         469 :   newd_params(N, &N2); /* will ensure mubeta != 0 */
    5583         469 :   D = mydivisorsu(N/N2); l = lg(D);
    5584        2485 :   for (i = 2; i < l; i++)
    5585             :   {
    5586        2016 :     long M = D[l-i]*N2, d = mfwt1cuspdimsum(M);
    5587        2016 :     if (d) S -= mubeta(D[i]) * d;
    5588             :   }
    5589         469 :   return S;
    5590             : }
    5591             : static long
    5592        1050 : mfwt1newdimsum(long N)
    5593             : {
    5594        1050 :   long S = mfwt1cuspdimsum(N);
    5595        1050 :   return S? S - mfwt1olddimsum(N): 0;
    5596             : }
    5597             : 
    5598             : /* Guess Galois type of wt1 eigenforms. */
    5599             : /* NK can be mf or [N,1,CHI] */
    5600             : static long
    5601          42 : mfisdihedral(GEN F, GEN DIH)
    5602             : {
    5603          42 :   GEN vG = gel(DIH,1), M = gel(DIH,2), v;
    5604             :   long i, l;
    5605          42 :   if (lg(M) == 1) return 0;
    5606          21 :   v = RgM_RgC_invimage(M, mftocol(F, nbrows(M)-1, 1));
    5607          21 :   if (!v) return 0;
    5608          21 :   l = lg(v);
    5609          21 :   for (i = 1; i < l; i++)
    5610          21 :     if (!gequal0(gel(v,i)))
    5611             :     {
    5612          21 :       GEN G = gel(vG,i), bnr = gel(G,2), w = gel(G,3);
    5613          21 :       GEN gen, cyc = bnr_get_cyc(bnr), D = gel(cyc,1);
    5614          21 :       GEN f = bnr_get_mod(bnr), nf = bnr_get_nf(bnr);
    5615          21 :       GEN con = gel(galoisconj(nf,gen_1), 2);
    5616          21 :       GEN f0 = gel(f,1), f0b = galoisapply(nf, con, f0);
    5617          21 :       GEN xin = zv_to_ZV(gel(w,2)); /* xi(bnr.gen[i]) = e(xin[i] / D) */
    5618             :       long e, j, L, n;
    5619          21 :       if (!gequal(f0,f0b))
    5620             :       { /* finite part of conductor not ambiguous */
    5621          14 :         GEN a = idealmul(nf, f0, idealdivexact(nf, f0b, idealadd(nf, f0, f0b)));
    5622          14 :         GEN bnr0 = bnr;
    5623          14 :         bnr = bnrinit0(bnr_get_bnf(bnr), mkvec2(a, gel(f,2)), 1);
    5624          14 :         xin = RgV_RgM_mul(xin, bnrsurjection(bnr, bnr0));
    5625             :         /* still xi(gen[i]) = e(xin[i] / D), for the new generators */
    5626             :       }
    5627          21 :       gen = bnr_get_gen(bnr); L = lg(gen);
    5628          35 :       for (j = 1, e = itou(D); j < L; j++)
    5629             :       {
    5630          28 :         GEN Ng = idealnorm(nf, gel(gen,j));
    5631          28 :         GEN a = shifti(gel(xin,j), 1); /* xi(g_j^2) = e(a/D) */
    5632          28 :         GEN b = FpV_dotproduct(xin, isprincipalray(bnr,Ng), D);
    5633          28 :         GEN m = Fp_sub(a, b, D); /* xi(g_j/\bar{g_j}) = e(m/D) */
    5634          28 :         e = ugcd(e, itou(m)); if (e == 1) break;
    5635             :       }
    5636          21 :       n = itou(D) / e;
    5637          21 :       return n == 1? 4: 2*n;
    5638             :     }
    5639           0 :   return 0;
    5640             : }
    5641             : 
    5642             : static ulong
    5643          21 : radical_u(ulong n)
    5644          21 : { return zv_prod(gel(myfactoru(n),1)); }
    5645             : 
    5646             : /* list of fundamental discriminants unramified outside N */
    5647             : static GEN
    5648           7 : mfunram(long N)
    5649             : {
    5650           7 :   long cN = radical_u(N >> vals(N)), l, c, i;
    5651           7 :   GEN D = mydivisorsu(cN), res;
    5652           7 :   l = lg(D);
    5653           7 :   res = cgetg(6*l - 5, t_VECSMALL);
    5654          21 :   for (i = c = 1; i < l; i++)
    5655             :   {
    5656          14 :     long d = D[i], d4 = d & 3L; /* d odd, squarefree */
    5657          14 :     if (d > 1 && d4 == 1) res[c++] = d;
    5658          14 :     if (d4 == 3) res[c++] = -d;
    5659          14 :     if ((N&1L) == 0)
    5660             :     {
    5661          14 :       if (d4 == 2 || d4 == 3) res[c++] = 4*d;
    5662          14 :       if (d4 == 2 || d4 == 1) res[c++] =-4*d;
    5663          14 :       if (d & 1) { res[c++] = 8*d; res[c++] = -8*d; }
    5664             :     }
    5665             :   }
    5666           7 :   setlg(res, c); return res;
    5667             : }
    5668             : /* list of negative fundamental discriminants unramified outside N */
    5669             : static GEN
    5670          14 : mfunramneg(long N)
    5671             : {
    5672          14 :   long cN = radical_u(N >> vals(N)), l, c, i;
    5673          14 :   GEN D = mydivisorsu(cN), res;
    5674          14 :   l = lg(D);
    5675          14 :   res = cgetg(3*l - 2, t_VECSMALL);
    5676          56 :   for (i = c = 1; i < l; i++)
    5677             :   {
    5678          42 :     long d = D[i], d4 = d & 3L; /* d odd, squarefree */
    5679          42 :     if (d4 == 3) res[c++] = -d;
    5680          42 :     if ((N&1L) == 0)
    5681             :     {
    5682          14 :       if (d4 == 2 || d4 == 1) res[c++] =-4*d;
    5683          14 :       if (d & 1) { res[c++] = 8*d; res[c++] = -8*d; }
    5684             :     }
    5685             :   }
    5686          14 :   setlg(res, c); return res;
    5687             : }
    5688             : 
    5689             : /* Return 1 if F is definitely not S4 type; return 0 on failure. */
    5690             : static long
    5691           7 : mfisnotS4(long N, GEN w)
    5692             : {
    5693           7 :   GEN D = mfunram(N);
    5694           7 :   long i, lD = lg(D), lw = lg(w);
    5695          56 :   for (i = 1; i < lD; i++)
    5696             :   {
    5697          49 :     long p, d = D[i], ok = 0;
    5698         154 :     for (p = 2; p < lw; p++)
    5699         154 :       if (w[p] && kross(d,p) == -1) { ok = 1; break; }
    5700          49 :     if (!ok) return 0;
    5701             :   }
    5702           7 :   return 1;
    5703             : }
    5704             : 
    5705             : /* Return 1 if F is definitely not A5 type; return 0 on failure. */
    5706             : static long
    5707           7 : mfisnotA5(GEN van)
    5708             : {
    5709           7 :   long l = lg(van) - 2, i, vz = 1;
    5710           7 :   GEN pol5 = gsubgs(gsqr(pol_x(vz)), 5);
    5711        1400 :   for (i = 1; i < l; i++)
    5712             :   {
    5713        1393 :     GEN c = gel(van, i);
    5714        1393 :     if (i != 1 && !uisprime(i+1)) continue; /* only test a_0 and a_prime */
    5715         322 :     if (typ(c) == t_POLMOD)
    5716             :     {
    5717         315 :       GEN T = gel(c,1);
    5718         315 :       if (varn(T) == vz)
    5719             :       { /* K / Q(zeta_n) / Q */
    5720         315 :         GEN t = NULL, p = NULL;
    5721         315 :         if (!RgX_is_FpXQX(T, &t,&p) || p) pari_err_TYPE("mfgaloistype", c);
    5722         315 :         if (t) T = rnfequation(t,T);
    5723         315 :         if (typ(nfisincl(pol5, T)) != t_INT) return 0;
    5724             :       }
    5725             :       else
    5726             :       { /* Q(zeta_n) / Q */
    5727           0 :         long n = poliscyclo(T);
    5728           0 :         if (!n) pari_err_TYPE("mfgaloistype", c);
    5729           0 :         if (n % 5 == 0) return 0;
    5730             :       }
    5731             :     }
    5732             :   }
    5733           7 :   return 1;
    5734             : }
    5735             : 
    5736             : /* Given x = z + 1/z with z prim. root of unity of order n, find n */
    5737             : static long
    5738         357 : mffindrootof1(GEN u1)
    5739             : {
    5740         357 :   pari_sp av = avma;
    5741         357 :   GEN u0 = gen_2, u1k = u1, u2;
    5742         357 :   long c = 1;
    5743        1379 :   while (!gequalsg(2, liftpol_shallow(u1))) /* u1 = z^c + z^-c */
    5744             :   {
    5745         665 :     u2 = gsub(gmul(u1k, u1), u0);
    5746         665 :     u0 = u1; u1 = u2; c++;
    5747             :   }
    5748         357 :   avma = av; return c;
    5749             : }
    5750             : 
    5751             : /* we known that F is not dihedral */
    5752             : static long
    5753          21 : mfgaloistype_i(long N, GEN CHI, GEN F, long lim)
    5754             : {
    5755             :   forprime_t iter;
    5756          21 :   GEN v = mfcoefs_i(F,lim,1), w = zero_zv(lim);
    5757             :   ulong p;
    5758          21 :   u_forprime_init(&iter, 2, lim);
    5759         406 :   while((p = u_forprime_next(&iter)))
    5760             :   {
    5761             :     GEN u;
    5762             :     long n;
    5763         378 :     if (!(N%p)) continue;
    5764         357 :     u = gdiv(gsqr(gel(v, p+1)), mfchareval_i(CHI, p));
    5765         357 :     n = mffindrootof1(gsubgs(u,2));
    5766         357 :     if (n == 3) w[p] = 1;
    5767         357 :     if (n == 4) return -24; /* S4 */
    5768         350 :     if (n == 5) return -60; /* A5 */
    5769         350 :     if (n > 5) pari_err_DOMAIN("mfgaloistype", "form", "not a",
    5770             :                                strtoGENstr("cuspidal eigenform"), F);
    5771             :   }
    5772           7 :   if (mfisnotS4(N,w) && mfisnotA5(v)) return -12; /* A4 */
    5773           0 :   return 0; /* FAILURE */
    5774             : }
    5775             : 
    5776             : static GEN
    5777          42 : mfgaloistype0(long N, GEN CHI, GEN F, GEN DIH, long lim)
    5778             : {
    5779          42 :   pari_sp av = avma;
    5780          42 :   long t = mfisdihedral(F, DIH);
    5781          42 :   avma = av;
    5782          42 :   if (t) return stoi(t);
    5783             :   for(;;)
    5784             :   {
    5785          21 :     t = mfgaloistype_i(N, CHI, F, lim);
    5786          14 :     avma = av; if (t) return stoi(t);
    5787           0 :     lim += lim >> 1;
    5788           0 :   }
    5789             : }
    5790             : 
    5791             : /* If f is NULL, give all the galoistypes, otherwise just for f */
    5792             : GEN
    5793          49 : mfgaloistype(GEN NK, GEN f)
    5794             : {
    5795          49 :   pari_sp av = avma;
    5796             :   GEN CHI, mf, T, F, DIH;
    5797             :   long N, k, lL, i, dim, lim, SB;
    5798             : 
    5799          49 :   if (checkMF_i(NK))
    5800             :   {
    5801          14 :     mf = NK;
    5802          14 :     N = MF_get_N(mf);
    5803          14 :     k = MF_get_k(mf);
    5804          14 :     CHI = MF_get_CHI(mf);
    5805             :   }
    5806             :   else
    5807             :   {
    5808          35 :     checkNK(NK, &N, &k, &CHI, 0);
    5809          35 :     mf = f? NULL: mfinit_i(NK, mf_NEW);
    5810             :   }
    5811          49 :   if (k != 1) pari_err_DOMAIN("mfgaloistype", "k", "!=", gen_1, stoi(k));
    5812          49 :   SB = mfsturmNk(N,1) + 1;
    5813          49 :   lim = maxss(200, 3*SB);
    5814          49 :   DIH = mfdihedralnew(N,CHI);
    5815          49 :   DIH = mkvec2(DIH, mfvectomat(DIH,SB,1));
    5816          49 :   if (f) return gerepileuptoint(av, mfgaloistype0(N,CHI, f, DIH, lim));
    5817             : 
    5818          42 :   dim = lg(MF_get_S(mf)) - 1;
    5819          42 :   if (!dim) { avma = av; return cgetg(1, t_VEC); }
    5820          35 :   F = mfeigenbasis(mf); lL = lg(F);
    5821          35 :   T = cgetg(lL, t_VEC);
    5822          35 :   for (i=1; i < lL; i++) gel(T,i) = mfgaloistype0(N,CHI, gel(F,i), DIH, lim);
    5823          35 :   return gerepileupto(av, T);
    5824             : }
    5825             : 
    5826             : /******************************************************************/
    5827             : /*                   Find all dihedral forms.                     */
    5828             : /******************************************************************/
    5829             : /* lim >= 2 */
    5830             : static void
    5831           7 : consttabdihedral(long lim)
    5832           7 : { cache_set(cache_DIH, mfdihedralall(mkvecsmall2(1,lim))); }
    5833             : 
    5834             : /* a ideal coprime to bnr modulus */
    5835             : static long
    5836       71547 : mfdiheval(GEN bnr, GEN w, GEN a)
    5837             : {
    5838       71547 :   GEN L, cycn = gel(w,1), chin = gel(w,2);
    5839       71547 :   long ordmax = cycn[1];
    5840       71547 :   L = ZV_to_Flv(isprincipalray(bnr,a), ordmax);
    5841       71547 :   return Flv_dotproduct(chin, L, ordmax);
    5842             : }
    5843             : 
    5844             : /* A(x^k) mod T */
    5845             : static GEN
    5846       25900 : Galois(GEN A, long k, GEN T)
    5847             : {
    5848       25900 :   if (typ(A) != t_POL) return A;
    5849        9443 :   return gmod(RgX_inflate(A, k), T);
    5850             : }
    5851             : static GEN
    5852         560 : vecGalois(GEN v, long k, GEN T)
    5853             : {
    5854             :   long i, l;
    5855         560 :   GEN w = cgetg_copy(v,&l);
    5856         560 :   for (i = 1; i < l; i++) gel(w,i) = Galois(gel(v,i), k, T);
    5857         560 :   return w;
    5858             : }
    5859             : 
    5860             : static GEN
    5861      140903 : fix_pol(GEN S, GEN Pn, int *trace)
    5862             : {
    5863      140903 :   if (typ(S) != t_POL) return S;
    5864       97293 :   S = RgX_rem(S, Pn);
    5865       97293 :   if (typ(S) == t_POL)
    5866             :   {
    5867       97293 :     switch(lg(S))
    5868             :     {
    5869       35224 :       case 2: return gen_0;
    5870       15799 :       case 3: return gel(S,2);
    5871             :     }
    5872       46270 :     *trace = 1;
    5873             :   }
    5874       46270 :   return S;
    5875             : }
    5876             : 
    5877             : static GEN
    5878        9968 : dihan(GEN bnr, GEN w, GEN k0j, ulong lim)
    5879             : {
    5880        9968 :   GEN nf = bnr_get_nf(bnr), f = bid_get_ideal(bnr_get_bid(bnr));
    5881        9968 :   GEN v = zerovec(lim+1), cycn = gel(w,1), Tinit = gel(w,3);
    5882        9968 :   GEN Pn = gel(Tinit,lg(Tinit)==4? 2: 1);
    5883        9968 :   long j, ordmax = cycn[1], k0 = k0j[1], jdeg = k0j[2];
    5884        9968 :   long D = itos(nf_get_disc(nf)), vt = varn(Pn);
    5885        9968 :   int trace = 0;
    5886             :   ulong p, n;
    5887             :   forprime_t T;
    5888             : 
    5889        9968 :   gel(v,2) = gen_1;
    5890        9968 :   u_forprime_init(&T, 2, lim);
    5891             :   /* fill in prime powers first */
    5892        9968 :   while ((p = u_forprime_next(&T)))
    5893             :   {
    5894             :     GEN vP, vchiP, S;
    5895             :     long k, lP;
    5896             :     ulong q, qk;
    5897       65954 :     if (kross(D,p) >= 0) q = p;
    5898             :     else
    5899             :     {
    5900       27279 :       q = umuluu_or_0(p,p);
    5901       27279 :       if (!q || q > lim) continue;
    5902             :     }
    5903             :     /* q = Norm P */
    5904       44093 :     vP = idealprimedec(nf, utoipos(p));
    5905       44093 :     lP = lg(vP);
    5906       44093 :     vchiP = cgetg(lP, t_VECSMALL);
    5907      119455 :     for (j = k = 1; j < lP; j++)
    5908             :     {
    5909       75362 :       GEN P = gel(vP,j);
    5910       75362 :       if (!idealval(nf, f, P)) vchiP[k++] = mfdiheval(bnr,w,P);
    5911             :     }
    5912       44093 :     if (k == 1) continue;
    5913       42434 :     setlg(vchiP, k); lP = k;
    5914       42434 :     if (lP == 2)
    5915             :     { /* one prime above p not dividing f */
    5916       13321 :       long s, s0 = vchiP[1];
    5917       22841 :       for (qk=q, s = s0;; s = Fl_add(s,s0,ordmax))
    5918             :       {
    5919       22841 :         S = mygmodulo_lift(s, ordmax, gen_1, vt);
    5920       22841 :         gel(v, qk+1) = fix_pol(S, Pn, &trace);
    5921       22841 :         qk = umuluu_or_0(qk, q); if (!qk || qk > lim) break;
    5922        9520 :       }
    5923             :     }
    5924             :     else /* two primes above p not dividing f */
    5925             :     {
    5926       29113 :       long s, s0 = vchiP[1], s1 = vchiP[2];
    5927       43246 :       for (qk=q, k = 1;; k++)
    5928             :       { /* sum over a,b s.t. Norm( P1^a P2^b ) = q^k, i.e. a+b = k */
    5929             :         long a;
    5930       43246 :         GEN S = gen_0;
    5931      151123 :         for (a = 0; a <= k; a++)
    5932             :         {
    5933      107877 :           s = Fl_add(Fl_mul(a, s0, ordmax), Fl_mul(k-a, s1, ordmax), ordmax);
    5934      107877 :           S = gadd(S, mygmodulo_lift(s, ordmax, gen_1, vt));
    5935             :         }
    5936       43246 :         gel(v, qk+1) = fix_pol(S, Pn, &trace);
    5937       43246 :         qk = umuluu_or_0(qk, q); if (!qk || qk > lim) break;
    5938       14133 :       }
    5939             :     }
    5940             :   }
    5941             :   /* complete with non-prime powers */
    5942      184128 :   for (n = 2; n <= lim; n++)
    5943             :   {
    5944      174160 :     GEN S, fa = myfactoru(n), P = gel(fa, 1), E = gel(fa, 2);
    5945             :     long q;
    5946      174160 :     if (lg(P) == 2) continue;
    5947             :     /* not a prime power */
    5948       74816 :     q = upowuu(P[1],E[1]);
    5949       74816 :     S = gmul(gel(v, q + 1), gel(v, n/q + 1));
    5950       74816 :     gel(v, n+1) = fix_pol(S, Pn, &trace);
    5951             :   }
    5952        9968 :   if (trace)
    5953             :   {
    5954        4935 :     if (lg(Tinit) == 4) v = QabV_tracerel(Tinit, jdeg, v);
    5955             :     /* Apply Galois Mod(k0, ordw) */
    5956        4935 :     if (k0 > 1) { GEN Pm = gel(Tinit,1); v = vecGalois(v, k0, Pm); }
    5957             :   }
    5958        9968 :   return v;
    5959             : }
    5960             : 
    5961             : /* as cyc_normalize for t_VECSMALL cyc */
    5962             : static GEN
    5963       13391 : cyc_normalize_zv(GEN cyc)
    5964             : {
    5965       13391 :   long i, o = cyc[1], l = lg(cyc); /* > 1 */
    5966       13391 :   GEN D = cgetg(l, t_VECSMALL);
    5967       13391 :   D[1] = o; for (i = 2; i < l; i++) D[i] = o / cyc[i];
    5968       13391 :   return D;
    5969             : }
    5970             : /* as char_normalize for t_VECSMALLs */
    5971             : static GEN
    5972       58975 : char_normalize_zv(GEN chi, GEN ncyc)
    5973             : {
    5974       58975 :   long i, l = lg(chi);
    5975       58975 :   GEN c = cgetg(l, t_VECSMALL);
    5976       58975 :   if (l > 1) {
    5977       58975 :     c[1] = chi[1];
    5978       58975 :     for (i = 2; i < l; i++) c[i] = chi[i] * ncyc[i];
    5979             :   }
    5980       58975 :   return c;
    5981             : }
    5982             : 
    5983             : static GEN
    5984        6006 : dihan_bnf(long D)
    5985        6006 : { setrand(gen_1); return Buchall(quadpoly(stoi(D)), 0, LOWDEFAULTPREC); }
    5986             : static GEN
    5987       20293 : dihan_bnr(GEN bnf, GEN A)
    5988       20293 : { setrand(gen_1); return bnrinit0(bnf, A, 1); }
    5989             : 
    5990             : /* Hecke xi * (D/.) = Dirichlet chi, return v in Q^r st chi(g_i) = e(v[i]).
    5991             :  * cycn = cyc_normalize_zv(bnr.cyc), chin = char_normalize_zv(chi,cyc) */
    5992             : static GEN
    5993       17206 : bnrchartwist2conrey(GEN chin, GEN cycn, GEN bnrconreyN, GEN kroconreyN)
    5994             : {
    5995       17206 :   long l = lg(bnrconreyN), c1 = cycn[1], i;
    5996       17206 :   GEN v = cgetg(l, t_COL);
    5997       62566 :   for (i = 1; i < l; i++)
    5998             :   {
    5999       45360 :     GEN d = sstoQ(zv_dotproduct(chin, gel(bnrconreyN,i)), c1);
    6000       45360 :     if (kroconreyN[i] < 0) d = gadd(d, ghalf);
    6001       45360 :     gel(v,i) = d;
    6002             :   }
    6003       17206 :   return v;
    6004             : }
    6005             : 
    6006             : /* chi(g_i) = e(v[i]) denormalize wrt Conrey generators orders */
    6007             : static GEN
    6008       17206 : conreydenormalize(GEN znN, GEN v)
    6009             : {
    6010       17206 :   GEN gcyc = znstar_get_conreycyc(znN), w;
    6011       17206 :   long l = lg(v), i;
    6012       17206 :   w = cgetg(l, t_COL);
    6013       62566 :   for (i = 1; i < l; i++)
    6014       45360 :     gel(w,i) = modii(gmul(gel(v,i), gel(gcyc,i)), gel(gcyc,i));
    6015       17206 :   return w;
    6016             : }
    6017             : 
    6018             : static long
    6019       41769 : Miyake(GEN vchi, GEN gb, GEN cycn)
    6020             : {
    6021       41769 :   long i, e = cycn[1], lb = lg(gb);
    6022       41769 :   GEN v = char_normalize_zv(vchi, cycn);
    6023       62132 :   for (i = 1; i < lb; i++)
    6024       49833 :     if ((zv_dotproduct(v, gel(gb,i)) -  v[i]) % e) return 1;
    6025       12299 :   return 0;
    6026             : }
    6027             : 
    6028             : /* list of Hecke characters not induced by a Dirichlet character up to Galois
    6029             :  * conjugation, whose conductor is bnr.cond; cycn = cyc_normalize(bnr.cyc)*/
    6030             : static GEN
    6031       13391 : mklvchi(GEN bnr, GEN con, GEN cycn)
    6032             : {
    6033       13391 :   GEN gb = NULL, cyc = bnr_get_cyc(bnr), cycsmall = ZV_to_zv(cyc);
    6034       13391 :   GEN vchi = cyc2elts(cycsmall);
    6035       13391 :   long ordmax = cycsmall[1], c, i, l;
    6036       13391 :   if (con)
    6037             :   {
    6038        3892 :     GEN g = bnr_get_gen(bnr), nf = bnr_get_nf(bnr);
    6039        3892 :     long lg = lg(g);
    6040        3892 :     gb = cgetg(lg, t_VEC);
    6041        9135 :     for (i = 1; i < lg; i++)
    6042        5243 :       gel(gb,i) = ZV_to_zv(isprincipalray(bnr, galoisapply(nf, con, gel(g,i))));
    6043             :   }
    6044       13391 :   l = lg(vchi);
    6045      151725 :   for (i = c = 1; i < l; i++)
    6046             :   {
    6047      138334 :     GEN chi = gel(vchi,i);
    6048      138334 :     if (!con || Miyake(chi, gb, cycn)) gel(vchi, c++) = Flv_to_ZV(chi);
    6049             :   }
    6050       13391 :   setlg(vchi, c); l = c;
    6051      139426 :   for (i = 1; i < l; i++)
    6052             :   {
    6053      126035 :     GEN chi = gel(vchi,i);
    6054             :     long n;
    6055      126035 :     if (!chi) continue;
    6056      527289 :     for (n = 2; n < ordmax; n++)
    6057      482748 :       if (cgcd(n, ordmax) == 1)
    6058             :       {
    6059      198597 :         GEN tmp = vecmodii(gmulsg(n, chi), cyc);
    6060             :         long j;
    6061     3809050 :         for (j = i+1; j < l; j++)
    6062     3610453 :           if (gel(vchi,j) && gequal(gel(vchi,j), tmp)) gel(vchi,j) = NULL;
    6063             :       }
    6064             :   }
    6065      139426 :   for (i = c = 1; i < l; i++)
    6066             :   {
    6067      126035 :     GEN chi = gel(vchi,i);
    6068      126035 :     if (chi && bnrisconductor(bnr, chi)) gel(vchi, c++) = chi;
    6069             :   }
    6070       13391 :   setlg(vchi, c); return vchi;
    6071             : }
    6072             : 
    6073             : /* con = NULL if D > 0 or if D < 0 and id != idcon. */
    6074             : static GEN
    6075       16835 : mfdihedralcommon(GEN bnf, GEN id, GEN znN, GEN kroconreyN, long N, long D, GEN con)
    6076             : {
    6077             :   GEN bnr, bnrconreyN, cyc, cycn, cycN, Lvchi, res, g, P;
    6078             :   long i, j, ordmax, l, lc, deghecke, degrel;
    6079             : 
    6080       16835 :   bnr = dihan_bnr(bnf, id);
    6081       16835 :   cyc = ZV_to_zv( bnr_get_cyc(bnr) );
    6082       16835 :   lc = lg(cyc); if (lc == 1) return NULL;
    6083             : 
    6084       13391 :   g = znstar_get_conreygen(znN); l = lg(g);
    6085       13391 :   bnrconreyN = cgetg(l, t_VEC);
    6086       50288 :   for (i = 1; i < l; i++)
    6087       36897 :     gel(bnrconreyN,i) = ZV_to_zv(isprincipalray(bnr,gel(g,i)));
    6088             : 
    6089       13391 :   cycn = cyc_normalize_zv(cyc);
    6090       13391 :   cycN = ZV_to_zv(znstar_get_cyc(znN));
    6091       13391 :   ordmax = cyc[1];
    6092       13391 :   P = polcyclo(ord_canon(ordmax), fetch_user_var("t"));
    6093       13391 :   deghecke = myeulerphiu(ordmax);
    6094       13391 :   Lvchi = mklvchi(bnr, con, cycn); l = lg(Lvchi);
    6095       13391 :   if (l == 1) return NULL;
    6096        7917 :   res = cgetg(l, t_VEC);
    6097       25123 :   for (j = 1; j < l; j++)
    6098             :   {
    6099       17206 :     GEN T, Tinit, v, vchi = ZV_to_zv(gel(Lvchi,j));
    6100       17206 :     GEN chi, chin = char_normalize_zv(vchi, cycn);
    6101             :     long ordw, vnum, k0;
    6102       17206 :     v = bnrchartwist2conrey(chin, cycn, bnrconreyN, kroconreyN);
    6103       17206 :     ordw = itou(Q_denom(v));
    6104       17206 :     Tinit = Qab_trace_init(P, ord_canon(ordmax), ord_canon(ordw));
    6105       17206 :     chi = conreydenormalize(znN, v);
    6106       17206 :     vnum = itou(znconreyexp(znN, chi));
    6107       17206 :     chi = ZV_to_zv(znconreychar(znN,chi));
    6108       17206 :     degrel = deghecke / myeulerphiu(ordw);
    6109       17206 :     k0 = zv_cyc_minimize(cycN, chi, coprimes_zv(ordw));
    6110       17206 :     vnum = Fl_powu(vnum, k0, N);
    6111             :     /* encodes degrel forms: jdeg = 0..degrel-1 */
    6112       17206 :     T = mkvecsmalln(6, N, k0, vnum, D, ordmax, degrel);
    6113       17206 :     gel(res,j) = mkvec3(T, id, mkvec3(cycn,chin,Tinit));
    6114             :   }
    6115        7917 :   return res;
    6116             : }
    6117             : 
    6118             : /* Append to v all dihedral weight 1 forms coming from D, if fundamental. */
    6119             : /* B a t_VECSMALL: if #B=1, only that level; if B=[Bmin,Bmax], Bmin <= Bmax:
    6120             :  * between those levels. */
    6121             : static void
    6122        9289 : append_dihedral(GEN v, long D, GEN B)
    6123             : {
    6124        9289 :   long Da = labs(D), no, N, i, numi, ct, min, max;
    6125             :   GEN bnf, con, LI, resall, varch;
    6126             :   pari_sp av;
    6127             : 
    6128        9289 :   if (lg(B) == 2)
    6129             :   {
    6130           0 :     long b = B[1], m = D > 0? 3: 1;
    6131           0 :     min = b / Da;
    6132           0 :     if (b % Da || min < m) return;
    6133           0 :     max = min;
    6134             :   }
    6135             :   else
    6136             :   { /* assume B[1] < B[2] */
    6137        9289 :     min = (B[1] + Da-1)/Da;
    6138        9289 :     max = B[2]/Da;
    6139             :   }
    6140        9289 :   if (!sisfundamental(D)) return;
    6141             : 
    6142        2842 :   av = avma;
    6143        2842 :   bnf = dihan_bnf(D);
    6144        2842 :   con = gel(galoisconj(bnf,gen_1), 2);
    6145        2842 :   LI = ideallist(bnf, max);
    6146        2842 :   numi = 0; for (i = min; i <= max; i++) numi += lg(gel(LI, i)) - 1;
    6147        2842 :   if (D > 0)
    6148             :   {
    6149         707 :     numi <<= 1;
    6150         707 :     varch = mkvec2(mkvec2(gen_1,gen_0), mkvec2(gen_0,gen_1));
    6151             :   }
    6152             :   else
    6153        2135 :     varch = NULL;
    6154        2842 :   resall = cgetg(numi+1, t_VEC); ct = 1;
    6155       27503 :   for (no = min; no <= max; no++)
    6156             :   {
    6157             :     GEN LIs, znN, conreyN, kroconreyN;
    6158             :     long flcond, lgc, lglis;
    6159       24661 :     if (D < 0)
    6160       15043 :       flcond = (no == 2 || no == 3 || (no == 4 && (D&7L)==1));
    6161             :     else
    6162        9618 :       flcond = (no == 4 && (D&7L) != 1);
    6163       24661 :     if (flcond) continue;
    6164       22302 :     LIs = gel(LI, no);
    6165       22302 :     N = Da*no;
    6166       22302 :     znN = znstar0(utoi(N), 1);
    6167       22302 :     conreyN = znstar_get_conreygen(znN); lgc = lg(conreyN);
    6168       22302 :     kroconreyN = cgetg(lgc, t_VECSMALL);
    6169       22302 :     for (i = 1; i < lgc; i++) kroconreyN[i] = krosi(D, gel(conreyN, i));
    6170       22302 :     lglis = lg(LIs);
    6171       43876 :     for (i = 1; i < lglis; i++)
    6172             :     {
    6173       21574 :       GEN id = gel(LIs, i), idcon, conk;
    6174             :       long j, inf, maxinf;
    6175       21574 :       if (typ(id) == t_INT) continue;
    6176       14077 :       idcon = galoisapply(bnf, con, id);
    6177       14077 :       conk = (D < 0 && gequal(idcon, id)) ? con : NULL;
    6178       42294 :       for (j = i; j < lglis; j++)
    6179       28217 :         if (gequal(idcon, gel(LIs, j))) gel(LIs, j) = gen_0;
    6180       14077 :       maxinf = (D < 0 || gequal(idcon,id))? 1: 2;
    6181       30912 :       for (inf = 1; inf <= maxinf; inf++)
    6182             :       {
    6183       16835 :         GEN ide = (D > 0)? mkvec2(id, gel(varch,inf)): id;
    6184       16835 :         GEN res = mfdihedralcommon(bnf, ide, znN, kroconreyN, N, D, conk);
    6185       16835 :         if (res) gel(resall, ct++) = res;
    6186             :       }
    6187             :     }
    6188             :   }
    6189        2842 :   if (ct == 1) avma = av;
    6190             :   else
    6191             :   {
    6192        2394 :     setlg(resall, ct);
    6193        2394 :     vectrunc_append(v, gerepilecopy(av, shallowconcat1(resall)));
    6194             :   }
    6195             : }
    6196             : 
    6197             : static long
    6198       21021 : di_N(GEN a) { return gel(a,1)[1]; }
    6199             : /* All primitive dihedral wt1 forms: LIM a t_VECSMALL with a single component
    6200             :  * (only level LIM) or 2 components [m,M], m < M (between m and M) */
    6201             : static GEN
    6202           7 : mfdihedralall(GEN LIM)
    6203             : {
    6204             :   GEN res, z;
    6205             :   long limD, ct, i, l1, l2;
    6206             : 
    6207           7 :   if (lg(LIM) == 2) l1 = l2 = LIM[1]; else { l1 = LIM[1]; l2 = LIM[2]; }
    6208           7 :   limD = l2;
    6209           7 :   res = vectrunc_init(2*limD);
    6210           7 :   if (l1 == l2)
    6211             :   {
    6212           0 :     GEN D = mydivisorsu(l1);
    6213           0 :     long l = lg(D), j;
    6214           0 :     for (j = 2; j < l; j++)
    6215             :     {
    6216           0 :       long d = D[j];
    6217           0 :       append_dihedral(res, -d, LIM);
    6218           0 :       if (d >= 5 && D[l-j] >= 3) append_dihedral(res, d, LIM);
    6219             :     }
    6220             :   }
    6221             :   else
    6222             :   {
    6223             :     long D;
    6224           7 :     for (D = -3; D >= -limD; D--) append_dihedral(res, D, LIM);
    6225           7 :     limD /= 3;
    6226           7 :     for (D = 5; D <= limD;   D++) append_dihedral(res, D, LIM);
    6227             :   }
    6228           7 :   if (l1 == l2) return gel(res,1); /* single level */
    6229           7 :   ct = lg(res);
    6230           7 :   if (ct > 1)
    6231             :   { /* concat and sort wrt N */
    6232           7 :     res = shallowconcat1(res);
    6233           7 :     res = vecpermute(res, indexvecsort(res, mkvecsmall(1)));
    6234           7 :     ct = lg(res);
    6235             :   }
    6236           7 :   z = const_vec(l2-l1+1, cgetg(1,t_VEC));
    6237        3836 :   for (i = 1; i < ct;)
    6238             :   { /* regroup result sharing the same N */
    6239        3822 :     long n = di_N(gel(res,i)), j = i+1, k;
    6240             :     GEN v;
    6241        3822 :     while (j < ct && di_N(gel(res,j)) == n) j++;
    6242        3822 :     n -= l1-1;
    6243        3822 :     gel(z, n) = v = cgetg(j-i+1, t_VEC);
    6244        3822 :     for (k = 1; i < j; k++,i++) gel(v,k) = gel(res,i);
    6245             :   }
    6246           7 :   return z;
    6247             : }
    6248             : static GEN
    6249       22813 : mfdihedral(long N)
    6250             : {
    6251       22813 :   GEN z = cache_get(cache_DIH, N);
    6252       22813 :   return z? z: mfdihedralall(mkvecsmall(N));
    6253             : }
    6254             : 
    6255             : /* return [vF, index], where vecpermute(vF,index) generates dihedral forms
    6256             :  * for character CHI */
    6257             : static GEN
    6258       22813 : mfdihedralnew_i(long N, GEN CHI)
    6259             : {
    6260       22813 :   GEN bnf, Tinit, Pm, vf, M, V, NK, SP = mfdihedral(N);
    6261             :   long Dold, d, ordw, i, SB, c, l, k0, k1, chino, chinoorig, lv;
    6262             : 
    6263       22813 :   lv = lg(SP); if (lv == 1) return NULL;
    6264       10759 :   CHI = mfcharinduce(CHI,N);
    6265       10759 :   ordw = mfcharorder(CHI);
    6266       10759 :   chinoorig = mfcharno(CHI);
    6267       10759 :   k0 = mfconreyminimize(CHI);
    6268       10759 :   chino = Fl_powu(chinoorig, k0, N);
    6269       10759 :   k1 = Fl_inv(k0 % ordw, ordw);
    6270       10759 :   V = cgetg(lv, t_VEC);
    6271       10759 :   d = 0;
    6272       33642 :   for (i = l = 1; i < lv; i++)
    6273             :   {
    6274       22883 :     GEN sp = gel(SP,i), T = gel(sp,1);
    6275       22883 :     if (T[3] != chino) continue;
    6276        3458 :     d += T[6];
    6277        3458 :     if (k1 != 1)
    6278             :     {
    6279          77 :       GEN t = leafcopy(T);
    6280          77 :       t[3] = chinoorig;
    6281          77 :       t[2] = (t[2]*k1)%ordw;
    6282          77 :       sp = mkvec4(t, gel(sp,2), gel(sp,3), gel(sp,4));
    6283             :     }
    6284        3458 :     gel(V, l++) = sp;
    6285             :   }
    6286       10759 :   setlg(V, l); /* dihedral forms of level N and character CHI */
    6287       10759 :   if (l == 1) return NULL;
    6288             : 
    6289        2240 :   SB = myeulerphiu(ordw) * mfsturmNk(N,1) + 1;
    6290        2240 :   M = cgetg(d+1, t_MAT);
    6291        2240 :   vf = cgetg(d+1, t_VEC);
    6292        2240 :   NK = mkNK(N, 1, CHI);
    6293        2240 :   bnf = NULL; Dold = 0;
    6294        5698 :   for (i = c = 1; i < l; i++)
    6295             :   { /* T = [N, k0, conreyno, D, ordmax, degrel] */
    6296        3458 :     GEN bnr, Vi = gel(V,i), T = gel(Vi,1), id = gel(Vi,2), w = gel(Vi,3);
    6297        3458 :     long jdeg, k0i = T[2], D = T[4], degrel = T[6];
    6298             : 
    6299        3458 :     if (D != Dold) { Dold = D; bnf = dihan_bnf(D); }
    6300        3458 :     bnr = dihan_bnr(bnf, id);
    6301       10052 :     for (jdeg = 0; jdeg < degrel; jdeg++,c++)
    6302             :     {
    6303        6594 :       GEN k0j = mkvecsmall2(k0i, jdeg), an = dihan(bnr, w, k0j, SB);
    6304        6594 :       settyp(an, t_COL); gel(M,c) = Q_primpart(an);
    6305        6594 :       gel(vf,c) = tag3(t_MF_DIHEDRAL, NK, bnr, w, k0j);
    6306             :     }
    6307             :   }
    6308        2240 :   Tinit = gmael3(V,1,3,3); Pm = gel(Tinit,1);
    6309        2240 :   V = QabM_indexrank(M, degpol(Pm)==1? NULL: Pm, ord_canon(ordw));
    6310        2240 :   return mkvec2(vf,gel(V,2));
    6311             : }
    6312             : static long
    6313       15484 : mfdihedralnewdim(long N, GEN CHI)
    6314             : {
    6315       15484 :   pari_sp av = avma;
    6316       15484 :   GEN S = mfdihedralnew_i(N, CHI);
    6317       15484 :   long d = S ? lg(gel(S,2))-1: 0;
    6318       15484 :   avma = av; return d;
    6319             : }
    6320             : static GEN
    6321        7329 : mfdihedralnew(long N, GEN CHI)
    6322             : {
    6323        7329 :   pari_sp av = avma;
    6324        7329 :   GEN S = mfdihedralnew_i(N, CHI);
    6325        7329 :   if (!S) { avma = av; return cgetg(1, t_VEC); }
    6326         721 :   return vecpermute(gel(S,1), gel(S,2));
    6327             : }
    6328             : 
    6329             : static long
    6330        6860 : mfdihedralcuspdim(long N, GEN CHI)
    6331             : {
    6332        6860 :   pari_sp av = avma;
    6333             :   GEN D, CHIP;
    6334             :   long F, i, lD, dim;
    6335             : 
    6336        6860 :   CHIP = mfchartoprimitive(CHI, &F);
    6337        6860 :   D = mydivisorsu(N/F); lD = lg(D);
    6338        6860 :   dim = mfdihedralnewdim(N, CHI); /* d = 1 */
    6339       15484 :   for (i = 2; i < lD; i++)
    6340             :   {
    6341        8624 :     long d = D[i], M = N/d, a = mfdihedralnewdim(M, CHIP);
    6342        8624 :     if (a) dim += a * mynumdivu(d);
    6343             :   }
    6344        6860 :   avma = av; return dim;
    6345             : }
    6346             : 
    6347             : static GEN
    6348        4879 : mfbdall(GEN E, long N)
    6349             : {
    6350        4879 :   GEN v, D = mydivisorsu(N);
    6351        4879 :   long i, j, nD = lg(D) - 1, nE = lg(E) - 1;
    6352        4879 :   v = cgetg(nD*nE + 1, t_VEC);
    6353        5922 :   for (j = 1; j <= nE; j++)
    6354             :   {
    6355        1043 :     GEN Ej = gel(E, j);
    6356        1043 :     for (i = 0; i < nD; i++) gel(v, i*nE + j) = mfbd_i(Ej, D[i+1]);
    6357             :   }
    6358        4879 :   return v;
    6359             : }
    6360             : static GEN
    6361        3213 : mfdihedralcusp(long N, GEN CHI)
    6362             : {
    6363        3213 :   pari_sp av = avma;
    6364             :   GEN D, CHIP, z;
    6365             :   long F, i, lD;
    6366             : 
    6367        3213 :   CHIP = mfchartoprimitive(CHI, &F);
    6368        3213 :   D = mydivisorsu(N/F); lD = lg(D);
    6369        3213 :   z = cgetg(lD, t_VEC);
    6370        3213 :   gel(z,1) = mfdihedralnew(N, CHI);
    6371        7280 :   for (i = 2; i < lD; i++) /* skip 1 */
    6372             :   {
    6373        4067 :     long d = D[i], M = N / d;
    6374        4067 :     GEN LF = mfdihedralnew(M, mfcharinduce(CHIP, M));
    6375        4067 :     gel(z,i) = mfbdall(LF, d);
    6376             :   }
    6377        3213 :   return gerepilecopy(av, shallowconcat1(z));
    6378             : }
    6379             : 
    6380             : /* CHI an mfchar */
    6381             : static int
    6382         287 : cmp_ord(void *E, GEN a, GEN b)
    6383             : {
    6384         287 :   GEN chia = MF_get_CHI(a), chib = MF_get_CHI(b);
    6385         287 :   (void)E; return cmpii(gmfcharorder(chia), gmfcharorder(chib));
    6386             : }
    6387             : /* mfinit structure.
    6388             : -- mf[1] contains [N,k,CHI,space],
    6389             : -- mf[2] contains vector of closures of Eisenstein series, empty if not
    6390             :    full space.
    6391             : -- mf[3] contains vector of closures, so #mf[3] = dimension of cusp/new space.
    6392             : -- mf[4] contains the corresponding indices: either j for T(j)tf if newspace,
    6393             :    or [M,j,d] for B(d)T(j)tf_M if cuspspace or oldspace.
    6394             : -- mf[5] contains the matrix M of first coefficients of basis, never cleaned.
    6395             :  * NK is either [N,k] or [N,k,CHI].
    6396             :  * mfinit does not do the splitting, only the basis generation. */
    6397             : 
    6398             : /* Set flraw to 1 if do not need mf[5]: no mftobasis etc..., only the
    6399             :    expansions of the basis elements are needed. */
    6400             : 
    6401             : static GEN
    6402        4172 : mfinit_Nkchi(long N, long k, GEN CHI, long space, long flraw)
    6403             : {
    6404        4172 :   GEN M = NULL, mf = NULL, mf1 = mkvec4(utoi(N), stoi(k), CHI, utoi(space));
    6405        4172 :   long sb = mfsturmNk(N, k);
    6406             :   cachenew_t cache;
    6407        4172 :   if (k < 0 || badchar(N, k, CHI)) return mfEMPTY(mf1);
    6408        4151 :   if (k == 0) /*nothing*/;
    6409        4116 :   else if (k == 1)
    6410             :   {
    6411         217 :     switch (space)
    6412             :     {
    6413             :       case mf_NEW:
    6414             :       case mf_FULL:
    6415         189 :       case mf_CUSP: mf = mfwt1init(N, CHI, NULL, space, flraw); break;
    6416          14 :       case mf_EISEN:break;
    6417           7 :       case mf_OLD: pari_err_IMPL("mfinit in weight 1 for old space");
    6418           7 :       default: pari_err_FLAG("mfinit");
    6419             :     }
    6420             :   }
    6421             :   else /* k >= 2 */
    6422             :   {
    6423        3899 :     long ord = mfcharorder_canon(CHI);
    6424        3899 :     GEN z = NULL, P = (ord == 1)? NULL: mfcharpol(CHI);
    6425        3899 :     switch(space)
    6426             :     {
    6427             :       case mf_EISEN:
    6428          91 :         break;
    6429             :       case mf_NEW:
    6430        1162 :         mf = mfnewinit(N, k, CHI, &cache, 1);
    6431        1162 :         if (mf && !flraw) { M = MF_get_M(mf); z = MF_get_Mindex(mf); }
    6432        1162 :         break;
    6433             :       case mf_OLD:
    6434             :       case mf_CUSP:
    6435             :       case mf_FULL:
    6436        2639 :         mf = mfinitcusp(N, k, CHI, &cache, space);
    6437        2639 :         if (mf && !flraw)
    6438             :         {
    6439        2177 :           GEN S = MF_get_S(mf);
    6440        2177 :           if (space != mf_FULL)
    6441             :           { /* try to clean with heuristic bound < Sturm bound */
    6442        2093 :             M = bhnmat_extend(M, ceilA1(N,k), 1, S, &cache);
    6443        2093 :             z = QabM_indexrank(M, P, ord);
    6444        2093 :             if (lg(gel(z,2)) != lg(M)) z = NULL; /* fail */
    6445             :           }
    6446        2177 :           if (!z)
    6447             :           {
    6448         119 :             M = bhnmat_extend(M, sb+1, 1, S, &cache);
    6449         119 :             if (space == mf_CUSP) gel(mf,5) = mfcleanCHI(M, CHI);
    6450             :           }
    6451             :         }
    6452        2639 :         dbg_cachenew(&cache);
    6453        2639 :         break;
    6454           7 :       default: pari_err_FLAG("mfinit");
    6455             :     }
    6456        3892 :     if (z) gel(mf,5) = mfclean2(M, z, P, ord);
    6457             :   }
    6458        4130 :   if (!mf) mf = mfEMPTY(mf1);
    6459             :   else
    6460             :   {
    6461        3227 :     gel(mf,1) = mf1;
    6462        3227 :     if (flraw) gel(mf,5) = zerovec(3);
    6463             :   }
    6464        4130 :   if (!space_is_cusp(space))
    6465             :   {
    6466         455 :     GEN E = mfeisensteinbasis(N, k, CHI);
    6467         455 :     gel(mf,2) = E;
    6468         455 :     if (!flraw)
    6469             :     {
    6470         301 :       if (M)
    6471          84 :         M = shallowconcat(mfvectomat(E, sb+1, 1), M);
    6472             :       else
    6473         217 :         M = mfcoefs_mf(mf, sb+1, 1);
    6474         301 :       gel(mf,5) = mfcleanCHI(M, CHI);
    6475             :     }
    6476             :   }
    6477        4130 :   return mf;
    6478             : }
    6479             : 
    6480             : /* mfinit for k = nk/dk */
    6481             : static GEN
    6482        2275 : mfinit_Nndkchi(long N, long nk, long dk, GEN CHI, long space)
    6483        2387 : { return (dk == 2)? mf2init_Nkchi(N, nk >> 1, CHI, space)
    6484        2408 :                   : mfinit_Nkchi(N, nk, CHI, space, 0); }
    6485             : static GEN
    6486        2849 : mfinit_i(GEN NK, long space)
    6487             : {
    6488             :   GEN CHI;
    6489             :   long N, k, dk, joker;
    6490        2849 :   if (checkmf_i(NK))
    6491             :   {
    6492          84 :     N = mf_get_N(NK);
    6493          84 :     Qtoss(mf_get_gk(NK), &k, &dk);
    6494          84 :     CHI = mf_get_CHI(NK);
    6495             :   }
    6496        2765 :   else if (checkMF_i(NK))
    6497             :   {
    6498           7 :     if (MF_get_space(NK) == space) return NK;
    6499           7 :     N = MF_get_N(NK);
    6500           7 :     Qtoss(MF_get_gk(NK), &k, &dk);
    6501           7 :     CHI = MF_get_CHI(NK);
    6502             :   }
    6503             :   else
    6504        2758 :     checkNK2(NK, &N, &k, &dk, &CHI, 1);
    6505        2828 :   joker = !CHI || typ(CHI) == t_COL;
    6506        2828 :   if (joker)
    6507             :   {
    6508        1134 :     GEN mf, vCHI = CHI;
    6509             :     long i, j, l;
    6510        1134 :     if (CHI && lg(CHI) == 1) return cgetg(1,t_VEC);
    6511        1127 :     if (k < 0) return mfEMPTYall(N, sstoQ(k,dk), CHI, space);
    6512        1113 :     if (k == 1 && space != mf_EISEN)
    6513         476 :     {
    6514             :       GEN TMP, gN, gs;
    6515        1078 :       if (space != mf_CUSP && space != mf_NEW)
    6516           0 :         pari_err_IMPL("mfinit([N,1,wildcard], space != cusp or new space)");
    6517        1078 :       if (wt1empty(N)) return mfEMPTYall(N, gen_1, CHI, space);
    6518         476 :       vCHI = mfwt1chars(N,vCHI);
    6519         476 :       l = lg(vCHI); mf = cgetg(l, t_VEC); if (l == 1) return mf;
    6520         476 :       TMP = mfwt1_pre(N); gN = utoipos(N); gs = utoi(space);
    6521        3584 :       for (i = j = 1; i < l; i++)
    6522             :       {
    6523        3108 :         GEN c = gel(vCHI,i), z = mfwt1init(N, c, TMP, space, 0);
    6524        3108 :         if (CHI && !z) z = mfEMPTY(mkvec4(gN,gen_1,c,gs));
    6525        3108 :         if (z) gel(mf, j++) = z;
    6526             :       }
    6527             :     }
    6528             :     else
    6529             :     {
    6530          35 :       vCHI = mfchars(N,k,dk,vCHI);
    6531          35 :       l = lg(vCHI); mf = cgetg(l, t_VEC);
    6532         119 :       for (i = j = 1; i < l; i++)
    6533             :       {
    6534          84 :         GEN v = mfinit_Nndkchi(N, k, dk, gel(vCHI,i), space);
    6535          84 :         if (MF_get_dim(v) || CHI) gel(mf, j++) = v;
    6536             :       }
    6537             :     }
    6538         511 :     setlg(mf,j);
    6539         511 :     if (!CHI) gen_sort_inplace(mf, NULL, &cmp_ord, NULL);
    6540         511 :     return mf;
    6541             :   }
    6542        1694 :   return mfinit_Nndkchi(N, k, dk, CHI, space);
    6543             : }
    6544             : GEN
    6545        1918 : mfinit(GEN NK, long space)
    6546             : {
    6547        1918 :   pari_sp av = avma;
    6548        1918 :   return gerepilecopy(av, mfinit_i(NK, space));
    6549             : }
    6550             : 
    6551             : /* UTILITY FUNCTIONS */
    6552             : static void
    6553         308 : cusp_canon(GEN cusp, long N, long *pA, long *pC)
    6554             : {
    6555         308 :   pari_sp av = avma;
    6556             :   long A, C, tc, cg;
    6557         308 :   if (N <= 0) pari_err_DOMAIN("mfcuspwidth","N","<=",gen_0,stoi(N));
    6558         602 :   if (!cusp || (tc = typ(cusp)) == t_INFINITY) { *pA = 1; *pC = N; return; }
    6559         294 :   if (tc != t_INT && tc != t_FRAC ) pari_err_TYPE("checkcusp", cusp);
    6560         294 :   Qtoss(cusp, &A,&C);
    6561         294 :   if (N % C)
    6562             :   {
    6563             :     ulong uC;
    6564           7 :     long u = Fl_invgen((C-1)%N + 1, N, &uC);
    6565           7 :     A = Fl_mul(A, u, N);
    6566           7 :     C = (long)uC;
    6567             :   }
    6568         294 :   cg = ugcd(C, N/C);
    6569         294 :   while (ugcd(A, N) > 1) A += cg;
    6570         294 :   *pA = A % N; *pC = C; avma = av;
    6571             : }
    6572             : static long
    6573        3129 : mfcuspcanon_width(long N, long C)
    6574             : {
    6575        3129 :   if (C == N) return 1;
    6576        3010 :   return N/cgcd(N, C*C);
    6577             : }
    6578             : long
    6579         119 : mfcuspwidth(long N, GEN cusp)
    6580             : {
    6581             :   long A, C;
    6582         119 :   cusp_canon(cusp, N, &A, &C);
    6583         112 :   return mfcuspcanon_width(N, C);
    6584             : }
    6585             : 
    6586             : /* Q a t_INT */
    6587             : static GEN
    6588          14 : findq(GEN al, GEN Q)
    6589             : {
    6590             :   long n;
    6591          14 :   if (typ(al) == t_FRAC && cmpii(gel(al,2), Q) <= 0)
    6592           0 :     return mkvec(mkvec2(gel(al,1), gel(al,2)));
    6593          14 :   n = 1 + (long)ceil(2.0781*gtodouble(glog(Q, LOWDEFAULTPREC)));
    6594          14 :   return contfracpnqn(gboundcf(al,n), n);
    6595             : }
    6596             : static GEN
    6597          84 : findqga(long N, GEN z)
    6598             : {
    6599          84 :   GEN Q, LDC, CK = NULL, DK = NULL, ma, x, y = imag_i(z);
    6600             :   long j, l;
    6601          84 :   if (gcmpgs(gmulsg(2*N, y), 1) >= 0) return NULL;
    6602          14 :   x = real_i(z);
    6603          14 :   Q = ground(ginv(gsqrt(gmulsg(N, y), LOWDEFAULTPREC)));
    6604          14 :   LDC = findq(gmulsg(-N,x), Q);
    6605          14 :   ma = gen_1; l = lg(LDC);
    6606          35 :   for (j = 1; j < l; j++)
    6607             :   {
    6608          21 :     GEN D, DC = gel(LDC,j), C1 = gel(DC,2);
    6609          21 :     if (cmpii(C1,Q) > 0) break;
    6610          21 :     D = gel(DC,1);
    6611          21 :     if (ugcd(umodiu(D,N), N) == 1)
    6612             :     {
    6613           7 :       GEN C = mului(N, C1), den;
    6614           7 :       den = gadd(gsqr(gmul(C,y)), gsqr(gadd(D, gmul(C,x))));
    6615           7 :       if (gcmp(den, ma) < 0) { ma = den; CK = C; DK = D; }
    6616             :     }
    6617             :   }
    6618          14 :   return DK? mkvec2(CK, DK): NULL;
    6619             : }
    6620             : 
    6621             : static long
    6622          28 : valNC2(GEN P, GEN E, long e)
    6623             : {
    6624          28 :   long i, d = 1, l = lg(P);
    6625          56 :   for (i = 1; i < l; i++)
    6626             :   {
    6627          28 :     ulong v = u_lval(e, P[i]) << 1;
    6628          28 :     if (v == E[i] + 1) v--;
    6629          28 :     d *= upowuu(P[i], v);
    6630             :   }
    6631          28 :   return d;
    6632             : }
    6633             : 
    6634             : static GEN
    6635          14 : findqganew(long N, GEN z)
    6636             : {
    6637          14 :   GEN MI, DI, x = real_i(z), y = imag_i(z), fa, P, E;
    6638          14 :   long i, Ck = 0, Dk = 1;
    6639          14 :   MI = ginv(utoi(N));
    6640          14 :   DI = mydivisorsu(mysqrtu(N));
    6641          14 :   fa = myfactoru(N); P = gel(fa,1); E = gel(fa,2);
    6642          42 :   for (i = 1; i < lg(DI); i++)
    6643             :   {
    6644          28 :     long e = DI[i], C, D, g;
    6645             :     GEN U, m;
    6646          28 :     (void)cxredsl2(gmulsg(e, z), &U);
    6647          28 :     C = itos(gcoeff(U,2,1)); if (!C) continue;
    6648          28 :     D = itos(gcoeff(U,2,2));
    6649          28 :     C *= e;
    6650          28 :     g = cgcd(e, D); if (g > 1) { C /= g; D /= g; }
    6651          28 :     m = gadd(gsqr(gaddgs(gmulsg(C, x), D)), gsqr(gmulsg(C, y)));
    6652          28 :     m = gdivgs(m, valNC2(P, E, e));
    6653          28 :     if (gcmp(m, MI) < 0) { MI = m; Ck = C; Dk = D; }
    6654             :   }
    6655          14 :   return Ck? mkvec2s(Ck, Dk): NULL;
    6656             : }
    6657             : 
    6658             : static GEN
    6659         126 : cxredga0N(long N, GEN z, GEN *pU, long flag)
    6660             : {
    6661         126 :   GEN v = NULL, A, B, C, D, g;
    6662         126 :   if (N == 1) return cxredsl2(z, pU);
    6663          98 :   v = flag? findqganew(N,z): findqga(N,z);
    6664          98 :   if (!v) { *pU = matid(2); return z; }
    6665          21 :   C = gel(v,1);
    6666          21 :   D = gel(v,2); g = bezout(C, D, &B, &A);
    6667          21 :   if (!equali1(g)) pari_err_BUG("cxredga0N [gcd > 1]");
    6668          21 :   B = negi(B);
    6669          21 :   *pU = mkmat2(mkcol2(A,C), mkcol2(B,D));
    6670          21 :   return gdiv(gadd(gmul(A,z), B), gadd(gmul(C,z), D));
    6671             : }
    6672             : 
    6673             : static GEN
    6674         126 : lfunthetaall(GEN b, GEN vL, GEN t, long bitprec)
    6675             : {
    6676         126 :   long i, l = lg(vL);
    6677         126 :   GEN v = cgetg(l, t_VEC);
    6678         280 :   for (i = 1; i < l; i++)
    6679             :   {
    6680         154 :     GEN T, L = gel(vL,i), a0 = gel(L,1), ldata = gel(L,2);
    6681         154 :     GEN van = gel(ldata_get_an(ldata),2);
    6682         154 :     if (lg(van) == 1)
    6683             :     {
    6684           0 :       T = gmul(b, a0);
    6685           0 :       if (isexactzero(T)) { GEN z = real_0_bit(-bitprec); T = mkcomplex(z,z); }
    6686             :     }
    6687             :     else
    6688             :     {
    6689         154 :       T = gmul2n(lfuntheta(ldata, t, 0, bitprec), -1);
    6690         154 :       T = gmul(b, gadd(a0, T));
    6691             :     }
    6692         154 :     gel(v,i) = T;
    6693             :   }
    6694         126 :   return l == 2? gel(v,1): v;
    6695             : }
    6696             : 
    6697             : /* P in ZX */
    6698             : static GEN
    6699         245 : ZX_roots(GEN P, long prec)
    6700             : {
    6701         245 :   long d = degpol(P);
    6702         245 :   if (d == 1) return mkvec(gen_0);
    6703         245 :   if (d == 2 && isint1(gel(P,2)) && isintzero(gel(P,3)) && isint1(gel(P,4)))
    6704           7 :     return mkvec2(gen_I(), powIs(3));
    6705         238 :   return (ZX_sturm(P) == d)? realroots(P,NULL,prec): QX_complex_roots(P,prec);
    6706             : }
    6707             : /* initializations for RgX_RgV_eval / RgC_embed */
    6708             : static GEN
    6709         273 : rootspowers(GEN v)
    6710             : {
    6711             :   long i, l;
    6712         273 :   GEN w = cgetg_copy(v, &l);
    6713         273 :   for (i = 1; i < l; i++) gel(w,i) = gpowers(gel(v,i), l-2);
    6714         273 :   return w;
    6715             : }
    6716             : /* mf embeddings attached to Q(chi)/(T), chi attached to cyclotomic P */
    6717             : static GEN
    6718         805 : getembed(GEN P, GEN T, GEN zcyclo, long prec)
    6719             : {
    6720             :   long i, l;
    6721             :   GEN v;
    6722         805 :   if (degpol(P) == 1) P = NULL; /* mfcharpol for quadratic char */
    6723         805 :   if (degpol(T) == 1) T = NULL; /* dim 1 orbit */
    6724         805 :   if (T && P)
    6725          28 :   { /* K(y) / (T(y)), K = Q(t)/(P) cyclotomic */
    6726          28 :     GEN vr = RgX_is_ZX(T)? ZX_roots(T,prec): roots(RgX_embed(T,zcyclo), prec);
    6727          28 :     v = rootspowers(vr); l = lg(v);
    6728          28 :     for (i = 1; i < l; i++) gel(v,i) = mkcol3(P,zcyclo,gel(v,i));
    6729             :   }
    6730         777 :   else if (T)
    6731             :   { /* Q(y) / (T(y)), T non-cyclotomic */
    6732         245 :     GEN vr = ZX_roots(T, prec);
    6733         245 :     v = rootspowers(vr); l = lg(v);
    6734         245 :     for (i = 1; i < l; i++) gel(v,i) = mkcol2(T, gel(v,i));
    6735             :   }
    6736             :   else /* cyclotomic or rational */
    6737         532 :     v = mkvec(P? mkvec2(P, zcyclo): cgetg(1,t_VEC));
    6738         805 :   settyp(v, t_VEC); return v;
    6739             : }
    6740             : /* return mf embeddings from inspecting vector v */
    6741             : static GEN
    6742         266 : mfgetembed(GEN F, long prec)
    6743             : {
    6744         266 :   GEN T = mf_get_field(F), CHI = mf_get_CHI(F), P = mfcharpol(CHI);
    6745         266 :   long o = mfcharorder_canon(CHI);
    6746         266 :   return getembed(P, T, grootsof1(o,prec), prec);
    6747             : }
    6748             : static GEN
    6749         245 : mfeigenembed(GEN mf, long prec)
    6750             : {
    6751         245 :   GEN CHI = MF_get_CHI(mf), P = mfcharpol(CHI), vP = MF_get_fields(mf);
    6752         245 :   long i, l, o = mfcharorder_canon(CHI);
    6753         245 :   GEN vE, zcyclo = grootsof1(o, prec);
    6754         245 :   l = lg(vP); vE = cgetg(l, t_VEC);
    6755         245 :   for (i = 1; i < l; i++) gel(vE,i) = getembed(P, gel(vP,i), zcyclo, prec);
    6756         245 :   return vE;
    6757             : }
    6758             : /* dummy lfun create for theta evaluation */
    6759             : static GEN
    6760         609 : mfthetaancreate(GEN van, GEN N, GEN k)
    6761             : {
    6762         609 :   GEN L = zerovec(6);
    6763         609 :   gel(L,1) = lfuntag(t_LFUN_GENERIC, van);
    6764         609 :   gel(L,3) = mkvec2(gen_0, gen_1);
    6765         609 :   gel(L,4) = k;
    6766         609 :   gel(L,5) = N; return L;
    6767             : }
    6768             : /* destroy van and prepare to evaluate theta(sigma(van)), for all sigma in
    6769             :  * embeddings vector vE */
    6770             : static GEN
    6771         245 : van_embedall(GEN van, GEN vE, GEN gN, GEN gk)
    6772             : {
    6773         245 :   GEN a0 = gel(van,1), vL;
    6774         245 :   long i, lE = lg(vE), l = lg(van);
    6775         245 :   van++; van[0] = evaltyp(t_VEC) | evallg(l-1); /* remove a0 */
    6776         245 :   vL = cgetg(lE, t_VEC);
    6777         567 :   for (i = 1; i < lE; i++)
    6778             :   {
    6779         322 :     GEN E = gel(vE,i), v = mfvecembed(van, E);
    6780         322 :     gel(vL,i) = mkvec2(mfembed(a0,E), mfthetaancreate(v, gN, gk));
    6781             :   }
    6782         245 :   return vL;
    6783             : }
    6784             : 
    6785             : static GEN
    6786        9184 : mkmat22(long a, long b, long c, long d) {retmkmat2(mkcol2s(a,c),mkcol2s(b,d));}
    6787             : 
    6788             : static int
    6789         231 : cusp_AC(GEN cusp, long *A, long *C)
    6790             : {
    6791         231 :   switch(typ(cusp))
    6792             :   {
    6793          14 :     case t_INFINITY: *A = 1; *C = 0; break;
    6794          35 :     case t_INT:  *A = itos(cusp); *C = 1; break;
    6795          49 :     case t_FRAC: *A = itos(gel(cusp, 1)); *C = itos(gel(cusp, 2)); break;
    6796         133 :     default: *A = 0; *C = 0; return 0;
    6797             :   }
    6798          98 :   return 1;
    6799             : }
    6800             : static GEN
    6801         175 : cusp2mat(long A, long C)
    6802             : { long B, D;
    6803         175 :   cbezout(A, C, &D, &B);
    6804         175 :   return mkmat22(A, -B, C, D);
    6805             : }
    6806             : /* if t is a cusp, return F(t), else NULL */
    6807             : static GEN
    6808         161 : evalcusp(GEN mf, GEN F, GEN t, long prec)
    6809             : {
    6810             :   long A, C;
    6811             :   GEN R;
    6812         161 :   if (!cusp_AC(t, &A,&C)) return NULL;
    6813          28 :   R = mfgaexpansion(mf, F, cusp2mat(A,C), 0, prec);
    6814          28 :   return gequal0(gel(R,1))? gmael(R,3,1): gen_0;
    6815             : }
    6816             : /* Evaluate an mf closure numerically, i.e., in the usual sense, either for a
    6817             :  * single tau or a vector of tau; for each, return a vector of results
    6818             :  * corresponding to all complex embeddings of F. If flag is non-zero, allow
    6819             :  * replacing F by F | gamma to increase imag(gamma^(-1).tau) [ expensive if
    6820             :  * MF_EISENSPACE not present ] */
    6821             : static GEN
    6822         140 : mfeval_i(GEN mf, GEN F, GEN vtau, long flag, long bitprec)
    6823             : {
    6824             :   GEN L0, vL, vb, sqN, vga, vTAU, vs, van, vE;
    6825         140 :   long N = mf_get_N(F), N0, ta, lv, i, prec = nbits2prec(bitprec);
    6826         140 :   GEN gN = utoipos(N), gk = mf_get_gk(F);
    6827         140 :   long flscal = 0;
    6828             : 
    6829         140 :   ta = typ(vtau);
    6830         140 :   if (!is_vec_t(ta)) { flscal = 1; vtau = mkvec(vtau); ta = t_VEC; }
    6831         140 :   lv = lg(vtau);
    6832         140 :   sqN = sqrtr_abs(utor(N, prec));
    6833         140 :   vs = const_vec(lv-1, NULL);
    6834         140 :   vb = const_vec(lv-1, NULL);
    6835         140 :   vL = cgetg(lv, t_VEC);
    6836         140 :   vTAU = cgetg(lv, t_VEC);
    6837         140 :   vga = cgetg(lv, t_VEC);
    6838         140 :   L0 = mfthetaancreate(NULL, gN, gk); /* only for thetacost */
    6839         140 :   vE = mfgetembed(F, prec);
    6840         140 :   N0 = 0;
    6841         294 :   for (i = 1; i < lv; i++)
    6842             :   {
    6843         161 :     GEN t = gel(vtau,i), tau, U;
    6844             :     long w, n;
    6845             : 
    6846         161 :     gel(vs,i) = evalcusp(mf, F, t, prec);
    6847         161 :     if (gel(vs,i)) continue;
    6848         133 :     if (gsigne(imag_i(t)) <= 0)
    6849           7 :       pari_err_DOMAIN("mfeval","imag(tau)","<=",gen_0,t);
    6850         126 :     tau = cxredga0N(N, t, &U, flag);
    6851         126 :     if (!flag) w = 0;
    6852             :     else
    6853             :     {
    6854          28 :       w = mfcuspcanon_width(N, itos(gcoeff(U,2,1)));
    6855          28 :       tau = gdivgs(tau, w);
    6856             :     }
    6857         126 :     tau = mulcxmI(gmul(tau, sqN));
    6858         126 :     n = lfunthetacost(L0, real_i(tau), 0, bitprec);
    6859         126 :     if (N0 < n) N0 = n;
    6860         126 :     if (flag)
    6861             :     {
    6862          28 :       GEN A, al, v = mfslashexpansion(mf,F,ginv(U),N0,0,&A,prec);
    6863          28 :       gel(vL,i) = van_embedall(v, vE, gN, gk);
    6864          28 :       al = gel(A,1);
    6865          28 :       if (!gequal0(al))
    6866           0 :         gel(vb,i) = gexp(gmul(gmul(gmulsg(w,al),PiI2(prec)), tau), prec);
    6867             :     }
    6868         126 :     gel(vTAU,i) = tau;
    6869         126 :     gel(vga,i) = U;
    6870             :   }
    6871         133 :   if (!flag)
    6872             :   {
    6873         105 :     van = mfcoefs_i(F, N0, 1);
    6874         105 :     vL = const_vec(lv-1, van_embedall(van, vE, gN, gk));
    6875             :   }
    6876         287 :   for (i = 1; i < lv; i++)
    6877             :   {
    6878             :     GEN z, g, c, d, T;
    6879         154 :     if (gel(vs,i)) continue;
    6880         126 :     z = gel(vtau,i); g = gel(vga,i);
    6881         126 :     c = gcoeff(g,2,1); d = gcoeff(g,2,2);
    6882         126 :     T = gpow(gadd(gmul(c,z), d), gneg(gk), prec);
    6883         126 :     if (flag && gel(vb,i)) T = gmul(T, gel(vb,i));
    6884         126 :     gel(vs,i) = lfunthetaall(T, gel(vL,i), gel(vTAU,i), bitprec);
    6885             :   }
    6886         133 :   return flscal? gel(vs,1): vs;
    6887             : }
    6888             : 
    6889             : /* check parameters rigorously, but not coefficients */
    6890             : static long
    6891         609 : mfisinspace_i(GEN mf, GEN F)
    6892             : {
    6893             :   GEN CHI1, CHI2, chi1, chi2, F1, F2, gk;
    6894         609 :   long Nmf, N, space = MF_get_space(mf);
    6895             : 
    6896         609 :   N = mf_get_N(F);
    6897         609 :   Nmf = MF_get_N(mf);
    6898         609 :   if (space == mf_NEW)
    6899         224 :   { if (N != Nmf) return 0; }
    6900             :   else
    6901         385 :   { if (Nmf % N) return 0; }
    6902         546 :   gk = mf_get_gk(F);
    6903         546 :   if (!gequal(MF_get_gk(mf), gk)) return 0;
    6904         546 :   CHI2 = mf_get_CHI(F);
    6905         546 :   CHI1 = MF_get_CHI(mf);
    6906             :   /* are the primitive chars attached to CHI1 and CHI2 equal ? */
    6907         546 :   F1 = znconreyconductor(gel(CHI1,1), gel(CHI1,2), &chi1);
    6908         546 :   if (typ(F1) == t_VEC) F1 = gel(F1,1);
    6909         546 :   F2 = znconreyconductor(gel(CHI2,1), gel(CHI2,2), &chi2);
    6910         546 :   if (typ(F2) == t_VEC) F2 = gel(F2,1);
    6911         546 :   return equalii(F1,F2) && ZV_equal(chi1,chi2);
    6912             : }
    6913             : static void
    6914           7 : err_space(GEN F)
    6915             : {
    6916           7 :   pari_err_DOMAIN("mftobasis", "form", "does not belong to",
    6917             :                   strtoGENstr("space"), F);
    6918           0 : }
    6919             : 
    6920             : static long
    6921         126 : mfcheapeisen(GEN mf)
    6922             : {
    6923         126 :   long k, L, N = MF_get_N(mf);
    6924             :   GEN P;
    6925         126 :   if (N <= 70) return 1;
    6926          84 :   k = itos(gceil(MF_get_gk(mf)));
    6927          84 :   if (odd(k)) k--;
    6928          84 :   switch (k)
    6929             :   {
    6930           0 :     case 2:  L = 190; break;
    6931          14 :     case 4:  L = 162; break;
    6932             :     case 6:
    6933          70 :     case 8:  L = 88; break;
    6934           0 :     case 10: L = 78; break;
    6935           0 :     default: L = 66; break;
    6936             :   }
    6937          84 :   P = gel(myfactoru(N), 1);
    6938          84 :   return P[lg(P)-1] <= L;
    6939             : }
    6940             : 
    6941             : static GEN
    6942         154 : myimag_i(GEN tau)
    6943             : {
    6944         154 :   long tc = typ(tau);
    6945         154 :   if (tc == t_INFINITY || tc == t_INT || tc == t_FRAC)
    6946          28 :     return gen_1;
    6947         126 :   if (tc == t_VEC)
    6948             :   {
    6949             :     long ltau, i;
    6950           7 :     GEN z = cgetg_copy(tau, &ltau);
    6951           7 :     for (i=1; i<ltau; i++) gel(z,i) = myimag_i(gel(tau,i));
    6952           7 :     return z;
    6953             :   }
    6954         119 :   return imag_i(tau);
    6955             : }
    6956             : 
    6957             : static GEN
    6958         126 : mintau(GEN vtau)
    6959             : {
    6960         126 :   if (!is_vec_t(typ(vtau))) return myimag_i(vtau);
    6961           7 :   return (lg(vtau) == 1)? gen_1: vecmin(myimag_i(vtau));
    6962             : }
    6963             : 
    6964             : /* initialization for mfgaexpansion: what does not depend on cusp */
    6965             : static GEN
    6966         413 : mf_eisendec(GEN mf, GEN F, long prec)
    6967             : {
    6968         413 :   GEN B = liftpol_shallow(mfeisensteindec(mf, F)), v = variables_vecsmall(B);
    6969         413 :   GEN Mvecj = obj_check(mf, MF_EISENSPACE);
    6970         413 :   long l = lg(v), i, ord;
    6971         413 :   if (lg(Mvecj) < 5) Mvecj = gel(Mvecj,1);
    6972         413 :   ord = itou(gel(Mvecj,4));
    6973         462 :   for (i = 1; i < l; i++)
    6974         273 :     if (v[i] != 1) { B = gsubst(B, v[i], rootsof1u_cx(ord, prec)); break; }
    6975         413 :   return B;
    6976             : }
    6977             : 
    6978             : GEN
    6979         140 : mfeval(GEN mf, GEN F, GEN vtau, long bitprec)
    6980             : {
    6981         140 :   pari_sp av = avma;
    6982         140 :   long flnew = 1;
    6983         140 :   if (!checkMF_i(mf)) pari_err_TYPE("mfeval", mf);
    6984         140 :   if (!checkmf_i(F)) pari_err_TYPE("mfeval", F);
    6985         140 :   if (!mfisinspace_i(mf, F)) err_space(F);
    6986         140 :   if (!obj_check(mf, MF_EISENSPACE)) flnew = mfcheapeisen(mf);
    6987         140 :   if (flnew && gcmpgs(gmulsg(2*MF_get_N(mf), mintau(vtau)), 1) >= 0) flnew = 0;
    6988         140 :   return gerepilecopy(av, mfeval_i(mf, F, vtau, flnew, bitprec));
    6989             : }
    6990             : 
    6991             : /* mfinit(F * Theta) */
    6992             : static GEN
    6993          21 : mf2init(GEN mf)
    6994             : {
    6995          21 :   GEN CHI = MF_get_CHI(mf), gk = gadd(MF_get_gk(mf), ghalf);
    6996          21 :   long N = MF_get_N(mf);
    6997          21 :   return mfinit_Nkchi(N, itou(gk), mfchiadjust(CHI, gk, N), mf_FULL, 0);
    6998             : }
    6999             : GEN
    7000         189 : mfcuspval(GEN mf, GEN F, GEN cusp, long bitprec)
    7001             : {
    7002         189 :   pari_sp av = avma;
    7003         189 :   long w, N, sb, n, A, C, prec = nbits2prec(bitprec);
    7004             :   GEN ga, gk;
    7005         189 :   checkMF(mf);
    7006         189 :   if (!checkmf_i(F)) pari_err_TYPE("mfcuspval",F);
    7007         189 :   N = MF_get_N(mf);
    7008         189 :   cusp_canon(cusp, N, &A, &C);
    7009         189 :   gk = mf_get_gk(F);
    7010         189 :   if (typ(gk) != t_INT)
    7011             :   {
    7012          42 :     GEN FT = mfmultheta(F), mf2 = obj_checkbuild(mf, MF_MF2INIT, &mf2init);
    7013          42 :     GEN r = mfcuspval(mf2, FT, cusp, bitprec);
    7014          42 :     if ((C & 3L) == 2) r = gsub(r, ginv(stoi(4)));
    7015          42 :     return gerepileupto(av, r);
    7016             :   }
    7017         147 :   w = mfcuspcanon_width(N, C);
    7018         147 :   sb = w * mfsturmNk(N, itos(gk));
    7019         147 :   ga = cusp2mat(A,C);
    7020         147 :   for (n = 8;; n = minss(sb, n << 1))
    7021             :   {
    7022         147 :     GEN R = mfgaexpansion(mf, F, ga, n, prec), res = liftpol_shallow(gel(R,3));
    7023             :     long c;
    7024         252 :     for (c = 1; c < n; c++)
    7025         252 :       if (gexpo(gel(res,c)) > -bitprec/2)
    7026         147 :         return gerepileupto(av, gadd(gel(R,1), sstoQ(c-1, w)));
    7027           0 :     if (n == sb) { avma = av; return mkoo(); }
    7028           0 :   }
    7029             : }
    7030             : 
    7031             : static GEN
    7032          42 : mffrickeeigen_i(GEN mf, GEN vE, long prec)
    7033             : {
    7034          42 :   GEN M, F, Z, L0, gN = MF_get_gN(mf), gk = MF_get_gk(mf);
    7035          42 :   long N0, i, lM, bit = prec2nbits(prec), k = itou(gk);
    7036          42 :   long LIM = 5; /* Sturm bound is enough */
    7037             : 
    7038          42 :   F = MF_get_newforms(mf);
    7039          42 :   L0 = mfthetaancreate(NULL, gN, gk); /* only for thetacost */
    7040             : START:
    7041          42 :   N0 = lfunthetacost(L0, gen_1, LIM, bit);
    7042          42 :   M = mfcoefs_mf(mf, N0, 1);
    7043          42 :   lM = lg(F);
    7044          42 :   Z = cgetg(lM, t_VEC);
    7045         154 :   for (i = 1; i < lM; i++)
    7046             :   { /* expansion of D * F[i] */
    7047         112 :     GEN D, z, van = RgM_RgC_mul(M, Q_remove_denom(gel(F,i), &D));
    7048         112 :     GEN L = van_embedall(van, gel(vE,i), gN, gk);
    7049         112 :     long l = lg(L), j, bit_add = D? expi(D): 0;
    7050         112 :     gel(Z,i) = z = cgetg(l, t_VEC);
    7051         273 :     for (j = 1; j < l; j++)
    7052             :     {
    7053             :       GEN v, C, C0;
    7054             :       long m, e;
    7055         224 :       for (m = 0; m <= LIM; m++)
    7056             :       {
    7057         224 :         v = lfuntheta(gmael(L,j,2), gen_1, m, bit);
    7058         224 :         if (gexpo(v) > bit_add - bit/2) break;
    7059             :       }
    7060         161 :       if (m > LIM) { LIM <<= 1; goto START; }
    7061         161 :       C = mulcxpowIs(gdiv(v,gconj(v)), 2*m - k);
    7062         161 :       C0 = grndtoi(C, &e); if (e < 5-bit) C = C0;
    7063         161 :       gel(z,j) = C;
    7064             :     }
    7065             :   }
    7066          42 :   return Z;
    7067             : }
    7068             : static GEN
    7069         196 : mffrickeeigen(GEN mf, GEN vE, long prec)
    7070             : {
    7071         196 :   GEN D = obj_check(mf, MF_FRICKE);
    7072         196 :   if (D) { long p = gprecision(D); if (!p || p >= prec) return D; }
    7073          42 :   return obj_insert(mf, MF_FRICKE, mffrickeeigen_i(mf,vE,prec));
    7074             : }
    7075             : 
    7076             : /* integral weight, new space for primitive quadratic character CHIP;
    7077             :  * MF = vector of embedded eigenforms coefs on mfbasis, by orbit.
    7078             :  * Assume N > Q > 1 and (Q,f(CHIP)) = 1 */
    7079             : static GEN
    7080          28 : mfatkineigenquad(GEN mf, GEN CHIP, long Q, GEN MF, long bitprec)
    7081             : {
    7082             :   GEN L0, la2, S, F, vP, tau, wtau, Z, va, vb, den, coe, sqrtQ, sqrtN;
    7083          28 :   GEN M, gN, gk = MF_get_gk(mf);
    7084          28 :   long N0, t, yq, i, j, lF, dim, muQ, prec = nbits2prec(bitprec);
    7085          28 :   long N = MF_get_N(mf), k = itos(gk), NQ = N / Q;
    7086             : 
    7087             :   /* Q coprime to FC */
    7088          28 :   F = MF_get_newforms(mf);
    7089          28 :   vP = MF_get_fields(mf);
    7090          28 :   lF = lg(F);
    7091          28 :   Z = cgetg(lF, t_VEC);
    7092          28 :   S = MF_get_S(mf); dim = lg(S) - 1;
    7093          28 :   muQ = moebiusu(Q);
    7094          28 :   if (muQ)
    7095             :   {
    7096          14 :     GEN SQ = cgetg(dim+1,t_VEC), Qk = gpow(stoi(Q), sstoQ(k-2, 2), prec);
    7097          14 :     long i, bit2 = bitprec >> 1;
    7098          14 :     for (j = 1; j <= dim; j++) gel(SQ,j) = mfak_i(gel(S,j), Q);
    7099          28 :     for (i = 1; i < lF; i++)
    7100             :     {
    7101          14 :       GEN S = RgV_dotproduct(gel(F,i), SQ), T = gel(vP,i);
    7102             :       long e;
    7103          14 :       if (degpol(T) > 1 && typ(S) != t_POLMOD) S = gmodulo(S, T);
    7104          14 :       S = grndtoi(gdiv(conjvec(S, prec), Qk), &e);
    7105          14 :       if (e > -bit2) pari_err_PREC("mfatkineigenquad");
    7106          14 :       if (muQ == -1) S = gneg(S);
    7107          14 :       gel(Z,i) = S;
    7108             :     }
    7109          14 :     return Z;
    7110             :   }
    7111          14 :   la2 = mfchareval_i(CHIP, Q); /* 1 or -1 */
    7112          14 :   (void)cbezout(Q, NQ, &t, &yq);
    7113          14 :   sqrtQ = sqrtr_abs(utor(Q,prec));
    7114          14 :   tau = mkcomplex(gadd(sstoQ(-t, NQ), ginv(utoi(1000))),
    7115             :                   divru(sqrtQ, N));
    7116          14 :   den = gaddgs(gmulsg(NQ, tau), t);
    7117          14 :   wtau = gdiv(gsub(tau, sstoQ(yq, Q)), den);
    7118          14 :   coe = gpowgs(gmul(sqrtQ, den), k);
    7119             : 
    7120          14 :   sqrtN = sqrtr_abs(utor(N,prec));
    7121          14 :   tau  = mulcxmI(gmul(tau,  sqrtN));
    7122          14 :   wtau = mulcxmI(gmul(wtau, sqrtN));
    7123          14 :   gN = utoipos(N);
    7124          14 :   L0 = mfthetaancreate(NULL, gN, gk); /* only for thetacost */
    7125          14 :   N0 = maxss(lfunthetacost(L0,real_i(tau), 0,bitprec),
    7126             :              lfunthetacost(L0,real_i(wtau),0,bitprec));
    7127          14 :   M = mfcoefs_mf(mf, N0, 1);
    7128          14 :   va = cgetg(dim+1, t_VEC);
    7129          14 :   vb = cgetg(dim+1, t_VEC);
    7130         105 :   for (j = 1; j <= dim; j++)
    7131             :   {
    7132          91 :     GEN L, v = vecslice(gel(M,j), 2, N0+1); /* remove a0 */
    7133          91 :     settyp(v, t_VEC); L = mfthetaancreate(v, gN, gk);
    7134          91 :     gel(va,j) = lfuntheta(L, tau,0,bitprec);
    7135          91 :     gel(vb,j) = lfuntheta(L,wtau,0,bitprec);
    7136             :   }
    7137          84 :   for (i = 1; i < lF; i++)
    7138             :   {
    7139          70 :     GEN z, FE = gel(MF,i);
    7140          70 :     long l = lg(FE);
    7141          70 :     z = cgetg(l, t_VEC);
    7142          70 :     for (j = 1; j < l; j++)
    7143             :     {
    7144          70 :       GEN f = gel(FE,j), a = RgV_dotproduct(va,f), b = RgV_dotproduct(vb,f);
    7145          70 :       GEN la = ground( gdiv(b, gmul(a,coe)) );
    7146          70 :       if (!gequal(gsqr(la), la2)) pari_err_PREC("mfatkineigenquad");
    7147          70 :       if (typ(la) == t_INT)
    7148             :       {
    7149          70 :         if (j != 1) pari_err_BUG("mfatkineigenquad");
    7150          70 :         z = const_vec(l-1, la); break;
    7151             :       }
    7152           0 :       gel(z,j) = la;
    7153             :     }
    7154          70 :     gel(Z,i) = z;
    7155             :   }
    7156          14 :   return Z;
    7157             : }
    7158             : 
    7159             : static GEN
    7160          70 : myusqrt(ulong a, long prec)
    7161             : {
    7162          70 :   if (a == 1UL) return gen_1;
    7163          56 :   if (uissquareall(a, &a)) return utoipos(a);
    7164          42 :   return sqrtr_abs(utor(a, prec));
    7165             : }
    7166             : /* Assume mf is a non-trivial new space, rational primitive character CHIP
    7167             :  * and (Q,FC) = 1 */
    7168             : static GEN
    7169         217 : mfatkinmatnewquad(GEN mf, GEN CHIP, long Q, long flag, long PREC)
    7170             : {
    7171         217 :   GEN cM, M, D, MF, den, vE, F = MF_get_newforms(mf);
    7172         217 :   long i, c, e, prec, bitprec, lF = lg(F), N = MF_get_N(mf), k = MF_get_k(mf);
    7173             : 
    7174         217 :   if (Q == 1) return mkvec4(gen_0, matid(MF_get_dim(mf)), gen_1, mf);
    7175         203 :   den = gel(MF_get_Minv(mf), 2);
    7176         203 :   bitprec = expi(den) + 64;
    7177         203 :   if (!flag) bitprec = maxss(bitprec, prec2nbits(PREC));
    7178             : 
    7179             : START:
    7180         203 :   prec = nbits2prec(bitprec);
    7181         203 :   vE = mfeigenembed(mf, prec);
    7182         203 :   M = cgetg(lF, t_VEC);
    7183         203 :   for (i = 1; i < lF; i++) gel(M,i) = mfvecembedall(gel(F,i), gel(vE,i));
    7184         203 :   if (Q != N)
    7185             :   {
    7186          28 :     D = mfatkineigenquad(mf, CHIP, Q, M, bitprec);
    7187          28 :     c = odd(k)? Q: 1;
    7188             :   }
    7189             :   else
    7190             :   {
    7191         175 :     D = mffrickeeigen(mf, vE, DEFAULTPREC);
    7192         175 :     c = mfcharmodulus(CHIP); if (odd(k)) c = -Q/c;
    7193             :   }
    7194         203 :   D = shallowconcat1(D);
    7195         203 :   if (vec_isconst(D)) { MF = diagonal_shallow(D); flag = 0; }
    7196             :   else
    7197             :   {
    7198         189 :     M = shallowconcat1(M);
    7199         189 :     MF = RgM_mul(matmuldiagonal(M,D), ginv(M));
    7200             :   }
    7201         203 :   if (!flag) return mkvec4(gen_0, MF, gen_1, mf);
    7202             : 
    7203          21 :   if (c > 0)
    7204          21 :     cM = myusqrt(c, PREC);
    7205             :   else
    7206             :   {
    7207           0 :     MF = imag_i(MF); c = -c;
    7208           0 :     cM = mkcomplex(gen_0, myusqrt(c,PREC));
    7209             :   }
    7210          21 :   if (c != 1) MF = RgM_Rg_mul(MF, myusqrt(c,prec));
    7211          21 :   MF = grndtoi(RgM_Rg_mul(MF,den), &e);
    7212          21 :   if (e > -32) { bitprec <<= 1; goto START; }
    7213          21 :   MF = RgM_Rg_div(MF, den);
    7214          21 :   if (is_rational_t(typ(cM)) && !isint1(cM))
    7215           0 :   { MF = RgM_Rg_div(MF, cM); cM = gen_1; }
    7216          21 :   return mkvec4(gen_0, MF, cM, mf);
    7217             : }
    7218             : 
    7219             : /* let CHI mod N, Q || N, return \bar{CHI_Q} * CHI_{N/Q} */
    7220             : static GEN
    7221          70 : mfcharAL(GEN CHI, long Q)
    7222             : {
    7223          70 :   GEN G = gel(CHI,1), c = gel(CHI,2), cycc, d, P, E, F;
    7224          70 :   long l = lg(c), N = mfcharmodulus(CHI), i;
    7225          70 :   if (N == Q) return mfcharconj(CHI);
    7226          42 :   if (N == 1) return CHI;
    7227          42 :   CHI = leafcopy(CHI);
    7228          42 :   gel(CHI,2) = d = leafcopy(c);
    7229          42 :   F = znstar_get_faN(G);
    7230          42 :   P = gel(F,1);
    7231          42 :   E = gel(F,2);
    7232          42 :   cycc = znstar_get_conreycyc(G);
    7233          42 :   if (!odd(Q) && equaliu(gel(P,1), 2) && E[1] >= 3)
    7234          14 :     gel(d,2) = Fp_neg(gel(d,2), gel(cycc,2));
    7235          56 :   else for (i = 1; i < l; i++)
    7236          28 :     if (!umodui(Q, gel(P,i))) gel(d,i) = Fp_neg(gel(d,i), gel(cycc,i));
    7237          42 :   return CHI;
    7238             : }
    7239             : static long
    7240         308 : atkin_get_NQ(long N, long Q, const char *f)
    7241             : {
    7242         308 :   long NQ = N / Q;
    7243         308 :   if (N % Q) pari_err_DOMAIN(f,"N % Q","!=",gen_0,utoi(Q));
    7244         308 :   if (cgcd(NQ, Q) > 1) pari_err_DOMAIN(f,"gcd(Q,N/Q)","!=",gen_1,utoi(Q));
    7245         308 :   return NQ;
    7246             : }
    7247             : /* if flag = 1, rationalize, else don't */
    7248             : static GEN
    7249         287 : mfatkininit_i(GEN mf, long Q, long flag, long prec)
    7250             : {
    7251             :   GEN M, B, C, CHI, CHIAL, G, chi, P, z, g, mfB;
    7252             :   GEN Mindex, Minv;
    7253         287 :   long j, l, lim, ord, FC, NQ, cQ, nk, dk, N = MF_get_N(mf);
    7254             : 
    7255         287 :   B = MF_get_basis(mf); l = lg(B);
    7256         287 :   M = cgetg(l, t_MAT); if (l == 1) return mkvec4(gen_0,M,gen_1,mf);
    7257         287 :   Qtoss(MF_get_gk(mf), &nk,&dk);
    7258         287 :   Q = labs(Q);
    7259         287 :   NQ = atkin_get_NQ(N, Q, "mfatkininit");
    7260         287 :   CHI = MF_get_CHI(mf);
    7261         287 :   CHI = mfchartoprimitive(CHI, &FC);
    7262         287 :   ord = mfcharorder_canon(CHI);
    7263         287 :   if (MF_get_space(mf) == mf_NEW && ord == 1 && NQ % FC == 0 && dk == 1)
    7264         217 :     return mfatkinmatnewquad(mf, CHI, Q, flag, prec);
    7265          70 :   G   = gel(CHI,1);
    7266          70 :   chi = gel(CHI,2);
    7267          70 :   if (Q == N) { g = mkmat22(0, -1, N, 0); cQ = NQ; } /* Fricke */
    7268             :   else
    7269             :   {
    7270          28 :     GEN F, gQP = utoi(cgcd(Q, FC));
    7271             :     long t, v;
    7272          28 :     chi = znchardecompose(G, chi, gQP);
    7273          28 :     F = znconreyconductor(G, chi, &chi);
    7274          28 :     G = znstar0(F,1);
    7275          28 :     (void)cbezout(Q, NQ, &t, &v);
    7276          28 :     g = mkmat22(Q, 1, -N*v, Q*t);
    7277          28 :     cQ = -NQ*v;
    7278             :   }
    7279          70 :   C = gen_1;
    7280          70 :   if (flag)
    7281             :   { /* N.B. G,chi are G_Q,chi_Q [primitive] at this point */
    7282          70 :     GEN s = gen_1;
    7283          70 :     if (lg(chi) != 1) C = ginv( znchargauss(G, chi, gen_1, prec2nbits(prec)) );
    7284          70 :     if (dk == 1)
    7285          63 :     { if (odd(nk)) s = myusqrt(Q,prec); }
    7286             :     else
    7287             :     {
    7288           7 :       long r = nk >> 1; /* k-1/2 */
    7289           7 :       s = gpow(utoipos(Q), mkfracss(odd(r)? 1: 3, 4), prec);
    7290           7 :       if (odd(cQ))
    7291             :       {
    7292           7 :         long t = r + ((cQ-1) >> 1);
    7293           7 :         s = mkcomplex(s, odd(t)? gneg(s): s);
    7294             :       }
    7295             :     }
    7296          70 :     if (!isint1(s)) C = gmul(C, s);
    7297             :   }
    7298          70 :   CHIAL = mfcharAL(CHI, Q);
    7299          70 :   if (dk == 2)
    7300           7 :     CHIAL = mfcharmul(CHIAL, induce(gel(CHIAL,1), utoipos(odd(Q) ? Q<<2 : Q)));
    7301          70 :   CHIAL = mfchartoprimitive(CHIAL,NULL);
    7302          70 :   mfB = gequal(CHIAL, CHI)? mf: mfinit_Nndkchi(N,nk,dk,CHIAL,MF_get_space(mf));
    7303          70 :   Mindex = MF_get_Mindex(mfB);
    7304          70 :   Minv = MF_get_Minv(mfB);
    7305          70 :   P = z = NULL;
    7306          70 :   if (ord != 1)
    7307             :   {
    7308          28 :     if (flag) { P = mfcharpol(CHI); z = rootsof1u_cx(ord, prec); }
    7309           0 :     else Minv = Minv_embed(Minv, grootsof1(ord, prec));
    7310             :   }
    7311          70 :   lim = maxss(mfsturm(mfB), mfsturm(mf)) + 1;
    7312         217 :   for (j = 1; j < l; j++)
    7313             :   {
    7314         147 :     GEN v = mfslashexpansion(mf, gel(B,j), g, lim, 0, NULL, prec+1);
    7315             :     long junk;
    7316         147 :     if (flag)
    7317             :     {
    7318         147 :       if (!isint1(C)) v = RgV_Rg_mul(v, C);
    7319         147 :       v = bestapprnf(v, P, z, prec);
    7320             :     }
    7321         147 :     v = vecpermute_partial(v, Mindex, &junk);
    7322         147 :     v = Minv_RgC_mul(Minv, v); /* cf mftobasis_i */
    7323         147 :     gel(M, j) = v;
    7324             :   }
    7325          70 :   if (is_rational_t(typ(C)) && !gequal1(C)) { M = gdiv(M, C); C = gen_1; }
    7326          70 :   if (mfB == mf) mfB = gen_0;
    7327          70 :   return mkvec4(mfB, M, C, mf);
    7328             : }
    7329             : GEN
    7330          77 : mfatkininit(GEN mf, long Q, long prec)
    7331             : {
    7332          77 :   pari_sp av = avma;
    7333          77 :   checkMF(mf); return gerepilecopy(av, mfatkininit_i(mf, Q, 1, prec));
    7334             : }
    7335             : static void
    7336          21 : checkmfa(GEN z)
    7337             : {
    7338          21 :   if (typ(z) != t_VEC || lg(z) != 5 || typ(gel(z,2)) != t_MAT
    7339          21 :       || !checkMF_i(gel(z,4))
    7340          21 :       || (!isintzero(gel(z,1)) && !checkMF_i(gel(z,1))))
    7341           0 :     pari_err_TYPE("mfatkin [please apply mfatkininit()]",z);
    7342          21 : }
    7343             : 
    7344             : /* Apply atkin Q to closure F */
    7345             : GEN
    7346          21 : mfatkin(GEN mfa, GEN F)
    7347             : {
    7348          21 :   pari_sp av = avma;
    7349             :   GEN z, mfB, MQ, mf;
    7350          21 :   checkmfa(mfa);
    7351          21 :   mfB= gel(mfa,1);
    7352          21 :   MQ = gel(mfa,2);
    7353          21 :   mf = gel(mfa,4);
    7354          21 :   if (typ(mfB) == t_INT) mfB = mf;
    7355          21 :   z = RgM_RgC_mul(MQ, mftobasis_i(mf,F));
    7356          21 :   return gerepileupto(av, mflinear(mfB, z));
    7357             : }
    7358             : 
    7359             : GEN
    7360          42 : mfatkineigenvalues(GEN mf, long Q, long prec)
    7361             : {
    7362          42 :   pari_sp av = avma;
    7363             :   GEN vF, L, CHI, M, mfatk, C, MQ, vE, mfB;
    7364             :   long N, NQ, l, i;
    7365             : 
    7366          42 :   checkMF(mf); N = MF_get_N(mf); CHI = MF_get_CHI(mf);
    7367          42 :   vF = MF_get_newforms(mf); l = lg(vF);
    7368          42 :   if (l == 1) { avma = av; return cgetg(1, t_VEC); }
    7369          42 :   L = cgetg(l, t_VEC);
    7370          42 :   if (Q == 1)
    7371             :   {
    7372           7 :     GEN vP = MF_get_fields(mf);
    7373           7 :     for (i = 1; i < l; i++) gel(L,i) = const_vec(degpol(gel(vP,i)), gen_1);
    7374           7 :     return L;
    7375             :   }
    7376          35 :   vE = mfeigenembed(mf,prec);
    7377          35 :   if (Q == N) return gerepileupto(av, mffrickeeigen(mf, vE, prec));
    7378          21 :   Q = labs(Q);
    7379          21 :   NQ = atkin_get_NQ(N, Q, "mfatkineigenvalues");
    7380          21 :   mfatk = mfatkininit(mf, Q, prec);
    7381          21 :   mfB= gel(mfatk,1); if (typ(mfB) != t_VEC) mfB = mf;
    7382          21 :   MQ = gel(mfatk,2);
    7383          21 :   C  = gel(mfatk,3);
    7384          21 :   M = row(mfcoefs_mf(mfB,1,1), 2); /* vec of a_1(b_i) for mfbasis functions */
    7385          56 :   for (i = 1; i < l; i++)
    7386             :   {
    7387          35 :     GEN c = RgV_dotproduct(RgM_RgC_mul(MQ,gel(vF,i)), M); /* C * eigen_i */
    7388          35 :     gel(L,i) = mfembedall(c, gel(vE,i));
    7389             :   }
    7390          21 :   if (!gequal1(C)) L = gdiv(L, C);
    7391          21 :   if (MF_get_space(mf) == mf_NEW && mfcharorder(CHI) <= 2
    7392           7 :       && (NQ==1 || NQ % mfcharconductor(CHI) == 0)
    7393           7 :       && typ(MF_get_gk(mf)) == t_INT) L = ground(L);
    7394          21 :   return gerepilecopy(av, L);
    7395             : }
    7396             : 
    7397             : /* expand B_d V, keeping same length */
    7398             : static GEN
    7399        8988 : bdexpand(GEN V, long d)
    7400             : {
    7401             :   GEN W;
    7402             :   long N, n;
    7403        8988 :   if (d == 1) return V;
    7404        2562 :   N = lg(V)-1; W = zerovec(N);
    7405        2562 :   for (n = 0; n <= (N-1)/d; n++) gel(W, n*d+1) = gel(V, n+1);
    7406        2562 :   return W;
    7407             : }
    7408             : /* expand B_d V, multiply length by d */
    7409             : static GEN
    7410         175 : bdexpandall(GEN V, long d)
    7411             : {
    7412             :   GEN W;
    7413             :   long N, n;
    7414         175 :   if (d == 1) return V;
    7415          14 :   N = lg(V)-1; W = zerovec(N*d);
    7416          14 :   for (n = 0; n <= N-1; n++) gel(W, n*d+1) = gel(V, n+1);
    7417          14 :   return W;
    7418             : }
    7419             : 
    7420             : static void
    7421        9422 : parse_vecj(GEN T, GEN *E1, GEN *E2)
    7422             : {
    7423        9422 :   if (lg(T)==3) { *E1 = gel(T,1); *E2 = gel(T,2); }
    7424        3402 :   else { *E1 = T; *E2 = NULL; }
    7425        9422 : }
    7426             : 
    7427             : static int
    7428        3220 : is_in_M2(GEN g) { return typ(g) == t_MAT && lg(g) == 3 && lgcols(g) == 3; }
    7429             : /* g in SL_2(Z) ? */
    7430             : static void
    7431        1722 : check_SL2Z(GEN g)
    7432             : {
    7433        1722 :   if (!is_in_M2(g) || !RgM_is_ZM(g) || !equali1(ZM_det(g)))
    7434           0 :     pari_err_TYPE("check_SL2Z", g);
    7435        1722 : }
    7436             : /* g in M_2(Q) ? */
    7437             : static void
    7438        1498 : check_M2Q(GEN g)
    7439             : {
    7440        1498 :   if (!is_in_M2(g) || !RgM_is_QM(g)) pari_err_TYPE("check_M2Q", g);
    7441        1498 : }
    7442             : 
    7443             : static GEN
    7444        4746 : mfcharcxeval(GEN CHI, long n, long prec)
    7445             : {
    7446             :   GEN ordg;
    7447             :   ulong ord;
    7448        4746 :   if (cgcd(mfcharmodulus(CHI), n) > 1) return gen_0;
    7449        4746 :   ordg = gmfcharorder(CHI);
    7450        4746 :   ord = itou(ordg);
    7451        4746 :   return rootsof1q_cx(znchareval_i(CHI,n,ordg), ord, prec);
    7452             : }
    7453             : 
    7454             : static GEN
    7455        8764 : RgV_shift(GEN V, GEN gn)
    7456             : {
    7457             :   long i, n, l;
    7458             :   GEN W;
    7459        8764 :   if (typ(gn) != t_INT) pari_err_BUG("RgV_shift [n not integral]");
    7460        8764 :   n = itos(gn);
    7461        8764 :   if (n < 0) pari_err_BUG("RgV_shift [n negative]");
    7462        8764 :   if (!n) return V;
    7463         154 :   W = cgetg_copy(V, &l); if (n > l-1) n = l-1;
    7464         154 :   for (i=1; i <= n; i++) gel(W,i) = gen_0;
    7465         154 :   for (    ; i < l; i++) gel(W,i) = gel(V, i-n);
    7466         154 :   return W;
    7467             : }
    7468             : static GEN
    7469       13216 : hash_eisengacx(hashtable *H, void *E, long w, GEN ga, long n, long prec)
    7470             : {
    7471       13216 :   ulong h = H->hash(E);
    7472       13216 :   hashentry *e = hash_search2(H, E, h);
    7473             :   GEN v;
    7474       13216 :   if (e) v = (GEN)e->val;
    7475             :   else
    7476             :   {
    7477        8022 :     v = mfeisensteingacx((GEN)E, w, ga, n, prec);
    7478        8022 :     hash_insert2(H, E, (void*)v, h);
    7479             :   }
    7480       13216 :   return v;
    7481             : }
    7482             : static GEN
    7483        7938 : vecj_expand(GEN B, hashtable *H, long w, GEN ga, long n, long prec)
    7484             : {
    7485             :   GEN E1, E2, v;
    7486        7938 :   parse_vecj(B, &E1, &E2);
    7487        7938 :   v = hash_eisengacx(H, (void*)E1, w, ga, n, prec);
    7488        7938 :   if (E2)
    7489             :   {
    7490        5271 :     GEN u = hash_eisengacx(H, (void*)E2, w, ga, n, prec);
    7491        5271 :     GEN a = gadd(gel(v,1), gel(u,1));
    7492        5271 :     GEN b = RgV_mul_RgXn(gel(v,2), gel(u,2));
    7493        5271 :     v = mkvec2(a,b);
    7494             :   }
    7495        7938 :   return v;
    7496             : }
    7497             : static GEN
    7498        1323 : shift_M(GEN M, GEN Valpha, long w)
    7499             : {
    7500        1323 :   long i, l = lg(Valpha);
    7501        1323 :   GEN almin = vecmin(Valpha);
    7502        9261 :   for (i = 1; i < l; i++)
    7503             :   {
    7504        7938 :     GEN alpha = gel(Valpha, i), gsh = gmulsg(w, gsub(alpha,almin));
    7505        7938 :     gel(M,i) = RgV_shift(gel(M,i), gsh);
    7506             :   }
    7507        1323 :   return almin;
    7508             : }
    7509             : #if 0
    7510             : /* ga in M_2^+(Z)), n >= 0 */
    7511             : static GEN
    7512             : mfgaexpansion_init(GEN mf, GEN ga, long n, long prec)
    7513             : {
    7514             :   GEN M, Mvecj, vecj, almin, Valpha;
    7515             :   long i, w, l, N = MF_get_N(mf), c = itos(gcoeff(ga,2,1));
    7516             :   hashtable *H;
    7517             : 
    7518             :   if (c % N == 0)
    7519             :   { /* ga in G_0(N), trivial case; w = 1 */
    7520             :     GEN chid = mfcharcxeval(MF_get_CHI(mf), itos(gcoeff(ga,2,2)), prec);
    7521             :     return mkvec2(chid, utoi(n));
    7522             :   }
    7523             : 
    7524             :   Mvecj = obj_checkbuild(mf, MF_EISENSPACE, &mfeisensteinspaceinit);
    7525             :   if (lg(Mvecj) < 5) pari_err_IMPL("mfgaexpansion_init in this case");
    7526             :   w = mfcuspcanon_width(N, c);
    7527             :   vecj = gel(Mvecj, 3);
    7528             :   l = lg(vecj);
    7529             :   M = cgetg(l, t_VEC);
    7530             :   Valpha = cgetg(l, t_VEC);
    7531             :   H = hash_create(l, (ulong(*)(void*))&hash_GEN,
    7532             :                      (int(*)(void*,void*))&gidentical, 1);
    7533             :   for (i = 1; i < l; i++)
    7534             :   {
    7535             :     GEN v = vecj_expand(gel(vecj,i), H, w, ga, n, prec);
    7536             :     gel(Valpha,i) = gel(v,1);
    7537             :     gel(M,i) = gel(v,2);
    7538             :   }
    7539             :   almin = shift_M(M, Valpha, w);
    7540             :   return mkvec3(almin, utoi(w), M);
    7541             : }
    7542             : /* half-integer weight not supported; vF = [F,eisendec(F)].
    7543             :  * Minit = mfgaexpansion_init(mf, ga, n, prec) */
    7544             : static GEN
    7545             : mfgaexpansion_with_init(GEN Minit, GEN vF)
    7546             : {
    7547             :   GEN v;
    7548             :   if (lg(Minit) == 3)
    7549             :   { /* ga in G_0(N) */
    7550             :     GEN chid = gel(Minit,1), gn = gel(Minit,2);
    7551             :     v = mfcoefs_i(gel(vF,1), itou(gn), 1);
    7552             :     v = mkvec3(gen_0, gen_1, RgV_Rg_mul(v,chid));
    7553             :   }
    7554             :   else
    7555             :   {
    7556             :     GEN V = RgM_RgC_mul(gel(Minit,3), gel(vF,2));
    7557             :     v = mkvec3(gel(Minit,1), gel(Minit,2), V);
    7558             :   }
    7559             :   return v;
    7560             : }
    7561             : #endif
    7562             : 
    7563             : /* B = mfeisensteindec(F) already embedded, ga in M_2^+(Z)), n >= 0 */
    7564             : static GEN
    7565        1323 : mfgaexpansion_i(GEN mf, GEN B0, GEN ga, long n, long prec)
    7566             : {
    7567        1323 :   GEN M, Mvecj, vecj, almin, Valpha, B, E = NULL;
    7568        1323 :   long i, j, w, l, N = MF_get_N(mf), bit = prec2nbits(prec) / 2;
    7569             :   hashtable *H;
    7570             : 
    7571        1323 :   Mvecj = obj_checkbuild(mf, MF_EISENSPACE, &mfeisensteinspaceinit);
    7572        1323 :   if (lg(Mvecj) < 5) { E = gel(Mvecj, 2); Mvecj = gel(Mvecj, 1); }
    7573        1323 :   vecj = gel(Mvecj, 3);
    7574        1323 :   l = lg(vecj);
    7575        1323 :   B = cgetg(l, t_COL);
    7576        1323 :   M = cgetg(l, t_VEC);
    7577        1323 :   Valpha = cgetg(l, t_VEC);
    7578        1323 :   w = mfcuspcanon_width(N, itos(gcoeff(ga, 2, 1)));
    7579        1323 :   H = hash_create(l, (ulong(*)(void*))&hash_GEN,
    7580             :                      (int(*)(void*,void*))&gidentical, 1);
    7581       11256 :   for (i = j = 1; i < l; i++)
    7582             :   {
    7583             :     GEN v;
    7584        9933 :     if (gequal0(gel(B0,i))) continue;
    7585        7938 :     v = vecj_expand(gel(vecj,i), H, w, ga, n, prec);
    7586        7938 :     gel(B,j) = gel(B0,i);
    7587        7938 :     gel(Valpha,j) = gel(v,1);
    7588        7938 :     gel(M,j) = gel(v,2); j++;
    7589             :   }
    7590        1323 :   setlg(Valpha, j);
    7591        1323 :   setlg(B, j);
    7592        1323 :   setlg(M, j); l = j;
    7593        1323 :   if (l == 1) return mkvec3(gen_0, utoi(w), zerovec(n+1));
    7594        1323 :   almin = shift_M(M, Valpha, w);
    7595        1323 :   B = RgM_RgC_mul(M, B); l = lg(B);
    7596      187733 :   for (i = 1; i < l; i++)
    7597      186410 :     if (gexpo(gel(B,i)) < -bit) gel(B,i) = gen_0;
    7598        1323 :   settyp(B, t_VEC);
    7599        1323 :   if (E)
    7600             :   {
    7601           7 :     GEN v = hash_eisengacx(H, (void*)E, w, ga, n, prec);
    7602           7 :     almin = gsub(almin, gel(v,1));
    7603           7 :     if (gsigne(almin) < 0) pari_err_IMPL("mfgaexpansion [almin < 0]");
    7604           7 :     B = RgV_div_RgXn(B, gel(v,2));
    7605             :   }
    7606        1323 :   return mkvec3(almin, utoi(w), B);
    7607             : }
    7608             : 
    7609             : /* Theta multiplier: assume 4 | C, (C,D)=1 */
    7610             : static GEN
    7611          42 : mfthetamultiplier(long C, long D)
    7612             : {
    7613          42 :   long s = kross(C, D);
    7614          42 :   if ((D&3L) == 1) return stoi(s);
    7615           0 :   return s > 0 ? powIs(3) : gen_I();
    7616             : }
    7617             : static GEN
    7618          42 : mfthetaexpansion(GEN M, long n)
    7619             : {
    7620          42 :   GEN s, al, sla, V = zerovec(n + 1);
    7621          42 :   long w, lim, la, f, C = itos(gcoeff(M, 2, 1)), D = itos(gcoeff(M, 2, 2));
    7622          42 :   switch (C & 3L)
    7623             :   {
    7624           7 :     case 0: al = gen_0; w = 1;
    7625           7 :       s = mfthetamultiplier(C,D);
    7626           7 :       lim = usqrt(n); gel(V, 1) = s;
    7627           7 :       s = gmul2n(s, 1);
    7628           7 :       for (f = 1; f <= lim; f++) gel(V, f*f + 1) = s;
    7629           7 :       break;
    7630           7 :     case 2: al = sstoQ(1,4); w = 1;
    7631           7 :       s = gmul2n(mfthetamultiplier(C - 2*D, D), 1);
    7632           7 :       lim = (usqrt(n << 2) - 1) >> 1;
    7633           7 :       for (f = 0; f <= lim; f++) gel(V, f*(f+1) + 1) = s;
    7634           7 :       break;
    7635          28 :     default: al = gen_0; w = 4; la = (-D*C) & 3L;
    7636          28 :       s = mfthetamultiplier(-(D + la*C), C);
    7637          28 :       s = gsub(s, mulcxI(s));
    7638          28 :       sla = gmul(s, powIs(-la));
    7639          28 :       lim = usqrt(n); gel(V, 1) = gmul2n(s, -1);
    7640          28 :       for (f = 1; f <= lim; f++) gel(V, f*f + 1) = odd(f) ? sla : s;
    7641          28 :       break;
    7642             :   }
    7643          42 :   return mkvec3(al, stoi(w), V);
    7644             : }
    7645             : 
    7646             : /* F 1/2 integral weight */
    7647             : static GEN
    7648          42 : mf2gaexpansion(GEN mf2, GEN F, GEN ga, long n, long prec)
    7649             : {
    7650          42 :   GEN FT = mfmultheta(F), mf = obj_checkbuild(mf2, MF_MF2INIT, &mf2init);
    7651             :   GEN res, V1, Tres, V2, al, V, gsh;
    7652          42 :   long w2, C = itos(gcoeff(ga,2,1)), w = mfcuspcanon_width(mf_get_N(FT), C);
    7653          42 :   long ext = ((C & 3L) != 2)? 0: (w+3) >> 2;
    7654             : 
    7655          42 :   res = mfgaexpansion(mf, FT, ga, n + ext, prec);
    7656          42 :   Tres = mfthetaexpansion(ga, n + ext);
    7657          42 :   V1 = gel(res,3);
    7658          42 :   V2 = gel(Tres,3);
    7659          42 :   al = gsub(gel(res,1), gel(Tres,1));
    7660          42 :   w2 = itos(gel(Tres,2));
    7661          42 :   if (w != itos(gel(res,2)) || w % w2)
    7662           0 :     pari_err_BUG("mf2gaexpansion [incorrect w2 or w]");
    7663          42 :   if (w2 != w) V2 = bdexpand(V2, w/w2);
    7664          42 :   V = RgV_div_RgXn(V1, V2);
    7665          42 :   gsh = gfloor(gmulsg(w, al));
    7666          42 :   if (!gequal0(gsh))
    7667             :   {
    7668           0 :     al = gsub(al, gdivgs(gsh, w));
    7669           0 :     if (gsigne(gsh) > 0)
    7670             :     {
    7671           0 :       V = RgV_shift(V, gsh);
    7672           0 :       V = vecslice(V, 1, n + 1);
    7673             :     }
    7674             :     else
    7675             :     {
    7676           0 :       long sh = -itos(gsh), i;
    7677           0 :       if (sh > ext) pari_err_BUG("mf2gaexpansion [incorrect sh]");
    7678           0 :       for (i = 1; i <= sh; i++)
    7679           0 :         if (!gequal0(gel(V,i))) pari_err_BUG("mf2gaexpansion [sh too large]");
    7680           0 :       V = vecslice(V, sh+1, n + sh+1);
    7681             :     }
    7682             :   }
    7683          42 :   obj_free(mf); return mkvec3(al, stoi(w), V);
    7684             : }
    7685             : 
    7686             : static GEN
    7687         175 : mfgaexpansionatkin(GEN mf, GEN F, long C, long D, long Q, long n, long prec)
    7688             : {
    7689         175 :   GEN mfa = mfatkininit_i(mf, Q, 0, prec), MQ = gel(mfa,2);
    7690         175 :   long i, t, v, FC, k = MF_get_k(mf);
    7691         175 :   GEN V, z, s, CHI = mfchartoprimitive(MF_get_CHI(mf), &FC);
    7692             : 
    7693             :   /* V = mfcoefs(F | w_Q, n), can't use mfatkin because MQ non-rational */
    7694         175 :   V = RgM_RgC_mul(mfcoefs_mf(mf,n,1), RgM_RgC_mul(MQ, mftobasis_i(mf,F)));
    7695         175 :   (void)cbezout(Q, C, &t, &v);
    7696         175 :   s = mfchareval_i(CHI, (((t*Q) % FC) * D) % FC);
    7697         175 :   s = gdiv(s, gpow(utoipos(Q), sstoQ(k,2), prec));
    7698         175 :   V = RgV_Rg_mul(V, s);
    7699         175 :   z = rootsof1powinit(D*v % Q, Q, prec);
    7700         175 :   for (i = 1; i <= n+1; i++) gel(V,i) = gmul(gel(V,i), rootsof1pow(z, i-1));
    7701         175 :   return mkvec3(gen_0, utoipos(Q), V);
    7702             : }
    7703             : 
    7704             : /* allow F of the form [F, mf_eisendec(F)]~ */
    7705             : static GEN
    7706        1715 : mfgaexpansion(GEN mf, GEN F, GEN ga, long n, long prec)
    7707             : {
    7708        1715 :   GEN v, EF = NULL;
    7709             :   long c, d;
    7710             : 
    7711        1715 :   if (n < 0) pari_err_DOMAIN("mfgaexpansion", "n", "<", gen_0, stoi(n));
    7712        1715 :   if (typ(F) == t_COL && lg(F) == 3) { EF = gel(F,2); F = gel(F,1); }
    7713        1715 :   if (!checkmf_i(F)) pari_err_TYPE("mfgaexpansion", F);
    7714        1715 :   check_SL2Z(ga);
    7715        1715 :   if (typ(mf_get_gk(F)) != t_INT) return mf2gaexpansion(mf, F, ga, n, prec);
    7716        1673 :   c = itos(gcoeff(ga,2,1));
    7717        1673 :   d = itos(gcoeff(ga,2,2));
    7718        1673 :   if (c % mf_get_N(F) == 0)
    7719             :   { /* trivial case: ga in Gamma_0(N) */
    7720         175 :     long N = MF_get_N(mf), w = mfcuspcanon_width(N,c);
    7721         175 :     GEN chid = mfcharcxeval(mf_get_CHI(F), d, prec);
    7722         175 :     v = bdexpandall(mfcoefs_i(F, n/w, 1), w);
    7723         175 :     return mkvec3(gen_0, stoi(w), RgV_Rg_mul(v,chid));
    7724             :   }
    7725        1498 :   if (MF_get_space(mf) == mf_NEW)
    7726             :   {
    7727         798 :     long N = MF_get_N(mf), g = cgcd(c,N), Q = N/g;
    7728         798 :     GEN CHI = MF_get_CHI(mf);
    7729         798 :     if (cgcd(c, Q)==1 && mfcharorder(CHI) <= 2
    7730         406 :                       && g % mfcharconductor(CHI) == 0
    7731         371 :                       && degpol(mf_get_field(F)) == 1)
    7732         175 :       return mfgaexpansionatkin(mf, F, c, d, Q, n, prec);
    7733             :   }
    7734        1323 :   if (!EF) EF = mf_eisendec(mf,F,prec);
    7735        1323 :   return mfgaexpansion_i(mf, EF, ga, n, prec);
    7736             : }
    7737             : 
    7738             : /* parity = -1 or +1 */
    7739             : static GEN
    7740         280 : findd(long N, long parity)
    7741             : {
    7742         280 :   GEN L, D = mydivisorsu(N);
    7743         280 :   long i, j, l = lg(D);
    7744         280 :   L = cgetg(l, t_VEC);
    7745        1386 :   for (i = j = 1; i < l; i++)
    7746             :   {
    7747        1106 :     long d = D[i];
    7748        1106 :     if (parity == -1) d = -d;
    7749        1106 :     if (sisfundamental(d)) gel(L,j++) = stoi(d);
    7750             :   }
    7751         280 :   setlg(L,j); return L;
    7752             : }
    7753             : 
    7754             : GEN
    7755           7 : mfsearch(GEN NK, GEN V, long space)
    7756             : {
    7757           7 :   pari_sp ltop = avma;
    7758             :   GEN RES, gk;
    7759             :   long N, nk, dk, parity, lV, i, Nlim, N0;
    7760           7 :   if (typ(NK) != t_VEC || lg(NK) != 3
    7761           7 :       || typ(gel(NK,1)) != t_INT
    7762           7 :       || typ(gmul2n(gel(NK,2), 1)) != t_INT) pari_err_TYPE("mfsearch", NK);
    7763           7 :   Nlim = itos(gel(NK,1));
    7764           7 :   gk = gel(NK,2); Qtoss(gk, &nk,&dk);
    7765           7 :   parity = (dk == 1 && odd(nk)) ? -1 : 1;
    7766           7 :   if (typ(V) == t_VEC) settyp(V, t_COL);
    7767           7 :   if (typ(V) != t_COL) pari_err_TYPE("mfsearch", V);
    7768           7 :   lV = lg(V) - 1; RES = cgetg(1, t_VEC);
    7769           7 :   N0 = (dk == 2) ? 4 : 1;
    7770         287 :   for (N = N0; N <= Nlim; N += N0)
    7771             :   {
    7772         280 :     GEN L = findd(N, parity), gN = utoi(N);
    7773         756 :     for (i = 1; i < lg(L); i++)
    7774             :     {
    7775         476 :       GEN gD = gel(L, i), CHI = get_mfchar(gD);
    7776         476 :       GEN mf = mfinit_Nndkchi(N, nk, dk, CHI, space);
    7777         476 :       GEN M = mfcoefs(mf, lV - 1, 1);
    7778         476 :       GEN CO = inverseimage(M, V);
    7779         476 :       if (lg(CO) > 1)
    7780             :       {
    7781          21 :         long found = 0, j;
    7782          42 :         for (j = 1; j < lg(RES); j++)
    7783             :         {
    7784          21 :           GEN tmp = gel(RES, j);
    7785          21 :           if (gequal(gel(tmp, 3), gD) && gequal0(modii(gN, gel(tmp, 1))))
    7786           0 :           { found = 1; break; }
    7787             :         }
    7788          21 :         if (!found)
    7789          21 :           RES = concat(RES, mkvec(mkvec4(gN, gk, gD, mflinear(mf, CO))));
    7790             :       }
    7791             :     }
    7792             :   }
    7793           7 :   return gerepilecopy(ltop, RES);
    7794             : }
    7795             : 
    7796             : static GEN
    7797         882 : search_from_split(GEN mf, GEN vap, GEN vlp)
    7798             : {
    7799         882 :   pari_sp av = avma;
    7800         882 :   long lvlp = lg(vlp), N = MF_get_N(mf), j, jv, l1;
    7801         882 :   GEN v, NK, S1, S, M = NULL;
    7802             : 
    7803         882 :   S1 = gel(mfsplit(mf, 1, 0), 1); /* rational newforms */
    7804         882 :   l1 = lg(S1);
    7805         882 :   if (l1 == 1) { avma = av; return NULL; }
    7806         448 :   v = cgetg(l1, t_VEC);
    7807         448 :   S = MF_get_S(mf);
    7808         448 :   NK = mf_get_NK(gel(S,1));
    7809         448 :   if (lvlp > 1) M = rowpermute(mfcoefs_mf(mf, vlp[lvlp-1], 1), vlp);
    7810         966 :   for (j = jv = 1; j < l1; j++)
    7811             :   {
    7812         518 :     GEN vF = gel(S1,j);
    7813             :     long t;
    7814         651 :     for (t = lvlp-1; t > 0; t--)
    7815             :     { /* lhs = vlp[j]-th coefficient of eigenform */
    7816         595 :       GEN rhs = gel(vap,t), lhs = RgMrow_RgC_mul(M, vF, t);
    7817         595 :       if (!gequal(lhs, rhs)) break;
    7818             :     }
    7819         518 :     if (t) continue;
    7820          56 :     gel(v,jv++) = mkvec2(utoi(N), mflinear_i(NK,S,vF));
    7821             :   }
    7822         448 :   if (jv == 1) { avma = av; return NULL; }
    7823          56 :   setlg(v,jv); return v;
    7824             : }
    7825             : GEN
    7826          28 : mfeigensearch(GEN NK, GEN AP)
    7827             : {
    7828          28 :   pari_sp av = avma;
    7829          28 :   GEN k, vap, vlp, vres = cgetg(1, t_VEC), D;
    7830             :   long N, N0, i, l, even;
    7831             : 
    7832          28 :   if (!AP) l = 1;
    7833             :   else
    7834             :   {
    7835          28 :     l = lg(AP);
    7836          28 :     if (typ(AP) != t_VEC) pari_err_TYPE("mfeigensearch",AP);
    7837             :   }
    7838          28 :   vap = cgetg(l, t_VEC);
    7839          28 :   vlp = cgetg(l, t_VEC);
    7840          28 :   if (l > 1)
    7841             :   {
    7842          28 :     GEN perm = indexvecsort(AP, mkvecsmall(1));
    7843          77 :     for (i = 1; i < l; i++)
    7844             :     {
    7845          49 :       GEN v = gel(AP,perm[i]), gp, ap;
    7846          49 :       if (typ(v) != t_VEC || lg(v) != 3) pari_err_TYPE("mfeigensearch", AP);
    7847          49 :       gp = gel(v,1);
    7848          49 :       ap = gel(v,2);
    7849          49 :       if (typ(gp) != t_INT || (typ(ap) != t_INT && typ(ap) != t_INTMOD))
    7850           0 :         pari_err_TYPE("mfeigensearch", AP);
    7851          49 :       gel(vap,i) = ap;
    7852          49 :       vlp[i] = itos(gp)+1; if (vlp[i] < 0) pari_err_TYPE("mfeigensearch", AP);
    7853             :     }
    7854             :   }
    7855          28 :   l = lg(NK);
    7856          28 :   if (typ(NK) != t_VEC || l != 3
    7857          28 :       || typ(gel(NK,1)) != t_INT
    7858          28 :       || typ(gel(NK,2)) != t_INT) pari_err_TYPE("mfeigensearch",NK);
    7859          28 :   N0 = itos(gel(NK,1));
    7860          28 :   k = gel(NK,2);
    7861          28 :   vecsmall_sort(vlp);
    7862          28 :   even = !mpodd(k);
    7863         966 :   for (N = 1; N <= N0; N++)
    7864             :   {
    7865         938 :     pari_sp av2 = avma;
    7866             :     GEN mf, L;
    7867         938 :     if (even) D = gen_1;
    7868             :     else
    7869             :     {
    7870         112 :       long r = (N&3L);
    7871         112 :       if (r == 1 || r == 2) continue;
    7872          56 :       D = stoi( corediscs(-N, NULL) ); /* < 0 */
    7873             :     }
    7874         882 :     mf = mfinit_i(mkvec3(utoipos(N), k, D), mf_NEW);
    7875         882 :     L = search_from_split(mf, vap, vlp);
    7876         882 :     if (L) vres = shallowconcat(vres, L); else avma = av2;
    7877             :   }
    7878          28 :   return gerepilecopy(av, vres);
    7879             : }
    7880             : 
    7881             : /* tf_{N,k}(n) */
    7882             : static GEN
    7883     2151296 : mfnewtracecache(long N, long k, long n, cachenew_t *cache)
    7884             : {
    7885     2151296 :   GEN C = NULL, S;
    7886             :   long lcache;
    7887     2151296 :   if (!n) return gen_0;
    7888     2076186 :   S = gel(cache->vnew,N);
    7889     2076186 :   lcache = lg(S);
    7890     2076186 :   if (n < lcache) C = gel(S, n);
    7891     2076186 :   if (C) cache->newHIT++;
    7892     1239868 :   else C = mfnewtrace_i(N,k,n,cache);
    7893     2076186 :   cache->newTOTAL++;
    7894     2076186 :   if (n < lcache) gel(S,n) = C;
    7895     2076186 :   return C;
    7896             : }
    7897             : 
    7898             : static long
    7899        1323 : mfdim_Nkchi(long N, long k, GEN CHI, long space)
    7900             : {
    7901        1323 :   if (k < 0 || badchar(N,k,CHI)) return 0;
    7902        1022 :   if (k == 0)
    7903          35 :     return mfcharistrivial(CHI) && !space_is_cusp(space)? 1: 0;
    7904         987 :   switch(space)
    7905             :   {
    7906         231 :     case mf_NEW: return mfnewdim(N,k,CHI);
    7907         182 :     case mf_CUSP:return mfcuspdim(N,k,CHI);
    7908         168 :     case mf_OLD: return mfolddim(N,k,CHI);
    7909         203 :     case mf_FULL:return mffulldim(N,k,CHI);
    7910         203 :     case mf_EISEN: return mfeisensteindim(N,k,CHI);
    7911           0 :     default: pari_err_FLAG("mfdim");
    7912             :   }
    7913             :   return 0;/*LCOV_EXCL_LINE*/
    7914             : }
    7915             : static long
    7916        2114 : mfwt1dimsum(long N, long space)
    7917             : {
    7918        2114 :   switch(space)
    7919             :   {
    7920        1050 :     case mf_NEW:  return mfwt1newdimsum(N);
    7921        1057 :     case mf_CUSP: return mfwt1cuspdimsum(N);
    7922           7 :     case mf_OLD:  return mfwt1olddimsum(N);
    7923             :   }
    7924           0 :   pari_err_FLAG("mfdim");
    7925             :   return 0; /*LCOV_EXCL_LINE*/
    7926             : }
    7927             : /* mfdim for k = nk/dk */
    7928             : static long
    7929       44702 : mfdim_Nndkchi(long N, long nk, long dk, GEN CHI, long space)
    7930       88144 : { return (dk == 2)? mf2dim_Nkchi(N, nk >> 1, CHI, space)
    7931       88165 :                   : mfdim_Nkchi(N, nk, CHI, space); }
    7932             : static long
    7933         245 : mfwtkdimsum(long N, long k, long dk, long space)
    7934             : {
    7935         245 :   GEN w = mfchars(N, k, dk, NULL);
    7936         245 :   long i, j, d = 0, l = lg(w);
    7937         245 :   for (i = j = 1; i < l; i++) d += mfdim_Nndkchi(N,k,dk,gel(w,i),space);
    7938         245 :   return d;
    7939             : }
    7940             : static GEN
    7941          98 : mfwt1dims(long N, GEN vCHI, long space)
    7942             : {
    7943          98 :   GEN D = NULL;
    7944          98 :   switch(space)
    7945             :   {
    7946          56 :     case mf_NEW: D = mfwt1newdimall(N, vCHI); break;
    7947          14 :     case mf_CUSP:D = mfwt1cuspdimall(N, vCHI); break;
    7948          28 :     case mf_OLD: D = mfwt1olddimall(N, vCHI); break;
    7949           0 :     default: pari_err_FLAG("mfdim");
    7950             :   }
    7951          98 :   return D;
    7952             : }
    7953             : static GEN
    7954        2947 : mfwtkdims(long N, long k, long dk, GEN vCHI, long space)
    7955             : {
    7956        2947 :   GEN D, w = mfchars(N, k, dk, vCHI);
    7957        2947 :   long i, j, l = lg(w);
    7958        2947 :   D = cgetg(l, t_VEC);
    7959       46550 :   for (i = j = 1; i < l; i++)
    7960             :   {
    7961       43603 :     GEN CHI = gel(w,i);
    7962       43603 :     long d = mfdim_Nndkchi(N,k,dk,CHI,space);
    7963       43603 :     if (vCHI)
    7964         560 :       gel(D, j++) = mkvec2s(d, 0);
    7965       43043 :     else if (d)
    7966        2506 :       gel(D, j++) = fmt_dim(CHI, d, 0);
    7967             :   }
    7968        2947 :   setlg(D,j); return D;
    7969             : }
    7970             : GEN
    7971        5691 : mfdim(GEN NK, long space)
    7972             : {
    7973        5691 :   pari_sp av = avma;
    7974             :   long N, k, dk, joker;
    7975             :   GEN CHI;
    7976        5691 :   if (checkMF_i(NK)) return utoi(MF_get_dim(NK));
    7977        5565 :   checkNK2(NK, &N, &k, &dk, &CHI, 2);
    7978        5565 :   if (!CHI) joker = 1;
    7979             :   else
    7980        2597 :     switch(typ(CHI))
    7981             :     {
    7982        2359 :       case t_INT: joker = 2; break;
    7983         112 :       case t_COL: joker = 3; break;
    7984         126 :       default: joker = 0; break;
    7985             :     }
    7986        5565 :   if (joker)
    7987             :   {
    7988             :     long d;
    7989             :     GEN D;
    7990             :     /* for now no jokers in 1/2 integral weight */
    7991        5439 :     if (k < 0) switch(joker)
    7992             :     {
    7993           0 :       case 1: return cgetg(1,t_VEC);
    7994           0 :       case 2: return gen_0;
    7995           0 :       case 3: return mfdim0all(CHI);
    7996             :     }
    7997        5439 :     if (k == 0)
    7998             :     {
    7999          28 :       if (space_is_cusp(space)) switch(joker)
    8000             :       {
    8001           7 :         case 1: return cgetg(1,t_VEC);
    8002           0 :         case 2: return gen_0;
    8003           7 :         case 3: return mfdim0all(CHI);
    8004             :       }
    8005          14 :       switch(joker)
    8006             :       {
    8007             :         long i, l;
    8008           7 :         case 1: retmkvec(fmt_dim(mfchartrivial(),0,0));
    8009           0 :         case 2: return gen_1;
    8010           7 :         case 3: l = lg(CHI); D = cgetg(l,t_VEC);
    8011          35 :                 for (i = 1; i < l; i++)
    8012             :                 {
    8013          28 :                   long t = mfcharistrivial(gel(CHI,i));
    8014          28 :                   gel(D,i) = mkvec2(t? gen_1: gen_0, gen_0);
    8015             :                 }
    8016           7 :                 return D;
    8017             :       }
    8018             :     }
    8019        5411 :     if (dk == 1 && k == 1 && space != mf_EISEN)
    8020             :     {
    8021        2219 :       if (!space_is_cusp(space))
    8022           7 :         pari_err_IMPL("noncuspidal dimension of G_1(N)");
    8023        2212 :       if (joker == 2) { d = mfwt1dimsum(N, space); avma = av; return utoi(d); }
    8024          98 :       D = mfwt1dims(N, CHI, space);
    8025             :     }
    8026             :     else
    8027             :     {
    8028        3192 :       if (joker==2) { d = mfwtkdimsum(N,k,dk,space); avma=av; return utoi(d); }
    8029        2947 :       D = mfwtkdims(N, k, dk, CHI, space);
    8030             :     }
    8031        3045 :     if (!CHI) return gerepileupto(av, vecsort(D, mkvecsmall(1)));
    8032          98 :     return gerepilecopy(av, D);
    8033             :   }
    8034         126 :   return utoi( mfdim_Nndkchi(N, k, dk, CHI, space) );
    8035             : }
    8036             : 
    8037             : GEN
    8038         231 : mfbasis(GEN mf, long space)
    8039             : {
    8040         231 :   pari_sp av = avma;
    8041             :   long N, k, dk;
    8042             :   GEN CHI;
    8043         231 :   if (checkMF_i(mf)) return concat(gel(mf, 2), gel(mf, 3));
    8044           7 :   checkNK2(mf, &N, &k, &dk, &CHI, 0);
    8045           7 :   if (dk == 2) return gerepilecopy(av, mf2basis(N, k>>1, CHI, space));
    8046           7 :   mf = mfinit_Nkchi(N, k, CHI, space, 1);
    8047           7 :   return gerepilecopy(av, MF_get_basis(mf));
    8048             : }
    8049             : 
    8050             : static GEN
    8051          28 : deg1ser_shallow(GEN a1, GEN a0, long v, long e)
    8052          28 : { return RgX_to_ser(deg1pol_shallow(a1, a0, v), e+2); }
    8053             : /* r / x + O(1) */
    8054             : static GEN
    8055          28 : simple_pole(GEN r)
    8056             : {
    8057          28 :   GEN S = deg1ser_shallow(gen_0, r, 0, 1);
    8058          28 :   setvalp(S, -1); return S;
    8059             : }
    8060             : 
    8061             : /* F form, E embedding; mfa = mfatkininit or root number (eigenform case) */
    8062             : static GEN
    8063         105 : mflfuncreate(GEN mfa, GEN F, GEN E, GEN N, GEN gk)
    8064             : {
    8065         105 :   GEN LF = cgetg(8,t_VEC), polar = cgetg(1,t_COL), eps;
    8066         105 :   long k = itou(gk);
    8067         105 :   gel(LF,1) = lfuntag(t_LFUN_MFCLOS, mkvec3(F,E,gen_1));
    8068         105 :   if (typ(mfa) != t_VEC)
    8069          70 :     eps = mfa; /* cuspidal eigenform: root number; no poles */
    8070             :   else
    8071             :   { /* mfatkininit */
    8072          35 :     GEN a0, b0, vF, vG, G = NULL, M = gel(mfa,2), mf = gel(mfa,4);
    8073          35 :     vF = mftobasis_i(mf, F);
    8074          35 :     vG = RgM_RgC_mul(M, vF);
    8075          35 :     if (gequal(vF,vG)) eps = gen_1;
    8076           7 :     else if (gequal(vF,gneg(vG))) eps = gen_m1;
    8077             :     else
    8078             :     { /* not self-dual */
    8079           7 :       eps = NULL;
    8080           7 :       G = mfatkin(mfa, F);
    8081           7 :       gel(LF,2) = lfuntag(t_LFUN_MFCLOS, mkvec3(G,E,ginv(gel(mfa,3))));
    8082           7 :       gel(LF,6) = powIs(k);
    8083             :     }
    8084             :     /* polar part */
    8085          35 :     a0 = mfcoef(F,0);
    8086          35 :     b0 = eps? gmul(eps,a0): mfcoef(G,0);
    8087          35 :     if (!gequal0(b0))
    8088             :     {
    8089          14 :       b0 = mulcxpowIs(gmul2n(b0,1), k);
    8090          14 :       polar = vec_append(polar, mkvec2(gk, simple_pole(b0)));
    8091             :     }
    8092          35 :     if (!gequal0(a0))
    8093             :     {
    8094          14 :       a0 = gneg(gmul2n(a0,1));
    8095          14 :       polar = vec_append(polar, mkvec2(gen_0, simple_pole(a0)));
    8096             :     }
    8097             :   }
    8098         105 :   if (eps) /* self-dual */
    8099             :   {
    8100          98 :     gel(LF,2) = mfcharorder(mf_get_CHI(F)) <= 2? gen_0: gen_1;
    8101          98 :     gel(LF,6) = mulcxpowIs(eps,k);
    8102             :   }
    8103         105 :   gel(LF,3) = mkvec2(gen_0, gen_1);
    8104         105 :   gel(LF,4) = gk;
    8105         105 :   gel(LF,5) = N;
    8106         105 :   if (lg(polar) == 1) setlg(LF,7); else gel(LF,7) = polar;
    8107         105 :   return LF;
    8108             : }
    8109             : static GEN
    8110          91 : mflfuncreateall(long sd, GEN mfa, GEN F, GEN vE, GEN gN, GEN gk)
    8111             : {
    8112          91 :   long i, l = lg(vE);
    8113          91 :   GEN L = cgetg(l, t_VEC);
    8114         196 :   for (i = 1; i < l; i++)
    8115         105 :     gel(L,i) = mflfuncreate(sd? gel(mfa,i): mfa, F, gel(vE,i), gN, gk);
    8116          91 :   return L;
    8117             : }
    8118             : static GEN
    8119          42 : lfunmf_i(GEN mf, GEN F, long bitprec)
    8120             : {
    8121          42 :   long i, l, N = MF_get_N(mf), prec = nbits2prec(bitprec);
    8122          42 :   GEN L, gk = MF_get_gk(mf), gN = utoipos(N);
    8123             : 
    8124          42 :   if (!F)
    8125             :   {
    8126           7 :     GEN M = mfeigenbasis(mf), vE = mfeigenembed(mf, prec);
    8127           7 :     GEN v = mffrickeeigen(mf, vE, prec);
    8128           7 :     l = lg(vE); L = cgetg(l, t_VEC);
    8129          63 :     for (i = 1; i < l; i++)
    8130          56 :       gel(L,i) = mflfuncreateall(1,gel(v,i), gel(M,i), gel(vE,i), gN, gk);
    8131             :   }
    8132             :   else
    8133             :   {
    8134          35 :     GEN mfa = mfatkininit_i(mf, N, 1, prec);
    8135          35 :     L = mflfuncreateall(0,mfa, F, mfgetembed(F,prec), gN, gk);
    8136          35 :     if (lg(L) == 2) L = gel(L,1);
    8137             :   }
    8138          42 :   return L;
    8139             : }
    8140             : GEN
    8141          42 : lfunmf(GEN mf, GEN F, long bitprec)
    8142             : {
    8143          42 :   pari_sp av = avma;
    8144          42 :   checkMF(mf);
    8145          42 :   if (F)
    8146             :   {
    8147          35 :     if (!checkmf_i(F)) pari_err_TYPE("lfunmf", F);
    8148          35 :     if (!mfisinspace_i(mf, F)) err_space(F);
    8149             :   }
    8150          42 :   return gerepilecopy(av, lfunmf_i(mf, F, bitprec));
    8151             : }
    8152             : 
    8153             : GEN
    8154          21 : mffromell(GEN E)
    8155             : {
    8156          21 :   pari_sp av = avma;
    8157             :   GEN mf, F, z, v, S;
    8158             :   long N, i, l;
    8159             : 
    8160          21 :   checkell(E);
    8161          21 :   if (ell_get_type(E) != t_ELL_Q) pari_err_TYPE("mfffromell [E not over Q]", E);
    8162          21 :   N = itos(gel(ellglobalred(E), 1));
    8163          21 :   mf = mfinit_i(mkvec2(utoi(N), gen_2), mf_NEW);
    8164          21 :   v = mfsplit(mf, 1, 0);
    8165          21 :   S = gel(v,1); l = lg(S); /* rational newforms */
    8166          21 :   F = tag(t_MF_ELL, mkNK(N,2,mfchartrivial()), E);
    8167          21 :   z = mftobasis_i(mf, F);
    8168          21 :   for(i = 1; i < l; i++)
    8169          21 :     if (gequal(z, gel(S,i))) break;
    8170          21 :   if (i == l) pari_err_BUG("mffromell [E is not modular]");
    8171          21 :   return gerepilecopy(av, mkvec3(mf, F, z));
    8172             : }
    8173             : 
    8174             : /* returns -1 if not, degree otherwise */
    8175             : long
    8176          42 : polishomogeneous(GEN P)
    8177             : {
    8178             :   long i, D, l;
    8179          42 :   if (typ(P) != t_POL) return 0;
    8180          21 :   D = -1; l = lg(P);
    8181         112 :   for (i = 2; i < l; i++)
    8182             :   {
    8183          91 :     GEN c = gel(P,i);
    8184             :     long d;
    8185          91 :     if (gequal0(c)) continue;
    8186          35 :     d = polishomogeneous(c);
    8187          35 :     if (d < 0) return -1;
    8188          35 :     if (D < 0) D = d + i-2; else if (D != d + i-2) return -1;
    8189             :   }
    8190          21 :   return D;
    8191             : }
    8192             : 
    8193             : /* 1 if spherical, 0 otherwise */
    8194             : static long
    8195           7 : polisspherical(GEN Qi, GEN P)
    8196             : {
    8197           7 :   pari_sp av = avma;
    8198             :   GEN va, S;
    8199             :   long lva, i, j, r;
    8200           7 :   if (gequal0(P) || degpol(P) <= 1) return 1;
    8201           7 :   va = variables_vecsmall(P); lva = lg(va);
    8202           7 :   if (lva > lg(Qi)) pari_err(e_MISC, "too many variables in mffromqf");
    8203           7 :   S = gen_0;
    8204          21 :   for (j = 1; j < lva; j++)
    8205             :   {
    8206          14 :     GEN col = gel(Qi, j), Pj = deriv(P, va[j]);
    8207          35 :     for (i = 1; i <= j; i++)
    8208             :     {
    8209          21 :       GEN coe = gel(col, i);
    8210          21 :       if (i != j) coe = gmul2n(coe, 1);
    8211          21 :       if (!gequal0(coe)) S = gadd(S, gmul(coe, deriv(Pj, va[i])));
    8212             :     }
    8213             :   }
    8214           7 :   r = gequal0(S); avma = av; return r;
    8215             : }
    8216             : 
    8217             : static GEN
    8218          21 : c_QFsimple_i(long n, GEN Q, GEN P)
    8219             : {
    8220          21 :   pari_sp av = avma;
    8221          21 :   GEN V, v = qfrep0(Q, utoi(n), 1);
    8222          21 :   long i, l = lg(v);
    8223          21 :   V = cgetg(l+1, t_VEC);
    8224          42 :   if (!P || equali1(P))
    8225             :   {
    8226          21 :     gel(V,1) = gen_1;
    8227          21 :     for (i = 2; i <= l; i++) gel(V,i) = utoi(v[i-1] << 1);
    8228             :   }
    8229             :   else
    8230             :   {
    8231           0 :     gel(V,1) = gcopy(P);
    8232           0 :     for (i = 2; i <= l; i++) gel(V,i) = gmulgs(P, v[i-1] << 1);
    8233             :   }
    8234          21 :   return gerepileupto(av, V);
    8235             : }
    8236             : static GEN
    8237          28 : c_QF_i(long n, GEN Q, GEN P)
    8238             : {
    8239          28 :   pari_sp av = avma;
    8240             :   GEN V, v, va;
    8241             :   long i, lva, lq, l;
    8242          28 :   if (!P || typ(P) != t_POL) return c_QFsimple_i(n, Q, P);
    8243           7 :   v = gel(minim(Q, utoi(2*n), NULL), 3);
    8244           7 :   va = variables_vec(P); lq = lg(Q) - 1; lva = lg(va) - 1;
    8245           7 :   V = zerovec(n + 1); l = lg(v);
    8246          35 :   for (i = 1; i < l; i++)
    8247             :   {
    8248          28 :     GEN X = gel(v,i);
    8249          28 :     long ind = (itos(qfeval0(Q, X, NULL)) >> 1) + 1;
    8250          28 :     if (lq > lva) X = vecslice(X, 1, lva);
    8251          28 :     gel(V, ind) = gadd(gel(V, ind), gsubstvec(P, va, X));
    8252             :   }
    8253           7 :   return gerepilecopy(av, gmul2n(V, 1));
    8254             : }
    8255             : 
    8256             : GEN
    8257          28 : mffromqf(GEN Q, GEN P)
    8258             : {
    8259          28 :   pari_sp av = avma;
    8260             :   GEN G, Qi, F, D, N, mf, v, gk, gwt, chi;
    8261             :   long m, d, space;
    8262          28 :   if (typ(Q) != t_MAT) pari_err_TYPE("mffromqf", Q);
    8263          28 :   if (!RgM_is_ZM(Q) || !qf_iseven(Q))
    8264           0 :     pari_err_TYPE("mffromqf [not integral or even]", Q);
    8265          28 :   m = lg(Q)-1;
    8266          28 :   gk = sstoQ(m, 2);
    8267          28 :   Qi = ZM_inv(Q, &N);
    8268          28 :   if (!qf_iseven(Qi)) N = shifti(N, 1);
    8269          28 :   if (!P || gequal1(P)) { d = 0; P = NULL; }
    8270             :   else
    8271             :   {
    8272           7 :     d = polishomogeneous(P);
    8273           7 :     if (d < 0) pari_err_TYPE("mffromqf [not homogeneous t_POL]", P);
    8274           7 :     if (!polisspherical(Qi, P))
    8275           0 :       pari_err_TYPE("mffromqf [not a spherical t_POL]", P);
    8276           7 :     if (d == 0) P = simplify_shallow(P);
    8277             :   }
    8278          28 :   D = ZM_det(Q);
    8279          28 :   if (typ(gk) == t_INT) { if (mpodd(gk)) D = negi(D); } else D = shifti(D, 1);
    8280          28 :   space = d > 0 ? mf_CUSP : mf_FULL;
    8281          28 :   G = znstar0(N,1);
    8282          28 :   chi = mkvec2(G, znchar_quad(G,D));
    8283          28 :   gwt = gaddgs(gk, d);
    8284          28 :   mf = mfinit(mkvec3(N, gwt, chi), space);
    8285          28 :   if (odd(d))
    8286             :   {
    8287           0 :     F = mftrivial();
    8288           0 :     v = zerocol(MF_get_dim(mf));
    8289             :   }
    8290             :   else
    8291             :   {
    8292          28 :     F = c_QF_i(mfsturm(mf), Q, P);
    8293          28 :     v = mftobasis_i(mf, F);
    8294          28 :     F = mflinear(mf, v);
    8295             :   }
    8296          28 :   return gerepilecopy(av, mkvec3(mf, F, v));
    8297             : }
    8298             : 
    8299             : /***********************************************************************/
    8300             : /*                          Eisenstein Series                          */
    8301             : /***********************************************************************/
    8302             : /* \sigma_{k-1}(\chi,n) */
    8303             : static GEN
    8304        9296 : sigchi(long k, GEN CHI, long n)
    8305             : {
    8306        9296 :   pari_sp av = avma;
    8307        9296 :   GEN S = gen_1, D = mydivisorsu(u_ppo(n,mfcharmodulus(CHI)));
    8308        9296 :   long i, l = lg(D), ord = mfcharorder(CHI), vt = varn(mfcharpol(CHI));
    8309       27839 :   for (i = 2; i < l; i++) /* skip D[1] = 1 */
    8310             :   {
    8311       18543 :     long d = D[i], a = mfcharevalord(CHI, d, ord);
    8312       18543 :     S = gadd(S, mygmodulo_lift(a, ord, powuu(d, k-1), vt));
    8313             :   }
    8314        9296 :   return gerepileupto(av,S);
    8315             : }
    8316             : 
    8317             : /* write n = n0*n1*n2, (n0,N1*N2) = 1, n1 | N1^oo, n2 | N2^oo;
    8318             :  * return NULL if (n,N1,N2) > 1, else return factoru(n0) */
    8319             : static GEN
    8320       96985 : sigchi2_dec(long n, long N1, long N2, long *pn1, long *pn2)
    8321             : {
    8322       96985 :   GEN P0, E0, P, E, fa = myfactoru(n);
    8323             :   long i, j, l;
    8324       96985 :   *pn1 = 1;
    8325       96985 :   *pn2 = 1;
    8326       96985 :   if (N1 == 1 && N2 == 1) return fa;
    8327       88158 :   P = gel(fa,1); l = lg(P);
    8328       88158 :   E = gel(fa,2);
    8329       88158 :   P0 = cgetg(l, t_VECSMALL);
    8330       88158 :   E0 = cgetg(l, t_VECSMALL);
    8331      200277 :   for (i = j = 1; i < l; i++)
    8332             :   {
    8333      116788 :     long p = P[i], e = E[i];
    8334      116788 :     if (N1 % p == 0)
    8335             :     {
    8336       11396 :       if (N2 % p == 0) return NULL;
    8337        6727 :       *pn1 *= upowuu(p,e);
    8338             :     }
    8339      105392 :     else if (N2 % p == 0)
    8340       17836 :       *pn2 *= upowuu(p,e);
    8341       87556 :     else { P0[j] = p; E0[j] = e; j++; }
    8342             :   }
    8343       83489 :   setlg(P0, j);
    8344       83489 :   setlg(E0, j); return mkvec2(P0,E0);
    8345             : }
    8346             : 
    8347             : /* sigma_{k-1}(\chi_1,\chi_2,n), ord multiple of lcm(ord(CHI1),ord(CHI2)) */
    8348             : static GEN
    8349       73416 : sigchi2(long k, GEN CHI1, GEN CHI2, long n, long ord)
    8350             : {
    8351       73416 :   pari_sp av = avma;
    8352       73416 :   GEN S = gen_0, D;
    8353       73416 :   long i, l, n1, n2, vt, N1 = mfcharmodulus(CHI1), N2 = mfcharmodulus(CHI2);
    8354       73416 :   D = sigchi2_dec(n, N1, N2, &n1, &n2); if (!D) { avma = av; return S; }
    8355       69517 :   D = divisorsu_fact(D); l = lg(D);
    8356       69517 :   vt = varn(mfcharpol(CHI1));
    8357      260344 :   for (i = 1; i < l; i++)
    8358             :   { /* S += d^(k-1)*chi1(d)*chi2(n/d) */
    8359      190827 :     long a, d = n2*D[i], nd = n1*D[l-i]; /* (d,N1)=1; (n/d,N2) = 1 */
    8360      190827 :     a = mfcharevalord(CHI1, d, ord) + mfcharevalord(CHI2, nd, ord);
    8361      190827 :     if (a >= ord) a -= ord;
    8362      190827 :     S = gadd(S, mygmodulo_lift(a, ord, powuu(d, k-1), vt));
    8363             :   }
    8364       69517 :   return gerepileupto(av, S);
    8365             : }
    8366             : 
    8367             : /**************************************************************************/
    8368             : /**           Dirichlet characters with precomputed values               **/
    8369             : /**************************************************************************/
    8370             : /* CHI mfchar */
    8371             : static GEN
    8372       21413 : mfcharcxinit(GEN CHI, long prec)
    8373             : {
    8374       21413 :   GEN G = gel(CHI,1), chi = gel(CHI,2), z, V;
    8375       21413 :   GEN v = ncharvecexpo(G, znconrey_normalized(G,chi));
    8376       21413 :   long n, l = lg(v), o = mfcharorder(CHI);
    8377       21413 :   V = cgetg(l, t_VEC);
    8378       21413 :   z = grootsof1(o, prec); /* Mod(t, Phi_o(t)) -> e(1/o) */
    8379       21413 :   for (n = 1; n < l; n++) gel(V,n) = v[n] < 0? gen_0: gel(z, v[n]+1);
    8380       21413 :   return mkvecn(6, G, chi, gel(CHI,3), v, V, gel(CHI,5));
    8381             : }
    8382             : /* v a "CHIvec" */
    8383             : static long
    8384    22359995 : CHIvec_N(GEN v) { return itou(znstar_get_N(gel(v,1))); }
    8385             : static GEN
    8386       14140 : CHIvec_CHI(GEN v)
    8387       14140 : { return mkvec4(gel(v,1), gel(v,2), gel(v,3), gel(v,5)); }
    8388             : /* character order */
    8389             : static long
    8390       37331 : CHIvec_ord(GEN v) { return itou(gel(v,3)); }
    8391             : /* character exponents, i.e. t such that chi(n) = e(t) */
    8392             : static GEN
    8393      231350 : CHIvec_expo(GEN v) { return gel(v,4); }
    8394             : /* character values chi(n) */
    8395             : static GEN
    8396    22025444 : CHIvec_val(GEN v) { return gel(v,5); }
    8397             : /* CHI(n) */
    8398             : static GEN
    8399    21999705 : mychareval(GEN v, long n)
    8400             : {
    8401    21999705 :   long N = CHIvec_N(v), ind = n%N;
    8402    21999705 :   if (ind <= 0) ind += N;
    8403    21999705 :   return gel(CHIvec_val(v), ind);
    8404             : }
    8405             : /* return c such that CHI(n) = e(c / ordz) or -1 if (n,N) > 1 */
    8406             : static long
    8407      231350 : mycharexpo(GEN v, long n)
    8408             : {
    8409      231350 :   long N = CHIvec_N(v), ind = n%N;
    8410      231350 :   if (ind <= 0) ind += N;
    8411      231350 :   return CHIvec_expo(v)[ind];
    8412             : }
    8413             : /* faster than mfcharparity */
    8414             : static long
    8415       24829 : CHIvec_parity(GEN v) { return mycharexpo(v,-1) ? -1: 1; }
    8416             : /**************************************************************************/
    8417             : 
    8418             : static ulong
    8419       23569 : sigchi2_Fl(long k, GEN CHI1vec, GEN CHI2vec, long n, GEN vz, ulong p)
    8420             : {
    8421       23569 :   pari_sp av = avma;
    8422       23569 :   long ordz = lg(vz)-2, i, l, n1, n2;
    8423       23569 :   ulong S = 0;
    8424       23569 :   GEN D = sigchi2_dec(n, CHIvec_N(CHI1vec), CHIvec_N(CHI2vec), &n1, &n2);
    8425       23569 :   if (!D) { avma = av; return S; }
    8426       22799 :   D = divisorsu_fact(D);
    8427       22799 :   l = lg(D);
    8428       82726 :   for (i = 1; i < l; i++)
    8429             :   { /* S += d^(k-1)*chi1(d)*chi2(n/d) */
    8430       59927 :     long a, d = n2*D[i], nd = n1*D[l-i]; /* (d,N1)=1, (n/d,N2)=1 */
    8431       59927 :     a = mycharexpo(CHI2vec, nd) + mycharexpo(CHI1vec, d);
    8432       59927 :     if (a >= ordz) a -= ordz;
    8433       59927 :     S = Fl_add(S, mygmodulo_Fl(a, vz, Fl_powu(d,k-1,p), p), p);
    8434             :   }
    8435       22799 :   avma = av; return S;
    8436             : }
    8437             : 
    8438             : /**********************************************************************/
    8439             : /* Fourier expansions of Eisenstein series                            */
    8440             : /**********************************************************************/
    8441             : /* L(CHI,0) / 2, order(CHI) | ord != 0 */
    8442             : static GEN
    8443         756 : charLFwt1(GEN CHI, long ord)
    8444             : {
    8445             :   GEN S;
    8446         756 :   long r, vt, m = mfcharmodulus(CHI);
    8447             : 
    8448         756 :   if (m == 1) return mkfrac(gen_m1,stoi(4));
    8449         756 :   S = gen_0; vt = varn(mfcharpol(CHI));
    8450       29064 :   for (r = 1; r < m; r++)
    8451             :   { /* S += r*chi(r) */
    8452             :     long a;
    8453       28308 :     if (ugcd(m,r) != 1) continue;
    8454       23464 :     a = mfcharevalord(CHI,r,ord);
    8455       23464 :     S = gadd(S, mygmodulo_lift(a, ord, utoi(r), vt));
    8456             :   }
    8457         756 :   return gdivgs(S, -2*m);
    8458             : }
    8459             : /* L(CHI,0) / 2, mod p */
    8460             : static ulong
    8461         770 : charLFwt1_Fl(GEN CHIvec, GEN vz, ulong p)
    8462             : {
    8463         770 :   long r, m = CHIvec_N(CHIvec);
    8464             :   ulong S;
    8465         770 :   if (m == 1) return Rg_to_Fl(mkfrac(gen_m1,stoi(4)), p);
    8466         770 :   S = 0;
    8467       49756 :   for (r = 1; r < m; r++)
    8468             :   { /* S += r*chi(r) */
    8469       48986 :     long a = mycharexpo(CHIvec,r);
    8470       48986 :     if (a < 0) continue;
    8471       48706 :     S = Fl_add(S, mygmodulo_Fl(a, vz, r, p), p);
    8472             :   }
    8473         770 :   return Fl_div(Fl_neg(S,p), 2*m, p);
    8474             : }
    8475             : /* L(CHI,1-k) / 2, order(CHI) | ord != 0 */
    8476             : static GEN
    8477        1015 : charLFwtk(long k, GEN CHI, long ord)
    8478             : {
    8479             :   GEN S, P, dS;
    8480             :   long r, m, vt;
    8481             : 
    8482        1015 :   if (k == 1) return charLFwt1(CHI, ord);
    8483        1015 :   m = mfcharmodulus(CHI);
    8484        1015 :   if (m == 1) return gdivgs(bernfrac(k),-2*k);
    8485         567 :   S = gen_0; vt = varn(mfcharpol(CHI));
    8486         567 :   P = ZX_rescale(Q_remove_denom(bernpol(k,0), &dS), utoi(m));
    8487         567 :   dS = mul_denom(dS, stoi(-2*m*k));
    8488        7840 :   for (r = 1; r < m; r++)
    8489             :   { /* S += P(r)*chi(r) */
    8490             :     long a;
    8491        7273 :     if (ugcd(r,m) != 1) continue;
    8492        6118 :     a = mfcharevalord(CHI,r,ord);
    8493        6118 :     S = gadd(S, mygmodulo_lift(a, ord, poleval(P, utoi(r)), vt));
    8494             :   }
    8495         567 :   return gdiv(S, dS);
    8496             : }
    8497             : /* L(CHI,1-k) / 2, mod p */
    8498             : static ulong
    8499        1183 : charLFwtk_Fl(long k, GEN CHIvec, GEN vz, ulong p)
    8500             : {
    8501             :   GEN P;
    8502             :   long r, m;
    8503             :   ulong S;
    8504        1183 :   if (k == 1) return charLFwt1_Fl(CHIvec, vz, p);
    8505         413 :   m = CHIvec_N(CHIvec);
    8506         413 :   if (m == 1) return Rg_to_Fl(gdivgs(bernfrac(k),-2*k), p);
    8507         252 :   S = 0;
    8508         252 :   P = RgX_to_Flx(RgX_rescale(bernpol(k,0), utoi(m)), p);
    8509        5845 :   for (r = 1; r < m; r++)
    8510             :   { /* S += P(r)*chi(r) */
    8511        5593 :     long a = mycharexpo(CHIvec,r);
    8512        5593 :     if (a < 0) continue;
    8513        5026 :     S = Fl_add(S, mygmodulo_Fl(a, vz, Flx_eval(P,r,p), p), p);
    8514             :   }
    8515         252 :   return Fl_div(Fl_neg(S,p), 2*k*m, p);
    8516             : }
    8517             : 
    8518             : static GEN
    8519        2975 : mfeisenstein2_0(long k, GEN CHI1, GEN CHI2, long ord)
    8520             : {
    8521        2975 :   if (k == 1 && mfcharistrivial(CHI1))
    8522         756 :     return charLFwt1(CHI2, ord);
    8523        2219 :   else if (mfcharistrivial(CHI2))
    8524         903 :     return charLFwtk(k, CHI1, ord);
    8525        1316 :   else return gen_0;
    8526             : }
    8527             : static ulong
    8528        1701 : mfeisenstein2_0_Fl(long k, GEN CHI1vec, GEN CHI2vec, GEN vz, ulong p)
    8529             : {
    8530        1701 :   if (k == 1 && CHIvec_ord(CHI1vec) == 1)
    8531         770 :     return charLFwtk_Fl(k, CHI2vec, vz, p);
    8532         931 :   else if (CHIvec_ord(CHI2vec) == 1)
    8533         413 :     return charLFwtk_Fl(k, CHI1vec, vz, p);
    8534         518 :   else return 0;
    8535             : }
    8536             : static GEN
    8537          49 : NK_eisen2(long k, GEN CHI1, GEN CHI2)
    8538             : {
    8539          49 :   long N = mfcharmodulus(CHI1)*mfcharmodulus(CHI2);
    8540          49 :   return mkNK(N, k, mfcharmul(CHI1,CHI2));
    8541             : }
    8542             : static GEN
    8543         182 : mfeisenstein_i(long k, GEN CHI1, GEN CHI2)
    8544             : {
    8545         182 :   long s = 1, ord, vt;
    8546             :   GEN E0, NK, vchi, CHI, T;
    8547         182 :   if (CHI2) { CHI2 = get_mfchar(CHI2); if (mfcharparity(CHI2) < 0) s = -s; }
    8548         182 :   if (CHI1) { CHI1 = get_mfchar(CHI1); if (mfcharparity(CHI1) < 0) s = -s; }
    8549         168 :   if (s != m1pk(k)) return mftrivial();
    8550         154 :   if (!CHI1)
    8551          91 :     CHI = CHI2? CHI2: mfchartrivial();
    8552          63 :   else if (!CHI2)
    8553          14 :     CHI = CHI1;
    8554             :   else
    8555          49 :     CHI = NULL;
    8556         154 :   if (CHI)
    8557             :   { /* E_k(chi) */
    8558         105 :     vt = varn(mfcharpol(CHI));
    8559         105 :     ord = mfcharorder(CHI);
    8560         105 :     NK = mkNK(mfcharmodulus(CHI), k, CHI);
    8561         105 :     E0 = charLFwtk(k, CHI, ord);
    8562         105 :     vchi = mkvec3(E0, mkvec(mfcharpol(CHI)), CHI);
    8563         105 :     return tag(t_MF_EISEN, NK, vchi);
    8564             :   }
    8565             :   /* E_k(chi1,chi2) */
    8566          49 :   vt = varn(mfcharpol(CHI1));
    8567          49 :   NK = NK_eisen2(k, CHI1, CHI2);
    8568          49 :   ord = clcm(mfcharorder(CHI1), mfcharorder(CHI2));
    8569          49 :   E0 = mfeisenstein2_0(k, CHI1, CHI2, ord);
    8570          49 :   T = mkvec(polcyclo(ord_canon(ord), vt));
    8571          49 :   vchi = mkvec4(E0, T, CHI1, CHI2);
    8572          49 :   return tag2(t_MF_EISEN, NK, vchi, mkvecsmall2(ord,0));
    8573             : }
    8574             : GEN
    8575         182 : mfeisenstein(long k, GEN CHI1, GEN CHI2)
    8576             : {
    8577         182 :   pari_sp av = avma;
    8578         182 :   if (k < 1) pari_err_DOMAIN("mfeisenstein", "k", "<", gen_1, stoi(k));
    8579         182 :   return gerepilecopy(av, mfeisenstein_i(k, CHI1, CHI2));
    8580             : }
    8581             : 
    8582             : static GEN
    8583         812 : mfeisenstein2all(long N0, GEN NK, long k, GEN CHI1, GEN CHI2, GEN T, long o)
    8584             : {
    8585         812 :   GEN E, E0 = mfeisenstein2_0(k, CHI1, CHI2, o), vchi = mkvec4(E0, T, CHI1, CHI2);
    8586         812 :   long j, d = (lg(T)==4)? itou(gmael(T,3,1)): 1;
    8587         812 :   E = cgetg(d+1, t_VEC);
    8588         812 :   for (j=1; j<=d; j++) gel(E,j) = tag2(t_MF_EISEN, NK,vchi,mkvecsmall2(o,j-1));
    8589         812 :   return mfbdall(E, N0 / mf_get_N(gel(E,1)));
    8590             : }
    8591             : 
    8592             : static GEN
    8593         420 : zncharsG(GEN G)
    8594             : {
    8595         420 :   long i, l, N = itou(znstar_get_N(G));
    8596             :   GEN vCHI, V;
    8597         420 :   if (N == 1) return mkvec2(gen_1,cgetg(1,t_COL));
    8598         420 :   vCHI = const_vec(N,NULL);
    8599         420 :   V = cyc2elts(znstar_get_conreycyc(G));
    8600         420 :   l = lg(V);
    8601       14119 :   for (i = 1; i < l; i++)
    8602             :   {
    8603       13699 :     GEN chi0, chi = zc_to_ZC(gel(V,i)), n, F;
    8604       13699 :     F = znconreyconductor(G, chi, &chi0);
    8605       13699 :     if (typ(F) != t_INT) F = gel(F,1);
    8606       13699 :     n = znconreyexp(G, chi);
    8607       13699 :     gel(vCHI, itos(n)) = mkvec2(F, chi0);
    8608             :   }
    8609         420 :   return vCHI;
    8610             : }
    8611             : 
    8612             : /* CHI primitive, f(CHI) | N. Return pairs (CHI1,CHI2) both primitive
    8613             :  * such that f(CHI1)*f(CHI2) | N and CHI1 * CHI2 = CHI;
    8614             :  * if k = 1, CHI1 is even; if k = 2, omit (1,1) if CHI = 1 */
    8615             : static GEN
    8616         539 : mfeisensteinbasis_i(long N0, long k, GEN CHI)
    8617             : {
    8618         539 :   GEN G = gel(CHI,1), chi = gel(CHI,2), vT = const_vec(myeulerphiu(N0), NULL);
    8619             :   GEN CHI0, GN, chiN, Lchi, LG, V, RES, NK, T;
    8620         539 :   long i, j, l, n, n1, N, ord = mfcharorder(CHI), OC = ord_canon(ord);
    8621         539 :   long F = mfcharmodulus(CHI), vt = varn(mfcharpol(CHI));
    8622             : 
    8623         539 :   CHI0 = (F == 1)? CHI: mfchartrivial();
    8624         539 :   j = 1; RES = cgetg(N0+1, t_VEC);
    8625         539 :   T = gel(vT,OC) = Qab_trace_init(polcyclo(OC,vt), OC, OC);
    8626         539 :   if (F != 1 || k != 2)
    8627             :   { /* N1 = 1 */
    8628         455 :     NK = mkNK(F, k, CHI);
    8629         455 :     gel(RES, j++) = mfeisenstein2all(N0, NK, k, CHI0, CHI, T, ord);
    8630         455 :     if (F != 1 && k != 1)
    8631         126 :       gel(RES, j++) = mfeisenstein2all(N0, NK, k, CHI, CHI0, T, ord);
    8632             :   }
    8633         539 :   if (N0 == 1) { setlg(RES,j); return RES; }
    8634         476 :   GN = G; chiN = chi;
    8635         476 :   if (F == N0) N = N0;
    8636             :   else
    8637             :   {
    8638         287 :     GEN faN = myfactoru(N0), P = gel(faN,1), E = gel(faN,2);
    8639         287 :     long lP = lg(P);
    8640         735 :     for (i = N = 1; i < lP; i++)
    8641             :     {
    8642         448 :       long p = P[i];
    8643         448 :       N *= upowuu(p, maxuu(E[i]/2, z_lval(F,p)));
    8644             :     }
    8645         287 :     if (N == 1) { setlg(RES,j); return RES; }
    8646         231 :     if (F != N)
    8647             :     {
    8648         140 :       GN = znstar0(utoipos(N),1);
    8649         140 :       chiN = zncharinduce(G, chi, GN);
    8650             :     }
    8651             :   }
    8652         420 :   LG = const_vec(N, NULL); /* LG[d] = znstar(d,1) or NULL */
    8653         420 :   gel(LG,1) = gel(CHI0,1);
    8654         420 :   gel(LG,F) = G;
    8655         420 :   gel(LG,N) = GN;
    8656         420 :   Lchi = coprimes_zv(N);
    8657         420 :   n = itou(znconreyexp(GN,chiN));
    8658         420 :   V = zncharsG(GN); l = lg(V);
    8659       19089 :   for (n1 = 2; n1 < l; n1++) /* skip 1 (trivial char) */
    8660             :   {
    8661       18669 :     GEN v = gel(V,n1), w, chi1, chi2, G1, G2, CHI1, CHI2;
    8662             :     long N12, N1, N2, no, oc, o12, t, m;
    8663       18669 :     if (!Lchi[n1]) continue;
    8664       13279 :     chi1 = gel(v,2); N1 = itou(gel(v,1)); /* conductor of chi1 */
    8665       13279 :     w = gel(V, Fl_div(n,n1,N));
    8666       13279 :     chi2 = gel(w,2); N2 = itou(gel(w,1)); /* conductor of chi2 */
    8667       13279 :     N12 = N1 * N2;
    8668       13279 :     if (N2 == 1 || N0 % N12) continue;
    8669             : 
    8670         301 :     G1 = gel(LG,N1); if (!G1) gel(LG,N1) = G1 = znstar0(utoipos(N1), 1);
    8671         301 :     if (k == 1 && zncharisodd(G1,chi1)) continue;
    8672         231 :     G2 = gel(LG,N2); if (!G2) gel(LG,N2) = G2 = znstar0(utoipos(N2), 1);
    8673         231 :     CHI1 = mfcharGL(G1, chi1);
    8674         231 :     CHI2 = mfcharGL(G2, chi2);
    8675         231 :     o12 = clcm(mfcharorder(CHI1), mfcharorder(CHI2));
    8676             :     /* remove Galois orbit: same trace */
    8677         231 :     no = Fl_powu(n1, ord, N1);
    8678         322 :     for (t = 1+ord, m = n1; t <= o12; t += ord)
    8679             :     { /* m <-> CHI1^t, if t in Gal(Q(chi1,chi2)/Q), omit (CHI1^t,CHI2^t) */
    8680          91 :       m = Fl_mul(m, no, N1); if (!m) break;
    8681          91 :       if (ugcd(t, o12) == 1) Lchi[m] = 0;
    8682             :     }
    8683         231 :     oc = ord_canon(o12); T = gel(vT,oc);
    8684         231 :     if (!T) T = gel(vT,oc) = Qab_trace_init(polcyclo(oc,vt), oc, OC);
    8685         231 :     NK = mkNK(N12, k, CHI);
    8686         231 :     gel(RES, j++) = mfeisenstein2all(N0, NK, k, CHI1, CHI2, T, o12);
    8687             :   }
    8688         420 :   setlg(RES,j); return RES;
    8689             : }
    8690             : 
    8691             : static GEN
    8692         357 : mfbd_E2(GEN E2, long d, GEN CHI)
    8693             : {
    8694         357 :   GEN E2d = mfbd_i(E2, d);
    8695         357 :   GEN F = mkvec2(E2, E2d), L = mkvec2(gen_1, utoineg(d));
    8696             :   /* cannot use mflinear_i: E2 and E2d do not have the same level */
    8697         357 :   return tag3(t_MF_LINEAR, mkNK(d,2,CHI), F, L, gen_1);
    8698             : }
    8699             : /* C-basis of E_k(Gamma_0(N),chi). If k = 1, the first basis element must not
    8700             :  * vanish at oo [used in mfwt1basis]. Here E_1(CHI), whose q^0 coefficient
    8701             :  * does not vanish (since L(CHI,0) does not) *if* CHI is not trivial; which
    8702             :  * must be the case in weight 1.
    8703             :  *
    8704             :  * (k>=3): In weight k >= 3, basis is B(d) E(CHI1,(CHI/CHI1)_prim), where
    8705             :  * CHI1 is primitive modulo N1, and if N2 is the conductor of CHI/CHI1
    8706             :  * then d*N1*N2 | N.
    8707             :  * (k=2): In weight k=2, same if CHI is nontrivial. If CHI is trivial, must
    8708             :  * not take CHI1 trivial, and must add E_2(tau)-dE_2(d tau)), where
    8709             :  * d|N, d > 1.
    8710             :  * (k=1): In weight k=1, same as k >= 3 except that we restrict to CHI1 even */
    8711             : static GEN
    8712         560 : mfeisensteinbasis(long N, long k, GEN CHI)
    8713             : {
    8714             :   long i, F;
    8715             :   GEN L;
    8716         560 :   if (badchar(N, k, CHI)) return cgetg(1, t_VEC);
    8717         560 :   if (k == 0) return mfcharistrivial(CHI)? mkvec(mf1()): cgetg(1, t_VEC);
    8718         539 :   CHI = mfchartoprimitive(CHI, &F);
    8719         539 :   L = mfeisensteinbasis_i(N, k, CHI);
    8720         539 :   if (F == 1 && k == 2)
    8721             :   {
    8722          84 :     GEN v, E2 = mfeisenstein(2, NULL, NULL), D = mydivisorsu(N);
    8723          84 :     long nD = lg(D)-1;
    8724          84 :     v = cgetg(nD, t_VEC); L = vec_append(L,v);
    8725          84 :     for (i = 1; i < nD; i++) gel(v,i) = mfbd_E2(E2, D[i+1], CHI);
    8726             :   }
    8727         539 :   return lg(L) == 1? L: shallowconcat1(L);
    8728             : }
    8729             : 
    8730             : /* when flag set, do not return error message */
    8731             : GEN
    8732         497 : mftobasis(GEN mf, GEN F, long flag)
    8733             : {
    8734         497 :   pari_sp av2, av = avma;
    8735             :   GEN G, v, y;
    8736             :   long B;
    8737             : 
    8738         497 :   checkMF(mf);
    8739         497 :   if (checkmf_i(F) && !mfisinspace_i(mf, F))
    8740             :   {
    8741          63 :     if (flag) return cgetg(1, t_COL);
    8742           0 :     err_space(F);
    8743             :   }
    8744             :   /* at least the parameters are right */
    8745         434 :   B = mfsturmNgk(MF_get_N(mf), MF_get_gk(mf)) + 1;
    8746         434 :   if (checkmf_i(F)) v = mfcoefs_i(F,B,1);
    8747             :   else
    8748             :   {
    8749          63 :     switch(typ(F))
    8750             :     { /* F(0),...,F(lg(v)-2) */
    8751          56 :       case t_SER: v = sertocol(F); settyp(v,t_VEC); break;
    8752           7 :       case t_VEC: v = F; break;
    8753           0 :       case t_COL: v = shallowtrans(F); break;
    8754           0 :       default: pari_err_TYPE("mftobasis",F);
    8755             :                v = NULL;/*LCOV_EXCL_LINE*/
    8756             :     }
    8757          63 :     if (flag) B = minss(B, lg(v)-2);
    8758             :   }
    8759         434 :   y = mftobasis_i(mf, v);
    8760         434 :   if (typ(y) == t_VEC)
    8761             :   {
    8762          21 :     if (flag) return gerepilecopy(av, y);
    8763           0 :     pari_err(e_MISC, "not enough coefficients in mftobasis");
    8764             :   }
    8765         413 :   av2 = avma;
    8766         413 :   if (MF_get_space(mf) == mf_FULL || mfsturm(mf)+1 == B) return y;
    8767         126 :   G = mflinear(mf, y);
    8768         126 :   if (!gequal(v, mfcoefs_i(G, lg(v)-2,1))) y = NULL;
    8769         126 :   avma = av2;
    8770         126 :   if (!y)
    8771             :   {
    8772           7 :     if (flag) { avma = av; return cgetg(1, t_COL); }
    8773           7 :     err_space(F);
    8774             :   }
    8775         119 :   return gerepileupto(av, y);
    8776             : }
    8777             : 
    8778             : /* List of cusps of Gamma_0(N) */
    8779             : GEN
    8780          14 : mfcusps(GEN gN)
    8781             : {
    8782          14 :   pari_sp av = avma;
    8783             :   GEN D, v;
    8784          14 :   long i, c, l, N = 0;
    8785             : 
    8786          14 :   if (typ(gN) == t_INT) N = itos(gN);
    8787           0 :   else if (checkMF_i(gN)) N = MF_get_N(gN);
    8788           0 :   else pari_err_TYPE("mfcusps", gN);
    8789          14 :   if (N <= 0) pari_err_DOMAIN("mfcusps", "N", "<=", gen_0, stoi(N));
    8790          14 :   if (N == 1) return mkvec(gen_0);
    8791          14 :   D = mydivisorsu(N); l = lg(D);
    8792          14 :   c = mfnumcuspsu_fact(myfactoru(N));
    8793          14 :   v = cgetg(c + 1, t_VEC);
    8794         140 :   for (i = c = 1; i < l; i++)
    8795             :   {
    8796         126 :     long C = D[i], NC = D[l-i], lima = ugcd(C, NC), A0, A;
    8797         378 :     for (A0 = 0; A0 < lima; A0++)
    8798         252 :       if (cgcd(A0, lima) == 1)
    8799             :       {
    8800         154 :         A = A0; while (ugcd(A,C) > 1) A += lima;
    8801         154 :         gel(v, c++) = sstoQ(A, C);
    8802             :       }
    8803             :   }
    8804          14 :   return gerepileupto(av, v);
    8805             : }
    8806             : 
    8807             : long
    8808         308 : mfcuspisregular(GEN NK, GEN cusp)
    8809             : {
    8810             :   long v, N, dk, nk, t, o;
    8811             :   GEN CHI, go, A, C, g, c, d;
    8812         308 :   if (checkMF_i(NK))
    8813             :   {
    8814          42 :     GEN gk = MF_get_gk(NK);
    8815          42 :     N = MF_get_N(NK);
    8816          42 :     CHI = MF_get_CHI(NK);
    8817          42 :     Qtoss(gk, &nk, &dk);
    8818             :   }
    8819             :   else
    8820         266 :     checkNK2(NK, &N, &nk, &dk, &CHI, 0);
    8821         308 :   if (typ(cusp) == t_INFINITY) return 1;
    8822         308 :   if (typ(cusp) == t_FRAC) { A = gel(cusp,1); C = gel(cusp,2); }
    8823          28 :   else { A = cusp; C = gen_1; }
    8824         308 :   g = diviuexact(mului(N,C), ugcd(N, Fl_sqr(umodiu(C,N), N)));
    8825         308 :   c = mulii(negi(C),g);
    8826         308 :   d = addiu(mulii(A,g), 1);
    8827         308 :   if (!CHI)
    8828             :   {
    8829           0 :     go = gen_1;
    8830           0 :     t = 0;
    8831             :   }
    8832             :   else
    8833             :   {
    8834         308 :     go = gmfcharorder(CHI);
    8835         308 :     v = vali(go); if (v < 2) go = shifti(go, 2-v);
    8836         308 :     t = itou( znchareval(gel(CHI,1), gel(CHI,2), d, go) );
    8837             :   }
    8838         308 :   if (dk == 1) return t == 0;
    8839         154 :   o = itou(go);
    8840         154 :   if (kronecker(c,d) < 0) t = Fl_add(t, o/2, o);
    8841         154 :   if (Mod4(d) == 1) return t == 0;
    8842          14 :   t = Fl_sub(t, Fl_mul(o/4, nk, o), o);
    8843          14 :   return t == 0;
    8844             : }
    8845             : 
    8846             : /* Some useful closures */
    8847             : 
    8848             : /* sum_{d|n} d^k */
    8849             : static GEN
    8850       14931 : mysumdivku(ulong n, ulong k)
    8851             : {
    8852       14931 :   GEN fa = myfactoru(n);
    8853       14931 :   return k == 1? usumdiv_fact(fa): usumdivk_fact(fa,k);
    8854             : }
    8855             : static GEN
    8856         567 : c_Ek(long n, long d, GEN F)
    8857             : {
    8858         567 :   GEN E = cgetg(n + 2, t_VEC), C = gel(F,2);
    8859         567 :   long i, k = mf_get_k(F);
    8860         567 :   gel (E, 1) = gen_1;
    8861        6881 :   for (i = 1; i <= n; i++)
    8862             :   {
    8863        6314 :     pari_sp av = avma;
    8864        6314 :     gel(E, i+1) = gerepileupto(av, gmul(C, mysumdivku(i*d, k-1)));
    8865             :   }
    8866         567 :   return E;
    8867             : }
    8868             : 
    8869             : GEN
    8870         161 : mfEk(long k)
    8871             : {
    8872         161 :   pari_sp av = avma;
    8873             :   GEN E0, NK;
    8874         161 :   if (k <= 0 || (k & 1L)) pari_err_TYPE("mfEk [incorrect k]", stoi(k));
    8875         161 :   E0 = gdivsg(-2*k, bernfrac(k));
    8876         161 :   NK = mkNK(1,k,mfchartrivial());
    8877         161 :   return gerepilecopy(av, tag(t_MF_Ek, NK, E0));
    8878             : }
    8879             : 
    8880             : GEN
    8881          49 : mfDelta(void)
    8882             : {
    8883          49 :   pari_sp av = avma;
    8884          49 :   return gerepilecopy(av, tag0(t_MF_DELTA, mkNK(1,12,mfchartrivial())));
    8885             : }
    8886             : 
    8887             : GEN
    8888         252 : mfTheta(GEN psi)
    8889             : {
    8890         252 :   pari_sp av = avma;
    8891             :   GEN N, gk, psi2;
    8892             :   long par;
    8893         252 :   if (!psi) { psi = mfchartrivial(); N = utoipos(4); par = 1; }
    8894             :   else
    8895             :   {
    8896             :     long FC;
    8897          14 :     psi = get_mfchar(psi);
    8898          14 :     FC = mfcharconductor(psi);
    8899          14 :     if (mfcharmodulus(psi) != FC)
    8900           0 :       pari_err_TYPE("mfTheta [nonprimitive character]", psi);
    8901          14 :     par = mfcharparity(psi);
    8902          14 :     N = shifti(sqru(FC),2);
    8903             :   }
    8904         252 :   if (par > 0) { gk = ghalf; psi2 = psi; }
    8905           7 :   else { gk = gsubsg(2, ghalf); psi2 = mfcharmul(psi, get_mfchar(stoi(-4))); }
    8906         252 :   return gerepilecopy(av, tag(t_MF_THETA, mkgNK(N, gk, psi2, pol_x(1)), psi));
    8907             : }
    8908             : 
    8909             : /* FIXME: unify with etaquotype */
    8910             : static GEN
    8911          63 : NK_eta(GEN M, GEN R)
    8912             : {
    8913          63 :   long N, k, i, lD, lM = lg(M);
    8914             :   GEN gN, S0, S1, P, D;
    8915          63 :   N = 1; for(i = 1; i < lM; i++) N = clcm(N, M[i]);
    8916          63 :   D = mydivisorsu(N); lD = lg(D);
    8917          63 :   S0 = gen_0; S1 = gen_0; P = gen_1; k = 0;
    8918         245 :   for (i = 1; i < lD; i++)
    8919             :   {
    8920         182 :     long m = D[i], r = 0, j;
    8921         651 :     for (j = 1; j < lM; j++)
    8922         469 :       if (m == M[j]) r += R[j];
    8923         182 :     S0 = gaddgs(S0, r*m);
    8924         182 :     S1 = gadd(S1, sstoQ(r, 24*m));
    8925         182 :     if (odd(r)) P = mulis(P, m);
    8926         182 :     k += r;
    8927             :   }
    8928          63 :   if (smodis(S0, 24)) return NULL;
    8929          49 :   gN = lcmii(stoi(N), Q_denom(S1));
    8930          49 :   D = (k & 3L) == 2 ? negi(P): P;
    8931          49 :   if ((k & 3L) == 1) D = gmul2n(D, 1);
    8932          49 :   return mkgNK(gN, sstoQ(k,2), get_mfchar(coredisc(D)), pol_x(1));
    8933             : }
    8934             : 
    8935             : GEN
    8936          63 : mffrometaquo(GEN eta, long flag)
    8937             : {
    8938          63 :   pari_sp av = avma;
    8939             :   GEN B, E, NK;
    8940             :   long s;
    8941          63 :   if (typ(eta) != t_MAT || !RgM_is_ZM(eta)) pari_err_TYPE("mffrometaquo", eta);
    8942          63 :   if (lg(eta) != 3 || lg(gel(eta,1)) == 1)
    8943           0 :     pari_err_TYPE("mffrometaquo [not a factorization]", eta);
    8944          63 :   B = gel(eta,1);
    8945          63 :   E = gel(eta,2); s = maxss(0, itos(ZV_dotproduct(B,E)) / 24);
    8946          63 :   B = ZV_to_zv(B);
    8947          63 :   E = ZV_to_zv(E); NK = NK_eta(B,E);
    8948          63 :   if (!NK)
    8949             :   {
    8950          14 :     if (flag) { avma = av; return gen_0; }
    8951           7 :     pari_err_DOMAIN("mffrometaquo", "eta quotient", "not",
    8952             :                     strtoGENstr("modular"), eta);
    8953             :   }
    8954          49 :   return gerepilecopy(av, tag2(t_MF_ETAQUO, NK, mkvec2(B,E), stoi(s)));
    8955             : }
    8956             : 
    8957             : #if 0
    8958             : /* number of primitive characters modulo N */
    8959             : static ulong
    8960             : numprimchars(ulong N)
    8961             : {
    8962             :   GEN fa, P, E;
    8963             :   long i, l;
    8964             :   ulong n;
    8965             :   if ((N & 3) == 2) return 0;
    8966             :   fa = myfactoru(N);
    8967             :   P = gel(fa,1); l = lg(P);
    8968             :   E = gel(fa,2);
    8969             :   for (i = n = 1; i < l; i++)
    8970             :   {
    8971             :     ulong p = P[i], e = E[i];
    8972             :     if (e == 2) n *= p-2; else n *= (p-1)*(p-1)*upowuu(p,e-2);
    8973             :   }
    8974             :   return n;
    8975             : }
    8976             : #endif
    8977             : 
    8978             : /* Space generated by products of two Eisenstein series */
    8979             : 
    8980             : INLINE int
    8981       42035 : cmp_small(long a, long b) { return a>b? 1: (a<b? -1: 0); }
    8982             : static int
    8983       12894 : cmp_small_priority(void *E, GEN a, GEN b)
    8984             : {
    8985       12894 :   GEN prio = (GEN)E;
    8986       12894 :   return cmp_small(prio[(long)a], prio[(long)b]);
    8987             : }
    8988             : static long
    8989         406 : znstar_get_expo(GEN G)
    8990             : {
    8991         406 :   GEN cyc = znstar_get_cyc(G);
    8992         406 :   return (lg(cyc) == 1)? 1: itou(gel(cyc,1));
    8993             : }
    8994             : 
    8995             : /* Return [vchi, bymod, vG]:
    8996             :  * vG[f] = znstar(f,1) for f a conductor of (at least) a char mod N; else NULL
    8997             :  * bymod[f] = vecsmall of conrey indexes of chars modulo f | N; else NULL
    8998             :  * vchi[n] = a list of CHIvec [G0,chi0,o,ncharvecexpo(G0,nchi0),...]:
    8999             :  *   chi0 = primitive char attached to Conrey Mod(n,N)
    9000             :  * (resp. NULL if (n,N) > 1) */
    9001             : static GEN
    9002         203 : charsmodN(long N)
    9003             : {
    9004         203 :   GEN D, G, prio, phio, dummy = cgetg(1,t_VEC);
    9005         203 :   GEN vP, vG = const_vec(N,NULL), vCHI  = const_vec(N,NULL);
    9006         203 :   GEN bymod = const_vec(N,NULL);
    9007         203 :   long pn, i, l, vt = fetch_user_var("t");
    9008         203 :   D = mydivisorsu(N); l = lg(D);
    9009        1036 :   for (i = 1; i < l; i++)
    9010         833 :     gel(bymod, D[i]) = vecsmalltrunc_init(myeulerphiu(D[i])+1);
    9011         203 :   gel(vG,N) = G = znstar0(utoipos(N),1);
    9012         203 :   pn = znstar_get_expo(G);  /* exponent(Z/NZ)^* */
    9013         203 :   vP = const_vec(pn,NULL);
    9014        5369 :   for (i = 1; i <= N; i++)
    9015             :   {
    9016             :     GEN P, gF, G0, chi0, nchi0, chi, v, go;
    9017             :     long j, F, o;
    9018        5166 :     if (ugcd(i,N) != 1) continue;
    9019        3535 :     chi = znconreylog(G, utoipos(i));
    9020        3535 :     gF = znconreyconductor(G, chi, &chi0);
    9021        3535 :     F = (typ(gF) == t_INT)? itou(gF): itou(gel(gF,1));
    9022        3535 :     G0 = gel(vG, F); if (!G0) G0 = gel(vG,F) = znstar0(gF, 1);
    9023        3535 :     nchi0 = znconreylog_normalize(G0,chi0);
    9024        3535 :     go = gel(nchi0,1); o = itou(go); /* order(chi0) */
    9025        3535 :     v = ncharvecexpo(G0, nchi0);
    9026        3535 :     if (!equaliu(go, pn)) v = zv_z_mul(v, pn / o);
    9027        3535 :     P = gel(vP, o); if (!P) P = gel(vP,o) = polcyclo(o,vt);
    9028             :     /* mfcharcxinit with dummy complex powers */
    9029        3535 :     gel(vCHI,i) = mkvecn(6, G0, chi0, go, v, P, dummy);
    9030        3535 :     D = mydivisorsu(N / F); l = lg(D);
    9031        3535 :     for (j = 1; j < l; j++) vecsmalltrunc_append(gel(bymod, F*D[j]), i);
    9032             :   }
    9033         203 :   phio = zero_zv(pn); l = lg(vCHI); prio = cgetg(l, t_VEC);
    9034        5369 :   for (i = 1; i < l; i++)
    9035             :   {
    9036        5166 :     GEN CHI = gel(vCHI,i);
    9037             :     long o;
    9038        5166 :     if (!CHI) continue;
    9039        3535 :     o = CHIvec_ord(CHI);
    9040        3535 :     if (!phio[o]) phio[o] = myeulerphiu(o);
    9041        3535 :     prio[i] = phio[o];
    9042             :   }
    9043         203 :   l = lg(bymod);
    9044             :   /* sort characters by increasing value of phi(order) */
    9045        5369 :   for (i = 1; i < l; i++)
    9046             :   {
    9047        5166 :     GEN z = gel(bymod,i);
    9048        5166 :     if (z) gen_sort_inplace(z, (void*)prio, &cmp_small_priority, NULL);
    9049             :   }
    9050         203 :   return mkvec3(vCHI, bymod, vG);
    9051             : }
    9052             : 
    9053             : static GEN
    9054        2114 : mfeisenstein2pure(long k, GEN CHI1, GEN CHI2, long ord, GEN P, long lim)
    9055             : {
    9056        2114 :   GEN c, V = cgetg(lim+2, t_COL);
    9057             :   long n;
    9058        2114 :   c = mfeisenstein2_0(k, CHI1, CHI2, ord);
    9059        2114 :   if (P) c = grem(c, P);
    9060        2114 :   gel(V,1) = c;
    9061       36848 :   for (n=1; n <= lim; n++)
    9062             :   {
    9063       34734 :     c = sigchi2(k, CHI1, CHI2, n, ord);
    9064       34734 :     if (P) c = grem(c, P);
    9065       34734 :     gel(V,n+1) = c;
    9066             :   }
    9067        2114 :   return V;
    9068             : }
    9069             : static GEN
    9070        1701 : mfeisenstein2pure_Fl(long k, GEN CHI1vec, GEN CHI2vec, GEN vz, ulong p, long lim)
    9071             : {
    9072        1701 :   GEN V = cgetg(lim+2, t_VECSMALL);
    9073             :   long n;
    9074        1701 :   V[1] = mfeisenstein2_0_Fl(k, CHI1vec, CHI2vec, vz, p);
    9075        1701 :   for (n=1; n <= lim; n++) V[n+1] = sigchi2_Fl(k, CHI1vec, CHI2vec, n, vz, p);
    9076        1701 :   return V;
    9077             : }
    9078             : 
    9079             : static GEN
    9080          98 : getcolswt2(GEN M, GEN D, ulong p)
    9081             : {
    9082          98 :   GEN R, v = gel(M,1);
    9083          98 :   long i, l = lg(M) - 1;
    9084          98 :   R = cgetg(l, t_MAT); /* skip D[1] = 1 */
    9085         259 :   for (i = 1; i < l; i++)
    9086             :   {
    9087         161 :     GEN w = Flv_Fl_mul(gel(M,i+1), D[i+1], p);
    9088         161 :     gel(R,i) = Flv_sub(v, w, p);
    9089             :   }
    9090          98 :   return R;
    9091             : }
    9092             : static GEN
    9093        2114 : expandbd(GEN V, long d)
    9094             : {
    9095             :   long L, n, nd;
    9096             :   GEN W;
    9097        2114 :   if (d == 1) return V;
    9098         770 :   L = lg(V)-1; W = zerocol(L); /* nd = n/d */
    9099         770 :   for (n = nd = 0; n < L; n += d, nd++) gel(W, n+1) = gel(V, nd+1);
    9100         770 :   return W;
    9101             : }
    9102             : static GEN
    9103        2562 : expandbd_Fl(GEN V, long d)
    9104             : {
    9105             :   long L, n, nd;
    9106             :   GEN W;
    9107        2562 :   if (d == 1) return V;
    9108         861 :   L = lg(V)-1; W = zero_Flv(L); /* nd = n/d */
    9109         861 :   for (n = nd = 0; n < L; n += d, nd++) W[n+1] = V[nd+1];
    9110         861 :   return W;
    9111             : }
    9112             : static void
    9113        1701 : getcols_i(GEN *pM, GEN *pvj, GEN gk, GEN CHI1vec, GEN CHI2vec, long NN1, GEN vz,
    9114             :           ulong p, long lim)
    9115             : {
    9116        1701 :   GEN CHI1 = CHIvec_CHI(CHI1vec), CHI2 = CHIvec_CHI(CHI2vec);
    9117        1701 :   long N2 = CHIvec_N(CHI2vec);
    9118        1701 :   GEN vj, M, D = mydivisorsu(NN1/N2);
    9119        1701 :   long i, l = lg(D), k = gk[2];
    9120        1701 :   GEN V = mfeisenstein2pure_Fl(k, CHI1vec, CHI2vec, vz, p, lim);
    9121        1701 :   M = cgetg(l, t_MAT);
    9122        1701 :   for (i = 1; i < l; i++) gel(M,i) = expandbd_Fl(V, D[i]);
    9123        1701 :   if (k == 2 && N2 == 1 && CHIvec_N(CHI1vec) == 1)
    9124             :   {
    9125          98 :     M = getcolswt2(M, D, p); l--;
    9126          98 :     D = vecslice(D, 2, l);
    9127             :   }
    9128        1701 :   *pM = M;
    9129        1701 :   *pvj = vj = cgetg(l, t_VEC);
    9130        1701 :   for (i = 1; i < l; i++) gel(vj,i) = mkvec4(gk, CHI1, CHI2, utoipos(D[i]));
    9131        1701 : }
    9132             : 
    9133             : /* find all CHI1, CHI2 mod N such that CHI1*CHI2 = CHI, f(CHI1)*f(CHI2) | N.
    9134             :  * set M = mfcoefs(B_e E(CHI1,CHI2), lim), vj = [e,i1,i2] */
    9135             : static void
    9136         721 : getcols(GEN *pM, GEN *pv, long k, long nCHI, GEN allN, GEN vz, ulong p,
    9137             :         long lim)
    9138             : {
    9139         721 :   GEN vCHI = gel(allN,1), gk = utoi(k);
    9140         721 :   GEN M = cgetg(1,t_MAT), v = cgetg(1,t_VEC);
    9141         721 :   long i1, N = lg(vCHI)-1;
    9142       35469 :   for (i1 = 1; i1 <= N; i1++)
    9143             :   {
    9144       34748 :     GEN CHI1vec = gel(vCHI, i1), CHI2vec, M1, v1;
    9145             :     long NN1, i2;
    9146       68313 :     if (!CHI1vec) continue;
    9147       31192 :     if (k == 1 && CHIvec_parity(CHI1vec) == -1) continue;
    9148       19782 :     NN1 = N/CHIvec_N(CHI1vec); /* N/f(chi1) */;
    9149       19782 :     i2 = Fl_div(nCHI,i1, N);
    9150       19782 :     if (!i2) i2 = 1;
    9151       19782 :     CHI2vec = gel(vCHI,i2);
    9152       19782 :     if (NN1 % CHIvec_N(CHI2vec)) continue; /* f(chi1)f(chi2) | N ? */
    9153        1183 :     getcols_i(&M1, &v1, gk, CHI1vec, CHI2vec, NN1, vz, p, lim);
    9154        1183 :     M = shallowconcat(M, M1);
    9155        1183 :     v = shallowconcat(v, v1);
    9156             :   }
    9157         721 :   *pM = M;
    9158         721 :   *pv = v;
    9159         721 : }
    9160             : 
    9161             : static void
    9162         448 : update_Mj(GEN *M, GEN *vecj, GEN *pz, ulong p)
    9163             : {
    9164             :   GEN perm;
    9165         448 :   *pz = Flm_indexrank(*M, p); perm = gel(*pz,2);
    9166         448 :   *M = vecpermute(*M, perm);
    9167         448 :   *vecj = vecpermute(*vecj, perm);
    9168         448 : }
    9169             : static int
    9170         168 : getcolsgen(long dim, GEN *pM, GEN *pvj, GEN *pz, long k, long ell, long nCHI,
    9171             :            GEN allN, GEN vz, ulong p, long lim)
    9172             : {
    9173         168 :   GEN vCHI = gel(allN,1), bymod = gel(allN,2), gell = utoi(ell);
    9174         168 :   long i1, N = lg(vCHI)-1;
    9175         168 :   long L = lim+1;
    9176         168 :   if (lg(*pvj)-1 >= dim) update_Mj(pM, pvj, pz, p);
    9177         168 :   if (lg(*pvj)-1 == dim) return 1;
    9178         721 :   for (i1 = 1; i1 <= N; i1++)
    9179             :   {
    9180         714 :     GEN CHI1vec = gel(vCHI, i1), T;
    9181             :     long par1, j, l, N1, NN1;
    9182             : 
    9183         714 :     if (!CHI1vec) continue;
    9184         707 :     par1 = CHIvec_parity(CHI1vec);
    9185         707 :     if (ell == 1 && par1 == -1) continue;
    9186         434 :     if (odd(ell)) par1 = -par1;
    9187         434 :     N1 = CHIvec_N(CHI1vec);
    9188         434 :     NN1 = N/N1;
    9189         434 :     T = gel(bymod, NN1); l = lg(T);
    9190        1575 :     for (j = 1; j < l; j++)
    9191             :     {
    9192        1302 :       long i2 = T[j], l1, l2, j1, s, nC;
    9193        1302 :       GEN M, M1, M2, vj, vj1, vj2, CHI2vec = gel(vCHI, i2);
    9194        2086 :       if (CHIvec_parity(CHI2vec) != par1) continue;
    9195         518 :       nC = Fl_div(nCHI, Fl_mul(i1,i2,N), N);
    9196         518 :       getcols(&M2, &vj2, k-ell, nC, allN, vz, p, lim);
    9197         518 :       l2 = lg(M2); if (l2 == 1) continue;
    9198         518 :       getcols_i(&M1, &vj1, gell, CHI1vec, CHI2vec, NN1, vz, p, lim);
    9199         518 :       l1 = lg(M1);
    9200         518 :       M1 = Flm_to_FlxV(M1, 0);
    9201         518 :       M2 = Flm_to_FlxV(M2, 0);
    9202         518 :       M  = cgetg((l1-1)*(l2-1) + 1, t_MAT);
    9203         518 :       vj = cgetg((l1-1)*(l2-1) + 1, t_VEC);
    9204        1218 :       for (j1 = s = 1; j1 < l1; j1++)
    9205             :       {
    9206         700 :         GEN E = gel(M1,j1), v = gel(vj1,j1);
    9207             :         long j2;
    9208        2744 :         for (j2 = 1; j2 < l2; j2++, s++)
    9209             :         {
    9210        2044 :           GEN c = Flx_to_Flv(Flxn_mul(E, gel(M2,j2), L, p), L);
    9211        2044 :           gel(M,s) = c;
    9212        2044 :           gel(vj,s) = mkvec2(v, gel(vj2,j2));
    9213             :         }
    9214             :       }
    9215         518 :       *pM = shallowconcat(*pM, M);
    9216         518 :       *pvj = shallowconcat(*pvj, vj);
    9217         518 :       if (lg(*pvj)-1 >= dim) update_Mj(pM, pvj, pz, p);
    9218         518 :       if (lg(*pvj)-1 == dim) return 1;
    9219             :     }
    9220             :   }
    9221           7 :   if (ell == 1)
    9222             :   {
    9223           7 :     update_Mj(pM, pvj, pz, p);
    9224           7 :     return (lg(*pvj)-1 == dim);
    9225             :   }
    9226           0 :   return 0;
    9227             : }
    9228             : 
    9229             : static GEN
    9230         784 : mkF2bd(long d, long lim)
    9231             : {
    9232         784 :   GEN V = zerovec(lim + 1);
    9233             :   long n;
    9234         784 :   gel(V, 1) = ginv(stoi(-24));
    9235         784 :   for (n = 1; n <= lim/d; n++) gel(V, n*d + 1) = mysumdivku(n, 1);
    9236         784 :   return V;
    9237             : }
    9238             : 
    9239             : static GEN
    9240        2233 : mkeisen(GEN E, long ord, GEN P, long lim)
    9241             : {
    9242        2233 :   long k = itou(gel(E,1)), e = itou(gel(E,4));
    9243        2233 :   GEN CHI1 = gel(E,2), CHI2 = gel(E,3);
    9244        2233 :   if (k == 2 && mfcharistrivial(CHI1) && mfcharistrivial(CHI2))
    9245         119 :     return gsub(mkF2bd(1,lim), gmulgs(mkF2bd(e,lim), e));
    9246             :   else
    9247             :   {
    9248        2114 :     GEN V = mfeisenstein2pure(k, CHI1, CHI2, ord, P, lim);
    9249        2114 :     return expandbd(V, e);
    9250             :   }
    9251             : }
    9252             : static GEN
    9253         189 : mkM(GEN vj, long pn, GEN P, long lim)
    9254             : {
    9255         189 :   long j, l = lg(vj), L = lim+1;
    9256         189 :   GEN M = cgetg(l, t_MAT);
    9257        1673 :   for (j = 1; j < l; j++)
    9258             :   {
    9259             :     GEN E1, E2;
    9260        1484 :     parse_vecj(gel(vj,j), &E1,&E2);
    9261        1484 :     E1 = RgV_to_RgX(mkeisen(E1, pn, P, lim), 0);
    9262        1484 :     if (E2)
    9263             :     {
    9264         749 :       E2 = RgV_to_RgX(mkeisen(E2, pn, P, lim), 0);
    9265         749 :       E1 = RgXn_mul(E1, E2, L);
    9266             :     }
    9267        1484 :     E1 = RgX_to_RgC(E1, L);
    9268        1484 :     if (P && E2) E1 = RgXQV_red(E1, P);
    9269        1484 :     gel(M,j) = E1;
    9270             :   }
    9271         189 :   return M;
    9272             : }
    9273             : 
    9274             : /* assume N > 2 */
    9275             : static GEN
    9276           7 : mffindeisen1(long N)
    9277             : {
    9278           7 :   GEN G = znstar0(utoipos(N), 1), L = chargalois(G, NULL), chi0 = NULL;
    9279           7 :   long j, m = N, l = lg(L);
    9280          56 :   for (j = 1; j < l; j++)
    9281             :   {
    9282          56 :     GEN chi = gel(L,j);
    9283          56 :     long r = myeulerphiu(itou(zncharorder(G,chi)));
    9284          56 :     if (r >= m) continue;
    9285          35 :     chi = znconreyfromchar(G, chi);
    9286          35 :     if (zncharisodd(G,chi)) { m = r; chi0 = chi; if (r == 1) break; }
    9287             :   }
    9288           7 :   if (!chi0) pari_err_BUG("mffindeisen1 [no Eisenstein series found]");
    9289           7 :   chi0 = znchartoprimitive(G,chi0);
    9290           7 :   return mfcharGL(gel(chi0,1), gel(chi0,2));
    9291             : }
    9292             : 
    9293             : static GEN
    9294         203 : mfeisensteinspaceinit_i(long N, long k, GEN CHI)
    9295             : {
    9296         203 :   GEN M, Minv, vj, vG, GN, allN, P, vz, z = NULL;
    9297         203 :   long nCHI, lim, ell, ord, pn, dim = mffulldim(N, k, CHI);
    9298             :   ulong r, p;
    9299             : 
    9300         203 :   if (!dim) retmkvec3(cgetg(1,t_VECSMALL),
    9301             :                       mkvec2(cgetg(1,t_MAT),gen_1),cgetg(1,t_VEC));
    9302         203 :   lim = mfsturmNk(N, k) + 1;
    9303         203 :   allN = charsmodN(N);
    9304         203 :   vG = gel(allN,3);
    9305         203 :   GN = gel(vG,N);
    9306         203 :   pn = znstar_get_expo(GN);
    9307         203 :   ord = ord_canon(pn);
    9308         203 :   P = ord == 1? NULL: polcyclo(ord, varn(mfcharpol(CHI)));
    9309         203 :   CHI = induce(GN, CHI); /* lift CHI mod N before mfcharno*/
    9310         203 :   nCHI = mfcharno(CHI);
    9311         203 :   r = QabM_init(ord, &p);
    9312         203 :   vz = Fl_powers(r, pn, p);
    9313         203 :   getcols(&M, &vj, k, nCHI, allN, vz, p, lim);
    9314         210 :   for (ell = k>>1; ell >= 1; ell--)
    9315         168 :     if (getcolsgen(dim, &M, &vj, &z, k, ell, nCHI, allN, vz, p, lim)) break;
    9316         203 :   if (!z) update_Mj(&M, &vj, &z, p);
    9317         203 :   if (lg(vj) - 1 < dim) return NULL;
    9318         189 :   M = mkM(vj, pn, P, lim);
    9319         189 :   Minv = QabM_Minv(rowpermute(M, gel(z,1)), P, ord);
    9320         189 :   return mkvec4(gel(z,1), Minv, vj, utoi(ord));
    9321             : }
    9322             : GEN
    9323         189 : mfeisensteinspaceinit(GEN NK)
    9324             : {
    9325         189 :   pari_sp av = avma;
    9326             :   GEN z, CHI;
    9327             :   long N, k;
    9328         189 :   if (checkMF_i(NK)) { N=MF_get_N(NK); k=MF_get_k(NK); CHI=MF_get_CHI(NK); }
    9329             :   else
    9330           0 :     checkNK(NK, &N, &k, &CHI, 0);
    9331         189 :   if (!CHI) CHI = mfchartrivial();
    9332         189 :   z = mfeisensteinspaceinit_i(N, k, CHI);
    9333         189 :   if (!z)
    9334             :   {
    9335           7 :     GEN E, CHIN = mffindeisen1(N), CHI0 = mfchartrivial();
    9336           7 :     z = mfeisensteinspaceinit_i(N, k+1, mfcharmul(CHI, CHIN));
    9337           7 :     if (z) E = mkvec4(gen_1, CHI0, CHIN, gen_1);
    9338             :     else
    9339             :     {
    9340           7 :       z = mfeisensteinspaceinit_i(N, k+2, CHI);
    9341           7 :       E = mkvec4(gen_2, CHI0, CHI0, utoipos(N));
    9342             :     }
    9343           7 :     z = mkvec2(z, E);
    9344             :   }
    9345         189 :   return gerepilecopy(av, z);
    9346             : }
    9347             : 
    9348             : /* decomposition of modular form on eisenspace */
    9349             : static GEN
    9350         413 : mfeisensteindec(GEN mf, GEN F)
    9351             : {
    9352         413 :   pari_sp av = avma;
    9353             :   GEN M, Mindex, Mvecj, V, B, CHI;
    9354             :   long o, ord;
    9355             : 
    9356         413 :   Mvecj = obj_checkbuild(mf, MF_EISENSPACE, &mfeisensteinspaceinit);
    9357         413 :   if (lg(Mvecj) < 5)
    9358             :   {
    9359           7 :     GEN E, e = gel(Mvecj,2), gkE = gel(e,1);
    9360           7 :     long dE = itou(gel(e,4));
    9361           7 :     Mvecj = gel(Mvecj,1);
    9362           7 :     E = mfeisenstein(itou(gkE), NULL, gel(e,3));
    9363           7 :     if (dE != 1) E = mfbd_E2(E, dE, gel(e,2)); /* here k = 2 */
    9364           7 :     F = mfmul(F, E);
    9365             :   }
    9366         413 :   M = gel(Mvecj, 2);
    9367         413 :   if (lg(M) == 1) return cgetg(1, t_VEC);
    9368         413 :   Mindex = gel(Mvecj, 1);
    9369         413 :   ord = itou(gel(Mvecj,4));
    9370         413 :   V = mfcoefs(F, Mindex[lg(Mindex)-1]-1, 1); settyp(V, t_COL);
    9371         413 :   CHI = mf_get_CHI(F);
    9372         413 :   o = mfcharorder_canon(CHI);
    9373         413 :   if (o > 1 && o != ord)
    9374             :   { /* convert Mod(.,polcyclo(o)) to Mod(., polcyclo(N)) for o | N,
    9375             :      * o and N both != 2 (mod 4) */
    9376          42 :     GEN z, P = mfcharpol(CHI);
    9377          42 :     long vt = varn(P);
    9378          42 :     if (ord % o) pari_err_TYPE("mfeisensteindec", V);
    9379          42 :     z = gmodulo(pol_xn(ord/o, vt), polcyclo(ord, vt));
    9380          42 :     V = gsubst(liftpol_shallow(V), vt, z);
    9381             :   }
    9382         413 :   B = Minv_RgC_mul(M, vecpermute(V, Mindex));
    9383         413 :   return gerepileupto(av, B);
    9384             : }
    9385             : 
    9386             : /*********************************************************************/
    9387             : /*                        END EISENSPACE                             */
    9388             : /*********************************************************************/
    9389             : 
    9390             : static GEN
    9391          35 : sertocol2(GEN S, long l)
    9392             : {
    9393          35 :   GEN C = cgetg(l + 2, t_COL);
    9394             :   long i;
    9395          35 :   for (i = 0; i <= l; i++) gel(C, i+1) = polcoeff_i(S, i, -1);
    9396          35 :   return C;
    9397             : }
    9398             : 
    9399             : /* Compute polynomial P0 such that F=E4^(k/4)P0(E6/E4^(3/2)). */
    9400             : static GEN
    9401           7 : mfcanfindp0(GEN F, long k)
    9402             : {
    9403           7 :   pari_sp ltop = avma;
    9404             :   GEN E4, E6, V, V1, Q, W, res, M, B;
    9405             :   long l, j;
    9406           7 :   l = k/6 + 2;
    9407           7 :   V = mfcoefsser(F,l);
    9408           7 :   E4 = mfcoefsser(mfEk(4),l);
    9409           7 :   E6 = mfcoefsser(mfEk(6),l);
    9410           7 :   V1 = gdiv(V, gpow(E4, sstoQ(k,4), 0));
    9411           7 :   Q = gdiv(E6, gpow(E4, sstoQ(3,2), 0));
    9412           7 :   W = gpowers(Q, l - 1);
    9413           7 :   M = cgetg(l + 1, t_MAT);
    9414           7 :   for (j = 1; j <= l; j++) gel(M,j) = sertocol2(gel(W,j), l);
    9415           7 :   B = sertocol2(V1, l);
    9416           7 :   res = inverseimage(M, B);
    9417           7 :   if (lg(res) == 1) err_space(F);
    9418           7 :   return gerepilecopy(ltop, gtopolyrev(res, 0));
    9419             : }
    9420             : 
    9421             : /* Compute the first n+1 Taylor coeffs at tau=I of a modular form
    9422             :  * on SL_2(Z). */
    9423             : GEN
    9424           7 : mftaylor(GEN F, long n, long flreal, long prec)
    9425             : {
    9426           7 :   pari_sp ltop = avma;
    9427           7 :   GEN P0, Pm1 = gen_0, v;
    9428           7 :   GEN X2 = mkpoln(3, ghalf,gen_0,gneg(ghalf)); /* (x^2-1) / 2 */
    9429             :   long k, m;
    9430           7 :   if (!checkmf_i(F)) pari_err_TYPE("mftaylor",F);
    9431           7 :   k = mf_get_k(F);
    9432           7 :   if (mf_get_N(F) != 1 || k < 0) pari_err_IMPL("mftaylor for this form");
    9433           7 :   P0 = mfcanfindp0(F, k);
    9434           7 :   v = cgetg(n+2, t_VEC); gel(v, 1) = RgX_coeff(P0,0);
    9435          77 :   for (m = 0; m < n; m++)
    9436             :   {
    9437          70 :     GEN P1 = gdivgs(gmulsg(-(k + 2*m), RgX_shift(P0,1)), 12);
    9438          70 :     P1 = gadd(P1, gmul(X2, RgX_deriv(P0)));
    9439          70 :     if (m) P1 = gsub(P1, gdivgs(gmulsg(m*(m+k-1), Pm1), 144));
    9440          70 :     Pm1 = P0; P0 = P1;
    9441          70 :     gel(v, m+2) = RgX_coeff(P0, 0);
    9442             :   }
    9443           7 :   if (flreal)
    9444             :   {
    9445           0 :     GEN pi2 = Pi2n(1, prec), pim4 = gmulsg(-2, pi2), VPC;
    9446           0 :     GEN C = gmulsg(3, gdiv(gpowgs(ggamma(ginv(utoi(4)), prec), 8), gpowgs(pi2, 6)));
    9447             :     /* E_4(i): */
    9448           0 :     GEN facn = gen_1;
    9449           0 :     VPC = gpowers(gmul(pim4, gsqrt(C, prec)), n);
    9450           0 :     C = gpow(C, sstoQ(k,4), prec);
    9451           0 :     for (m = 0; m <= n; m++)
    9452             :     {
    9453           0 :       gel(v, m+1) = gdiv(gmul(C, gmul(gel(v, m+1), gel(VPC, m+1))), facn);
    9454           0 :       facn = gmulgs(facn, m+1);
    9455             :     }
    9456             :   }
    9457           7 :   return gerepilecopy(ltop, v);
    9458             : }
    9459             : 
    9460             : #if 0
    9461             : /* To be used in mfeigensearch() */
    9462             : GEN
    9463             : mfreadratfile()
    9464             : {
    9465             :   GEN eqn;
    9466             :   pariFILE *F = pari_fopengz("rateigen300.gp");
    9467             :   eqn = gp_readvec_stream(F->file);
    9468             :   pari_fclose(F);
    9469             :   return eqn;
    9470             : }
    9471             : #endif
    9472             :  /*****************************************************************/
    9473             : /*           EISENSTEIN CUSPS: COMPLEX DIRECTLY: one F_k         */
    9474             : /*****************************************************************/
    9475             : 
    9476             : /* CHIvec = charinit(CHI); data = [N1g/g1,N2g/g2,g1/g,g2/g,C/g1,C/g2,
    9477             :  * (N1g/g1)^{-1},(N2g/g2)^{-1}] */
    9478             : 
    9479             : /* nm = n/m;
    9480             :  * z1 = powers of \z_{C/g}^{(Ae/g)^{-1}},
    9481             :  * z2 = powers of \z_N^{A^{-1}(g1g2/C)}]
    9482             :  * N.B. : we compute value and conjugate at the end, so it is (Ae/g)^{-1}
    9483             :  * and not -(Ae/g)^{-1} */
    9484             : static GEN
    9485    10076038 : eiscnm(long nm, long m, GEN CHI1vec, GEN CHI2vec, GEN data, GEN z1)
    9486             : {
    9487    10076038 :   long Cg1 = data[5], s10 = (nm*data[7]) % Cg1, r10 = (nm - data[1]*s10) / Cg1;
    9488    10076038 :   long Cg2 = data[6], s20 = (m *data[8]) % Cg2, r20 = (m  - data[2]*s20) / Cg2;
    9489             :   long j1, r1, s1;
    9490    10076038 :   GEN T = gen_0;
    9491    20634180 :   for (j1 = 0, r1 = r10, s1 = s10; j1 < data[3]; j1++, r1 -= data[1], s1 += Cg1)
    9492             :   {
    9493    10558142 :     GEN c1 = mychareval(CHI1vec, r1);
    9494    10558142 :     if (!gequal0(c1))
    9495             :     {
    9496             :       long j2, r2, s2;
    9497    10038630 :       GEN S = gen_0;
    9498    21474824 :       for (j2 = 0, r2 = r20, s2 = s20; j2 < data[4]; j2++, r2 -= data[2], s2 += Cg2)
    9499             :       {
    9500    11436194 :         GEN c2 = mychareval(CHI2vec, r2);
    9501    11436194 :         if (!gequal0(c2)) S = gadd(S, gmul(c2, rootsof1pow(z1, s1*s2)));
    9502             :       }
    9503    10038630 :       T = gadd(T, gmul(c1, S));
    9504             :     }
    9505             :   }
    9506    10076038 :   return gconj(T);
    9507             : }
    9508             : 
    9509             : static GEN
    9510      941101 : fg1g2n(long n, long k, GEN CHI1vec, GEN CHI2vec, GEN data, GEN z1, GEN z2)
    9511             : {
    9512      941101 :   GEN S = gen_0, D = mydivisorsu(n);
    9513      941101 :   long i, l = lg(D);
    9514     5979120 :   for (i = 1; i < l; i++)
    9515             :   {
    9516     5038019 :     long m = D[i], nm = D[l-i]; /* n/m */
    9517     5038019 :     GEN u = eiscnm( nm,  m, CHI1vec, CHI2vec, data, z1);
    9518     5038019 :     GEN v = eiscnm(-nm, -m, CHI1vec, CHI2vec, data, z1);
    9519     5038019 :     GEN w = odd(k) ? gsub(u, v) : gadd(u, v);
    9520     5038019 :     S = gadd(S, gmul(powuu(m, k-1), w));
    9521             :   }
    9522      941101 :   return gmul(S, rootsof1pow(z2, n));
    9523             : }
    9524             : 
    9525             : static GEN
    9526       21413 : gausssumcx(GEN CHIvec, long prec)
    9527             : {
    9528       21413 :   GEN z, S, V = CHIvec_val(CHIvec);
    9529       21413 :   long m, N = CHIvec_N(CHIvec);
    9530       21413 :   z = rootsof1u_cx(N, prec);
    9531       21413 :   S = gmul(z, gel(V, N));
    9532       21413 :   for (m = N-1; m >= 1; m--) S = gmul(z, gadd(gel(V, m), S));
    9533       21413 :   return S;
    9534             : }
    9535             : 
    9536             : /* Computation of Q_k(\z_N^s) as a polynomial in \z_N^s. FIXME: explicit
    9537             :  * formula ? */
    9538             : static GEN
    9539        4326 : mfqk(long k, long N)
    9540             : {
    9541        4326 :   GEN X = pol_x(0), P = gsubgs(gpowgs(X,N), 1), ZI, Q, Xm1, invden;
    9542             :   long i;
    9543        4326 :   ZI = cgetg(N, t_VEC);
    9544        4326 :   for (i = 1; i < N; i++) gel(ZI, i) = utoi(i);
    9545        4326 :   ZI = gdivgs(gmul(X, gtopolyrev(ZI, 0)), N);
    9546        4326 :   if (k == 1) return ZI;
    9547        3297 :   invden = RgXQ_powu(ZI, k, P);
    9548        3297 :   Q = gneg(X); Xm1 = gsubgs(X, 1);
    9549        8813 :   for (i = 2; i < k; i++)
    9550        5516 :     Q = gmul(X, ZX_add(gmul(Xm1, ZX_deriv(Q)), gmulsg(-i, Q)));
    9551        3297 :   return RgXQ_mul(Q, invden, P);
    9552             : }
    9553             : /* CHI mfchar */
    9554             : /* Warning: M is a multiple of the conductor of CHI, but is NOT
    9555             :    necessarily its modulus */
    9556             : 
    9557             : static GEN
    9558        5369 : mfskcx(long k, GEN CHI, long M, long prec)
    9559             : {
    9560             :   GEN S, CHIvec, P;
    9561             :   long F, m, i, l;
    9562        5369 :   CHI = mfchartoprimitive(CHI, &F);
    9563        5369 :   CHIvec = mfcharcxinit(CHI, prec);
    9564        5369 :   if (F == 1) S = gdivgs(bernfrac(k), k);
    9565             :   else
    9566             :   {
    9567        4326 :     GEN Q = mfqk(k, F), V = CHIvec_val(CHIvec);
    9568        4326 :     S = gmul(gel(V, F), RgX_coeff(Q, 0));
    9569        4326 :     for (m = 1; m < F; m++) S = gadd(S, gmul(gel(V, m), RgX_coeff(Q, m)));
    9570        4326 :     S = gconj(S);
    9571             :   }
    9572             :   /* prime divisors of M not dividing f(chi) */
    9573        5369 :   P = gel(myfactoru(u_ppo(M/F,F)), 1); l = lg(P);
    9574        5369 :   for (i = 1; i < l; i++)
    9575             :   {
    9576           0 :     long p = P[i];
    9577           0 :     S = gmul(S, gsubsg(1, gdiv(mychareval(CHIvec, p), powuu(p, k))));
    9578             :   }
    9579        5369 :   return gmul(gmul(gausssumcx(CHIvec, prec), S), powuu(M/F, k));
    9580             : }
    9581             : 
    9582             : static GEN
    9583        8645 : f00_i(long k, GEN CHI1vec, GEN CHI2vec, GEN G2, GEN S, long prec)
    9584             : {
    9585             :   GEN c, a;
    9586        8645 :   long N1 = CHIvec_N(CHI1vec), N2 = CHIvec_N(CHI2vec);
    9587        8645 :   if (S[2] != N1) return gen_0;
    9588        5369 :   c = mychareval(CHI1vec, S[3]);
    9589        5369 :   if (isintzero(c)) return gen_0;
    9590        5369 :   a = mfskcx(k, mfchardiv(CHIvec_CHI(CHI2vec), CHIvec_CHI(CHI1vec)), N1*N2, prec);
    9591        5369 :   a = gmul(a, gconj(gmul(c,G2)));
    9592        5369 :   return gdiv(a, mulsi(-N2, powuu(S[1], k-1)));
    9593             : }
    9594             : 
    9595             : static GEN
    9596        7560 : f00(long k, GEN CHI1vec,GEN CHI2vec, GEN G1,GEN G2, GEN data, long prec)
    9597             : {
    9598             :   GEN T1, T2;
    9599        7560 :   T2 = f00_i(k, CHI1vec, CHI2vec, G2, data, prec);
    9600        7560 :   if (k > 1) return T2;
    9601        1085 :   T1 = f00_i(k, CHI2vec, CHI1vec, G1, data, prec);
    9602        1085 :   return gadd(T1, T2);
    9603             : }
    9604             : 
    9605             : /* ga in SL_2(Z), find beta [a,b;c,d] in Gamma_0(N) and mu in Z such that
    9606             :  * beta * ga * T^u = [A',B';C',D'] with C' | N and N | B' */
    9607             : static void
    9608        8022 : mfgatogap(GEN ga, long N, long *pA, long *pC, long *pD, long *pd, long *pmu)
    9609             : {
    9610        8022 :   long A = itos(gcoeff(ga,1,1)), B = itos(gcoeff(ga,1,2));
    9611        8022 :   long C = itos(gcoeff(ga,2,1)), D = itos(gcoeff(ga,2,2));
    9612             :   long a, b, c, d, t, u, v, w, mu, ANsurCp, B1, Ap, D1, Cp, cN;
    9613        8022 :   Cp = cbezout(A*N, C, &c, &d);
    9614        8022 :   w = 0; ANsurCp = A*N/Cp;
    9615        8022 :   while (cgcd(d, N) > 1) { w++; d -= ANsurCp; }
    9616        8022 :   c += w*C/Cp; cN = c*N;
    9617        8022 :   D1 = cN*B + d*D;
    9618        8022 :   cbezout(d, -cN, &a, &b);
    9619        8022 :   t = 0; Ap = a*A + b*C;
    9620        8022 :   while (cgcd(Ap, N) > 1) { t++; Ap += Cp; }
    9621        8022 :   B1 = a*B + b*D + t*D1;
    9622        8022 :   cbezout(Ap, N, &u, &v);
    9623        8022 :   *pmu = mu = (-B1*u)%N;
    9624        8022 :   *pd = d; /* other coeffs of beta are useless */
    9625        8022 :   *pA = Ap; /* *pB = B1 + Ap*mu; useless */
    9626        8022 :   *pC = Cp; *pD = D1 + Cp*mu;
    9627        8022 : }
    9628             : 
    9629             : #if 0
    9630             : /* CHI is a mfchar, return alpha(CHI) */
    9631             : static long
    9632             : mfalchi(GEN CHI, long AN, long cg)
    9633             : {
    9634             :   GEN G = gel(CHI,1), chi = gel(CHI,2), go = gmfcharorder(CHI);
    9635             :   long o = itou(go), a = itos( znchareval(G, chi, stoi(1 + AN/cg), go) );
    9636             :   if (a < 0 || (cg * a) % o) pari_err_BUG("mfalchi");
    9637             :   return (cg * a) / o;
    9638             : }
    9639             : #endif
    9640             : /* return A such that CHI1(t) * CHI2(t) = e(A) or NULL if (t,N1*N2) > 1 */
    9641             : static GEN
    9642       16044 : mfcharmuleval(GEN CHI1vec, GEN CHI2vec, long t)
    9643             : {
    9644       16044 :   long a1 = mycharexpo(CHI1vec, t), o1 = CHIvec_ord(CHI1vec);
    9645       16044 :   long a2 = mycharexpo(CHI2vec, t), o2 = CHIvec_ord(CHI2vec);;
    9646       16044 :   if (a1 < 0 || a2 < 0) return NULL;
    9647       16044 :   return sstoQ(a1*o2 + a2*o1, o1*o2);
    9648             : }
    9649             : static GEN
    9650        8022 : mfcharmulcxeval(GEN CHI1vec, GEN CHI2vec, long t, long prec)
    9651             : {
    9652        8022 :   GEN A = mfcharmuleval(CHI1vec, CHI2vec, t);
    9653             :   long n, d;
    9654        8022 :   if (!A) return gen_0;
    9655        8022 :   Qtoss(A, &n,&d); return rootsof1q_cx(n, d, prec);
    9656             : }
    9657             : /* alpha(CHI1 * CHI2) */
    9658             : static long
    9659        8022 : mfalchi2(GEN CHI1vec, GEN CHI2vec, long AN, long cg)
    9660             : {
    9661        8022 :   GEN A = mfcharmuleval(CHI1vec, CHI2vec, 1 + AN/cg);
    9662             :   long a;
    9663        8022 :   if (!A) pari_err_BUG("mfalchi2");
    9664        8022 :   A = gmulsg(cg, A);
    9665        8022 :   if (typ(A) != t_INT) pari_err_BUG("mfalchi2");
    9666        8022 :   a = itos(A) % cg; if (a < 0) a += cg;
    9667        8022 :   return a;
    9668             : }
    9669             : 
    9670             : /* return g = (a,b), set u >= 0 s.t. g = a * u (mod b) */
    9671             : static long
    9672       32088 : mybezout(long a, long b, long *pu)
    9673             : {
    9674       32088 :   long junk, g = cbezout(a, b, pu, &junk);
    9675       32088 :   if (*pu < 0) *pu += b/g;
    9676       32088 :   return g;
    9677             : }
    9678             : 
    9679             : /* E = [k, CHI1,CHI2, e], CHI1 and CHI2 primitive mfchars such that,
    9680             :  * CHI1(-1)*CHI2(-1) = (-1)^k; expansion of (B_e (E_k(CHI1,CHI2))) | ga.
    9681             :  * w is the width for the space of the calling function. */
    9682             : static GEN
    9683        8022 : mfeisensteingacx(GEN E, long w, GEN ga, long lim, long prec)
    9684             : {
    9685        8022 :   GEN CHI1vec, CHI2vec, CHI1 = gel(E,2), CHI2 = gel(E,3), v, S, ALPHA;
    9686             :   GEN G1, G2, z1, z2, data;
    9687        8022 :   long k = itou(gel(E,1)), e = itou(gel(E,4));
    9688        8022 :   long N1 = mfcharmodulus(CHI1);
    9689        8022 :   long N2 = mfcharmodulus(CHI2), N = e * N1 * N2;
    9690             :   long NsurC, cg, wN, A, C, Ai, d, mu, alchi, na, da;
    9691             :   long eg, g, gH, U, u0, u1, u2, Aig, H, m, n, t, Cg, NC1, NC2;
    9692             : 
    9693        8022 :   mfgatogap(ga, N, &A, &C, &Ai, &d, &mu);
    9694        8022 :   CHI1vec = mfcharcxinit(CHI1, prec);
    9695        8022 :   CHI2vec = mfcharcxinit(CHI2, prec);
    9696        8022 :   NsurC = N/C; cg  = cgcd(C, NsurC); wN = NsurC / cg;
    9697        8022 :   if (w%wN) pari_err_BUG("mfeisensteingacx [wN does not divide w]");
    9698        8022 :   alchi = mfalchi2(CHI1vec, CHI2vec, A*N, cg);
    9699        8022 :   ALPHA = sstoQ(alchi, NsurC);
    9700             : 
    9701        8022 :   g = mybezout(A*e, C, &u0); Cg = C/g; eg = e/g;
    9702        8022 :   NC1 = mybezout(N1, Cg, &u1);
    9703        8022 :   NC2 = mybezout(N2, Cg, &u2);
    9704        8022 :   H = (NC1*NC2*g)/Cg;
    9705        8022 :   Aig = (Ai*H)%N; if (Aig < 0) Aig += N;
    9706        8022 :   z1 = rootsof1powinit(u0, Cg, prec);
    9707        8022 :   z2 = rootsof1powinit(Aig, N, prec);
    9708        8022 :   data = mkvecsmalln(8, N1/NC1, N2/NC2, NC1, NC2, Cg/NC1, Cg/NC2, u1, u2);
    9709        8022 :   v = zerovec(lim + 1);
    9710             :   /* need n*H = alchi (mod cg) */
    9711        8022 :   gH = mybezout(H, cg, &U);
    9712        8022 :   if (gH > 1)
    9713             :   {
    9714          56 :     if (alchi % gH) return mkvec2(gen_0, v);
    9715          56 :     alchi /= gH; cg /= gH; H /= gH;
    9716             :   }
    9717        8022 :   G1 = gausssumcx(CHI1vec, prec);
    9718        8022 :   G2 = gausssumcx(CHI2vec, prec);
    9719        8022 :   if (!alchi)
    9720        7560 :     gel(v,1) = f00(k, CHI1vec,CHI2vec,G1,G2, mkvecsmall3(NC2,Cg,A*eg), prec);
    9721        8022 :   n = Fl_mul(alchi,U,cg); if (!n) n = cg;
    9722        8022 :   m = (n*H - alchi) / cg; /* positive, exact division */
    9723      949123 :   for (; m <= lim; n+=cg, m+=H)
    9724      941101 :     gel(v, m+1) = fg1g2n(n, k, CHI1vec, CHI2vec, data, z1,z2);
    9725        8022 :   t = (2*e)/g; if (odd(k)) t = -t;
    9726        8022 :   v = gdiv(v, gmul(gconj(gmul(G1,G2)), mulsi(t, powuu(eg*N2/NC2, k-1))));
    9727        8022 :   if (k == 2 && N1 == 1 && N2 == 1) v = gsub(mkF2bd(wN,lim), gmulsg(e,v));
    9728             : 
    9729        8022 :   Qtoss(ALPHA, &na,&da);
    9730        8022 :   S = gconj( mfcharmulcxeval(CHI1vec,CHI2vec,d,prec) ); /* CHI(1/d) */
    9731        8022 :   if (wN > 1)
    9732             :   {
    9733        7056 :     GEN z = rootsof1powinit(-mu, wN, prec);
    9734        7056 :     long i, l = lg(v);
    9735        7056 :     for (i = 1; i < l; i++) gel(v,i) = gmul(gel(v,i), rootsof1pow(z,i-1));
    9736             :   }
    9737        8022 :   v = bdexpand(RgV_Rg_mul(v, gmul(S, rootsof1q_cx(-mu*na, da, prec))), w/wN);
    9738        8022 :   return mkvec2(ALPHA, v);
    9739             : }
    9740             : 
    9741             : /*****************************************************************/
    9742             : /*                       END EISENSTEIN CUSPS                    */
    9743             : /*****************************************************************/
    9744             : 
    9745             : static GEN
    9746        1491 : mfchisimpl(GEN CHI)
    9747             : {
    9748             :   GEN G, chi;
    9749        1491 :   if (typ(CHI) == t_INT) return CHI;
    9750        1491 :   G = gel(CHI, 1); chi = gel(CHI, 2);
    9751        1491 :   switch(mfcharorder(CHI))
    9752             :   {
    9753        1071 :     case 1: chi = gen_1; break;
    9754         399 :     case 2: chi = znchartokronecker(G,chi,1); break;
    9755          21 :     default:chi = mkintmod(znconreyexp(G,chi), znstar_get_N(G)); break;
    9756             :   }
    9757        1491 :   return chi;
    9758             : }
    9759             : 
    9760             : GEN
    9761         616 : mfparams(GEN F)
    9762             : {
    9763         616 :   pari_sp av = avma;
    9764             :   GEN z;
    9765         616 :   if (checkMF_i(F))
    9766             :   {
    9767          14 :     long N = MF_get_N(F);
    9768          14 :     GEN gk = MF_get_gk(F);
    9769          14 :     z = mkvec4(utoi(N), gk, MF_get_CHI(F), utoi(MF_get_space(F)));
    9770             :   }
    9771             :   else
    9772             :   {
    9773         602 :     if (!checkmf_i(F)) pari_err_TYPE("mfparams", F);
    9774         602 :     z = shallowcopy( mf_get_NK(F) );
    9775             :   }
    9776         616 :   gel(z,3) = mfchisimpl(gel(z,3));
    9777         616 :   return gerepilecopy(av, z);
    9778             : }
    9779             : 
    9780             : GEN
    9781          14 : mfisCM(GEN F)
    9782             : {
    9783          14 :   pari_sp av = avma;
    9784             :   forprime_t S;
    9785             :   GEN D, v;
    9786             :   long N, k, lD, sb, p, i;
    9787          14 :   if (!checkmf_i(F)) pari_err_TYPE("mfisCM", F);
    9788          14 :   N = mf_get_N(F);
    9789          14 :   k = mf_get_k(F); if (N < 0 || k < 0) pari_err_IMPL("mfisCM for this F");
    9790          14 :   D = mfunramneg(N);
    9791          14 :   lD = lg(D);
    9792          14 :   sb = maxss(mfsturmNk(N, k), 4*N);
    9793          14 :   v = mfcoefs_i(F, sb, 1);
    9794          14 :   u_forprime_init(&S, 2, sb);
    9795         518 :   while ((p = u_forprime_next(&S)))
    9796             :   {
    9797         490 :     GEN ap = gel(v, p+1);
    9798         490 :     if (!gequal0(ap))
    9799         399 :       for (i = 1; i < lD; i++)
    9800         238 :         if (kross(D[i], p) == -1) { D = vecsplice(D, i); lD--; }
    9801             :   }
    9802          14 :   if (lD == 1) { avma = av; return gen_0; }
    9803          14 :   if (lD == 2) { avma = av; return stoi(D[1]); }
    9804           7 :   if (k > 1) pari_err_BUG("mfisCM");
    9805           7 :   return gerepileupto(av, zv_to_ZV(D));
    9806             : }
    9807             : 
    9808             : static long
    9809         287 : mfspace_i(GEN mf, GEN F)
    9810             : {
    9811             :   GEN v, vF, gk;
    9812             :   long n, nE, i, l, s, N;
    9813             : 
    9814         287 :   checkMF(mf); s = MF_get_space(mf);
    9815         287 :   if (!F) return s;
    9816         287 :   if (!checkmf_i(F)) pari_err_TYPE("mfspace",F);
    9817         287 :   v = mftobasis(mf, F, 1);
    9818         287 :   n = lg(v)-1; if (!n) return -1;
    9819         231 :   nE = lg(MF_get_E(mf))-1;
    9820         231 :   switch(s)
    9821             :   {
    9822          63 :     case mf_NEW: case mf_OLD: case mf_EISEN: return s;
    9823             :     case mf_FULL:
    9824         140 :       if (mf_get_type(F) == t_MF_THETA) return mf_EISEN;
    9825         133 :       if (!gequal0(vecslice(v,1,nE)))
    9826          63 :         return gequal0(vecslice(v,nE+1,n))? mf_EISEN: mf_FULL;
    9827             :   }
    9828             :   /* mf_CUSP */
    9829          98 :   gk = mf_get_gk(F);
    9830          98 :   if (typ(gk) == t_FRAC || equali1(gk)) return mf_CUSP;
    9831          91 :   vF = mftonew_i(mf, vecslice(v, nE+1, n), &N);
    9832          91 :   if (N != MF_get_N(mf)) return mf_OLD;
    9833          63 :   l = lg(vF);
    9834         105 :   for (i = 1; i < l; i++)
    9835          63 :     if (itos(gmael(vF,i,1)) != N) return mf_CUSP;
    9836          42 :   return mf_NEW;
    9837             : }
    9838             : long
    9839         287 : mfspace(GEN mf, GEN F)
    9840             : {
    9841         287 :   pari_sp av = avma;
    9842         287 :   long s = mfspace_i(mf,F);
    9843         287 :   avma = av; return s;
    9844             : }
    9845             : static GEN
    9846           7 : lfunfindchi(GEN ldata, GEN van, long prec)
    9847             : {
    9848           7 :   GEN gN = ldata_get_conductor(ldata), G = znstar0(gN,1), L, go, vz;
    9849           7 :   long k = ldata_get_k(ldata), N = itou(gN), bit = 10 - prec2nbits(prec);
    9850           7 :   long i, j, o, l, odd = k & 1, B0 = 2, B = lg(van)-1;
    9851             : 
    9852           7 :   van = shallowcopy(van);
    9853           7 :   L = cyc2elts(znstar_get_conreycyc(G));
    9854           7 :   l = lg(L);
    9855          21 :   for (i = j = 1; i < l; i++)
    9856             :   {
    9857          14 :     GEN chi = zc_to_ZC(gel(L,i));
    9858          14 :     if (zncharisodd(G,chi) == odd) gel(L,j++) = mfcharGL(G,chi);
    9859             :   }
    9860           7 :   setlg(L,j); l = j;
    9861           7 :   if (l <= 2) return gel(L,1);
    9862           0 :   o = znstar_get_expo(G); go = utoi(o);
    9863           0 :   vz = grootsof1(o, prec);
    9864             :   for (;;)
    9865             :   {
    9866             :     long n;
    9867           0 :     for (n = B0; n <= B; n++)
    9868             :     {
    9869           0 :       GEN an = gel(van,n), r;
    9870           0 :       if (cgcd(n, N) != 1 || gexpo(an) < bit) continue;
    9871           0 :       r = gdiv(an, gconj(an));
    9872           0 :       for (i = 1; i < l; i++)
    9873             :       {
    9874           0 :         GEN CHI = gel(L,i);
    9875           0 :         if (gexpo(gsub(r, gel(vz, znchareval_i(CHI,n,go)+1))) > bit)
    9876             :         {
    9877           0 :           L = vecsplice(L,i);
    9878           0 :           if (--l == 2) return gel(L,1);
    9879             :         }
    9880             :       }
    9881             :     }
    9882           0 :     B0 = B+1; B <<= 1;
    9883           0 :     van = ldata_vecan(ldata_get_an(ldata), B, prec);
    9884           0 :   }
    9885             : }
    9886             : 
    9887             : GEN
    9888           7 : mffromlfun(GEN L, long prec)
    9889             : {
    9890           7 :   pari_sp av = avma;
    9891           7 :   GEN ldata = lfunmisc_to_ldata_shallow(L), Vga = ldata_get_gammavec(ldata);
    9892             :   GEN mf, V, van, a0, CHI;
    9893             :   long k, N, space;
    9894           7 :   if (!gequal(Vga, mkvec2(gen_0, gen_1))) pari_err_TYPE("mffromlfun", L);
    9895           7 :   k = ldata_get_k(ldata);
    9896           7 :   N = itou(ldata_get_conductor(ldata));
    9897           7 :   van = ldata_vecan(ldata_get_an(ldata), mfsturmNk(N,k) + 2, prec);
    9898           7 :   CHI = lfunfindchi(ldata, van, prec);
    9899           7 :   space = (lg(ldata) == 7)? mf_CUSP: mf_FULL;
    9900           7 :   mf = mfinit_Nkchi(N, k, CHI, space, 0);
    9901           7 :   if (!RgV_is_QV(van)) return gerepilecopy(av, mf);
    9902           7 :   a0 = (space == mf_CUSP)? gen_0: gneg(lfun(L, gen_0, prec2nbits(prec)));
    9903           7 :   setlg(van, MF_get_dim(mf));
    9904           7 :   V = mftobasis_i(mf, shallowconcat(a0, van));
    9905           7 :   if (typ(V) == t_VEC) pari_err_BUG("mffromlfun");
    9906           7 :   return gerepilecopy(av, mkvec3(mf, mflinear(mf,V), V));
    9907             : }
    9908             : /*******************************************************************/
    9909             : /*                                                                 */
    9910             : /*                       HALF-INTEGRAL WEIGHT                      */
    9911             : /*                                                                 */
    9912             : /*******************************************************************/
    9913             : /* We use the prefix mf2; k represents the weight -1/2, so e.g.
    9914             :    k = 2 is weight 5/2. N is the level, so 4\mid N, and CHI is the
    9915             :    character, always even. */
    9916             : 
    9917             : static long
    9918        3360 : lamCO(long r, long s, long p)
    9919             : {
    9920        3360 :   if ((s << 1) <= r)
    9921             :   {
    9922        1232 :     long rp = r >> 1;
    9923        1232 :     if (odd(r)) return upowuu(p, rp) << 1;
    9924         336 :     else return (p + 1)*upowuu(p, rp - 1);
    9925             :   }
    9926        2128 :   else return upowuu(p, r - s) << 1;
    9927             : }
    9928             : 
    9929             : static int
    9930        1568 : condC(GEN faN, GEN valF)
    9931             : {
    9932        1568 :   GEN P = gel(faN, 1), E = gel(faN, 2);
    9933        1568 :   long l = lg(P), i;
    9934        3696 :   for (i = 1; i < l; i++)
    9935        3024 :     if ((P[i] & 3L) == 3)
    9936             :     {
    9937        1120 :       long r = E[i];
    9938        1120 :       if (odd(r) || r < (valF[i] << 1)) return 1;
    9939             :     }
    9940         672 :   return 0;
    9941             : }
    9942             : 
    9943             : /* returns 2*zetaCO; weight is k + 1/2 */
    9944             : static long
    9945        3696 : zeta2CO(GEN faN, GEN valF, long r2, long s2, long k)
    9946             : {
    9947        3696 :   if (r2 >= 4) return lamCO(r2, s2, 2) << 1;
    9948        2912 :   if (r2 == 3) return 6;
    9949        1568 :   if (condC(faN, valF)) return 4;
    9950         672 :   if (odd(k)) return s2 ? 3 : 5; else return s2 ? 5: 3;
    9951             : }
    9952             : 
    9953             : /* returns 4 times last term in formula */
    9954             : static long
    9955        3696 : dim22(long N, long F, long k)
    9956             : {
    9957        3696 :   pari_sp av = avma;
    9958        3696 :   GEN vF, faN = myfactoru(N), P = gel(faN, 1), E = gel(faN, 2);
    9959        3696 :   long i, D, l = lg(P);
    9960        3696 :   vF = cgetg(l, t_VECSMALL);
    9961        3696 :   for (i = 1; i < l; i++) vF[i] = u_lval(F, P[i]);
    9962        3696 :   D = zeta2CO(faN, vF, E[1], vF[1], k);
    9963        3696 :   for (i = 2; i < l; i++) D *= lamCO(E[i], vF[i], P[i]);
    9964        3696 :   avma = av; return D;
    9965             : }
    9966             : 
    9967             : /* PSI not necessarily primitive, of conductor F */
    9968             : static int
    9969       13846 : charistotallyeven(GEN PSI, long F)
    9970             : {
    9971       13846 :   pari_sp av = avma;
    9972       13846 :   GEN P = gel(myfactoru(F), 1);
    9973       13846 :   GEN G = gel(PSI,1), psi = gel(PSI,2);
    9974             :   long i;
    9975       14350 :   for (i = 1; i < lg(P); i++)
    9976             :   {
    9977         532 :     GEN psip = znchardecompose(G, psi, utoipos(P[i]));
    9978         532 :     if (zncharisodd(G, psip)) { avma = av; return 0; }
    9979             :   }
    9980       13818 :   avma = av; return 1;
    9981             : }
    9982             : 
    9983             : static GEN
    9984      299775 : get_PSI(GEN CHI, long t)
    9985             : {
    9986      299775 :   long r = t & 3L, t2 = (r == 2 || r == 3) ? t << 2 : t;
    9987      299775 :   return mfcharmul_i(CHI, induce(gel(CHI,1), utoipos(t2)));
    9988             : }
    9989             : /* space = mf_CUSP, mf_EISEN or mf_FULL, weight k + 1/2 */
    9990             : static long
    9991       41363 : mf2dimwt12(long N, GEN CHI, long space)
    9992             : {
    9993       41363 :   pari_sp av = avma;
    9994       41363 :   GEN D = mydivisorsu(N >> 2);
    9995       41363 :   long i, l = lg(D), dim3 = 0, dim4 = 0;
    9996             : 
    9997       41363 :   CHI = induceN(N, CHI);
    9998      341138 :   for (i = 1; i < l; i++)
    9999             :   {
   10000      299775 :     long rp, t = D[i], Mt = D[l-i];
   10001      299775 :     GEN PSI = get_PSI(CHI,t);
   10002      299775 :     rp = mfcharconductor(PSI);
   10003      299775 :     if (Mt % (rp*rp) == 0) { dim4++; if (charistotallyeven(PSI,rp)) dim3++; }
   10004             :   }
   10005       41363 :   avma = av;
   10006       41363 :   switch (space)
   10007             :   {
   10008       40439 :     case mf_CUSP: return dim4 - dim3;
   10009         462 :     case mf_EISEN:return dim3;
   10010         462 :     case mf_FULL: return dim4;
   10011             :   }
   10012             :   return 0; /*LCOV_EXCL_LINE*/
   10013             : }
   10014             : 
   10015             : static long
   10016         693 : mf2dimwt32(long N, GEN CHI, long F, long space)
   10017             : {
   10018             :   long D;
   10019         693 :   switch(space)
   10020             :   {
   10021         231 :     case mf_CUSP: D = mypsiu(N) - 6*dim22(N, F, 1);
   10022         231 :       if (D%24) pari_err_BUG("mfdim");
   10023         231 :       return D/24 + mf2dimwt12(N, CHI, 4);
   10024         231 :     case mf_FULL: D = mypsiu(N) + 6*dim22(N, F, 0);
   10025         231 :       if (D%24) pari_err_BUG("mfdim");
   10026         231 :       return D/24 + mf2dimwt12(N, CHI, 1);
   10027         231 :     case mf_EISEN: D = dim22(N, F, 0) + dim22(N, F, 1);
   10028         231 :       if (D & 3L) pari_err_BUG("mfdim");
   10029         231 :       return (D >> 2) - mf2dimwt12(N, CHI, 3);
   10030             :   }
   10031             :   return 0; /*LCOV_EXCL_LINE*/
   10032             : }
   10033             : 
   10034             : /* F = conductor(CHI), weight k = r+1/2 */
   10035             : static long
   10036       43596 : checkmf2(long N, long r, GEN CHI, long F, long space)
   10037             : {
   10038       43596 :   switch(space)
   10039             :   {
   10040       43575 :     case mf_FULL: case mf_CUSP: case mf_EISEN: break;
   10041             :     case mf_NEW: case mf_OLD:
   10042          14 :       pari_err_TYPE("half-integral weight [new/old spaces]", utoi(space));
   10043             :     default:
   10044           7 :       pari_err_TYPE("half-integral weight [incorrect space]",utoi(space));
   10045             :   }
   10046       43575 :   if (N & 3L)
   10047           0 :     pari_err_DOMAIN("half-integral weight", "N % 4", "!=", gen_0, stoi(N));
   10048       43575 :   return r >= 0 && mfcharparity(CHI) == 1 && N % F == 0;
   10049             : }
   10050             : 
   10051             : /* weight k = r + 1/2 */
   10052             : static long
   10053       43463 : mf2dim_Nkchi(long N, long r, GEN CHI, ulong space)
   10054             : {
   10055       43463 :   long D, D2, F = mfcharconductor(CHI);
   10056       43463 :   if (!checkmf2(N, r, CHI, F, space)) return 0;
   10057       43442 :   if (r == 0) return mf2dimwt12(N, CHI, space);
   10058        2772 :   if (r == 1) return mf2dimwt32(N, CHI, F, space);
   10059        2079 :   if (space == mf_EISEN)
   10060             :   {
   10061         693 :     D = dim22(N, F, r) + dim22(N, F, 1-r);
   10062         693 :     if (D & 3L) pari_err_BUG("mfdim");
   10063         693 :     return D >> 2;
   10064             :   }
   10065        1386 :   D2 = space == mf_FULL? dim22(N, F, 1-r): -dim22(N, F, r);
   10066        1386 :   D = (2*r-1)*mypsiu(N) + 6*D2;
   10067        1386 :   if (D%24) pari_err_BUG("mfdim");
   10068        1386 :   return D/24;
   10069             : }
   10070             : 
   10071             : /* weight k=r+1/2 */
   10072             : static GEN
   10073         133 : mf2init_Nkchi(long N, long r, GEN CHI, long space)
   10074             : {
   10075         133 :   GEN Minv, Minvmat, B, M, gk = gaddsg(r,ghalf);
   10076         133 :   GEN mf1 = mkvec4(utoi(N),gk,CHI,utoi(space));
   10077             :   long L;
   10078         133 :   if (!checkmf2(N, r, CHI, mfcharconductor(CHI), space)) return mfEMPTY(mf1);
   10079         133 :   if (space==mf_EISEN) pari_err_IMPL("half-integral weight Eisenstein space");
   10080         133 :   L = mfsturmNgk(N, gk) + 1;
   10081         133 :   B = mf2basis(N, r, CHI, space);
   10082         133 :   M = mflineardivtomat(B,L);
   10083         133 :   M = mfcleanCHI(M, CHI);
   10084         133 :   Minv = gel(M,2);
   10085         133 :   Minvmat = RgM_Minv_mul(NULL, Minv);
   10086         133 :   B = vecmflineardiv_linear(B, Minvmat);
   10087         133 :   gel(M,3) = RgM_Minv_mul(gel(M,3), Minv);
   10088         133 :   gel(M,2) = mkMinv(matid(lg(B)-1), NULL,NULL,NULL);
   10089         133 :   return mkmf(mf1, cgetg(1,t_VEC), B, gen_0, M);
   10090             : }
   10091             : 
   10092             : /**************************************************************************/
   10093             : /*                          Kohnen + space                                */
   10094             : /**************************************************************************/
   10095             : #if 0
   10096             : GEN
   10097             : mfkohnenbasis(GEN mf)
   10098             : {
   10099             :   pari_sp ltop = avma;
   10100             :   GEN gk, CHI, M, ME, K, RES;
   10101             :   long N, N4, r, eps, sb, c, lk, i;
   10102             :   checkMF(mf);
   10103             :   N = MF_get_N(mf); gk = MF_get_gk(mf); CHI = MF_get_CHI(mf);
   10104             :   if (typ(gk) == t_INT) pari_err_TYPE("mfkohnenbasis", gk);
   10105             :   N4 = N >> 2;
   10106             :   r = itos(gsub(gk, ghalf));
   10107             :   eps = N4 % mfcharconductor(CHI)? -1 : 1;
   10108             :   if (odd(r)) eps = -eps;
   10109             :   sb = mfsturmNgk(N, gk) + 1;
   10110             :   M = shallowtrans(mfcoefs_mf(mf,sb,1));
   10111             :   ME = cgetg(sb + 2, t_MAT); c = 1;
   10112             :   for (i = 0; i <= sb; i++)
   10113             :   {
   10114             :     long j = i & 3L;
   10115             :     if (j == 2 || j == 2 + eps) gel(ME, c++) = gel(M, i+1);
   10116             :   }
   10117             :   setlg(ME, c); ME = shallowtrans(ME);
   10118             :   K = ker(ME); lk = lg(K); RES = cgetg(lk, t_VEC);
   10119             :   for (i = 1; i < lk; i++) gel(RES,i) = mflinear(mf, Q_primpart(gel(K,i)));
   10120             :   return gerepilecopy(ltop, RES);
   10121             : }
   10122             : #endif
   10123             : 
   10124             : static GEN desc(GEN F);
   10125             : static GEN
   10126         497 : desc_mfeisen(GEN F)
   10127             : {
   10128         497 :   GEN R, gk = mf_get_gk(F);
   10129         497 :   if (typ(gk) == t_FRAC)
   10130           0 :     R = gsprintf("H_{%Ps}", gk);
   10131             :   else
   10132             :   {
   10133         497 :     GEN vchi = gel(F, 2), CHI = mfchisimpl(gel(vchi, 3));
   10134         497 :     long k = itou(gk);
   10135         497 :     if (lg(vchi) < 5) R = gsprintf("F_%ld(%Ps)", k, CHI);
   10136             :     else
   10137             :     {
   10138         294 :       GEN CHI2 = mfchisimpl(gel(vchi, 4));
   10139         294 :       R = gsprintf("F_%ld(%Ps, %Ps)", k, CHI, CHI2);
   10140             :     }
   10141             :   }
   10142         497 :   return R;
   10143             : }
   10144             : static GEN
   10145          35 : desc_hecke(GEN F)
   10146             : {
   10147             :   long n, N;
   10148          35 :   GEN D = gel(F,2);
   10149          35 :   if (typ(D) == t_VECSMALL) { N = D[3]; n = D[1]; }
   10150          14 :   else { GEN nN = gel(D,2); n = nN[1]; N = nN[2]; } /* half integer */
   10151          35 :   return gsprintf("T_%ld(%ld)(%Ps)", N, n, desc(gel(F,3)));
   10152             : }
   10153             : static GEN
   10154          98 : desc_linear(GEN FLD, GEN dL)
   10155             : {
   10156          98 :   GEN F = gel(FLD,2), L = gel(FLD,3), R = strtoGENstr("LIN([");
   10157          98 :   long n = lg(F) - 1, i;
   10158         168 :   for (i = 1; i <= n; i++)
   10159             :   {
   10160         168 :     R = shallowconcat(R, desc(gel(F,i))); if (i == n) break;
   10161          70 :     R = shallowconcat(R, strtoGENstr(", "));
   10162             :   }
   10163          98 :   return shallowconcat(R, gsprintf("], %Ps)", gdiv(L, dL)));
   10164             : }
   10165             : static GEN
   10166          21 : desc_dihedral(GEN F)
   10167             : {
   10168          21 :   GEN bnr = gel(F,2), D = nf_get_disc(bnr_get_nf(bnr)), f = bnr_get_mod(bnr);
   10169          21 :   GEN cyc = bnr_get_cyc(bnr);
   10170          21 :   GEN w = gel(F,3), chin = zv_to_ZV(gel(w,2)), o = utoi(gel(w,1)[1]);
   10171          21 :   GEN chi = char_denormalize(cyc, o, chin);
   10172          21 :   if (lg(gel(f,2)) == 1) f = gel(f,1);
   10173          21 :   return gsprintf("DIH(%Ps, %Ps, %Ps, %Ps)",D,f,cyc,chi);
   10174             : }
   10175             : 
   10176             : static void
   10177        1036 : unpack0(GEN *U)
   10178        1036 : { if (U) *U = mkvec2(cgetg(1, t_VEC), cgetg(1, t_VEC)); }
   10179             : static void
   10180          42 : unpack2(GEN F, GEN *U)
   10181          42 : { if (U) *U = mkvec2(mkvec2(gel(F,2), gel(F,3)), cgetg(1, t_VEC)); }
   10182             : static void
   10183         308 : unpack23(GEN F, GEN *U)
   10184         308 : { if (U) *U = mkvec2(mkvec(gel(F,2)), mkvec(gel(F,3))); }
   10185             : static GEN
   10186        1533 : desc_i(GEN F, GEN *U)
   10187             : {
   10188        1533 :   switch(mf_get_type(F))
   10189             :   {
   10190           7 :     case t_MF_CONST: unpack0(U); return gsprintf("CONST(%Ps)", gel(F,2));
   10191         497 :     case t_MF_EISEN: unpack0(U); return desc_mfeisen(F);
   10192         154 :     case t_MF_Ek: unpack0(U); return gsprintf("E_%ld", mf_get_k(F));
   10193          63 :     case t_MF_DELTA: unpack0(U); return gsprintf("DELTA");
   10194          35 :     case t_MF_THETA: unpack0(U);
   10195          35 :       return gsprintf("THETA(%Ps)", mfchisimpl(gel(F,2)));
   10196          56 :     case t_MF_ETAQUO: unpack0(U);
   10197          56 :       return gsprintf("ETAQUO(%Ps, %Ps)", gel(F,2), gel(F,3));
   10198          56 :     case t_MF_ELL: unpack0(U);
   10199          56 :       return gsprintf("ELL(%Ps)", vecslice(gel(F,2), 1, 5));
   10200           7 :     case t_MF_TRACE: unpack0(U); return gsprintf("TR(%Ps)", mfparams(F));
   10201         140 :     case t_MF_NEWTRACE: unpack0(U); return gsprintf("TR^new(%Ps)", mfparams(F));
   10202          21 :     case t_MF_DIHEDRAL: unpack0(U); return desc_dihedral(F);
   10203          28 :     case t_MF_MUL: unpack2(F, U);
   10204          28 :       return gsprintf("MUL(%Ps, %Ps)", desc(gel(F,2)), desc(gel(F,3)));
   10205          14 :     case t_MF_DIV: unpack2(F, U);
   10206          14 :       return gsprintf("DIV(%Ps, %Ps)", desc(gel(F,2)), desc(gel(F,3)));
   10207          14 :     case t_MF_POW: unpack23(F, U);
   10208          14 :       return gsprintf("POW(%Ps, %ld)", desc(gel(F,2)), itos(gel(F,3)));
   10209          14 :     case t_MF_SHIFT: unpack23(F, U);
   10210          14 :       return gsprintf("SHIFT(%Ps, %ld)", desc(gel(F,2)), itos(gel(F,3)));
   10211          14 :     case t_MF_DERIV: unpack23(F, U);
   10212          14 :       return gsprintf("DER^%ld(%Ps)", itos(gel(F,3)), desc(gel(F,2)));
   10213          21 :     case t_MF_DERIVE2: unpack23(F, U);
   10214          21 :       return gsprintf("DERE2^%ld(%Ps)", itos(gel(F,3)), desc(gel(F,2)));
   10215          14 :     case t_MF_TWIST: unpack23(F, U);
   10216          14 :       return gsprintf("TWIST(%Ps, %Ps)", desc(gel(F,2)), gel(F,3));
   10217         231 :     case t_MF_BD: unpack23(F, U);
   10218         231 :       return gsprintf("B(%ld)(%Ps)", itou(gel(F,3)), desc(gel(F,2)));
   10219             :     case t_MF_BRACKET:
   10220          14 :       if (U) *U = mkvec2(mkvec2(gel(F,2), gel(F,3)), mkvec(gel(F,4)));
   10221          14 :       return gsprintf("MULRC_%ld(%Ps, %Ps)", itos(gel(F,4)), desc(gel(F,2)), desc(gel(F,3)));
   10222             :     case t_MF_LINEAR_BHN:
   10223             :     case t_MF_LINEAR:
   10224          98 :       if (U) *U = mkvec2(gel(F,2), mkvec(gdiv(gel(F,3), gel(F,4))));
   10225          98 :       return desc_linear(F,gel(F,4));
   10226             :     case t_MF_HECKE:
   10227          35 :       if (U) *U = mkvec2(mkvec(gel(F,3)), mkvec(stoi(gel(F,2)[1])));
   10228          35 :       return desc_hecke(F);
   10229           0 :     default: pari_err_TYPE("mfdescribe",F);
   10230           0 :     return NULL;/* not reached */
   10231             :   }
   10232             : }
   10233             : static GEN
   10234         623 : desc(GEN F) { return desc_i(F, NULL); }
   10235             : GEN
   10236         959 : mfdescribe(GEN F, GEN *U)
   10237             : {
   10238         959 :   pari_sp av = avma;
   10239         959 :   if (checkMF_i(F))
   10240             :   {
   10241          49 :     const char *f = NULL;
   10242          49 :     switch (MF_get_space(F))
   10243             :     {
   10244           7 :       case mf_NEW:  f = "S_%Ps^new(G_0(%ld, %Ps))"; break;
   10245          14 :       case mf_CUSP: f = "S_%Ps(G_0(%ld, %Ps))"; break;
   10246           7 :       case mf_OLD:  f = "S_%Ps^old(G_0(%ld, %Ps))"; break;
   10247           7 :       case mf_EISEN:f = "E_%Ps(G_0(%ld, %Ps))"; break;
   10248          14 :       case mf_FULL: f = "M_%Ps(G_0(%ld, %Ps))"; break;
   10249             :     }
   10250          49 :     if (U) *U = cgetg(1, t_VEC);
   10251          49 :     return gsprintf(f, MF_get_gk(F), MF_get_N(F), mfchisimpl(MF_get_CHI(F)));
   10252             :   }
   10253         910 :   if (!checkmf_i(F)) pari_err_TYPE("mfdescribe", F);
   10254         910 :   F = desc_i(F, U);
   10255         910 :   gerepileall(av, U ? 2: 1, &F, U);
   10256         910 :   return F;
   10257             : }
   10258             : 
   10259             : #if 0
   10260             : /* Kernel of real/complex matrix M assuming pivots with gexpo < -ex
   10261             :    are zero */
   10262             : GEN
   10263             : kerreal(GEN M, long ex)
   10264             : {
   10265             :   pari_sp ltop = avma;
   10266             :   GEN CI, DI, K;
   10267             :   long m, n, i, j, k, r;
   10268             :   n = lg(M) - 1; if (!n) return cgetg(1, t_MAT);
   10269             :   m = lg(gel(M, 1)) - 1; if (!m) return matid(n);
   10270             :   M = gcopy(M);
   10271             :   CI = cgetg(m + 1, t_VECSMALL); DI = cgetg(n + 1, t_VECSMALL);
   10272             :   r = 0; for (i = 1; i <= m; i++) CI[i] = 0;
   10273             :   for (k = 1; k <= n; k++)
   10274             :   {
   10275             :     GEN col = gel(M, k);
   10276             :     long exmax = -2*ex, jkeep = 0;
   10277             :     for (j = 1; j <= m; j++)
   10278             :     {
   10279             :       if (!CI[j])
   10280             :       {
   10281             :         long ex = gexpo(gel(col, j));
   10282             :         if (!jkeep || ex > exmax) { exmax = ex; jkeep = j; }
   10283             :       }
   10284             :     }
   10285             :     if (!jkeep || exmax < -ex) { r++; DI[k] = 0; }
   10286             :     else
   10287             :     {
   10288             :       GEN d;
   10289             :       long s;
   10290             :       j = jkeep; d = gneg(ginv(gel(col, j)));
   10291             :       gcoeff(M, j, k) = gen_m1;
   10292             :       for (s = k + 1; s <= n; s++)
   10293             :         gcoeff(M, j, s) = gmul(d, gcoeff(M, j, s));
   10294             :       for (i = 1; i <= m; i++)
   10295             :       {
   10296             :         if (i != j)
   10297             :         {
   10298             :           d = gcoeff(M, i, k); gcoeff(M, i, k) = gen_0;
   10299             :           for (s = k + 1; s <= n; s++)
   10300             :             gcoeff(M, i, s) = gadd(gcoeff(M, i, s), gmul(d, gcoeff(M, j, s)));
   10301             :         }
   10302             :       }
   10303             :       CI[j] = k; DI[k] = j;
   10304             :     }
   10305             :   }
   10306             :   K = cgetg(r + 1, t_MAT); j = 0;
   10307             :   for (k = 1; k <= n; k++)
   10308             :   {
   10309             :     if (!DI[k])
   10310             :     {
   10311             :       GEN X = cgetg(n + 1, t_COL);
   10312             :       if (++j > r) pari_err_BUG("kerreal [j > r]");
   10313             :       for (i = 1; i <= n; i++)
   10314             :       {
   10315             :         if (DI[i]) gel(X, i) = gcoeff(M, DI[i], k);
   10316             :         else gel(X, i) = i == k ? gen_1 : gen_0;
   10317             :       }
   10318             :       gel(K, j) = X;
   10319             :     }
   10320             :   }
   10321             :   if (j < r) pari_err_BUG("kerreal [j < r]");
   10322             :   return gerepilecopy(ltop, K);
   10323             : }
   10324             : #endif
   10325             : /***********************************************************************/
   10326             : /*               Eisenstein series H_r of weight r+1/2                 */
   10327             : /***********************************************************************/
   10328             : /* radical(u_ppo(g,q)) */
   10329             : static long
   10330          28 : u_pporad(long g, long q)
   10331             : {
   10332          28 :   GEN F = myfactoru(g), P = gel(F,1);
   10333             :   long i, l, n;
   10334          28 :   if (q == 1) return zv_prod(P);
   10335          28 :   l = lg(P);
   10336          35 :   for (i = n = 1; i < l; i++)
   10337             :   {
   10338           7 :     long p = P[i];
   10339           7 :     if (q % p) n *= p;
   10340             :   }
   10341          28 :   return n;
   10342             : }
   10343             : static void
   10344          63 : c_F2TH4(long n, GEN *pF2, GEN *pTH4)
   10345             : {
   10346          63 :   GEN v = mfcoefs_i(mfEk(2), n, 1), v2 = bdexpand(v,2), v4 = bdexpand(v,4);
   10347          63 :   GEN F2 = gdivgs(ZC_add(ZC_sub(v, ZC_z_mul(v2,3)), ZC_z_mul(v4,2)), -24);
   10348          63 :   GEN TH4 = gdivgs(ZC_sub(v, ZC_z_mul(v4,4)), -3);
   10349          63 :   settyp(F2,t_VEC); *pF2 = F2;
   10350          63 :   settyp(TH4,t_VEC);*pTH4= TH4;
   10351          63 : }
   10352             : /* r > 0, N >= 0 */
   10353             : static GEN
   10354          77 : mfEHcoef(long r, long N)
   10355             : {
   10356             :   long D0, f, i, l;
   10357             :   GEN S, Df;
   10358             : 
   10359          77 :   if (r == 1) return hclassno(utoi(N));
   10360          77 :   if (N == 0) return gdivgs(bernfrac(2*r), -2*r);
   10361          56 :   if (r&1L)
   10362             :   {
   10363          42 :     long s = N&3L; if (s == 2 || s == 1) return gen_0;
   10364          14 :     D0 = mycoredisc2neg(N,&f);
   10365             :   }
   10366             :   else
   10367             :   {
   10368          14 :     long s = N&3L; if (s == 2 || s == 3) return gen_0;
   10369          14 :     D0 = mycoredisc2pos(N,&f);
   10370             :   }
   10371          28 :   Df = mydivisorsu(u_pporad(f, D0)); l = lg(Df);
   10372          28 :   S = gen_0;
   10373          63 :   for (i = 1; i < l; i++)
   10374             :   {
   10375          35 :     long d = Df[i], s = moebiusu(d)*kross(D0, d); /* != 0 */
   10376          35 :     GEN c = gmul(powuu(d, r-1), mysumdivku(f/d, 2*r-1));
   10377          35 :     S = s > 0? addii(S, c): subii(S, c);
   10378             :   }
   10379          28 :   return gmul(lfunquadneg(D0, r), S);
   10380             : }
   10381             : static GEN
   10382          63 : mfEHmat(long lim, long r)
   10383             : {
   10384          63 :   long j, l, d = r/2;
   10385             :   GEN f2, th4, th3, v, vth4, vf2;
   10386          63 :   c_F2TH4(lim, &f2, &th4);
   10387          63 :   f2 = gtoser(f2, 0, 0);
   10388          63 :   th4 = gtoser(th4, 0, 0);
   10389          63 :   th3 = gtoser(c_theta(lim, 1, mfchartrivial()), 0, 0);
   10390          63 :   if (odd(r)) th3 = gpowgs(th3, 3);
   10391          63 :   vth4 = gpowers(th4, d);
   10392          63 :   vf2 = gpowers0(f2, d, th3); /* th3 f2^j */
   10393          63 :   l = d+2; v = cgetg(l, t_VEC);
   10394         287 :   for (j = 1; j < l; j++)
   10395         224 :     gel(v, j) = ser2rfrac_i(gmul(gel(vth4, l-j), gel(vf2, j)));
   10396          63 :   return RgXV_to_RgM(v, lim);
   10397             : }
   10398             : static GEN
   10399           7 : Hfind(long r, GEN *pden)
   10400             : {
   10401           7 :   long lim = (r/2)+3, i;
   10402             :   GEN res, M, B;
   10403             : 
   10404           7 :   if (r <= 0) pari_err_DOMAIN("mfEH", "r", "<=", gen_0, stoi(r));
   10405           7 :   M = mfEHmat(lim, r);
   10406           7 :   B = cgetg(lim+1, t_COL);
   10407           7 :   for (i = 1; i <= lim; i++) gel(B, i) = mfEHcoef(r, i-1);
   10408           7 :   res = inverseimage(M, B);
   10409           7 :   if (lg(res) == 1) pari_err_BUG("mfEH");
   10410           7 :   return Q_remove_denom(res,pden);
   10411             : }
   10412             : GEN
   10413          63 : mfEH(GEN gk)
   10414             : {
   10415          63 :   pari_sp av = avma;
   10416          63 :   GEN v, d, NK, gr = gsub(gk, ghalf);
   10417             :   long r;
   10418          63 :   if (typ(gr) != t_INT) pari_err_TYPE("mfEH", gk);
   10419          63 :   r = itos(gr);
   10420          63 :   switch (r)
   10421             :   {
   10422           7 :     case 1: v=cgetg(1,t_VEC); d=gen_1; break;
   10423           7 :     case 2: v=mkvec2s(1,-20); d=utoipos(120); break;
   10424           7 :     case 3: v=mkvec2s(-1,14); d=utoipos(252); break;
   10425           7 :     case 4: v=mkvec3s(1,-16,16); d=utoipos(240); break;
   10426           7 :     case 5: v=mkvec3s(-1,22,-88); d=utoipos(132); break;
   10427          14 :     case 6: v=mkvec4s(691,-18096,110136,-4160); d=utoipos(32760); break;
   10428           7 :     case 7: v=mkvec4s(-1,30,-240,224); d=utoipos(12); break;
   10429           7 :     default: v = Hfind(r, &d); break;
   10430             :   }
   10431          63 :   NK = mkgNK(utoipos(4), gaddgs(ghalf,r), mfchartrivial(), pol_x(1));
   10432          63 :   return gerepilecopy(av, tag(t_MF_EISEN, NK, mkvec2(v,d)));
   10433             : }
   10434             : 
   10435             : /**********************************************************/
   10436             : /*             T(f^2) for half-integral weight            */
   10437             : /**********************************************************/
   10438             : 
   10439             : /* T_p^2 V */
   10440             : static GEN
   10441          70 : tp2apply(GEN V, long p, long p2, GEN c1, GEN c2)
   10442             : {
   10443          70 :   long lw = (lg(V) - 2)/p2 + 1, m, n;
   10444          70 :   GEN a0 = gel(V,1), W = cgetg(lw + 1, t_VEC);
   10445             : 
   10446          70 :   gel(W,1) = gequal0(a0)? gen_0: gmul(a0, gaddsg(1, c2));
   10447       11109 :   for (n = 1; n < lw; n++)
   10448             :   {
   10449       11039 :     GEN c = gel(V, p2*n + 1);
   10450       11039 :     if (n%p) c = gadd(c, gmulsg(kross(n,p), gmul(gel(V,n+1), c1)));
   10451       11039 :     gel(W, n+1) = c;
   10452             :   }
   10453        1253 :   for (m = 1, n = p2; n < lw; m++, n += p2)
   10454        1183 :     gel(W, n+1) = gadd(gel(W,n+1), gmul(gel(V,m+1), c2));
   10455          70 :   return W;
   10456             : }
   10457             : 
   10458             : /* T_{p^{2e}} V; can derecursify [Purkait, Hecke operators in half-integral
   10459             :  * weight, Prop 4.3], not worth it */
   10460             : static GEN
   10461          70 : tp2eapply(GEN V, long p, long p2, long e, GEN q, GEN c1, GEN c2)
   10462             : {
   10463          70 :   GEN V4 = NULL;
   10464          70 :   if (e > 1)
   10465             :   {
   10466          21 :     V4 = vecslice(V, 1, (lg(V) - 2)/(p2*p2) + 1);
   10467          21 :     V = tp2eapply(V, p, p2, e-1, q, c1, c2);
   10468             :   }
   10469          70 :   V = tp2apply(V, p, p2, c1, c2);
   10470          70 :   if (e > 1)
   10471          28 :     V = gsub(V, (e == 2)? gmul(q, V4)
   10472           7 :                         : gmul(c2, tp2eapply(V4, p, p2, e-2, q, c1, c2)));
   10473          70 :   return V;
   10474             : }
   10475             : 
   10476             : /* weight k = r+1/2 */
   10477             : static GEN
   10478          98 : c_mfheckef2(long n, long d, GEN F, GEN DATA)
   10479             : {
   10480          98 :   GEN CHI = mf_get_CHI(F), fa = gel(DATA,1), S = gel(DATA,2);
   10481          98 :   GEN P = gel(fa,1), E = gel(fa,2), VF = mfcoefs_i(F, n*d*S[3], S[4]);
   10482          98 :   long i, l = lg(P), r = mf_get_r(F), s4 = odd(r)? -4: 4, k2m3 = (r<<1)-2;
   10483         140 :   for (i = 1; i < l; i++)
   10484             :   { /* p does not divide N */
   10485          42 :     long p = P[i], e = E[i], p2 = p*p;
   10486          42 :     GEN chip, c1, c2, a, b, q = NULL;
   10487          42 :     chip = mfchareval(CHI,p);
   10488          42 :     a = r? powuu(p,r-1): mkfrac(gen_1,utoipos(p)); /* p^(r-1) */
   10489          42 :     b = r? mulii(powuu(p,r), a): a; /* p^(2r-1) */
   10490          42 :     c1 = gmul(chip, gmulsg(kross(s4,p),a));
   10491          42 :     c2 = gmul(chip, b);
   10492          42 :     if (e > 1)
   10493          14 :       q = gmul(c2, gmulsg(1+p, r? powuu(p,k2m3): mkfrac(gen_1, utoipos(p2))));
   10494          42 :     VF = tp2eapply(VF, p, p2, e, q, c1, c2);
   10495             :   }
   10496          98 :   return c_deflate(n, d, VF);
   10497             : }
   10498             : 
   10499             : static GEN
   10500        1498 : GL2toSL2(GEN ga, long *pa, long *pb, long *pd)
   10501             : {
   10502             :   long A, B, C, D, u, v, a, d;
   10503        1498 :   check_M2Q(ga);
   10504        1498 :   ga = Q_remove_denom(ga, NULL);
   10505        1498 :   A = itos(gcoeff(ga,1,1)); B = itos(gcoeff(ga,1,2));
   10506        1498 :   C = itos(gcoeff(ga,2,1)); D = itos(gcoeff(ga,2,2));
   10507        1498 :   *pa = a = cbezout(A, C, &u, &v);
   10508        1498 :   if (a > 1) { A /= a; C /= a; }
   10509        1498 :   *pd = d = A*D - B*C; if (d <= 0) pari_err_TYPE("GL2toSL2",ga);
   10510        1498 :   *pb = u*B + v*D; return mkmat22(A, -v, C, u);
   10511             : }
   10512             : 
   10513             : /* m != 2 (mod 4) */
   10514             : static GEN
   10515           7 : bestapprnf2(GEN V, long m, long prec)
   10516             : {
   10517           7 :   long vt = fetch_user_var("t"), i, j, f;
   10518           7 :   GEN Tinit, Vl, H, Pf, P = polcyclo(m, vt);
   10519           7 :   V = bestapprnf(liftpol_shallow(V), P, NULL, prec);
   10520           7 :   Vl = liftpol_shallow(V);
   10521           7 :   H = coprimes_zv(m);
   10522          14 :   for (i = 2; i < m; i++)
   10523             :   {
   10524           7 :     if (H[i] != 1) continue;
   10525           7 :     if (!gequal(Vl, vecGalois(Vl, i, P))) H[i] = 0;
   10526           0 :     else for (j = i; j < m; j *= i) H[i] = 3;
   10527             :   }
   10528           7 :   f = znstar_conductor_bits(Flv_to_F2v(H));
   10529           7 :   if (f == m || f == 1) return V;
   10530           0 :   Tinit = Qab_trace_init(P, m, f);
   10531           0 :   Pf = gel(Tinit,1);
   10532           0 :   Vl = QabV_tracerel(Tinit, 0, Vl);
   10533           0 :   return gmodulo(gdivgs(Vl, degpol(P)/degpol(Pf)), Pf);
   10534             : }
   10535             : 
   10536             : /* F | gamma expansion; [F, mf_eisendec(F)]~ allowed */
   10537             : GEN
   10538        1498 : mfslashexpansion(GEN mf, GEN F, GEN gamma, long n, long flrat, GEN *params, long prec)
   10539             : {
   10540        1498 :   pari_sp av = avma;
   10541             :   GEN res, al, V, M, gw;
   10542             :   long i, a, b, d;
   10543             : 
   10544        1498 :   checkMF(mf);
   10545        1498 :   M = GL2toSL2(gamma, &a,&b,&d);
   10546        1498 :   res = mfgaexpansion(mf, F, M, n, prec);
   10547        1498 :   al = gel(res,1);
   10548        1498 :   gw = gel(res,2);
   10549        1498 :   V = gel(res,3);
   10550        1498 :   if (a != 1 || d != 1 || b != 0)
   10551             :   {
   10552         826 :     GEN ad = sstoQ(a,d), z, W, sh, adal, t;
   10553         826 :     long nums, dens, w = itos(gw);
   10554         826 :     Qtoss(sstoQ(b, w*d), &nums, &dens);
   10555         826 :     z = rootsof1powinit(nums, dens, prec);
   10556         826 :     W = cgetg(n+2, t_VEC);
   10557         826 :     for (i = 1; i <= n+1; i++) gel(W, i) = gmul(gel(V,i), rootsof1pow(z, i-1));
   10558         826 :     t = gexp(gmul(PiI2(prec), gmul(al, sstoQ(b,d))), prec);
   10559         826 :     t = gmul(t, gpow(ad, gmul2n(MF_get_gk(mf), -1), prec));
   10560         826 :     W = RgV_Rg_mul(W, t);
   10561         826 :     Qtoss(gdivgs(ad, w), &nums, &w);
   10562         826 :     adal = gmul(ad, al); sh = gfloor(adal); al = gsub(adal, sh);
   10563         826 :     V = RgV_shift(bdexpand(W, nums), sh);
   10564         826 :     gw = utoipos(w);
   10565             :   }
   10566        1498 :   if (flrat)
   10567             :   {
   10568           7 :     GEN CV, gk = MF_get_gk(mf);
   10569           7 :     long C = itos(gcoeff(M, 2, 1)), N = MF_get_N(mf), g, w = itos(gw);
   10570           7 :     long ord = mfcharorder_canon(MF_get_CHI(mf)), k;
   10571           7 :     if (typ(gk) != t_INT)
   10572           0 :       pari_err_IMPL("rationalization of half-integral weight slash");
   10573           7 :     k = itos(gk);
   10574           7 :     g = cgcd(N/cgcd(N, C), C);
   10575           7 :     CV = odd(k) ? powuu(N, k - 1) : powuu(N, k >> 1);
   10576           7 :     V = gdiv(bestapprnf2(gmul(CV, V), ord_canon(clcm(g*w, ord)), prec), CV);
   10577             :   }
   10578        1498 :   if (!params) return gerepilecopy(av, V);
   10579        1309 :   *params = mkvec2(al, gw); gerepileall(av,2,&V,params); return V;
   10580             : }
   10581             : 
   10582             : /**************************************************************/
   10583             : /*         Alternative method for 1/2-integral weight         */
   10584             : /**************************************************************/
   10585             : static GEN
   10586         133 : mf2basis(long N, long r, GEN CHI, long space)
   10587             : {
   10588             :   GEN CHI1, CHI2, mf1, mf2, B1, B2, BT1, BT2, M1, M2, M, T1, T2;
   10589             :   GEN M2I, K, POLCYC, v, den;
   10590             :   long sb, k1, N2, ordchi;
   10591         133 :   k1 = r + 1;
   10592         133 :   if (odd(k1))
   10593             :   {
   10594          77 :     CHI1 = mfcharmul(CHI, get_mfchar(stoi(-4)));
   10595          77 :     CHI2 = mfcharmul(CHI, get_mfchar(stoi(-8)));
   10596             :   }
   10597             :   else
   10598             :   {
   10599          56 :     CHI1 = CHI;
   10600          56 :     CHI2 = mfcharmul(CHI, get_mfchar(utoi(8)));
   10601             :   }
   10602         133 :   mf1 = mfinit_Nkchi(N, k1, CHI1, space, 1);
   10603         133 :   B1 = MF_get_basis(mf1); if (lg(B1) == 1) return cgetg(1,t_VEC);
   10604         126 :   N2 = clcm(8, N);
   10605         126 :   mf2 = mfinit_Nkchi(N2, k1, CHI2, space, 1);
   10606         126 :   B2 = MF_get_basis(mf2); if (lg(B2) == 1) return cgetg(1,t_VEC);
   10607         126 :   sb = mfsturmNgk(N2, gaddsg(k1, ghalf));
   10608         126 :   M1 = mfcoefs_mf(mf1, sb, 1);
   10609         126 :   M2 = mfcoefs_mf(mf2, sb, 1);
   10610         126 :   T1 = mfTheta(NULL); BT1 = RgV_to_RgX(mfcoefs_i(T1, sb, 1), 0);
   10611         126 :   T2 = mfbd_i(T1, 2); BT2 = RgV_to_RgX(mfcoefs_i(T2, sb, 1), 0);
   10612         126 :   M1 = mfmatsermul(M1, BT2);
   10613         126 :   M2 = mfmatsermul(M2, BT1);
   10614         126 :   ordchi = mfcharorder_canon(CHI);
   10615         126 :   POLCYC = (ordchi == 1)? NULL: mfcharpol(CHI);
   10616         126 :   M2I = QabM_pseudoinv(M2, POLCYC, ordchi, &v, &den);
   10617         126 :   M = RgM_mul(M2, RgM_mul(M2I, rowpermute(M1, gel(v,1))));
   10618         126 :   M = gsub(RgM_Rg_mul(M1, den), M);
   10619         126 :   K = QabM_ker(M, POLCYC, ordchi);
   10620         126 :   return vecmflineardiv0(B1, K, T1);
   10621             : }
   10622             : 
   10623             : #if 0
   10624             : /* alternative method for weight 1 */
   10625             : GEN
   10626             : mfwt1basisalt(long N, GEN CHI, long space)
   10627             : {
   10628             :   pari_sp ltop = avma;
   10629             :   GEN CHI1, mf1, mf2, B1, B2, BT1, BT2, M1, M2, M, T1, T2;
   10630             :   GEN M2I, K, POLCYC, v, den;
   10631             :   long sb, N1, N2, ordchi;
   10632             : 
   10633             :   CHI = get_mfchar(CHI);
   10634             :   CHI1 = mfcharmul(CHI, get_mfchar(stoi(-4)));
   10635             :   N1 = clcm(4, N);
   10636             :   mf1 = mfinit_Nkchi(N1, 2, CHI1, space, 1);
   10637             :   B1 = MF_get_basis(mf1);
   10638             :   if (lg(B1) == 1) { avma = ltop; return cgetg(1,t_VEC); }
   10639             :   N2 = clcm(8, N);
   10640             :   mf2 = mfinit_Nkchi(N2, 2, CHI1, space, 1);