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 21059-cbe0d6a) Lines: 4200 4993 84.1 %
Date: 2017-09-22 06:24:58 Functions: 429 484 88.6 %
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             :   t_MF_CONST, t_MF_EISEN, t_MF_Ek, t_MF_DELTA, t_MF_ETAQUO, t_MF_ELL,
      24             :   t_MF_MUL, t_MF_BRACKET, t_MF_DIV, t_MF_LINEAR, t_MF_LINEAR_BHN,
      25             :   t_MF_SHIFT, t_MF_HECKEU, t_MF_DERIV, t_MF_DERIVE2, t_MF_INTEG,
      26             :   t_MF_TWIST, t_MF_EMBED, t_MF_HECKE, t_MF_BD, t_MF_TRACE, t_MF_NEWTRACE,
      27             :   t_MF_CLOSURE, t_MF_DIHEDRAL, t_MF_EISENM1M2, t_MF_POW, t_MF_RELTOABS
      28             : };
      29             : 
      30             : typedef struct {
      31             :   GEN vnew, vfull, DATA, VCHIP;
      32             :   long newHIT, newTOTAL, cuspHIT, cuspTOTAL;
      33             : } cachenew_t;
      34             : 
      35             : static void init_cachenew(cachenew_t *c, long n, GEN D);
      36             : static long mfisinspace_i(GEN mf, GEN F);
      37             : static GEN mfinit_i(GEN NK, long space);
      38             : static GEN mfeisenbasis_i(long N, long k, GEN CHI);
      39             : static GEN mfwt1trace_i(long N, GEN CHI, long space);
      40             : static GEN myfactoru(long N);
      41             : static GEN mydivisorsu(long N);
      42             : static GEN mygmodulo_lift(long k, long ord, GEN C);
      43             : static GEN mfcoefs_i(GEN F, long n, long d);
      44             : static GEN c_deflate(long n, long d, GEN V);
      45             : static GEN bhnmat_extend(GEN M, long m,long l, GEN vtf, cachenew_t *cache);
      46             : static GEN initnewtrace(long N, GEN CHI);
      47             : static void dbg_cachenew(cachenew_t *C);
      48             : static GEN c_integ(long n, long d, GEN F, GEN gk);
      49             : static GEN hecke_i(long m, long l, GEN nN, GEN F);
      50             : static GEN c_Ek(long n, long d, long k, GEN C);
      51             : static GEN mfcusptrace_i(long N, long k, long n, GEN Dn, GEN TDATA);
      52             : static GEN mfnewtracecache(long N, long k, long n, cachenew_t *cache);
      53             : static GEN colnewtrace(long n0, long n, long d, long N, long k, cachenew_t *cache);
      54             : static GEN dihan(GEN bnr, GEN w, GEN Tinit, GEN k0j, ulong n);
      55             : static GEN sigchi(long k, GEN CHI, long n);
      56             : static GEN sigchi2(long k, GEN CHI1, GEN CHI2, long n, long ord);
      57             : static GEN GammaNsig(long N, long k, long m1, long m2, long n);
      58             : static GEN mfmatheckewt1(GEN mf, long n, GEN B);
      59             : static GEN wt1basiscols(GEN mf, long n);
      60             : static GEN mfmathecke_i(GEN mf, long n);
      61             : static GEN mfdihedralcusp(long N, GEN CHI);
      62             : static GEN mfwt1basisdiv(GEN D, 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 GEN mfeval0(long N, long k, GEN F, GEN vtau, long bitprec);
      67             : static GEN mfwt1_cusptonew(GEN mf);
      68             : static long mfwt1dim(long N, GEN CHI);
      69             : 
      70             : static GEN
      71       32046 : mkgNK(GEN N, GEN k, GEN CHI) { return mkvec3(N, k, CHI); }
      72             : static GEN
      73       22309 : mkNK(long N, long k, GEN CHI) { return mkgNK(stoi(N), stoi(k), CHI); }
      74             : GEN
      75        4473 : mf_get_CHI(GEN mf) { return gmael(mf,1,3); }
      76             : long
      77       14959 : mf_get_N(GEN mf) { return itou(gmael(mf,1,1)); }
      78             : long
      79        5131 : mf_get_k(GEN mf) { return itou(gmael(mf,1,2)); }
      80             : long
      81       11529 : mf_get_space(GEN mf) { return itos(gmael(mf,1,4)); }
      82             : GEN
      83         455 : mf_get_eisen(GEN mf) { return gel(mf,2); }
      84             : GEN
      85       18501 : mf_get_vtf(GEN mf) { return gel(mf,3); }
      86             : GEN
      87        1106 : mf_get_basis(GEN mf) { return shallowconcat(gel(mf,2), gel(mf,3)); }
      88             : GEN
      89          70 : mfbasis(GEN mf) { checkmf(mf); return concat(gel(mf,2), gel(mf,3)); }
      90             : long
      91        9282 : mf_get_dim(GEN mf)
      92             : {
      93        9282 :   switch(mf_get_space(mf))
      94             :   {
      95             :     case mf_NEW: case mf_CUSP: case mf_OLD:
      96        8981 :       return lg(mf_get_vtf(mf)) - 1;
      97             :     case mf_FULL:
      98         301 :       return lg(mf_get_vtf(mf)) - 1 + lg(mf_get_eisen(mf))-1;
      99             :     case mf_EISEN:
     100           0 :       return lg(mf_get_eisen(mf))-1;
     101           0 :     default: pari_err_FLAG("mf_get_dim");
     102             :   }
     103           0 :   return 0;
     104             : }
     105             : GEN
     106          91 : mf_get_listj(GEN mf) { return gel(mf,4); }
     107             : GEN
     108        5362 : mfnew_get_vj(GEN mf) { return gel(mf,4); }
     109             : GEN
     110           0 : mfcusp_get_vMjd(GEN mf) { return gel(mf,4); }
     111             : GEN
     112        3080 : mf_get_M(GEN mf) { return gmael(mf,5,3); }
     113             : GEN
     114        1673 : mf_get_Minv(GEN mf) { return gmael(mf,5,2); }
     115             : GEN
     116        4214 : mf_get_Mindex(GEN mf) { return gmael(mf,5,1); }
     117             : GEN
     118        1680 : mf_get_newforms(GEN mf) { return gel(mf,6); }
     119             : GEN
     120         567 : mf_get_fields(GEN mf) { return gel(mf,7); }
     121             : 
     122             : enum { _CHIP = 1, _SQRTS, _MUP, _GCD, _VCHIP, _BEZ, _NEWLZ };
     123             : 
     124             : /* ordinary gtocol forgets about initial 0s */
     125             : GEN
     126         434 : sertocol(GEN S) { return gtocol0(S, -(lg(S) - 2 + valp(S))); }
     127             : 
     128             : /*******************************************************************/
     129             : /*     Linear algebra in cyclotomic fields (TODO: export this)     */
     130             : /*******************************************************************/
     131             : /* return r and split prime p giving projection Q(zeta_n) -> Fp, zeta -> r */
     132             : static ulong
     133        1015 : QabM_init(long n, ulong *p)
     134             : {
     135        1015 :   ulong pinit = 1000000007;
     136             :   forprime_t T;
     137        1015 :   if (n <= 1) { *p = pinit; return 0; }
     138         798 :   u_forprime_arith_init(&T, pinit, ULONG_MAX, 1, n);
     139         798 :   *p = u_forprime_next(&T);
     140         798 :   return Flx_oneroot(ZX_to_Flx(polcyclo(n, 0), *p), *p);
     141             : }
     142             : static ulong
     143     3070144 : Qab_to_Fl(GEN P, ulong r, ulong p)
     144             : {
     145             :   ulong t;
     146             :   GEN den;
     147     3070144 :   P = Q_remove_denom(lift_shallow(P), &den);
     148     3070144 :   if (typ(P) == t_POL) { GEN Pp = ZX_to_Flx(P, p); t = Flx_eval(Pp, r, p); }
     149     2953076 :   else t = umodiu(P, p);
     150     3070144 :   if (den) t = Fl_div(t, umodiu(den, p), p);
     151     3070144 :   return t;
     152             : }
     153             : static GEN
     154       28973 : QabC_to_Flc(GEN C, ulong r, ulong p)
     155             : {
     156       28973 :   long i, l = lg(C);
     157       28973 :   GEN A = cgetg(l, t_VECSMALL);
     158       28973 :   for (i = 1; i < l; ++i) uel(A,i) = Qab_to_Fl(gel(C,i), r, p);
     159       28973 :   return A;
     160             : }
     161             : static GEN
     162        1225 : QabM_to_Flm(GEN M, ulong r, ulong p)
     163             : {
     164             :   long i, l;
     165        1225 :   GEN A = cgetg_copy(M, &l);
     166       30198 :   for (i = 1; i < l; ++i)
     167       28973 :     gel(A, i) = QabC_to_Flc(gel(M, i), r, p);
     168        1225 :   return A;
     169             : }
     170             : /* A a t_POL */
     171             : static GEN
     172        2499 : QabX_to_Flx(GEN A, ulong r, ulong p)
     173             : {
     174        2499 :   long i, l = lg(A);
     175        2499 :   GEN a = cgetg(l, t_VECSMALL);
     176        2499 :   a[1] = ((ulong)A[1])&VARNBITS;
     177        2499 :   for (i = 2; i < l; i++) uel(a,i) = Qab_to_Fl(gel(A,i), r, p);
     178        2499 :   return Flx_renormalize(a, l);
     179             : }
     180             : 
     181             : /* M matrix with coeff in Q(\chi)), where Q(\chi) = Q(X)/(P) for
     182             :  * P = cyclotomic Phi_n. Assume M rational if n <= 2 */
     183             : static GEN
     184         798 : QabM_ker(GEN M, GEN P, long n)
     185             : {
     186             :   GEN B;
     187         798 :   if (n <= 2)
     188         420 :     B = ZM_ker(Q_primpart(M));
     189             :   else
     190         378 :     B = ZabM_ker(Q_primpart(lift_shallow(M)), P, n);
     191         798 :   return vec_Q_primpart(B);
     192             : }
     193             : /* pseudo-inverse of M */
     194             : static GEN
     195         546 : QabM_pseudoinv(GEN M, GEN P, long n, GEN *pv, GEN *pden)
     196             : {
     197             :   GEN cM, Mi;
     198         546 :   if (n <= 2)
     199             :   {
     200         406 :     M = Q_primitive_part(M, &cM);
     201         406 :     Mi = ZM_pseudoinv(M, pv, pden); /* M^(-1) = Mi / (cM * den) */
     202             :   }
     203             :   else
     204             :   {
     205         140 :     M = Q_primitive_part(lift_shallow(M), &cM);
     206         140 :     Mi = ZabM_pseudoinv(M, P, n, pv, pden);
     207         140 :     Mi = gmodulo(Mi, P);
     208             :   }
     209         546 :   *pden = mul_content(*pden, cM);
     210         546 :   return Mi;
     211             : }
     212             : 
     213             : /*******************************************************************/
     214             : /*   Relative trace between cyclotomic fields (TODO: export this)  */
     215             : /*******************************************************************/
     216             : /* g * prod_{p | g, (p,q) = 1} (1-1/p) */
     217             : static long
     218       42567 : phipart(long g, long q)
     219             : {
     220             :   long i, l;
     221             :   GEN P;
     222       42567 :   if (g == 1) return 1;
     223       16590 :   P = gel(myfactoru(g), 1);
     224       16590 :   l = lg(P);
     225       33803 :   for (i = 1; i < l; i++)
     226             :   {
     227       17213 :     long p = P[i];
     228       17213 :     if (q % p) g -= g / p;
     229             :   }
     230       16590 :   return g;
     231             : }
     232             : 
     233             : /* Trace(zeta_n^k) from Q(\zeta_n) to Q; k > 0 */
     234             : static GEN
     235       33453 : tracerelzQ(long n, long k)
     236             : {
     237       33453 :   long s, g = cgcd(k, n), q = n/g, muq = moebiusu(q);
     238       33453 :   if (!muq) return gen_0;
     239       17843 :   s = phipart(g, q); if (muq < 0) s = -s;
     240       17843 :   return stoi(s);
     241             : }
     242             : /* Trace(zeta_n^k) from Q(\zeta_n) to Q(\zeta_m) with m|n; k > 0 */
     243             : static GEN
     244       77273 : tracerelz(long n, long m, long k, long vt)
     245             : {
     246             :   long s, d, g, q, muq, v;
     247             :   GEN S;
     248             : 
     249       77273 :   if (m == 1) return tracerelzQ(n, k);
     250       43820 :   d = n / m;
     251       43820 :   g = cgcd(k, d);
     252       43820 :   q = d / g; if (cgcd(q, m) > 1) return gen_0;
     253       34412 :   muq = moebiusu(q); if (!muq) return gen_0;
     254       24724 :   k /= g;
     255             :   /* (m,q) = 1 */
     256       24724 :   s = phipart(g, m*q); if (muq < 0) s = -s;
     257       24724 :   v = Fl_inv(q % m, m);
     258       24724 :   v = (v*k) % m;
     259       24724 :   S = mygmodulo_lift(v, m, stoi(s));
     260       24724 :   if (typ(S) == t_POL) setvarn(S, vt);
     261       24724 :   return S;
     262             : }
     263             : /* x a t_POL modulo Phi_n; n, m not 2 mod 4, degrel != 1*/
     264             : static GEN
     265       43386 : tracerel_i(GEN T, GEN x)
     266             : {
     267       43386 :   long k, l = lg(x);
     268       43386 :   GEN S = gen_0;
     269       43386 :   for (k = 2; k < l; k++) S = gadd(S, gmul(gel(T,k-1), gel(x,k)));
     270       43386 :   return S;
     271             : }
     272             : /* m | n, both not 2 mod 4 */
     273             : static GEN
     274       19362 : Qab_trace_init(long n, long m)
     275             : {
     276             :   GEN T, Pn, Pm;
     277       19362 :   long i, d, vt = fetch_user_var("t");
     278       19362 :   Pn = polcyclo(n, vt);
     279       19362 :   if (m == n) return mkvec(Pn);
     280       12551 :   d = degpol(Pn);
     281       12551 :   Pm = polcyclo(m, vt);
     282       12551 :   T = cgetg(d+1, t_VEC);
     283       12551 :   gel(T,1) = utoipos(d / degpol(Pm)); /* Tr 1 */
     284       12551 :   for (i = 1; i < d; i++) gel(T,i+1) = tracerelz(n, m, i, vt);
     285       12551 :   return mkvec3(Pm, Pn, T);
     286             : }
     287             : /* v = Qab_trace_init(n,m); x is a t_VEC of polmodulo Phi_n
     288             :  * Tr_{Q(zeta_n)/Q(zeta_m)} (zeta_n^t * x) */
     289             : static GEN
     290        3458 : QabV_tracerel(GEN v, long t, GEN x)
     291             : {
     292             :   long d, dm, lx, j, degrel;
     293             :   GEN y, z, Pm, Pn, T;
     294        3458 :   if (lg(v) != 4) return x;
     295        3458 :   y = cgetg_copy(x, &lx);
     296        3458 :   Pm = gel(v,1);
     297        3458 :   Pn = gel(v,2);
     298        3458 :   T  = gel(v,3);
     299        3458 :   d = degpol(Pn);
     300        3458 :   dm = degpol(Pm); degrel = d / dm;
     301        3458 :   z = RgX_rem(monomial(gen_1, t, varn(Pn)), Pn);
     302       91609 :   for (j = 1; j < lx; j++)
     303             :   {
     304       88151 :     GEN a = liftpol_shallow(gel(x,j));
     305       88151 :     a = simplify_shallow( gmul(a, z) );
     306       88151 :     if (typ(a) == t_POL)
     307             :     {
     308       43386 :       a = gdivgs(tracerel_i(T, RgX_rem(a, Pn)), degrel);
     309       43386 :       if (typ(a) == t_POL) a = RgX_rem(a, Pm);
     310             :     }
     311       88151 :     gel(y,j) = a;
     312             :   }
     313        3458 :   return y;
     314             : }
     315             : 
     316             : /*********************************************************************/
     317             : /*                    Simple arithmetic functions                    */
     318             : /*********************************************************************/
     319             : /* TODO: most of these should be exported and used in ifactor1.c */
     320             : /* phi(n) */
     321             : static ulong
     322      145124 : myeulerphiu(ulong n)
     323             : {
     324             :   pari_sp av;
     325             :   GEN fa;
     326      145124 :   if (n == 1) return 1;
     327      139748 :   av = avma; fa = myfactoru(n);
     328      139748 :   avma = av; return eulerphiu_fact(fa);
     329             : }
     330             : 
     331             : /* N\prod_{p|N} (1+1/p) */
     332             : static long
     333      301287 : mypsiu(ulong N)
     334             : {
     335      301287 :   pari_sp av = avma;
     336      301287 :   GEN P = gel(myfactoru(N), 1);
     337      301287 :   long j, l = lg(P), res = N;
     338      301287 :   for (j = 1; j < l; ++j) res += res/P[j];
     339      301287 :   avma = av; return res;
     340             : }
     341             : 
     342             : /* write -n = Df^2, D < 0 fundamental discriminant. Return D, set f. */
     343             : static long
     344         140 : mycoredisc2u_i(ulong n, long *pf)
     345             : {
     346         140 :   pari_sp av = avma;
     347         140 :   GEN fa = myfactoru(n), P = gel(fa,1), E = gel(fa,2);
     348         140 :   long i, l = lg(P), m = 1, f = 1;
     349         619 :   for (i = 1; i < l; i++)
     350             :   {
     351         479 :     long j, p = P[i], e = E[i];
     352         479 :     if (e & 1) m *= p;
     353         479 :     for (j = 2; j <= e; j+=2) f *= p;
     354             :   }
     355         140 :   if ((m&3L) != 3) { m <<= 2; f >>= 1; }
     356         140 :   avma = av; *pf = f; return -m;
     357             : }
     358             : /* fa = factorization of -D > 0, return -D0 > 0 (where D0 is fundamental) */
     359             : static long
     360    16234273 : corediscs_fact(GEN fa)
     361             : {
     362    16234273 :   GEN P = gel(fa,1), E = gel(fa,2);
     363    16234273 :   long i, l = lg(P), m = 1;
     364    61252270 :   for (i = 1; i < l; i++)
     365             :   {
     366    45017997 :     long p = P[i], e = E[i];
     367    45017997 :     if (e & 1) m *= p;
     368             :   }
     369    16234273 :   if ((m&3L) != 3) m <<= 2;
     370    16234273 :   return m;
     371             : }
     372             : static long
     373        5747 : mubeta(long n)
     374             : {
     375        5747 :   pari_sp av = avma;
     376        5747 :   GEN E = gel(myfactoru(n), 2);
     377        5747 :   long i, s = 1, l = lg(E);
     378       11977 :   for (i = 1; i < l; ++i)
     379             :   {
     380        6230 :     long e = E[i];
     381        6230 :     if (e >= 3) { avma = av; return 0; }
     382        6230 :     if (e == 1) s *= -2;
     383             :   }
     384        5747 :   avma = av; return s;
     385             : }
     386             : 
     387             : /* n = n1*n2, n1 = ppo(n, m); return mubeta(n1)*moebiusu(n2).
     388             :  * N.B. If n from newt_params we, in fact, never return 0 */
     389             : static long
     390     4257722 : mubeta2(long n, long m)
     391             : {
     392     4257722 :   pari_sp av = avma;
     393     4257722 :   GEN fa = myfactoru(n), P = gel(fa,1), E = gel(fa,2);
     394     4257722 :   long i, s = 1, l = lg(P);
     395     8978046 :   for (i = 1; i < l; i++)
     396             :   {
     397     4720324 :     long p = P[i], e = E[i];
     398     4720324 :     if (m % p)
     399             :     { /* p^e in n1 */
     400     3776087 :       if (e >= 3) { avma = av; return 0; }
     401     3776087 :       if (e == 1) s *= -2;
     402             :     }
     403             :     else
     404             :     { /* in n2 */
     405      944237 :       if (e >= 2) { avma = av; return 0; }
     406      944237 :       s = -s;
     407             :     }
     408             :   }
     409     4257722 :   avma = av; return s;
     410             : }
     411             : 
     412             : /* write N = prod p^{ep} and n = df^2, d squarefree.
     413             :  * set g  = ppo(gcd(sqfpart(N), f), FC)
     414             :  *     N2 = prod p^if(e==1 || p|n, ep-1, ep-2) */
     415             : static void
     416      840357 : newt_params(long N, long n, long FC, long *pg, long *pN2)
     417             : {
     418      840357 :   GEN fa = myfactoru(N), P = gel(fa,1), E = gel(fa,2);
     419      840357 :   long i, g = 1, N2 = 1, l = lg(P);
     420     2398599 :   for (i = 1; i < l; i++)
     421             :   {
     422     1558242 :     long p = P[i], e = E[i];
     423     1558242 :     if (e == 1)
     424     1254540 :     { if (FC % p && n % (p*p) == 0) g *= p; }
     425             :     else
     426      303702 :       N2 *= upowuu(p,(n % p)? e-2: e-1);
     427             :   }
     428      840357 :   *pg = g; *pN2 = N2;
     429      840357 : }
     430             : /* simplified version of newt_params for n = 1 (newdim) */
     431             : static void
     432       33257 : newd_params(long N, long *pN2)
     433             : {
     434       33257 :   GEN fa = myfactoru(N), P = gel(fa,1), E = gel(fa,2);
     435       33257 :   long i, N2 = 1, l = lg(P);
     436       89880 :   for (i = 1; i < l; i++)
     437             :   {
     438       56623 :     long p = P[i], e = E[i];
     439       56623 :     if (e > 2) N2 *= upowuu(p, e-2);
     440             :   }
     441       33257 :   *pN2 = N2;
     442       33257 : }
     443             : 
     444             : static long
     445           0 : newd_params2(long N)
     446             : {
     447           0 :   GEN fa = myfactoru(N), P = gel(fa,1), E = gel(fa,2);
     448           0 :   long i, N2 = 1, l = lg(P);
     449           0 :   for (i = 1; i < l; i++)
     450             :   {
     451           0 :     long p = P[i], e = E[i];
     452           0 :     if (e >= 2) N2 *= upowuu(p, e);
     453             :   }
     454           0 :   return N2;
     455             : }
     456             : 
     457             : /* TODO: export, together with numdivu */
     458             : static long
     459        8568 : numdivu_fact(GEN E)
     460             : {
     461        8568 :   long S = 1, i, l = lg(E);
     462        8568 :   for (i = 1; i < l; i++) S *= E[i] + 1;
     463        8568 :   return S;
     464             : }
     465             : static long
     466        8568 : mynumdivu(long N)
     467             : {
     468        8568 :   pari_sp av = avma;
     469        8568 :   GEN E = gel(myfactoru(N), 2);
     470        8568 :   long S = numdivu_fact(E);
     471        8568 :   avma = av; return S;
     472             : }
     473             : 
     474             : /*              Operations on Dirichlet characters                       */
     475             : 
     476             : /* A Dirichlet character can be given in GP in different formats, but in this
     477             :  * package, it will be a vector CHI=[G,chi,ord], where G is the (Z/MZ)^* to
     478             :  * which the character belongs, chi is the character in Conrey format, ord is
     479             :  * the order */
     480             : 
     481             : static GEN
     482     4263910 : gmfcharorder(GEN CHI) { return gel(CHI, 3); }
     483             : static long
     484     2607759 : mfcharorder(GEN CHI) { return itou(gmfcharorder(CHI)); }
     485             : static long
     486     2530969 : mfcharistrivial(GEN CHI) { return !CHI || mfcharorder(CHI) == 1; }
     487             : static GEN
     488     5758592 : gmfcharmodulus(GEN CHI) { return gmael3(CHI, 1, 1, 1); }
     489             : static long
     490     5758592 : mfcharmodulus(GEN CHI) { return itou(gmfcharmodulus(CHI)); }
     491             : 
     492             : /* t^k mod polcyclo(ord) */
     493             : static GEN
     494        7294 : mygmodulo(long k, long ord)
     495             : {
     496             :   long vt;
     497             :   GEN C;
     498        7294 :   if (!k || ord == 1) return gen_1;
     499        5446 :   if ((k << 1) == ord) return gen_m1;
     500        2933 :   vt = fetch_user_var("t");
     501        2933 :   if ((ord&3L) != 2)
     502        1687 :     C = gen_1;
     503             :   else
     504             :   {
     505        1246 :     ord >>= 1;
     506        1246 :     if (odd(k)) { C = gen_m1; k += ord; } else C = gen_1;
     507        1246 :     k >>= 1;
     508             :   }
     509        2933 :   return gmodulo(monomial(C, k, vt), polcyclo(ord, vt));
     510             : }
     511             : static long
     512      208103 : ord_canon(long ord)
     513             : {
     514      208103 :   if ((ord & 3L) == 2) ord >>= 1;
     515      208103 :   return ord;
     516             : }
     517             : static GEN
     518      284382 : mygmodulo_mod(GEN z, long ord)
     519             : {
     520             :   long vt;
     521      284382 :   if (typ(z) != t_POL) return z;
     522      144025 :   vt = fetch_user_var("t");
     523      144025 :   setvarn(z, vt);
     524      144025 :   return gmodulo(z, polcyclo(ord_canon(ord), vt));
     525             : }
     526             : /* C*zeta_ord^k */
     527             : static GEN
     528      989765 : mygmodulo_lift(long k, long ord, GEN C)
     529             : {
     530      989765 :   if (!k) return C;
     531      630756 :   if ((k << 1) == ord) return gneg(C);
     532      441175 :   if ((ord&3L) == 2)
     533             :   {
     534      228438 :     if (odd(k)) { C = gneg(C); k += ord >> 1; }
     535      228438 :     k >>= 1;
     536             :   }
     537      441175 :   return monomial(C,k,0);
     538             : }
     539             : 
     540             : static long
     541     1142190 : znchareval_i(GEN CHI, long n, GEN ord)
     542     1142190 : { return itos(znchareval(gel(CHI,1), gel(CHI,2), stoi(n), ord)); }
     543             : 
     544             : /* CHI mod N = \prod_p p^e, (n,N) = 1; let CHI = \prod CHI_p, CHI_p mod p^e
     545             :  * return CHI_p; p a prime. CHI primitive <=> CHI_p primitive for all p */
     546             : static GEN
     547        1855 : mfcharp(GEN CHI, long p)
     548             : {
     549        1855 :   GEN G = gel(CHI,1), c = gel(CHI,2);
     550        1855 :   GEN cp = NULL, P, E, F = znstar_get_faN(G); /* factor(N) */
     551        1855 :   long l = lg(c), i;
     552        1855 :   P = gel(F,1); /* prime divisors of N */
     553        1855 :   E = gel(F,2); /* exponents */
     554        1855 :   if (p == 2 && E[1] >= 3)
     555             :   {
     556          28 :     cp = mkcol2(gel(c,1), gel(c,2));
     557          28 :     if (l > 3) G = znstar0(int2n(E[1]),1);
     558             :   }
     559             :   else
     560             :   {
     561        2030 :     for (i = 1; i < l; i++)
     562        2030 :       if (equaliu(gel(P,i), p)) { cp = mkcol(gel(c,i)); break; }
     563        1827 :     if (l > 2) G = znstar0(powuu(p, E[i]),1);
     564             :   }
     565        1855 :   return mkvec3(G, cp, zncharorder(G, cp));
     566             : }
     567             : 
     568             : static GEN
     569        1365 : mfchar2char(GEN CHI)
     570             : {
     571        1365 :   if (typ(CHI) != t_VEC) return znchar(CHI);
     572        1358 :   else return mkvec2(gel(CHI,1), gel(CHI,2));
     573             : }
     574             : 
     575             : /* G a znstar, L a Conrey log: return a 'mfchar' */
     576             : static GEN
     577       15638 : mfcharGL(GEN G, GEN L) { return mkvec3(G, L, zncharorder(G,L)); }
     578             : static GEN
     579        3241 : mfchartrivial(long N)
     580             : {
     581        3241 :   GEN G = znstar0(utoi(N), 1);
     582        3241 :   GEN L = zerocol(lg(znstar_get_cyc(G))-1);
     583        3241 :   return mkvec3(G, L, gen_1);
     584             : }
     585             : /* convert a generic character into an 'mfchar' */
     586             : static GEN
     587        3409 : get_mfchar(GEN CHI)
     588             : {
     589             :   GEN G, L;
     590        3409 :   if (typ(CHI) != t_VEC)
     591        1260 :     CHI = znchar(CHI);
     592        2149 :   else if (lg(CHI) != 3 || !checkznstar_i(gel(CHI,1)))
     593           0 :     pari_err_TYPE("checkNF [chi]", CHI);
     594        3409 :   G = gel(CHI,1);
     595        3409 :   L = gel(CHI,2); if (typ(L) != t_COL) L = znconreylog(G,L);
     596        3409 :   return mfcharGL(G, L);
     597             : }
     598             : /* parse [N], [N,k], [N,k,CHI]. If 'joker' is set, allow wildcard for CHI */
     599             : static void
     600        7875 : checkNK(GEN NK, long *aN, long *ak, GEN *aCHI, int joker)
     601             : {
     602             :   GEN CHI, T;
     603        7875 :   long l = lg(NK), N, k;
     604        7875 :   if (typ(NK) != t_VEC || l < 3 || l > 4) pari_err_TYPE("checkNK", NK);
     605        7875 :   T = gel(NK,1); if (typ(T) != t_INT) pari_err_TYPE("checkNF [N]", NK);
     606        7875 :   *aN = N = itos(T);
     607        7875 :   T = gel(NK,2); if (typ(T) != t_INT) pari_err_TYPE("checkNF [k]", NK);
     608        7875 :   *ak = k = itos(T);
     609        7875 :   if (l == 3)
     610        1925 :     CHI = mfchartrivial(N);
     611             :   else
     612             :   {
     613             :     long i, l;
     614        5950 :     CHI = gel(NK,3); l = lg(CHI);
     615        5950 :     if (isintzero(CHI) && joker)
     616        1169 :       CHI = NULL; /* all character orbits */
     617        4781 :     else if (isintm1(CHI) && joker > 1)
     618        2142 :       CHI = gen_m1; /* sum over all character orbits */
     619        2751 :     else if ((typ(CHI) == t_VEC &&
     620        1519 :              (l == 1 || l != 3 || !checkznstar_i(gel(CHI,1)))) && joker)
     621             :     {
     622         112 :       CHI = shallowtrans(CHI); /* list of characters */
     623         112 :       for (i = 1; i < l; i++) gel(CHI,i) = get_mfchar(gel(CHI,i));
     624             :     }
     625             :     else
     626             :     {
     627        2527 :       CHI = get_mfchar(CHI); /* single char */
     628        2527 :       if (N % mfcharmodulus(CHI)) pari_err_TYPE("checkNF [chi]", NK);
     629             :     }
     630             :   }
     631        7861 :   *aCHI = CHI;
     632        7861 : }
     633             : 
     634             : static GEN
     635        1715 : mfchargalois(long N, int odd, GEN flagorder)
     636             : {
     637        1715 :   GEN G = znstar0(utoi(N), 1), L = chargalois(G, flagorder);
     638        1715 :   long l = lg(L), i, j;
     639       22316 :   for (i = j = 1; i < l; i++)
     640             :   {
     641       20601 :     GEN chi = znconreyfromchar(G, gel(L,i));
     642       20601 :     if (zncharisodd(G,chi) == odd) gel(L,j++) = mfcharGL(G,chi);
     643             :   }
     644        1715 :   setlg(L, j); return L;
     645             : }
     646             : 
     647             : /* wrappers from mfchar to znchar */
     648             : static long
     649       25956 : mfcharparity(GEN CHI)
     650             : {
     651       25956 :   if (!CHI) return 1;
     652       25956 :   return zncharisodd(gel(CHI,1), gel(CHI,2)) ? -1 : 1;
     653             : }
     654             : /* if CHI is primitive, return CHI itself, not a copy */
     655             : static GEN
     656       57358 : mfchartoprimitive(GEN CHI, long *pF)
     657             : {
     658             :   pari_sp av;
     659             :   GEN G0, chi0, F;
     660       57358 :   if (!CHI) { if (pF) *pF = 1; return mfchartrivial(1); }
     661       57358 :   av = avma; F = znconreyconductor(gel(CHI,1), gel(CHI,2), &chi0);
     662       57358 :   if (typ(F) == t_INT) avma = av;
     663             :   else
     664             :   {
     665       14623 :     G0 = znstar0(F, 1);
     666       14623 :     CHI = gerepilecopy(av, mkvec3(G0, chi0, gmfcharorder(CHI)));
     667             :   }
     668       57358 :   if (pF) *pF = mfcharmodulus(CHI);
     669       57358 :   return CHI;
     670             : }
     671             : static long
     672       40166 : mfcharconductor(GEN CHI)
     673             : {
     674       40166 :   pari_sp ltop = avma;
     675       40166 :   GEN res = znconreyconductor(gel(CHI,1), gel(CHI,2), NULL);
     676             :   long FC;
     677       40166 :   if (typ(res) == t_VEC) res = gel(res, 1);
     678       40166 :   FC = itos(res); avma = ltop; return FC;
     679             : }
     680             : 
     681             : #if 0
     682             : /* let CHI mod N, Q || N, return CHI_Q / CHI_{N/Q} */
     683             : static GEN
     684             : zncharAL(GEN CHI, long Q)
     685             : {
     686             :   GEN G = gel(CHI,1), c = gel(CHI,2);
     687             :   GEN d, P, E, F = znstar_get_faN(G); /* factor(N) */
     688             :   long l = lg(c), N = mfcharmodulus(CHI), i;
     689             : 
     690             :   if (N == Q) return CHI;
     691             :   d = leafcopy(c);
     692             :   P = gel(F,1); /* prime divisors of N */
     693             :   E = gel(F,2); /* exponents */
     694             :   if (equaliu(gel(P,1), 2) && odd(Q) && E[1] >= 3)
     695             :   {
     696             :     gel(d,1) = negi(gel(d,1));
     697             :     gel(d,2) = negi(gel(d,2));
     698             :   }
     699             :   else
     700             :   {
     701             :     for (i = 1; i < l; i++)
     702             :       if (umodui(Q, gel(P,i))) { gel(d,i) = negi(gel(d,i)); break; }
     703             :   }
     704             :   return mkvec3(G, d, gel(CHI,3));
     705             : }
     706             : GEN
     707             : mfcharAL(GEN CHI, long Q)
     708             : {
     709             :   pari_sp ltop = avma;
     710             :   return gerepileupto(ltop, mfchartoprimitive(zncharAL(CHI, Q), NULL));
     711             : }
     712             : #endif
     713             : 
     714             : /* n coprime with the modulus of CHI */
     715             : static GEN
     716       67543 : mfchareval_i(GEN CHI, long n)
     717             : {
     718       67543 :   GEN ordg = gmfcharorder(CHI);
     719       67543 :   long ord = itos(ordg);
     720       67543 :   if (ord == 1) return gen_1;
     721        7294 :   return mygmodulo(znchareval_i(CHI, n, ordg), ord);
     722             : }
     723             : static GEN
     724         357 : mfchareval(GEN CHI, long n)
     725             : {
     726         357 :   long N = mfcharmodulus(CHI);
     727         357 :   return (cgcd(N, n) > 1) ? gen_0 : mfchareval_i(CHI, n);
     728             : }
     729             : /* ordnew a multiple of ord(CHI) or 0 [use ord(CHI)]; n coprime with
     730             :  * char modulus; return CHI(n) in Z[\zeta_ordnew] */
     731             : static long
     732     1571738 : mfcharevalord(GEN CHI, long n, long ordnew)
     733             : {
     734     1571738 :   GEN ordg = gmfcharorder(CHI);
     735     1571738 :   if (equali1(ordg)) return 0;
     736     1134896 :   return znchareval_i(CHI, n, ordnew? utoi(ordnew): ordg);
     737             : }
     738             : 
     739             : static long
     740       12789 : zncharisprimitive(GEN G, GEN chi)
     741             : {
     742       12789 :   pari_sp av = avma;
     743       12789 :   GEN res = znconreyconductor(G, chi, NULL);
     744       12789 :   avma = av; return (typ(res) == t_INT);
     745             : }
     746             : 
     747             : static GEN
     748           0 : mfchardiv_i(GEN CHI1, GEN CHI2)
     749             : {
     750           0 :   GEN G1 = gel(CHI1,1), chi1 = gel(CHI1,2);
     751           0 :   GEN G2 = gel(CHI2,1), chi2 = gel(CHI2,2), G;
     752           0 :   long f1 = itou(znstar_get_N(G1));
     753           0 :   long f2 = itou(znstar_get_N(G2)), f = clcm(f1,f2);
     754             : 
     755           0 :   if      (f == f1) G = G1;
     756           0 :   else if (f == f2) G = G2;
     757           0 :   else G = znstar0(utoipos(f), 1);
     758           0 :   if (f != f1) chi1 = zncharinduce(G1, chi1, G);
     759           0 :   if (f != f2) chi2 = zncharinduce(G2, chi2, G);
     760           0 :   return mfcharGL(G, znchardiv(G, chi1, chi2));
     761             : }
     762             : 
     763             : /*                      Operations on mf closures                    */
     764             : static GEN
     765       38570 : tagparams(long t, GEN NK) { return mkvec2(mkvecsmall(t), NK); }
     766             : static GEN
     767         105 : lfuntag(long t, GEN x) { return mkvec2(mkvecsmall(t), x); }
     768             : static GEN
     769          28 : tag0(long t, GEN NK) { retmkvec(tagparams(t,NK)); }
     770             : static GEN
     771        6503 : tag(long t, GEN NK, GEN x) { retmkvec2(tagparams(t,NK), x); }
     772             : static GEN
     773       25571 : tag2(long t, GEN NK, GEN x, GEN y) { retmkvec3(tagparams(t,NK), x,y); }
     774             : static GEN
     775          14 : tag3(long t, GEN NK, GEN x,GEN y,GEN z) { retmkvec4(tagparams(t,NK), x,y,z); }
     776             : static GEN
     777        6433 : tag4(long t, GEN NK, GEN x, GEN y, GEN z, GEN a)
     778        6433 : { retmkvec5(tagparams(t,NK), x,y,z,a); }
     779             : /* is F a "modular form" ? */
     780             : static long
     781        5558 : isf(GEN F)
     782       11082 : { return typ(F) == t_VEC
     783        5446 :     && lg(F) > 1 && typ(gel(F,1)) == t_VEC
     784        5327 :     && lg(gel(F,1)) == 3
     785        5320 :     && typ(gmael(F,1,1)) == t_VECSMALL
     786       10084 :     && typ(gmael(F,1,2)) == t_VEC; }
     787       99015 : static long f_type(GEN F) { return gmael(F,1,1)[1]; }
     788       64617 : static GEN f_gN(GEN F) { return gmael3(F,1,2,1); }
     789       63077 : static GEN f_gk(GEN F) { return gmael3(F,1,2,2); }
     790       54460 : static long f_N(GEN F) { return itos(f_gN(F)); }
     791       52920 : static long f_k(GEN F) { return itos(f_gk(F)); }
     792       10353 : static GEN f_CHI(GEN F) { return gmael3(F,1,2,3); }
     793        2058 : static GEN f_NK(GEN F) { return gmael(F,1,2); }
     794             : 
     795             : /* UTILITY FUNCTIONS */
     796             : GEN
     797        6083 : mftocol(GEN F, long lim)
     798        6083 : { GEN c = mfcoefs_i(F, lim, 1); settyp(c,t_COL); return c; }
     799             : GEN
     800        2289 : mfvectomat(GEN vF, long lim)
     801             : {
     802        2289 :   long j, l = lg(vF);
     803        2289 :   GEN M = cgetg(l, t_MAT);
     804        2289 :   for (j = 1; j < l; j++) gel(M,j) = mftocol(gel(vF,j), lim);
     805        2289 :   return M;
     806             : }
     807             : 
     808             : static GEN
     809         616 : RgV_to_ser(GEN x, long v)
     810             : {
     811         616 :   long j, lx = lg(x);
     812         616 :   GEN y = cgetg(lx+1, t_SER);
     813         616 :   y[1] = evalvarn(v)|evalvalp(0);
     814         616 :   x--;
     815         616 :   for (j = 2; j <= lx; ++j) gel(y, j) = gel(x, j);
     816         616 :   return normalize(y);
     817             : }
     818             : 
     819             : /* TODO: delete */
     820             : static GEN
     821         616 : mfcoefsser(GEN F, long n, long d) { return RgV_to_ser(mfcoefs_i(F, n,d), 0); }
     822             : 
     823             : static GEN
     824         126 : sertovecslice(GEN S, long n)
     825             : {
     826         126 :   GEN tmp = gtovec0(S, -(lg(S) - 2 + valp(S))), res;
     827         126 :   long i, lt = lg(tmp), n2 = n + 2;
     828         126 :   if (lt < n2) pari_err_BUG("sertovecslice [n too large]");
     829         126 :   if (lt == n2) return tmp;
     830           0 :   res = cgetg(n2, t_VEC);
     831           0 :   for (i = 1; i < n2; ++i) gel(res, i) = gel(tmp, i);
     832           0 :   return res;
     833             : }
     834             : 
     835             : /* a, b two RgV of the same length, multiply as truncated power series */
     836             : static GEN
     837         273 : RgV_mul_RgXn(GEN a, GEN b)
     838             : {
     839         273 :   long n = lg(a)-1;
     840             :   GEN c;
     841         273 :   a = RgV_to_RgX(a,0);
     842         273 :   b = RgV_to_RgX(b,0); c = RgXn_mul(a,b,n);
     843         273 :   c = RgX_to_RgC(c,n); settyp(c,t_VEC); return c;
     844             : }
     845             : static GEN
     846          21 : RgV_pows_RgXn(GEN a, long b)
     847             : {
     848          21 :   long n = lg(a)-1;
     849             :   GEN c;
     850          21 :   a = RgV_to_RgX(a,0);
     851          21 :   if (b < 0) { a = RgXn_inv(a, n); b = -b; }
     852          21 :   c = RgXn_powu_i(a,b,n);
     853          21 :   c = RgX_to_RgC(c,n); settyp(c,t_VEC); return c;
     854             : }
     855             : 
     856             : static GEN
     857         203 : c_mul(long n, long d, GEN F, GEN G)
     858             : {
     859         203 :   pari_sp av = avma;
     860         203 :   long nd = n*d;
     861         203 :   GEN VF = mfcoefs_i(F, nd, 1);
     862         203 :   GEN VG = mfcoefs_i(G, nd, 1);
     863         203 :   return gerepilecopy(av, c_deflate(n, d, RgV_mul_RgXn(VF,VG)));
     864             : }
     865             : static GEN
     866          21 : c_pow(long n, long d, GEN F, GEN a)
     867             : {
     868          21 :   pari_sp av = avma;
     869          21 :   long nd = n*d;
     870          21 :   GEN f = RgV_pows_RgXn(mfcoefs_i(F,nd,1), itos(a));
     871          21 :   return gerepilecopy(av, c_deflate(n, d, f));
     872             : }
     873             : 
     874             : static GEN
     875          14 : c_bracket(long n, long d, GEN F, GEN G, GEN gm)
     876             : {
     877          14 :   pari_sp av = avma;
     878          14 :   long i, nd = n*d;
     879          14 :   GEN VF = mfcoefs_i(F, nd, 1), tF = cgetg(nd+2, t_VEC);
     880          14 :   GEN VG = mfcoefs_i(G, nd, 1), tG = cgetg(nd+2, t_VEC);
     881          14 :   GEN C, mpow, res = NULL;
     882          14 :   ulong j, k = f_k(F), l = f_k(G), m = itos(gm);
     883             :   /* pow[i,j+1] = i^j */
     884          14 :   mpow = cgetg(m+2, t_MAT);
     885          14 :   gel(mpow,1) = const_col(nd, gen_1);
     886          35 :   for (j = 1; j <= m; j++)
     887             :   {
     888          21 :     GEN c = cgetg(nd+1, t_COL);
     889          21 :     gel(mpow,j+1) = c;
     890          21 :     for (i = 1; i <= nd; i++) gel(c,i) = muliu(gcoeff(mpow,i,j), i);
     891             :   }
     892          14 :   C = binomialuu(m+k-1, m);
     893          49 :   for (j = 0; j <= m; j++)
     894             :   { /* C = (-1)^j binom(m+l-1, j) binom(m+k-1,m-j) */
     895             :     GEN c;
     896          35 :     gel(tF,1) = j == 0? gel(VF,1): gen_0;
     897          35 :     gel(tG,1) = j == m? gel(VG,1): gen_0;
     898         217 :     for (i = 1; i <= nd; i++)
     899             :     {
     900         182 :       gel(tF, i+1) = gmul(gcoeff(mpow,i,j+1),   gel(VF, i+1));
     901         182 :       gel(tG, i+1) = gmul(gcoeff(mpow,i,m-j+1), gel(VG, i+1));
     902             :     }
     903          35 :     c = gmul(C, c_deflate(n, d, RgV_mul_RgXn(tF, tG)));
     904          35 :     res = res? gadd(res, c): c;
     905          35 :     if (j < m)
     906             :     {
     907          21 :       C = diviuexact(muliu(C, (m-j+l-1)*(m-j)), (j+1)*(j+k));
     908          21 :       togglesign_safe(&C);
     909             :     }
     910             :   }
     911          14 :   return gerepileupto(av, res);
     912             : }
     913             : /* linear combination \sum L[j] vecF[j] */
     914             : static GEN
     915        2009 : c_linear(long n, long d, GEN F, GEN L)
     916             : {
     917        2009 :   pari_sp av = avma;
     918        2009 :   GEN S = gen_0, con;
     919        2009 :   long j, l = lg(L);
     920        2009 :   if (l == 1) return zerovec(n + 1);
     921        2009 :   L = Q_primitive_part(L, &con);
     922        9919 :   for (j = 1; j < l; ++j)
     923             :   {
     924        7910 :     GEN tmp = gel(L, j);
     925        7910 :     if (!gequal0(tmp)) tmp = gmul(tmp, mfcoefs_i(gel(F, j), n, d));
     926        1806 :     else tmp = zerovec(n + 1);
     927        7910 :     S = j == 1 ? tmp : gadd(S, tmp);
     928             :   }
     929        2009 :   if (con) S = gmul(S, con);
     930        2009 :   return gerepileupto(av, S);
     931             : }
     932             : 
     933             : /* t_MF_BD(t_MF_HECKE(t_MF_NEWTRACE)) or
     934             :  * t_MF_HECKE(t_MF_NEWTRACE)
     935             :  * or t_MF_NEWTRACE in level N */
     936             : static void
     937       45654 : bhn_parse(GEN f, long *N, long *d, long *j, GEN *DATA)
     938             : {
     939       45654 :   long t = f_type(f);
     940       45654 :   *d = *j = 1;
     941       45654 :   if (t == t_MF_BD)
     942             :   {
     943       13454 :     *d = itos(gel(f,2));
     944       13454 :     f = gel(f,3);
     945       13454 :     t = f_type(f);
     946             :   }
     947       45654 :   if (t == t_MF_HECKE)
     948             :   {
     949       27363 :     *j = gel(f,2)[1];
     950       27363 :     f = gel(f,3);
     951             :   }
     952       45654 :   *DATA = gel(f,2);
     953       45654 :   *N = f_N(f);
     954       45654 : }
     955             : static int
     956       23919 : newtrace_stripped(GEN DATA)
     957       23919 : { return lg(DATA) == 4 && typ(gel(DATA, 3)) == t_INT; }
     958             : static GEN
     959       23919 : newtrace_DATA(long N, GEN DATA)
     960       23919 : { return (newtrace_stripped(DATA))? initnewtrace(N, DATA): DATA; }
     961             : /* vF not empty, same hypotheses as bhnmat_extend */
     962             : static GEN
     963        2625 : bhnmat_extend_nocache(GEN M, long n, long d, GEN vF)
     964             : {
     965        2625 :   GEN DATA, f = gel(vF, lg(vF)-1); /* vF[#vF-1] has largest level */
     966             :   long Bd, j, N;
     967             :   cachenew_t cache;
     968        2625 :   bhn_parse(f, &N, &Bd,&j, &DATA);
     969        2625 :   DATA = newtrace_DATA(N, DATA);
     970        2625 :   init_cachenew(&cache, n*d, DATA);
     971        2625 :   M = bhnmat_extend(M, n, d, vF, &cache);
     972        2625 :   dbg_cachenew(&cache);
     973        2625 :   return M;
     974             : }
     975             : /* c_linear of "bhn" mf closures, same hypotheses as bhnmat_extend */
     976             : static GEN
     977         203 : c_linear_bhn(long n, long d, GEN F, GEN L)
     978             : {
     979             :   pari_sp av;
     980             :   GEN M, v;
     981         203 :   if (lg(L) == 1) return zerovec(n+1);
     982         203 :   av = avma;
     983         203 :   M = bhnmat_extend_nocache(NULL, n, d, F);
     984         203 :   v = RgM_RgC_mul(M,L); settyp(v, t_VEC);
     985         203 :   return gerepileupto(av, v);
     986             : }
     987             : 
     988             : /* c in K, K := Q[X]/(T) vz = vector of consecutive powers of root z of T
     989             :  * attached to an embedding s: K -> C. Return s(c) in C */
     990             : static GEN
     991       26733 : Rg_embed(GEN c, GEN vz)
     992             : {
     993       26733 :   long t = typ(c);
     994       26733 :   if (t == t_POLMOD) { c = gel(c,2); t = typ(c); }
     995       26733 :   if (t == t_POL) c = RgX_RgV_eval(c, vz);
     996       26733 :   return c;
     997             : }
     998             : /* return s(P) in C[X] */
     999             : static GEN
    1000           0 : RgX_embed(GEN P, GEN vz)
    1001             : {
    1002             :   long i, l;
    1003           0 :   GEN Q = cgetg_copy(P, &l);
    1004           0 :   Q[1] = P[1];
    1005           0 :   for (i = 2; i < l; i++) gel(Q,i) = Rg_embed(gel(P,i), vz);
    1006           0 :   return normalizepol_lg(Q,l); /* normally a no-op */
    1007             : }
    1008             : /* return s(P) in C^n */
    1009             : static GEN
    1010        1260 : RgC_embed(GEN P, GEN vz)
    1011             : {
    1012             :   long i, l;
    1013        1260 :   GEN Q = cgetg_copy(P, &l);
    1014        1260 :   for (i = 1; i < l; i++) gel(Q,i) = Rg_embed(gel(P,i), vz);
    1015        1260 :   return Q;
    1016             : }
    1017             : /* P in L = K[X]/(U), K = Q[t]/T; s an embedding of K -> C attached
    1018             :  * to a root of T, extended to an embedding of L -> C attached to a root
    1019             :  * of s(U); vT powers of the root of T, vU powers of the root of s(U).
    1020             :  * Return s(P) in C^n */
    1021             : static GEN
    1022           0 : Rg_embed2(GEN P, long vt, GEN vT, GEN vU)
    1023             : {
    1024             :   long i, l;
    1025             :   GEN Q;
    1026           0 :   P = liftpol_shallow(P);
    1027           0 :   if (typ(P) != t_POL) return P;
    1028           0 :   if (varn(P) == vt) return Rg_embed(P, vT);
    1029             :   /* varn(P) == vx */
    1030           0 :   Q = cgetg_copy(P, &l); Q[1] = P[1];
    1031           0 :   for (i = 2; i < l; i++) gel(Q,i) = Rg_embed(gel(P,i), vT);
    1032           0 :   return Rg_embed(Q, vU);
    1033             : }
    1034             : static GEN
    1035           0 : RgC_embed2(GEN P, long vt, GEN vT, GEN vU)
    1036             : {
    1037             :   long i, l;
    1038           0 :   GEN Q = cgetg_copy(P, &l);
    1039           0 :   for (i = 1; i < l; i++) gel(Q,i) = Rg_embed2(gel(P,i), vt, vT, vU);
    1040           0 :   return Q;
    1041             : }
    1042             : 
    1043             : static GEN
    1044          70 : c_embed(long n, long d, GEN F, GEN vz)
    1045             : {
    1046          70 :   pari_sp av = avma;
    1047          70 :   GEN f = mfcoefs_i(F, n, d);
    1048          70 :   return gerepilecopy(av, RgC_embed(f, vz));
    1049             : }
    1050             : static GEN
    1051          98 : c_div(long n, long d, GEN F, GEN G)
    1052             : {
    1053          98 :   pari_sp av = avma;
    1054          98 :   GEN VF = mfcoefsser(F, n, d);
    1055          98 :   GEN VG = mfcoefsser(G, n, d);
    1056          98 :   GEN a0 = polcoeff_i(VG, 0, -1), a0i, H;
    1057          98 :   if (gequal0(a0) || gequal1(a0)) a0 = a0i = NULL;
    1058             :   else
    1059             :   {
    1060          91 :     a0i = ginv(a0);
    1061          91 :     VG = gmul(ser_unscale(VG,a0), a0i);
    1062          91 :     VF = gmul(ser_unscale(VF,a0), a0i);
    1063             :   }
    1064          98 :   H = gdiv(VF, VG);
    1065          98 :   if (a0) H = ser_unscale(H,a0i);
    1066          98 :   return gerepilecopy(av, sertovecslice(H, n));
    1067             : }
    1068             : static GEN
    1069        4102 : c_deflate(long n, long d, GEN V)
    1070             : {
    1071             :   GEN res;
    1072             :   long i;
    1073        4102 :   if (d == 1) return V;
    1074          35 :   res = cgetg(n + 2, t_VEC);
    1075          35 :   for (i = 0; i <= n; ++i) gel(res, i + 1) = gel(V, i*d + 1);
    1076          35 :   return res;
    1077             : }
    1078             : 
    1079             : static GEN
    1080          28 : c_shift(long n, long d, GEN F, GEN gsh)
    1081             : {
    1082          28 :   pari_sp av = avma;
    1083             :   GEN tmp;
    1084          28 :   long sh = itos(gsh), n1 = n*d + sh;
    1085          28 :   if (n1 < 0) return zerovec(n + 1);
    1086          28 :   tmp = mfcoefs_i(F, n1, 1);
    1087          28 :   if (sh < 0) tmp = concat(zerovec(-sh), tmp);
    1088          28 :   else tmp = vecslice(tmp, sh + 1, n1 + 1);
    1089          28 :   return gerepilecopy(av, c_deflate(n, d, tmp));
    1090             : }
    1091             : 
    1092             : static GEN
    1093          21 : c_deriv(long n, long d, GEN F, GEN gm)
    1094             : {
    1095          21 :   pari_sp av = avma;
    1096          21 :   GEN V = mfcoefs_i(F, n, d), res;
    1097          21 :   long i, m = itos(gm);
    1098          21 :   if (m < 0) return c_integ(n, d, F, stoi(-m));
    1099          21 :   if (m == 0) return V;
    1100          21 :   res = cgetg(n+2, t_VEC); gel(res, 1) = gen_0;
    1101          21 :   for (i = 1; i <= n; i++) gel(res, i+1) = gmulsg(upowuu(i,m), gel(V,i+1));
    1102          21 :   return gerepileupto(av, res);
    1103             : }
    1104             : 
    1105             : static GEN
    1106          14 : c_derivE2(long n, long d, GEN F, GEN gm)
    1107             : {
    1108          14 :   pari_sp av = avma;
    1109             :   GEN VF, VE, res, tmp, gk;
    1110          14 :   long i, m = itos(gm), nd;
    1111          14 :   if (m == 0) return mfcoefs_i(F, n, d);
    1112          14 :   nd = n*d;
    1113          14 :   VF = mfcoefs_i(F, nd, 1); VE = mfcoefs_i(mfEk(2), nd, 1);
    1114          14 :   gk = f_gk(F); if (signe(gk) < 0) pari_err_IMPL("mfderivE2 for this form");
    1115          14 :   if (m == 1)
    1116             :   {
    1117           7 :     res = cgetg(n+2, t_VEC);
    1118           7 :     for (i = 0; i <= n; i++) gel(res, i+1) = gmulsg(i, gel(VF, i*d+1));
    1119           7 :     tmp = c_deflate(n, d, RgV_mul_RgXn(VF, VE));
    1120           7 :     return gerepileupto(av, gsub(res, gmul(gdivgs(gk, 12), tmp)));
    1121             :   }
    1122             :   else
    1123             :   {
    1124             :     long j;
    1125          35 :     for (j = 1; j <= m; ++j)
    1126             :     {
    1127          28 :       tmp = RgV_mul_RgXn(VF, VE);
    1128          28 :       for (i = 0; i <= nd; i++) gel(VF, i+1) = gmulsg(i, gel(VF, i+1));
    1129          28 :       VF = gsub(VF, gmul(gdivgs(gaddgs(gk, 2*(j-1)), 12), tmp));
    1130             :     }
    1131           7 :     return gerepilecopy(av, c_deflate(n, d, VF));
    1132             :   }
    1133             : }
    1134             : 
    1135             : static GEN
    1136          14 : c_integ(long n, long d, GEN F, GEN gm)
    1137             : {
    1138          14 :   pari_sp av = avma;
    1139          14 :   GEN V = mfcoefs_i(F, n, d), res;
    1140          14 :   long i, m = itos(gm);
    1141          14 :   if (m < 0) return c_deriv(n, d, F, stoi(-m));
    1142          14 :   if (m == 0) return V;
    1143          14 :   res = cgetg(n + 2, t_VEC); gel(res, 1) = gen_0;
    1144          63 :   for (i = 1; i <= n; ++i)
    1145          49 :     gel(res, i + 1) = gdivgs(gel(V, i + 1), upowuu(i, m));
    1146          14 :   return gerepileupto(av, res);
    1147             : }
    1148             : /* Twist by the character (D/.) */
    1149             : static GEN
    1150          14 : c_twist(long n, long d, GEN F, GEN D)
    1151             : {
    1152          14 :   pari_sp av = avma;
    1153          14 :   GEN V = mfcoefs_i(F, n, d), res = cgetg(n + 2, t_VEC);
    1154             :   long i;
    1155         210 :   for (i = 0; i <= n; ++i)
    1156         196 :     gel(res, i + 1) = gmulsg(krois(D, i), gel(V, i + 1));
    1157          14 :   return gerepileupto(av, res);
    1158             : }
    1159             : 
    1160             : /* form F given by closure, compute T(n)(F) as closure */
    1161             : static GEN
    1162        6573 : c_hecke(long m, long l, GEN nN, GEN F)
    1163             : {
    1164        6573 :   pari_sp av = avma;
    1165        6573 :   return gerepilecopy(av, hecke_i(m, l, nN, F));
    1166             : }
    1167             : static GEN
    1168         119 : c_const(long n, long d, GEN C)
    1169             : {
    1170         119 :   GEN V = zerovec(n+1);
    1171         119 :   long i, j, l = lg(C);
    1172         119 :   if (l > d*n+2) l = d*n+2;
    1173         119 :   for (i = j = 1; i < l; i+=d, j++) gel(V, j) = gcopy(gel(C,i));
    1174         119 :   return V;
    1175             : }
    1176             : 
    1177             : static GEN
    1178         399 : eta3_ZXn(long m)
    1179             : {
    1180         399 :   long l = m+2, n, k;
    1181         399 :   GEN P = cgetg(l,t_POL);
    1182         399 :   P[1] = evalsigne(1)|evalvarn(0);
    1183         399 :   for (n = 2; n < l; n++) gel(P,n) = gen_0;
    1184        2373 :   for (n = k = 0;; n++)
    1185             :   {
    1186        2373 :     k += n; if (k >= m) break;
    1187             :     /* now k = n(n+1) / 2 */
    1188        1974 :     gel(P, k+2) = odd(n)? utoineg(2*n+1): utoipos(2*n+1);
    1189        1974 :   }
    1190         399 :   return P;
    1191             : }
    1192             : 
    1193             : static GEN
    1194         399 : c_delta(long n, long d)
    1195             : {
    1196         399 :   pari_sp ltop = avma;
    1197         399 :   long N = n*d;
    1198         399 :   GEN e = eta3_ZXn(N);
    1199             :   /* FIXME: can't use RgXn_sqr if we want FFT */
    1200         399 :   e = RgXn_red_shallow(ZX_sqr(e), N);
    1201         399 :   e = RgXn_red_shallow(ZX_sqr(e), N);
    1202         399 :   e = RgXn_red_shallow(ZX_sqr(e), N); /* eta(x)^24 */
    1203         399 :   settyp(e, t_VEC);
    1204         399 :   gel(e,1) = gen_0; /* Delta(x) = x*eta(x)^24 as a t_VEC */
    1205         399 :   return gerepilecopy(ltop, c_deflate(n, d, e));
    1206             : }
    1207             : 
    1208             : static GEN
    1209          28 : c_etaquo(long n, long d, GEN eta, GEN gs)
    1210             : {
    1211          28 :   pari_sp av = avma;
    1212          28 :   GEN B = gel(eta,1), E = gel(eta,2), c = gen_1;
    1213          28 :   long i, s = itos(gs), nd = n*d, nds = nd - s + 1, l = lg(B);
    1214          28 :   for (i = 1; i < l; i++) c = gmul(c, gpowgs(eta_inflate_ZXn(nds, B[i]), E[i]));
    1215          28 :   if (s > 0) c = gmul(c, gpowgs(pol_x(0), s));
    1216          28 :   return gerepilecopy(av, c_deflate(n, d, sertovecslice(c, nd)));
    1217             : }
    1218             : 
    1219             : static GEN
    1220          21 : c_cusptrace(long n, long d, GEN F)
    1221             : {
    1222          21 :   GEN D = gel(F,2), res = cgetg(n+2, t_VEC);
    1223          21 :   long i, N = f_N(F), k = f_k(F);
    1224          21 :   gel(res, 1) = gen_0;
    1225         140 :   for (i = 1; i <= n; i++)
    1226         119 :     gel(res, i+1) = mfcusptrace_i(N, k, i*d, mydivisorsu(i*d), D);
    1227          21 :   return res;
    1228             : }
    1229             : 
    1230             : static GEN
    1231        2842 : c_newtrace(long n, long d, GEN F)
    1232             : {
    1233        2842 :   pari_sp av = avma;
    1234             :   cachenew_t cache;
    1235        2842 :   long N = f_N(F);
    1236        2842 :   GEN v, D = newtrace_DATA(N, gel(F,2));
    1237        2842 :   init_cachenew(&cache, n*d, D);
    1238        2842 :   v = colnewtrace(0, n, d, N, f_k(F), &cache);
    1239        2842 :   settyp(v, t_VEC); return gerepilecopy(av, v);
    1240             : }
    1241             : 
    1242             : static GEN
    1243        3619 : c_Bd(long n, long l, GEN D, GEN F)
    1244             : {
    1245        3619 :   pari_sp av = avma;
    1246        3619 :   long d = itou(D), dl = cgcd(d,l), ddl = d/dl, i, j;
    1247        3619 :   GEN w, v = mfcoefs_i(F, n/ddl, l/dl);
    1248        3619 :   if (d == 1) return v;
    1249        3619 :   n++; w = zerovec(n);
    1250        3619 :   for (i = j = 0; j < n; i++, j += ddl) gel(w, j+1) = gcopy(gel(v, i+1));
    1251        3619 :   return gerepileupto(av, w);
    1252             : }
    1253             : 
    1254             : static GEN
    1255           0 : c_heckeU(long n, long l, GEN d, GEN F)
    1256           0 : { return mfcoefs_i(F, n, itos(d)*l); }
    1257             : 
    1258             : static GEN
    1259          14 : c_closure(long n, long d, GEN F)
    1260             : {
    1261             :   GEN v;
    1262          14 :   if (closure_arity(F) == 1)
    1263             :   {
    1264             :     long i;
    1265          14 :     v = cgetg(n+2, t_VEC);
    1266          14 :     for (i = 0; i <= n; i++) gel(v, i+1) = closure_callgen1(F, utoi(i*d));
    1267             :   }
    1268             :   else
    1269             :   {
    1270           0 :     v = closure_callgen2(F, utoi(n), utoi(d));
    1271           0 :     if (typ(v) != t_VEC) pari_err_TYPE("mfcoefs [from closure]",v);
    1272           0 :     if (lg(v) != n+2) pari_err_TYPE("mfcoefs [from closure, wrong dimension]",v);
    1273             :   }
    1274          14 :   return v;
    1275             : }
    1276             : 
    1277             : static GEN
    1278        3318 : c_dihedral(long n, long d, GEN bnr, GEN w, GEN Tinit, GEN k0j)
    1279             : {
    1280        3318 :   pari_sp av = avma;
    1281        3318 :   GEN V = dihan(bnr, w, Tinit, k0j, n*d);
    1282        3318 :   GEN Pm = gel(Tinit,1);
    1283        3318 :   GEN A = c_deflate(n, d, V);
    1284        3318 :   if (degpol(Pm) == 1 || RgX_is_QX(A)) return gerepilecopy(av, A);
    1285         798 :   return gerepileupto(av, gmodulo(A, Pm));
    1286             : }
    1287             : static GEN
    1288          21 : c_reltoabs(long n, long d, GEN F, GEN S)
    1289             : {
    1290          21 :   pari_sp av = avma;
    1291          21 :   GEN T, V = mfcoefs_i(F, n, d);
    1292          21 :   if (typ(S) == t_VEC) /* nf_rnfeq */
    1293             :   {
    1294          14 :     long i, l = lg(V);
    1295          14 :     for (i = 1; i < l; i++) gel(V,i) = eltreltoabs(S,liftpol_shallow(gel(V,i)));
    1296          14 :     T = gel(S,1);
    1297          14 :     V = gerepileupto(av, gmodulo(V, T));
    1298             :   }
    1299          21 :   return V;
    1300             : }
    1301             : 
    1302             : static GEN
    1303        4620 : c_mfeisen(long n, long d, GEN F2, GEN F3)
    1304             : {
    1305        4620 :   GEN v = cgetg(n+2, t_VEC), E0 = gel(F3,1), CHI = gel(F3,2);
    1306        4620 :   long i, k = F2[1];
    1307        4620 :   gel(v, 1) = gcopy(E0); /* E(0) */
    1308        4620 :   if (lg(F3) == 5)
    1309             :   {
    1310        4081 :     long ord = F2[2], j = F2[3];
    1311        4081 :     GEN CHI2 = gel(F3,3), T = gel(F3,4);
    1312        4081 :     for (i = 1; i <= n; i++) gel(v, i+1) = sigchi2(k, CHI, CHI2, i*d, ord);
    1313        4081 :     if (lg(T) == 4) v = QabV_tracerel(T, j, v);
    1314        4081 :     if (lg(T) != 1 && !RgV_is_QV(v)) v = gmodulo(v, gel(T,1));
    1315             :   }
    1316             :   else
    1317             :   {
    1318         539 :     for (i = 1; i <= n; i++) gel(v, i+1) = sigchi(k, CHI, i*d);
    1319             :   }
    1320        4620 :   return v;
    1321             : }
    1322             : 
    1323             : static GEN
    1324           0 : c_mfeisenm1m2(long n, long d, GEN NK, GEN E0)
    1325             : {
    1326           0 :   GEN res = cgetg(n + 2, t_VEC);
    1327           0 :   long i, N = NK[1], k = NK[2], m1 = NK[3], m2 = NK[4];
    1328           0 :   gel(res, 1) = gcopy(E0);
    1329           0 :   for (i = 1; i <= n; ++i) gel(res, i+1) = GammaNsig(N, k, m1, m2, i*d);
    1330           0 :   return res;
    1331             : }
    1332             : 
    1333             : /* Returns vector of coeffs from F[0], F[d], ..., F[d*n] */
    1334             : static GEN
    1335       24430 : mfcoefs_i(GEN F, long n, long d)
    1336             : {
    1337       24430 :   if (n < 0) return gen_0;
    1338       24430 :   switch(f_type(F))
    1339             :   {
    1340         119 :     case t_MF_CONST: return c_const(n, d, gel(F,2));
    1341        4620 :     case t_MF_EISEN: return c_mfeisen(n, d, gel(F,2), gel(F,3));
    1342         371 :     case t_MF_Ek: return c_Ek(n, d, gel(F,2)[1], gel(F,3));
    1343         399 :     case t_MF_DELTA: return c_delta(n, d);
    1344          28 :     case t_MF_ETAQUO: return c_etaquo(n, d, gel(F,2), gel(F,3));
    1345          56 :     case t_MF_ELL: return c_deflate(n, d, concat(gen_0, anell(gel(F,2), n*d)));
    1346         203 :     case t_MF_MUL: return c_mul(n, d, gel(F,2), gel(F,3));
    1347          21 :     case t_MF_POW: return c_pow(n, d, gel(F,2), gel(F,3));
    1348          14 :     case t_MF_BRACKET: return c_bracket(n, d, gel(F,2), gel(F,3), gel(F,4));
    1349        1729 :     case t_MF_LINEAR: return c_linear(n, d, gel(F,2), gel(F,3));
    1350         203 :     case t_MF_LINEAR_BHN: return c_linear_bhn(n, d, gel(F,2), gel(F,3));
    1351          98 :     case t_MF_DIV: return c_div(n, d, gel(F,2), gel(F,3));
    1352          28 :     case t_MF_SHIFT: return c_shift(n, d, gel(F,2), gel(F,3));
    1353          21 :     case t_MF_DERIV: return c_deriv(n, d, gel(F,2), gel(F,3));
    1354          14 :     case t_MF_DERIVE2: return c_derivE2(n, d, gel(F,2), gel(F,3));
    1355          14 :     case t_MF_INTEG: return c_integ(n, d, gel(F,2), gel(F,3));
    1356          70 :     case t_MF_EMBED: return c_embed(n, d, gel(F,2), gel(F,3));
    1357          14 :     case t_MF_TWIST: return c_twist(n, d, gel(F,2), gel(F,3));
    1358        6573 :     case t_MF_HECKE: return c_hecke(n, d, gel(F,2), gel(F,3));
    1359        3619 :     case t_MF_BD: return c_Bd(n, d, gel(F,2), gel(F,3));
    1360          21 :     case t_MF_TRACE: return c_cusptrace(n, d, F);
    1361        2842 :     case t_MF_NEWTRACE: return c_newtrace(n, d, F);
    1362          14 :     case t_MF_CLOSURE: return c_closure(n, d, gel(F,2));
    1363        3318 :     case t_MF_DIHEDRAL: return c_dihedral(n,d,gel(F,2),gel(F,3),gel(F,4),gel(F,5));
    1364          21 :     case t_MF_RELTOABS: return c_reltoabs(n,d,gel(F,2),gel(F,3));
    1365           0 :     case t_MF_EISENM1M2: return c_mfeisenm1m2(n, d, gel(F,2), gel(F,3));
    1366           0 :     case t_MF_HECKEU: return c_heckeU(n, d, gel(F,2), gel(F,3));
    1367           0 :     default: pari_err_TYPE("mfcoefs",F);
    1368           0 :     return NULL;/* not reached */
    1369             :   }
    1370             : }
    1371             : 
    1372             : GEN
    1373        3780 : mfcoefs(GEN F, long n, long d)
    1374             : {
    1375        3780 :   if (!isf(F)) pari_err_TYPE("mfcoefs", F);
    1376        3780 :   if (d <= 0) pari_err_DOMAIN("mfcoefs", "d", "<=", gen_0, stoi(d));
    1377        3780 :   return mfcoefs_i(F, n, d);
    1378             : }
    1379             : 
    1380             : static GEN
    1381         756 : mfak_i(GEN F, long k) { return gel(mfcoefs_i(F, 1, k), 2); }
    1382             : GEN
    1383          28 : mfcoef(GEN F, long n)
    1384             : {
    1385          28 :   pari_sp av = avma;
    1386          28 :   if (!isf(F)) pari_err_TYPE("mfcoef",F);
    1387          28 :   return gerepilecopy(av, mfak_i(F, n));
    1388             : }
    1389             : 
    1390             : static GEN
    1391          63 : unknownNK(void) { return mkNK(-1,-1, gen_0); }
    1392             : static GEN
    1393          21 : mftrivial(void) {
    1394          21 :   GEN f = cgetg(3, t_VEC);
    1395          21 :   gel(f,1) = tagparams(t_MF_CONST, unknownNK());
    1396          21 :   gel(f,2) = cgetg(1,t_VEC); return f;
    1397             : }
    1398             : GEN
    1399          77 : mfcreate0(GEN x, GEN NK)
    1400             : {
    1401          77 :   pari_sp av = avma;
    1402          77 :   long t = typ(x);
    1403          77 :   if (NK)
    1404             :   {
    1405             :      long N, k;
    1406             :      GEN CHI;
    1407           7 :      checkNK(NK, &N, &k, &CHI, 0);
    1408           7 :      NK = mkNK(N, k, CHI);
    1409             :   }
    1410          77 :   if (typ(x) == t_CLOSURE)
    1411             :   {
    1412          28 :     long a = closure_arity(x);
    1413          28 :     if (!NK) NK = unknownNK();
    1414          28 :     if (a == 1 || a == 2)
    1415          28 :       return gerepilecopy(av, tag(t_MF_CLOSURE, NK, x));
    1416             :   }
    1417          49 :   if (gequal0(x)) return mftrivial();
    1418          42 :   if (is_scalar_t(t)) x = mkvec(x);
    1419           7 :   else switch(t)
    1420             :   {
    1421           0 :     case t_VEC: break;
    1422           7 :     case t_POL: x = RgX_to_RgC(x, degpol(x)+1); settyp(x, t_VEC); break;
    1423           0 :     case t_SER: x = sertocol(x); break;
    1424           0 :     default: pari_err_TYPE("mfcreate", x);
    1425             :   }
    1426          42 :   if (!NK) NK = (lg(x) == 2)? mkNK(1,0,mfchartrivial(1)): unknownNK();
    1427          42 :   return gerepilecopy(av, tag(t_MF_CONST, NK, x));
    1428             : }
    1429             : GEN
    1430          28 : mfcreate(GEN x) { return mfcreate0(x, NULL); }
    1431             : 
    1432             : static GEN
    1433        3164 : induce(GEN G, GEN CHI)
    1434             : {
    1435             :   GEN o, chi;
    1436        3164 :   if (typ(CHI) == t_INT) /* Kronecker */
    1437             :   {
    1438          14 :     chi = znchar_quad(G, CHI);
    1439          14 :     o = ZV_equal0(chi)? gen_1: gen_2;
    1440             :   }
    1441             :   else
    1442             :   {
    1443        3150 :     if (mfcharmodulus(CHI) == itos(znstar_get_N(G))) return CHI;
    1444        3080 :     chi = zncharinduce(gel(CHI,1), gel(CHI,2), G);
    1445        3080 :     o = gel(CHI, 3);
    1446             :   }
    1447        3094 :   return mkvec3(G, chi, o);
    1448             : }
    1449             : 
    1450             : static void
    1451        2471 : char2(GEN *pG, GEN *pCHI1, GEN *pCHI2)
    1452             : {
    1453        2471 :   GEN G, G1, G2, N1, N2, CHI1 = *pCHI1, CHI2 = *pCHI2;
    1454        2471 :   G1 = gel(CHI1,1); N1 = znstar_get_N(G1);
    1455        2471 :   G2 = gel(CHI2,1); N2 = znstar_get_N(G2);
    1456        2471 :   if (equalii(N1,N2)) G = G1;
    1457        2268 :   else if (dvdii(N1,N2)) { G = G1; CHI2 = induce(G, CHI2); }
    1458        2114 :   else if (dvdii(N2,N1)) { G = G2; CHI1 = induce(G, CHI1); }
    1459             :   else
    1460             :   {
    1461         749 :     G = znstar0(lcmii(N1,N2), 1);
    1462         749 :     CHI1 = induce(G, CHI1);
    1463         749 :     CHI2 = induce(G, CHI2);
    1464             :   }
    1465        2471 :   *pG = G;
    1466        2471 :   *pCHI1 = CHI1;
    1467        2471 :   *pCHI2 = CHI2;
    1468        2471 : }
    1469             : static GEN
    1470        2240 : mfcharmul(GEN CHI1, GEN CHI2)
    1471             : {
    1472             :   GEN G, CHI3;
    1473        2240 :   if (isintzero(CHI1) || isintzero(CHI2)) return gen_0;
    1474        2240 :   char2(&G, &CHI1, &CHI2);
    1475        2240 :   CHI3 = zncharmul(G, gel(CHI1,2), gel(CHI2,2));
    1476        2240 :   return mkvec3(G, CHI3, zncharorder(G, CHI3));
    1477             : }
    1478             : static GEN
    1479          21 : mfcharpow(GEN CHI, GEN n)
    1480             : {
    1481             :   GEN G;
    1482          21 :   if (isintzero(CHI)) return gen_0;
    1483          21 :   G = gel(CHI,1);
    1484          21 :   CHI = zncharpow(G, gel(CHI,2), n);
    1485          21 :   return mkvec3(G, CHI, zncharorder(G, CHI));
    1486             : }
    1487             : static GEN
    1488         231 : mfchardiv(GEN CHI1, GEN CHI2)
    1489             : {
    1490             :   GEN G, CHI3;
    1491         231 :   if (isintzero(CHI1) || isintzero(CHI2)) return gen_0;
    1492         231 :   char2(&G, &CHI1, &CHI2);
    1493         231 :   CHI3 = znchardiv(G, gel(CHI1, 2), gel(CHI2, 2));
    1494         231 :   return mkvec3(G, CHI3, zncharorder(G, CHI3));
    1495             : }
    1496             : 
    1497             : static GEN
    1498         371 : lcmN(GEN Nf, GEN Ng)
    1499             : {
    1500         371 :   if (signe(Nf) < 0 || signe(Ng) < 0) return gen_m1;
    1501         371 :   return lcmii(Nf, Ng);
    1502             : }
    1503             : static GEN
    1504         294 : opK(GEN kf, GEN kg, GEN (*op)(GEN,GEN))
    1505             : {
    1506         294 :   if (signe(kf) < 0 || signe(kg) < 0) return gen_m1;
    1507         294 :   return op(kf, kg);
    1508             : }
    1509             : 
    1510             : GEN
    1511          49 : mfmul(GEN f, GEN g)
    1512             : {
    1513          49 :   pari_sp av = avma;
    1514             :   GEN N, K, NK;
    1515          49 :   if (!isf(f)) pari_err_TYPE("mfmul",f);
    1516          49 :   if (!isf(g)) pari_err_TYPE("mfmul",g);
    1517          49 :   N = lcmN(f_gN(f), f_gN(g));
    1518          49 :   K = opK(f_gk(f), f_gk(g), &addii);
    1519          49 :   NK = mkgNK(N, K, mfcharmul(f_CHI(f), f_CHI(g)));
    1520          49 :   return gerepilecopy(av, tag2(t_MF_MUL, NK, f, g));
    1521             : }
    1522             : GEN
    1523          21 : mfpow(GEN f, GEN n)
    1524             : {
    1525          21 :   pari_sp av = avma;
    1526             :   GEN kf, KK, NK;
    1527          21 :   if (!isf(f)) pari_err_TYPE("mfpow",f);
    1528          21 :   if (typ(n) != t_INT) pari_err_TYPE("mfpow",n);
    1529          21 :   if (!signe(n)) return mfcreate(gen_1);
    1530          21 :   kf = f_gk(f);
    1531          21 :   KK = signe(kf) < 0? kf: mulii(n,kf);
    1532          21 :   NK = mkgNK(f_gN(f), KK, mfcharpow(f_CHI(f), n));
    1533          21 :   return gerepilecopy(av, tag2(t_MF_POW, NK, f, n));
    1534             : }
    1535             : GEN
    1536          14 : mfbracket(GEN f, GEN g, long m)
    1537             : {
    1538          14 :   pari_sp av = avma;
    1539             :   GEN N, K, NK;
    1540          14 :   if (!isf(f)) pari_err_TYPE("mfbracket",f);
    1541          14 :   if (!isf(g)) pari_err_TYPE("mfbracket",g);
    1542          14 :   K = opK(f_gk(f), f_gk(g), &addii);
    1543          14 :   if (signe(K) < 0) pari_err_IMPL("mfbracket for this form");
    1544          14 :   N = lcmN(f_gN(f), f_gN(g));
    1545          14 :   NK = mkgNK(N, addis(K,2*m), mfcharmul(f_CHI(f), f_CHI(g)));
    1546          14 :   return gerepilecopy(av, tag3(t_MF_BRACKET, NK, f, g, stoi(m)));
    1547             : }
    1548             : 
    1549             : /* remove 0 entries in L */
    1550             : static int
    1551         707 : mflinear_strip(GEN *pF, GEN *pL)
    1552             : {
    1553         707 :   pari_sp av = avma;
    1554         707 :   GEN F = *pF, L = *pL;
    1555         707 :   long i, j, l = lg(L);
    1556         707 :   GEN F2 = cgetg(l, t_VEC), L2 = cgetg(l, t_VEC);
    1557        3108 :   for (i = j = 1; i < l; i++)
    1558             :   {
    1559        2401 :     if (gequal0(gel(L,i))) continue;
    1560        2310 :     gel(F2,j) = gel(F,i);
    1561        2310 :     gel(L2,j) = gel(L,i); j++;
    1562             :   }
    1563         707 :   if (j == l) avma = av;
    1564             :   else
    1565             :   {
    1566          35 :     setlg(F2,j); *pF = F2;
    1567          35 :     setlg(L2,j); *pL = L2;
    1568             :   }
    1569         707 :   return (j > 1);
    1570             : }
    1571             : /* assume F has homogeneous [N,K,CHI] */
    1572             : static GEN
    1573         476 : mflinear_i(GEN F, GEN L)
    1574             : {
    1575         476 :   if (!mflinear_strip(&F,&L)) return mftrivial();
    1576         476 :   return tag2(t_MF_LINEAR, f_NK(gel(F,1)), F,L);
    1577             : }
    1578             : /* assume F has homogeneous [N,K,CHI] */
    1579             : static GEN
    1580         161 : mflinear_bhn(GEN F, GEN L)
    1581             : {
    1582         161 :   if (!mflinear_strip(&F,&L)) return mftrivial();
    1583         161 :   return tag2(t_MF_LINEAR_BHN, f_NK(gel(F,1)), F,L);
    1584             : }
    1585             : GEN
    1586          70 : mflinear(GEN F, GEN L)
    1587             : {
    1588          70 :   pari_sp av = avma;
    1589          70 :   GEN G, FL, NK, N = NULL, K = NULL, CHI = NULL;
    1590          70 :   long i, l = lg(F);
    1591          70 :   if (typ(F) != t_VEC) pari_err_TYPE("mflinear",F);
    1592          70 :   if (typ(L) != t_VEC) pari_err_TYPE("mflinear",L);
    1593          70 :   if (lg(L) != l) pari_err_DIM("mflinear");
    1594          70 :   if (!mflinear_strip(&F,&L)) return mftrivial();
    1595          70 :   l = lg(F);
    1596         217 :   for (i = 1; i < l; i++)
    1597             :   {
    1598         147 :     GEN f = gel(F,i), Ni, Ki;
    1599         147 :     if (!isf(f)) pari_err_TYPE("mflinear", f);
    1600         147 :     Ni = f_gN(f);
    1601         147 :     Ki = f_gk(f);
    1602         147 :     N = N? lcmN(N, Ni): Ni;
    1603         147 :     if (!K) K = Ki; else if (!equalii(K,Ki)) K = gen_m1;
    1604             :   }
    1605          70 :   G = znstar0(N,1);
    1606         210 :   for (i = 1; i < l; i++)
    1607             :   {
    1608         147 :     GEN CHI2 = f_CHI(gel(F,i));
    1609         147 :     if (isintzero(CHI2)) { CHI = gen_0; break; }
    1610         147 :     CHI2 = induce(G, CHI2);
    1611         147 :     if (!CHI) CHI = CHI2; else if (!gequal(CHI, CHI2)) { CHI = gen_0; break; }
    1612             :   }
    1613          70 :   NK = (signe(K) < 0 || isintzero(CHI))? unknownNK(): mkgNK(N, K, CHI);
    1614          70 :   FL = tag2(t_MF_LINEAR, NK, F,L);
    1615          70 :   return gerepilecopy(av, FL);
    1616             : }
    1617             : 
    1618             : /* Non empty linear combination of linear combinations of same, not checked */
    1619             : /* F_j=\sum_i \mu_{i,j}G_i so R = \sum_i (\sum_j(\la_j\mu_{i,j})) G_i */
    1620             : static GEN
    1621         140 : mflinear_linear(GEN F, GEN L)
    1622             : {
    1623         140 :   long l = lg(F), j;
    1624         140 :   GEN vF, M = cgetg(l, t_MAT);
    1625         413 :   for (j = 1; j < l; j++)
    1626             :   {
    1627         273 :     GEN f = gel(F,j), c = gel(f,3);
    1628         273 :     if (typ(c) == t_VEC) c = shallowtrans(c);
    1629         273 :     gel(M,j) = c;
    1630             :   }
    1631         140 :   vF = gmael(F,1,2);
    1632         140 :   return tag2(t_MF_LINEAR, f_NK(gel(vF,1)), vF, RgM_RgC_mul(M,L));
    1633             : }
    1634             : 
    1635             : GEN
    1636          28 : mfshift(GEN F, long sh)
    1637             : {
    1638          28 :   pari_sp av = avma;
    1639          28 :   if (!isf(F)) pari_err_TYPE("mfshift",F);
    1640          28 :   return gerepilecopy(av, tag2(t_MF_SHIFT, f_NK(F), F, stoi(sh)));
    1641             : }
    1642             : long
    1643          84 : mfval(GEN F)
    1644             : {
    1645          84 :   pari_sp ltop = avma;
    1646          84 :   long i = 0, k;
    1647         133 :   for (k = 0; k <= 6; ++k)
    1648             :   {
    1649         126 :     long k2 = 1 << k;
    1650         126 :     GEN tmp = mfcoefs(F, k2, 1);
    1651         595 :     for (; i <= k2; ++i)
    1652         546 :       if (!gequal0(gel(tmp, i + 1))) { avma = ltop; return i; }
    1653             :   }
    1654           7 :   avma = ltop; return 100;
    1655             : }
    1656             : GEN
    1657         231 : mfdiv_val(GEN f, GEN g, long vg)
    1658             : {
    1659             :   GEN N, K, NK;
    1660         231 :   if (vg) { f = mfshift(f,vg); g = mfshift(g,vg); }
    1661         231 :   N = lcmN(f_gN(f), f_gN(g));
    1662         231 :   K = opK(f_gk(f), f_gk(g), &subii);
    1663         231 :   NK = mkgNK(N, K, mfchardiv(f_CHI(f), f_CHI(g)));
    1664         231 :   return tag2(t_MF_DIV, NK, f, g);
    1665             : }
    1666             : GEN
    1667          70 : mfdiv(GEN F, GEN G)
    1668             : {
    1669          70 :   pari_sp av = avma;
    1670          70 :   long vG = mfval(G);
    1671          70 :   if (vG == 100 || (vG && !gequal0(mfcoefs(F, vG-1, 1))))
    1672           0 :     pari_err_DOMAIN("mfdiv", "ord(G)", ">", strtoGENstr("ord(F)"),
    1673             :                     mkvec2(F, G));
    1674          70 :   return gerepilecopy(av, mfdiv_val(F, G, vG));
    1675             : }
    1676             : GEN
    1677          21 : mfderiv(GEN F, long m)
    1678             : {
    1679          21 :   pari_sp av = avma;
    1680             :   GEN NK;
    1681             :   long k;
    1682          21 :   if (!isf(F)) pari_err_TYPE("mfderiv",F);
    1683          21 :   k = f_k(F); if (k >= 0) k += 2*m;
    1684          21 :   NK = mkNK(f_N(F), k, f_CHI(F));
    1685          21 :   return gerepilecopy(av, tag2(t_MF_DERIV, NK, F, stoi(m)));
    1686             : }
    1687             : GEN
    1688          14 : mfderivE2(GEN F, long m)
    1689             : {
    1690          14 :   pari_sp av = avma;
    1691             :   GEN NK;
    1692             :   long k;
    1693          14 :   if (!isf(F)) pari_err_TYPE("mfderivE2",F);
    1694          14 :   if (m < 0) pari_err_DOMAIN("mfderivE2","m","<",gen_0,stoi(m));
    1695          14 :   k = f_k(F); if (k >= 0) k += 2*m;
    1696          14 :   NK = mkNK(f_N(F), k, f_CHI(F));
    1697          14 :   return gerepilecopy(av, tag2(t_MF_DERIVE2, NK, F, stoi(m)));
    1698             : }
    1699             : 
    1700             : GEN
    1701          14 : mfinteg(GEN F, long m)
    1702             : {
    1703          14 :   pari_sp av = avma;
    1704             :   GEN a, NK;
    1705          14 :   if (!isf(F)) pari_err_TYPE("mfinteg",F);
    1706          14 :   a = mfak_i(F, 0);
    1707          14 :   if (!gequal0(a)) pari_err_DOMAIN("mfinteg", "F(0)", "!=", gen_0, a);
    1708          14 :   NK = mkNK(f_N(F), f_k(F)-2*m, f_CHI(F));
    1709          14 :   return gerepilecopy(av, tag2(t_MF_INTEG, NK, F, stoi(m)));
    1710             : }
    1711             : GEN
    1712          14 : mftwist(GEN F, GEN D)
    1713             : {
    1714          14 :   pari_sp av = avma;
    1715             :   GEN NK;
    1716          14 :   if (!isf(F)) pari_err_TYPE("mftwist", F);
    1717          14 :   if (typ(D) != t_INT) pari_err_TYPE("mftwist", D);
    1718          14 :   NK = mkgNK(mulii(f_gN(F), sqri(D)), f_gk(F), f_CHI(F));
    1719          14 :   return gerepilecopy(av, tag2(t_MF_TWIST, NK, F, D));
    1720             : }
    1721             : 
    1722             : /***************************************************************/
    1723             : /*                 Generic cache handling                      */
    1724             : /***************************************************************/
    1725             : enum { cache_FACT, cache_DIV, cache_H, cache_D, cache_DIH };
    1726             : typedef struct {
    1727             :   const char *name;
    1728             :   GEN cache;
    1729             :   ulong minself;
    1730             :   ulong maxself;
    1731             :   void (*init)(long);
    1732             :   ulong miss;
    1733             :   ulong maxmiss;
    1734             : } cache;
    1735             : 
    1736             : static void constdiv(long lim);
    1737             : static void consttabh(long lim);
    1738             : static void consttabdihedral(long lim);
    1739             : static void constcoredisc(long lim);
    1740             : static THREAD cache caches[] = {
    1741             : { "Factors",  NULL,  50000,    50000, &constdiv, 0, 0 },
    1742             : { "Divisors", NULL,  50000,    50000, &constdiv, 0, 0 },
    1743             : { "H",        NULL, 100000, 10000000, &consttabh, 0, 0 },
    1744             : { "CorediscF",NULL, 100000, 10000000, &constcoredisc, 0, 0 },
    1745             : { "Dihedral", NULL,   1000,     3000, &consttabdihedral, 0, 0 },
    1746             : };
    1747             : 
    1748             : static void
    1749         259 : cache_reset(long id) { caches[id].miss = caches[id].maxmiss = 0; }
    1750             : static void
    1751        6004 : cache_delete(long id) { if (caches[id].cache) gunclone(caches[id].cache); }
    1752             : static void
    1753         266 : cache_set(long id, GEN S)
    1754             : {
    1755         266 :   GEN old = caches[id].cache;
    1756         266 :   caches[id].cache = gclone(S);
    1757         266 :   if (old) gunclone(old);
    1758         266 : }
    1759             : 
    1760             : /* handle a cache miss: store stats, possibly reset table; return value
    1761             :  * if (now) cached; return NULL on failure. HACK: some caches contain an
    1762             :  * ulong where the 0 value is impossible, and return it (typecase to GEN) */
    1763             : static GEN
    1764   158837394 : cache_get(long id, ulong D)
    1765             : {
    1766   158837394 :   cache *S = &caches[id];
    1767             :   /* cache_H is compressed: D=0,1 mod 4 */
    1768   158837394 :   const ulong d = (id == cache_H)? D>>1: D;
    1769             :   ulong max, l;
    1770             : 
    1771   158837394 :   if (!S->cache)
    1772             :   {
    1773         140 :     max = maxuu(minuu(D, S->maxself), S->minself);
    1774         140 :     S->init(max);
    1775         140 :     l = lg(S->cache);
    1776             :   }
    1777             :   else
    1778             :   {
    1779   158837254 :     l = lg(S->cache);
    1780   158837254 :     if (l <= d)
    1781             :     {
    1782         714 :       if (D > S->maxmiss) S->maxmiss = D;
    1783         714 :       if (DEBUGLEVEL >= 3)
    1784           0 :         err_printf("miss in cache %s: %lu, max = %lu\n",
    1785             :                    S->name, D, S->maxmiss);
    1786         714 :       if (S->miss++ >= 5 && D < S->maxself)
    1787             :       {
    1788          77 :         max = minuu(S->maxself, (long)(S->maxmiss * 1.2));
    1789          77 :         if (max <= S->maxself)
    1790             :         {
    1791          77 :           if (DEBUGLEVEL >= 3)
    1792           0 :             err_printf("resetting cache %s to %lu\n", S->name, max);
    1793          77 :           S->init(max); l = lg(S->cache);
    1794             :         }
    1795             :       }
    1796             :     }
    1797             :   }
    1798   158837394 :   return (l <= d)? NULL: gel(S->cache, d);
    1799             : }
    1800             : static GEN
    1801           0 : cache_report(long id)
    1802             : {
    1803           0 :   cache *S = &caches[id];
    1804           0 :   GEN v = zerocol(5);
    1805           0 :   gel(v,1) = strtoGENstr(S->name);
    1806           0 :   if (S->cache)
    1807             :   {
    1808           0 :     gel(v,2) = utoi(lg(S->cache)-1);
    1809           0 :     gel(v,3) = utoi(S->miss);
    1810           0 :     gel(v,4) = utoi(S->maxmiss);
    1811           0 :     gel(v,5) = utoi(gsizebyte(S->cache));
    1812             :   }
    1813           0 :   return v;
    1814             : }
    1815             : GEN
    1816           0 : getcache(void)
    1817             : {
    1818           0 :   pari_sp av = avma;
    1819           0 :   GEN M = cgetg(6, t_MAT);
    1820           0 :   gel(M,1) = cache_report(cache_FACT);
    1821           0 :   gel(M,2) = cache_report(cache_DIV);
    1822           0 :   gel(M,3) = cache_report(cache_H);
    1823           0 :   gel(M,4) = cache_report(cache_D);
    1824           0 :   gel(M,5) = cache_report(cache_DIH);
    1825           0 :   return gerepilecopy(av, shallowtrans(M));
    1826             : }
    1827             : 
    1828             : void
    1829        1501 : pari_close_mf(void)
    1830             : {
    1831        1501 :   cache_delete(cache_DIH);
    1832        1501 :   cache_delete(cache_DIV);
    1833        1501 :   cache_delete(cache_FACT);
    1834        1501 :   cache_delete(cache_H);
    1835        1501 : }
    1836             : 
    1837             : /*************************************************************************/
    1838             : static void
    1839          56 : constcoredisc(long lim)
    1840             : {
    1841          56 :   pari_sp av2, av = avma;
    1842          56 :   const long cachestep = 1000; /* don't increase this: RAM cache thrashing */
    1843          56 :   GEN D = caches[cache_D].cache, CACHE = NULL;
    1844          56 :   long cachea, cacheb, N, LIM = !D ? 4 : lg(D)-1;
    1845          56 :   if (lim <= 0) lim = 5;
    1846         112 :   if (lim <= LIM) return;
    1847          56 :   cache_reset(cache_D);
    1848          56 :   D = zero_zv(lim);
    1849          56 :   av2 = avma;
    1850          56 :   cachea = cacheb = 0;
    1851    16234329 :   for (N = 1; N <= lim; ++N)
    1852             :   {
    1853             :     GEN F;
    1854    16234273 :     if (N > cacheb)
    1855             :     { /* update local cache (recycle memory) */
    1856       16184 :       cachea = N;
    1857       16184 :       if (cachea + 2*cachestep > lim)
    1858          56 :         cacheb = lim; /* fuse last 2 chunks */
    1859             :       else
    1860       16128 :         cacheb = cachea + cachestep;
    1861       16184 :       avma = av2; /* FIXME: need only factor odd integers in the range */
    1862       16184 :       CACHE = vecfactoru_i(cachea, cacheb);
    1863             :     }
    1864    16234273 :     F = gel(CACHE,N - cachea + 1); /* factoru(N) */
    1865    16234273 :     D[N] = corediscs_fact(F);
    1866             :   }
    1867          56 :   cache_set(cache_D, D);
    1868          56 :   avma = av;
    1869             : }
    1870             : 
    1871             : static long
    1872   108655092 : indexu(long y, long N)
    1873             : {
    1874   108655092 :   long x = y%N;
    1875   108655092 :   return (x <= 0) ? x + N : x;
    1876             : }
    1877             : 
    1878             : static void
    1879          49 : constdiv(long lim)
    1880             : {
    1881          49 :   pari_sp av = avma;
    1882          49 :   GEN VFACT0, VDIV0, VFACT = caches[cache_FACT].cache;
    1883          49 :   long N, LIM = !VFACT ? 4 : lg(VFACT)-1;
    1884          49 :   if (lim <= 0) lim = 5;
    1885          98 :   if (lim <= LIM) return;
    1886          49 :   cache_reset(cache_FACT);
    1887          49 :   cache_reset(cache_DIV);
    1888          49 :   VFACT0 = vecfactoru_i(1, lim);
    1889          49 :   VDIV0  = cgetg(lim+1, t_VEC);
    1890     2450049 :   for (N = 1; N <= lim; ++N)
    1891             :   {
    1892     2450000 :     GEN fa = gel(VFACT0,N);
    1893     2450000 :     gel(VDIV0, N) = divisorsu_fact(gel(fa,1), gel(fa,2));
    1894             :   }
    1895          49 :   cache_set(cache_FACT, VFACT0);
    1896          49 :   cache_set(cache_DIV, VDIV0); avma = av;
    1897             : }
    1898             : 
    1899             : /* n > 1, D = divisors(n); sets L = 2*lambda(n), S = sigma(n) */
    1900             : static void
    1901     9063342 : lamsig(GEN D, long *pL, long *pS)
    1902             : {
    1903     9063342 :   pari_sp av = avma;
    1904     9063342 :   long i, l = lg(D), L = 1, S = D[l-1]+1;
    1905    33068094 :   for (i = 2; i < l; ++i) /* skip d = 1 */
    1906             :   {
    1907    33068094 :     long d = D[i], nd = D[l-i]; /* nd = n/d */
    1908    33068094 :     if (d < nd) { L += d; S += d + nd; }
    1909             :     else
    1910             :     {
    1911     9063342 :       L <<= 1; if (d == nd) { L += d; S += d; }
    1912     9063342 :       break;
    1913             :     }
    1914             :   }
    1915     9063342 :   avma = av; *pL = L; *pS = S;
    1916     9063342 : }
    1917             : /* table of 6 * Hurwitz class numbers D <= lim */
    1918             : static void
    1919         105 : consttabh(long lim)
    1920             : {
    1921         105 :   pari_sp av = avma;
    1922         105 :   GEN VHDH0, VDIV, CACHE = NULL;
    1923         105 :   GEN VHDH = caches[cache_H].cache;
    1924         105 :   const long cachestep = 1000; /* don't increase this: RAM cache thrashing */
    1925         105 :   long r, N, cachea, cacheb, lim0 = VHDH? lg(VHDH)-1: 2, LIM = lim0 << 1;
    1926             : 
    1927         105 :   if (lim <= 0) lim = 5;
    1928         210 :   if (lim <= LIM) return;
    1929         105 :   cache_reset(cache_H);
    1930         105 :   r = lim&3L; if (r) lim += 4-r;
    1931         105 :   cache_get(cache_DIV, lim);
    1932         105 :   VDIV = caches[cache_DIV].cache;
    1933         105 :   VHDH0 = cgetg_block(lim/2 + 1, t_VECSMALL);
    1934         105 :   VHDH0[1] = 2;
    1935         105 :   VHDH0[2] = 3;
    1936         105 :   for (N = 3; N <= lim0; N++) VHDH0[N] = VHDH[N];
    1937         105 :   cachea = cacheb = 0;
    1938     4531776 :   for (N = LIM + 3; N <= lim; N += 4)
    1939             :   {
    1940     4531671 :     long s = 0, limt = usqrt(N>>2), flsq = 0, ind, t, L, S;
    1941             :     GEN DN, DN2;
    1942     4531671 :     if (N + 2 >= lg(VDIV))
    1943             :     {
    1944             :       GEN F;
    1945     3919269 :       if (N + 2 > cacheb)
    1946             :       { /* update local cache (recycle memory) */
    1947       15643 :         cachea = N;
    1948       15643 :         if (cachea + 2*cachestep > lim)
    1949         105 :           cacheb = lim+2; /* fuse last 2 chunks */
    1950             :         else
    1951       15538 :           cacheb = cachea + cachestep;
    1952       15643 :         avma = av; /* FIXME: need only factor odd integers in the range */
    1953       15643 :         CACHE = vecfactoru_i(cachea, cacheb);
    1954             :       }
    1955             :       /* use local cache */
    1956     3919269 :       F = gel(CACHE,N - cachea + 1); /* factoru(N) */
    1957     3919269 :       DN = divisorsu_fact(gel(F,1), gel(F,2));
    1958     3919269 :       F = gel(CACHE,N - cachea + 3); /* factoru(N+2) */
    1959     3919269 :       DN2 = divisorsu_fact(gel(F,1), gel(F,2));
    1960             :     }
    1961             :     else
    1962             :     { /* use global cache */
    1963      612402 :       DN = gel(VDIV,N);
    1964      612402 :       DN2 = gel(VDIV,N+2);
    1965             :     }
    1966     4531671 :     ind = N >> 1;
    1967  1068829174 :     for (t = 1; t <= limt; ++t)
    1968             :     {
    1969  1064297503 :       ind -= (t<<2)-2; /* N/2 - 2t^2 */
    1970  1064297503 :       if (ind) s += VHDH0[ind]; else flsq = 1;
    1971             :     }
    1972     4531671 :     lamsig(DN, &L,&S);
    1973     4531671 :     VHDH0[N >> 1] = 2*S - 3*L - 2*s + flsq;
    1974     4531671 :     s = 0; flsq = 0; limt = (usqrt(N+2) - 1) >> 1;
    1975     4531671 :     ind = (N+1) >> 1;
    1976  1066581561 :     for (t = 1; t <= limt; ++t)
    1977             :     {
    1978  1062049890 :       ind -= t<<2; /* (N+1)/2 - 2t(t+1) */
    1979  1062049890 :       if (ind) s += VHDH0[ind]; else flsq = 1;
    1980             :     }
    1981     4531671 :     lamsig(DN2, &L,&S);
    1982     4531671 :     VHDH0[(N+1) >> 1] = S - 3*(L >> 1) - s - flsq;
    1983             :   }
    1984         105 :   cache_set(cache_H, VHDH0); avma = av;
    1985             : }
    1986             : 
    1987             : /*************************************************************************/
    1988             : /* Core functions using factorizations, divisors of class numbers caches */
    1989             : /* TODO: myfactoru and factorization cache should be exported */
    1990             : static GEN
    1991    29638777 : myfactoru(long N)
    1992             : {
    1993    29638777 :   GEN z = cache_get(cache_FACT, N);
    1994    29638777 :   if (z) return gcopy(z);
    1995         147 :   return factoru(N);
    1996             : }
    1997             : static GEN
    1998    46279135 : mydivisorsu(long N)
    1999             : {
    2000    46279135 :   GEN z = cache_get(cache_DIV, N);
    2001    46279135 :   if (z) return leafcopy(z);
    2002           7 :   return divisorsu(N);
    2003             : }
    2004             : static long
    2005    43712473 : mycoredisc2u(ulong n, long *pf)
    2006             : {
    2007    43712473 :   ulong D = (ulong)cache_get(cache_D, n);
    2008    43712473 :   if (D) { *pf = usqrt(n/D); return -(long)D; }
    2009         140 :   return mycoredisc2u_i(n, pf);
    2010             : }
    2011             : 
    2012             : /* 1+p+...+p^e, e >= 1 */
    2013             : static ulong
    2014          35 : usumpow(ulong p, long e)
    2015             : {
    2016          35 :   ulong q = 1+p;
    2017             :   long i;
    2018          35 :   for (i = 1; i < e; i++) q = p*q + 1;
    2019          35 :   return q;
    2020             : }
    2021             : /* Hurwitz(D0 F^2)/ Hurwitz(D0)
    2022             :  * = \sum_{f|F}  f \prod_{p|f} (1-kro(D0/p)/p)
    2023             :  * = \prod_{p^e || F} (1 + (p^e-1) / (p-1) * (p-kro(D0/p))) */
    2024             : static long
    2025         245 : get_sh(long F, long D0)
    2026             : {
    2027         245 :   GEN fa = myfactoru(F), P = gel(fa,1), E = gel(fa,2);
    2028         245 :   long i, l = lg(P), t = 1;
    2029         640 :   for (i = 1; i < l; ++i)
    2030             :   {
    2031         395 :     long p = P[i], e = E[i], s = kross(D0,p);
    2032         395 :     if (e == 1) { t *= 1 + p - s; continue; }
    2033         111 :     if (s == 1) { t *= upowuu(p,e); continue; }
    2034          35 :     t *= 1 + usumpow(p,e-1)*(p-s);
    2035             :   }
    2036         245 :   return t;
    2037             : }
    2038             : /* d > 0, d = 0,3 (mod 4). Return 6*hclassno(d); -d must be fundamental
    2039             :  * Faster than quadclassunit up to 5*10^5 or so */
    2040             : static ulong
    2041          35 : hclassno6u_count(ulong d)
    2042             : {
    2043          35 :   ulong a, b, b2, h = 0;
    2044          35 :   int f = 0;
    2045             : 
    2046          35 :   if (d > 500000)
    2047           0 :     return 6 * itou(gel(quadclassunit0(utoineg(d), 0, NULL, 0), 1));
    2048             : 
    2049             :   /* this part would work with -d non fundamental */
    2050          35 :   b = d&1; b2 = (1+d)>>2;
    2051          35 :   if (!b)
    2052             :   {
    2053           0 :     for (a=1; a*a<b2; a++)
    2054           0 :       if (b2%a == 0) h++;
    2055           0 :     f = (a*a==b2); b=2; b2=(4+d)>>2;
    2056             :   }
    2057        7168 :   while (b2*3 < d)
    2058             :   {
    2059        7098 :     if (b2%b == 0) h++;
    2060     1188551 :     for (a=b+1; a*a < b2; a++)
    2061     1181453 :       if (b2%a == 0) h += 2;
    2062        7098 :     if (a*a == b2) h++;
    2063        7098 :     b += 2; b2 = (b*b+d)>>2;
    2064             :   }
    2065          35 :   if (b2*3 == d) return 6*h+2;
    2066          35 :   if (f) return 6*h+3;
    2067          35 :   return 6*h;
    2068             : }
    2069             : /* D > 0; 6 * hclassno(D), using D = D0*F^2 */
    2070             : static long
    2071         280 : hclassno6u_2(ulong D, long D0, long F)
    2072             : {
    2073             :   long h;
    2074         280 :   if (F == 1) h = hclassno6u_count(D);
    2075             :   else
    2076             :   { /* second chance */
    2077         245 :     h = (ulong)cache_get(cache_H, -D0);
    2078         245 :     if (!h) h = hclassno6u_count(-D0);
    2079         245 :     h *= get_sh(F,D0);
    2080             :   }
    2081         280 :   return h;
    2082             : }
    2083             : /* D > 0; 6 * hclassno(D) (6*Hurwitz). Beware, cached value for D (=0,3 mod 4)
    2084             :  * is stored at D>>1 */
    2085             : ulong
    2086      112632 : hclassno6u(ulong D)
    2087             : {
    2088      112632 :   ulong z = (ulong)cache_get(cache_H, D);
    2089             :   long D0, F;
    2090      112632 :   if (z) return z;
    2091         280 :   D0 = mycoredisc2u(D, &F);
    2092         280 :   return hclassno6u_2(D,D0,F);
    2093             : }
    2094             : /* same, where the decomposition D = D0*F^2 is already known */
    2095             : static ulong
    2096    31574739 : hclassno6u_i(ulong D, long D0, long F)
    2097             : {
    2098    31574739 :   ulong z = (ulong)cache_get(cache_H, D);
    2099    31574739 :   if (z) return z;
    2100           0 :   return hclassno6u_2(D,D0,F);
    2101             : }
    2102             : 
    2103             : /* D > 0, return h(-D) [ordinary class number].
    2104             :  * Assume consttabh(D or more) was previously called */
    2105             : static long
    2106     7496552 : hfromH(long D)
    2107             : {
    2108     7496552 :   pari_sp ltop = avma;
    2109     7496552 :   GEN m, d, fa = myfactoru(D), P = gel(fa,1), E = gel(fa,2);
    2110     7496552 :   GEN VH = caches[cache_H].cache;
    2111     7496552 :   long i, nd, S, l = lg(P);
    2112             : 
    2113             :   /* n = d[i] loops through squarefree divisors of f, where f^2 = largest square
    2114             :    * divisor of N = |D|; m[i] = moebius(n) */
    2115     7496552 :   nd = 1 << (l-1);
    2116     7496552 :   d = cgetg(nd+1, t_VECSMALL);
    2117     7496552 :   m = cgetg(nd+1, t_VECSMALL);
    2118     7496552 :   d[1] = 1; S = VH[D >> 1]; /* 6 hclassno(-D) */
    2119     7496552 :   m[1] = 1; nd = 1;
    2120     7496552 :   i = 1;
    2121     7496552 :   if (P[1] == 2 && E[1] <= 3) /* need D/n^2 to be a discriminant */
    2122     3629164 :   { if (odd(E[1]) || (E[1] == 2 && (D & 15) == 4)) i = 2; }
    2123    17812718 :   for (; i<l; i++)
    2124             :   {
    2125    10316166 :     long j, p = P[i];
    2126    10316166 :     if (E[i] == 1) continue;
    2127           0 :     for (j=1; j<=nd; j++)
    2128             :     {
    2129             :       long n, s, hn;
    2130           0 :       d[nd+j] = n = d[j] * p;
    2131           0 :       m[nd+j] = s = - m[j]; /* moebius(n) */
    2132           0 :       hn = VH[(D/(n*n)) >> 1]; /* 6 hclassno(-D/n^2) */
    2133           0 :       if (s > 0) S += hn; else S -= hn;
    2134             :     }
    2135           0 :     nd <<= 1;
    2136             :   }
    2137     7496552 :   avma = ltop; return S/6;
    2138             : }
    2139             : /* D < 0, h(D), ordinary class number */
    2140             : static long
    2141     7496552 : myh(long D)
    2142             : {
    2143     7496552 :   ulong z = (ulong)cache_get(cache_H, -D);
    2144     7496552 :   if (z) return hfromH(-D); /* cache big enough */
    2145           0 :   return itou(quadclassno(stoi(D)));
    2146             : }
    2147             : 
    2148             : /*************************************************************************/
    2149             : /*                          TRACE FORMULAS                               */
    2150             : 
    2151             : /* ceil(m/d) */
    2152             : static long
    2153       99267 : ceildiv(long m, long d)
    2154             : {
    2155             :   long q;
    2156       99267 :   if (!m) return 0;
    2157       39753 :   q = m/d; return m%d? q+1: q;
    2158             : }
    2159             : 
    2160             : /* contribution of scalar matrices in dimension formula */
    2161             : static GEN
    2162      274848 : A1(long N, long k)
    2163      274848 : { return gdivgs(utoi(mypsiu(N) * (k-1)), 12); }
    2164             : static long
    2165        7980 : ceilA1(long N, long k)
    2166        7980 : { return ceildiv(mypsiu(N) * (k-1), 12); }
    2167             : 
    2168             : /* sturm bound, slightly larger than dimension */
    2169             : long
    2170       18459 : mfsturmNk(long N, long k) { return 1 + (mypsiu(N)*k)/12; }
    2171             : 
    2172             : /* List of all solutions of x^2 + x + 1 = 0 modulo N, x modulo N */
    2173             : static GEN
    2174         168 : sqrtm3modN(long N)
    2175             : {
    2176             :   pari_sp av;
    2177         168 :   GEN L = cgetg(1, t_VECSMALL), fa, P, E, res, listchin, listchinneg;
    2178         168 :   long lfa, i, n, ct, fl3 = 0, Ninit;
    2179         168 :   if (!odd(N) || (N%9) == 0) return L;
    2180         154 :   Ninit = N;
    2181         154 :   if ((N%3) == 0) { N /= 3; fl3 = 1; }
    2182         154 :   fa = myfactoru(N); P = gel(fa, 1); E = gel(fa, 2);
    2183         154 :   lfa = lg(P);
    2184         154 :   for (i = 1; i < lfa; ++i) if ((P[i]%3) == 2) return L;
    2185          56 :   listchin = cgetg(lfa, t_VEC); ct = 0;
    2186         112 :   for (i = 1; i < lfa; ++i)
    2187             :   {
    2188          56 :     long p = P[i], e = E[i];
    2189          56 :     GEN tmp = Zp_sqrt(utoineg(3), utoi(p), e);
    2190          56 :     gel(listchin, i) = mkintmod(tmp, powuu(p,e));
    2191             :   }
    2192          56 :   listchinneg = gneg(listchin);
    2193          56 :   ct = 1 << (lfa - 1);
    2194          56 :   res = cgetg(ct + 1, t_VECSMALL);
    2195          56 :   av = avma;
    2196         168 :   for (n = 1; n <= ct; ++n)
    2197             :   {
    2198         112 :     GEN listchintmp = cgetg(lfa, t_VEC);
    2199         112 :     long m = n - 1, rr;
    2200         224 :     for (i = 1; i < lfa; ++i)
    2201             :     {
    2202         112 :       gel(listchintmp, i) = (m&1L) ? gel(listchinneg, i) : gel(listchin, i);
    2203         112 :       m >>= 1;
    2204             :     }
    2205         112 :     rr = itos(lift(chinese1(listchintmp)));
    2206         112 :     avma = av;
    2207         112 :     if (fl3)
    2208          28 :       while (rr%3) rr += N;
    2209         112 :     res[n] = (rr&1L) ? (rr - 1) >> 1 : (rr + Ninit - 1) >> 1;
    2210             :   }
    2211          56 :   return res;
    2212             : }
    2213             : 
    2214             : /* number of elliptic points of order 3 in X0(N) */
    2215             : static long
    2216        8932 : nu3(long N)
    2217             : {
    2218             :   long i, l;
    2219             :   GEN P;
    2220        8932 :   if (!odd(N) || (N%9) == 0) return 0;
    2221        7910 :   if ((N%3) == 0) N /= 3;
    2222        7910 :   P = gel(myfactoru(N), 1); l = lg(P);
    2223        7910 :   for (i = 1; i < l; ++i) if ((P[i]%3) == 2) return 0;
    2224        3416 :   return 1L<<(l-1);
    2225             : }
    2226             : /* number of elliptic points of order 2 in X0(N) */
    2227             : static long
    2228       14959 : nu2(long N)
    2229             : {
    2230             :   long i, l;
    2231             :   GEN P;
    2232       14959 :   if ((N&3L) == 0) return 0;
    2233       14959 :   if (!odd(N)) N >>= 1;
    2234       14959 :   P = gel(myfactoru(N), 1); l = lg(P);
    2235       14959 :   for (i = 1; i < l; ++i) if ((P[i]&3L) == 3) return 0;
    2236        3255 :   return 1L<<(l-1);
    2237             : }
    2238             : 
    2239             : /* contribution of elliptic matrices of order 3 in dimension formula
    2240             :  * Only depends on CHIP the primitive char attached to CHI */
    2241             : static GEN
    2242       33824 : A21(long N, long k, GEN CHI)
    2243             : {
    2244             :   GEN S, res;
    2245             :   long a21, i, limx;
    2246       33824 :   if ((N&1L) == 0) return gen_0;
    2247       17493 :   a21 = k - 1 - 3*(k/3);
    2248       17493 :   if (!a21) return gen_0;
    2249       17353 :   if (N <= 3) return gdivgs(stoi(a21), 3);
    2250        9100 :   if (!CHI) return gdivgs(stoi(nu3(N) * a21), 3);
    2251         168 :   res = sqrtm3modN(N); limx = (N - 1) >> 1;
    2252         168 :   S = gen_0;
    2253         280 :   for (i = 1; i < lg(res); ++i)
    2254             :   {
    2255         112 :     long x = res[i];
    2256         112 :     if (x <= limx)
    2257             :     { /* (x,N) = 1 */
    2258          56 :       GEN c = mfchareval_i(CHI, x);
    2259          56 :       S = gadd(S, gadd(c, gsqr(c)));
    2260             :     }
    2261             :   }
    2262         168 :   S = polcoeff_i(ground(greal(lift(S))), 0, -1);
    2263         168 :   return gdivgs(gmulsg(a21, S), 3);
    2264             : }
    2265             : 
    2266             : /* List of all square roots of -1 modulo N */
    2267             : static GEN
    2268         126 : sqrtm1modN(long N)
    2269             : {
    2270             :   pari_sp av;
    2271         126 :   GEN L = cgetg(1, t_VECSMALL), fa, P, E, res, listchin, listchinneg;
    2272         126 :   long lfa, i, n, ct, fleven = 0;
    2273         126 :   if ((N&3L) == 0) return L;
    2274         126 :   if ((N&1L) == 0) { N >>= 1; fleven = 1; }
    2275         126 :   fa = myfactoru(N); P = gel(fa, 1); E = gel(fa, 2);
    2276         126 :   lfa = lg(P);
    2277         126 :   for (i = 1; i < lfa; ++i) if ((P[i]&3L) == 3) return L;
    2278          21 :   listchin = cgetg(lfa, t_VEC); ct = 0;
    2279          42 :   for (i = 1; i < lfa; ++i)
    2280             :   {
    2281          21 :     long p = P[i], e = E[i];
    2282          21 :     GEN t = Zp_sqrt(gen_m1, utoi(p), e);
    2283          21 :     gel(listchin, i) = mkintmod(t, powuu(p,e));
    2284             :   }
    2285          21 :   listchinneg = gneg(listchin);
    2286          21 :   ct = 1 << (lfa - 1);
    2287          21 :   res = cgetg(ct + 1, t_VECSMALL);
    2288          21 :   av = avma;
    2289          63 :   for (n = 1; n <= ct; ++n)
    2290             :   {
    2291          42 :     GEN listchintmp = cgetg(lfa, t_VEC);
    2292          42 :     long m = n - 1, rr;
    2293          84 :     for (i = 1; i < lfa; ++i)
    2294             :     {
    2295          42 :       gel(listchintmp, i) = (m&1L) ? gel(listchinneg, i) : gel(listchin, i);
    2296          42 :       m >>= 1;
    2297             :     }
    2298          42 :     rr = itos(lift(chinese1(listchintmp)));
    2299          42 :     avma = av;
    2300          42 :     if (fleven && ((rr&1L) == 0)) rr += N;
    2301          42 :     res[n] = rr;
    2302             :   }
    2303          21 :   return res;
    2304             : }
    2305             : 
    2306             : /* contribution of elliptic matrices of order 4 in dimension formula.
    2307             :  * Only depends on CHIP the primitive char attached to CHI */
    2308             : static GEN
    2309       33824 : A22(long N, long k, GEN CHI)
    2310             : {
    2311             :   GEN S, res;
    2312             :   long a22, i, limx;
    2313       33824 :   if ((N&3L) == 0) return gen_0;
    2314       24892 :   a22 = k - 1 - 4*(k/4);
    2315       24892 :   if (!a22) return gen_0;
    2316       24878 :   if (N <= 2) return gdivgs(stoi(a22), 4);
    2317       15211 :   if (!CHI) return gdivgs(stoi(nu2(N)*a22), 4);
    2318         252 :   if (mfcharparity(CHI) == -1) return gen_0;
    2319         126 :   res = sqrtm1modN(N); limx = (N - 1) >> 1;
    2320         126 :   S = gen_0;
    2321         168 :   for (i = 1; i < lg(res); ++i)
    2322             :   { /* (x,N) = 1 */
    2323          42 :     long x = res[i];
    2324          42 :     if (x <= limx) S = gadd(S, mfchareval_i(CHI, x));
    2325             :   }
    2326         126 :   S = polcoeff_i(ground(greal(lift(S))), 0, -1);
    2327         126 :   return gdivgs(gmulsg(a22, S), 2);
    2328             : }
    2329             : 
    2330             : /* sumdiv(N,d,eulerphi(gcd(d,N/d))) */
    2331             : static long
    2332       32431 : nuinf(long N)
    2333             : {
    2334       32431 :   GEN fa = myfactoru(N), P = gel(fa,1), E = gel(fa,2);
    2335       32431 :   long i, t = 1, l = lg(P);
    2336       69461 :   for (i=1; i<l; i++)
    2337             :   {
    2338       37030 :     long p = P[i], e = E[i];
    2339       37030 :     if (odd(e))
    2340       29834 :       t *= upowuu(p,e>>1) << 1;
    2341             :     else
    2342        7196 :       t *= upowuu(p,(e>>1)-1) * (p+1);
    2343             :   }
    2344       32431 :   return t;
    2345             : }
    2346             : 
    2347             : /* contribution of hyperbolic matrices in dimension formula */
    2348             : static GEN
    2349       34013 : A3(long N, long FC)
    2350             : {
    2351             :   long i, S, NF, l;
    2352             :   GEN D;
    2353       34013 :   if (FC == 1) return gdivgs(stoi(nuinf(N)),2);
    2354        1582 :   D = mydivisorsu(N); l = lg(D);
    2355        1582 :   S = 0; NF = N/FC;
    2356       15246 :   for (i = 1; i < l; ++i)
    2357             :   {
    2358       13664 :     long g = cgcd(D[i], D[l-i]);
    2359       13664 :     if (NF%g == 0) S += myeulerphiu(g);
    2360             :   }
    2361        1582 :   return gdivgs(stoi(S), 2);
    2362             : }
    2363             : 
    2364             : /* special contribution in weight 2 in dimension formula */
    2365             : static long
    2366       33831 : A4(long k, long FC)
    2367       33831 : { return (k==2 && FC==1)? 1: 0; }
    2368             : 
    2369             : /* Trace of $T(n)$ on $(S_k(\G_0(N),CHI))$, $k$ integral.
    2370             : One CAN have $\gcd(n,N)>1$. Values of CHI integers or polmods. */
    2371             : 
    2372             : static long
    2373    95361427 : mycgcd(GEN GCD, long N, long x)
    2374    95361427 : { return x < N ? GCD[x + 1] : GCD[x%N + 1]; }
    2375             : /* chi(gcd(x,N)) */
    2376             : static GEN
    2377   128951515 : mychicgcd(GEN GCD, GEN VCHI, long N, long FC, long x)
    2378             : {
    2379   128951515 :   long t = GCD[smodss(x, N) + 1];
    2380   128951515 :   return t == 1 ? gel(VCHI, indexu(x, FC)) : gen_0;
    2381             : }
    2382             : 
    2383             : /* contribution of scalar matrices to trace formula */
    2384             : static GEN
    2385     3405703 : TA1(long N, long k, GEN VCHI, long FC, GEN GCD, long n)
    2386             : {
    2387     3405703 :   pari_sp ltop = avma;
    2388             :   GEN S;
    2389             :   ulong sqn;
    2390     3405703 :   if (!uissquareall(n, &sqn)) return gen_0;
    2391      294749 :   S = mychicgcd(GCD, VCHI, N, FC, sqn);
    2392      294749 :   if (!gequal0(S)) S = gmul(gmul(powuu(sqn, k-2), A1(N, k)), S);
    2393      294749 :   return gerepileupto(ltop, S);
    2394             : }
    2395             : 
    2396             : /* Solutions of x^2 - tx + n = 0 mod N, x mod N */
    2397             : GEN
    2398           0 : sqrtmtnmodN(long N, long t, long n)
    2399             : {
    2400           0 :   pari_sp av, ltop = avma;
    2401           0 :   GEN L = cgetg(1, t_VECSMALL), fa, P, E, res, listchin, listchinneg, listzer;
    2402           0 :   long lfa, i, j, N4 = N << 2, D = smodss(t*t - (n << 2), N4), co = 0, com, NSH = 0;
    2403           0 :   fa = myfactoru(N4); P = gel(fa, 1); E = gel(fa, 2);
    2404           0 :   lfa = lg(P);
    2405           0 :   listchin = cgetg(lfa, t_VEC);
    2406           0 :   listzer = cgetg(lfa, t_VECSMALL);
    2407           0 :   for (i = 1; i < lfa; ++i)
    2408             :   {
    2409           0 :     long p = P[i], a = E[i];
    2410             :     ulong E;
    2411           0 :     long b2, b = u_lvalrem(D, p, &E);
    2412           0 :     if (a <= b)
    2413             :     {
    2414           0 :       gel(listchin, i) = mkintmod(gen_0, powuu(p, (a+1) >> 1));
    2415           0 :       listzer[i] = 0; continue;
    2416             :     }
    2417             :     /* a > b */
    2418           0 :     if (b&1L) return L;
    2419           0 :     if (p > 2)
    2420             :     {
    2421             :       GEN t;
    2422           0 :       if (kross(E, p) == -1) return L;
    2423           0 :       b2 = b >> 1;
    2424           0 :       t = mulii(powuu(p,b2), Zp_sqrt(stoi(E), utoi(p), a-b));
    2425           0 :       gel(listchin, i) = mkintmod(t, powuu(p, a-b2));
    2426           0 :       listzer[i] = 1; co++;
    2427             :     }
    2428             :     else
    2429             :     {
    2430           0 :       long d = a - b;
    2431           0 :       b2 = b >> 1;
    2432           0 :       if (d == 1)
    2433             :       {
    2434           0 :         gel(listchin, i) = mkintmod(int2n(b2), int2n(1+b2));
    2435           0 :         listzer[i] = 0;
    2436             :       }
    2437           0 :       else if (d == 2)
    2438             :       {
    2439           0 :         if ((E&3L) != 1) return L;
    2440           0 :         gel(listchin, i) = mkintmod(int2n(b2), int2n(1+b2));
    2441           0 :         listzer[i] = 0;
    2442             :       }
    2443             :       else
    2444             :       {
    2445             :         GEN t;
    2446           0 :         if ((E&7L) != 1) return L;
    2447           0 :         t = shifti(Z2_sqrt(stoi(E), d), b2);
    2448           0 :         gel(listchin, i) = mkintmod(t, int2n(d-2+b2));
    2449           0 :         if (d == 3) listzer[i] = 0; else { listzer[i] = 1; co++; }
    2450             :       }
    2451             :     }
    2452             :   }
    2453           0 :   listchinneg = gneg(listchin);
    2454           0 :   com = 1 << co;
    2455           0 :   res = cgetg(com + 1, t_VECSMALL);
    2456           0 :   av = avma;
    2457           0 :   for (j = 1; j <= com; ++j)
    2458             :   {
    2459           0 :     GEN listchintmp = cgetg(lfa, t_VEC), gr;
    2460           0 :     long m = j - 1;
    2461           0 :     for (i = 1; i < lfa; ++i)
    2462             :     {
    2463           0 :       if (listzer[i])
    2464             :       {
    2465           0 :         gel(listchintmp, i) = (m&1L) ? gel(listchinneg, i) : gel(listchin, i);
    2466           0 :         m >>= 1;
    2467             :       }
    2468           0 :       else gel(listchintmp, i) = gel(listchin, i);
    2469             :     }
    2470           0 :     gr = chinese1(listchintmp);
    2471           0 :     if (j == 1) NSH = itos(gel(gr, 1));
    2472           0 :     res[j] = itos(lift(gr));
    2473           0 :     avma = av;
    2474             :   }
    2475             :   /* Here res contains all u mod NSH such that u^2 = t^2 - 4n modulo 4N */
    2476           0 :   if ((NSH&1L) == 0) NSH >>= 1;
    2477           0 :   for (j = 1; j <= com; ++j)
    2478           0 :     res[j] = smodss((res[j] + t) >> 1, NSH);
    2479             :   /* Here res contains all x mod NSH such that x^2 - tx + n = 0 modulo N */
    2480           0 :   return gerepilecopy(ltop, mkvec2(stoi(NSH), res));
    2481             : }
    2482             : 
    2483             : /* All square roots modulo 4N, x modulo 2N, precomputed to accelerate TA2 */
    2484             : static GEN
    2485      118594 : mksqr(long N)
    2486             : {
    2487      118594 :   pari_sp av = avma;
    2488      118594 :   long x, N2 = N << 1, N4 = N << 2;
    2489      118594 :   GEN SQRTS = const_vec(N2, cgetg(1, t_VECSMALL));
    2490      118594 :   gel(SQRTS, N2) = mkvecsmall(0); /* x = 0 */
    2491     3509198 :   for (x = 1; x <= N; ++x)
    2492             :   {
    2493     3390604 :     long r = (((x*x - 1)%N4) >> 1) + 1;
    2494     3390604 :     gel(SQRTS, r) = vecsmall_append(gel(SQRTS, r), x);
    2495             :   }
    2496      118594 :   return gerepilecopy(av, SQRTS);
    2497             : }
    2498             : 
    2499             : static GEN
    2500      118594 : mkgcd(long N)
    2501             : {
    2502             :   GEN GCD, d;
    2503             :   long i, N2;
    2504      118594 :   if (N == 1) return mkvecsmall(N);
    2505      101360 :   GCD = cgetg(N + 1, t_VECSMALL);
    2506      101360 :   d = GCD+1; /* GCD[i+1] = d[i] = gcd(i,N) = gcd(N-i,N), i = 0..N-1 */
    2507      101360 :   d[0] = N; d[1] = d[N-1] = 1; N2 = N>>1;
    2508      101360 :   for (i = 2; i <= N2; i++) d[i] = d[N-i] = ugcd(N, i);
    2509      101360 :   return GCD;
    2510             : }
    2511             : 
    2512             : /* Table of \sum_{x^2-tx+n=0 mod Ng}chi(x) for all g dividing gcd(N,F),
    2513             :  * F^2 largest such that (t^2-4n)/F^2=0 or 1 mod 4; t >= 0 */
    2514             : static GEN
    2515    10254727 : mutglistall(long t, long N, long NF, GEN VCHI, long n, GEN MUP, GEN li, long FC, GEN GCD)
    2516             : {
    2517    10254727 :   pari_sp ltop = avma;
    2518    10254727 :   long i, lx = lg(li);
    2519    10254727 :   GEN DNF = mydivisorsu(NF), p2 = zerovec(NF);
    2520    10254727 :   long j, g, lDNF = lg(DNF);
    2521    30177049 :   for (i = 1; i < lx; i++)
    2522             :   {
    2523    19922322 :     long x = (li[i] + t) >> 1, xt = t - x, y, lD;
    2524    19922322 :     GEN D, c = mychicgcd(GCD, VCHI, N, FC, x);
    2525    19922322 :     if (li[i] && li[i] != N)
    2526    13257132 :       c = gadd(c, mychicgcd(GCD, VCHI, N, FC, xt));
    2527    19922322 :     if (isintzero(c)) continue;
    2528    17059028 :     y = (x*(x - t) + n) / N; /* exact division */
    2529    17059028 :     D = mydivisorsu(cgcd(y, NF)); lD = lg(D);
    2530    47830412 :     for (j = 1; j < lD; ++j)
    2531             :     {
    2532    30771384 :       long g = D[j];
    2533    30771384 :       gel(p2, g) = gadd(gel(p2, g), c);
    2534             :     }
    2535             :   }
    2536             :   /* j = 1 corresponds to g = 1, and MUP[1] = 1 */
    2537    27731536 :   for (j = 2; j < lDNF; j++)
    2538             :   {
    2539    17476809 :     g = DNF[j];
    2540    17476809 :     gel(p2, g) = gmulsg(MUP[g], gel(p2, g));
    2541             :   }
    2542    10254727 :   return gerepileupto(ltop, p2);
    2543             : }
    2544             : 
    2545             : /* special case (N,F) = 1: easier */
    2546             : static GEN
    2547    33457466 : mutg1(long t, long N, GEN VCHI, GEN li, long FC, GEN GCD)
    2548             : { /* (N,F) = 1 */
    2549    33457466 :   pari_sp av = avma;
    2550    33457466 :   GEN S = gen_0;
    2551    33457466 :   long i, lx = lg(li);
    2552    70533099 :   for (i = 1; i < lx; i++)
    2553             :   {
    2554    37075633 :     long x = (li[i] + t) >> 1, xt = t - x;
    2555    37075633 :     GEN c = mychicgcd(GCD, VCHI, N, FC, x);
    2556    37075633 :     if (!isintzero(c)) S = gadd(S, c);
    2557    37075633 :     if (li[i] && li[i] != N)
    2558             :     {
    2559    20745368 :       c = mychicgcd(GCD, VCHI, N, FC, xt);
    2560    20745368 :       if (!isintzero(c)) S = gadd(S, c);
    2561             :     }
    2562             :   }
    2563    33457466 :   return gerepileupto(av, S); /* single value */
    2564             : }
    2565             : 
    2566             : /* Gegenbauer pol; n > 2, P = \sum_{0<=j<=n/2} (-1)^j (n-j)!/j!(n-2*j)! X^j */
    2567             : static GEN
    2568      875035 : mfrhopol(long n)
    2569             : {
    2570             : #ifdef LONG_IS_64BIT
    2571      750030 :   const long M = 2642249;
    2572             : #else
    2573      125005 :   const long M = 1629;
    2574             : #endif
    2575      875035 :   long j, d = n >> 1; /* >= 1 */
    2576      875035 :   GEN P = cgetg(d + 3, t_POL);
    2577             : 
    2578      875035 :   if (n > M) pari_err_IMPL("mfrhopol for large weight"); /* avoid overflow */
    2579      875035 :   P[1] = evalvarn(0)|evalsigne(1);
    2580      875035 :   gel(P,2) = gen_1;
    2581      875035 :   gel(P,3) = utoineg(n-1); /* j = 1 */
    2582      875035 :   if (d > 1) gel(P,4) = utoipos(((n-3)*(n-2)) >> 1); /* j = 2 */
    2583      875035 :   if (d > 2) gel(P,5) = utoineg(((n-5)*(n-4)*(n-3)) / 6); /* j = 3 */
    2584      901901 :   for (j = 4; j <= d; ++j)
    2585       26866 :     gel(P,j+2) = divis(mulis(gel(P,j+1), (n-2*j+1)*(n-2*j+2)), (n-j+1)*(-j));
    2586      875035 :   return P;
    2587             : }
    2588             : 
    2589             : /* polrecip(Q)(t2), assume Q(0) = 1 */
    2590             : static GEN
    2591     5434016 : ZXrecip_u_eval(GEN Q, ulong t2)
    2592             : {
    2593     5434016 :   GEN T = addiu(gel(Q,3), t2);
    2594     5434016 :   long l = lg(Q), j;
    2595     5434016 :   for (j = 4; j < l; j++) T = addii(gel(Q,j), mului(t2, T));
    2596     5434016 :   return T;
    2597             : }
    2598             : /* return sh * sqrt(n)^nu * G_nu(t/(2*sqrt(n))) for t != 0
    2599             :  * else (sh/2) * sqrt(n)^nu * G_nu(0) [ implies nu is even ]
    2600             :  * G_nu(z) = \sum_{0<=j<=nu/2} (-1)^j (nu-j)!/j!(nu-2*j)! * (2z)^(nu-2*j)) */
    2601             : static GEN
    2602    39799389 : mfrhopowsimp(GEN Q, GEN sh, long nu, long t, long t2, long n)
    2603             : {
    2604             :   GEN T;
    2605    39799389 :   switch (nu)
    2606             :   {
    2607    34344667 :     case 0: return t? sh: gmul2n(sh,-1);
    2608        1001 :     case 1: return gmulsg(t, sh);
    2609        5481 :     case 2: return t? gmulsg(t2 - n, sh): gmul(gmul2n(stoi(-n), -1), sh);
    2610         371 :     case 3: return gmul(mulss(t, t2 - 2*n), sh);
    2611             :     default:
    2612     5447869 :       if (!t) return gmul(gmul2n(gel(Q, lg(Q) - 1), -1), sh);
    2613     5434016 :       T = ZXrecip_u_eval(Q, t2); if (odd(nu)) T = mulsi(t, T);
    2614     5434016 :       return gmul(T, sh);
    2615             :   }
    2616             : }
    2617             : 
    2618             : /* contribution of elliptic matrices to trace formula */
    2619             : static GEN
    2620     3405703 : TA2(long N, long k, GEN VCHI, long n, GEN SQRTS, GEN MUP, long FC, GEN GCD)
    2621             : {
    2622     3405703 :   pari_sp ltop = avma;
    2623             :   GEN S, Q;
    2624     3405703 :   const long n4 = n << 2, N4 = N << 2, nu = k - 2;
    2625             :   long limt, t;
    2626     3405703 :   const long st = (!odd(N) && odd(n)) ? 2 : 1;
    2627             : 
    2628     3405703 :   limt = usqrt(n4);
    2629     3405703 :   if (limt*limt == n4) limt--;
    2630     3405703 :   Q = nu > 3 ? ZX_z_unscale(mfrhopol(nu), n) : NULL;
    2631     3405703 :   S = gen_0;
    2632    89051858 :   for (t = odd(k)? st: 0; t <= limt; t += st) /* t^2 < 4n */
    2633             :   {
    2634    85646155 :     long t2 = t*t, D = n4 - t2, i, j, F, D0, NF, lDF;
    2635             :     GEN DF, p2, sh, li;
    2636             : 
    2637    85646155 :     li = gel(SQRTS, (smodss(-D - 1, N4) >> 1) + 1);
    2638   131492921 :     if (lg(li) == 1) continue;
    2639    43712193 :     D0 = mycoredisc2u(D, &F);
    2640    43712193 :     NF = mycgcd(GCD, N, F);
    2641    43712193 :     if (NF == 1)
    2642             :     { /* (N,F) = 1 => single value in mutglistall */
    2643    33457466 :       GEN mut = mutg1(t, N, VCHI, li, FC, GCD);
    2644    33457466 :       if (gequal0(mut)) continue;
    2645    31574739 :       sh = gmul(gdivgs(utoipos(hclassno6u_i(D,D0,F)),6), mut);
    2646             :     }
    2647             :     else
    2648             :     {
    2649    10254727 :       sh = gen_0;
    2650    10254727 :       p2 = mutglistall(t, N, NF, VCHI, n, MUP, li, FC, GCD);
    2651    10254727 :       DF = mydivisorsu(F); lDF = lg(DF);
    2652    42338030 :       for (i = 1; i < lDF; ++i)
    2653             :       {
    2654    32083303 :         long Ff, f = DF[i], g = mycgcd(GCD, N, f);
    2655    32083303 :         GEN mut = gel(p2, g);
    2656    32083303 :         if (gequal0(mut)) continue;
    2657    20243104 :         Ff = DF[lDF-i]; /* F/f */
    2658    20243104 :         if (Ff == 1) sh = gadd(sh, mut);
    2659             :         else
    2660             :         {
    2661    15808926 :           GEN P = gel(myfactoru(Ff), 1);
    2662    15808926 :           long lP = lg(P);
    2663    15808926 :           for (j = 1; j < lP; ++j) { long p = P[j]; Ff -= kross(D0, p)*Ff/p; }
    2664    15808926 :           sh = gadd(sh, gmulsg(Ff, mut));
    2665             :         }
    2666             :       }
    2667    10254727 :       if (gequal0(sh)) continue;
    2668     8224650 :       if (D0 == -3) sh = gdivgs(sh, 3);
    2669     7844949 :       else if (D0 == -4) sh = gdivgs(sh, 2);
    2670     7496552 :       else sh = gmulgs(sh, myh(D0));
    2671             :     }
    2672    39799389 :     S = gadd(S, mfrhopowsimp(Q, sh, nu, t, t2, n));
    2673             :   }
    2674     3405703 :   return gerepilecopy(ltop, S);
    2675             : }
    2676             : 
    2677             : /* compute global auxiliary data for TA3 */
    2678             : static GEN
    2679      118594 : mkbez(long N, long FC)
    2680             : {
    2681      118594 :   long ct, i, NF = N/FC;
    2682      118594 :   GEN w, D = mydivisorsu(N);
    2683      118594 :   long l = lg(D);
    2684             : 
    2685      118594 :   w = cgetg(l, t_VEC);
    2686      386421 :   for (i = ct = 1; i < l; ++i)
    2687             :   {
    2688      369187 :     long u, v, h, c = D[i], Nc = D[l-i];
    2689      369187 :     if (c > Nc) break;
    2690      267827 :     h = cbezout(c, Nc, &u, &v);
    2691      267827 :     if (h == 1) /* shortcut */
    2692      166698 :       gel(w, ct++) = mkvecsmall5(1,u*c,v*Nc,1,i);
    2693      101129 :     else if (!(NF%h))
    2694      100954 :       gel(w, ct++) = mkvecsmall5(h,u*c/h,v*Nc/h,myeulerphiu(h),i);
    2695             :   }
    2696      118594 :   setlg(w,ct); stackdummy((pari_sp)(w+ct),(pari_sp)(w+l));
    2697      118594 :   return w;
    2698             : }
    2699             : 
    2700             : /* CHIP primitive */
    2701             : static GEN
    2702       26145 : mkvchip(GEN CHIP)
    2703             : {
    2704       26145 :   long i, N = mfcharmodulus(CHIP);
    2705             :   GEN v;
    2706       26145 :   if (N == 1) return mkvec(gen_1);
    2707        1036 :   v = cgetg(N+1, t_VEC); gel(v,1) = gen_1;
    2708        1036 :   for (i = 2; i < N; ++i) gel(v,i) = ugcd(N,i)==1? mfchareval_i(CHIP,i): gen_0;
    2709        1036 :   gel(v,N) = gen_0; return v;
    2710             : }
    2711             : 
    2712             : GEN
    2713           0 : mfchartovec(GEN CHI)
    2714             : {
    2715           0 :   pari_sp av = avma;
    2716           0 :   return gerepilecopy(av, mkvchip(CHI));
    2717             : }
    2718             : 
    2719             : /* contribution of hyperbolic matrices to trace formula, d * nd = n,
    2720             :  * DN = divisorsu(N) */
    2721             : static GEN
    2722    12751242 : auxsum(long N, GEN VCHI, long FC, GEN GCD, long d, long nd, GEN DN, GEN BEZ)
    2723             : {
    2724    12751242 :   GEN S = gen_0;
    2725    12751242 :   long ct, g = nd - d, lDN = lg(DN), lBEZ = lg(BEZ);
    2726    39468821 :   for (ct = 1; ct < lBEZ; ct++)
    2727             :   {
    2728    26717579 :     GEN y, B = gel(BEZ, ct);
    2729    26717579 :     long ic, iNc, c, Nc, uch, vNch, ph, h = B[1];
    2730    26717579 :     if (g%h) continue;
    2731    26272813 :     uch = B[2];
    2732    26272813 :     vNch= B[3];
    2733    26272813 :     ph  = B[4];
    2734    26272813 :     ic  = B[5]; iNc = lDN - ic;
    2735    26272813 :     c = DN[ic];
    2736    26272813 :     Nc= DN[iNc]; /* Nc = N/c */
    2737    26272813 :     if (cgcd(c, d) == 1 && cgcd(Nc, nd) == 1)
    2738             :     {
    2739    19633964 :       y = mychicgcd(GCD, VCHI, N, FC, d*vNch + nd*uch);
    2740    19633964 :       if (isintzero(y)) y = NULL;
    2741             :     }
    2742             :     else
    2743     6638849 :       y = NULL;
    2744    26272813 :     if (c != Nc && cgcd(c, nd) == 1 && cgcd(Nc, d) == 1)
    2745             :     {
    2746    18022347 :       GEN y2 = mychicgcd(GCD, VCHI, N, FC, d*uch + nd*vNch);
    2747    18022347 :       if (!isintzero(y2)) y = y? gadd(y, y2): y2;
    2748             :     }
    2749    26272813 :     if (y) S = gadd(S, gmulsg(ph, y));
    2750             :   }
    2751    12751242 :   return S;
    2752             : }
    2753             : 
    2754             : static GEN
    2755     3405703 : TA3(long N, long k, GEN VCHI, long FC, GEN GCD, GEN Dn, GEN BEZ)
    2756             : {
    2757     3405703 :   pari_sp av = avma;
    2758     3405703 :   GEN S = gen_0, DN = mydivisorsu(N);
    2759     3405703 :   long i, l = lg(Dn);
    2760    16156945 :   for (i = 1; i < l; ++i)
    2761             :   {
    2762    16109618 :     long d = Dn[i], nd = Dn[l-i]; /* = n/d */
    2763             :     GEN t, u;
    2764    16109618 :     if (d > nd) break;
    2765    12751242 :     t = auxsum(N, VCHI, FC, GCD, d, nd, DN, BEZ);
    2766    12751242 :     if (isintzero(t)) continue;
    2767    12151580 :     u = powuu(d,k-1); if (d == nd) u = gmul2n(u,-1);
    2768    12151580 :     S = gadd(S, gmul(u,t));
    2769             :   }
    2770     3405703 :   return gerepileupto(av, S);
    2771             : }
    2772             : 
    2773             : /* special contribution in weight 2 in trace formula
    2774             :  * Only depends on CHIP the primitive char attached to CHI */
    2775             : static GEN
    2776     3405703 : TA4(long N, long k, GEN CHI, GEN Dn, GEN GCD)
    2777             : {
    2778     3405703 :   pari_sp ltop = avma;
    2779     3405703 :   long i, l, S = 0;
    2780     3405703 :   if (k != 2 || !mfcharistrivial(CHI)) return gen_0;
    2781     2523913 :   l = lg(Dn);
    2782    22089844 :   for (i = 1; i < l; ++i)
    2783             :   {
    2784    19565931 :     long d = Dn[i]; /* gcd(N,n/d) == 1? */
    2785    19565931 :     if (mycgcd(GCD, N, Dn[l-i]) == 1) S += d;
    2786             :   }
    2787     2523913 :   avma = ltop; return utoi(S);
    2788             : }
    2789             : 
    2790             : /* precomputation of products occurring im mutg, again to accelerate TA2 */
    2791             : static GEN
    2792      118594 : mkmup(long N)
    2793             : {
    2794      118594 :   GEN fa = myfactoru(N), P = gel(fa,1), E = gel(fa,2);
    2795      118594 :   GEN D = divisorsu_fact(P,E);
    2796      118594 :   long i, lP = lg(P), lD = lg(D);
    2797      118594 :   GEN MUP = const_vecsmall(N, 0);
    2798      118594 :   MUP[1] = 1;
    2799      505022 :   for (i = 2; i < lD; ++i)
    2800             :   {
    2801      386428 :     long j, g = D[i], Ng = D[lD-i]; /*  N/g */
    2802     1057819 :     for (j = 1; j < lP; ++j)
    2803             :     {
    2804      671391 :       long p = P[j];
    2805      671391 :       if (Ng%p) g = (g/p)*(p+1);
    2806             :     }
    2807      386428 :     MUP[D[i]] = g;
    2808             :   }
    2809      118594 :   return MUP;
    2810             : }
    2811             : 
    2812             : /* CHIP primitive. Determine all cases where newtrace must be zero. Codes:
    2813             :  * [p,-2]: n%p!=1; (only for p = 4 and p = 8).
    2814             :  * [p,-1]: kronecker(n,p)==-1; (only for p odd).
    2815             :  * [p,j], j>=0; n%p==j; (only for j = 0 or p = 4 or p = 8). */
    2816             : static GEN
    2817      118580 : mfnewzerodata(long N, GEN CHIP)
    2818             : {
    2819      118580 :   GEN res, fa = myfactoru(N), P = gel(fa,1), E = gel(fa,2);
    2820      118580 :   long FC = mfcharmodulus(CHIP), i, j, l = lg(P);
    2821      118580 :   res = cgetg(2*l + 8, t_VEC);
    2822      265860 :   for (i = j = 1; i < l; ++i)
    2823             :   {
    2824      147280 :     long p = P[i], e = E[i], c = u_lval(FC, p);
    2825      147280 :     GEN CHIp = c? mfcharp(CHIP,p): NULL;
    2826      147280 :     if (p > 2)
    2827             :     {
    2828       80346 :       long ord = c ? mfcharorder(CHIp) : 1;
    2829       80346 :       if ((e <= 2 && c == 1 && ord == 2) || (e >= 3 && c <= e - 2))
    2830        1904 :         gel(res,j++) = mkvecsmall2(p, -1); /* sc: -p */
    2831       80346 :       if (e >= 2 && c <= e - 1)
    2832        5726 :         gel(res,j++) = mkvecsmall2(p, 0); /* sc: p */
    2833             :     }
    2834             :     else
    2835             :     {
    2836       66934 :       if (e == 1) continue;
    2837             :       /* e >= 2 */
    2838       47551 :       if (c == e - 1)
    2839          35 :         gel(res,j++) = mkvecsmall2(1, 0); /* sc: 1 */
    2840       47551 :       if (e == 2 && c == 2)
    2841         126 :         gel(res,j++) = mkvecsmall2(4, 3); /* sc: -4 */
    2842       47551 :       if ((e == 3 || e == 5) && c == 3)
    2843             :       { /* sc: -8 (CHIp odd) and 8 (CHIp even) */
    2844          28 :         long t = mfcharparity(CHIp) == -1? 7: 3;
    2845          28 :         gel(res,j++) = mkvecsmall2(8, 5);
    2846          28 :         gel(res,j++) = mkvecsmall2(8, t);
    2847             :       }
    2848       47551 :       if ((e == 4 && c == 2) || (e == 5 && c <= 2) || (e == 6 && c <= 2)
    2849       37051 :            || (e >= 7 && c == e - 3))
    2850       10500 :         gel(res,j++) = mkvecsmall2(4, -2); /* sc: 4 */
    2851       47551 :       if ((e <= 4 && c == 0) || (e >= 5 && c == e - 2))
    2852       36778 :         gel(res,j++) = mkvecsmall2(2, 0); /* sc: 2 */
    2853       47551 :       if ((e == 6 && c == 3) || (e >= 7 && c <= e - 4))
    2854          84 :         gel(res,j++) = mkvecsmall2(8, -2); /* sc: -2 */
    2855             :     }
    2856             :   }
    2857      118580 :   setlg(res,j); return res;
    2858             : }
    2859             : 
    2860             : /* if (!VCHIP): from mfcusptrace_i;
    2861             :  * else from initnewtrace and CHI is known to be primitive */
    2862             : static GEN
    2863      118594 : inittrace(long N, GEN CHI, GEN VCHIP)
    2864             : {
    2865             :   GEN CHIP;
    2866             :   long FC;
    2867      118594 :   if (VCHIP)
    2868             :   {
    2869      118580 :     CHIP = CHI;
    2870      118580 :     FC = mfcharmodulus(CHI);
    2871      118580 :     return mkvecn(7, CHIP, mksqr(N), mkmup(N), mkgcd(N),
    2872             :                   VCHIP, mkbez(N, FC), mfnewzerodata(N,CHIP));
    2873             :   }
    2874             :   else
    2875             :   {
    2876          14 :     CHIP = mfchartoprimitive(CHI, &FC);
    2877          14 :     VCHIP = mkvchip(CHIP);
    2878          14 :     return mkvecn(6, CHIP, mksqr(N), mkmup(N), mkgcd(N),
    2879             :                   VCHIP, mkbez(N, FC));
    2880             :   }
    2881             : }
    2882             : /* assume CHIP primitive */
    2883             : static GEN
    2884       26131 : initnewtrace(long N, GEN CHI)
    2885             : {
    2886       26131 :   GEN T = zerovec(N), D, CHIP, VCHIP;
    2887             :   long FC, N1, N2, i, l;
    2888             : 
    2889       26131 :   CHIP = mfchartoprimitive(CHI, &FC);
    2890       26131 :   if (N%FC)
    2891           0 :     pari_err_DOMAIN("mfnewtrace", "N % f(chi)", "!=", gen_0, mkvec2s(N,FC));
    2892       26131 :   VCHIP = mkvchip(CHIP);
    2893       26131 :   N1 = N/FC; newd_params(N1, &N2);
    2894       26131 :   D = mydivisorsu(N1/N2); l = lg(D);
    2895       26131 :   N2 *= FC;
    2896      144711 :   for (i = 1; i < l; i++)
    2897             :   {
    2898      118580 :     long M = D[i]*N2;
    2899      118580 :     gel(T,M) = inittrace(M, CHIP, VCHIP);
    2900             :   }
    2901       26131 :   return T;
    2902             : }
    2903             : 
    2904             : int
    2905        6034 : checkmf_i(GEN mf)
    2906             : {
    2907        6034 :   long l = lg(mf);
    2908             :   GEN v;
    2909        6034 :   if (typ(mf) != t_VEC) return 0;
    2910        6034 :   if (l != 6 && l != 8) return 0;
    2911        1232 :   v = gel(mf,1);
    2912        1232 :   if (typ(v) != t_VEC || lg(v) != 5) return 0;
    2913        2464 :   return typ(gel(v,1)) == t_INT
    2914        1232 :          && typ(gel(v,2)) == t_INT
    2915        1232 :          && typ(gel(v,3)) == t_VEC
    2916        2464 :          && typ(gel(v,4)) == t_INT;
    2917             : }
    2918             : void
    2919         910 : checkmf(GEN mf)
    2920         910 : { if (!checkmf_i(mf)) pari_err_TYPE("checkmf [please use mfinit]", mf); }
    2921             : void
    2922         406 : checkmfsplit(GEN mf)
    2923             : {
    2924         406 :   checkmf(mf);
    2925         406 :   if (lg(mf) != 8) pari_err_TYPE("checkmfsplit [please use mfsplit]", mf);
    2926         406 : }
    2927             : 
    2928             : /* Given an ordered Vecsmall vecn, return the vector of mfmathecke
    2929             :    of its entries. */
    2930             : GEN
    2931          35 : mfmathecke(GEN mf, GEN vecn)
    2932             : {
    2933          35 :   pari_sp ltop = avma;
    2934             :   long lv, lvP, i, N, dim, k;
    2935             :   GEN CHI, vtf, res, vT, FA, B, vP;
    2936             : 
    2937          35 :   checkmf(mf);
    2938          35 :   if (typ(vecn) == t_INT)
    2939             :   {
    2940          28 :     long n = itos(vecn); if (!n) pari_err_TYPE("mfmathecke", vecn);
    2941          28 :     return mfmathecke_i(mf, labs(n));
    2942             :   }
    2943           7 :   N = mf_get_N(mf); dim = mf_get_dim(mf); k = mf_get_k(mf);
    2944           7 :   CHI = mf_get_CHI(mf); vtf = mf_get_vtf(mf);
    2945           7 :   if (typ(vecn) != t_VECSMALL) vecn = gtovecsmall(vecn);
    2946           7 :   lv = lg(vecn);
    2947           7 :   res = cgetg(lv, t_VEC);
    2948           7 :   FA = cgetg(lv, t_VEC);
    2949           7 :   vP = cgetg(lv, t_VEC);
    2950           7 :   vT = const_vec(vecsmall_max(vecn), NULL);
    2951          28 :   for (i = 1; i < lv; ++i)
    2952             :   {
    2953          21 :     long n = vecn[i];
    2954             :     GEN fa;
    2955          21 :     if (n == 1) continue;
    2956          21 :     if (!n) pari_err_TYPE("mfmathecke", vecn);
    2957          21 :     gel(FA, i) = fa = myfactoru(labs(n));
    2958          21 :     gel(vP, i) = gel(fa,1);
    2959             :   }
    2960           7 :   vP = shallowconcat1(vP); vecsmall_sort(vP);
    2961           7 :   vP = vecsmall_uniq_sorted(vP); /* all primes occurring in vecn */
    2962           7 :   lvP = lg(vP);
    2963           7 :   if (lvP != 1 && k == 1 && f_type(gel(vtf,1)) == t_MF_DIV)
    2964           0 :     B = wt1basiscols(mf, vP[lvP-1]);
    2965             :   else
    2966           7 :     B = NULL;
    2967          21 :   for (i = 1; i < lvP; i++)
    2968             :   {
    2969          14 :     long j, e = 1, p = vP[i];
    2970          14 :     GEN Tp, u1, u0 = gen_1;
    2971          14 :     for (j = 1; j < lv; j++) e = maxss(e, z_lval(vecn[j], p));
    2972          14 :     Tp = B? mfmatheckewt1(mf, p, B): mfmathecke_i(mf, p);
    2973          14 :     gel(vT, p) = Tp;
    2974          14 :     if (e > 1)
    2975             :     {
    2976          14 :       GEN fac = (N % p)? gmul(mfchareval_i(CHI,p), powuu(p, k-1)): NULL;
    2977          14 :       long jj, q = p;
    2978          28 :       for (u1=Tp, jj=2; jj <= e; ++jj)
    2979             :       {
    2980          14 :         GEN u2 = gmul(Tp, u1);
    2981          14 :         if (fac) u2 = gsub(u2, gmul(fac, u0));
    2982          14 :         u0 = u1; u1 = u2;
    2983          14 :         q *= p; gel(vT, q) = u1; /* T_q, q = p^jj */
    2984             :       }
    2985             :     }
    2986             :   }
    2987             :   /* vT[p^e] = T_{p^e} for all p^e occurring below */
    2988          28 :   for (i = 1; i < lv; ++i)
    2989             :   {
    2990          21 :     long n = vecn[i], j, lP;
    2991             :     GEN fa, P, E, M;
    2992          21 :     if (n == 1) { gel(res, i) = matid(dim); continue; }
    2993          21 :     fa = gel(FA,i);
    2994          21 :     P = gel(fa,1); lP = lg(P);
    2995          21 :     E = gel(fa,2); M = gen_1;
    2996          21 :     for (j = 1; j < lP; ++j) M = gmul(M, gel(vT, upowuu(P[j], E[j])));
    2997          21 :     gel(res, i) = M;
    2998             :   }
    2999           7 :   return gerepilecopy(ltop, res);
    3000             : }
    3001             : 
    3002             : /* (-1)^k */
    3003             : static long
    3004        5761 : m1pk(long k) { return odd(k)? -1 : 1; }
    3005             : 
    3006             : static long
    3007        5663 : ischarok(long N, long k, GEN CHI)
    3008             : {
    3009        5663 :   if (mfcharparity(CHI) != m1pk(k)) return 0;
    3010        5348 :   if (CHI && N % mfcharconductor(CHI)) return 0;
    3011        5348 :   return 1;
    3012             : }
    3013             : 
    3014             : /* dimension of space of cusp forms S_k(\G_0(N),CHI)
    3015             :  * Only depends on CHIP the primitive char attached to CHI */
    3016             : long
    3017       33684 : mfcuspdim(long N, long k, GEN CHI)
    3018             : {
    3019       33684 :   pari_sp av = avma;
    3020             :   long FC;
    3021             :   GEN s;
    3022       33684 :   if (k <= 0) return 0;
    3023       33684 :   if (k == 1) return mfwt1dim(N, CHI);
    3024       33649 :   FC = CHI? mfcharconductor(CHI): 1;
    3025       33649 :   if (FC == 1) CHI = NULL;
    3026       33649 :   s = gsub(A1(N, k), gadd(A21(N, k, CHI), A22(N, k, CHI)));
    3027       33649 :   s = gadd(s, gsubsg(A4(k, FC), A3(N, FC)));
    3028       33649 :   avma = av; return itos(s);
    3029             : }
    3030             : 
    3031             : /* dimension of whole space M_k(\G_0(N),CHI)
    3032             :  * Only depends on CHIP the primitive char attached to CHI; assumes ischarok */
    3033             : long
    3034         175 : mffulldim(long N, long k, GEN CHI)
    3035             : {
    3036         175 :   pari_sp av = avma;
    3037         175 :   long FC = CHI? mfcharconductor(CHI): 1;
    3038             :   GEN s;
    3039         175 :   if (k <= 0) return (k == 0 && FC == 1)? 1: 0;
    3040         175 :   if (k == 1)
    3041             :   {
    3042           0 :     long dim = itos(A3(N, FC));
    3043           0 :     avma = av; return dim + mfwt1dim(N, CHI);
    3044             :   }
    3045         175 :   if (FC == 1) CHI = NULL;
    3046         175 :   s = gsub(A1(N, k), gadd(A21(N, k, CHI), A22(N, k, CHI)));
    3047         175 :   s = gadd(s, A3(N, FC));
    3048         175 :   avma = av; return itos(s);
    3049             : }
    3050             : 
    3051             : /* Dimension of the space of Eisenstein series */
    3052             : long
    3053         189 : mfeisendim(long N, long k, GEN CHI)
    3054             : {
    3055         189 :   pari_sp av = avma;
    3056         189 :   long s, FC = CHI? mfcharconductor(CHI): 1;
    3057         189 :   if (k <= 0) return (k == 0 && FC == 1)? 1: 0;
    3058         189 :   s = itos(gmul2n(A3(N, FC), 1));
    3059         189 :   if (k > 1) s -= A4(k, FC);
    3060           7 :   else s >>= 1;
    3061         189 :   avma = av; return s;
    3062             : }
    3063             : 
    3064             : /* Trace of T(n) on space of cuspforms; only depends on CHIP the primitive char
    3065             :  * attached to CHI */
    3066             : static GEN
    3067     3405703 : mfcusptrace_i(long N, long k, long n, GEN Dn, GEN S)
    3068             : {
    3069     3405703 :   pari_sp ltop = avma;
    3070             :   GEN tmp1, tmp2, CHIP, VCHIP, GCD;
    3071             :   long FC;
    3072     3405703 :   if (!n) return gen_0;
    3073     3405703 :   CHIP = gel(S,_CHIP);
    3074     3405703 :   VCHIP = gel(S,_VCHIP);
    3075     3405703 :   GCD = gel(S,_GCD);
    3076     3405703 :   FC = mfcharmodulus(CHIP);
    3077     3405703 :   tmp1 = gadd(TA1(N, k, VCHIP, FC, GCD, n), TA4(N, k, CHIP, Dn, GCD));
    3078     3405703 :   tmp2 = TA2(N, k, VCHIP, n, gel(S,_SQRTS), gel(S,_MUP), FC, GCD);
    3079     3405703 :   tmp2 = gadd(tmp2, TA3(N, k, VCHIP, FC, GCD, Dn, gel(S,_BEZ)));
    3080     3405703 :   tmp2 = gsub(tmp1, tmp2);
    3081     3405703 :   return gerepileupto(ltop, tmp2);
    3082             : }
    3083             : 
    3084             : static GEN
    3085     4257722 : mfcusptracecache(long N, long k, long n, GEN Dn, GEN S, cachenew_t *cache)
    3086             : {
    3087     4257722 :   GEN C = NULL, T = gel(cache->vfull,N);
    3088     4257722 :   long lcache = lg(T);
    3089     4257722 :   if (n < lcache) C = gel(T, n);
    3090     4257722 :   if (C) cache->cuspHIT++; else C = mfcusptrace_i(N, k, n, Dn, S);
    3091     4257722 :   cache->cuspTOTAL++;
    3092     4257722 :   if (n < lcache) gel(T,n) = C;
    3093     4257722 :   return C;
    3094             : }
    3095             : 
    3096             : /* p > 2 prime */
    3097             : static long
    3098         147 : mftrconj(long N, long p)
    3099             : {
    3100         147 :   GEN fa = myfactoru(N/p), P = gel(fa,1), E = gel(fa,2);
    3101         147 :   long i, l = lg(P);
    3102         210 :   for (i = 1; i < l; i++)
    3103          63 :     if (E[i] == 1 && kross(-4*p, P[i]) == 1) return 1;
    3104         147 :   return 0;
    3105             : }
    3106             : 
    3107             : /* LZ from mfnewzerodata(N,CHI); returns 1 if newtrace(n) must be zero,
    3108             :  * 0 otherwise (but newtrace(n) may still be zero) */
    3109             : static long
    3110     1404046 : mfnewchkzero(GEN LZ, long n)
    3111             : {
    3112     1404046 :   long i, l = lg(LZ);
    3113     1739500 :   for (i = 1; i < l; i++)
    3114             :   {
    3115      899143 :     GEN V = gel(LZ, i);
    3116      899143 :     long p = V[1], j = V[2];
    3117      899143 :     switch(j)
    3118             :     {
    3119       34293 :       case -1: if (krouu(n, p) == -1) return 1;
    3120       23408 :         break;
    3121      565824 :       case -2: if (n%p != 1) return 1;
    3122      141834 :         break;
    3123      299026 :       default: if (n%p == j) return 1;
    3124      170212 :         break;
    3125             :     }
    3126             :   }
    3127      840357 :   return 0;
    3128             : }
    3129             : 
    3130             : /* return the divisors of n, known to be among the elements of D */
    3131             : static GEN
    3132      297927 : div_restrict(GEN D, ulong n)
    3133             : {
    3134             :   long i, j, l;
    3135      297927 :   GEN v, VDIV = caches[cache_DIV].cache;
    3136      297927 :   if (lg(VDIV) > n) return gel(VDIV,n);
    3137           0 :   l = lg(D);
    3138           0 :   v = cgetg(l, t_VECSMALL);
    3139           0 :   for (i = j = 1; i < l; i++)
    3140             :   {
    3141           0 :     ulong d = D[i];
    3142           0 :     if (n % d == 0) v[j++] = d;
    3143             :   }
    3144           0 :   setlg(v,j); return v;
    3145             : }
    3146             : 
    3147             : /* Trace formula on new space. */
    3148             : static GEN
    3149     1404046 : mfnewtrace_i(long N, long k, long n, cachenew_t *cache)
    3150             : {
    3151     1404046 :   GEN s, Dn, DN1, S = cache->DATA, SN = gel(S,N);
    3152     1404046 :   GEN CHIP = gel(SN, _CHIP), VCHIP = gel(SN, _VCHIP), LZ = gel(SN, _NEWLZ);
    3153             :   long FC, N1, N2, N1N2, g, i, j, lDN1;
    3154             : 
    3155     1404046 :   if (!n) return gen_0;
    3156     1404046 :   FC = mfcharmodulus(CHIP);
    3157     1404046 :   if (mfnewchkzero(LZ, n) ||
    3158      158599 :       (k > 2 && FC==1 && n > 2 && N%n == 0 && uisprime(n) && mftrconj(N, n)))
    3159      563689 :         return gen_0;
    3160      840357 :   N1 = N/FC; newt_params(N1, n, FC, &g, &N2);
    3161      840357 :   N1N2 = N1/N2;
    3162      840357 :   DN1 = mydivisorsu(N1N2); lDN1 = lg(DN1);
    3163      840357 :   N2 *= FC;
    3164      840357 :   Dn = mydivisorsu(n); /* this one is probably out of cache */
    3165      840357 :   s = gmulsg(mubeta2(N1N2,n), mfcusptracecache(N2, k, n, Dn, gel(S,N2), cache));
    3166     3959795 :   for (i = 2; i < lDN1; ++i)
    3167             :   { /* skip M1 = 1, done above */
    3168     3119438 :     long M1 = DN1[i], N1M1 = DN1[lDN1-i];
    3169     3119438 :     GEN Dg = mydivisorsu(cgcd(M1, g));
    3170     3119438 :     M1 *= N2;
    3171     3119438 :     s = gadd(s, gmulsg(mubeta2(N1M1,n),
    3172     3119438 :                        mfcusptracecache(M1, k, n, Dn, gel(S,M1), cache)));
    3173     3417365 :     for (j = 2; j < lg(Dg); ++j) /* skip d = 1, done above */
    3174             :     {
    3175      297927 :       long d = Dg[j], ndd = n/(d*d), M = M1/d;
    3176      297927 :       long mu = mubeta2(N1M1, ndd); /* != 0 */
    3177      297927 :       GEN z = mulsi(mu, powuu(d,k-1)), c = gel(VCHIP,indexu(d,FC)); /* != 0 */
    3178      297927 :       GEN Dndd = div_restrict(Dn, ndd);
    3179      297927 :       s = gadd(s, gmul(gmul(z, c), mfcusptracecache(M, k, ndd, Dndd, gel(S,M), cache)));
    3180             :     }
    3181             :   }
    3182      840357 :   return s;
    3183             : }
    3184             : 
    3185             : /* Only depends on CHIP the primitive char attached to CHI; assumes ischarok */
    3186             : long
    3187       11795 : mfnewdim(long N, long k, GEN CHI)
    3188             : {
    3189       11795 :   pari_sp av = avma;
    3190             :   long FC, N1, N2, i, S, l;
    3191       11795 :   GEN D, CHIP = mfchartoprimitive(CHI, &FC);
    3192             : 
    3193       11795 :   S = mfcuspdim(N, k, CHIP); if (!S) return 0;
    3194        5803 :   N1 = N/FC; newd_params(N1, &N2); /* will ensure mubeta != 0 */
    3195        5803 :   D = mydivisorsu(N1/N2); l = lg(D);
    3196        5803 :   N2 *= FC;
    3197       25088 :   for (i = 2; i < l; ++i)
    3198             :   {
    3199       19285 :     long M = D[l-i]*N2, d = mfcuspdim(M, k, CHIP);
    3200       19285 :     if (d) S += mubeta(D[i]) * d;
    3201             :   }
    3202        5803 :   avma = av; return S;
    3203             : }
    3204             : 
    3205             : /* mfcuspdim(N,k,CHI) - mfnewdim(N,k,CHI) */
    3206             : long
    3207         273 : mfolddim(long N, long k, GEN CHI)
    3208             : {
    3209         273 :   pari_sp av = avma;
    3210             :   long FC, N1, N2, i, S, l;
    3211         273 :   GEN D, CHIP = mfchartoprimitive(CHI, &FC);
    3212             : 
    3213         273 :   N1 = N/FC; newd_params(N1, &N2); /* will ensure mubeta != 0 */
    3214         273 :   D = mydivisorsu(N1/N2); l = lg(D);
    3215         273 :   N2 *= FC; S = 0;
    3216         742 :   for (i = 2; i < l; ++i)
    3217             :   {
    3218         469 :     long M = D[l-i]*N2, d = mfcuspdim(M, k, CHIP);
    3219         469 :     if (d) S -= mubeta(D[i]) * d;
    3220             :   }
    3221         273 :   avma = av; return S;
    3222             : }
    3223             : 
    3224             : /* trace form, given as closure */
    3225             : static GEN
    3226        6398 : mftraceform_new(long N, long k, GEN CHI)
    3227             : {
    3228        6398 :   GEN NK = mkNK(N, k, CHI);
    3229        6398 :   return tag(t_MF_NEWTRACE, NK, initnewtrace(N,CHI)); }
    3230             : static GEN
    3231          14 : mftraceform_cusp(long N, long k, GEN CHI)
    3232             : {
    3233          14 :   GEN NK = mkNK(N, k, CHI);
    3234          14 :   return tag(t_MF_TRACE, NK, inittrace(N,CHI,NULL));
    3235             : }
    3236             : 
    3237             : static GEN
    3238          21 : mftraceform_i(GEN NK, long space)
    3239             : {
    3240             :   GEN CHI;
    3241             :   long N, k;
    3242          21 :   checkNK(NK, &N, &k, &CHI, 0);
    3243          21 :   if (space == mf_FULL)
    3244           0 :     pari_err_DOMAIN("mftraceform", "space", "=", utoi(mf_FULL), NK);
    3245          21 :   if (k == 1) return mfwt1trace_i(N, CHI, space);
    3246          21 :   if (space == mf_NEW) return mftraceform_new(N, k, CHI);
    3247          14 :   return mftraceform_cusp(N, k, CHI);
    3248             : }
    3249             : GEN
    3250          21 : mftraceform(GEN NK, long space)
    3251          21 : { pari_sp av = avma; return gerepilecopy(av, mftraceform_i(NK,space)); }
    3252             : 
    3253             : static GEN
    3254       11277 : hecke_data(long N, long n)
    3255       11277 : { return mkvecsmall3(n, u_ppo(n, N), N); }
    3256             : 
    3257             : static GEN
    3258       16744 : mfhecke_i(long N, long k, GEN CHI, GEN F, long n)
    3259             : {
    3260             :   GEN NK;
    3261       16744 :   if (n == 1) return F;
    3262       11200 :   if (!CHI) CHI = mfchartrivial(N);
    3263       11200 :   NK = mkNK(N, k, CHI);
    3264       11200 :   return tag2(t_MF_HECKE, NK, hecke_data(N,n), F);
    3265             : }
    3266             : 
    3267             : GEN
    3268          14 : mfhecke(GEN F, long n, GEN NK)
    3269             : {
    3270          14 :   pari_sp av = avma;
    3271             :   GEN CHI;
    3272             :   long N, k;
    3273          14 :   if (!NK)
    3274             :   {
    3275          14 :     GEN P = mfparams(F);
    3276          14 :     N = itos(gel(P,1));
    3277          14 :     k = itos(gel(P,2));
    3278          14 :     CHI = gel(P,3);
    3279          14 :     if (N < 0 || k < 0 || isintzero(CHI))
    3280           0 :       pari_err_IMPL("mfhecke for this form");
    3281          14 :     CHI = get_mfchar(CHI);
    3282             :   }
    3283           0 :   else if (!checkmf_i(NK)) checkNK(NK, &N, &k, &CHI, 0);
    3284             :   else
    3285             :   {
    3286           0 :     GEN mf = NK;
    3287           0 :     N = mf_get_N(mf);
    3288           0 :     k = mf_get_k(mf);
    3289           0 :     CHI = mf_get_CHI(mf);
    3290             :   }
    3291          14 :   if (n == 1) return gcopy(F);
    3292          14 :   NK = mkgNK(lcmii(stoi(N), f_gN(F)), stoi(k), CHI);
    3293          14 :   return gerepilecopy(av, tag2(t_MF_HECKE, NK, hecke_data(N,n), F));
    3294             : }
    3295             : 
    3296             : /* form F given by closure, compute B(d)(F) as closure (q -> q^d) */
    3297             : static GEN
    3298       25333 : mfbd_i(GEN F, long d)
    3299             : {
    3300             :   GEN D, NK;
    3301       25333 :   if (d == 1) return F;
    3302        9338 :   if (d <= 0) pari_err_TYPE("mfbd [d <= 0]", stoi(d));
    3303        9338 :   if (f_type(F) != t_MF_BD) D = utoi(d);
    3304           0 :   else { D = mului(d, gel(F,2)); F = gel(F,3); }
    3305        9338 :   NK = mkgNK(muliu(f_gN(F), d), f_gk(F), f_CHI(F));
    3306        9338 :   return tag2(t_MF_BD, NK, D, F);
    3307             : }
    3308             : GEN
    3309          14 : mfbd(GEN F, long d)
    3310             : {
    3311          14 :   pari_sp av = avma;
    3312          14 :   if (!isf(F)) pari_err_TYPE("mfbd",F);
    3313          14 :   return gerepilecopy(av, mfbd_i(F, d));
    3314             : }
    3315             : 
    3316             : static GEN
    3317           0 : mfheckeU_i(GEN F, long d)
    3318             : {
    3319             :   GEN D;
    3320           0 :   if (d == 1) return F;
    3321           0 :   if (d <= 0) pari_err_TYPE("mfheckeU [d <= 0]", stoi(d));
    3322           0 :   if (f_type(F) != t_MF_HECKEU) D = utoi(d);
    3323           0 :   else { D = mului(d, gel(F,2)); F = gel(F,3); }
    3324           0 :   return tag2(t_MF_HECKEU, f_NK(F), D, F);
    3325             : }
    3326             : GEN
    3327           0 : mfheckeU(GEN F, long d)
    3328             : {
    3329           0 :   pari_sp av = avma;
    3330           0 :   if (!isf(F)) pari_err_TYPE("mfheckeU",F);
    3331           0 :   return gerepilecopy(av, mfheckeU_i(F, d));
    3332             : }
    3333             : 
    3334             : static GEN
    3335        4326 : clean(GEN W, GEN M, GEN dM, GEN d, long n, GEN y)
    3336             : {
    3337        4326 :   M = rowslice(M, 1, y[lg(y)-1]);
    3338        4326 :   if (!d) d = gen_1;
    3339        4326 :   if (dM)
    3340             :   {
    3341         378 :     M = RgM_Rg_div(M, dM);
    3342         378 :     W = (n == 1)? ZM_Z_mul(W,dM): RgM_Rg_mul(W,dM);
    3343             :   }
    3344        4326 :   return mkvec3(y, mkvec2(W,d), M);
    3345             : }
    3346             : /* assume M without denominators (stored in dM), lg(M) > 1, full
    3347             :  * column rank; y = indexrank(M)[1], P cyclotomic polynomial of order
    3348             :  * n != 2 mod 4 or NULL */
    3349             : static GEN
    3350        2583 : mfclean2(GEN M, GEN y, GEN P, long n, GEN dM)
    3351             : {
    3352             :   GEN W, d;
    3353        2583 :   W = rowpermute(M, y);
    3354        2583 :   W = P? ZabM_inv(liftpol_shallow(W), P, n, &d): ZM_inv_ratlift(W, &d);
    3355        2583 :   return clean(W,M,dM,d,n,y);
    3356             : }
    3357             : static GEN
    3358        1743 : mfclean(GEN M, long n)
    3359             : {
    3360             :   GEN W, v, y, z, d, dM;
    3361             : 
    3362        1743 :   M = Q_remove_denom(M, &dM);
    3363        1743 :   n = ord_canon(n);
    3364        1743 :   if (n == 1)
    3365        1141 :     W = ZM_pseudoinv(M, &v, &d);
    3366             :   else
    3367             :   {
    3368         602 :     GEN P = polcyclo(n, fetch_user_var("t"));
    3369         602 :     W = ZabM_pseudoinv(liftpol_shallow(M), P, n, &v, &d);
    3370             :   }
    3371        1743 :   y = gel(v,1);
    3372        1743 :   z = gel(v,2); if (lg(z) != lg(M)) M = vecpermute(M,z);
    3373        1743 :   return clean(W,M,dM,d,n,y);
    3374             : }
    3375             : 
    3376             : /* in place, so that lg(v) is unaffected even if < lg(perm) */
    3377             : void
    3378        2562 : vecpermute_inplace(GEN v, GEN perm)
    3379             : {
    3380        2562 :   pari_sp av = avma;
    3381        2562 :   long i, l = lg(perm);
    3382        2562 :   GEN w = cgetg(l,t_VEC);
    3383        2562 :   for (i = 1; i < l; i++) gel(w,i) = gel(v,perm[i]);
    3384        2562 :   for (i = 1; i < l; i++) gel(v,i) = gel(w,i);
    3385        2562 :   avma = av;
    3386        2562 : }
    3387             : 
    3388             : /* initialize a cache of newtrace / cusptrace up to index n */
    3389             : static void
    3390       14154 : init_cachenew(cachenew_t *cache, long n, GEN DATA)
    3391             : {
    3392       14154 :   long i, l = lg(DATA), N = l-1;
    3393       14154 :   GEN v = cgetg(l, t_VEC);
    3394       14154 :   for (i = 1; i < l; i++) gel(v,i) = (N % i)? gen_0: const_vec(n, NULL);
    3395       14154 :   cache->vnew = v;
    3396       14154 :   cache->DATA = DATA;
    3397       14154 :   cache->newHIT = cache->newTOTAL = cache->cuspHIT = cache->cuspTOTAL = 0;
    3398       14154 :   v = cgetg(l, t_VEC);
    3399     1307348 :   for (i = 1; i < l; i++)
    3400     1293194 :     gel(v,i) = (typ(gel(DATA,i)) == t_INT)? gen_0: const_vec(n, NULL);
    3401       14154 :   cache->vfull = v;
    3402       14154 :   cache->VCHIP = gel(gel(DATA,l-1),_VCHIP);
    3403       14154 : }
    3404             : /* reset cachenew for new level incorporating new DATA
    3405             :  * (+ possibly initialize 'full' for new allowed levels) */
    3406             : static void
    3407       12691 : reset_cachenew(cachenew_t *cache, GEN DATA)
    3408             : {
    3409       12691 :   GEN v = gel(cache->vnew,1);
    3410       12691 :   long i, n = lg(v)-1, l = lg(DATA);
    3411       12691 :   cache->DATA = DATA;
    3412       12691 :   v = cache->vfull;
    3413      711991 :   for (i = 1; i < l; i++)
    3414      699300 :     if (typ(gel(v,i)) == t_INT && typ(gel(DATA,i)) != t_INT)
    3415        2044 :       gel(v,i) = const_vec(n, NULL);
    3416       12691 : }
    3417             : static void
    3418       15603 : dbg_cachenew(cachenew_t *C)
    3419             : {
    3420       15603 :   if (DEBUGLEVEL >= 2 && C)
    3421           0 :     err_printf("newtrace cache hits: new = %ld/%ld, cusp = %ld/%ld\n",
    3422             :                     C->newHIT, C->newTOTAL, C->cuspHIT, C->cuspTOTAL);
    3423       15603 : }
    3424             : 
    3425             : /* newtrace_{N,k}(d*i), i = n0, ..., n */
    3426             : static GEN
    3427      109074 : colnewtrace(long n0, long n, long d, long N, long k, cachenew_t *cache)
    3428             : {
    3429      109074 :   GEN v = cgetg(n-n0+2, t_COL);
    3430             :   long i;
    3431     2290953 :   for (i = n0; i <= n; ++i)
    3432     2181879 :     gel(v, i - n0 + 1) = mfnewtracecache(N, k, i*d, cache);
    3433      109074 :   return v;
    3434             : }
    3435             : /* T_n(l*m0, l*(m0+1), ..., l*m) F, F = t_MF_NEWTRACE [N,k],DATA, cache
    3436             :  * contains DATA as well as cached values of F */
    3437             : static GEN
    3438       57974 : heckenewtrace(long m0, long m, long l, long N, long NBIG, long k, long n, cachenew_t *cache)
    3439             : {
    3440       57974 :   long lD, a, k1, FC, nl = n*l;
    3441       57974 :   GEN D, V, v = colnewtrace(m0, m, nl, N, k, cache); /* d=1 */
    3442             :   GEN VCHIP;
    3443       57974 :   if (n == 1) return v;
    3444       39158 :   VCHIP = cache->VCHIP; FC = lg(VCHIP) - 1;
    3445       39158 :   D = mydivisorsu(u_ppo(n, NBIG)); lD = lg(D);
    3446       39158 :   k1 = k - 1;
    3447       87416 :   for (a = 2; a < lD; a++)
    3448             :   { /* d > 1, (d,N) = 1 */
    3449       48258 :     long d = D[a], c = cgcd(l, d), dl = d/c, i, j, m0d;
    3450       48258 :     GEN C = gmul(gel(cache->VCHIP, indexu(d, FC)), powuu(d, k1));
    3451       48258 :     m0d = ceildiv(m0, dl);
    3452             :     /* m0=0: i = 1 => skip F(0) = 0 */
    3453       48258 :     if (!m0) { i = 1; j = dl; } else { i = 0; j = m0d*dl; }
    3454       48258 :     V = colnewtrace(m0d, m/dl, nl/(d*c), N, k, cache);
    3455             :     /* C = chi(d) d^(k-1) */
    3456      390152 :     for (; j <= m; i++, j += dl)
    3457      341894 :       gel(v, j - m0 + 1) = gadd(gel(v, j - m0 + 1), gmul(C, gel(V, i + 1)));
    3458             :   }
    3459       39158 :   return v;
    3460             : }
    3461             : 
    3462             : /* tf a t_MF_NEWTRACE */
    3463             : static GEN
    3464       11452 : tf_get_DATA(GEN tf) { return gel(tf,2); }
    3465             : 
    3466             : /* Given v = an[i], return an[d*i] */
    3467             : static GEN
    3468         336 : anextract(GEN v, long n, long d)
    3469             : {
    3470         336 :   GEN w = cgetg(n + 2, t_VEC);
    3471             :   long i;
    3472         336 :   for (i = 0; i <= n; ++i) gel(w, i + 1) = gel(v, i*d + 1);
    3473         336 :   return w;
    3474             : }
    3475             : /* T_n(F)(0, l, ..., l*m) */
    3476             : static GEN
    3477        6832 : hecke_i(long m, long l, GEN DATA, GEN F)
    3478             : {
    3479        6832 :   long k = f_k(F), n = DATA[1], nN = DATA[2], NBIG = DATA[3];
    3480        6832 :   long lD, M, a, t, nl = n*l;
    3481             :   GEN D, v, AN, CHI;
    3482        6832 :   if (nN == 1) return mfcoefs_i(F,m,nl);
    3483        5929 :   if (f_type(F) == t_MF_NEWTRACE)
    3484             :   { /* inline F to allow cache */
    3485             :     cachenew_t cache;
    3486        5761 :     long N = f_N(F);
    3487        5761 :     GEN DATA = newtrace_DATA(N, tf_get_DATA(F));
    3488        5761 :     init_cachenew(&cache, m*nl, DATA);
    3489        5761 :     v = heckenewtrace(0, m, l, N, NBIG, k, n, &cache);
    3490        5761 :     dbg_cachenew(&cache);
    3491        5761 :     settyp(v, t_VEC); return v;
    3492             :   }
    3493         168 :   CHI = f_CHI(F);
    3494         168 :   D = mydivisorsu(nN); lD = lg(D);
    3495         168 :   M = m + 1;
    3496         168 :   t = nN * cgcd(nN, l);
    3497         168 :   AN = mfcoefs_i(F, m * t, nl / t); /* usually nl = t and we gain nothing */
    3498         168 :   v = anextract(AN, m, t); /* mfcoefs(F, m, nl); d = 1 */
    3499         336 :   for (a = 2; a < lD; a++)
    3500             :   { /* d > 1, (d, N) = 1 */
    3501         168 :     long d = D[a], c = cgcd(l, d), dl = d/c, i, idl;
    3502         168 :     GEN C = gmul(mfchareval_i(CHI, d), powuu(d, k-1));
    3503         168 :     GEN V = anextract(AN, m/dl, t/(d*c)); /* mfcoefs(F, m/dl, nl/(d*c)) */
    3504         875 :     for (i = idl = 1; idl <= M; i++, idl += dl)
    3505         707 :       gel(v,idl) = gadd(gel(v,idl), gmul(C, gel(V,i)));
    3506             :   }
    3507         168 :   return v;
    3508             : }
    3509             : 
    3510             : static ulong
    3511      234255 : coreu_f(ulong n)
    3512             : {
    3513      234255 :   ulong a = coreu_fact(myfactoru(n));
    3514      234255 :   return usqrt(n/a);
    3515             : }
    3516             : 
    3517             : /* Find basis of newspace using closures; assume k >= 2 and
    3518             :  * ischarok(N, k, CHI). Return NULL if space is empty, else
    3519             :  * [mf1, list of closures T(j)traceform, list of corresponding j, matrix] */
    3520             : static GEN
    3521       11620 : mfnewinit(long N, long k, GEN CHI, cachenew_t *cache, long init)
    3522             : {
    3523             :   GEN tf, vtf, vj, M, CHIP, mf1, listj, DATA, P;
    3524             :   long j, ct, ctlj, dim, jin, SB, sb, two, ord;
    3525             : 
    3526       11620 :   dim = mfnewdim(N, k, CHI);
    3527       11620 :   if (!dim && !init) return NULL;
    3528        5691 :   sb = mfsturmNk(N, k);
    3529        5691 :   tf = mftraceform_new(N, k, CHI);
    3530        5691 :   DATA = tf_get_DATA(tf);
    3531             :   /* try sbsmall first: Sturm bound not sharp for new space */
    3532        5691 :   SB = ceilA1(N, k);
    3533        5691 :   listj = cgetg(2*sb + 3, t_VECSMALL);
    3534      239946 :   for (j = 1, ctlj = 0; ctlj < 2*sb + 2; ++j)
    3535      234255 :     if (cgcd(coreu_f(j), N) == 1) listj[++ctlj] = j;
    3536        5691 :   if (init)
    3537             :   {
    3538        2926 :     init_cachenew(cache, (SB+1)*listj[dim+1], DATA);
    3539        2926 :     if (init == -1 || !dim) return NULL; /* old space */
    3540             :   }
    3541             :   else
    3542        2765 :     reset_cachenew(cache, newtrace_DATA(N, DATA));
    3543        5306 :   CHIP = mfchartoprimitive(CHI, NULL);
    3544        5306 :   ord = mfcharorder(CHIP);
    3545        5306 :   ord = ord_canon(ord);
    3546        5306 :   P = ord <= 2? NULL: polcyclo(ord, fetch_user_var("t"));
    3547        5306 :   vj = cgetg(dim+1, t_VECSMALL);
    3548        5306 :   M = cgetg(dim+1, t_MAT);
    3549        5313 :   for (two = 1, ct = 0, jin = 1; two <= 2; ++two)
    3550             :   {
    3551        5313 :     long a, jlim = jin + sb;
    3552       16261 :     for (a = jin; a <= jlim; a++)
    3553             :     {
    3554             :       GEN z, vecz;
    3555       16254 :       ct++; vj[ct] = listj[a];
    3556       16254 :       gel(M, ct) = heckenewtrace(0, SB, 1, N, N, k, vj[ct], cache);
    3557       16254 :       if (ct < dim) continue;
    3558             : 
    3559        6587 :       z = P? ZabM_indexrank(liftpol_shallow(M),P,ord): ZM_indexrank(M);
    3560        6587 :       vecz = gel(z, 2); ct = lg(vecz) - 1;
    3561        6587 :       if (ct == dim) { M = mkvec3(z, gen_0, M); break; } /*maximal rank, done*/
    3562        1281 :       vecpermute_inplace(M, vecz);
    3563        1281 :       vecpermute_inplace(vj, vecz);
    3564             :     }
    3565        5313 :     if (a <= jlim) break;
    3566             :     /* sbsmall was not sufficient, use Sturm bound: must extend M */
    3567          70 :     for (j = 1; j <= ct; j++)
    3568             :     {
    3569          63 :       GEN t = heckenewtrace(SB + 1, sb, 1, N, N, k, vj[j], cache);
    3570          63 :       gel(M,j) = shallowconcat(gel(M, j), t);
    3571             :     }
    3572           7 :     jin = jlim + 1; SB = sb;
    3573             :   }
    3574        5306 :   vtf = cgetg(dim + 1, t_VEC);
    3575             :   /* FIXME (experiment) : remove newtrace data from vtf to save space.
    3576             :    * I expect negligible slowdown */
    3577        5306 :   gel(tf, 2) = CHI;
    3578        5306 :   for (j = 1; j <= dim; ++j) gel(vtf, j) = mfhecke_i(N, k, CHIP, tf, vj[j]);
    3579        5306 :   dbg_cachenew(cache);
    3580        5306 :   mf1 = mkvec4(utoipos(N), utoipos(k), CHI, utoi(mf_NEW));
    3581        5306 :   return mkvec5(mf1, cgetg(1, t_VEC), vtf, vj, M);
    3582             : }
    3583             : 
    3584             : /* Bd(f)[m0..m], v = f[ceil(m0/d)..floor(m/d)], m0d = ceil(m0/d) */
    3585             : static GEN
    3586       43029 : RgC_Bd_expand(long m0, long m, GEN v, long d, long m0d)
    3587             : {
    3588             :   long i, j;
    3589             :   GEN w;
    3590       43029 :   if (d == 1) return v;
    3591       13454 :   w = zerocol(m-m0+1);
    3592       13454 :   if (!m0) { i = 1; j = d; } else { i = 0; j = m0d*d; }
    3593       13454 :   for (; j <= m; i++, j += d) gel(w,j-m0+1) = gel(v,i+1);
    3594       13454 :   return w;
    3595             : }
    3596             : /* vtf a non-empty vector of t_MF_BD(t_MF_HECKE(t_MF_NEWTRACE)); M the matrix
    3597             :  * of their coefficients up to m0 (~ mfvectomat) or NULL (empty),
    3598             :  * extend it to coeffs up to m > m0. The forms B_d(T_j(tf_N))in vtf should be
    3599             :  * sorted by level N, then j, then increasing d. No reordering here. */
    3600             : static GEN
    3601        4571 : bhnmat_extend(GEN M, long m, long r, GEN vtf, cachenew_t *cache)
    3602             : {
    3603        4571 :   long i, m0, Nold = 0, jold = 0, l = lg(vtf);
    3604        4571 :   GEN MAT = cgetg(l, t_MAT), v = NULL;
    3605        4571 :   m0 = M? nbrows(M): 0;
    3606       47600 :   for (i = 1; i < l; i++)
    3607             :   {
    3608       43029 :     GEN DATA, c, f = gel(vtf,i);
    3609       43029 :     long d, j, m0d, N, k = f_k(f);
    3610       43029 :     bhn_parse(f, &N, &d, &j, &DATA);
    3611       43029 :     m0d = ceildiv(m0,d);
    3612       43029 :     if (N!=Nold)
    3613        9926 :     { reset_cachenew(cache, newtrace_DATA(N,DATA)); Nold=N; jold=0; }
    3614       43029 :     if (j!=jold || m0)
    3615       35896 :     { v = heckenewtrace(m0d, m/d, r, N, N, k, j,cache); jold=j; }
    3616       43029 :     c = RgC_Bd_expand(m0, m, v, d, m0d);
    3617       43029 :     if (M) c = shallowconcat(gel(M,i), c);
    3618       43029 :     gel(MAT,i) = c;
    3619             :   }
    3620        4571 :   return MAT;
    3621             : }
    3622             : 
    3623             : /* vmf by increasing level, mf1 for final (concatenated) MF */
    3624             : static GEN
    3625        1911 : mfinitjoin(GEN vmf, GEN mf1, cachenew_t *cache)
    3626             : {
    3627        1911 :   GEN gmf1 = mkvec(mf1);
    3628        1911 :   long i, ind, L = 0, N = mf_get_N(gmf1), k = mf_get_k(gmf1), l = lg(vmf);
    3629        1911 :   GEN P, vvtf, vMjd, MAT, z, vBd = cgetg(l, t_VEC);
    3630        1911 :   long ord = mfcharorder(mf_get_CHI(gmf1));
    3631        6573 :   for (i = 1; i < l; i++)
    3632             :   {
    3633        4662 :     GEN mf = gel(vmf,i), D;
    3634        4662 :     gel(vBd,i) = D = mydivisorsu(N/mf_get_N(mf));
    3635        4662 :     L += (lg(D)-1) * mf_get_dim(mf);
    3636             :   }
    3637        1911 :   vvtf = cgetg(L+1, t_VEC);
    3638        1911 :   vMjd = cgetg(L+1, t_VEC);
    3639        6573 :   for (i = ind = 1; i < l; i++)
    3640             :   {
    3641        4662 :     GEN DNM = gel(vBd,i), mf = gel(vmf,i);
    3642        4662 :     GEN vtf = mf_get_vtf(mf), vj = mfnew_get_vj(mf);
    3643        4662 :     long a, lvtf = lg(vtf), lDNM = lg(DNM), M = mf_get_N(mf);
    3644       18256 :     for (a = 1; a < lvtf; a++)
    3645             :     {
    3646       13594 :       GEN tf = gel(vtf,a);
    3647       13594 :       long b, j = vj[a];
    3648       34321 :       for (b = 1; b < lDNM; b++)
    3649             :       {
    3650       20727 :         long d = DNM[b];
    3651       20727 :         gel(vvtf, ind) = mfbd_i(tf, d);
    3652       20727 :         gel(vMjd, ind) = mkvecsmall3(M, j, d);
    3653       20727 :         ind++;
    3654             :       }
    3655             :     }
    3656             :   }
    3657        1911 :   MAT = bhnmat_extend(NULL,ceilA1(N,k),1, vvtf, cache);
    3658        1911 :   ord = ord_canon(ord);
    3659        1911 :   P = (ord == 1)? NULL: polcyclo(ord, fetch_user_var("t"));
    3660        1911 :   z = P? ZabM_indexrank(liftpol_shallow(MAT), P, ord): ZM_indexrank(MAT);
    3661        1911 :   if (lg(gel(z,2)) == lg(MAT))
    3662        1876 :     MAT = mfclean2(MAT, gel(z,1), P, ord, NULL);
    3663             :   else
    3664             :   {
    3665          35 :     MAT = bhnmat_extend(MAT, mfsturmNk(N,k), 1, vvtf, cache);
    3666          35 :     MAT = mfclean(MAT, ord);
    3667             :   }
    3668        1911 :   dbg_cachenew(cache);
    3669        1911 :   return mkvec5(mf1, cgetg(1, t_VEC), vvtf, vMjd, MAT);
    3670             : }
    3671             : static GEN
    3672        1974 : mfinitcusp(long N, long k, GEN CHI, GEN mf1, long space)
    3673             : {
    3674             :   long lDN1, FC, N1, d1, i, ind, init;
    3675        1974 :   GEN DN1, vmf, CHIP = mfchartoprimitive(CHI, &FC);
    3676             :   cachenew_t cache;
    3677             : 
    3678        1974 :   d1 = (space == mf_OLD)? mfolddim(N, k, CHIP): mfcuspdim(N, k, CHIP);
    3679        1974 :   if (!d1) return NULL;
    3680        1911 :   N1 = N/FC; DN1 = mydivisorsu(N1); lDN1 = lg(DN1);
    3681        1911 :   init = (space == mf_OLD)? -1: 1;
    3682        1911 :   vmf = cgetg(lDN1, t_VEC);
    3683       12516 :   for (i = lDN1 - 1, ind = 1; i; i--)
    3684             :   { /* by decreasing level to allow cache */
    3685       10605 :     GEN mf = mfnewinit(FC*DN1[i], k, CHIP, &cache, init);
    3686       10605 :     if (mf) gel(vmf, ind++) = mf;
    3687       10605 :     init = 0;
    3688             :   }
    3689        1911 :   setlg(vmf, ind); /* reorder by increasing level */
    3690        1911 :   return mfinitjoin(vecreverse(vmf), mf1, &cache);
    3691             : }
    3692             : 
    3693             : static long
    3694        2198 : mfsturm_mf(GEN mf)
    3695             : {
    3696             :   GEN Mindex;
    3697        2198 :   if (!mf_get_dim(mf)) return 0;
    3698        2198 :   Mindex = mf_get_Mindex(mf);
    3699        2198 :   return Mindex[lg(Mindex)-1];
    3700             : }
    3701             : long
    3702          77 : mfsturm(GEN mf)
    3703             : {
    3704             :   long N, k;
    3705             :   GEN CHI;
    3706          77 :   if (checkmf_i(mf)) return mfsturm_mf(mf);
    3707           7 :   checkNK(mf, &N, &k, &CHI, 0);
    3708           7 :   return mfsturmNk(N, k);
    3709             : }
    3710             : 
    3711             : long
    3712           7 : mfisequal(GEN F, GEN G, long lim)
    3713             : {
    3714           7 :   pari_sp av = avma;
    3715             :   long t, sb;
    3716           7 :   if (!isf(F)) pari_err_TYPE("mfisequal",F);
    3717           7 :   if (!isf(G)) pari_err_TYPE("mfisequal",G);
    3718           7 :   if (lim) sb = lim;
    3719             :   else
    3720             :   {
    3721             :     long N, k;
    3722           7 :     N = f_N(F);
    3723           7 :     k = f_k(F); if (N < 0 || k < 0) pari_err_IMPL("mfisequal for these forms");
    3724           7 :     sb = mfsturmNk(N, k);
    3725           7 :     N = f_N(G);
    3726           7 :     k = f_k(G); if (N < 0 || k < 0) pari_err_IMPL("mfisequal for these forms");
    3727           7 :     sb = maxss(sb, mfsturmNk(N, k));
    3728             :   }
    3729           7 :   t = gequal(mfcoefs_i(F, sb+1, 1), mfcoefs_i(G, sb+1, 1));
    3730           7 :   avma = av; return t;
    3731             : }
    3732             : 
    3733             : GEN
    3734          42 : mffields(GEN mf)
    3735             : {
    3736          42 :   if (lg(mf) == 6) return utoi(mf_get_dim(mf));
    3737          42 :   if (lg(mf) < 8) pari_err_TYPE("mffields", mf);
    3738          42 :   return gcopy(mf_get_fields(mf));
    3739             : }
    3740             : 
    3741             : /* F non-empty vector of wt1 forms of the form mfdiv(wt2, eis) or
    3742             :  * mflinear(dihedral,L) */
    3743             : static GEN
    3744         140 : mflinear_wt1(GEN F, GEN L)
    3745             : {
    3746         140 :   long l = lg(F), j;
    3747             :   GEN v, E, f;
    3748         140 :   if (lg(L) != l) pari_err_DIM("mflinear_wt1");
    3749         140 :   f = gel(F,1); /* l > 1 */
    3750         140 :   if (f_type(f) != t_MF_DIV)
    3751          84 :     return mflinear_linear(F, L);
    3752          56 :   E = gel(f,3);
    3753          56 :   v = cgetg(l, t_VEC);
    3754          56 :   for (j = 1; j < l; j++) { GEN f = gel(F,j); gel(v,j) = gel(f,2); }
    3755          56 :   return mfdiv(mflinear_linear(v,L), E);
    3756             : }
    3757             : GEN
    3758          91 : mfeigenbasis(GEN mf)
    3759             : {
    3760          91 :   pari_sp ltop = avma;
    3761             :   GEN mfsplit, vtf, res;
    3762             :   long i, l, k;
    3763             : 
    3764          91 :   checkmfsplit(mf);
    3765          91 :   k = mf_get_k(mf);
    3766          91 :   vtf = mf_get_vtf(mf); if (lg(vtf) == 1) return cgetg(1, t_VEC);
    3767          91 :   mfsplit = mf_get_newforms(mf);
    3768          91 :   res = cgetg_copy(mfsplit, &l);
    3769          91 :   if (k == 1)
    3770          84 :     for (i = 1; i < l; i++)
    3771          42 :       gel(res,i) = mflinear_wt1(vtf, gel(mfsplit,i));
    3772             :   else
    3773         210 :     for (i = 1; i < l; i++)
    3774         161 :       gel(res,i) = mflinear_bhn(vtf, gel(mfsplit,i));
    3775          91 :   return gerepilecopy(ltop, res);
    3776             : }
    3777             : 
    3778             : /* Minv = [primitive part, denominator], v a t_COL; return Minv*v */
    3779             : static GEN
    3780        2555 : Minv_RgC_mul(GEN Minv, GEN v)
    3781             : {
    3782        2555 :   GEN A = gel(Minv,1), d = gel(Minv,2);
    3783        2555 :   v = RgM_RgC_mul(A, v);
    3784        2555 :   if (!equali1(d)) v = RgC_Rg_div(v, d);
    3785        2555 :   return v;
    3786             : }
    3787             : static GEN
    3788         784 : Minv_RgM_mul(GEN Minv, GEN v)
    3789             : {
    3790         784 :   long j, l = lg(v);
    3791         784 :   GEN M = cgetg(l, t_MAT);
    3792         784 :   for (j = 1; j < l; j++) gel(M, j) = Minv_RgC_mul(Minv, gel(v, j));
    3793         784 :   return M;
    3794             : }
    3795             : 
    3796             : /* perm vector of strictly increasing indices, v a vector or arbitrary length;
    3797             :  * the last r entries of perm fall beyond v.
    3798             :  * Return v o perm[1..(-r)], discarding the last r entries of v */
    3799             : static GEN
    3800         105 : vecpermute_partial(GEN v, GEN perm, long *r)
    3801             : {
    3802         105 :   long i, n = lg(v)-1, l = lg(perm);
    3803             :   GEN w;
    3804         105 :   if (perm[l-1] <= n) { *r = 0; return vecpermute(v,perm); }
    3805          63 :   for (i = 1; i < l; i++)
    3806          63 :     if (perm[i] > n) break;
    3807          21 :   *r = l - i; l = i;
    3808          21 :   w = cgetg(l, typ(v));
    3809          21 :   for (i = 1; i < l; i++) gel(w,i) = gel(v,perm[i]);
    3810          21 :   return w;
    3811             : }
    3812             : 
    3813             : /* given form F, find coeffs of F on mfbasis(mf). If power series, not
    3814             :  * guaranteed correct if precision less than Sturm bound */
    3815             : static GEN
    3816         595 : mftobasis_i(GEN mf, GEN F)
    3817             : {
    3818             :   GEN v, Mindex, Minv;
    3819         595 :   if (!mf_get_dim(mf)) return cgetg(1, t_COL);
    3820         588 :   Mindex = mf_get_Mindex(mf);
    3821         588 :   Minv = mf_get_Minv(mf);
    3822         588 :   if (isf(F))
    3823             :   {
    3824         483 :     long n = Mindex[lg(Mindex)-1];
    3825         483 :     v = vecpermute(mfcoefs_i(F, n, 1), Mindex);
    3826         483 :     return Minv_RgC_mul(Minv, v);
    3827             :   }
    3828             :   else
    3829             :   {
    3830         105 :     GEN A = gel(Minv,1), d = gel(Minv,2);
    3831             :     long r;
    3832         105 :     v = F;
    3833         105 :     switch(typ(F))
    3834             :     {
    3835           0 :       case t_SER: v = sertocol(v);
    3836         105 :       case t_VEC: case t_COL: break;
    3837           0 :       default: pari_err_TYPE("mftobasis", F);
    3838             :     }
    3839         105 :     if (lg(v) == 1) pari_err_TYPE("mftobasis",v);
    3840         105 :     v = vecpermute_partial(v, Mindex, &r);
    3841         105 :     if (!r) return Minv_RgC_mul(Minv, v); /* single solution */
    3842             :     /* affine space of dimension r */
    3843          21 :     v = RgM_RgC_mul(vecslice(A, 1, lg(v)-1), v);
    3844          21 :     if (!equali1(d)) v = RgC_Rg_div(v,d);
    3845          21 :     return mkvec2(v, vecslice(A, lg(A)-r, lg(A)-1));
    3846             :   }
    3847             : }
    3848             : 
    3849             : static GEN
    3850         182 : const_mat(long n, GEN x)
    3851             : {
    3852         182 :   long j, l = n+1;
    3853         182 :   GEN A = cgetg(l,t_MAT);
    3854         182 :   for (j = 1; j < l; j++) gel(A,j) = const_col(n, x);
    3855         182 :   return A;
    3856             : }
    3857             : 
    3858             : /* L is the mftobasis of a form on CUSP space */
    3859             : static GEN
    3860          91 : mftonew_i(GEN mf, GEN L, long *plevel)
    3861             : {
    3862             :   GEN vtf, listMjd, CHI, res, Aclos, Acoef, D, perm;
    3863          91 :   long N1, LC, lD, i, l, t, level, N = mf_get_N(mf);
    3864             : 
    3865          91 :   if (mf_get_k(mf) == 1) pari_err_IMPL("mftonew in weight 1");
    3866          91 :   listMjd = mf_get_listj(mf);
    3867          91 :   CHI = mf_get_CHI(mf); LC = mfcharconductor(CHI);
    3868          91 :   vtf = mf_get_vtf(mf);
    3869             : 
    3870          91 :   N1 = N/LC;
    3871          91 :   D = mydivisorsu(N1); lD = lg(D);
    3872          91 :   perm = cgetg(N1+1, t_VECSMALL);
    3873          91 :   for (i = 1; i < lD; i++) perm[D[i]] = i;
    3874          91 :   Aclos = const_mat(lD-1, cgetg(1,t_VEC));
    3875          91 :   Acoef = const_mat(lD-1, cgetg(1,t_VEC));
    3876          91 :   l = lg(listMjd);
    3877        1792 :   for (i = 1; i < l; ++i)
    3878             :   {
    3879             :     long M, d;
    3880             :     GEN v;
    3881        1701 :     if (gequal0(gel(L,i))) continue;
    3882         147 :     v = gel(listMjd, i);
    3883         147 :     M = perm[ v[1]/LC ];
    3884         147 :     d = perm[ v[3] ];
    3885         147 :     gcoeff(Aclos,M,d) = shallowconcat(gcoeff(Aclos,M,d), mkvec(gel(vtf,i)));
    3886         147 :     gcoeff(Acoef,M,d) = shallowconcat(gcoeff(Acoef,M,d), gel(L,i));
    3887             :   }
    3888          91 :   res = cgetg(l, t_VEC); level = 1;
    3889         462 :   for (i = t = 1; i < lD; i++)
    3890             :   {
    3891         371 :     long j, M = D[i]*LC;
    3892        3472 :     for (j = 1; j < lD; j++)
    3893             :     {
    3894        3101 :       GEN f = gcoeff(Aclos,i,j), C;
    3895             :       long d;
    3896        3101 :       if (lg(f) == 1) continue;
    3897         105 :       d = D[j];
    3898         105 :       C = gcoeff(Acoef,i,j);
    3899         105 :       level = clcm(level, M*d);
    3900         105 :       gel(res,t++) = mkvec3(utoipos(M), utoipos(d), mflinear_i(f,C));
    3901             :     }
    3902             :   }
    3903          91 :   if (plevel) *plevel = level;
    3904          91 :   setlg(res, t); return res;
    3905             : }
    3906             : GEN
    3907           7 : mftonew(GEN mf, GEN F)
    3908             : {
    3909           7 :   pari_sp av = avma;
    3910           7 :   checkmf(mf);
    3911           7 :   if (mf_get_space(mf) != mf_CUSP)
    3912           0 :     pari_err_TYPE("mftonew [not a cuspidal space]", mf);
    3913           7 :   F = mftobasis_i(mf, F);
    3914           7 :   return gerepilecopy(av, mftonew_i(mf,F, NULL));
    3915             : }
    3916             : long
    3917           7 : mfconductor(GEN mf, GEN F)
    3918             : {
    3919           7 :   pari_sp av = avma;
    3920             :   long N;
    3921           7 :   checkmf(mf);
    3922           7 :   if (mf_get_space(mf) != mf_CUSP)
    3923           0 :     pari_err_TYPE("mfconductor [not a cuspidal space]", mf);
    3924           7 :   F = mftobasis_i(mf, F);
    3925           7 :   (void)mftonew_i(mf, F, &N);
    3926           7 :   avma = av; return N;
    3927             : }
    3928             : 
    3929             : /* Here an mf closure F is of the type DIV(LINEAR(...,...),EISEN1),
    3930             :  * F[2]=LINEAR(...,...), F[2][2]=wt2 basis, F[2][3]=linear combination coeffs
    3931             :  * F[3]=EISEN1; return cols of mfbasis wt1 */
    3932             : static GEN
    3933          21 : wt1basiscols(GEN mf, long n)
    3934             : {
    3935             :   pari_sp btop;
    3936          21 :   GEN vtf = mf_get_vtf(mf), F = gel(vtf, 1), LI = gmael(F, 2, 2);
    3937             :   GEN EI, EIc, V, B, a0;
    3938          21 :   long lLI = lg(LI), i, j, l, b = n * mfsturm_mf(mf);
    3939             : 
    3940          21 :   EI = mfcoefsser(gel(F,3),b,1);
    3941          21 :   a0 = polcoeff_i(EI, 0, -1);
    3942          21 :   if (gequal0(a0) || gequal1(a0))
    3943           0 :     a0 = NULL;
    3944             :   else
    3945          21 :     EI = gdiv(ser_unscale(EI, a0), a0);
    3946          21 :   EIc = ginv(EI);
    3947          21 :   if (DEBUGLEVEL) err_printf("need %ld series in wt1basiscols\n", lLI - 1);
    3948          21 :   btop = avma;
    3949          21 :   V = zerovec(lLI - 1);
    3950         399 :   for (i = 1; i < lLI; i++)
    3951             :   {
    3952         378 :     GEN LISer = mfcoefsser(gel(LI,i),b,1), f;
    3953         378 :     if (a0) LISer = gdiv(ser_unscale(LISer, a0), a0);
    3954         378 :     f = gmul(LISer, EIc);
    3955         378 :     if (a0) f = ser_unscale(f, ginv(a0));
    3956         378 :     f = sertocol(f);
    3957         378 :     setlg(f, b+2);
    3958         378 :     gel(V, i) = f;
    3959         378 :     if (gc_needed(btop, 1))
    3960             :     {
    3961           0 :       if (DEBUGMEM > 1) pari_warn(warnmem,"wt1basiscols i = %ld", i);
    3962           0 :       V = gerepilecopy(btop, V);
    3963             :     }
    3964             :   }
    3965          21 :   V = gerepilecopy(btop, V);
    3966          21 :   l = lg(vtf); btop = avma;
    3967          21 :   B = zerovec(l-1);
    3968          21 :   if (DEBUGLEVEL) err_printf("%ld divs to do\n", l - 1);
    3969          63 :   for (j = 1; j < l; ++j)
    3970             :   {
    3971          42 :     GEN S = gen_0, coe;
    3972          42 :     F = gel(vtf, j); /* t_MF_DIV */
    3973          42 :     coe = gmael(F,2,3);
    3974         840 :     for (i = 1; i < lLI; ++i)
    3975             :     {
    3976         798 :       GEN co = gel(coe, i);
    3977         798 :       if (!gequal0(co)) S = gadd(S, gmul(co, gel(V, i)));
    3978             :     }
    3979          42 :     gel(B, j) = S;
    3980          42 :     if (gc_needed(btop, 1))
    3981             :     {
    3982           0 :       if (DEBUGMEM > 1) pari_warn(warnmem,"wt1basiscols j = %ld", j);
    3983           0 :       gerepileall(btop, 1, &B);
    3984             :     }
    3985             :   }
    3986          21 :   return B;
    3987             : }
    3988             : 
    3989             : /* B from wt1basiscols */
    3990             : static GEN
    3991          21 : mfmatheckewt1(GEN mf, long n, GEN B)
    3992             : {
    3993          21 :   pari_sp av = avma;
    3994             :   GEN CHI, Mindex, Minv, D, Q, vC;
    3995             :   long lMindex, l, lD, k, N, nN, i, j;
    3996             : 
    3997          21 :   l = lg(B);
    3998          21 :   k = mf_get_k(mf);
    3999          21 :   N = mf_get_N(mf);
    4000          21 :   nN = u_ppo(n, N); /* largest divisor of n coprime to N */
    4001          21 :   CHI = mf_get_CHI(mf);
    4002          21 :   Mindex = mf_get_Mindex(mf); lMindex = lg(Mindex);
    4003          21 :   Minv = mf_get_Minv(mf);
    4004          21 :   Q = cgetg(l, t_MAT);
    4005          21 :   for (j = 1; j < l; j++) gel(Q,j) = cgetg(lMindex, t_COL);
    4006          21 :   D = mydivisorsu(nN); lD = lg(D);
    4007          21 :   vC = cgetg(nN+1, t_VEC);
    4008          35 :   for (j = 2; j < lD; j++) /* skip d = 1 */
    4009             :   {
    4010          14 :     long d = D[j];
    4011          14 :     gel(vC, d) = gmul(mfchareval_i(CHI, d), powuu(d, k-1));
    4012             :   }
    4013             : 
    4014          63 :   for (i = 1; i < lMindex; i++)
    4015             :   {
    4016          42 :     long m = Mindex[i]-1, mn = m*n;
    4017          42 :     D = mydivisorsu(cgcd(m, nN)); lD = lg(D);
    4018         140 :     for (j = 1; j < l; j++)
    4019             :     {
    4020          98 :       GEN S = gel(B,j), s = gel(S, mn + 1);
    4021             :       long jj;
    4022         140 :       for (jj = 2; jj < lD; jj++) /* skip d = 1 */
    4023             :       {
    4024          42 :         long d = D[jj]; /* coprime to N */
    4025          42 :         s = gadd(s, gmul(gel(vC,d), gel(S, mn/(d*d) + 1)));
    4026             :       }
    4027          98 :       gcoeff(Q, i, j) = s;
    4028             :     }
    4029             :   }
    4030          21 :   return gerepileupto(av, Minv_RgM_mul(Minv, Q));
    4031             : }
    4032             : 
    4033             : /* mf_NEW, weight > 1, p prime. Use
    4034             :  * T(p) T(j) = T(j*p) + p^{k-1} \chi(p) 1_{p | j, p \nmid N} T(j/p) */
    4035             : static GEN
    4036         700 : mfnewmathecke_p(GEN mf, long p)
    4037             : {
    4038         700 :   pari_sp av = avma;
    4039         700 :   GEN tf, vj = mfnew_get_vj(mf), CHI = mf_get_CHI(mf);
    4040         700 :   GEN Mindex = mf_get_Mindex(mf), Minv = mf_get_Minv(mf);
    4041         700 :   long N = mf_get_N(mf), k = mf_get_k(mf);
    4042         700 :   long i, j, lvj = lg(vj), lim = vj[lvj-1] * p;
    4043         700 :   GEN perm, V, need = zero_zv(lim);
    4044         700 :   GEN M, C = gmul(mfchareval_i(CHI, p), powuu(p, k-1));
    4045         700 :   tf = mftraceform_new(N, k, CHI);
    4046        2387 :   for (i = 1; i < lvj; i++)
    4047             :   {
    4048        1687 :     j = vj[i]; need[j*p] = 1;
    4049        1687 :     if (N % p && j % p == 0) need[j/p] = 1;
    4050             :   }
    4051         700 :   perm = zero_zv(lim);
    4052         700 :   V = cgetg(lim+1, t_VEC);
    4053        6776 :   for (i = j = 1; i <= lim; i++)
    4054        6076 :     if (need[i]) { gel(V,j) = mfhecke_i(N, k, CHI, tf, i); perm[i] = j; j++; }
    4055         700 :   setlg(V, j);
    4056         700 :   V = bhnmat_extend_nocache(NULL, mfsturm_mf(mf)-1, 1, V);
    4057         700 :   V = rowpermute(V, Mindex); /* V[perm[i]] = coeffs(T_i newtrace) */
    4058         700 :   M = cgetg(lvj, t_MAT);
    4059        2387 :   for (i = 1; i < lvj; i++)
    4060             :   {
    4061             :     GEN t;
    4062        1687 :     j = vj[i]; t = gel(V, perm[j*p]);
    4063        1687 :     if (N % p && j % p == 0) t = RgC_add(t, RgC_Rg_mul(gel(V, perm[j/p]),C));
    4064        1687 :     gel(M,i) = t;
    4065             :   }
    4066         700 :   return gerepileupto(av, Minv_RgM_mul(Minv, M));
    4067             : }
    4068             : 
    4069             : /* Matrix of T(n), assume n > 0 */
    4070             : static GEN
    4071         784 : mfmathecke_i(GEN mf, long n)
    4072             : {
    4073         784 :   pari_sp av = avma;
    4074             :   GEN Minv, v, b, Mindex, nN;
    4075             :   long N, j, l, sb;
    4076             : 
    4077         784 :   b = mf_get_basis(mf); l = lg(b);
    4078         784 :   if (l == 1) return cgetg(1, t_MAT);
    4079         784 :   if (n == 1) return matid(l-1);
    4080         784 :   if (mf_get_k(mf) == 1 && f_type(gel(b,1)) == t_MF_DIV)
    4081          21 :     return mfmatheckewt1(mf, n, wt1basiscols(mf, n));
    4082         763 :   if (mf_get_space(mf) == mf_NEW && uisprime(n))
    4083         700 :     return mfnewmathecke_p(mf, n);
    4084          63 :   N = mf_get_N(mf);
    4085          63 :   sb = mfsturm_mf(mf)-1;
    4086          63 :   Mindex = mf_get_Mindex(mf);
    4087          63 :   Minv = mf_get_Minv(mf);
    4088          63 :   nN = hecke_data(N, n);
    4089          63 :   v = cgetg(l, t_VEC);
    4090         322 :   for (j = 1; j < l; j++)
    4091             :   {
    4092         259 :     GEN vj = hecke_i(sb, 1, nN, gel(b,j)); /* Tp f[j] */
    4093         259 :     settyp(vj,t_COL); gel(v, j) = vecpermute(vj, Mindex);
    4094             :   }
    4095          63 :   return gerepileupto(av, Minv_RgM_mul(Minv,v));
    4096             : }
    4097             : 
    4098             : /* f = \sum_i v[i] T_listj[i] (Trace Form) attached to v; replace by f/a_1(f) */
    4099             : static GEN
    4100         882 : mf_normalize(GEN v1, GEN v)
    4101             : {
    4102         882 :   GEN c, dc = NULL;
    4103         882 :   v = Q_primpart(v);
    4104         882 :   c = ginv(RgV_dotproduct(v1, v));
    4105         882 :   if (typ(c) == t_POLMOD) c = Q_remove_denom(c, &dc);
    4106         882 :   v = RgC_Rg_mul(v, c);
    4107         882 :   return dc? RgC_Rg_div(v, dc): v;
    4108             : }
    4109             : /* normalize */
    4110             : static GEN
    4111         539 : mfspcleanrat(GEN v1, GEN simplesp)
    4112             : {
    4113             :   GEN res, D;
    4114         539 :   long l = lg(simplesp), i;
    4115         539 :   res = cgetg(l, t_VEC); D = cgetg(l, t_VECSMALL);
    4116         539 :   for (i = 1; i < l; ++i) D[i] = lg(gmael(simplesp, i, 2));
    4117         539 :   simplesp = vecpermute(simplesp, vecsmall_indexsort(D));
    4118        1106 :   for (i = 1; i < l; ++i)
    4119             :   {
    4120         567 :     GEN ATP = gel(simplesp,i), A = gel(ATP,1);
    4121         567 :     gel(res,i) = mf_normalize(v1, gel(A,1));
    4122             :   }
    4123         539 :   return mkvec2(res, const_vec(l-1, pol_x(1)));
    4124             : }
    4125             : 
    4126             : /* Diagonalize and normalize. See mfsplit for meaning of flag. */
    4127             : 
    4128             : static GEN
    4129         175 : mfspclean(GEN v1, GEN NF, long ord, GEN simplesp, long k, long flag)
    4130             : {
    4131             :   GEN res, D, pols;
    4132         175 :   long i, l = lg(simplesp);
    4133             : 
    4134         175 :   res = cgetg(l, t_VEC);
    4135         175 :   pols = cgetg(l, t_VEC);
    4136         175 :   D = cgetg(l, t_VEC); /* sort by increasing dimension */
    4137         175 :   for (i = 1; i < l; ++i) D[i] = lg(gmael(simplesp, i, 2));
    4138         175 :   simplesp = vecpermute(simplesp, vecsmall_indexsort(D));
    4139         490 :   for (i = 1; i < l; ++i)
    4140             :   {
    4141         315 :     GEN v, ATP = gel(simplesp, i), A = gel(ATP,1), P = gel(ATP,3);
    4142         315 :     long d = degpol(P), vz = varn(P);
    4143         315 :     if (d == 1) { P = pol_x(vz); v = gel(A,1); }
    4144             :     else
    4145             :     {
    4146         105 :       GEN den, K, M, a, D = RgX_disc(P), T = gel(ATP,2);
    4147             :       long j;
    4148         105 :       if (typ(D) != t_INT)
    4149             :       {
    4150          35 :         D = gnorm(D);
    4151          35 :         if (typ(D) != t_INT) pari_err_BUG("mfnewsplit");
    4152             :       }
    4153         105 :       if (k <= 2 || expi(D) < 62)
    4154         105 :       {
    4155             :         GEN z;
    4156         105 :         if (expi(D) < 31)
    4157         105 :           z = NF? rnfpolredabs(NF, P,1): polredabs0(P,1);
    4158             :         else
    4159           0 :           z = NF? rnfpolredbest(NF,P,1): polredbest(P,1);
    4160         105 :         P = gel(z,1);
    4161         105 :         a = gel(z,2); if (typ(a) == t_POLMOD) a = gel(a,2);
    4162             :       }
    4163             :       else
    4164           0 :         a = pol_x(vz);
    4165             :       /* Mod(a,P) root of charpoly(T), K*gpowers(Mod(a,P)) = eigenvector of T */
    4166         105 :       if (flag < 0 && d > -flag)
    4167           0 :         v = zerovec(d);
    4168             :       else
    4169             :       {
    4170         105 :         T = shallowtrans(T);
    4171         105 :         M = cgetg(d+1, t_MAT); /* basis of cyclic vectors */
    4172         105 :         gel(M,1) = vec_ei(d,1);
    4173         105 :         for (j = 2; j <= d; j++) gel(M,j) = RgM_RgC_mul(T, gel(M,j-1));
    4174         105 :         M = Q_primpart(M);
    4175         147 :         K = NF? ZabM_inv(liftpol_shallow(M), nf_get_pol(NF), ord, &den)
    4176         147 :               : ZM_inv_ratlift(M,&den);
    4177         105 :         K = shallowtrans(K);
    4178         105 :         v = gequalX(a)? pol_x_powers(d, vz): RgXQ_powers(a, d-1, P);
    4179         105 :         v = gmodulo(RgM_RgC_mul(A, RgM_RgC_mul(K,v)), P);
    4180             :       }
    4181             :     }
    4182         315 :     if (!flag || d <= flag) v = mf_normalize(v1, v);
    4183         315 :     gel(res, i) = v;
    4184         315 :     gel(pols, i) = P;
    4185             :   }
    4186         175 :   return mkvec2(res, pols);
    4187             : }
    4188             : 
    4189             : /* return v = v_{X-r}(P), and set Z = P / (X-r)^v */
    4190             : static long
    4191          63 : RgX_valrem_root(GEN P, GEN r, GEN *Z)
    4192             : {
    4193             :   long v;
    4194         126 :   for (v = 0; degpol(P); v++)
    4195             :   {
    4196         126 :     GEN t, Q = RgX_div_by_X_x(P, r, &t);
    4197         126 :     if (!gequal0(t)) break;
    4198          63 :     P = Q;
    4199             :   }
    4200          63 :   *Z = P; return v;
    4201             : }
    4202             : static GEN
    4203         756 : mynffactor(GEN NF, GEN P, long dimlim)
    4204             : {
    4205             :   long i, l, v;
    4206             :   GEN R, E;
    4207         756 :   if (dimlim != 1)
    4208             :   {
    4209         217 :     R = NF? nffactor(NF, P): QX_factor(P);
    4210         217 :     if (!dimlim) return R;
    4211          21 :     E = gel(R,2);
    4212          21 :     R = gel(R,1); l = lg(R);
    4213          98 :     for (i = 1; i < l; i++)
    4214          91 :       if (degpol(gel(R,i)) > dimlim) break;
    4215          21 :     if (i == 1) return NULL;
    4216          21 :     setlg(E,i);
    4217          21 :     setlg(R,i); return mkmat2(R, E);
    4218             :   }
    4219             :   /* dimlim = 1 */
    4220         539 :   R = nfroots(NF, P); l = lg(R);
    4221         539 :   if (l == 1) return NULL;
    4222         476 :   v = varn(P);
    4223         476 :   settyp(R, t_COL);
    4224         476 :   if (degpol(P) == l-1)
    4225         427 :     E = const_vec(l-1, gen_1);
    4226             :   else
    4227             :   {
    4228          49 :     E = cgetg(l, t_COL);
    4229          49 :     for (i = 1; i < l; i++) gel(E,i) = utoi(RgX_valrem_root(P, gel(R,i), &P));
    4230             :   }
    4231         476 :   R = deg1_from_roots(R, v);
    4232         476 :   return mkmat2(R, E);
    4233             : }
    4234             : 
    4235             : /* Let K be a number field attached to NF (Q if NF = NULL). A K-vector
    4236             :  * space of dimension d > 0 is given by a t_MAT A (n x d, full column rank)
    4237             :  * giving a K-basis, X a section (d x n: left pseudo-inverse of A). Return a
    4238             :  * pair (T, fa), where T is an element of the Hecke algebra (a sum of Tp taken
    4239             :  * from vector vTp) acting on A (a d x d t_MAT) and fa is the factorization of
    4240             :  * its characteristic polynomial, limited to factors of degree <= dimlim if
    4241             :  * dimlim != 0 (return NULL if there are no factors of degree <= dimlim) */
    4242             : static GEN
    4243         749 : findbestsplit(GEN NF, GEN vTp, GEN A, GEN X, long dimlim, long vz)
    4244             : {
    4245         749 :   GEN T = NULL, Tkeep = NULL, fakeep = NULL;
    4246         749 :   long lmax = 0, i, lT = lg(vTp);
    4247        1582 :   for (i = 1; i < lT; i++)
    4248             :   {
    4249         791 :     GEN D, P, E, fa, TpA = gel(vTp,i);
    4250             :     long l;
    4251        1477 :     if (typ(TpA) == t_INT) break;
    4252         756 :     if (lg(TpA) > lg(A)) TpA = RgM_mul(X, RgM_mul(TpA, A)); /* Tp | A */
    4253         756 :     T = T ? RgM_add(T, TpA) : TpA;
    4254         756 :     if (!NF) { P = QM_charpoly_ZX(T); setvarn(P, vz); }
    4255             :     else
    4256             :     {
    4257         105 :       P = charpoly(Q_remove_denom(T, &D), vz);
    4258         105 :       if (D) P = gdiv(RgX_unscale(P, D), powiu(D, degpol(P)));
    4259             :     }
    4260         756 :     fa = mynffactor(NF, P, dimlim);
    4261         756 :     if (!fa) return NULL;
    4262         693 :     E = gel(fa, 2);
    4263             :     /* characteristic polynomial is separable ? */
    4264         693 :     if (isint1(vecmax(E))) { Tkeep = T; fakeep = fa; break; }
    4265          42 :     l = lg(E);
    4266             :     /* characteristic polynomial has more factors than before ? */
    4267          42 :     if (l > lmax) { lmax = l; Tkeep = T; fakeep = fa; }
    4268             :   }
    4269         686 :   return mkvec2(Tkeep, fakeep);
    4270             : }
    4271             : 
    4272             : static GEN
    4273          56 : nfcontent(GEN nf, GEN v)
    4274             : {
    4275          56 :   long i, l = lg(v);
    4276          56 :   GEN c = gel(v,1);
    4277          56 :   for (i = 2; i < l; i++) c = idealadd(nf, c, gel(v,i));
    4278          56 :   if (typ(c) == t_MAT && gequal1(gcoeff(c,1,1))) c = gen_1;
    4279          56 :   return c;
    4280             : }
    4281             : static GEN
    4282          98 : nf_primpart(GEN nf, GEN B)
    4283             : {
    4284          98 :   switch(typ(B))
    4285             :   {
    4286             :     case t_COL:
    4287             :     {
    4288          56 :       GEN A = matalgtobasis(nf, B), c = nfcontent(nf, A);
    4289          56 :       if (typ(c) == t_INT) return B;
    4290           0 :       c = idealred_elt(nf,c);
    4291           0 :       A = Q_primpart( nfC_nf_mul(nf, A, Q_primpart(nfinv(nf,c))) );
    4292           0 :       A = liftpol_shallow( matbasistoalg(nf, A) );
    4293           0 :       if (gexpo(A) > gexpo(B)) A = B;
    4294           0 :       return A;
    4295             :     }
    4296             :     case t_MAT:
    4297             :     {
    4298             :       long i, l;
    4299          42 :       GEN A = cgetg_copy(B, &l);
    4300          42 :       for (i = 1; i < l; i++) gel(A,i) = nf_primpart(nf, gel(B,i));
    4301          42 :       return A;
    4302             :     }
    4303             :     default:
    4304           0 :       pari_err_TYPE("nf_primpart", B);
    4305             :       return NULL; /*LCOV_EXCL_LINE*/
    4306             :   }
    4307             : }
    4308             : 
    4309             : /* rotate entries of v to accomodate new entry 'x' (push out oldest entry) */
    4310             : static void
    4311         742 : vecpush(GEN v, GEN x)
    4312             : {
    4313             :   long i;
    4314         742 :   for (i = lg(v)-1; i > 1; i--) gel(v,i) = gel(v,i-1);
    4315         742 :   gel(v,1) = x;
    4316         742 : }
    4317             : 
    4318             : /* A non-empty matrix */
    4319             : static GEN
    4320          28 : RgM_getnf(GEN A)
    4321             : {
    4322          28 :   long i, j, l = lg(A), m = lgcols(A);
    4323          84 :   for (j = 1; j < l; j++)
    4324         196 :     for (i = 1; i < m; i++)
    4325             :     {
    4326         140 :       GEN c = gcoeff(A,i,j);
    4327         140 :       if (typ(c) == t_POLMOD) return nfinit(gel(c,1), DEFAULTPREC);
    4328             :     }
    4329          28 :   return NULL;
    4330             : }
    4331             : 
    4332             : /* mf is either new space of whole cuspidal space in weight 1. If dimlim > 0,
    4333             :  * keep only the dimension <= dimlim eigenspaces. See mfsplit for the meaning
    4334             :  * of flag. */
    4335             : static GEN
    4336        1085 : mfsplit_i(GEN mf, long dimlim, long flag)
    4337             : {
    4338             :   forprime_t iter;
    4339        1085 :   GEN v, NF, POLCYC, CHI, todosp, Tpbigvec, simplesp, empty = cgetg(1, t_VEC);
    4340        1085 :   long N, k, ord, FC, newdim, dim = mf_get_dim(mf), dimsimple = 0;
    4341        1085 :   const long NBH = 5, vz = 1;
    4342             :   ulong p;
    4343             : 
    4344        1085 :   newdim = dim;
    4345        1085 :   switch(mf_get_space(mf))
    4346             :   {
    4347        1022 :     case mf_NEW: break;
    4348             :     case mf_CUSP: /* in wt1 much faster to compute mfolddim */
    4349          63 :       if (dimlim) pari_err_FLAG("mfsplit [cusp space]");
    4350          63 :       newdim -= mfolddim(mf_get_N(mf), mf_get_k(mf), mf_get_CHI(mf));
    4351          63 :       break;
    4352           0 :     default: pari_err_TYPE("mfsplit [cannot split old/fullspace]", mf);
    4353             :   }
    4354        1085 :   if (!newdim) return shallowconcat(mf, mkvec2(empty, empty));
    4355         714 :   N = mf_get_N(mf);
    4356         714 :   k = mf_get_k(mf);
    4357         714 :   CHI = mf_get_CHI(mf);
    4358         714 :   FC = mfcharconductor(CHI);
    4359         714 :   ord = mfcharorder(CHI);
    4360         714 :   if (ord > 2)
    4361             :   {
    4362          77 :     ord = ord_canon(ord);
    4363          77 :     POLCYC = polcyclo(ord, fetch_user_var("t"));
    4364          77 :     NF = nfinit(POLCYC, DEFAULTPREC);
    4365             :   }
    4366             :   else
    4367             :   {
    4368         637 :     ord = 1;
    4369         637 :     POLCYC = NULL;
    4370         637 :     NF = NULL;
    4371             :   }
    4372         714 :   todosp = mkvec(mkvec2(matid(dim), matid(dim)));
    4373         714 :   simplesp = empty;
    4374         714 :   Tpbigvec = zerovec(NBH);
    4375         714 :   u_forprime_init(&iter, 2, ULONG_MAX);
    4376         714 :   while (dimsimple < newdim && (p = u_forprime_next(&iter)))
    4377             :   {
    4378             :     GEN nextsp;
    4379             :     long ind;
    4380         924 :     if (N % (p*p) == 0 && N/p % FC == 0) continue; /* T_p = 0 in this case */
    4381         742 :     vecpush(Tpbigvec, mfmathecke_i(mf,p));
    4382         742 :     if (k == 1 && !NF) NF = RgM_getnf(gel(Tpbigvec,1));
    4383         742 :     nextsp = empty;
    4384        1491 :     for (ind = 1; ind < lg(todosp); ++ind)
    4385             :     {
    4386         749 :       GEN tmp = gel(todosp, ind), fa, P, E, D, Tp, DTp;
    4387         749 :       GEN A = gel(tmp, 1);
    4388         749 :       GEN X = gel(tmp, 2);
    4389             :       long lP, i;
    4390         749 :       tmp = findbestsplit(NF, Tpbigvec, A, X, dimlim, vz);
    4391        1288 :       if (!tmp) continue; /* nothing there */
    4392         686 :       Tp = gel(tmp, 1);
    4393         686 :       fa = gel(tmp, 2);
    4394         686 :       P = gel(fa, 1);
    4395         686 :       E = gel(fa, 2); lP = lg(P);
    4396             :       /* lP > 1 */
    4397         686 :       if (DEBUGLEVEL) err_printf("Exponents = %Ps\n", E);
    4398         686 :       if (lP == 2)
    4399             :       {
    4400         518 :         GEN P1 = gel(P,1);
    4401         518 :         long e1 = itos(gel(E,1)), d1 = degpol(P1);
    4402         518 :         if (e1 * d1 == lg(Tp)-1)
    4403             :         {
    4404         476 :           if (e1 > 1) nextsp = shallowconcat(nextsp, mkvec(mkvec2(A,X)));
    4405             :           else
    4406             :           { /* simple module */
    4407         462 :             simplesp = shallowconcat(simplesp, mkvec(mkvec3(A,Tp,P1)));
    4408         462 :             dimsimple += d1;
    4409             :           }
    4410         476 :           continue;
    4411             :         }
    4412             :       }
    4413             :       /* Found splitting */
    4414         210 :       DTp = Q_remove_denom(Tp, &D);
    4415         658 :       for (i = 1; i < lP; ++i)
    4416             :       {
    4417         448 :         GEN Ai, Xi, dXi, AAi, v, y, Pi = gel(P,i);
    4418         448 :         Ai = RgX_RgM_eval(D? RgX_rescale(Pi,D): Pi, DTp);
    4419         448 :         Ai = QabM_ker(Ai, POLCYC, ord);
    4420         448 :         if (NF) Ai = nf_primpart(NF, Ai);
    4421             : 
    4422         448 :         AAi = RgM_mul(A, Ai);
    4423             :         /* gives section, works on nonsquare matrices */
    4424         448 :         Xi = QabM_pseudoinv(Ai, POLCYC, ord, &v, &dXi);
    4425         448 :         Xi = RgM_Rg_div(Xi, dXi);
    4426         448 :         y = gel(v,1);
    4427         448 :         if (isint1(gel(E,i)))
    4428             :         {
    4429         420 :           GEN Tpi = RgM_mul(Xi, RgM_mul(rowpermute(Tp,y), Ai));
    4430         420 :           simplesp = shallowconcat(simplesp, mkvec(mkvec3(AAi, Tpi, Pi)));
    4431         420 :           dimsimple += degpol(Pi);
    4432             :         }
    4433             :         else
    4434             :         {
    4435          28 :           Xi = RgM_mul(Xi, rowpermute(X,y));
    4436          28 :           nextsp = shallowconcat(nextsp, mkvec(mkvec2(AAi, Xi)));
    4437             :         }
    4438             :       }
    4439             :     }
    4440         742 :     todosp = nextsp; if (lg(todosp) == 1) break;
    4441             :   }
    4442         714 :   v = row(mf_get_M(mf),2); /* v[i] = vtf[i](1) */
    4443         714 :   if (DEBUGLEVEL) err_printf("end split, need to clean\n");
    4444         714 :   if (dimlim == 1)
    4445         539 :     v = mfspcleanrat(v, simplesp);
    4446             :   else
    4447         175 :     v = mfspclean(v, NF, ord, simplesp, k, flag);
    4448         714 :   return shallowconcat(mf, v);
    4449             : }
    4450             : /* mf is either already split or output by mfinit. Splitting is done only for
    4451             :  * newspace except in weight 1. If flag = 0 (default) split completely.
    4452             :  * If flag = d > 0, give the Galois polynomials and the nonnormalized
    4453             :  * eigenforms in degree > d, otherwise all. If flag = -d < 0, only
    4454             :  * give the Galois polynomials in degree > d, otherwise all. Flag is ignored if
    4455             :  * dimlim = 1. */
    4456             : GEN
    4457        1113 : mfsplit(GEN mf, long dimlim, long flag)
    4458             : {
    4459        1113 :   pari_sp av = avma;
    4460        1113 :   long lmf = lg(mf);
    4461        1113 :   if (lmf == 1) return gcopy(mf);
    4462        1113 :   if (typ(mf) != t_VEC) pari_err_TYPE("mfsplit", mf);
    4463        1113 :   if (!checkmf_i(mf))
    4464             :   {
    4465         959 :     mf = mfinit_i(mf, mf_NEW);
    4466         959 :     lmf = lg(mf); if (lmf == 1) { avma = av; return mf; }
    4467             :   }
    4468             : 
    4469        1113 :   if (typ(gel(mf,1)) == t_VEC)
    4470             :   { /* vector of mf spaces */
    4471        1113 :     long i, lv = lg(gel(mf,1));
    4472        1113 :     if (lv == 6 || lv == 8)
    4473             :     {
    4474           7 :       GEN V = cgetg(lmf, t_VEC);
    4475           7 :       for (i = 1; i < lmf; i++) gel(V,i) = mfsplit(gel(mf,i), dimlim, flag);
    4476           7 :       return V;
    4477             :     }
    4478        1106 :     if (lv != 5) pari_err_TYPE("mfsplit", mf);
    4479             :   }
    4480        1106 :   if (lmf == 8)
    4481             :   { /* already split; apply dimlim filter */
    4482             :     GEN pols, forms;
    4483             :     long j, l;
    4484          21 :     mf = gcopy(mf); if (!dimlim) return mf;
    4485           0 :     pols = mf_get_fields(mf); l = lg(pols);
    4486           0 :     forms = mf_get_newforms(mf);
    4487           0 :     for (j = 1; j < l; j++)
    4488           0 :       if (degpol(gel(pols,j)) > dimlim) break;
    4489           0 :     setlg(pols, j);
    4490           0 :     setlg(forms,j); return mf;
    4491             :   }
    4492        1085 :   return gerepilecopy(av, mfsplit_i(mf, dimlim, flag));
    4493             : }
    4494             : 
    4495             : /*************************************************************************/
    4496             : /*                     Modular forms of Weight 1                         */
    4497             : /*************************************************************************/
    4498             : /* S_1(G_0(N)), small N. Return 1 if definitely empty; return 0 if maybe
    4499             :  * non-empty  */
    4500             : static int
    4501       15498 : wt1empty(long N)
    4502             : {
    4503       15498 :   if (N <= 100) switch (N)
    4504             :   { /* non-empty [32/100] */
    4505             :     case 23: case 31: case 39: case 44: case 46:
    4506             :     case 47: case 52: case 55: case 56: case 57:
    4507             :     case 59: case 62: case 63: case 68: case 69:
    4508             :     case 71: case 72: case 76: case 77: case 78:
    4509             :     case 79: case 80: case 83: case 84: case 87:
    4510             :     case 88: case 92: case 93: case 94: case 95:
    4511        5152 :     case 99: case 100: return 0;
    4512        3353 :     default: return 1;
    4513             :   }
    4514        6993 :   if (N <= 600) switch(N)
    4515             :   { /* empty [111/500] */
    4516             :     case 101: case 102: case 105: case 106: case 109:
    4517             :     case 113: case 121: case 122: case 123: case 125:
    4518             :     case 130: case 134: case 137: case 146: case 149:
    4519             :     case 150: case 153: case 157: case 162: case 163:
    4520             :     case 169: case 170: case 173: case 178: case 181:
    4521             :     case 182: case 185: case 187: case 193: case 194:
    4522             :     case 197: case 202: case 205: case 210: case 218:
    4523             :     case 221: case 226: case 233: case 241: case 242:
    4524             :     case 245: case 246: case 250: case 257: case 265:
    4525             :     case 267: case 269: case 274: case 277: case 281:
    4526             :     case 289: case 293: case 298: case 305: case 306:
    4527             :     case 313: case 314: case 317: case 326: case 337:
    4528             :     case 338: case 346: case 349: case 353: case 361:
    4529             :     case 362: case 365: case 369: case 370: case 373:
    4530             :     case 374: case 377: case 386: case 389: case 394:
    4531             :     case 397: case 401: case 409: case 410: case 421:
    4532             :     case 425: case 427: case 433: case 442: case 449:
    4533             :     case 457: case 461: case 466: case 481: case 482:
    4534             :     case 485: case 490: case 493: case 509: case 514:
    4535             :     case 521: case 530: case 533: case 534: case 538:
    4536             :     case 541: case 545: case 554: case 557: case 562:
    4537             :     case 565: case 569: case 577: case 578: case 586:
    4538         336 :     case 593: return 1;
    4539        6643 :     default: return 0;
    4540             :   }
    4541          14 :   return 0;
    4542             : }
    4543             : 
    4544             : static GEN
    4545           0 : initwt1trace(long N, GEN CHI)
    4546             : {
    4547           0 :   GEN mf = mfinit_i(mkvec3(utoi(N), gen_1, CHI), mf_CUSP), vtf = mf_get_vtf(mf);
    4548             :   GEN v, Mindex, Minv, la, HEC, Mindexmin;
    4549             :   long lM, i;
    4550           0 :   if (lg(vtf) == 1) return mkvec2(mf, gen_0);
    4551           0 :   Mindex = mf_get_Mindex(mf); lM = lg(Mindex);
    4552           0 :   Minv = mf_get_Minv(mf);
    4553           0 :   v = cgetg(lM, t_VEC);
    4554           0 :   Mindexmin = cgetg(lM, t_VECSMALL);
    4555           0 :   for (i = 1; i < lM; i++) Mindexmin[i] = Mindex[i] - 1;
    4556           0 :   HEC = mfmathecke(mf, Mindexmin);
    4557           0 :   for (i = 1; i < lM; i++) gel(v, i) = gtrace(gel(HEC, i));
    4558           0 :   la = Minv_RgC_mul(Minv, v);
    4559           0 :   return mkvec2(mf, mflinear_wt1(vtf, la));
    4560             : }
    4561             : 
    4562             : /* Return mf full space and newtrace form */
    4563             : static GEN
    4564           0 : initwt1newtrace(long N, GEN CHI)
    4565             : {
    4566             :   GEN D, vtf, mf, mftfN, la, Mindex, Minv, res;
    4567             :   long FC, lD, i, sb, N1, N2, lM;
    4568           0 :   CHI = mfchartoprimitive(CHI, &FC);
    4569           0 :   if (N % FC || mfcharparity(CHI) == 1) return mkvec2(gen_0, mfcreate(gen_0));
    4570           0 :   D = mydivisorsu(N/FC); lD = lg(D);
    4571           0 :   mftfN = initwt1trace(N, CHI);
    4572           0 :   mf = gel(mftfN, 1);
    4573           0 :   vtf = mf_get_vtf(mf);
    4574           0 :   if (lg(vtf) == 1) return mkvec2(mf, mfcreate(gen_0));
    4575           0 :   N2 = newd_params2(N);
    4576           0 :   N1 = N / N2;
    4577           0 :   Mindex = mf_get_Mindex(mf);
    4578           0 :   Minv = mf_get_Minv(mf);
    4579           0 :   lM = lg(Mindex);
    4580           0 :   sb = Mindex[lM-1];
    4581           0 :   res = zerovec(sb+1);
    4582           0 :   for (i = 1; i < lD; ++i)
    4583             :   {
    4584           0 :     long M = FC*D[i], j;
    4585           0 :     GEN tf = (M == N)? gel(mftfN, 2): gel(initwt1trace(M, CHI), 2);
    4586             :     GEN listd, v;
    4587           0 :     if (gequal0(tf)) continue;
    4588           0 :     v = mfcoefs_i(tf, sb, 1);
    4589           0 :     if (M == N) { res = gadd(res, v); continue; }
    4590           0 :     listd = mydivisorsu(u_ppo(cgcd(N/M, N1), FC));
    4591           0 :     for (j = 1; j < lg(listd); j++)
    4592             :     {
    4593           0 :       long d = listd[j], d2 = d*d; /* coprime to FC */
    4594           0 :       GEN dk = mfchareval_i(CHI, d);
    4595           0 :       long NMd = N/(M*d), m;
    4596           0 :       for (m = 1; m <= sb/d2; m++)
    4597             :       {
    4598           0 :         long be = mubeta2(NMd, m);
    4599           0 :         if (be)
    4600             :         {
    4601           0 :           GEN c = gmul(dk, gmulsg(be, gel(v, m+1)));
    4602           0 :           long n = m*d2;
    4603           0 :           gel(res, n+1) = gadd(gel(res, n+1), c);
    4604             :         }
    4605             :       }
    4606             :     }
    4607             :   }
    4608           0 :   if (gequal0(gel(res,2))) return mkvec2(mf, mfcreate(gen_0));
    4609           0 :   la = Minv_RgC_mul(Minv, vecpermute(res,Mindex));
    4610           0 :   return mkvec2(mf, mflinear_wt1(vtf, la));
    4611             : }
    4612             : static GEN
    4613           0 : mfwt1trace_i(long N, GEN CHI, long space)
    4614             : {
    4615           0 :   GEN T = (space == mf_NEW)? initwt1newtrace(N,CHI): initwt1trace(N,CHI);
    4616           0 :   return gel(T, 2);
    4617             : }
    4618             : 
    4619             : /* Matrix of T(p), p \nmid N */
    4620             : static GEN
    4621        1015 : Tpmat(long p, long lim, GEN CHI)
    4622             : {
    4623        1015 :   GEN M = zeromatcopy(lim, p*lim), chip = mfchareval_i(CHI, p); /* != 0 */
    4624             :   long i, j, pi, pj;
    4625        1015 :   gcoeff(M, 1, 1) = gaddsg(1, chip);
    4626        1015 :   for (i = 1, pi = p; i < lim; i++,  pi += p) gcoeff(M, i+1, pi+1) = gen_1;
    4627        1015 :   for (j = 1, pj = p; pj < lim; j++, pj += p) gcoeff(M, pj+1, j+1) = chip;
    4628        1015 :   return M;
    4629             : }
    4630             : 
    4631             : /* assume !wt1empty(N), in particular N>25 */
    4632             : /* Returns [[lim,p], mf (weight 2), p*lim x dim matrix, echelonized series] */
    4633             : static GEN
    4634        1722 : mfwt1_pre(long N)
    4635             : {
    4636        1722 :   GEN M, mf = mfinit_i(mkvec2(utoi(N), gen_2), mf_CUSP); /*not empty for N>25*/
    4637             :   long p, lim;
    4638        1722 :   if (uisprime(N))
    4639             :   {
    4640         378 :     p = 2; /*N>25 is not 2 */
    4641         378 :     lim = ceilA1(N, 3);
    4642             :   }
    4643             :   else
    4644             :   {
    4645             :     forprime_t S;
    4646        1344 :     u_forprime_init(&S, 2, N);
    4647        1344 :     while ((p = u_forprime_next(&S)))
    4648        2429 :       if (N % p) break;
    4649        1344 :     lim = mfsturm_mf(mf) + 1;
    4650             :   }
    4651             :   /* p = smalllest prime not dividing N */
    4652        1722 :   M = bhnmat_extend_nocache(mf_get_M(mf), p*lim-1, 1, mf_get_vtf(mf));
    4653        1722 :   return mkvec3(mkvecsmall2(lim, p), mf, M);
    4654             : }
    4655             : 
    4656             : /* lg(A) > 1, E a t_POL */
    4657             : static GEN
    4658         385 : mfmatsermul(GEN A, GEN E)
    4659             : {
    4660         385 :   long j, l = lg(A), r = nbrows(A);
    4661         385 :   GEN M = cgetg(l, t_MAT);
    4662        4914 :   for (j = 1; j < l; j++)
    4663             :   {
    4664        4529 :     GEN c = RgV_to_RgX(gel(A,j), 0);
    4665        4529 :     gel(M, j) = RgX_to_RgC(RgXn_mul(c, E, r+1), r);
    4666             :   }
    4667         385 :   return M;
    4668             : }
    4669             : /* lg(Ap) > 1, Ep an Flxn */
    4670             : static GEN
    4671        2702 : mfmatsermul_Fl(GEN Ap, GEN Ep, ulong p)
    4672             : {
    4673        2702 :   long j, l = lg(Ap), r = nbrows(Ap);
    4674        2702 :   GEN M = cgetg(l, t_MAT);
    4675       45591 :   for (j = 1; j < l; j++)
    4676             :   {
    4677       42889 :     GEN c = Flv_to_Flx(gel(Ap,j), 0);
    4678       42889 :     gel(M,j) = Flx_to_Flv(Flxn_mul(c, Ep, r+1, p), r);
    4679             :   }
    4680        2702 :   return M;
    4681             : }
    4682             : 
    4683             : /* CHI mod F | N, return mfchar of modulus N.
    4684             :  * FIXME: wasteful, G should be precomputed  */
    4685             : static GEN
    4686       35399 : mfcharinduce(GEN CHI, long N)
    4687             : {
    4688             :   GEN G, chi;
    4689       35399 :   if (mfcharmodulus(CHI) == N) return CHI;
    4690        6489 :   G = znstar0(utoipos(N), 1);
    4691        6489 :   chi = zncharinduce(gel(CHI,1), gel(CHI,2), G);
    4692        6489 :   return mkvec3(G, chi, gel(CHI,3));
    4693             : }
    4694             : 
    4695             : static GEN
    4696        1701 : gmfcharno(GEN CHI)
    4697             : {
    4698        1701 :   GEN G = gel(CHI,1), chi = gel(CHI,2);
    4699        1701 :   return mkintmod(znconreyexp(G, chi), znstar_get_N(G));
    4700             : }
    4701             : static long
    4702       22736 : mfcharno(GEN CHI)
    4703             : {
    4704       22736 :   GEN n = znconreyexp(gel(CHI,1), gel(CHI,2));
    4705       22736 :   return itou(n);
    4706             : }
    4707             : 
    4708             : /* return k such that minimal mfcharacter in Galois orbit of CHI is CHI^k */
    4709             : static long
    4710       22736 : mfconreyminimize(GEN CHI)
    4711             : {
    4712       22736 :   long o = mfcharorder(CHI);
    4713       22736 :   GEN G = gel(CHI,1), cyc, chi;
    4714       22736 :   cyc = ZV_to_zv(znstar_get_cyc(G));
    4715       22736 :   chi = ZV_to_zv(znconreychar(G, gel(CHI,2)));
    4716       22736 :   return zv_cyc_minimize(cyc, chi, coprimes_zv(o));
    4717             : }
    4718             : 
    4719             : /* M is the matrix of Fourier coeffs attached to (F, C); Minv is the
    4720             :  * operator yielding the Gauss-Jordan form of M. Update M & C */
    4721             : static void
    4722         728 : Minv_RgM_mul2(GEN Minv, GEN *M, GEN *C)
    4723             : {
    4724         728 :   GEN A = gel(Minv,1), d = gel(Minv,2);
    4725         728 :   if (gequal1(d)) d = NULL;
    4726         728 :   *M = RgM_mul(*M, A); if (d) *M = RgM_Rg_div(*M,d);
    4727         728 :   *C = RgM_mul(*C, A); if (d) *C = RgM_Rg_div(*C,d);
    4728         728 : }
    4729             : /* do not use mflinear: wt1basiscols rely on F being constant across the
    4730             :  * basis where mflinear_i strips the ones matched by 0 coeffs */
    4731             : static GEN
    4732         728 : vecmflinear(GEN F, GEN C)
    4733             : {
    4734         728 :   long i, l = lg(C);
    4735         728 :   GEN v = cgetg(l, t_VEC);
    4736         728 :   if (l > 1)
    4737             :   {
    4738         728 :     GEN NK = f_NK(gel(F,1));
    4739         728 :     for (i = 1; i < l; i++) gel(v,i) = tag2(t_MF_LINEAR, NK, F, gel(C,i));
    4740             :   }
    4741         728 :   return v;
    4742             : }
    4743             : 
    4744             : /* find scalar c such that first non-0 entry of c*v is 1; return c*v
    4745             :  * (set c = NULL for 1) */
    4746             : static GEN
    4747        1421 : RgV_normalize(GEN v, GEN *pc)
    4748             : {
    4749        1421 :   long i, l = lg(v);
    4750        1421 :   *pc = NULL;
    4751        3367 :   for (i = 1; i < l; i++)
    4752             :   {
    4753        3367 :     GEN c = gel(v,i);
    4754        3367 :     if (!gequal0(c))
    4755             :     {
    4756        1421 :       if (gequal1(c)) { *pc = gen_1; return v; }
    4757         399 :       *pc = ginv(c); return RgV_Rg_mul(v, *pc);
    4758             :     }
    4759             :   }
    4760           0 :   return v;
    4761             : }
    4762             : /* ordchi != 2 mod 4 */
    4763             : static GEN
    4764        9191 : mftreatdihedral(GEN DIH, long ordchi, long biglim, GEN *pvtf)
    4765             : {
    4766             :   GEN M, Minv, C;
    4767             :   long l, i;
    4768        9191 :   l = lg(DIH); if (l == 1) return NULL;
    4769        2135 :   if (!pvtf) return DIH;
    4770         665 :   C = cgetg(l, t_VEC);
    4771         665 :   M = cgetg(l, t_MAT);
    4772        1855 :   for (i = 1; i < l; ++i)
    4773             :   {
    4774        1190 :     GEN c, v = mfcoefs_i(gel(DIH,i), biglim, 1);
    4775        1190 :     gel(M,i) = RgV_normalize(v, &c);
    4776        1190 :     gel(C,i) = Rg_col_ei(c, l-1, i);
    4777             :   }
    4778         665 :   Minv = gel(mfclean(M,ordchi),2);
    4779         665 :   Minv_RgM_mul2(Minv, &M,&C);
    4780         665 :   *pvtf = vecmflinear(DIH, C);
    4781         665 :   return M;
    4782             : }
    4783             : 
    4784             : /* D = divisors(N/FC), ord != 2 mod 4 (order of cyclotomic polynomial
    4785             :  * generating Q(chi)); dimold > 0 */
    4786             : static GEN
    4787           0 : mftreatoldstuff(GEN D, GEN Vvtf, long dimold, long ord, long biglim, GEN *pvtf)
    4788             : {
    4789             :   GEN POLCYC, M, Minv, C, V, z, vecz, MdM, dM;
    4790           0 :   long i, j, dAF = 1, ld = lg(D)-1;
    4791           0 :   for (j = 1; j < ld; j++)
    4792             :   {
    4793           0 :     GEN vtf = gel(Vvtf, j);
    4794           0 :     if (typ(vtf) != t_INT) dAF += mynumdivu(D[ld-j]) * (lg(vtf)-1);
    4795             :   }
    4796           0 :   C = cgetg(dAF, t_VEC);
    4797           0 :   M = cgetg(dAF, t_MAT);
    4798           0 :   V = cgetg(dAF, t_VEC);
    4799           0 :   for (j = i = 1; j < ld; j++)
    4800             :   {
    4801           0 :     GEN vtf = gel(Vvtf,j), Dj;
    4802             :     long lj, j1, j2;
    4803           0 :     if (typ(vtf) == t_INT) continue;
    4804           0 :     Dj = mydivisorsu(D[ld-j]);
    4805           0 :     lj = lg(Dj);
    4806           0 :     for (j1 = 1; j1 < lg(vtf); j1++)
    4807             :     {
    4808           0 :       GEN F = gel(vtf, j1);
    4809           0 :       for (j2 = 1; j2 < lj; j2++, i++)
    4810             :       {
    4811           0 :         GEN c, Fd = mfbd(F, Dj[j2]), v = mfcoefs_i(Fd, biglim, 1);
    4812           0 :         gel(M,i) = RgV_normalize(v, &c);
    4813           0 :         gel(C,i) = Rg_col_ei(c, dAF-1, i);
    4814           0 :         gel(V,i) = Fd;
    4815             :       }
    4816             :     }
    4817             :   }
    4818           0 :   POLCYC = (ord == 1)? NULL: polcyclo(ord, fetch_user_var("t"));
    4819           0 :   MdM = Q_remove_denom(M, &dM);
    4820           0 :   z = POLCYC? ZabM_indexrank(liftpol_shallow(MdM), POLCYC, ord)
    4821           0 :             : ZM_indexrank(MdM);
    4822           0 :   vecz = gel(z,2);
    4823           0 :   if (lg(vecz)-1 != dimold) pari_err_BUG("mfwt1basis [old]");
    4824           0 :   C = shallowmatextract(C, vecz, vecz);
    4825           0 :   M = vecpermute(M, vecz);
    4826           0 :   V = vecpermute(V, vecz);
    4827             : 
    4828           0 :   Minv = gel(mfclean2(M, gel(z,1), POLCYC, ord, dM), 2);
    4829           0 :   Minv_RgM_mul2(Minv, &M,&C);
    4830           0 :   *pvtf = vecmflinear(V, C);
    4831           0 :   return M;
    4832             : }
    4833             : 
    4834             : static GEN
    4835         105 : mfstabiter(GEN M, GEN A2, GEN E1inv, long lim, GEN P, long ordchi)
    4836             : {
    4837             :   GEN A, VC, con;
    4838         105 :   E1inv = primitive_part(E1inv, &con);
    4839         105 :   VC = con? ginv(con): gen_1;
    4840         105 :   A = mfmatsermul(A2, E1inv);
    4841             :   while(1)
    4842             :   {
    4843         168 :     long lA = lg(A);
    4844         168 :     GEN Ash = rowslice(A, 1, lim);
    4845         168 :     GEN R = shallowconcat(RgM_mul(M, A), Ash);
    4846         168 :     GEN B = QabM_ker(R, P, ordchi);
    4847         168 :     if (lg(B) == 1) return mkvec2(A, VC);
    4848         168 :     if (lg(B) == lA) break;
    4849          63 :     B = rowslice(B, 1, lA-1);
    4850          63 :     if (ordchi != 1) B = gmodulo(B, P);
    4851          63 :     A = Q_primitive_part(RgM_mul(A,B), &con);
    4852          63 :     VC = gmul(VC,B); /* first VC is a scalar, then a RgM */
    4853          63 :     if (con) VC = RgM_Rg_div(VC, con);
    4854          63 :   }
    4855         105 :   return mkvec2(A, VC);
    4856             : }
    4857             : static long
    4858         210 : mfstabitermodp(GEN Mp, GEN Ap, long p, long lim)
    4859             : {
    4860         210 :   GEN VC = NULL;
    4861             :   while (1)
    4862             :   {
    4863         238 :     long lAp = lg(Ap);
    4864         238 :     GEN Ashp = rowslice(Ap, 1, lim);
    4865         238 :     GEN Rp = shallowconcat(Flm_mul(Mp, Ap, p), Ashp);
    4866         238 :     GEN Bp = Flm_ker(Rp, p);
    4867         238 :     if (lg(Bp) == 1) return 0;
    4868         154 :     if (lg(Bp) == lAp) return lAp-1;
    4869          28 :     Bp = rowslice(Bp, 1, lAp-1);
    4870          28 :     Ap = Flm_mul(Ap, Bp, p);
    4871          28 :     VC = VC? Flm_mul(VC, Bp, p): Bp;
    4872          28 :   }
    4873             : }
    4874             : 
    4875             : static GEN
    4876         182 : mfintereis(GEN A, GEN M2, GEN y, GEN den, GEN E2, GEN P, long ordchi)
    4877             : {
    4878         182 :   pari_sp av = avma;
    4879         182 :   GEN z, M1 = mfmatsermul(A,E2), M1den = is_pm1(den)? M1: RgM_Rg_mul(M1,den);
    4880         182 :   M2 = RgM_mul(M2, rowpermute(M1, y));
    4881         182 :   z = QabM_ker(RgM_sub(M2,M1den), P, ordchi);
    4882         182 :   if (ordchi != 1) z = gmodulo(z, P);
    4883         182 :   return gerepilecopy(av, mkvec2(RgM_mul(A, z), z));
    4884             : }
    4885             : static GEN
    4886        1484 : mfintereismodp(GEN A, GEN M2, GEN E2, ulong p)
    4887             : {
    4888        1484 :   pari_sp av = avma;
    4889        1484 :   GEN M1 = mfmatsermul_Fl(A, E2, p), z;
    4890        1484 :   long j, lx = lg(A);
    4891        1484 :   z = Flm_ker(shallowconcat(M1, M2), p);
    4892        1484 :   for (j = lg(z) - 1; j; j--) setlg(z[j], lx);
    4893        1484 :   return gerepilecopy(av, mkvec2(Flm_mul(A, z, p), z));
    4894             : }
    4895             : 
    4896             : static GEN
    4897        1015 : mfcharinv_i(GEN CHI)
    4898             : {
    4899        1015 :   GEN G = gel(CHI,1), chi = zncharconj(G, gel(CHI,2));
    4900        1015 :   return mkvec3(G, chi, gel(CHI,3));
    4901             : }
    4902             : 
    4903             : /* upper bound dim S_1(Gamma_0(N),chi) performing the linear algebra mod p */
    4904             : static long
    4905        1015 : mfwt1dimmodp(GEN A, GEN ES, GEN M, long ordchi, long dimdih, long lim, long plim)
    4906             : {
    4907             :   GEN Ap, C, ApF, ES1p, ES1INVp, Mp, VC, ApC;
    4908             :   ulong r, p;
    4909             :   long i;
    4910             : 
    4911        1015 :   ordchi = ord_canon(ordchi);
    4912        1015 :   r = QabM_init(ordchi, &p);
    4913        1015 :   ApF = Ap = QabM_to_Flm(A, r, p);
    4914        1015 :   VC = NULL;
    4915        1015 :   ES1p = QabX_to_Flx(gel(ES,1), r, p);
    4916        1015 :   if (lg(ES) >= 3)
    4917             :   {
    4918        1008 :     GEN M2 = mfmatsermul_Fl(ApF, ES1p, p);
    4919        1687 :     for (i = 2; i < lg(ES); ++i)
    4920             :     {
    4921        1484 :       GEN ESip = QabX_to_Flx(gel(ES,i), r, p);
    4922        1484 :       ApC = mfintereismodp(Ap, M2, ESip, p);
    4923        1484 :       Ap = gel(ApC,1);
    4924        1484 :       C = gel(ApC,2); VC = VC? Flm_mul(VC, C, p): C;
    4925        1484 :       if (lg(Ap) == 1) return 0;
    4926         812 :       if (lg(Ap) == dimdih+1) return dimdih;
    4927             :     }
    4928             :   }
    4929             :   /* intersection of Eisenstein series quotients non empty: use Schaeffer */
    4930         210 :   ES1INVp = Flxn_inv(ES1p, plim, p);
    4931         210 :   Ap = mfmatsermul_Fl(Ap, ES1INVp, p);
    4932         210 :   Mp = QabM_to_Flm(M, r, p);
    4933         210 :   return mfstabitermodp(Mp, Ap, p, lim);
    4934             : }
    4935             : 
    4936             : 
    4937             : /* Compute the full S_1(\G_0(N),\chi). If pvtf is NULL, only the dimension
    4938             :  * dim, in the form of a vector having dim components. Otherwise output
    4939             :  * a basis: ptvf contains a pointer to the vector of forms, and the
    4940             :  * program returns the corresponding matrix of Fourier expansions.
    4941             :  * ptdimdih gives the dimension of the subspace generated by dihedral forms;
    4942             :  * TMP is from mfwt1_pre or NULL. If non NULL, Vvtf is the vector
    4943             :  * of the vtf's of S_1(\G_0(M),\chi) for f(\chi)\mid M\mid N, M < N. */
    4944             : static GEN
    4945       10143 : mfwt1basis(long N, GEN CHI, GEN TMP, GEN *pvtf, long *ptdimdih, GEN Vvtf)
    4946             : {
    4947             :   GEN ES, mf, A, M, Tp, tmp1, tmp2, den, CHIP;
    4948             :   GEN vtf, ESA, VC, C, Ash, POLCYC, ES1, ES1INV, DIH, D, a0, a0i;
    4949             :   long N1, plim, lim, biglim, i, p, dA, dimp, ordchi, dimdih;
    4950             :   long lim2, dimold, ld, FC;
    4951             : 
    4952       10143 :   if (ptdimdih) *ptdimdih = 0;
    4953       10143 :   if (pvtf) *pvtf = NULL;
    4954       10143 :   if (wt1empty(N) || mfcharparity(CHI) != -1) return NULL;
    4955       10066 :   ordchi = ord_canon(mfcharorder(CHI));
    4956       10066 :   if (uisprime(N) && ordchi > 4) return NULL;
    4957       10052 :   if (!pvtf)
    4958             :   {
    4959        6832 :     dimdih = mfdihedralcuspdim(N, CHI);
    4960        6832 :     DIH = zerovec(dimdih);
    4961             :   }
    4962             :   else
    4963             :   {
    4964        3220 :     DIH = mfdihedralcusp(N, CHI);
    4965        3220 :     dimdih = lg(DIH) - 1;
    4966             :   }
    4967       10052 :   if (ptdimdih) *ptdimdih = dimdih;
    4968       10052 :   if (DEBUGLEVEL) err_printf("dimdih = %ld\n", dimdih);
    4969       10052 :   biglim = mfsturmNk(N, 2);
    4970       10052 :   if (N < 200 && N != 124 && N != 133 && N != 148 && N != 171)
    4971        9037 :     return mftreatdihedral(DIH, ordchi, biglim, pvtf);
    4972        1015 :   if (!TMP) TMP = mfwt1_pre(N);
    4973        1015 :   tmp1= gel(TMP,1); lim = tmp1[1]; p = tmp1[2]; plim = p*lim;
    4974        1015 :   mf  = gel(TMP,2);
    4975        1015 :   A   = gel(TMP,3);
    4976             :   /* A p*lim x dim matrix, res echelonized series, B transf. matrix */
    4977        1015 :   vtf = mf_get_vtf(mf);
    4978        1015 :   ESA = mfeisenbasis_i(N, 1, mfcharinv_i(CHI));
    4979        1015 :   ES = RgM_to_RgXV(mfvectomat(ESA, plim+1), 0);
    4980        1015 :   ES1 = gel(ES,1); /* does not vanish at oo */
    4981        1015 :   Tp = Tpmat(p, lim, CHI);
    4982        1015 :   dimp = mfwt1dimmodp(A, ES, Tp, ordchi, dimdih, lim, plim);
    4983        1015 :   if (!dimp) return NULL;
    4984         259 :   if (DEBUGLEVEL) err_printf("dimmodp = %ld\n", dimp);
    4985         259 :   if (dimp == dimdih) return mftreatdihedral(DIH, ordchi, biglim, pvtf);
    4986             :   /* we have dimold <= dim <= dimp, so dimp == dimold => dim = dimold */
    4987         105 :   CHIP = mfchartoprimitive(CHI, &FC);
    4988         105 :   N1 = N/FC; D = mydivisorsu(N1);
    4989         105 :   if (!Vvtf) Vvtf = mfwt1basisdiv(D, CHIP);
    4990         105 :   ld = lg(D)-1; /* remove N/FC */
    4991         189 :   for (i = 1, dimold = 0; i < ld; ++i)
    4992             :   {
    4993          84 :     GEN vtfi = gel(Vvtf, i);
    4994          84 :     if (!gequal0(vtfi)) dimold -= mubeta(D[ld-i])*(lg(vtfi) - 1);
    4995             :   }
    4996         105 :   if (DEBUGLEVEL) err_printf("dimold = %ld\n", dimold);
    4997         105 :   if (dimp == dimold)
    4998             :   {
    4999           0 :     if (!pvtf) return zerovec(dimold);
    5000           0 :     return mftreatoldstuff(D, Vvtf, dimold, ordchi, biglim, pvtf);
    5001             :   }
    5002         105 :   if (DEBUGLEVEL) err_printf("begin hard stuff\n");
    5003         105 :   VC = matid(lg(A) - 1);
    5004         105 :   lim2 = (3*lim)/2 + 1;
    5005         105 :   Ash = rowslice(A, 1, lim2);
    5006         105 :   POLCYC = (ordchi == 1)? NULL: polcyclo(ordchi, fetch_user_var("t"));
    5007         105 :   if (lg(ES) >= 3)
    5008             :   {
    5009             :     pari_sp btop;
    5010          98 :     GEN v, y, M2M2I, M2I, M2 = mfmatsermul(Ash, ES1);
    5011          98 :     M2I = QabM_pseudoinv(M2, POLCYC, ordchi, &v, &den);
    5012          98 :     y = gel(v,1);
    5013          98 :     M2M2I = RgM_mul(M2,M2I);
    5014          98 :     btop = avma;
    5015         280 :     for (i = 2; i < lg(ES); ++i)
    5016             :     {
    5017         182 :       GEN APC = mfintereis(Ash, M2M2I, y, den, gel(ES,i), POLCYC,ordchi);
    5018         182 :       Ash = gel(APC,1);
    5019         182 :       if (lg(Ash) == 1) return NULL;
    5020         182 :       VC = RgM_mul(VC, gel(APC,2));
    5021         182 :       if (gc_needed(btop, 1))
    5022             :       {
    5023           0 :         if (DEBUGMEM > 1) pari_warn(warnmem,"mfwt1basis i = %ld", i);
    5024           0 :         gerepileall(btop, 2, &Ash, &VC);
    5025             :       }
    5026             :     }
    5027             :   }
    5028         105 :   A = RgM_mul(A, vecslice(VC,1, lg(Ash)-1));
    5029         105 :   a0 = gel(ES1,2); /* non-zero */
    5030         105 :   if (gequal1(a0)) a0 = a0i = NULL;
    5031             :   else
    5032             :   {
    5033         105 :     a0i = ginv(a0);
    5034         105 :     ES1 = RgX_Rg_mul(RgX_unscale(ES1,a0), a0i);
    5035             :   }
    5036         105 :   ES1INV = RgXn_inv(ES1, plim-1);
    5037         105 :   if (a0) ES1INV = RgX_Rg_mul(RgX_unscale(ES1INV, a0i), a0i);
    5038         105 :   tmp2 = mfstabiter(Tp, A, ES1INV, lim, POLCYC, ordchi);
    5039         105 :   A = gel(tmp2,1); dA = lg(A);
    5040         105 :   if (dA == 1) return NULL;
    5041         105 :   VC = gmul(VC, gel(tmp2,2));
    5042         105 :   C = cgetg(dA, t_VEC);
    5043         105 :   M = cgetg(dA, t_MAT);
    5044         336 :   for (i = 1; i < dA; ++i)
    5045             :   {
    5046         231 :     GEN c, v = gel(A,i);
    5047         231 :     gel(M,i) = RgV_normalize(v, &c);
    5048         231 :     gel(C,i) = RgC_Rg_mul(gel(VC,i), c);
    5049             :   }
    5050         105 :   if (pvtf)
    5051             :   {
    5052          63 :     GEN v, Minv = gel(mfclean(M, ordchi), 2), ES1clos = gel(ESA,1);
    5053          63 :     Minv_RgM_mul2(Minv, &M,&C);
    5054          63 :     *pvtf = v = vecmflinear(vtf, C);
    5055          63 :     for (i = 1; i < dA; i++) gel(v,i) = mfdiv_val(gel(v,i), ES1clos, 0);
    5056             :   }
    5057         105 :   return M;
    5058             : }
    5059             : 
    5060             : /* mfwt1basis for all divisors; D = divisors(N/FC), CHIP primitive */
    5061             : static GEN
    5062          98 : mfwt1basisdiv(GEN D, GEN CHIP)
    5063             : {
    5064          98 :   long i, FC = mfcharmodulus(CHIP), nD = lg(D) - 1;
    5065             :   GEN Vvtf;
    5066             : 
    5067          98 :   Vvtf = zerovec(nD - 1);
    5068         182 :   for (i = 1; i < nD; i++) /* skip N/FC */
    5069             :   {
    5070             :     GEN z, vtf, Vvtfs;
    5071          84 :     long d = D[i], M = d*FC, j, ct;
    5072          84 :     if (wt1empty(M)) continue;
    5073          28 :     Vvtfs = cgetg(i, t_VEC);
    5074          49 :     for (j = ct = 1; j < i; j++)
    5075          21 :       if (d % D[j] == 0) gel(Vvtfs, ct++) = gel(Vvtf, j);
    5076          28 :     setlg(Vvtfs, ct);
    5077          28 :     z = mfwt1basis(M, mfcharinduce(CHIP,M), NULL, &vtf, NULL, Vvtfs);
    5078          28 :     if (z) gel(Vvtf, i) = vtf;
    5079             :   }
    5080          98 :   return Vvtf;
    5081             : }
    5082             : 
    5083             : static GEN
    5084        3213 : mfwt1init(long N, GEN CHI, GEN TMP)
    5085             : {
    5086        3213 :   GEN mf1, vtf, M = mfwt1basis(N, CHI, TMP, &vtf, NULL, NULL);
    5087        3213 :   if (!M) return NULL;
    5088         700 :   mf1 = mkvec4(stoi(N), gen_1, CHI, utoi(mf_CUSP));
    5089         700 :   return mkvec5(mf1, cgetg(1,t_VEC), vtf, gen_0, mfclean(M, mfcharorder(CHI)));
    5090             : }
    5091             : 
    5092             : static GEN
    5093        1701 : fmt_dim(GEN CHI, long d, long dih)
    5094        1701 : { return mkvec4(gmfcharorder(CHI), gmfcharno(CHI), utoi(d), stoi(dih)); }
    5095             : 
    5096             : static GEN
    5097        1617 : mfwt1chars(long N)
    5098             : {
    5099        1617 :   long i, j, l, Nprime = uisprime(N);
    5100        1617 :   GEN w = mfchargalois(N, 1, Nprime? mkvecsmall2(2,4): NULL); /* Tate theorem */
    5101        1617 :   l = lg(w); w = leafcopy(w);
    5102       11459 :   for (i = j = 1; i < l; i++)
    5103             :   {
    5104        9842 :     GEN CHI = gel(w,i);
    5105        9842 :     if (mfcharparity(CHI) == -1)
    5106             :     {
    5107        9842 :       if (Nprime) { long o = mfcharorder(CHI); if (o!=2 && o!=4) continue; }
    5108        9842 :       gel(w,j++) = CHI;
    5109             :     }
    5110             :   }
    5111        1617 :   return w;
    5112             : }
    5113             : 
    5114             : static GEN
    5115         546 : mfEMPTY(GEN mf1)
    5116             : {
    5117         546 :   GEN M = mkvec3(cgetg(1,t_VECSMALL), cgetg(1,t_MAT),cgetg(1,t_MAT));
    5118         546 :   return mkvec5(mf1, cgetg(1,t_VEC), cgetg(1,t_VEC), cgetg(1,t_VEC), M);
    5119             : }
    5120             : static GEN
    5121           0 : mfwt1EMPTY(long N, GEN CHI, long space)
    5122             : {
    5123           0 :   GEN mf1 = mkvec4(utoi(N), gen_1, CHI, utoi(space));
    5124           0 :   return mfEMPTY(mf1);
    5125             : }
    5126             : static GEN
    5127           0 : mfwt1EMPTYall(long N, GEN vCHI, long space)
    5128             : {
    5129           0 :   long i, l = lg(vCHI);
    5130           0 :   GEN w = cgetg(l, t_VEC);
    5131           0 :   for (i = 1; i < l; i++) gel(w,i) = mfwt1EMPTY(N, gel(vCHI,i), space);
    5132           0 :   return w;
    5133             : }
    5134             : 
    5135             : /* Compute all $S_1(\G_0(N),\chi)$ for all $\chi$ up to Galois conjugation
    5136             :  * w is NULL or a vector of mfchars. */
    5137             : 
    5138             : static GEN
    5139        1064 : mfwt1initall(long N, GEN vCHI, long space)
    5140             : {
    5141        1064 :   GEN res, TMP, w, z = gen_0;
    5142             :   long i, j, l;
    5143             : 
    5144        1064 :   if (space != mf_NEW && space != mf_CUSP) pari_err_FLAG("mfwt1initall");
    5145        1064 :   if (wt1empty(N)) return vCHI? mfwt1EMPTYall(N,vCHI,space): cgetg(1,t_VEC);
    5146         476 :   w = vCHI? vCHI: mfwt1chars(N);
    5147         476 :   l = lg(w); if (l == 1) return cgetg(1,t_VEC);
    5148         476 :   TMP = mfwt1_pre(N);
    5149         476 :   res = cgetg(l, t_VEC);
    5150        3598 :   for (i = j = 1; i < l; ++i)
    5151             :   {
    5152        3122 :     GEN CHI = gel(w,i);
    5153        3122 :     z = mfwt1init(N, CHI, TMP);
    5154        3122 :     if (space == mf_NEW) z = mfwt1_cusptonew(z);
    5155        3122 :     if (vCHI && !z) z = mfwt1EMPTY(N, CHI, space);
    5156        3122 :     if (z) gel(res, j++) = z;
    5157             :   }
    5158         476 :   setlg(res,j); return res;
    5159             : }
    5160             : 
    5161             : static GEN
    5162        3003 : mfdim0all(GEN w)
    5163             : {
    5164             :   GEN v, z;
    5165             :   long i, l;
    5166        3003 :   if (!w) return cgetg(1,t_VEC);
    5167           7 :   l = lg(w); v = cgetg(l, t_VEC); z = zerovec(2);
    5168           7 :   for (i = 1; i < l; i++) gel(v,i) = z;
    5169           7 :   return v;
    5170             : }
    5171             : static GEN
    5172        4130 : mfwt1dimall(long N, GEN vCHI)
    5173             : {
    5174             :   GEN z, TMP, w;
    5175             :   long i, j, l;
    5176        4130 :   if (wt1empty(N)) return mfdim0all(vCHI);
    5177        1134 :   w = vCHI? vCHI: mfwt1chars(N);
    5178        1134 :   l = lg(w); if (l == 1) return cgetg(1,t_VEC);
    5179        1134 :   z = cgetg(l, t_VEC);
    5180        1134 :   TMP = mfwt1_pre(N);
    5181        7868 :   for (i = j = 1; i < l; ++i)
    5182             :   {
    5183             :     long d, dimdih;
    5184        6734 :     GEN CHI = gel(w,i), b = mfwt1basis(N, CHI, TMP, NULL, &dimdih, NULL);
    5185        6734 :     d = b? lg(b)-1: 0;
    5186        6734 :     if (vCHI)
    5187          28 :       gel(z,j++) = mkvec2s(d, dimdih);
    5188        6706 :     else if (d)
    5189        1428 :       gel(z,j++) = fmt_dim(CHI, d, dimdih);
    5190             :   }
    5191        1134 :   setlg(z,j); return z;
    5192             : }
    5193             : 
    5194             : long
    5195          35 : mfwt1dim(long N, GEN CHI)
    5196             : {
    5197          35 :   pari_sp av = avma;
    5198          35 :   GEN M = mfwt1basis(N, CHI, NULL, NULL, NULL, NULL);
    5199          35 :   avma = av; return M? lg(M)-1: 0;
    5200             : }
    5201             : 
    5202             : /* Dimension of $S_1(\G_1(N))$ */
    5203             : /* Warning: vres[i] is of the form
    5204             :    [N,[Vecsmall(order,conrey,dimension),Vecsmall(or...)]]; Change if format
    5205             :    changes. */
    5206             : static long
    5207        4116 : mfwt1dim_i(long N)
    5208             : {
    5209        4116 :   pari_sp av = avma;
    5210        4116 :   GEN v = mfwt1dimall(N, NULL);
    5211        4116 :   long i, ct = 0, l = lg(v);
    5212        5537 :   for (i = 1; i < l; i++)
    5213             :   {
    5214        1421 :     GEN w = gel(v, i);
    5215        1421 :     ct += itou(gel(w,3))*myeulerphiu(itou(gel(w,1)));
    5216             :   }
    5217        4116 :   avma = av; return ct;
    5218             : }
    5219             : 
    5220             : static GEN
    5221          56 : mfwt1newdimall(long N, GEN vCHI)
    5222             : {
    5223             :   GEN z, w, vTMP, D;
    5224             :   long i, c, lw;
    5225          56 :   if (wt1empty(N)) return mfdim0all(vCHI);
    5226          56 :   w = vCHI? vCHI: mfwt1chars(N);
    5227          56 :   lw = lg(w); if (lw == 1) return cgetg(1,t_VEC);
    5228          56 :   D = mydivisorsu(N);
    5229          56 :   vTMP = const_vec(N, NULL);
    5230          56 :   gel(vTMP,N) = mfwt1_pre(N);
    5231          56 :   z = cgetg(lw, t_VEC);
    5232         182 :   for (i = c = 1; i < lw; i++)
    5233             :   {
    5234         126 :     long j, l, F, S = 0, dimdihnew = 0, dimdih = 0;
    5235         126 :     GEN Di, CHI = gel(w, i), CHIP = mfchartoprimitive(CHI,&F);
    5236         126 :     GEN b = mfwt1basis(N, CHI, gel(vTMP,N), NULL, &dimdih, NULL);
    5237         126 :     if (!b)
    5238             :     {
    5239          56 :       if (vCHI) gel(z, c++) = zerovec(2);
    5240          56 :       continue;
    5241             :     }
    5242          70 :     S = lg(b) - 1;
    5243          70 :     dimdihnew = dimdih;
    5244          70 :     Di = mydivisorsu(N/F); l = lg(Di)-1; /* skip last M = N */
    5245          77 :     for (j = 1; j < l; j++)
    5246             :     {
    5247           7 :       long M = D[j]*F, mb;
    5248             :       GEN TMP;
    5249           7 :       if (wt1empty(M) || !(mb = mubeta(N/M))) continue;
    5250           7 :       TMP = gel(vTMP,M);
    5251           7 :       if (!TMP) gel(vTMP,M) = TMP = mfwt1_pre(M);
    5252           7 :       b = mfwt1basis(M, CHIP, TMP, NULL, &dimdih, NULL);
    5253           7 :       if (b) { S += mb * (lg(b)-1); dimdihnew += mb * dimdih; }
    5254             :     }
    5255          70 :     if (vCHI)
    5256          63 :       gel(z,c++) = mkvec2s(S, dimdihnew);
    5257           7 :     else if (S)
    5258           7 :       gel(z, c++) = fmt_dim(CHI, S, dimdihnew);
    5259             :   }
    5260          56 :   setlg(z,c); return z;
    5261             : }
    5262             : 
    5263             : static GEN
    5264          14 : mfwt1olddimall(long N, GEN vCHI)
    5265             : {
    5266             :   long i, j, l;
    5267             :   GEN z, w;
    5268          14 :   if (wt1empty(N)) return mfdim0all(vCHI);
    5269          14 :   w = vCHI? vCHI: mfwt1chars(N);
    5270          14 :   l = lg(w); z = cgetg(l, t_VEC);
    5271          49 :   for (i = j = 1; i < l; ++i)
    5272             :   {
    5273          35 :     GEN CHI = gel(w,i);
    5274          35 :     long d = mfolddim(N, 1, CHI);
    5275          35 :     if (vCHI)
    5276          28 :       gel(z,j++) = mkvec2s(d,d?-1:0);
    5277           7 :     else if (d)
    5278           0 :       gel(z, j++) = fmt_dim(CHI, d, -1);
    5279             :   }
    5280          14 :   setlg(z,j); return z;
    5281             : }
    5282             : 
    5283             : static long
    5284        1050 : mfwt1newdim(long N)
    5285             : {
    5286             :   GEN D;
    5287             :   long N2, i, l, S;
    5288        1050 :   newd_params(N, &N2); /* will ensure mubeta != 0 */
    5289        1050 :   D = mydivisorsu(N/N2); l = lg(D);
    5290        1050 :   S = mfwt1dim_i(N); if (!S) return 0;
    5291        2471 :   for (i = 2; i < l; ++i)
    5292             :   {
    5293        2009 :     long M = D[l-i]*N2, d = mfwt1dim_i(M);
    5294        2009 :     if (d) S += mubeta(D[i]) * d;
    5295             :   }
    5296         462 :   return S;
    5297             : }
    5298             : 
    5299             : /* Guess Galois type of wt1 eigenforms. */
    5300             : /* NK can be mf or [N,1,CHI] */
    5301             : static long
    5302          42 : mfisdihedral(GEN F, GEN DIH)
    5303             : {
    5304          42 :   GEN vG = gel(DIH,1), M = gel(DIH,2), v;
    5305             :   long i, l;
    5306          42 :   if (lg(M) == 1) return 0;
    5307          21 :   v = RgM_RgC_invimage(M, mftocol(F, nbrows(M)-1));
    5308          21 :   if (!v) return 0;
    5309          21 :   l = lg(v);
    5310          21 :   for (i = 1; i < l; i++)
    5311          21 :     if (!gequal0(gel(v,i)))
    5312             :     {
    5313          21 :       GEN G = gel(vG,i), bnr = gel(G,2), w = gel(G,3);
    5314          21 :       GEN gen, cyc = bnr_get_cyc(bnr), D = gel(cyc,1);
    5315          21 :       GEN f = bnr_get_mod(bnr), nf = bnr_get_nf(bnr);
    5316          21 :       GEN con = gel(galoisconj(nf,gen_1), 2);
    5317          21 :       GEN f0 = gel(f,1), f0b = galoisapply(nf, con, f0);
    5318          21 :       GEN xin = zv_to_ZV(gel(w,2)); /* xi(bnr.gen[i]) = e(xin[i] / D) */
    5319             :       long e, j, L, n;
    5320          21 :       if (!gequal(f0,f0b))
    5321             :       { /* finite part of conductor not ambiguous */
    5322          14 :         GEN a = idealmul(nf, f0, idealdivexact(nf, f0b, idealadd(nf, f0, f0b)));
    5323          14 :         GEN bnr0 = bnr;
    5324          14 :         bnr = bnrinit0(bnr_get_bnf(bnr), mkvec2(a, gel(f,2)), 1);
    5325          14 :         xin = RgV_RgM_mul(xin, bnrsurjection(bnr, bnr0));
    5326             :         /* still xi(gen[i]) = e(xin[i] / D), for the new generators */
    5327             :       }
    5328          21 :       gen = bnr_get_gen(bnr); L = lg(gen);
    5329          35 :       for (j = 1, e = itou(D); j < L; j++)
    5330             :       {
    5331          28 :         GEN Ng = idealnorm(nf, gel(gen,j));
    5332          28 :         GEN a = shifti(gel(xin,j), 1); /* xi(g_j^2) = e(a/D) */
    5333          28 :         GEN b = FpV_dotproduct(xin, isprincipalray(bnr,Ng), D);
    5334          28 :         GEN m = Fp_sub(a, b, D); /* xi(g_j/\bar{g_j}) = e(m/D) */
    5335          28 :         e = ugcd(e, itou(m)); if (e == 1) break;
    5336             :       }
    5337          21 :       n = itou(D) / e;
    5338          21 :       return n == 1? 4: 2*n;
    5339             :     }
    5340           0 :   return 0;
    5341             : }
    5342             : 
    5343             : static ulong
    5344         322 : radical_u(ulong n)
    5345         322 : { return zv_prod(gel(myfactoru(n),1)); }
    5346             : 
    5347             : /* list of fundamental discriminants unramified outside N */
    5348             : static GEN
    5349           7 : mfunram(long N)
    5350             : {
    5351           7 :   long cN = radical_u(N >> vals(N)), l, c, i;
    5352           7 :   GEN D = divisorsu(cN), res;
    5353           7 :   l = lg(D);
    5354           7 :   res = cgetg(6*l - 5, t_VECSMALL);
    5355          21 :   for (i = c = 1; i < l; ++i)
    5356             :   {
    5357          14 :     long d = D[i], d4 = d & 3L; /* d odd, squarefree */
    5358          14 :     if (d > 1 && d4 == 1) res[c++] = d;
    5359          14 :     if (d4 == 3) res[c++] = -d;
    5360          14 :     if ((N&1L) == 0)
    5361             :     {
    5362          14 :       if (d4 == 2 || d4 == 3) res[c++] = 4*d;
    5363          14 :       if (d4 == 2 || d4 == 1) res[c++] =-4*d;
    5364          14 :       if (d & 1) { res[c++] = 8*d; res[c++] = -8*d; }
    5365             :     }
    5366             :   }
    5367           7 :   setlg(res, c); return res;
    5368             : }
    5369             : /* list of negative fundamental discriminants unramified outside N */
    5370             : static GEN
    5371          14 : mfunramneg(long N)
    5372             : {
    5373          14 :   long cN = radical_u(N >> vals(N)), l, c, i;
    5374          14 :   GEN D = divisorsu(cN), res;
    5375          14 :   l = lg(D);
    5376          14 :   res = cgetg(3*l - 2, t_VECSMALL);
    5377          56 :   for (i = c = 1; i < l; ++i)
    5378             :   {
    5379          42 :     long d = D[i], d4 = d & 3L; /* d odd, squarefree */
    5380          42 :     if (d4 == 3) res[c++] = -d;
    5381          42 :     if ((N&1L) == 0)
    5382             :     {
    5383          14 :       if (d4 == 2 || d4 == 1) res[c++] =-4*d;
    5384          14 :       if (d & 1) { res[c++] = 8*d; res[c++] = -8*d; }
    5385             :     }
    5386             :   }
    5387          14 :   setlg(res, c); return res;
    5388             : }
    5389             : 
    5390             : /* Return 1 if F is definitely not S4 type; return 0 on failure. */
    5391             : static long
    5392           7 : mfisnotS4(long N, GEN w)
    5393             : {
    5394           7 :   GEN D = mfunram(N);
    5395           7 :   long i, lD = lg(D), lw = lg(w);
    5396          56 :   for (i = 1; i < lD; i++)
    5397             :   {
    5398          49 :     long p, d = D[i], ok = 0;
    5399         154 :     for (p = 2; p < lw; p++)
    5400         154 :       if (w[p] && kross(d,p) == -1) { ok = 1; break; }
    5401          49 :     if (!ok) return 0;
    5402             :   }
    5403           7 :   return 1;
    5404             : }
    5405             : 
    5406             : /* Return 1 if F is definitely not A5 type; return 0 on failure. */
    5407             : static long
    5408           7 : mfisnotA5(GEN van)
    5409             : {
    5410           7 :   long l = lg(van) - 2, i, vz = 1;
    5411           7 :   GEN pol5 = gsubgs(gsqr(pol_x(vz)), 5);
    5412        1400 :   for (i = 1; i < l; i++)
    5413             :   {
    5414        1393 :     GEN c = gel(van, i);
    5415        1393 :     if (i != 1 && !uisprime(i+1)) continue; /* only test a_0 and a_prime */
    5416         322 :     if (typ(c) == t_POLMOD)
    5417             :     {
    5418         315 :       GEN T = gel(c,1);
    5419         315 :       if (varn(T) == vz)
    5420             :       { /* K / Q(zeta_n) / Q */
    5421         315 :         GEN t = NULL, p = NULL;
    5422         315 :         if (!RgX_is_FpXQX(T, &t,&p) || p) pari_err_TYPE("mfgaloistype", c);
    5423         315 :         if (t) T = rnfequation(t,T);
    5424         315 :         if (typ(nfisincl(pol5, T)) != t_INT) return 0;
    5425             :       }
    5426             :       else
    5427             :       { /* Q(zeta_n) / Q */
    5428           0 :         long n = poliscyclo(T);
    5429           0 :         if (!n) pari_err_TYPE("mfgaloistype", c);
    5430           0 :         if (n % 5 == 0) return 0;
    5431             :       }
    5432             :     }
    5433             :   }
    5434           7 :   return 1;
    5435             : }
    5436             : 
    5437             : /* Given x = z + 1/z with z prim. root of unity of order n, find n */
    5438             : static long
    5439         357 : mffindrootof1(GEN u1)
    5440             : {
    5441         357 :   pari_sp av = avma;
    5442         357 :   GEN u0 = gen_2, u1k = u1, u2;
    5443         357 :   long c = 1;
    5444        1379 :   while (!gequalsg(2, lift_shallow(u1))) /* u1 = z^c + z^-c */
    5445             :   {
    5446         665 :     u2 = gsub(gmul(u1k, u1), u0);
    5447         665 :     u0 = u1; u1 = u2; c++;
    5448             :   }
    5449         357 :   avma = av; return c;
    5450             : }
    5451             : 
    5452             : /* we known that F is not dihedral */
    5453             : static long
    5454          21 : mfgaloistype_i(long N, GEN CHI, GEN F, long lim)
    5455             : {
    5456             :   forprime_t iter;
    5457          21 :   GEN v = mfcoefs_i(F,lim,1), w = zero_zv(lim);
    5458             :   ulong p;
    5459          21 :   u_forprime_init(&iter, 2, lim);
    5460         406 :   while((p = u_forprime_next(&iter)))
    5461             :   {
    5462             :     GEN u;
    5463             :     long n;
    5464         378 :     if (!(N%p)) continue;
    5465         357 :     u = gdiv(gsqr(gel(v, p+1)), mfchareval(CHI, p));
    5466         357 :     n = mffindrootof1(gsubgs(u,2));
    5467         357 :     if (n == 3) w[p] = 1;
    5468         357 :     if (n == 4) return -24; /* S4 */
    5469         350 :     if (n == 5) return -60; /* A5 */
    5470         350 :     if (n > 5) pari_err_DOMAIN("mfgaloistype", "form", "not a",
    5471             :                                strtoGENstr("cuspidal eigenform"), F);
    5472             :   }
    5473           7 :   if (mfisnotS4(N,w) && mfisnotA5(v)) return -12; /* A4 */
    5474           0 :   return 0; /* FAILURE */
    5475             : }
    5476             : 
    5477             : static GEN
    5478          42 : mfgaloistype0(long N, GEN CHI, GEN F, GEN DIH, long lim)
    5479             : {
    5480          42 :   pari_sp av = avma;
    5481          42 :   long t = mfisdihedral(F, DIH);
    5482          42 :   avma = av;
    5483          42 :   if (t) return stoi(t);
    5484             :   for(;;)
    5485             :   {
    5486          21 :     t = mfgaloistype_i(N, CHI, F, lim);
    5487          14 :     avma = av; if (t) return stoi(t);
    5488           0 :     lim += lim >> 1;
    5489           0 :   }
    5490             : }
    5491             : 
    5492             : /* If f is NULL, give all the galoistypes, otherwise just for f */
    5493             : GEN
    5494          49 : mfgaloistype(GEN NK, GEN f)
    5495             : {
    5496          49 :   pari_sp av = avma;
    5497             :   GEN CHI, mf, T, F, DIH;
    5498             :   long N, k, lL, i, dim, lim, SB;
    5499             : 
    5500          49 :   if (checkmf_i(NK))
    5501             :   {
    5502          14 :     mf = NK;
    5503          14 :     N = mf_get_N(mf);
    5504          14 :     k = mf_get_k(mf);
    5505          14 :     CHI = mf_get_CHI(mf);
    5506             :   }
    5507             :   else
    5508             :   {
    5509          35 :     checkNK(NK, &N, &k, &CHI, 0);
    5510          35 :     mf = f? NULL: mfinit_i(NK, mf_NEW);
    5511             :   }
    5512          49 :   if (k != 1) pari_err_DOMAIN("mfgaloistype", "k", "!=", gen_1, stoi(k));
    5513          49 :   SB = mfsturmNk(N,1) + 1;
    5514          49 :   lim = maxss(200, 3*SB);
    5515          49 :   DIH = mfdihedralnew(N,CHI);
    5516          49 :   DIH = mkvec2(DIH, mfvectomat(DIH,SB));
    5517          49 :   if (f) return gerepileuptoint(av, mfgaloistype0(N,CHI, f, DIH, lim));
    5518             : 
    5519          42 :   dim = lg(mf_get_vtf(mf)) - 1;
    5520          42 :   if (!dim) { avma = av; return cgetg(1, t_VEC); }
    5521          35 :   if (lg(mf) != 8) mf = mfsplit(mf, 0, 0);
    5522          35 :   F = mfeigenbasis(mf); lL = lg(F);
    5523          35 :   T = cgetg(lL, t_VEC);
    5524          35 :   for (i=1; i < lL; i++) gel(T,i) = mfgaloistype0(N,CHI, gel(F,i), DIH, lim);
    5525          35 :   return gerepileupto(av, T);
    5526             : }
    5527             : 
    5528             : /******************************************************************/
    5529             : /*                   Find all dihedral forms.                     */
    5530             : /******************************************************************/
    5531             : /* lim >= 2 */
    5532             : static void
    5533           7 : consttabdihedral(long lim)
    5534           7 : { cache_set(cache_DIH, mfdihedralall(mkvecsmall2(1,lim))); }
    5535             : 
    5536             : /* a ideal coprime to bnr modulus */
    5537             : static long
    5538       76797 : mfdiheval(GEN bnr, GEN w, GEN a)
    5539             : {
    5540       76797 :   GEN L, cycn = gel(w,1), chin = gel(w,2);
    5541       76797 :   long ordmax = cycn[1];
    5542       76797 :   L = ZV_to_Flv(isprincipalray(bnr,a), ordmax);
    5543       76797 :   return Flv_dotproduct(chin, L, ordmax);
    5544             : }
    5545             : 
    5546             : /* A(x^k) mod T */
    5547             : static GEN
    5548       26593 : Galois(GEN A, long k, GEN T)
    5549             : {
    5550       26593 :   if (typ(A) != t_POL) return A;
    5551        9667 :   return gmod(RgX_inflate(A, k), T);
    5552             : }
    5553             : static GEN
    5554         546 : vecGalois(GEN v, long k, GEN T)
    5555             : {
    5556             :   long i, l;
    5557         546 :   GEN w = cgetg_copy(v,&l);
    5558         546 :   for (i = 1; i < l; i++) gel(w,i) = Galois(gel(v,i), k, T);
    5559         546 :   return w;
    5560             : }
    5561             : 
    5562             : static GEN
    5563      158907 : fix_pol(GEN S, GEN Pn, int *trace)
    5564             : {
    5565      158907 :   if (typ(S) != t_POL) return S;
    5566      109039 :   setvarn(S, varn(Pn));
    5567      109039 :   S = simplify_shallow(RgX_rem(S, Pn));
    5568      109039 :   if (typ(S) == t_POL) *trace = 1;
    5569      109039 :   return S;
    5570             : }
    5571             : 
    5572             : static GEN
    5573        9751 : dihan(GEN bnr, GEN w, GEN Tinit, GEN k0j, ulong lim)
    5574             : {
    5575        9751 :   GEN nf = bnr_get_nf(bnr), f = bid_get_ideal(bnr_get_bid(bnr));
    5576        9751 :   GEN v = zerovec(lim+1), cycn = gel(w,1), Pn = gel(w,3);
    5577        9751 :   long j, ordmax = cycn[1], k0 = k0j[1], jdeg = k0j[2];
    5578        9751 :   long D = itos(nf_get_disc(nf));
    5579        9751 :   int trace = 0;
    5580             :   ulong p, n;
    5581             :   forprime_t T;
    5582             : 
    5583        9751 :   gel(v,2) = gen_1;
    5584        9751 :   u_forprime_init(&T, 2, lim);
    5585             :   /* fill in prime powers first */
    5586        9751 :   while ((p = u_forprime_next(&T)))
    5587             :   {
    5588             :     GEN vP, vchiP, S;
    5589             :     long k, lP;
    5590             :     ulong q, qk;
    5591       72422 :     if (kross(D,p) >= 0) q = p;
    5592             :     else
    5593             :     {
    5594       31192 :       q = umuluu_or_0(p,p);
    5595       31192 :       if (!q || q > lim) continue;
    5596             :     }
    5597             :     /* q = Norm P */
    5598       47152 :     vP = idealprimedec(nf, utoipos(p));
    5599       47152 :     lP = lg(vP);
    5600       47152 :     vchiP = cgetg(lP, t_VECSMALL);
    5601      127792 :     for (j = k = 1; j < lP; j++)
    5602             :     {
    5603       80640 :       GEN P = gel(vP,j);
    5604       80640 :       if (!idealval(nf, f, P)) vchiP[k++] = mfdiheval(bnr,w,P);
    5605             :     }
    5606       47152 :     if (k == 1) continue;
    5607       45570 :     setlg(vchiP, k); lP = k;
    5608       45570 :     if (lP == 2)
    5609             :     { /* one prime above p not dividing f */
    5610       14343 :       long s, s0 = vchiP[1];
    5611       24801 :       for (qk=q, s = s0;; s = Fl_add(s,s0,ordmax))
    5612             :       {
    5613       24801 :         S = mygmodulo_lift(s, ordmax, gen_1);
    5614       24801 :         gel(v, qk+1) = fix_pol(S, Pn, &trace);
    5615       24801 :         qk = umuluu_or_0(qk, q); if (!qk || qk > lim) break;
    5616       10458 :       }
    5617             :     }
    5618             :     else /* two primes above p not dividing f */
    5619             :     {
    5620       31227 :       long s, s0 = vchiP[1], s1 = vchiP[2];
    5621       47880 :       for (qk=q, k = 1;; k++)
    5622             :       { /* sum over a,b s.t. Norm( P1^a P2^b ) = q^k, i.e. a+b = k */
    5623             :         long a;
    5624       47880 :         GEN S = gen_0;
    5625      170002 :         for (a = 0; a <= k; a++)
    5626             :         {
    5627      122122 :           s = Fl_add(Fl_mul(a, s0, ordmax), Fl_mul(k-a, s1, ordmax), ordmax);
    5628      122122 :           S = gadd(S, mygmodulo_lift(s, ordmax, gen_1));
    5629             :         }
    5630       47880 :         gel(v, qk+1) = fix_pol(S, Pn, &trace);
    5631       47880 :         qk = umuluu_or_0(qk, q); if (!qk || qk > lim) break;
    5632       16653 :       }
    5633             :     }
    5634             :   }
    5635             :   /* complete with non-prime powers */
    5636      206108 :   for (n = 2; n <= lim; n++)
    5637             :   {
    5638      196357 :     GEN S, fa = myfactoru(n), P = gel(fa, 1), E = gel(fa, 2);
    5639             :     long q;
    5640      196357 :     if (lg(P) == 2) continue;
    5641             :     /* not a prime power */
    5642       86226 :     q = upowuu(P[1],E[1]);
    5643       86226 :     S = gmul(gel(v, q + 1), gel(v, n/q + 1));
    5644       86226 :     gel(v, n+1) = fix_pol(S, Pn, &trace);
    5645             :   }
    5646        9751 :   if (trace)
    5647             :   {
    5648        4914 :     if (lg(Tinit) == 4) v = QabV_tracerel(Tinit, jdeg, v);
    5649             :     /* Apply Galois Mod(k0, ordw) */
    5650        4914 :     if (k0 > 1) { GEN Pm = gel(Tinit,1); v = vecGalois(v, k0, Pm); }
    5651             :   }
    5652        9751 :   return v;
    5653             : }
    5654             : 
    5655             : /* as cyc_normalize for t_VECSMALL cyc */
    5656             : static GEN
    5657       16786 : cyc_normalize_zv(GEN cyc)
    5658             : {
    5659       16786 :   long i, o = cyc[1], l = lg(cyc); /* > 1 */
    5660       16786 :   GEN D = cgetg(l, t_VECSMALL);
    5661       16786 :   D[1] = o; for (i = 2; i < l; i++) D[i] = o / cyc[i];
    5662       16786 :   return D;
    5663             : }
    5664             : /* as char_normalize for t_VECSMALLs */
    5665             : static GEN
    5666       62370 : char_normalize_zv(GEN chi, GEN ncyc)
    5667             : {
    5668       62370 :   long i, l = lg(chi);
    5669       62370 :   GEN c = cgetg(l, t_VECSMALL);
    5670       62370 :   if (l > 1) {
    5671       62370 :     c[1] = chi[1];
    5672       62370 :     for (i = 2; i < l; i++) c[i] = chi[i] * ncyc[i];
    5673             :   }
    5674       62370 :   return c;
    5675             : }
    5676             : 
    5677             : static GEN
    5678        6237 : dihan_bnf(long D)
    5679        6237 : { setrand(gen_1); return Buchall(quadpoly(stoi(D)), 0, LOWDEFAULTPREC); }
    5680             : static GEN
    5681       20230 : dihan_bnr(GEN bnf, GEN A)
    5682       20230 : { setrand(gen_1); return bnrinit0(bnf, A, 1); }
    5683             : 
    5684             : static GEN
    5685        3395 : dihan_init(GEN bnr, GEN chi)
    5686             : {
    5687        3395 :   GEN cycn = cyc_normalize_zv( ZV_to_zv( bnr_get_cyc(bnr) ) );
    5688        3395 :   GEN chin = char_normalize_zv(chi, cycn);
    5689        3395 :   long ord = ord_canon(cycn[1]);
    5690        3395 :   GEN Pn = (ord == 1)? gen_0: polcyclo(ord, fetch_user_var("t"));
    5691        3395 :   return mkvec3(cycn, chin, Pn);
    5692             : }
    5693             : 
    5694             : /* Hecke xi * (D/.) = Dirichlet chi, return v in Q^r st chi(g_i) = e(v[i]).
    5695             :  * cycn = cyc_normalize_zv(bnr.cyc), chin = char_normalize_zv(chi,cyc) */
    5696             : static GEN
    5697       17206 : bnrchartwist2conrey(GEN chin, GEN cycn, GEN bnrconreyN, GEN kroconreyN)
    5698             : {
    5699       17206 :   long l = lg(bnrconreyN), c1 = cycn[1], i;
    5700       17206 :   GEN v = cgetg(l, t_COL);
    5701       62566 :   for (i = 1; i < l; i++)
    5702             :   {
    5703       45360 :     GEN d = gdivgs(utoi(zv_dotproduct(chin, gel(bnrconreyN,i))), c1);
    5704       45360 :     if (kroconreyN[i] < 0) d = gadd(d, ghalf);
    5705       45360 :     gel(v,i) = d;
    5706             :   }
    5707       17206 :   return v;
    5708             : }
    5709             : 
    5710             : /* chi(g_i) = e(v[i]) denormalize wrt Conrey generators orders */
    5711             : static GEN
    5712       17206 : conreydenormalize(GEN znN, GEN v)
    5713             : {
    5714       17206 :   GEN gcyc = znstar_get_conreycyc(znN), w;
    5715       17206 :   long l = lg(v), i;
    5716       17206 :   w = cgetg(l, t_COL);
    5717       62566 :   for (i = 1; i < l; i++)
    5718       45360 :     gel(w,i) = modii(gmul(gel(v,i), gel(gcyc,i)), gel(gcyc,i));
    5719       17206 :   return w;
    5720             : }
    5721             : 
    5722             : static long
    5723       41769 : Miyake(GEN vchi, GEN gb, GEN cycn)
    5724             : {
    5725       41769 :   long i, e = cycn[1], lb = lg(gb);
    5726       41769 :   GEN v = char_normalize_zv(vchi, cycn);
    5727       62132 :   for (i = 1; i < lb; i++)
    5728       49833 :     if ((zv_dotproduct(v, gel(gb,i)) -  v[i]) % e) return 1;
    5729       12299 :   return 0;
    5730             : }
    5731             : 
    5732             : /* list of Hecke characters not induced by a Dirichlet character up to Galois
    5733             :  * conjugation, whose conductor is bnr.cond; cycn = cyc_normalize(bnr.cyc)*/
    5734             : static GEN
    5735       13391 : mklvchi(GEN bnr, GEN con, GEN cycn)
    5736             : {
    5737       13391 :   GEN gb = NULL, cyc = bnr_get_cyc(bnr), cycsmall = ZV_to_zv(cyc);
    5738       13391 :   GEN vchi = cyc2elts(cycsmall);
    5739       13391 :   long ordmax = cycsmall[1], c, i, l;
    5740       13391 :   if (con)
    5741             :   {
    5742        3892 :     GEN g = bnr_get_gen(bnr), nf = bnr_get_nf(bnr);
    5743        3892 :     long lg = lg(g);
    5744        3892 :     gb = cgetg(lg, t_VEC);
    5745        9135 :     for (i = 1; i < lg; ++i)
    5746        5243 :       gel(gb,i) = ZV_to_zv(isprincipalray(bnr, galoisapply(nf, con, gel(g,i))));
    5747             :   }
    5748       13391 :   l = lg(vchi);
    5749      151725 :   for (i = c = 1; i < l; i++)
    5750             :   {
    5751      138334 :     GEN chi = gel(vchi,i);
    5752      138334 :     if (!con || Miyake(chi, gb, cycn)) gel(vchi, c++) = Flv_to_ZV(chi);
    5753             :   }
    5754       13391 :   setlg(vchi, c); l = c;
    5755      139426 :   for (i = 1; i < l; i++)
    5756             :   {
    5757      126035 :     GEN chi = gel(vchi,i);
    5758             :     long n;
    5759      126035 :     if (!chi) continue;
    5760      527289 :     for (n = 2; n < ordmax; n++)
    5761      482748 :       if (cgcd(n, ordmax) == 1)
    5762             :       {
    5763      198597 :         GEN tmp = vecmodii(gmulsg(n, chi), cyc);
    5764             :         long j;
    5765     3809050 :         for (j = i+1; j < l; ++j)
    5766     3610453 :           if (gel(vchi,j) && gequal(gel(vchi,j), tmp)) gel(vchi,j) = NULL;
    5767             :       }
    5768             :   }
    5769      139426 :   for (i = c = 1; i < l; i++)
    5770             :   {
    5771      126035 :     GEN chi = gel(vchi,i);
    5772      126035 :     if (chi && bnrisconductor(bnr, chi)) gel(vchi, c++) = chi;
    5773             :   }
    5774       13391 :   setlg(vchi, c); return vchi;
    5775             : }
    5776             : 
    5777             : /* con = NULL if D > 0 or if D < 0 and id != idcon. */
    5778             : static GEN
    5779       16835 : mfdihedralcommon(GEN bnf, GEN id, GEN znN, GEN kroconreyN, long N, long D, GEN con)
    5780             : {
    5781             :   GEN bnr, bnrconreyN, cyc, cycn, cycN, Lvchi, res, g;
    5782             :   long i, j, ordmax, l, lc, deghecke, degrel;
    5783             : 
    5784       16835 :   bnr = dihan_bnr(bnf, id);
    5785       16835 :   cyc = ZV_to_zv( bnr_get_cyc(bnr) );
    5786       16835 :   lc = lg(cyc); if (lc == 1) return NULL;
    5787             : 
    5788       13391 :   g = znstar_get_conreygen(znN); l = lg(g);
    5789       13391 :   bnrconreyN = cgetg(l, t_VEC);
    5790       50288 :   for (i = 1; i < l; i++)
    5791       36897 :     gel(bnrconreyN,i) = ZV_to_zv(isprincipalray(bnr,gel(g,i)));
    5792             : 
    5793       13391 :   cycn = cyc_normalize_zv(cyc);
    5794       13391 :   cycN = ZV_to_zv(znstar_get_cyc(znN));
    5795       13391 :   ordmax = cyc[1];
    5796       13391 :   deghecke = myeulerphiu(ordmax);
    5797       13391 :   Lvchi = mklvchi(bnr, con, cycn); l = lg(Lvchi);
    5798       13391 :   if (l == 1) return NULL;
    5799        7917 :   res = cgetg(l, t_VEC);
    5800       25123 :   for (j = 1; j < l; j++)
    5801             :   {
    5802       17206 :     GEN T, Tinit, v, vchi = ZV_to_zv(gel(Lvchi,j));
    5803       17206 :     GEN chi, chin = char_normalize_zv(vchi, cycn);
    5804             :     long ordw, vnum, k0;
    5805       17206 :     v = bnrchartwist2conrey(chin, cycn, bnrconreyN, kroconreyN);
    5806       17206 :     ordw = itos(Q_denom(v));
    5807       17206 :     Tinit = Qab_trace_init(ord_canon(ordmax), ord_canon(ordw));
    5808       17206 :     chi = conreydenormalize(znN, v);
    5809       17206 :     vnum = itou(znconreyexp(znN, chi));
    5810       17206 :     chi = ZV_to_zv(znconreychar(znN,chi));
    5811       17206 :     degrel = deghecke / myeulerphiu(ordw);
    5812       17206 :     k0 = zv_cyc_minimize(cycN, chi, coprimes_zv(ordw));
    5813       17206 :     vnum = Fl_powu(vnum, k0, N);
    5814             :     /* encodes degrel forms: jdeg = 0..degrel-1 */
    5815       17206 :     T = mkvecsmalln(6, N, k0, vnum, D, ordmax, degrel);
    5816       17206 :     gel(res,j) = mkvec4(T, id, vchi, Tinit);
    5817             :   }
    5818        7917 :   return res;
    5819             : }
    5820             : 
    5821             : /* Append to v all dihedral weight 1 forms coming from D, if fundamental. */
    5822             : /* B a t_VECSMALL: if #B=1, only that level; if B=[Bmin,Bmax], Bmin <= Bmax:
    5823             :  * between those levels. */
    5824             : static void
    5825        9289 : append_dihedral(GEN v, long D, GEN B)
    5826             : {
    5827        9289 :   long Da = labs(D), no, N, i, numi, ct, min, max;
    5828             :   GEN bnf, con, LI, resall, varch;
    5829             :   pari_sp av;
    5830             : 
    5831        9289 :   if (lg(B) == 2)
    5832             :   {
    5833           0 :     long b = B[1], m = D > 0? 3: 1;
    5834           0 :     min = b / Da;
    5835           0 :     if (b % Da || min < m) return;
    5836           0 :     max = min;
    5837             :   }
    5838             :   else
    5839             :   { /* assume B[1] < B[2] */
    5840        9289 :     min = (B[1] + Da-1)/Da;
    5841        9289 :     max = B[2]/Da;
    5842             :   }
    5843        9289 :   if (!sisfundamental(D)) return;
    5844             : 
    5845        2842 :   av = avma;
    5846        2842 :   bnf = dihan_bnf(D);
    5847        2842 :   con = gel(galoisconj(bnf,gen_1), 2);
    5848        2842 :   LI = ideallist(bnf, max);
    5849        2842 :   numi = 0; for (i = min; i <= max; i++) numi += lg(gel(LI, i)) - 1;
    5850        2842 :   if (D > 0)
    5851             :   {
    5852         707 :     numi <<= 1;
    5853         707 :     varch = mkvec2(mkvec2(gen_1,gen_0), mkvec2(gen_0,gen_1));
    5854             :   }
    5855             :   else
    5856        2135 :     varch = NULL;
    5857        2842 :   resall = cgetg(numi+1, t_VEC); ct = 1;
    5858       27503 :   for (no = min; no <= max; no++)
    5859             :   {
    5860             :     GEN LIs, znN, conreyN, kroconreyN;
    5861             :     long flcond, lgc, lglis;
    5862       24661 :     if (D < 0)
    5863       15043 :       flcond = (no == 2 || no == 3 || (no == 4 && (D&7L)==1));
    5864             :     else
    5865        9618 :       flcond = (no == 4 && (D&7L) != 1);
    5866       24661 :     if (flcond) continue;
    5867       22302 :     LIs = gel(LI, no);
    5868       22302 :     N = Da*no;
    5869       22302 :     znN = znstar0(utoi(N), 1);
    5870       22302 :     conreyN = znstar_get_conreygen(znN); lgc = lg(conreyN);
    5871       22302 :     kroconreyN = cgetg(lgc, t_VECSMALL);
    5872       22302 :     for (i = 1; i < lgc; ++i) kroconreyN[i] = krosi(D, gel(conreyN, i));
    5873       22302 :     lglis = lg(LIs);
    5874       43876 :     for (i = 1; i < lglis; ++i)
    5875             :     {
    5876       21574 :       GEN id = gel(LIs, i), idcon, conk;
    5877             :       long j, inf, maxinf;
    5878       21574 :       if (typ(id) == t_INT) continue;
    5879       14077 :       idcon = galoisapply(bnf, con, id);
    5880       14077 :       conk = (D < 0 && gequal(idcon, id)) ? con : NULL;
    5881       42294 :       for (j = i; j < lglis; ++j)
    5882       28217 :         if (gequal(idcon, gel(LIs, j))) gel(LIs, j) = gen_0;
    5883       14077 :       maxinf = (D < 0 || gequal(idcon,id))? 1: 2;
    5884       30912 :       for (inf = 1; inf <= maxinf; inf++)
    5885             :       {
    5886       16835 :         GEN ide = (D > 0)? mkvec2(id, gel(varch,inf)): id;
    5887       16835 :         GEN res = mfdihedralcommon(bnf, ide, znN, kroconreyN, N, D, conk);
    5888       16835 :         if (res) gel(resall, ct++) = res;
    5889             :       }
    5890             :     }
    5891             :   }
    5892        2842 :   if (ct == 1) avma = av;
    5893             :   else
    5894             :   {
    5895        2394 :     setlg(resall, ct);
    5896        2394 :     vectrunc_append(v, gerepilecopy(av, shallowconcat1(resall)));
    5897             :   }
    5898             : }
    5899             : 
    5900             : static long
    5901       21021 : di_N(GEN a) { return gel(a,1)[1]; }
    5902             : /* All primitive dihedral wt1 forms: LIM a t_VECSMALL with a single component
    5903             :  * (only level LIM) or 2 components [m,M], m < M (between m and M) */
    5904             : static GEN
    5905           7 : mfdihedralall(GEN LIM)
    5906             : {
    5907             :   GEN res, z;
    5908             :   long limD, ct, i, l1, l2;
    5909             : 
    5910           7 :   if (lg(LIM) == 2) l1 = l2 = LIM[1]; else { l1 = LIM[1]; l2 = LIM[2]; }
    5911           7 :   limD = l2;
    5912           7 :   res = vectrunc_init(2*limD);
    5913           7 :   if (l1 == l2)
    5914             :   {
    5915           0 :     GEN D = mydivisorsu(l1);
    5916           0 :     long l = lg(D), j;
    5917           0 :     for (j = 2; j < l; ++j)
    5918             :     {
    5919           0 :       long d = D[j];
    5920           0 :       append_dihedral(res, -d, LIM);
    5921           0 :       if (d >= 5 && D[l-j] >= 3) append_dihedral(res, d, LIM);
    5922             :     }
    5923             :   }
    5924             :   else
    5925             :   {
    5926             :     long D;
    5927           7 :     for (D = -3; D >= -limD; D--) append_dihedral(res, D, LIM);
    5928           7 :     limD /= 3;
    5929           7 :     for (D = 5; D <= limD;   D++) append_dihedral(res, D, LIM);
    5930             :   }
    5931           7 :   ct = lg(res);
    5932           7 :   if (ct > 1)
    5933             :   { /* concat and sort wrt N */
    5934           7 :     res = shallowconcat1(res);
    5935           7 :     res = vecpermute(res, indexvecsort(res, mkvecsmall(1)));
    5936           7 :     ct = lg(res);
    5937             :   }
    5938           7 :   z = const_vec(l2-l1+1, cgetg(1,t_VEC));
    5939        3836 :   for (i = 1; i < ct;)
    5940             :   { /* regroup result sharing the same N */
    5941        3822 :     long n = di_N(gel(res,i)), j = i+1, k;
    5942             :     GEN v;
    5943        3822 :     while (j < ct && di_N(gel(res,j)) == n) j++;
    5944        3822 :     n -= l1-1;
    5945        3822 :     gel(z, n) = v = cgetg(j-i+1, t_VEC);
    5946        3822 :     for (k = 1; i < j; k++,i++) gel(v,k) = gel(res,i);
    5947             :   }
    5948           7 :   return z;
    5949             : }
    5950             : static GEN
    5951       22736 : mfdihedral(long N)
    5952             : {
    5953       22736 :   GEN z = cache_get(cache_DIH, N);
    5954       22736 :   if (z) return z;
    5955           0 :   z = mfdihedralall(mkvecsmall(N)); return gel(z,1);
    5956             : }
    5957             : 
    5958             : /* return [vF, index], where vecpermute(vF,index) generates dihedral forms
    5959             :  * for character CHI */
    5960             : static GEN
    5961       22736 : mfdihedralnew_i(long N, GEN CHI)
    5962             : {
    5963       22736 :   GEN Pm, vf, M, V, NK, SP = mfdihedral(N);
    5964             :   long d, ordw, i, SB, c, l, k0, k1, chino, chinoorig, lv;
    5965             : 
    5966       22736 :   CHI = mfcharinduce(CHI,N);
    5967       22736 :   ordw = mfcharorder(CHI);
    5968       22736 :   chinoorig = mfcharno(CHI);
    5969       22736 :   k0 = mfconreyminimize(CHI);
    5970       22736 :   chino = Fl_powu(chinoorig, k0, N);
    5971       22736 :   k1 = Fl_inv(k0 % ordw, ordw);
    5972       22736 :   lv = lg(SP); V = cgetg(lv, t_VEC);
    5973       22736 :   d = 0;
    5974       45605 :   for (i = l = 1; i < lv; i++)
    5975             :   {
    5976       22869 :     GEN sp = gel(SP,i), T = gel(sp,1);
    5977       22869 :     if (T[3] != chino) continue;
    5978        3395 :     d += T[6];
    5979        3395 :     if (k1 != 1)
    5980             :     {
    5981          77 :       GEN t = leafcopy(T); t[3] = chinoorig; t[2] = (t[2]*k1)%ordw;
    5982          77 :       sp = mkvec4(t, gel(sp,2), gel(sp,3), gel(sp,4));
    5983             :     }
    5984        3395 :     gel(V, l++) = sp;
    5985             :   }
    5986       22736 :   setlg(V, l); /* dihedral forms of level N and character CHI */
    5987       22736 :   if (l == 1) return NULL;
    5988             : 
    5989        2177 :   SB = myeulerphiu(ordw) * mfsturmNk(N,1) + 1;
    5990        2177 :   M = cgetg(d+1, t_MAT);
    5991        2177 :   vf = cgetg(d+1, t_VEC);
    5992        2177 :   NK = mkNK(N, 1, CHI);
    5993        5572 :   for (i = c = 1; i < l; i++)
    5994             :   { /* T = [N, k0, conreyno, D, ordmax, degrel] */
    5995        3395 :     GEN an, bnf, bnr, w, Vi = gel(V,i);
    5996        3395 :     GEN T = gel(Vi,1), id = gel(Vi,2), vchi = gel(Vi,3), Tinit = gel(Vi,4);
    5997        3395 :     long jdeg, k0i = T[2], D = T[4], degrel = T[6];
    5998        3395 :     bnf = dihan_bnf(D);
    5999        3395 :     bnr = dihan_bnr(bnf, id);
    6000        3395 :     w = dihan_init(bnr, vchi);
    6001        9828 :     for (jdeg = 0; jdeg < degrel; jdeg++,c++)
    6002             :     {
    6003        6433 :       GEN k0j = mkvecsmall2(k0i, jdeg);
    6004        6433 :       an = dihan(bnr, w, Tinit, k0j, SB);
    6005        6433 :       settyp(an, t_COL); gel(M,c) = Q_primpart(an);
    6006        6433 :       gel(vf,c) = tag4(t_MF_DIHEDRAL, NK, bnr, w, Tinit, k0j);
    6007             :     }
    6008             :   }
    6009        2177 :   Pm = gmael3(V,1,4,1);
    6010        2177 :   V = (degpol(Pm) == 1)? ZM_indexrank(M): ZabM_indexrank(M,Pm,ord_canon(ordw));
    6011        2177 :   return mkvec2(vf,gel(V,2));
    6012             : }
    6013             : static long
    6014       15400 : mfdihedralnewdim(long N, GEN CHI)
    6015             : {
    6016       15400 :   pari_sp av = avma;
    6017       15400 :   GEN S = mfdihedralnew_i(N, CHI);
    6018       15400 :   long d = S ? lg(gel(S,2))-1: 0;
    6019       15400 :   avma = av; return d;
    6020             : }
    6021             : static GEN
    6022        7336 : mfdihedralnew(long N, GEN CHI)
    6023             : {
    6024        7336 :   pari_sp av = avma;
    6025        7336 :   GEN S = mfdihedralnew_i(N, CHI);
    6026        7336 :   if (!S) { avma = av; return cgetg(1, t_VEC); }
    6027         707 :   return vecpermute(gel(S,1), gel(S,2));
    6028             : }
    6029             : 
    6030             : static long
    6031        6832 : mfdihedralcuspdim(long N, GEN CHI)
    6032             : {
    6033        6832 :   pari_sp av = avma;
    6034             :   GEN D, CHIP;
    6035             :   long F, i, lD, dim;
    6036             : 
    6037        6832 :   CHIP = mfchartoprimitive(CHI, &F);
    6038        6832 :   D = divisorsu(N/F); lD = lg(D);
    6039        6832 :   dim = mfdihedralnewdim(N, CHI); /* d = 1 */
    6040       15400 :   for (i = 2; i < lD; ++i)
    6041             :   {
    6042        8568 :     long d = D[i], M = N/d;
    6043        8568 :     dim += mfdihedralnewdim(M, mfcharinduce(CHIP,M)) * mynumdivu(d);
    6044             :   }
    6045        6832 :   avma = av; return dim;
    6046             : }
    6047             : 
    6048             : static GEN
    6049        6223 : mfbdall(GEN E, long N)
    6050             : {
    6051        6223 :   GEN v, D = mydivisorsu(N);
    6052        6223 :   long i, j, lD = lg(D) - 1, lE = lg(E) - 1;
    6053        6223 :   v = cgetg(lD*lE + 1, t_VEC);
    6054        8624 :   for (j = 0; j < lE; j++)
    6055             :   {
    6056        2401 :     GEN Ej = gel(E, j+1);
    6057        2401 :     for (i = 0; i < lD; i++) gel(v, i*lE + j+1) = mfbd_i(Ej, D[i+1]);
    6058             :   }
    6059        6223 :   return v;
    6060             : }
    6061             : static GEN
    6062        3220 : mfdihedralcusp(long N, GEN CHI)
    6063             : {
    6064        3220 :   pari_sp av = avma;
    6065             :   GEN D, CHIP, z;
    6066             :   long F, i, lD;
    6067             : 
    6068        3220 :   CHIP = mfchartoprimitive(CHI, &F);
    6069        3220 :   D = divisorsu(N/F); lD = lg(D);
    6070        3220 :   z = cgetg(lD, t_VEC);
    6071        3220 :   gel(z,1) = mfdihedralnew(N, CHI);
    6072        7287 :   for (i = 2; i < lD; ++i) /* skip 1 */
    6073             :   {
    6074        4067 :     long d = D[i], M = N / d;
    6075        4067 :     GEN LF = mfdihedralnew(M, mfcharinduce(CHIP, M));
    6076        4067 :     gel(z,i) = mfbdall(LF, d);
    6077             :   }
    6078        3220 :   return gerepilecopy(av, shallowconcat1(z));
    6079             : }
    6080             : 
    6081             : long
    6082           0 : mfdihedraldim(long N, GEN CHI, long space)
    6083             : {
    6084           0 :   CHI = get_mfchar(CHI);
    6085           0 :   return space==mf_NEW? mfdihedralnewdim(N, CHI): mfdihedralcuspdim(N, CHI);
    6086             : }
    6087             : 
    6088             : static void
    6089          63 : mf_set_space(GEN mf, long x) { gmael(mf,1,4) = utoi(x); }
    6090             : static GEN
    6091          63 : mfwt1_cusptonew(GEN mf)
    6092             : {
    6093          63 :   const long vy = 1;
    6094             :   GEN CHI, vtf, galpols, F, vtfnew, vnewforms, M, z, P;
    6095             :   long N, dimcusp, lgal, dimnew, i, ct, sb, ord;
    6096             : 
    6097          63 :   if (!mf) return NULL;
    6098          63 :   mf = mfsplit(mf, 0, 0);
    6099          63 :   galpols = mf_get_fields(mf);
    6100          63 :   lgal = lg(galpols);
    6101          63 :   if (lgal == 1) return NULL;
    6102          63 :   N = mf_get_N(mf);
    6103          63 :   CHI = mf_get_CHI(mf);
    6104          63 :   mf_set_space(mf, mf_NEW);
    6105          63 :   vtf = mf_get_vtf(mf);
    6106          63 :   dimcusp = lg(vtf) - 1;
    6107          63 :   F = mf_get_newforms(mf);
    6108          63 :   dimnew = 0;
    6109          63 :   for (i = 1; i < lgal; i++) dimnew += degpol(gel(galpols,i));
    6110          63 :   vtfnew = cgetg(dimnew + 1, t_VEC); ct = 0;
    6111          63 :   vnewforms = cgetg(lgal, t_VEC);
    6112         133 :   for (i = 1; i < lgal; i++)
    6113             :   {
    6114          70 :     GEN tmp, pol = gel(galpols, i), f = liftpol_shallow(gel(F,i));
    6115          70 :     long d = degpol(pol), j;
    6116          70 :     if (d == 1)
    6117             :     {
    6118          49 :       gel(vtfnew, ++ct) = mflinear_wt1(vtf, f);
    6119          49 :       tmp = mkvec(gen_1);
    6120             :     }
    6121             :     else
    6122             :     {
    6123          21 :       f = shallowtrans( RgXV_to_RgM(f, dimcusp) );
    6124          21 :       for (j = 1; j <= d; j++) gel(vtfnew, ++ct) = mflinear_wt1(vtf, gel(f,j));
    6125          21 :       tmp = gmodulo(pol_x_powers(d, vy), pol);
    6126             :     }
    6127          70 :     if (ct - d) tmp = concat(zerovec(ct - d), tmp);
    6128          70 :     if (dimnew - ct) tmp = concat(tmp, zerovec(dimnew - ct));
    6129          70 :     gel(vnewforms, i) = tmp;
    6130             :   }
    6131          63 :   gel(mf,3) = vtfnew;
    6132          63 :   gel(mf,6) = vnewforms;
    6133          63 :   sb = mfsturmNk(N, 1);
    6134          63 :   M = mfvectomat(vtfnew, sb);
    6135          63 :   ord = ord_canon(mfcharorder(CHI));
    6136          63 :   if (ord == 1)
    6137             :   {
    6138          28 :     P = NULL;
    6139          28 :     z = ZM_indexrank(M);
    6140             :   }
    6141             :   else
    6142             :   {
    6143          35 :     P = polcyclo(ord,fetch_user_var("t"));
    6144          35 :     z = ZabM_indexrank(liftpol_shallow(M), P, ord);
    6145             :   }
    6146          63 :   gel(mf,5) = mfclean2(M, gel(z,1), P, ord, NULL);
    6147          63 :   return mf;
    6148             : }
    6149             : 
    6150             : /* CHI an mfchar */
    6151             : static GEN
    6152        1176 : toNK(long N, long k, GEN CHI)
    6153        1176 : { return mkvec3(utoi(N),utoi(k),mfchar2char(CHI)); }
    6154             : static int
    6155         273 : cmp_ord(void *E, GEN a, GEN b)
    6156             : {
    6157         273 :   GEN chia = mf_get_CHI(a), chib = mf_get_CHI(b);
    6158         273 :   (void)E; return cmpii(gmfcharorder(chia), gmfcharorder(chib));
    6159             : }
    6160             : static GEN
    6161           0 : mfwttrivialall(GEN mf1, GEN CHI)
    6162             : {
    6163             :   long i, l;
    6164             :   GEN v;
    6165           0 :   if (!CHI) return cgetg(1, t_VEC);
    6166           0 :   l = lg(CHI); v = cgetg(l, t_VEC);
    6167           0 :   for (i = 1; i < l; i++)
    6168             :   {
    6169           0 :     GEN w = leafcopy(mf1);
    6170           0 :     gel(w,3) = gel(CHI,i);
    6171           0 :     gel(v,i) = mfEMPTY(w);
    6172             :   }
    6173           0 :   return v;
    6174             : }
    6175             : static int
    6176        5411 : space_is_cusp(long space) { return space != mf_FULL && space != mf_EISEN; }
    6177             : /* mfinit structures. Can be length 5 (full/cusp/oldspace or newspace nonsplit)
    6178             :    or length 7 (newspace split).
    6179             : -- mf[1] contains [N,k,CHI,space],
    6180             : -- mf[2] contains vector of closures of Eisenstein series, empty if not
    6181             :    full space.
    6182             : -- mf[3] contains vector of closures, so #mf[3] = dimension of cusp/new space.
    6183             : -- mf[4] contains the corresponding indices: either j for T(j)tf if newspace,
    6184             :    or [M,j,d] for B(d)T(j)tf_M if cuspspace or oldspace.
    6185             : -- mf[5] contains the matrix M of first coefficients of basis, never cleaned.
    6186             : -- mf[6] contains the vector of vectors of coefficients on mf[3] of the
    6187             :    eigenspaces, as polmods in the variable y, so #mf[6] is the number of
    6188             :    eigenspaces.
    6189             : -- mf[7] contains the defining polynomials of the polmods, so #mf[7] is also
    6190             :    the number of eigenspaces, and the degrees of the polynomials are the
    6191             :    dimensions.
    6192             :  * NK is either [N,k] or [N,k,CHI].
    6193             :  * mfinit does not do the splitting, only the basis generation. */
    6194             : static GEN
    6195        4270 : mfinit_i(GEN NK, long space)
    6196             : {
    6197        4270 :   GEN mf = NULL, mf1, CHI;
    6198             :   long N, k, joker;
    6199        4270 :   checkNK(NK, &N, &k, &CHI, 1);
    6200        4256 :   joker = !CHI || typ(CHI) == t_COL;
    6201        4256 :   mf1 = mkvec4(utoi(N), stoi(k), CHI, utoi(space));
    6202        4256 :   if (k < 0) return joker? mfwttrivialall(mf1, CHI): mfEMPTY(mf1);
    6203        4256 :   if (joker)
    6204             :   {
    6205        1085 :     GEN vCHI = CHI;
    6206             :     long i, j, l;
    6207        1085 :     if (CHI && lg(CHI) == 1) return cgetg(1,t_VEC);
    6208        1085 :     if (k == 1)
    6209             :     {
    6210        1064 :       if (space != mf_CUSP && space != mf_NEW)
    6211           0 :         pari_err_IMPL("mfinit([N,1,wildcard], space != cusp or new space)");
    6212        1064 :       mf = mfwt1initall(N, CHI, space);
    6213             :     }
    6214             :     else
    6215             :     {
    6216          21 :       if (!vCHI) vCHI = mfchargalois(N, k & 1, NULL);
    6217          21 :       l = lg(vCHI); mf = cgetg(l, t_VEC);
    6218          77 :       for (i = j = 1; i < l; i++)
    6219             :       {
    6220          56 :         GEN v = mfinit_i(toNK(N,k,gel(vCHI,i)), space);
    6221          56 :         if (mf_get_dim(v) || CHI) gel(mf, j++) = v;
    6222             :       }
    6223          21 :       setlg(mf,j);
    6224             :     }
    6225        1085 :     if (!CHI) gen_sort_inplace(mf, NULL, &cmp_ord, NULL);
    6226        1085 :     return mf;
    6227             :   }
    6228        3171 :   if (!ischarok(N, k, CHI)) return mfEMPTY(mf1);
    6229        3150 :   if (k == 0) /*nothing*/;
    6230        3101 :   else if (k == 1)
    6231             :   {
    6232          91 :     switch (space)
    6233             :     {
    6234             :       case mf_NEW:
    6235             :       case mf_FULL:
    6236             :       case mf_CUSP:
    6237          91 :         mf = mfwt1init(N, CHI, NULL);
    6238          91 :         if (space == mf_NEW) mf = mfwt1_cusptonew(mf);
    6239          91 :         break;
    6240           0 :       case mf_EISEN:mf = mfEMPTY(NULL); break;
    6241           0 :       case mf_OLD: pari_err_IMPL("mfinit in weight 1 for old space");
    6242           0 :       default: pari_err_FLAG("mfinit");
    6243             :     }
    6244             :   }
    6245             :   else /* k >= 2 */
    6246             :   {
    6247        3010 :     switch(space)
    6248             :     {
    6249             :       case mf_NEW:
    6250             :       {
    6251             :         cachenew_t cache;
    6252             :         GEN dM, P, z, M;
    6253        1015 :         long ord = ord_canon(mfcharorder(CHI));
    6254        1015 :         mf = mfnewinit(N, k, CHI, &cache, 1);
    6255        1015 :         if (mf)
    6256             :         {
    6257         644 :           P = (ord == 1)? NULL: polcyclo(ord, fetch_user_var("t"));
    6258         644 :           M = Q_remove_denom(mf_get_M(mf), &dM);
    6259         644 :           z = mf_get_Mindex(mf);
    6260         644 :           gel(mf,5) = mfclean2(M, gel(z,1), P, ord, dM);
    6261             :         }
    6262        1015 :         break;
    6263             :       }
    6264          21 :       case mf_EISEN:mf = mfEMPTY(NULL); break;
    6265             :       case mf_CUSP:
    6266             :       case mf_OLD:
    6267        1974 :       case mf_FULL: mf = mfinitcusp(N, k, CHI, mf1, space); break;
    6268           0 :       default: pari_err_FLAG("mfinit");
    6269             :     }
    6270             :   }
    6271        3150 :   if (!mf) mf = mfEMPTY(mf1); else gel(mf,1) = mf1;
    6272        3150 :   if (!space_is_cusp(space))
    6273             :   {
    6274         280 :     long sb = mfsturmNk(N,k);
    6275             :     GEN M;
    6276         280 :     gel(mf,2) = mfeisenbasis_i(N, k, CHI);
    6277         280 :     M = mfvectomat(mf_get_basis(mf), sb+1); /* uses mf[2] */
    6278         280 :     gel(mf,5) = mfclean(M, mfcharorder(CHI));
    6279             :   }
    6280        3150 :   return mf;
    6281             : }
    6282             : GEN
    6283        1505 : mfinit(GEN NK, long space)
    6284             : {
    6285        1505 :   pari_sp av = avma;
    6286        1505 :   return gerepilecopy(av, mfinit_i(NK, space));
    6287             : }
    6288             : 
    6289             : /* UTILITY FUNCTIONS */
    6290             : 
    6291             : /* mfeval for an element of S_k(\SL_2(\Z)), also valid near cusps
    6292             :  * vtau a t_VEC of elements */
    6293             : static GEN
    6294           0 : mfzeval(long k, GEN F, GEN vtau, long bitprec)
    6295             : {
    6296           0 :   pari_sp ltop = avma;
    6297             :   GEN vga, vtau1, vres0, vres;
    6298           0 :   long lv = lg(vtau), i;
    6299           0 :   vga = cgetg(lv, t_VEC);
    6300           0 :   vtau1= cgetg(lv, t_VEC);
    6301           0 :   for (i = 1; i < lv; ++i) gel(vtau1,i) = cxredsl2(gel(vtau,i), &gel(vga,i));
    6302           0 :   vres0 = mfeval0(0, k, F, vtau1, bitprec);
    6303           0 :   vres = cgetg(lv, t_VEC);
    6304           0 :   for (i = 1; i < lv; ++i)
    6305           0 :     if (gexpo(imag_i(gel(vtau1,i))) > 10)
    6306           0 :       gel(vres,i) = gen_0;
    6307             :     else
    6308             :     {
    6309           0 :       GEN z = gel(vtau,i), g = gel(vga,i), c = gcoeff(g,2,1), d = gcoeff(g,2,2);
    6310           0 :       gel(vres,i) = gmul(gpowgs(gadd(gmul(c,z), d), -k), gel(vres0, i));
    6311             :     }
    6312           0 :   return gerepileupto(ltop, vres);
    6313             : }
    6314             : 
    6315             : static int
    6316        1778 : RgV_embedded(GEN v)
    6317             : {
    6318        1778 :   long i, l = lg(v);
    6319      338443 :   for (i = 1; i < l; i++)
    6320      336665 :     if (typ(gel(v,i)) == t_POLMOD) return 0;
    6321        1778 :   return 1;
    6322             : }
    6323             : 
    6324             : /* evaluate an mf closure numerically, i.e., in the usual sense,
    6325             : either for a single tau or a vector of tau. If N=1, assume that
    6326             : F is in S_k(\SL_2(\Z)), otherwise imaginary part must not be too small. */
    6327             : static GEN
    6328        1778 : mfeval0(long N, long k, GEN F, GEN vtau, long bitprec)
    6329             : {
    6330        1778 :   pari_sp ltop = avma;
    6331             :   GEN vs, vq, PI2I, an, vecan;
    6332             :   double tmpdbl, nlimdbl;
    6333        1778 :   long ta, nlim, lv, i, n, pr, prec = nbits2prec(bitprec), flscal = 0;
    6334             : 
    6335        1778 :   ta = typ(vtau);
    6336        1778 :   if (ta != t_VEC && ta != t_COL) { flscal = 1; vtau = mkvec(vtau); }
    6337        1778 :   if (N == 1)
    6338             :   {
    6339           0 :     vs = mfzeval(k, F, vtau, bitprec);
    6340           0 :     return flscal ? gerepilecopy(ltop, gel(vs, 1)) : vs;
    6341             :   }
    6342        1778 :   if (!N) N = 1;
    6343        1778 :   tmpdbl = 2*M_PI*gtodouble(vecmin(imag_i(vtau)));
    6344        1778 :   pr = bitprec + 10;
    6345        1778 :   nlimdbl = ceil(pr*LOG2/tmpdbl);
    6346        1778 :   tmpdbl -= (k-1)/(2*nlimdbl); if (tmpdbl < 1) tmpdbl = 1.;
    6347        1778 :   nlimdbl += ceil((0.7+(k-1)/2*log(nlimdbl))/tmpdbl);
    6348        1778 :   nlim = (long)nlimdbl;
    6349        1778 :   lv = lg(vtau);
    6350        1778 :   vs = cgetg(lv, ta);
    6351        1778 :   vq = cgetg(lv, t_VEC);
    6352        1778 :   PI2I = PiI2(prec);
    6353        1778 :   vecan = mfcoefs(F, nlim, 1);
    6354        1778 :   if (!RgV_embedded(vecan)) pari_err_TYPE("mfeval [use mfembed first]",vecan);
    6355        5264 :   for (i = 1; i < lv; ++i)
    6356             :   {
    6357        3486 :     gel(vs, i) = gel(vecan, nlim + 1);
    6358        3486 :     gel(vq, i) = gexp(gmul(PI2I, gel(vtau,i)), prec);
    6359             :   }
    6360      336665 :   for (n = nlim - 1; n >= 0; --n)
    6361             :   {
    6362      334887 :     an = gel(vecan, n + 1);
    6363     1002281 :     for (i = 1; i < lv; ++i)
    6364      667394 :       gel(vs, i) = gadd(an, gmul(gel(vq, i), gel(vs, i)));
    6365             :   }
    6366        1778 :   if (flscal) vs = gel(vs, 1);
    6367        1778 :   return gerepilecopy(ltop, vs);
    6368             : }
    6369             : 
    6370             : GEN
    6371          70 : mfeval(GEN F, GEN vtau, long bitprec)
    6372             : {
    6373             :   long N, k;
    6374          70 :   if (!isf(F)) pari_err_TYPE("mfeval", F);
    6375          70 :   N = f_N(F);
    6376          70 :   k = f_k(F); if (N < 0 || k < 0) pari_err_IMPL("mfeval for this form");
    6377          70 :   return mfeval0(N, k, F, vtau, bitprec);
    6378             : }
    6379             : 
    6380             : static GEN
    6381        1365 : get_laq(GEN msp, GEN R, GEN veval, GEN c)
    6382             : {
    6383        1365 :   GEN a = gen_0, b = gen_0;
    6384        1365 :   long j, l = lg(msp);
    6385       14854 :   for (j = 1; j < l; ++j)
    6386             :   {
    6387       13489 :     GEN c = gel(msp,j), v = gel(veval,j);
    6388       13489 :     if (R) c = Rg_embed(c, R);
    6389       13489 :     a = gadd(a, gmul(c, gel(v,1)));
    6390       13489 :     b = gadd(b, gmul(c, gel(v,2)));
    6391             :   }
    6392        1365 :   return gdiv(b, gmul(a,c));
    6393             : }
    6394             : 
    6395             : /* P in ZX */
    6396             : static GEN
    6397        2485 : ZX_roots(GEN P, long prec)
    6398             : {
    6399        2485 :   long d = degpol(P);
    6400        2485 :   if (d == 1) return mkvec(gen_0);
    6401         623 :   if (d == 2 && isint1(gel(P,2)) && isintzero(gel(P,3)) && isint1(gel(P,4)))
    6402           0 :     return mkvec2(gen_I(), gneg(gen_I()));
    6403         623 :   if (ZX_sturm(P) == d) return realroots(P, NULL, prec);
    6404           7 :   return QX_complex_roots(P, prec);
    6405             : }
    6406             : /* P in Z[chi][X] */
    6407             : static GEN
    6408           0 : rootsC(GEN P, GEN zcyclo, long prec)
    6409             : {
    6410             :   GEN Q;
    6411           0 :   if (RgX_is_QX(P)) return ZX_roots(P, prec);
    6412           0 :   Q = RgX_embed(P, zcyclo); return roots(Q, prec);
    6413             : }
    6414             : /* initializations for RgX_RgV_eval / RgC_embed */
    6415             : static GEN
    6416        2485 : rootspowers(GEN v)
    6417             : {
    6418             :   long i, l;
    6419        2485 :   GEN w = cgetg_copy(v, &l);
    6420        2485 :   for (i = 1; i < l; i++) gel(w,i) = gpowers(gel(v,i), l-2);
    6421        2485 :   return w;
    6422             : }
    6423             : /* split mf, quadratic character */
    6424             : static GEN
    6425         322 : mfQeigenroots(GEN mf, long prec)
    6426             : {
    6427         322 :   GEN z, vP = mf_get_fields(mf);
    6428         322 :   long i, l = lg(vP);
    6429         322 :   z = cgetg(l, t_VEC);
    6430         322 :   for (i = 1; i < l; i++) gel(z,i) = rootspowers(ZX_roots(gel(vP,i),prec));
    6431         322 :   return z;
    6432             : }
    6433             : /* non-real character of order o != 2 mod 4 */
    6434             : static GEN
    6435           0 : mfeigenroots(GEN mf, GEN zcyclo, long prec)
    6436             : {
    6437           0 :   GEN z, vP = mf_get_fields(mf);
    6438           0 :   long i, l = lg(vP);
    6439           0 :   z = cgetg(l, t_VEC);
    6440           0 :   for (i = 1; i < l; i++) gel(z,i) = rootspowers(rootsC(gel(vP,i),zcyclo,prec));
    6441           0 :   return z;
    6442             : }
    6443             : 
    6444             : /* split mf */
    6445             : static GEN
    6446         140 : mfeigendims(GEN mf)
    6447             : {
    6448         140 :   GEN z, vP = mf_get_fields(mf);
    6449         140 :   long i, l = lg(vP);
    6450         140 :   z = cgetg(l, t_VECSMALL);
    6451         140 :   for (i = 1; i < l; i++) z[i] = degpol(gel(vP,i));
    6452         140 :   return z;
    6453             : }
    6454             : 
    6455             : /* split mf; assume dim >=1, mfcharorder(CHI) = 2.
    6456             :  * Here cannot use mfeigeneval since mfeigeneval uses mffricke. */
    6457             : static GEN
    6458           7 : mffrickeeigenvalues(GEN mf, GEN RO, long bitprec)
    6459             : {
    6460             :   GEN vtf, F, tau, wtau, Z, v, sqN, coe;
    6461           7 :   long N, k, i, j, lgal, dim, prec = nbits2prec(bitprec);
    6462             : 
    6463           7 :   N = mf_get_N(mf);
    6464           7 :   vtf = mf_get_vtf(mf);
    6465           7 :   dim = lg(vtf) - 1;
    6466           7 :   F = mf_get_newforms(mf);
    6467           7 :   lgal = lg(F);
    6468           7 :   Z = cgetg(lgal, t_VEC);
    6469           7 :   k = mf_get_k(mf);
    6470           7 :   sqN = sqrtr_abs(utor(N, prec));
    6471           7 :   tau = mkcomplex(ginv(utoi(1000)), ginv(sqN));
    6472           7 :   wtau = ginv(gmulsg(-N, tau));
    6473           7 :   coe = gpowgs(gmul(sqN, tau), k);
    6474           7 :   v = cgetg(dim + 1, t_VEC);
    6475          14 :   for (j = 1; j <= dim; ++j)
    6476           7 :     gel(v,j) = mfeval0(N, k, gel(vtf,j), mkvec2(tau, wtau), bitprec);
    6477          14 :   for (i = 1; i < lgal; i++)
    6478             :   {
    6479           7 :     GEN z, ro = gel(RO,i), f = gel(F,i);
    6480           7 :     long l = lg(ro);
    6481           7 :     if (l == 2) z = mkvec( get_laq(f, NULL, v, coe) );
    6482             :     else
    6483             :     {
    6484           0 :       f = liftpol_shallow(f);
    6485           0 :       z = cgetg(l, t_VEC);
    6486           0 :       for (j = 1; j < l; j++) gel(z,j) = get_laq(f, gel(ro,j), v, coe);
    6487             :     }
    6488           7 :     gel(Z,i) = z;
    6489             :   }
    6490           7 :   return Z;
    6491             : }
    6492             : 
    6493             : static long
    6494         322 : atkin_check(long N, long Q)
    6495             : {
    6496         322 :   long NQ = N/Q;
    6497         322 :   if (N % Q) pari_err_DOMAIN("mfatkineigenvalues","N % Q","!=",gen_0,utoi(Q));
    6498         322 :   if (cgcd(NQ, Q) > 1)
    6499           0 :     pari_err_DOMAIN("mfatkineigenvalues","gcd(Q,N/Q)","!=",gen_1,utoi(Q));
    6500         322 :   return NQ;
    6501             : }
    6502             : 
    6503             : static GEN
    6504         322 : mfatkineigenvalues_i(GEN mf, long Q, GEN RO, long bitprec)
    6505             : {
    6506             :   GEN laq2, CHI, vtf, F, tau, wtau, Z, veval, den, CHIP, coe, sqrtQ;
    6507         322 :   long FC, NQ, t, yq, i, j, lgal, dim, muQ, prec = nbits2prec(bitprec);
    6508         322 :   long N = mf_get_N(mf), k = mf_get_k(mf);
    6509             : 
    6510         322 :   NQ = atkin_check(N,Q);
    6511         322 :   vtf = mf_get_vtf(mf); dim = lg(vtf) - 1;
    6512         322 :   if (!dim) return cgetg(1, t_VEC);
    6513         322 :   CHI = mf_get_CHI(mf);
    6514         322 :   if (mfcharorder(CHI) > 2) pari_err_IMPL("nonreal CHI in mfatkineigenvalues");
    6515         322 :   CHIP = mfchartoprimitive(CHI, &FC);
    6516         322 :   if (NQ % FC)
    6517             :   {
    6518           7 :     if (Q != N) pari_err_IMPL("pseudo eigenvalues for W_Q");
    6519           7 :     return mffrickeeigenvalues(mf, RO, bitprec);
    6520             :   }
    6521             :   /* Q coprime to FC */
    6522         315 :   F = mf_get_newforms(mf);
    6523         315 :   lgal = lg(F);
    6524         315 :   if (Q == 1)
    6525             :   {
    6526          70 :     GEN dims = mfeigendims(mf);
    6527          70 :     long i, l = lg(dims);
    6528          70 :     Z = cgetg(l,t_VEC);
    6529          70 :     for (i = 1; i < l; ++i) gel(Z, i) = const_vec(dims[i], gen_1);
    6530          70 :     return Z;
    6531             :   }
    6532             :   /* Q != 1 */
    6533         245 :   if (!odd(k) && (muQ = moebiusu(Q)))
    6534           0 :   {
    6535          70 :     GEN vtfQ = cgetg(dim+1,t_VEC), dims = mfeigendims(mf), Qk = powuu(Q,k/2-1);
    6536          70 :     long i, l = lg(dims), ok = 1;
    6537          70 :     Z = cgetg(l, t_VEC);
    6538          70 :     for (j = 1; j <= dim; j++) gel(vtfQ,j) = mfak_i(gel(vtf,j), Q);
    6539         630 :     for (i = 1; i < l; i++)
    6540             :     {
    6541         560 :       GEN S = gen_0, f = gel(F,i);
    6542        6160 :       for (j = 1; j <= dim; j++)
    6543             :       {
    6544        5600 :         GEN t = liftpol_shallow(gel(f,j));
    6545        5600 :         S = gadd(S, gmul(t, gel(vtfQ,j)));
    6546             :       }
    6547         560 :       if (typ(S) == t_POL) S = degpol(S) < 0? gen_0: gel(S,2);
    6548         560 :       if (muQ == -1) S = gneg(S);
    6549         560 :       if (ok && gequal0(S)) ok = 0;
    6550         560 :       gel(Z, i) = const_vec(dims[i], gdiv(S, Qk));
    6551             :     }
    6552          70 :     if (ok) return Z;
    6553             :   }
    6554             :   else
    6555         175 :     Z = zerovec(lgal-1);
    6556         175 :   laq2 = mfchareval_i(CHIP, Q); /* 1 or -1 */
    6557         175 :   (void)cbezout(Q, NQ, &t, &yq);
    6558         175 :   sqrtQ = sqrtr_abs(utor(Q,prec));
    6559         175 :   tau = mkcomplex(gadd(gdivgs(stoi(-t), NQ), ginv(utoi(1000))),
    6560             :                   divru(sqrtQ, N));
    6561         175 :   den = gaddgs(gmulsg(NQ, tau), t);
    6562         175 :   wtau = gdiv(gsub(tau, gdivgs(stoi(yq), Q)), den);
    6563         175 :   coe = gpowgs(gmul(sqrtQ, den), k);
    6564         175 :   veval = cgetg(dim + 1, t_VEC);
    6565        1876 :   for (j = 1; j <= dim; j++)
    6566        1701 :     gel(veval,j) = mfeval0(N, k, gel(vtf,j), mkvec2(tau,wtau), bitprec);
    6567        1533 :   for (i = 1; i < lgal; i++)
    6568             :   {
    6569        1358 :     GEN z, ro = gel(RO,i), f = gel(F,i);
    6570        1358 :     long l = lg(ro);
    6571             : 
    6572        1358 :     if (l == 2)
    6573             :     {
    6574        1015 :       GEN lar = get_laq(f, NULL, veval, coe);
    6575        1015 :       lar = ground(lar);
    6576        1015 :       if (gexpo(gsub(gsqr(lar), laq2)) > -(bitprec>>1))
    6577           0 :         pari_err_PREC("mfatkineigenvalues");
    6578        1015 :       z = mkvec(lar);
    6579             :     }
    6580             :     else
    6581             :     {
    6582         343 :       f = liftpol_shallow(f);
    6583         343 :       z = cgetg(l, t_VEC);
    6584         343 :       for (j = 1; j < l; j++)
    6585             :       {
    6586         343 :         GEN lar, laq = get_laq(f, gel(ro,j), veval, coe);
    6587         343 :         if (gexpo(gsub(gsqr(laq), laq2)) > -(bitprec>>1))
    6588           0 :           pari_err_PREC("mfatkineigenvalues");
    6589         343 :         lar = ground(laq);
    6590         343 :         if (typ(lar) == t_INT && is_pm1(lar))
    6591             :         {
    6592         343 :           if (j != 1) pari_err_BUG("mfatkineigenvalues [1]");
    6593         343 :           z = const_vec(l-1, lar); break;
    6594             :         }
    6595           0 :         gel(z,j) = lar;
    6596             :       }
    6597             :     }
    6598        1358 :     if (!gequal0(gel(Z,i)) && !gequal(gel(Z,i), z))
    6599           0 :       pari_err_BUG("mfatkineigenvalues [2]");
    6600        1358 :     gel(Z, i) = z;
    6601             :   }
    6602         175 :   return Z;
    6603             : }
    6604             : GEN
    6605          14 : mfatkineigenvalues(GEN mf, long Q, long bit)
    6606             : {
    6607          14 :   pari_sp av = avma;
    6608             :   GEN RO;
    6609          14 :   checkmfsplit(mf); RO = mfQeigenroots(mf, nbits2prec(bit));
    6610          14 :   return gerepilecopy(av, mfatkineigenvalues_i(mf,Q,RO,bit));
    6611             : }
    6612             : 
    6613             : /* assume mf a split newspace for a real character, RO = mfQeigenroots(mf) */
    6614             : static GEN
    6615         301 : mfQeigenembed(GEN mf, GEN RO)
    6616             : {
    6617         301 :   long i, ct = 0, dim = mf_get_dim(mf);
    6618         301 :   GEN F = mf_get_newforms(mf), M = cgetg(dim+1, t_MAT);
    6619        2667 :   for (i = 1; i < lg(F); i++)
    6620             :   {
    6621        2366 :     GEN ro = gel(RO,i), f = gel(F,i);
    6622        2366 :     long j, l = lg(ro);
    6623        2366 :     if (l == 2) gel(M, ++ct) = f;
    6624             :     else
    6625         595 :       for (j = 1; j < l; j++) gel(M, ++ct) = RgC_embed(f, gel(ro,j));
    6626             :   }
    6627         301 :   return M; /* ct = dim */
    6628             : }
    6629             : /* assume mf a split newspace, general character, RO = mfQeigenroots(mf) */
    6630             : static GEN
    6631           0 : mfeigenembed(GEN mf, long vt, GEN vcyclo, GEN RO)
    6632             : {
    6633           0 :   long i, ct = 0, dim = mf_get_dim(mf);
    6634           0 :   GEN F = mf_get_newforms(mf), M = cgetg(dim+1, t_MAT);
    6635           0 :   for (i = 1; i < lg(F); i++)
    6636             :   {
    6637           0 :     GEN ro = gel(RO,i), f = gel(F,i);
    6638           0 :     long j, l = lg(ro);
    6639           0 :     for (j = 1; j < l; j++) gel(M, ++ct) = RgC_embed2(f, vt, vcyclo, gel(ro,j));
    6640             :   }
    6641           0 :   return M; /* ct = dim */
    6642             : }
    6643             : 
    6644             : /* FIXME */
    6645             : static long
    6646           0 : RgC_study_fields(GEN mf, GEN v)
    6647             : {
    6648           0 :   const long vy = 1;
    6649           0 :   long i, l = lg(v);
    6650           0 :   GEN T = NULL, P = mf_get_fields(mf);
    6651           0 :   for (i = 1; i < l; i++)
    6652             :   {
    6653           0 :     GEN c = gel(v,i);
    6654           0 :     long t = typ(c);
    6655           0 :     if (t == t_POLMOD && varn(gel(c,1)) == vy)
    6656           0 :     { if (!T) T = gel(c,1); else if (!gequal(T,gel(c,1))) return -1; }
    6657             :   }
    6658           0 :   l = lg(P);
    6659           0 :   for (i = 1; i < l; i++)
    6660           0 :     if (gequal(T,gel(P,i))) return i;
    6661           0 :   return 0;
    6662             : }
    6663             : 
    6664             : /* split mf, embed F */
    6665             : GEN
    6666           0 : mftoeigenbasis(GEN mf, GEN F, long prec)
    6667             : {
    6668             :   GEN M, RO;
    6669             :   long o;
    6670           0 :   checkmfsplit(mf);
    6671           0 :   o = ord_canon(mfcharorder(mf_get_CHI(mf)));
    6672           0 :   F = mftobasis(mf, F, 0);
    6673           0 :   if (o == 1)
    6674             :   {
    6675           0 :     RO = mfQeigenroots(mf,prec);
    6676           0 :     M = mfQeigenembed(mf, RO);
    6677           0 :     F = RgC_embed(F, RO);
    6678             :   }
    6679             :   else
    6680             :   {
    6681           0 :     const long vt = fetch_user_var("t");
    6682             :     long i;
    6683           0 :     GEN vcyclo = grootsof1(o, prec);
    6684           0 :     RO = mfeigenroots(mf,vcyclo,prec);
    6685           0 :     M = mfeigenembed(mf, vt, vcyclo, RO);
    6686           0 :     i = RgC_study_fields(mf, F);
    6687           0 :     if (i < 0) pari_err_IMPL("mftoeigenbasis in this case");
    6688           0 :     if (i)
    6689           0 :       F = RgC_embed2(F, vt, vcyclo, gmael(RO,i,1));
    6690             :     else
    6691           0 :       F = RgC_embed(F, vcyclo);
    6692             :   }
    6693           0 :   return RgM_solve(M,F);
    6694             : }
    6695             : 
    6696             : static GEN
    6697         301 : matapprox(GEN A, GEN dA)
    6698             : {
    6699             :   long e;
    6700         301 :   A = grndtoi(RgM_Rg_mul(A,dA), &e);
    6701         301 :   return (e < -32)? RgM_Rg_div(A, dA): NULL;
    6702             : }
    6703             : 
    6704             : static GEN
    6705         301 : mfmatatkin_i(GEN mf, long Q, long *cM)
    6706             : {
    6707             :   GEN M, M1, D, DN, MF, den, RO;
    6708             :   long radN, N, k, i, l, dim, prec, s, bitprec;
    6709             : 
    6710         301 :   checkmfsplit(mf);
    6711         301 :   if (mf_get_space(mf) != mf_NEW) pari_err_IMPL("mfmatatkin for full space");
    6712         301 :   *cM = 1; dim = mf_get_dim(mf);
    6713         301 :   if (!dim) return cgetg(1, t_MAT);
    6714         301 :   N = mf_get_N(mf);
    6715         301 :   k = mf_get_k(mf);
    6716         301 :   radN = radical_u(N);
    6717         301 :   den = muliu( gel(mf_get_Minv(mf), 2), radN);
    6718         301 :   bitprec = expi(den) + 64;
    6719         301 :   prec = nbits2prec(bitprec);
    6720         301 :   RO = mfQeigenroots(mf, prec);
    6721         301 :   D = mfatkineigenvalues_i(mf, Q, RO, bitprec);
    6722         301 :   D = diagonal_shallow(shallowconcat1(D));
    6723         301 :   M = mfQeigenembed(mf, RO);
    6724         301 :   MF = gmul(M, gmul(D, ginv(M)));
    6725         301 :   if (!odd(k) || Q != N || mfcharistrivial(mf_get_CHI(mf))) s = 1;
    6726           0 :   else { MF = imag_i(MF); s = -1; }
    6727         301 :   M1 = matapprox(MF, den);
    6728         301 :   if (M1) { *cM = s; return M1; }
    6729           0 :   DN = mydivisorsu(radN);
    6730           0 :   l = lg(DN);
    6731           0 :   for (i = 2; i < l; i++) /* skip 1 */
    6732             :   {
    6733           0 :     long d = DN[i];
    6734           0 :     GEN MG = RgM_Rg_mul(MF, sqrtr_abs(utor(d,prec)));
    6735           0 :     M1 = matapprox(MG, den);
    6736           0 :     if (M1) { *cM = s * d; return M1; }
    6737             :   }
    6738           0 :   pari_err_BUG("mfmatatkin [no good approximation found]");
    6739             :   return NULL;/*LCOV_EXCL_LINE*/
    6740             : }
    6741             : GEN
    6742         294 : mfmatatkin(GEN mf, long Q, GEN *cM)
    6743             : {
    6744         294 :   pari_sp av = avma;
    6745             :   long c;
    6746         294 :   GEN M = gerepilecopy(av, mfmatatkin_i(mf, Q, &c));
    6747         294 :   if (cM) *cM = utoipos(c);
    6748         294 :   return M;
    6749             : }
    6750             : 
    6751             : /* Apply atkin Q to closure F */
    6752             : GEN
    6753          14 : mfatkin(GEN mf, GEN F, GEN Q, long bitprec)
    6754             : {
    6755          14 :   pari_sp av = avma;
    6756             :   GEN z;
    6757          14 :   long A, prec = nbits2prec(bitprec);
    6758          14 :   checkmf(mf);
    6759          14 :   z = mftobasis_i(mf, F);
    6760          14 :   switch(typ(Q))
    6761             :   {
    6762           7 :     case t_INT: Q = mfmatatkin_i(mf, itos(Q), &A); break;
    6763             :     case t_VEC:
    6764           7 :       if (lg(Q) == 3 && typ(gel(Q,1))==t_MAT && typ(gel(Q,2))==t_INT)
    6765             :       {
    6766           7 :         A = itos(gel(Q,2));
    6767           7 :         Q = gel(Q,1); break;
    6768             :       }
    6769           0 :     default: pari_err_TYPE("mfatkin", Q);
    6770             :              return NULL; /*LCOV_EXCL_LINE*/
    6771             :   }
    6772          14 :   z = RgM_RgC_mul(Q, z);
    6773          14 :   if (A != 1) z = gdiv(z, sqrtr(stor(A,prec)));
    6774          14 :   return gerepilecopy(av, mflinear_i(mf_get_vtf(mf), z));
    6775             : }
    6776             : 
    6777             : /* Fourier expansion of form F (closure) at a cusp */
    6778             : GEN
    6779         280 : mfcuspexpansion(GEN mf, GEN F, GEN cusp, long n)
    6780             : {
    6781         280 :   pari_sp ltop = avma;
    6782             :   GEN M, a;
    6783         280 :   long N, Q, c = 0;
    6784             : 
    6785         280 :   checkmf(mf); N = mf_get_N(mf);
    6786         280 :   if (n < 0) pari_err_DOMAIN("mfcuspexpansion", "n", "<", gen_0, stoi(n));
    6787         280 :   switch(typ(cusp))
    6788             :   {
    6789           0 :     case t_INFINITY: c = N; break;
    6790          70 :     case t_INT:   c = 1; break;
    6791         210 :     case t_FRAC : c = itos(gel(cusp,2)); break;
    6792           0 :     default: pari_err_TYPE("mfcuspexpansion", cusp);
    6793             :   }
    6794         280 :   if (N%c) pari_err_TYPE("mfcuspexpansion [cusp = a/b, with b|N]", cusp);
    6795         280 :   Q = N/c;
    6796         280 :   if (cgcd(c, Q) > 1)
    6797           0 :     pari_err_IMPL("mfcuspexpansion for cusp a/c with gcd(c,N/c) > 1");
    6798         280 :   M = mfmatatkin(mf, Q, NULL);
    6799         280 :   a = RgM_RgC_mul(M, mftobasis_i(mf,F));
    6800         280 :   a = c_linear(n, 1, mf_get_vtf(mf), a);
    6801         280 :   return gerepileupto(ltop, a);
    6802             : }
    6803             : 
    6804             : static GEN
    6805         882 : search_from_mf(GEN mf, GEN vap, GEN vlp)
    6806             : {
    6807         882 :   pari_sp av = avma;
    6808         882 :   long lvlp = lg(vlp), N = mf_get_N(mf);
    6809         882 :   GEN v, M = NULL, vtf = mf_get_vtf(mf), S = mf_get_newforms(mf);
    6810             :   long j, jv, lS;
    6811         882 :   if (lvlp > 1) M = rowpermute(mfvectomat(vtf, vlp[lvlp-1]), vlp);
    6812         882 :   v = cgetg_copy(S, &lS);
    6813        1400 :   for (j = jv = 1; j < lS; j++)
    6814             :   {
    6815         518 :     GEN vF = gel(S,j);
    6816             :     long t;
    6817         651 :     for (t = lvlp-1; t > 0; t--)
    6818             :     { /* lhs = vlp[j]-th coefficient of eigenform */
    6819         595 :       GEN rhs = gel(vap,t), lhs = RgMrow_RgC_mul(M, vF, t);
    6820         595 :       if (!gequal(lhs, rhs)) break;
    6821             :     }
    6822         518 :     if (t) continue;
    6823          56 :     gel(v,jv++) = mkvec2(utoi(N), mflinear_i(vtf,vF));
    6824             :   }
    6825         882 :   if (jv == 1) { avma = av; return NULL; }
    6826          56 :   setlg(v,jv); return v;
    6827             : }
    6828             : GEN
    6829          28 : mfsearch(GEN NK, GEN AP)
    6830             : {
    6831          28 :   pari_sp av = avma;
    6832          28 :   GEN k, vap, vlp, vres = cgetg(1, t_VEC), D;
    6833             :   long N, N0, i, l, even;
    6834             : 
    6835          28 :   if (!AP) l = 1;
    6836             :   else
    6837             :   {
    6838          28 :     l = lg(AP);
    6839          28 :     if (typ(AP) != t_VEC) pari_err_TYPE("mfsearch",AP);
    6840             :   }
    6841          28 :   vap = cgetg(l, t_VEC);
    6842          28 :   vlp = cgetg(l, t_VEC);
    6843          28 :   if (l > 1)
    6844             :   {
    6845          28 :     GEN perm = indexvecsort(AP, mkvecsmall(1));
    6846          77 :     for (i = 1; i < l; ++i)
    6847             :     {
    6848          49 :       GEN v = gel(AP,perm[i]), gp, ap;
    6849          49 :       if (typ(v) != t_VEC || lg(v) != 3) pari_err_TYPE("mfsearch", AP);
    6850          49 :       gp = gel(v,1);
    6851          49 :       ap = gel(v,2);
    6852          49 :       if (typ(gp) != t_INT || (typ(ap) != t_INT && typ(ap) != t_INTMOD))
    6853           0 :         pari_err_TYPE("mfsearch", AP);
    6854          49 :       gel(vap,i) = ap;
    6855          49 :       vlp[i] = itos(gp)+1; if (vlp[i] < 0) pari_err_TYPE("mfsearch", AP);
    6856             :     }
    6857             :   }
    6858          28 :   l = lg(NK);
    6859          28 :   if (typ(NK) != t_VEC || l != 3
    6860          28 :       || typ(gel(NK,1)) != t_INT
    6861          28 :       || typ(gel(NK,2)) != t_INT) pari_err_TYPE("mfsearch",NK);
    6862          28 :   N0 = itos(gel(NK,1));
    6863          28 :   k = gel(NK,2);
    6864          28 :   vecsmall_sort(vlp);
    6865          28 :   even = !mpodd(k);
    6866         966 :   for (N = 1; N <= N0; N++)
    6867             :   {
    6868         938 :     pari_sp av2 = avma;
    6869             :     GEN mf, L;
    6870         938 :     if (even) D = gen_1;
    6871             :     else
    6872             :     {
    6873         112 :       long r = (N&3L);
    6874         112 :       if (r == 1 || r == 2) continue;
    6875          56 :       D = stoi( corediscs(-N, NULL) ); /* < 0 */
    6876             :     }
    6877         882 :     mf = mfsplit(mkvec3(utoipos(N), k, D), 1, 0);
    6878         882 :     L = search_from_mf(mf, vap, vlp);
    6879         882 :     if (L) vres = shallowconcat(vres, L); else avma = av2;
    6880             :   }
    6881          28 :   return gerepilecopy(av, vres);
    6882             : }
    6883             : 
    6884             : /* tf_{N,k}(n) */
    6885             : static GEN
    6886     2181879 : mfnewtracecache(long N, long k, long n, cachenew_t *cache)
    6887             : {
    6888     2181879 :   GEN C = NULL, S;
    6889             :   long lcache;
    6890     2181879 :   if (!n) return gen_0;
    6891     2104641 :   S = gel(cache->vnew,N);
    6892     2104641 :   lcache = lg(S);
    6893     2104641 :   if (n < lcache) C = gel(S, n);
    6894     2104641 :   if (C) cache->newHIT++;
    6895     1404046 :   else C = mfnewtrace_i(N,k,n,cache);
    6896     2104641 :   cache->newTOTAL++;
    6897     2104641 :   if (n < lcache) gel(S,n) = C;
    6898     2104641 :   return C;
    6899             : }
    6900             : 
    6901             : static long
    6902        2107 : mfwt1dimsum(long N, long space)
    6903             : {
    6904        2107 :   switch(space)
    6905             :   {
    6906        1050 :     case mf_NEW:  return mfwt1newdim(N);
    6907        1057 :     case mf_CUSP: return mfwt1dim_i(N);
    6908           0 :     case mf_OLD:  return mfwt1dim_i(N) - mfwt1newdim(N);
    6909             :   }
    6910           0 :   pari_err_FLAG("mfdim");
    6911             :   return 0; /*LCOV_EXCL_LINE*/
    6912             : }
    6913             : static long
    6914          35 : mfwtkdimsum(long N, long k, long space)
    6915             : {
    6916          35 :   GEN w = mfchargalois(N, k & 1, NULL);
    6917          35 :   long i, j, d = 0, l = lg(w);
    6918         315 :   for (i = j = 1; i < l; i++)
    6919             :   {
    6920         280 :     GEN CHI = gel(w,i);
    6921         280 :     d += itou( mfdim(toNK(N,k,CHI), space) );
    6922             :   }
    6923          35 :   return d;
    6924             : }
    6925             : static GEN
    6926          84 : mfwt1dims(long N, GEN vCHI, long space)
    6927             : {
    6928          84 :   GEN D = NULL;
    6929          84 :   switch(space)
    6930             :   {
    6931          56 :     case mf_NEW: D = mfwt1newdimall(N, vCHI); break;
    6932          14 :     case mf_CUSP:D = mfwt1dimall(N, vCHI); break;
    6933          14 :     case mf_OLD: D = mfwt1olddimall(N, vCHI); break;
    6934           0 :     default: pari_err_FLAG("mfdim");
    6935             :   }
    6936          84 :   return D;
    6937             : }
    6938             : static GEN
    6939          70 : mfwtkdims(long N, long k, GEN vCHI, long space)
    6940             : {
    6941          70 :   GEN D, w = vCHI? vCHI: mfchargalois(N, k & 1, NULL);
    6942          70 :   long i, j, l = lg(w);
    6943          70 :   D = cgetg(l, t_VEC);
    6944         910 :   for (i = j = 1; i < l; i++)
    6945             :   {
    6946         840 :     GEN CHI = gel(w,i);
    6947         840 :     long d = itou( mfdim(toNK(N,k,CHI), space) );
    6948         840 :     if (vCHI)
    6949         560 :       gel(D, j++) = mkvec2s(d, 0);
    6950         280 :     else if (d)
    6951         259 :       gel(D, j++) = fmt_dim(CHI, d, 0);
    6952             :   }
    6953          70 :   setlg(D,j); return D;
    6954             : }
    6955             : GEN
    6956        3612 : mfdim(GEN NK, long space)
    6957             : {
    6958        3612 :   pari_sp av = avma;
    6959             :   long N, k, joker;
    6960             :   GEN CHI;
    6961        3612 :   if (checkmf_i(NK)) return utoi(mf_get_dim(NK));
    6962        3535 :   checkNK(NK, &N, &k, &CHI, 2);
    6963        3535 :   if (!CHI) joker = 1;
    6964             :   else
    6965        3451 :     switch(typ(CHI))
    6966             :     {
    6967        2142 :       case t_INT: joker = 2; break;
    6968         112 :       case t_COL: joker = 3; break;
    6969        1197 :       default: joker = 0; break;
    6970             :     }
    6971        3535 :   if (joker)
    6972             :   {
    6973             :     long d;
    6974             :     GEN D;
    6975        2338 :     if (k < 0) switch(joker)
    6976             :     {
    6977           0 :       case 1: return cgetg(1,t_VEC);
    6978           0 :       case 2: return gen_0;
    6979           0 :       case 3: return mfdim0all(CHI);
    6980             :     }
    6981        2338 :     if (k == 0)
    6982             :     {
    6983          28 :       if (space_is_cusp(space)) switch(joker)
    6984             :       {
    6985           7 :         case 1: return cgetg(1,t_VEC);
    6986           0 :         case 2: return gen_0;
    6987           7 :         case 3: return mfdim0all(CHI);
    6988             :       }
    6989          14 :       switch(joker)
    6990             :       {
    6991             :         long i, l;
    6992           7 :         case 1: retmkvec(fmt_dim(mfchartrivial(1),0,0));
    6993           0 :         case 2: return gen_1;
    6994           7 :         case 3: l = lg(CHI); D = cgetg(l,t_VEC);
    6995          35 :                 for (i = 1; i < l; i++)
    6996             :                 {
    6997          28 :                   long t = mfcharistrivial(gel(CHI,i));
    6998          28 :                   gel(D,i) = mkvec2(t? gen_1: gen_0, gen_0);
    6999             :                 }
    7000           7 :                 return D;
    7001             :       }
    7002             :     }
    7003        2310 :     if (k == 1)
    7004             :     {
    7005        2205 :       if (!space_is_cusp(space))
    7006          14 :         pari_err_IMPL("noncuspidal dimension of G_1(N)");
    7007        2191 :       if (joker == 2) { d = mfwt1dimsum(N, space); avma = av; return utoi(d); }
    7008          84 :       D = mfwt1dims(N, CHI, space);
    7009             :     }
    7010             :     else
    7011             :     {
    7012         105 :       if (joker == 2) { d = mfwtkdimsum(N,k,space); avma = av; return utoi(d); }
    7013          70 :       D = mfwtkdims(N, k, CHI, space);
    7014             :     }
    7015         154 :     if (!CHI) return gerepileupto(av, vecsort(D, mkvecsmall(1)));
    7016          98 :     return gerepilecopy(av, D);
    7017             :   }
    7018        1197 :   if (k < 0 || !ischarok(N,k,CHI)) return gen_0;
    7019         903 :   if (k == 0)
    7020          28 :     return mfcharistrivial(CHI) && !space_is_cusp(space)? gen_1: gen_0;
    7021         875 :   switch(space)
    7022             :   {
    7023         175 :     case mf_NEW: return utoi( mfnewdim(N,k,CHI) );
    7024         168 :     case mf_CUSP:return utoi( mfcuspdim(N,k,CHI) );
    7025         168 :     case mf_OLD: return utoi( mfolddim(N,k,CHI) );
    7026         175 :     case mf_FULL:return utoi( mffulldim(N,k,CHI) );
    7027         189 :     case mf_EISEN: return utoi( mfeisendim(N,k,CHI) );
    7028           0 :     default: pari_err_FLAG("mfdim");
    7029             :   }
    7030             :   return NULL;/*LCOV_EXCL_LINE*/
    7031             : }
    7032             : 
    7033             : /* Given a closure F and a vector of complex numbers z, output the vector of
    7034             :  * closures corresponding to all embeddings X -> z[j] */
    7035             : static GEN
    7036          56 : allembed(GEN F, GEN z)
    7037             : {
    7038          56 :   long l = lg(z), j;
    7039          56 :   GEN r = cgetg(l, t_VEC);
    7040          56 :   if (l > 1)
    7041             :   {
    7042          56 :     GEN NK = f_NK(F);
    7043          56 :     for (j = 1; j < l; j++) gel(r,j) = tag2(t_MF_EMBED, NK, F, gel(z,j));
    7044             :   }
    7045          56 :   return r;
    7046             : }
    7047             : GEN
    7048           7 : mfembed(GEN F, long prec)
    7049             : {
    7050           7 :   pari_sp av = avma;
    7051           7 :   GEN vecan = mfcoefs(F, 20, 1);
    7052             :   long n;
    7053         147 :   for (n = 0; n < 20; n++)
    7054             :   {
    7055         140 :     GEN an = gel(vecan, n+1);
    7056         140 :     if (typ(an) == t_POLMOD)
    7057             :     {
    7058           0 :       GEN z = rootspowers( ZX_roots(gel(an,1), prec) );
    7059           0 :       return gerepilecopy(av, allembed(F, z));
    7060             :     }
    7061             :   }
    7062           7 :   avma = av; return mkveccopy(F);
    7063             : }
    7064             : /* polmods, set P for Q(chi), T for relative extension */
    7065             : static int
    7066          21 : RgV_polmods(GEN v, GEN *P, GEN *T)
    7067             : {
    7068          21 :   const long vy = 1;
    7069          21 :   long i, l = lg(v), vt = fetch_user_var("t");
    7070          21 :   *T = *P = NULL;
    7071         252 :   for (i = 1; i < l; i++)
    7072             :   {
    7073         231 :     GEN c = gel(v,i);
    7074         231 :     long t = typ(c);
    7075         231 :     if (t == t_POLMOD)
    7076             :     {
    7077         231 :       long vc = varn(gel(c,1));
    7078         231 :       GEN Q = NULL;
    7079         231 :       if (vc == vy)
    7080             :       {
    7081         154 :         GEN p = NULL;
    7082         154 :         if (*T)
    7083             :         {
    7084         280 :           if (gequal(*T,gel(c,1))) continue;
    7085           0 :           return 0;
    7086             :         }
    7087          14 :         *T = gel(c,1);
    7088          14 :         if (!RgX_is_FpXQX(*T,&Q,&p) || p) return 0;
    7089          14 :         if (!Q) continue;
    7090          14 :         vc = varn(Q);
    7091             :       }
    7092             :       else
    7093             :       {
    7094          77 :         if (vc != vt) return 0;
    7095          77 :         Q = gel(c,1);
    7096             :       }
    7097          91 :       if (!*P) *P = Q; else if (!gequal(*P,Q)) return 0;
    7098             :     }
    7099             :   }
    7100          21 :   return 1;
    7101             : }
    7102             : GEN
    7103          21 : mfreltoabs(GEN F)
    7104             : {
    7105          21 :   pari_sp av = avma;
    7106             :   GEN S, P, T;
    7107          21 :   if (!RgV_polmods(mfcoefs(F,10,1), &P, &T)) pari_err_TYPE("mfreltoabs",F);
    7108          21 :   S = (P&&T)? nf_rnfeq(P,T): gen_0;
    7109          21 :   return gerepilecopy(av, tag2(t_MF_RELTOABS, f_NK(F), F, S));
    7110             : }
    7111             : 
    7112             : static GEN
    7113         105 : lfunmf_i(GEN F, GEN sd, GEN N, GEN k, GEN r, long cuspidal, long bitprec)
    7114             : {
    7115         105 :   GEN LF = cuspidal? cgetg(7, t_VEC): cgetg(8, t_VEC);
    7116         105 :   gel(LF,1) = lfuntag(t_LFUN_MFCLOS, F);
    7117         105 :   gel(LF,2) = sd;
    7118         105 :   gel(LF,3) = mkvec2(gen_0, gen_1);
    7119         105 :   gel(LF,4) = k;
    7120         105 :   gel(LF,5) = N;
    7121         105 :   gel(LF,6) = r;
    7122         105 :   if (!cuspidal) gel(LF, 7) = gen_0;
    7123         105 :   if (gequal0(r))
    7124             :   {
    7125          35 :     GEN v = lfunrootres(LF, bitprec + 32), po;
    7126          35 :     gel(LF,6) = gel(v,3);
    7127          35 :     if (!cuspidal)
    7128             :     {
    7129           7 :       po = gel(v, 1);
    7130           7 :       if (isintzero(po)) setlg(LF, 7);
    7131           7 :       else gel(LF, 7) = po;
    7132             :     }
    7133             :   }
    7134         105 :   return LF;
    7135             : }
    7136             : static GEN
    7137           7 : lfunmfall(GEN mf, long real, long bitprec)
    7138             : {
    7139             :   GEN L, M, SD, F, A, RO, gN, gk;
    7140           7 :   long l, i, N, k, prec = nbits2prec(bitprec);
    7141             : 
    7142           7 :   M = mfeigenbasis(mf);
    7143           7 :   N = mf_get_N(mf); gN = utoipos(N);
    7144           7 :   k = mf_get_k(mf); gk = utoipos(k);
    7145           7 :   RO = mfQeigenroots(mf, prec);
    7146           7 :   A = mfatkineigenvalues_i(mf, N, RO, bitprec);
    7147           7 :   l = lg(RO);
    7148           7 :   SD = cgetg(l, t_VEC);
    7149           7 :   F = cgetg(l, t_VEC);
    7150          63 :   for (i = 1; i < l; i++)
    7151             :   {
    7152          56 :     GEN ro = gel(RO,i), f = gel(M,i);
    7153          56 :     long n = lg(ro)-1;
    7154          56 :     int sd = (typ(gel(ro,n)) == t_COMPLEX);
    7155          56 :     if (real && sd) pari_err_FLAG("lfunmf [not a real eigenform]");
    7156          56 :     gel(F,i) = allembed(f, ro);
    7157          56 :     gel(SD,i) = const_vec(n, sd? gen_1: gen_0);
    7158             :   }
    7159           7 :   A = shallowconcat1(A);
    7160           7 :   F = shallowconcat1(F);
    7161           7 :   SD= shallowconcat1(SD);
    7162           7 :   l = lg(A); L = cgetg(l, t_VEC);
    7163          77 :   for (i = 1; i < l; i++)
    7164             :   {
    7165          70 :     GEN r = mulcxpowIs(gel(A,i), k);
    7166          70 :     gel(L,i) = lfunmf_i(gel(F,i), gel(SD,i), gN, gk, r, 1, bitprec);
    7167             :   }
    7168           7 :   return L;
    7169             : }
    7170             : GEN
    7171          42 : lfunmf(GEN F, long flag, long bitprec)
    7172             : {
    7173          42 :   pari_sp av = avma;
    7174             :   GEN z;
    7175          42 :   if (!isf(F)) z = lfunmfall(F, flag & 1, bitprec);
    7176             :   else
    7177             :   {
    7178          35 :     GEN gN, gk, sd = flag & 1? gen_0: gen_1;
    7179          35 :     gN = f_gN(F);
    7180          35 :     gk = f_gk(F);
    7181          35 :     if (signe(gN) < 0 || signe(gk) < 0) pari_err_TYPE("lfunmf",F);
    7182          35 :     z = lfunmf_i(F, sd, gN, gk, gen_0, flag & 2, bitprec);
    7183             :   }
    7184          42 :   return gerepilecopy(av,z);
    7185             : }
    7186             : 
    7187             : static GEN
    7188           0 : get_theta(GEN LD, GEN tdom, GEN vtau, long bit)
    7189             : {
    7190           0 :   GEN z, LT = lfunthetainit(LD, tdom, 0, bit);
    7191             :   long j, l;
    7192           0 :   if (!is_vec_t(typ(vtau))) return lfuntheta(LT, vtau, 0, bit);
    7193           0 :   l = lg(vtau); z = cgetg(l, t_VEC);
    7194           0 :   for (j = 1; j < l; ++j) gel(z,j) = lfuntheta(LT, gel(vtau,j), 0, bit);
    7195           0 :   return z;
    7196             : }
    7197             : /* Here F is an eigenform already embedded, hence an mf closure. */
    7198             : GEN
    7199           0 : mfeigeneval(GEN mf, GEN vtau, long bitprec)
    7200             : {
    7201           0 :   pari_sp av = avma;
    7202             :   GEN L, tdom, z;
    7203             :   long prec, N;
    7204             : 
    7205           0 :   if (isf(mf))
    7206             :   {
    7207           0 :     N = f_N(mf); if (N < 0) pari_err_IMPL("mfeigeneval for this form");
    7208           0 :     L = lfunmf(mf, 0, bitprec);
    7209           0 :     mf = NULL;
    7210             :   }
    7211             :   else
    7212             :   {
    7213           0 :     checkmfsplit(mf);
    7214           0 :     N = mf_get_N(mf);
    7215           0 :     L = lfunmfall(mf, 0, bitprec);
    7216             :   }
    7217           0 :   prec = nbits2prec(bitprec);
    7218           0 :   vtau = gmul(sqrtr_abs(utor(N, prec)), mulcxmI(vtau));
    7219           0 :   tdom = mkvec2(vecmin(gabs(vtau,prec)), vecmax(gabs(garg(vtau,prec),prec)));
    7220           0 :   if (!mf)
    7221           0 :     z  = get_theta(L, tdom, vtau, bitprec);
    7222             :   else
    7223             :   {
    7224           0 :     long i, l = lg(L);
    7225           0 :     z = cgetg(l, t_VEC);
    7226           0 :     for (i = 1; i < l; i++) gel(z,i) = get_theta(gel(L,i), tdom, vtau, bitprec);
    7227             :   }
    7228           0 :   return gerepileupto(av, gmul2n(z, -1));
    7229             : }
    7230             : 
    7231             : GEN
    7232          21 : mffromell(GEN E)
    7233             : {
    7234          21 :   pari_sp av = avma;
    7235             :   GEN mf, F, z, S;
    7236             :   long N, i, l;
    7237             : 
    7238          21 :   checkell(E);
    7239          21 :   if (ell_get_type(E) != t_ELL_Q) pari_err_TYPE("mfffromell [E not over Q]", E);
    7240          21 :   N = itos(gel(ellglobalred(E), 1));
    7241          21 :   mf = mfsplit(mfinit(mkvec2(utoi(N), gen_2), mf_NEW), 1, 0);
    7242          21 :   F = tag(t_MF_ELL, mkNK(N,2,mfchartrivial(1)), E);
    7243          21 :   z = mftobasis_i(mf, F);
    7244          21 :   S = mf_get_newforms(mf); l = lg(S);
    7245          21 :   for(i = 1; i < l; i++)
    7246          21 :     if (gequal(z, gel(S, i))) break;
    7247          21 :   if (i == l) pari_err_BUG("mffromell [E is not modular]");
    7248          21 :   return gerepilecopy(av, mkvec3(mf, F, z));
    7249             : }
    7250             : 
    7251             : /* returns -1 if not, degree otherwise */
    7252             : long
    7253          42 : polishomogeneous(GEN P)
    7254             : {
    7255             :   long i, D, l;
    7256          42 :   if (typ(P) != t_POL) return 0;
    7257          21 :   D = -1; l = lg(P);
    7258         112 :   for (i = 2; i < l; i++)
    7259             :   {
    7260          91 :     GEN c = gel(P,i);
    7261             :     long d;
    7262          91 :     if (gequal0(c)) continue;
    7263          35 :     d = polishomogeneous(c);
    7264          35 :     if (d < 0) return -1;
    7265          35 :     if (D < 0) D = d + i-2; else if (D != d + i-2) return -1;
    7266             :   }
    7267          21 :   return D;
    7268             : }
    7269             : 
    7270             : /* 1 if spherical, 0 otherwise */
    7271             : static long
    7272           7 : polisspherical(GEN Qi, GEN P)
    7273             : {
    7274           7 :   pari_sp av = avma;
    7275             :   GEN va, S;
    7276             :   long lva, i, j, r;
    7277           7 :   if (gequal0(P) || poldegree(P, -1) <= 1) return 1;
    7278           7 :   va = variables_vecsmall(P); lva = lg(va);
    7279           7 :   if (lva > lg(Qi))
    7280           0 :     pari_err(e_MISC, "too many variables in mffromqf");
    7281           7 :   S = gen_0;
    7282          21 :   for (j = 1; j < lva; ++j)
    7283             :   {
    7284          14 :     GEN col = gel(Qi, j), Pj = deriv(P, va[j]);
    7285          35 :     for (i = 1; i <= j; ++i)
    7286             :     {
    7287          21 :       GEN coe = gel(col, i);
    7288          21 :       if (i != j) coe = gmul2n(coe, 1);
    7289          21 :       if (!gequal0(coe))
    7290          14 :         S = gadd(S, gmul(coe, deriv(Pj, va[i])));
    7291             :     }
    7292             :   }
    7293           7 :   r = gequal0(S); avma = av; return r;
    7294             : }
    7295             : 
    7296             : static GEN
    7297          21 : c_QFsimple(long n, GEN Q, GEN P)
    7298             : {
    7299          21 :   pari_sp av = avma;
    7300          21 :   GEN V, v = qfrep0(Q, utoi(n), 1);
    7301          21 :   long i, l = lg(v);
    7302          21 :   V = cgetg(l+1, t_VEC);
    7303          42 :   if (!P || equali1(P))
    7304             :   {
    7305          21 :     gel(V,1) = gen_1;
    7306          21 :     for (i = 2; i <= l; i++) gel(V,i) = utoi(v[i-1] << 1);
    7307             :   }
    7308             :   else
    7309             :   {
    7310           0 :     gel(V,1) = gcopy(P);
    7311           0 :     for (i = 2; i <= l; i++) gel(V,i) = gmulgs(P, v[i-1] << 1);
    7312             :   }
    7313          21 :   return gerepileupto(av, V);
    7314             : }
    7315             : static GEN
    7316          28 : c_QF(long n, GEN Q, GEN P)
    7317             : {
    7318          28 :   pari_sp av = avma;
    7319             :   GEN V, v, va;
    7320             :   long i, lva, lq, l;
    7321          28 :   if (!P || typ(P) != t_POL) return c_QFsimple(n, Q, P);
    7322           7 :   v = gel(minim(Q, utoi(2*n), NULL), 3);
    7323           7 :   va = variables_vec(P); lq = lg(Q) - 1; lva = lg(va) - 1;
    7324           7 :   V = zerovec(n + 1); l = lg(v);
    7325          35 :   for (i = 1; i < l; ++i)
    7326             :   {
    7327          28 :     GEN X = gel(v,i);
    7328          28 :     long ind = (itos(qfeval0(Q, X, NULL)) >> 1) + 1;
    7329          28 :     if (lq > lva) X = vecslice(X, 1, lva);
    7330          28 :     gel(V, ind) = gadd(gel(V, ind), gsubstvec(P, va, X));
    7331             :   }
    7332           7 :   return gerepilecopy(av, gmul2n(V,1));
    7333             : }
    7334             : GEN
    7335          28 : mffromqf(GEN Q, GEN P)
    7336             : {
    7337          28 :   pari_sp av = avma;
    7338             :   GEN G, Qi, F, D, N, mf, v;
    7339             :   long m, k, d, space;
    7340          28 :   if (typ(Q) != t_MAT) pari_err_TYPE("mffromqf", Q);
    7341          28 :   if (!RgM_is_ZM(Q) || !qf_iseven(Q))
    7342           0 :     pari_err_TYPE("mffromqf [not integral or even]", Q);
    7343          28 :   m = lg(Q)-1;
    7344          28 :   if (odd(m)) pari_err_TYPE("mffromqf [odd dimension]", Q);
    7345          28 :   k = m >> 1;
    7346          28 :   Qi = ZM_inv_ratlift(Q, &N);
    7347          28 :   if (!qf_iseven(Qi)) N = shifti(N, 1);
    7348          28 :   if (!P || gequal1(P)) { d = 0; P = NULL; }
    7349             :   else
    7350             :   {
    7351           7 :     d = polishomogeneous(P);
    7352           7 :     if (d < 0) pari_err_TYPE("mffromqf [not homogeneous t_POL]", P);
    7353           7 :     if (!polisspherical(Qi, P))
    7354           0 :       pari_err_TYPE("mffromqf [not a spherical t_POL]", P);
    7355           7 :     if (d == 0) P = simplify_shallow(P);
    7356             :   }
    7357          28 :   D = ZM_det(Q); if (k&1L) D = negi(D);
    7358          28 :   space = d > 0 ? mf_CUSP : mf_FULL;
    7359          28 :   G = znstar0(N,1);
    7360          28 :   mf = mfinit(mkvec3(N, utoi(k+d), mkvec2(G,znchar_quad(G,D))), space);
    7361          28 :   if (odd(d))
    7362             :   {
    7363           0 :     F = mfcreate(gen_0);
    7364           0 :     v = zerocol(mf_get_dim(mf));
    7365             :   }
    7366             :   else
    7367             :   {
    7368          28 :     F = c_QF(mfsturm(mf), Q, P);
    7369          28 :     v = mftobasis_i(mf, F);
    7370          28 :     F = mflinear_i(mf_get_basis(mf), v);
    7371             :   }
    7372          28 :   return gerepilecopy(av, mkvec3(mf, F, v));
    7373             : }
    7374             : 
    7375             : /***********************************************************************/
    7376             : /*                          Eisenstein Series                          */
    7377             : /***********************************************************************/
    7378             : #if 0
    7379             : /* radical(u_ppo(g,q)) */
    7380             : static long
    7381             : u_pporad(long g, long q)
    7382             : {
    7383             :   GEN F = myfactoru(g), P = gel(F,1);
    7384             :   long i, l, n;
    7385             :   if (q == 1) return zv_prod(P);
    7386             :   l = lg(P);
    7387             :   for (i = n = 1; i < l; i++)
    7388             :   {
    7389             :     long p = P[i];
    7390             :     if (q % p) n *= p;
    7391             :   }
    7392             :   return n;
    7393             : }
    7394             : #endif
    7395             : /* \sigma_{k-1}(\chi,n) */
    7396             : static GEN
    7397       14161 : sigchi(long k, GEN CHI, long n)
    7398             : {
    7399       14161 :   pari_sp av = avma;
    7400       14161 :   GEN S = gen_0, D = mydivisorsu(u_ppo(n,mfcharmodulus(CHI)));
    7401       14161 :   long i, l = lg(D);
    7402       14161 :   if (k == 1)
    7403           0 :     for (i = 1; i < l; ++i) S = gadd(S, mfchareval_i(CHI, D[i]));
    7404             :   else
    7405       74627 :     for (i = 1; i < l; ++i)
    7406             :     {
    7407       60466 :       long d = D[i];
    7408       60466 :       S = gadd(S, gmul(powuu(d, k-1), mfchareval_i(CHI, d)));
    7409             :     }
    7410       14161 :   return gerepileupto(av,S);
    7411             : }
    7412             : 
    7413             : /* sigma_{k-1}(\chi_1,\chi_2,n), ord multiple of lcm(ord(CHI1),ord(CHI2)) */
    7414             : static GEN
    7415      283262 : sigchi2(long k, GEN CHI1, GEN CHI2, long n, long ord)
    7416             : {
    7417      283262 :   pari_sp av = avma;
    7418      283262 :   GEN S = gen_0, D;
    7419      283262 :   long i, l, N1 = mfcharmodulus(CHI1), N2 = mfcharmodulus(CHI2);
    7420      283262 :   D = mydivisorsu(u_ppo(n,N1));
    7421      283262 :   l = lg(D);
    7422     1455790 :   for (i = 1; i < l; ++i)
    7423             :   { /* S += d^(k-1)*chi1(d)*chi2(n/d) */
    7424     1172528 :     long a, d = D[i], nd = n/d; /* (d,N1)=1 */
    7425     1172528 :     if (cgcd(nd,N2) != 1) continue;
    7426      753620 :     a = mfcharevalord(CHI1, d, ord) + mfcharevalord(CHI2, nd, ord);
    7427      753620 :     if (a >= ord) a -= ord;
    7428      753620 :     S = gadd(S, mygmodulo_lift(a, ord, powuu(d, k-1)));
    7429             :   }
    7430      283262 :   return gerepileupto(av, mygmodulo_mod(S, ord));
    7431             : }
    7432             : 
    7433             : /**********************************************************************/
    7434             : /* Fourier expansions of Eisenstein series over G(N) and G_0(N),chi   */
    7435             : /**********************************************************************/
    7436             : /* \sigma_{k-1}(n;m1,m2) */
    7437             : static GEN
    7438           0 : GammaNsig(long N, long k, long m1, long m2, long n)
    7439             : {
    7440           0 :   pari_sp ltop = avma;
    7441           0 :   GEN S = gen_0, D = mydivisorsu(n);
    7442           0 :   long lD = lg(D), i, mm2;
    7443             : 
    7444           0 :   m2 = smodss(m2, N);
    7445           0 :   mm2 = m2? N-m2: 0;
    7446           0 :   for (i = 1; i < lD; ++i)
    7447             :   {
    7448           0 :     long d = D[i], nd = D[lD-i];
    7449           0 :     if ((m1 - nd) % N == 0)
    7450             :     {
    7451           0 :       GEN q = powuu(d,k-1);
    7452           0 :       S = gadd(S, mygmodulo_lift(Fl_mul(m2,d,N), N, q));
    7453             :     }
    7454           0 :     if ((m1 + nd) % N == 0)
    7455             :     {
    7456           0 :       GEN q = powuu(d,k-1);
    7457           0 :       if (odd(k)) q = negi(q);
    7458           0 :       S = gadd(S, mygmodulo_lift(Fl_mul(mm2,d,N), N, q));
    7459             :     }
    7460             :   }
    7461           0 :   return gerepileupto(ltop, mygmodulo_mod(S, N));
    7462             : }
    7463             : 
    7464             : static GEN /* order(CHI) | ord != 0 */
    7465        1043 : charLFwt1_o(GEN CHI, long ord)
    7466             : {
    7467             :   pari_sp av;
    7468             :   GEN S;
    7469        1043 :   long r, m = mfcharmodulus(CHI);
    7470             : 
    7471        1043 :   if (m == 1) return gen_m1;
    7472        1043 :   av = avma; S = gen_0;
    7473       99694 :   for (r = 1; r < m; ++r)
    7474             :   { /* S += r*chi(r) */
    7475             :     long a;
    7476       98651 :     if (cgcd(m,r) != 1) continue;
    7477       64218 :     a = mfcharevalord(CHI,r,ord);
    7478       64218 :     S = gadd(S, mygmodulo_lift(a, ord, utoi(r)));
    7479             :   }
    7480        1043 :   S = gdivgs(S, -m);
    7481        1043 :   return gerepileupto(av, mygmodulo_mod(S, ord));
    7482             : }
    7483             : static GEN /* order(CHI) | ord != 0 */
    7484         238 : charLFwtk_o(long k, GEN CHI, long ord)
    7485             : {
    7486             :   pari_sp av;
    7487             :   GEN S, P;
    7488             :   long r, m;
    7489             : 
    7490         238 :   if (k == 1) return charLFwt1_o(CHI, ord);
    7491         238 :   m = mfcharmodulus(CHI);
    7492         238 :   if (m == 1) return gdivgs(bernfrac(k),-k);
    7493          77 :   av = avma; S = gen_0;
    7494          77 :   P = RgX_rescale(bernpol(k,0), utoi(m));
    7495         420 :   for (r = 1; r < m; ++r)
    7496             :   { /* S += B_k(r/m)*chi(r) */
    7497             :     long a;
    7498         343 :     if (ugcd(r,m) != 1) continue;
    7499         280 :     a = mfcharevalord(CHI,r,ord);
    7500         280 :     S = gadd(S, mygmodulo_lift(a, ord, poleval(P, utoi(r))));
    7501             :   }
    7502          77 :   S = gdivgs(S, -k*m);
    7503          77 :   return gerepileupto(av, mygmodulo_mod(S, ord));
    7504             : }
    7505             : 
    7506             : /* L(\chi,k-1) */
    7507             : GEN
    7508          63 : charLFwtk(long k, GEN CHI) { return charLFwtk_o(k, CHI, mfcharorder(CHI)); }
    7509             : 
    7510             : static GEN
    7511          63 : mfeisen_1_0(long k, GEN CHI)
    7512          63 : { GEN E0 = gmul2n(charLFwtk(k, CHI), -1); return mkvec2(E0, CHI); }
    7513             : static GEN /* ord != 0 */
    7514        2177 : mfeisen_2_0(long k, GEN CHI1, GEN CHI2, long *ord)
    7515             : {
    7516             :   GEN E0;
    7517        2177 :   *ord = clcm(mfcharorder(CHI1), mfcharorder(CHI2));
    7518        2177 :   if (k == 1 && mfcharistrivial(CHI1))
    7519        1043 :     E0 = gmul2n(charLFwt1_o(CHI2, *ord), -1);
    7520        1134 :   else if (mfcharistrivial(CHI2))
    7521         175 :     E0 = gmul2n(charLFwtk_o(k, CHI1, *ord), -1);
    7522             :   else
    7523         959 :     E0 = gen_0;
    7524        2177 :   return mkvec4(E0,CHI1,CHI2,cgetg(1,t_VEC));
    7525             : }
    7526             : static GEN
    7527        2177 : NK_eisen2(long k, GEN CHI1, GEN CHI2)
    7528             : {
    7529        2177 :   long N = mfcharmodulus(CHI1)*mfcharmodulus(CHI2);
    7530        2177 :   return mkNK(N, k, mfcharmul(CHI1,CHI2));
    7531             : }
    7532             : static GEN
    7533          98 : mfeisen_i(long k, GEN CHI1, GEN CHI2)
    7534             : {
    7535          98 :   long s = 1, ord;
    7536             :   GEN NK, vchi, CHI;
    7537          98 :   if (CHI2) { CHI2 = get_mfchar(CHI2); if (mfcharparity(CHI2) < 0) s = -s; }
    7538          98 :   if (CHI1) { CHI1 = get_mfchar(CHI1); if (mfcharparity(CHI1) < 0) s = -s; }
    7539          98 :   if (s != m1pk(k)) return mftrivial();
    7540          84 :   if (!CHI1)
    7541          49 :     CHI = CHI2? CHI2: mfchartrivial(1);
    7542          35 :   else if (!CHI2)
    7543          14 :     CHI = CHI1;
    7544             :   else
    7545          21 :     CHI = NULL;
    7546             :   /* E_k(chi) */
    7547          84 :   if (CHI)
    7548             :   {
    7549          63 :     NK = mkNK(mfcharmodulus(CHI), k, CHI);
    7550          63 :     return tag2(t_MF_EISEN, NK, mkvecsmall(k), mfeisen_1_0(k,CHI));
    7551             :   }
    7552             :   /* E_k(chi1,chi2) */
    7553          21 :   NK = NK_eisen2(k, CHI1, CHI2);
    7554          21 :   vchi = mfeisen_2_0(k, CHI1, CHI2, &ord);
    7555          21 :   return tag2(t_MF_EISEN, NK, mkvecsmall3(k,ord,0), vchi);
    7556             : }
    7557             : GEN
    7558          98 : mfeisen(long k, GEN CHI1, GEN CHI2)
    7559             : {
    7560          98 :   pari_sp av = avma;
    7561          98 :   if (k < 1) pari_err_DOMAIN("mfeisen", "k", "<", gen_1, stoi(k));
    7562          98 :   return gerepilecopy(av, mfeisen_i(k, CHI1, CHI2));
    7563             : }
    7564             : 
    7565             : static GEN
    7566        2156 : mfeisen2closvec(long k, GEN CHI1, GEN CHI2, long ordchi)
    7567             : {
    7568             :   long ord, j, d;
    7569        2156 :   GEN NK, E, vchi = mfeisen_2_0(k, CHI1, CHI2, &ord);
    7570        2156 :   GEN T = Qab_trace_init(ord_canon(ord), ord_canon(ordchi));
    7571        2156 :   NK = NK_eisen2(k, CHI1, CHI2);
    7572        2156 :   gel(vchi,4) = T;
    7573        2156 :   d = (lg(T)==4)? itou(gmael(T,3,1)): 1;
    7574        2156 :   E = cgetg(d+1, t_VEC);
    7575        4319 :   for (j = 1; j <= d; j++)
    7576        2163 :     gel(E,j) = tag2(t_MF_EISEN, NK, mkvecsmall3(k,ord,j-1), vchi);
    7577        2156 :   return E;
    7578             : }
    7579             : 
    7580             : /* Basic theorems:
    7581             :    (k>=3): In weight k >= 3, basis of Eisenstein series for
    7582             :    M_k(G_0(N),CHI) is B(d)E(CHI1,(CHI/CHI1)_prim) (mfeisen2 above), where
    7583             :    CHI1 is primitive modulo N1, and if N2 is the conductor of CHI/CHI1
    7584             :    then d*N1*N2|N.
    7585             :    (k=2): In weight k=2, same if CHI is nontrivial. If CHI is trivial, must
    7586             :    not take CHI1 trivial, and must add E_2(tau)-dE_2(d tau)), where
    7587             :    d|N, d > 1.
    7588             :    (k=1): In weight k=1, same as k >= 3 except that we must restrict to
    7589             :    CHI1 even character. */
    7590             : 
    7591             : /* Given f1 and f2 find lower bound for conductor of product of characters
    7592             :  * of conductors fi. P is a list of primes containing all prime divisors
    7593             :  * of f1 and f2 */
    7594             : static long
    7595        4872 : boundcondprod(GEN P, ulong f1, ulong f2)
    7596             : {
    7597        4872 :   long i, l = lg(P);
    7598        4872 :   ulong res = 1;
    7599        8022 :   for (i = 1; i < l; i++)
    7600             :   {
    7601        8022 :     ulong p = P[i], e1 = u_lvalrem(f1, p, &f1), e2 = u_lvalrem(f2, p, &f2);
    7602        8022 :     if (e1 != e2) res *= upowuu(p, maxuu(e1,e2));
    7603        8022 :     if (f1 == 1) return res * f2;
    7604        5530 :     if (f2 == 1) return res * f1;
    7605             :   }
    7606           0 :   return res;
    7607             : }
    7608             : 
    7609             : /* CHI primitive, f(CHI) | N
    7610             :  * FIXME: implement a local algorithm N = \prod_p p^e_p,
    7611             :  * chi = \prod chi_p; find chi1_p chi2_p = chi_p */
    7612             : static GEN
    7613        1260 : mfeisenbasis_pre(long N, long k, GEN CHI)
    7614             : {
    7615        1260 :   pari_sp av = avma;
    7616        1260 :   GEN D = mydivisorsu(N), RES = cgetg(N+1, t_VEC);
    7617        1260 :   GEN G = gel(CHI,1), L = gel(CHI,2), CHI0, GN, LN, Lchi, LG, P;
    7618        1260 :   long i, j, l = lg(D), ord = mfcharorder(CHI), f = mfcharmodulus(CHI);
    7619             : 
    7620        1260 :   CHI0 = (f == 1)? CHI: mfchartrivial(1);
    7621        1260 :   Lchi = cgetg(N + 1, t_VECSMALL);
    7622        1260 :   LG = const_vec(N, NULL); /* LG[D] = znstar(D,1) or NULL */
    7623        1260 :   P = gel(myfactoru(N), 1);
    7624        1260 :   gel(LG,1) = gel(CHI0,1);
    7625        1260 :   if (f == N)
    7626             :   {
    7627         651 :     GN = G;
    7628         651 :     LN = L;
    7629             :   }
    7630             :   else
    7631             :   {
    7632         609 :     GN = znstar0(utoi(N),1);
    7633         609 :     LN = zncharinduce(G, L, GN);
    7634         609 :     gel(LG,f) = G;
    7635             :   }
    7636        1260 :   gel(LG,N) = GN;
    7637        1260 :   j = 1;
    7638             :   /* N1 = 1 */
    7639        1260 :   if (f != 1 || k != 2)
    7640             :   {
    7641        1211 :     gel(RES, j++) = mkvec2(CHI0, CHI);
    7642        1211 :     if (f != 1 && k != 1) gel(RES, j++) = mkvec2(CHI, CHI0);
    7643             :   }
    7644        7280 :   for (i = 2; i < l-1; ++i) /* skip N1 = 1 and N */
    7645             :   {
    7646        6020 :     long N1 = D[i], D1 = D[l-i], n;
    7647             :     GEN G1;
    7648        6020 :     if (ugcd(D1, f) == 1)
    7649             :     { /* (N/N1,f)=1 => (N2,f)=1 => conductor(chi1 = chi/chi2) = N1 = f*N2 */
    7650             :       /* N.B. N2 = 1 is done already */
    7651        1148 :       if (N1 == f || N1 % f || (D1 % (N1/f))) continue;
    7652             :     }
    7653             :     else
    7654        4872 :       if (D1 % boundcondprod(P, f, N1)) continue;
    7655        2366 :     if (!gel(LG,N1)) gel(LG,N1) = znstar0(utoi(N1), 1);
    7656        2366 :     G1 = gel(LG,N1);
    7657       48307 :     for (n = 1; n < N1; n++) /* reset Lchi */
    7658       45941 :        Lchi[n] = cgcd(n, N1) == 1? 1: 0;
    7659       45941 :     for (n = 2; n < N1; n++) /* remove 1: trivial char */
    7660             :     {
    7661             :       GEN L1;
    7662       43575 :       if (!Lchi[n]) continue;
    7663             :       /* n coprime to N1 */
    7664       27314 :       L1 = znconreylog(G1, utoipos(n));
    7665       27314 :       if (k == 1 && zncharisodd(G1,L1)) continue;
    7666       12789 :       if (zncharisprimitive(G1, L1))
    7667             :       { /* need f(CHI / CHI1) | N/N1, f(CHI1) = N1 */
    7668        8127 :         GEN gN2, CHI1, CHI2, L2 = znchardiv(GN, LN, zncharinduce(G1,L1,GN));
    7669             :         long t, ochi12, N2;
    7670             : 
    7671        8127 :         gN2 = znconreyconductor(GN, L2, &L2);
    7672             :         /* if L2 is primitive, then N2 = N => N1 = 1; done already */
    7673       15372 :         if (typ(gN2) == t_INT) continue;
    7674        2359 :         N2 = itou(gel(gN2,1));
    7675        2359 :         if (N2 == 1 || D1 % N2) continue; /* N2 = 1; done already */
    7676         882 :         if (!gel(LG,N2)) gel(LG,N2) = znstar0(gN2, 1);
    7677         882 :         CHI1 = mfcharGL(G1, L1);
    7678         882 :         CHI2 = mfcharGL(gel(LG,N2), L2);
    7679         882 :         gel(RES, j++) = mkvec2(CHI1, CHI2);
    7680         882 :         ochi12 = clcm(mfcharorder(CHI1), mfcharorder(CHI2));
    7681         882 :         Lchi[n] = 0;
    7682         952 :         for (t = 1 + ord; t <= ochi12; t += ord)
    7683          70 :           if (ugcd(t, ochi12) == 1)
    7684             :           {
    7685           7 :             long ind = Fl_powu(n, t, N1);
    7686           7 :             if (!ind) ind = N1;
    7687           7 :              Lchi[ind] = 0;
    7688             :           }
    7689             :       }
    7690             :     }
    7691             :   }
    7692        1260 :   setlg(RES, j);
    7693        1260 :   return gerepilecopy(av, RES);
    7694             : }
    7695             : 
    7696             : /* C-basis of E_k(Gamma_0(N),chi). If k = 1, the first basis element must not
    7697             :  * vanish at oo [used in mfwt1basis]. Here E_1(CHI), whose q^0 coefficient
    7698             :  * does not vanish (since L(CHI,0) does not) *if* CHI is not trivial; which
    7699             :  * must be the case in weight 1. */
    7700             : GEN
    7701        1295 : mfeisenbasis_i(long N, long k, GEN CHI)
    7702             : {
    7703        1295 :   GEN RES, LI, P = NULL;
    7704             :   long i, j, f, l, lLI, ordchi;
    7705             : 
    7706        1295 :   if (!ischarok(N, k, CHI)) return cgetg(1, t_VEC);
    7707        1358 :   if (k == 0) return mfcharistrivial(CHI)? mkvec(mfcreate(gen_1))
    7708          63 :                                          : cgetg(1, t_VEC);
    7709        1260 :   if (!CHI) CHI = mfchartrivial(1);
    7710        1260 :   CHI = mfchartoprimitive(CHI, &f);
    7711        1260 :   ordchi = mfcharorder(CHI);
    7712        1260 :   LI = mfeisenbasis_pre(N, k, CHI);
    7713        1260 :   l = lLI = lg(LI);
    7714        1260 :   if (f == 1 && k == 2)
    7715             :   {
    7716          49 :     P = mydivisorsu(N);
    7717          49 :     l += lg(P) - 2;
    7718             :   }
    7719        1260 :   RES = cgetg(l, t_VEC);
    7720        3416 :   for (j = 1; j < lLI; j++)
    7721             :   {
    7722        2156 :     GEN CHI1 = gmael(LI, j, 1), CHI2 = gmael(LI, j, 2);
    7723        2156 :     long N0 = mfcharmodulus(CHI1) * mfcharmodulus(CHI2);
    7724        2156 :     GEN E = mfeisen2closvec(k, CHI1, CHI2, ordchi);
    7725        2156 :     gel(RES, j) = mfbdall(E, N/N0);
    7726             :   }
    7727        1260 :   if (P)
    7728             :   {
    7729          49 :     GEN E2 = mfeisen(k, NULL, NULL);
    7730          49 :     l = lg(P);
    7731         301 :     for (i = 2; i < l; i++, j++)
    7732             :     {
    7733         252 :       long d = P[i];
    7734         252 :       GEN E2d = mfbd_i(E2, d);
    7735         252 :       GEN Ed = mflinear_i(mkvec2(E2, E2d), mkvec2(gen_1, utoineg(d)));
    7736         252 :       gel(RES, j) = mkvec(Ed);
    7737             :     }
    7738             :   }
    7739        1260 :   return lg(RES) == 1 ? RES : shallowconcat1(RES);
    7740             : }
    7741             : 
    7742             : /* check parameters rigorously, but not coefficients */
    7743             : static long
    7744          28 : mfisinspace_i(GEN mf, GEN F)
    7745             : {
    7746             :   GEN CHI1, CHI2;
    7747          28 :   long Nmf, N, k, space = mf_get_space(mf);
    7748             : 
    7749          28 :   N = f_N(F);
    7750          28 :   Nmf = mf_get_N(mf);
    7751          28 :   if (space == mf_NEW)
    7752          21 :   { if (N != Nmf) return 0; }
    7753             :   else
    7754           7 :   { if (Nmf % N) return 0; }
    7755          14 :   k = f_k(F);
    7756          14 :   if (mf_get_k(mf) != k) return 0;
    7757          14 :   if (isintzero(f_CHI(F))) pari_err_IMPL("mfisinspace for this F");
    7758          14 :   CHI1 = mf_get_CHI(mf); CHI1 = mfchar2char(CHI1);
    7759          14 :   CHI1 = znchartoprimitive(gel(CHI1,1), gel(CHI1,2));
    7760          14 :   CHI2 = mfchar2char(f_CHI(F));
    7761          14 :   CHI2 = znchartoprimitive(gel(CHI2,1), gel(CHI2,2));
    7762          14 :   return gequal(CHI1,CHI2);
    7763             : }
    7764             : static void
    7765           7 : err_space(GEN F)
    7766             : {
    7767           7 :   pari_err_DOMAIN("mftobasis", "form", "does not belong to",
    7768             :                   strtoGENstr("space"), F);
    7769           0 : }
    7770             : /* when flag set, do not return error message */
    7771             : GEN
    7772          91 : mftobasis(GEN mf, GEN F, long flag)
    7773             : {
    7774          91 :   pari_sp av2, av = avma;
    7775             :   GEN G, v, y;
    7776             :   long B;
    7777             : 
    7778          91 :   checkmf(mf);
    7779          91 :   if (isf(F) && !mfisinspace_i(mf, F))
    7780             :   {
    7781          14 :     if (flag) return cgetg(1, t_COL);
    7782           7 :     err_space(F);
    7783             :   }
    7784             :   /* at least the parameters are right */
    7785          77 :   B = mfsturmNk(mf_get_N(mf), mf_get_k(mf)) + 1;
    7786          77 :   if (isf(F)) v = mfcoefs_i(F,B,1);
    7787             :   else
    7788             :   {
    7789          63 :     switch(typ(F))
    7790             :     { /* F(0),...,F(lg(v)-2) */
    7791          56 :       case t_SER: v = sertocol(F); settyp(v,t_VEC); break;
    7792           7 :       case t_VEC: v = F; break;
    7793           0 :       case t_COL: v = shallowtrans(F); break;
    7794           0 :       default: pari_err_TYPE("mftobasis",F);
    7795             :                v = NULL;/*LCOV_EXCL_LINE*/
    7796             :     }
    7797          63 :     if (flag) B = minss(B, lg(v)-2);
    7798             :   }
    7799          77 :   y = mftobasis_i(mf, v);
    7800          77 :   if (typ(y) == t_VEC)
    7801             :   {
    7802          21 :     if (flag) return gerepilecopy(av, y);
    7803           0 :     pari_err(e_MISC, "not enough coefficients in mftobasis");
    7804             :   }
    7805          56 :   av2 = avma;
    7806          56 :   if (mf_get_space(mf) == mf_FULL || mfsturm(mf)+1 == B) return y;
    7807          14 :   G = mflinear_i(mf_get_basis(mf), y);
    7808          14 :   if (!gequal(v, mfcoefs_i(G, lg(v)-2,1))) y = NULL;
    7809          14 :   avma = av2;
    7810          14 :   if (!y)
    7811             :   {
    7812           0 :     if (flag) { avma = av; return cgetg(1, t_COL); }
    7813           0 :     err_space(F);
    7814             :   }
    7815          14 :   return gerepileupto(av, y);
    7816             : }
    7817             : 
    7818             : /* List of cusps of Gamma_0(N) */
    7819             : GEN
    7820           7 : mfcusps(long N)
    7821             : {
    7822           7 :   pari_sp av = avma;
    7823             :   GEN D, v;
    7824             :   long i, c, l;
    7825             : 
    7826           7 :   if (N <= 0) pari_err_DOMAIN("mfcusps", "N", "<=", gen_0, stoi(N));
    7827           7 :   if (N == 1) return mkvec(gen_0);
    7828           7 :   D = mydivisorsu(N); l = lg(D);
    7829           7 :   c = mfnumcuspsu_fact(myfactoru(N));
    7830           7 :   v = cgetg(c + 1, t_VEC);
    7831          91 :   for (i = c = 1; i < l; i++)
    7832             :   {
    7833          84 :     long C = D[i], NC = D[l-i], lima = ugcd(C, NC), A0, A;
    7834         280 :     for (A0 = 0; A0 < lima; A0++)
    7835         196 :       if (cgcd(A0, lima) == 1)
    7836             :       {
    7837         112 :         A = A0; while (ugcd(A,C) > 1) A += lima;
    7838         112 :         gel(v, c++) = gdivgs(utoi(A), C);
    7839             :       }
    7840             :   }
    7841           7 :   return gerepileupto(av, v);
    7842             : }
    7843             : 
    7844             : static void
    7845           0 : cusp_canon(GEN cusp, long N, long *pA, long *pC)
    7846             : {
    7847           0 :   pari_sp av = avma;
    7848             :   long A, C, tc;
    7849           0 :   if (!cusp || (tc = typ(cusp)) == t_INFINITY) { *pA = 1; *pC = N; return; }
    7850           0 :   if (tc != t_INT && tc != t_FRAC ) pari_err_TYPE("checkcusp", cusp);
    7851           0 :   C = itos(Q_denom(cusp));
    7852           0 :   A = itos(gmulgs(cusp, C));
    7853           0 :   if (N % C)
    7854             :   {
    7855             :     ulong uC;
    7856           0 :     long u = Fl_invgen((C-1)%N + 1, N, &uC);
    7857           0 :     A = Fl_mul(A, u, N);
    7858           0 :     C = (long)uC;
    7859             :   }
    7860           0 :   *pA = A; *pC = C; avma = av;
    7861             : }
    7862             : long
    7863           0 : mfcuspwidth(long N, GEN cusp)
    7864             : {
    7865             :   long A, C;
    7866           0 :   cusp_canon(cusp, N, &A, &C);
    7867           0 :   if (C == N) return 1;
    7868           0 :   return N/cgcd(N, C*C);
    7869             : }
    7870             : 
    7871             : /* Some useful closures */
    7872             : 
    7873             : /* sum_{d|n} d^k */
    7874             : static GEN
    7875        4515 : mysumdivku(ulong n, ulong k) { return usumdivk_fact(myfactoru(n),k); }
    7876             : static GEN
    7877         371 : c_Ek(long n, long d, long k, GEN C)
    7878             : {
    7879         371 :   GEN E = cgetg(n + 2, t_VEC);
    7880             :   long i;
    7881         371 :   gel (E, 1) = gen_1;
    7882        4886 :   for (i = 1; i <= n; i++)
    7883             :   {
    7884        4515 :     pari_sp av = avma;
    7885        4515 :     gel(E, i+1) = gerepileupto(av, gmul(C, mysumdivku(i*d, k-1)));
    7886             :   }
    7887         371 :   return E;
    7888             : }
    7889             : 
    7890             : GEN
    7891          77 : mfEk(long k)
    7892             : {
    7893          77 :   pari_sp av = avma;
    7894             :   GEN E0, NK;
    7895          77 :   if (k <= 0 || (k & 1L)) pari_err_TYPE("mfEk [incorrect k]", stoi(k));
    7896          77 :   E0 = gdivsg(-2*k, bernfrac(k));
    7897          77 :   NK = mkNK(1,k,mfchartrivial(1));
    7898          77 :   return gerepilecopy(av, tag2(t_MF_Ek, NK, mkvecsmall(k), E0));
    7899             : }
    7900             : 
    7901             : GEN
    7902          28 : mfDelta(void)
    7903             : {
    7904          28 :   pari_sp av = avma;
    7905          28 :   return gerepilecopy(av, tag0(t_MF_DELTA,mkNK(1,12,mfchartrivial(1))));
    7906             : }
    7907             : 
    7908             : /* FIXME: unify with lfunetaquotype */
    7909             : static GEN
    7910          14 : NK_eta(GEN M, GEN R)
    7911             : {
    7912          14 :   long N, k, i, lD, lM = lg(M);
    7913             :   GEN gN, S, P, D;
    7914          14 :   N = 1; for(i = 1; i < lM; i++) N = clcm(N, M[i]);
    7915          14 :   D = divisorsu(N); lD = lg(D);
    7916          14 :   S = gen_0; P = gen_1; k = 0;
    7917          42 :   for (i = 1; i < lD; ++i)
    7918             :   {
    7919          28 :     long m = D[i], r = 0, j;
    7920          84 :     for (j = 1; j < lM; ++j)
    7921          56 :       if (m == M[j]) r += R[j];
    7922          28 :     S = gadd(S, gdivgs(utoi(r), 24*m));
    7923          28 :     if (odd(r)) P = mulis(P, m);
    7924          28 :     k += r;
    7925             :   }
    7926          14 :   k >>= 1;
    7927          14 :   gN = lcmii(stoi(N), Q_denom(S));
    7928          14 :   D = odd(k)? negi(P): P;
    7929          14 :   return mkvec3(gN, utoi(k), coredisc(D));
    7930             : }
    7931             : GEN
    7932          14 : mfetaquo(GEN eta)
    7933             : {
    7934          14 :   pari_sp av = avma;
    7935             :   GEN B, E;
    7936             :   long s, i;
    7937          14 :   if (typ(eta) != t_MAT || !RgM_is_ZM(eta)) pari_err_TYPE("mfetaquo", eta);
    7938          14 :   if (lg(eta) != 3 || lg(gel(eta,1)) == 1)
    7939           0 :     pari_err_TYPE("mfetaquo [not a factorization]", eta);
    7940          14 :   B = ZV_to_zv(gel(eta,1));
    7941          14 :   E = ZV_to_zv(gel(eta,2)); s = 0;
    7942          14 :   for (i = 1; i < lg(B); i++) s += B[i]*E[i];
    7943          14 :   s = maxss(0, s/24);
    7944          14 :   return gerepilecopy(av, tag2(t_MF_ETAQUO, NK_eta(B,E), mkvec2(B,E), stoi(s)));
    7945             : }
    7946             : 
    7947             : /* Tr_{Q(zeta_n)/Q} (zeta_n^j * x), j = 0 .. phi(n) */
    7948             : static GEN
    7949           0 : mytraceall(GEN x, GEN P)
    7950             : {
    7951           0 :   long j, degrel = degpol(P);
    7952           0 :   GEN res = cgetg(degrel + 1, t_VEC), X = pol_x(varn(P));
    7953             : 
    7954           0 :   x = liftpol_shallow(x);
    7955           0 :   for (j = 0; j < degrel; ++j)
    7956             :   {
    7957           0 :     GEN y = gmul(x, gmodulo(gpowgs(X, j), P));
    7958           0 :     gel(res, j + 1) = gtrace(y);
    7959             :   }
    7960           0 :   return res;
    7961             : }
    7962             : 
    7963             : static GEN
    7964           0 : mfeisenbasis(long N, long k, GEN CHI, long lim)
    7965           0 : { return mfvectomat(mfeisenbasis_i(N, k, CHI), lim); }
    7966             : 
    7967             : static void
    7968           0 : update_Mj(GEN *M, GEN *vecj)
    7969             : {
    7970           0 :   GEN z = ZM_indexrank(*M), perm = gel(z, 2);
    7971           0 :   *M = vecpermute(*M, perm);
    7972           0 :   *vecj = vecpermute(*vecj, perm);
    7973           0 : }
    7974             : /* Space generated by products of two Eisenstein series */
    7975             : GEN
    7976           0 : mfeisenspaceinit(GEN NK)
    7977             : {
    7978           0 :   pari_sp ltop = avma;
    7979             :   GEN G, M, CHI, lisC, vecj;
    7980             :   long lim, i, k2, j, N, k, dim, ct, llC;
    7981             : 
    7982           0 :   checkNK(NK, &N, &k, &CHI, 0);
    7983           0 :   k2 = k/2;
    7984           0 :   if (!CHI) CHI = mfchartrivial(1);
    7985           0 :   dim = mffulldim(N, k, CHI);
    7986           0 :   lim = mfsturmNk(N, k) + 1;
    7987           0 :   M = mfeisenbasis(N, k, CHI, lim);
    7988           0 :   ct = lg(M) - 1;
    7989           0 :   vecj = cgetg(ct+1, t_VEC);
    7990           0 :   for (i = 1; i <= ct; ++i)
    7991             :   {
    7992           0 :     gel(vecj,i) = mkvecsmall5(0,k,0,0,i);
    7993           0 :     gel(M,i) = Q_primpart(gel(M,i));
    7994             :   }
    7995           0 :   G = gel(CHI,1);
    7996           0 :   lisC = chargalois(G, NULL); llC = lg(lisC);
    7997           0 :   if (mfcharorder(CHI) > 1)
    7998           0 :     pari_err_IMPL("nontrivial CHI not yet implemented in mfeisenspace");
    7999           0 :   for (j = 1; j < llC; ++j)
    8000             :   {
    8001           0 :     GEN CHI1 = mfcharGL(G, znconreyfromchar(G, gel(lisC, j)));
    8002           0 :     GEN P = polcyclo(ord_canon(mfcharorder(CHI1)), fetch_user_var("t"));
    8003           0 :     GEN CHI2 = mfchardiv_i(CHI, CHI1);
    8004           0 :     long l, linit = (mfcharparity(CHI1) == -1)? 1: 2;
    8005           0 :     for (l = linit; l <= k2; l += 2)
    8006             :     {
    8007           0 :       GEN B2, B1 = RgM_to_RgXV(mfeisenbasis(N, l, CHI1, lim), 0);
    8008             :       long j1;
    8009           0 :       if (l == k - l && gequal(CHI2, CHI1))
    8010           0 :         B2 = B1;
    8011             :       else
    8012           0 :         B2 = RgM_to_RgXV(mfeisenbasis(N, k-l, CHI2, lim), 0);
    8013           0 :       for (j1 = 1; j1 < lg(B1); j1++)
    8014             :       {
    8015             :         long j2;
    8016           0 :         for (j2 = (B1 == B2)? j1 : 1; j2 < lg(B2); j2++)
    8017             :         {
    8018           0 :           GEN tmp = RgX_to_RgC(RgXn_mul(gel(B1,j1), gel(B2,j2), lim+1), lim+1);
    8019             :           long j3;
    8020           0 :           tmp = mytraceall(tmp, P);
    8021           0 :           for (j3 = 1; j3 < lg(tmp); j3++)
    8022             :           {
    8023           0 :             M = shallowconcat(M, Q_primpart(gel(tmp,j3)));
    8024           0 :             vecj = shallowconcat(vecj, mkvec(mkvecsmall5(j,l,j1,j2,j3)));
    8025           0 :             if (++ct >= dim)
    8026             :             {
    8027           0 :               update_Mj(&M, &vecj); ct = lg(vecj) - 1;
    8028           0 :               if (ct == dim) return gerepilecopy(ltop, mkvec2(M, vecj));
    8029             :             }
    8030             :           }
    8031             :         }
    8032             :       }
    8033             :     }
    8034             :   }
    8035           0 :   update_Mj(&M, &vecj);
    8036           0 :   return gerepilecopy(ltop, mkvec2(M, vecj));
    8037             : }
    8038             : 
    8039             : static GEN
    8040          35 : sertocol2(GEN S, long l)
    8041             : {
    8042          35 :   GEN C = cgetg(l + 2, t_COL);
    8043             :   long i;
    8044          35 :   for (i = 0; i <= l; ++i) gel(C, i+1) = polcoeff0(S, i, -1);
    8045          35 :   return C;
    8046             : }
    8047             : 
    8048             : /* Compute polynomial P0 such that F=E4^(k/4)P0(E6/E4^(3/2)). */
    8049             : static GEN
    8050           7 : mfcanfindp0(GEN F, long k)
    8051             : {
    8052           7 :   pari_sp ltop = avma;
    8053             :   GEN E4, E6, V, V1, Q, W, res, M, B;
    8054             :   long l, j;
    8055           7 :   l = k/6 + 2;
    8056           7 :   V = mfcoefsser(F,l,1);
    8057           7 :   E4 = mfcoefsser(mfEk(4),l,1);
    8058           7 :   E6 = mfcoefsser(mfEk(6),l,1);
    8059           7 :   V1 = gdiv(V, gpow(E4, gdivgs(utoi(k), 4), 0));
    8060           7 :   Q = gdiv(E6, gpow(E4, gdivsg(3, gen_2), 0));
    8061           7 :   W = gpowers(Q, l - 1);
    8062           7 :   M = cgetg(l + 1, t_MAT);
    8063           7 :   for (j = 1; j <= l; ++j) gel(M, j) = sertocol2(gel(W, j), l);
    8064           7 :   B = sertocol2(V1, l);
    8065           7 :   res = inverseimage(M, B);
    8066           7 :   if (lg(res) == 1) err_space(F);
    8067           7 :   return gerepilecopy(ltop, gtopolyrev(res, 0));
    8068             : }
    8069             : 
    8070             : /* Compute the first n+1 Taylor coeffs at tau=I of a modular form
    8071             :  * on SL_2(Z). */
    8072             : GEN
    8073           7 : mftaylor(GEN F, long n, long flreal, long prec)
    8074             : {
    8075           7 :   pari_sp ltop = avma;
    8076           7 :   GEN P0, Pm1 = gen_0, v;
    8077           7 :   GEN X2 = mkpoln(3, ghalf,gen_0,gneg(ghalf)); /* (x^2-1) / 2 */
    8078             :   long k, m;
    8079           7 :   if (!isf(F)) pari_err_TYPE("mftaylor",F);
    8080           7 :   k = f_k(F);
    8081           7 :   if (f_N(F) != 1 || k < 0) pari_err_IMPL("mftaylor for this form");
    8082           7 :   P0 = mfcanfindp0(F, k);
    8083           7 :   v = cgetg(n+2, t_VEC); gel(v, 1) = RgX_coeff(P0,0);
    8084          77 :   for (m = 0; m < n; m++)
    8085             :   {
    8086          70 :     GEN P1 = gdivgs(gmulsg(-(k + 2*m), RgX_shift(P0,1)), 12);
    8087          70 :     P1 = gadd(P1, gmul(X2, RgX_deriv(P0)));
    8088          70 :     if (m) P1 = gsub(P1, gdivgs(gmulsg(m*(m+k-1), Pm1), 144));
    8089          70 :     Pm1 = P0; P0 = P1;
    8090          70 :     gel(v, m+2) = RgX_coeff(P0, 0);
    8091             :   }
    8092           7 :   if (flreal)
    8093             :   {
    8094           0 :     GEN pi2 = Pi2n(1, prec), pim4 = gmulsg(-2, pi2), VPC;
    8095           0 :     GEN C = gmulsg(3, gdiv(gpowgs(ggamma(ginv(utoi(4)), prec), 8), gpowgs(pi2, 6)));
    8096             :     /* E_4(i): */
    8097           0 :     GEN facn = gen_1;
    8098           0 :     VPC = gpowers(gmul(pim4, gsqrt(C, prec)), n);
    8099           0 :     C = gpow(C, gdivgs(utoi(k), 4), prec);
    8100           0 :     for (m = 0; m <= n; m++)
    8101             :     {
    8102           0 :       gel(v, m+1) = gdiv(gmul(C, gmul(gel(v, m+1), gel(VPC, m+1))), facn);
    8103           0 :       facn = gmulgs(facn, m+1);
    8104             :     }
    8105             :   }
    8106           7 :   return gerepilecopy(ltop, v);
    8107             : }
    8108             : 
    8109             : #if 0
    8110             : /* To be used in mfsearch() */
    8111             : GEN
    8112             : mfreadratfile()
    8113             : {
    8114             :   GEN eqn;
    8115             :   pariFILE *F = pari_fopengz("rateigen300.gp");
    8116             :   eqn = gp_readvec_stream(F->file);
    8117             :   pari_fclose(F);
    8118             :   return eqn;
    8119             : }
    8120             : #endif
    8121             : 
    8122             : /********************************************************************/
    8123             : /*                     EISENSTEIN AT CUSPS                          */
    8124             : /********************************************************************/
    8125             : 
    8126             : /* Eisenstein evaluation, for now in weight not 2.
    8127             :    First part, as complex numbers. */
    8128             : GEN
    8129           0 : mfcharcxeval(GEN CHI, long m, long prec)
    8130             : {
    8131           0 :   long N = mfcharmodulus(CHI);
    8132             :   GEN o;
    8133           0 :   if (cgcd(m, N) > 1) return gen_0;
    8134           0 :   o = gmfcharorder(CHI);
    8135           0 :   return chareval(gel(CHI,1), gel(CHI,2), utoi(m),
    8136             :                   mkvec2(rootsof1_cx(o,prec), o));
    8137             : }
    8138             : 
    8139             : long
    8140           0 : mfcuspisregular(GEN NK, GEN cusp)
    8141             : {
    8142             :   GEN CHI;
    8143             :   long A, C, N, k;
    8144           0 :   if (checkmf_i(NK))
    8145           0 :   { N = mf_get_N(NK); k = mf_get_k(NK); CHI = mf_get_CHI(NK); }
    8146           0 :   else { checkNK(NK, &N, &k, &CHI, 0); if (!CHI) return 1; }
    8147           0 :   if(typ(cusp) == t_INFINITY) return 1;
    8148           0 :   C = itos(denom(cusp));
    8149           0 :   A = itos(numer(cusp));
    8150           0 :   return gequal1(mfchareval(CHI, 1 + A*N/cgcd(C, N/C)));
    8151             : }
    8152             : 
    8153             : static GEN
    8154           0 : char2vecexpo(GEN CHI)
    8155             : {
    8156           0 :   long i, N = mfcharmodulus(CHI);
    8157           0 :   GEN ord = gmfcharorder(CHI);
    8158           0 :   GEN T = cgetg(N+1, t_VECSMALL);
    8159           0 :   for (i = 0; i < N; i++) T[i+1] = znchareval_i(CHI, i, ord);
    8160           0 :   return T;
    8161             : }
    8162             : /* v non empty t_VECSMALL */
    8163             : static GEN
    8164           0 : vecsmall_to_fact(GEN v)
    8165             : {
    8166           0 :   long i, j, k, c, l = lg(v);
    8167           0 :   GEN P = cgetg(l, t_COL), E = cgetg(l, t_COL);
    8168           0 :   c = v[1]; j = 1;
    8169           0 :   for (k = 1, i = 2; i < l; i++, k++)
    8170             :   {
    8171           0 :     if (v[i] != c)
    8172             :     {
    8173           0 :       gel(P, j) = utoi(c);
    8174           0 :       gel(E, j) = utoipos(k);
    8175           0 :       j++;
    8176           0 :       c = v[i];
    8177           0 :       k = 0;
    8178             :     }
    8179             :   }
    8180           0 :   if (k)
    8181             :   {
    8182           0 :     gel(P, j) = utoi(c);
    8183           0 :     gel(E, j) = utoipos(k);
    8184           0 :     j++;
    8185             :   }
    8186           0 :   if (j == 1) return NULL;
    8187           0 :   setlg(P, j);
    8188           0 :   setlg(E, j); return mkmat2(P,E);
    8189             : }
    8190             : 
    8191             : /* g=gcd(e,C), g1=gcd(N1*g,C), g2=gcd(N2*g,C); */
    8192             : /* known: $C\mid g*N1*N2$ and $C*g\mid g1*g2$. */
    8193             : /* datacusp=Vecsmall(N1*g/g1,N2*g/g2,C/g,C/g1,C/g2,(N1*g/g1)^{-1},(N2*g/g2)^{-1},-(A*e/g)^{-1}) */
    8194             : /* (inverses mod C/g1, C/g2, and C/g respectively) */
    8195             : static GEN
    8196           0 : doublecharsum_i(GEN T1, GEN T2, long ord1, long ord2, GEN datacusp, long a1, long a2)
    8197             : {
    8198           0 :   long N1 = lg(T1) - 1, N2 = lg(T2) - 1, s1, s2, iT;
    8199           0 :   long N1sg1 = datacusp[1], N2sg2 = datacusp[2], Csg = datacusp[3];
    8200           0 :   long Csg1 = datacusp[4], Csg2 = datacusp[5];
    8201           0 :   long N1i = datacusp[6], N2i = datacusp[7], Aei = datacusp[8];
    8202           0 :   long M = clcm(Csg, clcm(ord1, ord2));
    8203           0 :   long v1 = M/ord1, v2 = M/ord2, v3 = Aei*(M/Csg);
    8204           0 :   GEN T = cgetg((Csg/Csg1)*(Csg/Csg2) + 1, t_VECSMALL);
    8205           0 :   iT = 1;
    8206           0 :   for (s1 = Fl_mul(a1, N1i, Csg1); s1 < Csg; s1 += Csg1)
    8207             :   {
    8208           0 :     long w1 = (a1 - N1sg1*s1)/Csg1;
    8209           0 :     if (cgcd(w1, N1) != 1) continue;
    8210           0 :     w1 %= N1; if (w1 < 0) w1 += N1;
    8211           0 :     for (s2 = Fl_mul(a2, N2i, Csg2); s2 < Csg; s2 += Csg2)
    8212             :     {
    8213           0 :       long w2 = (a2 - N2sg2*s2)/Csg2, t;
    8214           0 :       if (cgcd(w2, N2) != 1) continue;
    8215           0 :       w2 %= N2; if (w2 < 0) w2 += N2;
    8216           0 :       t = T1[w1 + 1]*v1 + T2[w2 + 1]*v2 + s1*s2*v3;
    8217           0 :       t %= M; if (t < 0) t += M;
    8218           0 :       T[iT++] = t;
    8219             :     }
    8220             :   }
    8221           0 :   if (iT == 1) return NULL;
    8222           0 :   setlg(T, iT); vecsmall_sort(T);
    8223           0 :   return vecsmall_to_fact(T);
    8224             : }
    8225             : 
    8226             : /* cusp = mkvecsmall2(A, C) */
    8227             : GEN
    8228           0 : doublecharsum(GEN CHI1, GEN CHI2, GEN cusp, long e, long a1, long a2)
    8229             : {
    8230           0 :   pari_sp av = avma;
    8231             :   GEN T1, T2, datacusp, res;
    8232           0 :   long A = cusp[1], C = cusp[2], N1, N2, g, g1, g2, Ai, u1, u2, ord1, ord2, junk;
    8233           0 :   g = cbezout(-A*e,C, &Ai, &junk);
    8234           0 :   CHI1 = get_mfchar(CHI1); N1 = mfcharmodulus(CHI1);
    8235           0 :   CHI2 = get_mfchar(CHI2); N2 = mfcharmodulus(CHI2);
    8236           0 :   g1 = cbezout(N1*g, C, &u1, &junk);
    8237           0 :   if (cgcd(N1*g/g1, a1) != 1) return gen_0;
    8238           0 :   g2 = cbezout(N2*g, C, &u2, &junk);
    8239           0 :   if (cgcd(N2*g/g2, a2) != 1) return gen_0;
    8240           0 :   ord1 = mfcharorder(CHI1); T1 = char2vecexpo(CHI1);
    8241           0 :   ord2 = mfcharorder(CHI2); T2 = char2vecexpo(CHI2);
    8242           0 :   datacusp = mkvecsmalln(8,N1*g/g1,N2*g/g2,C/g,C/g1,C/g2,u1,u2,Ai);
    8243           0 :   res = doublecharsum_i(T1,T2,ord1,ord2,datacusp,a1,a2);
    8244           0 :   if (!res) { avma = av; return gen_0; }
    8245           0 :   else return gerepilecopy(av, res);
    8246             : }
    8247             : 
    8248             : static int
    8249           0 : cmpi(void *E, GEN a, GEN b)
    8250           0 : { (void)E; return cmpii(a, b); }
    8251             : 
    8252             : /* n > 0; true a(n) must be multiplied by \z_N^{A^{-1}(g1g2/C)n},
    8253             :  * n1 = n*g1*g2 */
    8254             : static GEN
    8255           0 : mfeisenchi1chi2coeff_i(GEN T1, GEN T2, long ord1, long ord2, GEN datacusp,
    8256             :                        long N1Csg, long N2Csg, long k, long n1)
    8257             : {
    8258             :   long i, l;
    8259           0 :   GEN D, S = mkmat2(cgetg(1, t_COL), cgetg(1, t_COL));
    8260           0 :   D = mydivisorsu(n1); l = lg(D);
    8261           0 :   for (i = 1; i < l; i++)
    8262             :   {
    8263           0 :     long m1 = D[i], a1 = D[l-i] % N1Csg, a2 = m1 % N2Csg;
    8264           0 :     GEN G, t = powuu(m1, k - 1);
    8265           0 :     G = doublecharsum_i(T1, T2, ord1, ord2, datacusp, a1, a2);
    8266           0 :     if (G)
    8267             :     {
    8268           0 :       G = mkmat2(gel(G, 1), ZC_Z_mul(gel(G, 2), t));
    8269           0 :       S = merge_factor(S, G, NULL, &cmpi);
    8270             :     }
    8271           0 :     a1 = Fl_neg(a1, N1Csg);
    8272           0 :     a2 = Fl_neg(a2, N2Csg);
    8273           0 :     G = doublecharsum_i(T1, T2, ord1, ord2, datacusp, a1, a2);
    8274           0 :     if (G)
    8275             :     {
    8276           0 :       G = mkmat2(gel(G, 1), ZC_Z_mul(gel(G, 2), (k & 1L) ? negi(t) : t));
    8277           0 :       S = merge_factor(S, G, NULL, &cmpi);
    8278             :     }
    8279             :   }
    8280           0 :   return S;
    8281             : }
    8282             : 
    8283             : static GEN
    8284           0 : mfeisenclean(GEN vres, long re)
    8285             : {
    8286             :   GEN wres;
    8287           0 :   long lv = lg(vres) - 2, n;
    8288           0 :   wres = cgetg(lv/re + 2, t_VEC);
    8289           0 :   gel(wres, 1) = gel(vres, 1);
    8290           0 :   for (n = 1; n <= lv; n++)
    8291             :   {
    8292           0 :     GEN tmp = gmael(vres, n+1, 1);
    8293           0 :     if (n%re && lg(tmp) > 1) pari_err_BUG("mfeisenchi1chi2cusp");
    8294           0 :     if (n%re == 0) gel(wres, n/re + 1) = gel(vres, n + 1);
    8295             :   }
    8296           0 :   return wres;
    8297             : }
    8298             : 
    8299             : /*****************************************************************/
    8300             : /*                          f(0)                                 */
    8301             : /*****************************************************************/
    8302             : 
    8303             : /* Computation of Q_k(\z_N^s) as a polynomial in \z_N^s. FIXME: explicit
    8304             :  * formula ? */
    8305             : GEN
    8306           0 : mfqk(long k, long N)
    8307             : {
    8308           0 :   GEN X = pol_x(0), P = gsubgs(gpowgs(X,N), 1), ZI, Q, Xm1, invden;
    8309             :   long i;
    8310           0 :   ZI = cgetg(N, t_VEC);
    8311           0 :   for (i = 1; i < N; i++) gel(ZI, i) = utoi(i);
    8312           0 :   ZI = gtopoly(ZI, 0);
    8313           0 :   if (k == 1) return ZI;
    8314           0 :   invden = RgXQ_powu(ZI, k, P);
    8315           0 :   Q = gneg(X); Xm1 = gsubgs(X, 1);
    8316           0 :   for (i = 2; i < k; i++)
    8317           0 :     Q = gmul(X, ZX_add(gmul(Xm1, ZX_deriv(Q)), gmulsg(-i, Q)));
    8318           0 :   return RgXQ_mul(Q, invden, P);
    8319             : }
    8320             : GEN
    8321           0 : mfsk(GEN CHI, GEN Q, long k)
    8322             : {
    8323             :   long i, l, m, F, F1, M, o;
    8324             :   GEN v, w, D, T;
    8325             : 
    8326           0 :   CHI = get_mfchar(CHI);
    8327           0 :   M = mfcharmodulus(CHI);
    8328           0 :   o = mfcharorder(CHI);
    8329           0 :   CHI = mfchartoprimitive(CHI, &F);
    8330           0 :   T = char2vecexpo(CHI);
    8331           0 :   v = zerovec(o);
    8332           0 :   for (m = 0; m < F; m++)
    8333             :   {
    8334           0 :     long j = T[m + 1]; /* chi(m) = zeta_o^T[m+1] */
    8335           0 :     if (j < 0) continue;
    8336           0 :     if (j) j = o - j;
    8337           0 :     gel(v, j+1) = addii(gel(v, j+1), RgX_coeff(Q,m));
    8338             :   }
    8339             :   /* \sum \bar{chi}(m) Q[m] */
    8340           0 :   F1 = M / F;
    8341           0 :   D = mydivisorsu(F1);
    8342           0 :   l = lg(D);
    8343           0 :   w = zerovec(o);
    8344           0 :   for (i = 1; i < l; i++)
    8345             :   {
    8346           0 :     long j, d = D[i], d1 = D[l-i], mu = moebiusu(d);
    8347             :     GEN q;
    8348           0 :     if (!mu) continue; /* FIXME ! */
    8349           0 :     j = T[d + 1];
    8350           0 :     if (j < 0) continue;
    8351           0 :     q = powuu(d1, k);
    8352           0 :     if (mu < 0) q = negi(q);
    8353           0 :     gel(w, j+1) = addii(gel(w, j+1), q);
    8354             :   }
    8355           0 :   return RgXQ_mul(RgV_to_RgX(v, 0), RgV_to_RgX(w, 0), polcyclo(o,0));
    8356             : }
    8357             : 
    8358             : /* vector of coefficients from a(0) to a(lim); cusp a vecsmall */
    8359             : GEN
    8360           0 : mfeisenchi1chi2cusp(GEN CHI1, GEN CHI2, GEN cusp, long e, long k, long lim)
    8361             : {
    8362           0 :   pari_sp ltop = avma;
    8363           0 :   GEN vres = cgetg(lim + 2, t_VEC), T1, T2, datacusp;
    8364           0 :   long A = cusp[1], C = cusp[2], g = cgcd(e, C);
    8365           0 :   long N1 = mfcharmodulus(CHI1), N2 = mfcharmodulus(CHI2);
    8366           0 :   long ord1, ord2, g1, g2, g1g2, u1, u2, N = e*N1*N2, Csg = C/g;
    8367           0 :   long Ai, Aei, M, junk, NsM, Aig, n1, N1Csg = N1*Csg, N2Csg = N2*Csg;
    8368             : 
    8369           0 :   cbezout(A, N, &Ai, &junk);
    8370           0 :   g = cbezout(-A*e, C, &Aei, &junk);
    8371           0 :   g1 = cbezout(N1*g, C, &u1, &junk);
    8372           0 :   g2 = cbezout(N2*g, C, &u2, &junk);
    8373           0 :   g1g2 = g1*g2;
    8374           0 :   Aig = ((Ai * g1g2) / C) % N; if (Aig < 0) Aig += N;
    8375           0 :   ord1 = mfcharorder(CHI1); T1 = char2vecexpo(CHI1);
    8376           0 :   ord2 = mfcharorder(CHI2); T2 = char2vecexpo(CHI2);
    8377           0 :   datacusp = mkvecsmalln(8, N1*g/g1, N2*g/g2, C/g, C/g1, C/g2, u1, u2, Aei);
    8378           0 :   M = clcm(Csg, clcm(ord1, ord2));
    8379           0 :   NsM = N / M;
    8380           0 :   for (n1 = 1; n1 <= lim; n1++)
    8381             :   {
    8382           0 :     GEN tmp = mfeisenchi1chi2coeff_i(T1, T2, ord1, ord2, datacusp,
    8383             :                                      N1Csg, N2Csg, k, n1);
    8384           0 :     GEN P = gel(tmp, 1), E = gel(tmp, 2);
    8385           0 :     long i, l = lg(P);
    8386           0 :     for (i = 1; i < l; i++)
    8387             :     {
    8388           0 :       long pi = (NsM*itos(gel(P, i)) + n1*Aig)%N;
    8389           0 :       if (pi < 0) pi += N;
    8390           0 :       gel(P, i) = utoi(pi);
    8391             :     }
    8392           0 :     gel(vres, n1 + 1) = mkvec2(P, E);
    8393             :   }
    8394             :   /*
    8395             :   if (k > 1)
    8396             :     gel(vres, 1) = mfeisenchi1chi20(...);
    8397             :   else
    8398             :   gel(vres, 1) = mfeisenchi1chi2wt10(...); */
    8399           0 :   gel(vres, 1) = gen_0;
    8400           0 :   vres = mfeisenclean(vres, cgcd(C*C, N*e) / (g1*g2));
    8401           0 :   return gerepilecopy(ltop, vres);
    8402             : }
    8403             : 
    8404             : GEN
    8405           0 : mftsteisencusp(GEN CHI1, GEN CHI2, GEN cusp, long e, long k, long lim)
    8406             : {
    8407             :   long A, C, N;
    8408           0 :   CHI1 = get_mfchar(CHI1);
    8409           0 :   CHI2 = get_mfchar(CHI2);
    8410           0 :   N = e*mfcharmodulus(CHI1)*mfcharmodulus(CHI2);
    8411           0 :   cusp_canon(cusp, N, &A, &C);
    8412           0 :   cusp = mkvecsmall2(A, C);
    8413           0 :   return mfeisenchi1chi2cusp(CHI1, CHI2, cusp, e, k, lim);
    8414             : }
    8415             : 
    8416             : /*****************************************************************/
    8417             : /*                       END EISENSTEIN CUSPS                    */
    8418             : /*****************************************************************/
    8419             : 
    8420             : /* Period polynomials (only for SL_2(\Z) for now) */
    8421             : /* flag = 0: full, flag = +1 or -1, odd/even */
    8422             : 
    8423             : /* Basis of period polynomials */
    8424             : GEN
    8425          35 : mfperiodpolbasis(long k, long flag)
    8426             : {
    8427          35 :   pari_sp av = avma;
    8428          35 :   long i, j, km2 = k - 2;
    8429             :   GEN M, C;
    8430          35 :   if (k <= 4) return cgetg(1,t_VEC);
    8431          21 :   M = cgetg(k, t_MAT);
    8432          21 :   C = matpascal(km2);
    8433          21 :   if (!flag)
    8434          84 :     for (j = 0; j <= km2; j++)
    8435             :     {
    8436          77 :       GEN v = cgetg(k, t_COL);
    8437          77 :       for (i = 0; i <= j; i++) gel(v, i+1) = gcoeff(C, j+1, i+1);
    8438          77 :       for (; i <= km2; i++) gel(v, i+1) = gcoeff(C, km2-j+1, i-j+1);
    8439          77 :       gel(M, j+1) = v;
    8440             :     }
    8441             :   else
    8442         168 :     for (j = 0; j <= km2; ++j)
    8443             :     {
    8444         154 :       GEN v = cgetg(k, t_COL);
    8445        1848 :       for (i = 0; i <= km2; ++i)
    8446             :       {
    8447        1694 :         GEN a = i < j ? gcoeff(C, j+1, i+1) : gen_0;
    8448        1694 :         if (i + j >= km2)
    8449             :         {
    8450         924 :           GEN b = gcoeff(C, j+1, i+j-km2+1);
    8451         924 :           a = flag < 0 ? addii(a,b) : subii(a,b);
    8452             :         }
    8453        1694 :         gel(v, i+1) = a;
    8454             :       }
    8455         154 :       gel(M, j+1) = v;
    8456             :     }
    8457          21 :   return gerepilecopy(av, RgM_to_RgXV(ZM_ker(M), 0));
    8458             : }
    8459             : 
    8460             : /* period polynomial associated to an eigenform in SL_2(Z) (not checked),
    8461             :  * assumed already embedded using mfembed. flag is as above.
    8462             :  * der is the order of derivation of the lambda function */
    8463             : GEN
    8464          14 : mfperiodpol(GEN F, long flag, long der, long bitprec)
    8465             : {
    8466          14 :   pari_sp ltop = avma;
    8467             :   GEN sdom, L, V, B;
    8468             :   long k, km2, n, step, flagmf, n0;
    8469          14 :   if (!isf(F)) pari_err_TYPE("mfperiodpol", F);
    8470          14 :   if (f_N(F) != 1) pari_err_IMPL("mfperiodpol in level > 1");
    8471          14 :   k = f_k(F); if (k < 0) pari_err_IMPL("mfperiodpol for this form");
    8472          14 :   km2 = k-2;
    8473          14 :   flagmf = gequal0(mfak_i(F, 0)) ? 3: 1;
    8474          14 :   sdom = mkvec3(stoi(k/2), stoi(k/2), gen_1);
    8475          14 :   L = lfuninit(lfunmf(F, flagmf, bitprec), sdom, der, bitprec);
    8476          14 :   V = zerovec(k-1);
    8477          14 :   B = vecbinomial(km2);
    8478          14 :   step = flag? 2: 1;
    8479          14 :   n0 = flag >= 0? 0: 1;
    8480          91 :   for (n = n0; n <= km2; n += step)
    8481             :   {
    8482          77 :     GEN z = lfunlambda0(L, stoi(n+1), der, bitprec);
    8483          77 :     gel(V, n+1) = gmul(mulcxpowIs(gel(B, n+1), 1-n), z);
    8484             :   }
    8485          14 :   return gerepileupto(ltop, gtopoly(V, 0));
    8486             : }
    8487             : 
    8488             : GEN
    8489         273 : mfparams(GEN F)
    8490             : {
    8491         273 :   pari_sp av = avma;
    8492             :   GEN z, CHI;
    8493         273 :   if (checkmf_i(F))
    8494             :   {
    8495           7 :     long N = mf_get_N(F), k = mf_get_k(F);
    8496           7 :     z = mkvec3(utoi(N), utoi(k), mf_get_CHI(F));
    8497             :   }
    8498             :   else
    8499             :   {
    8500         266 :     if (!isf(F)) pari_err_TYPE("mfparams", F);
    8501         266 :     z = shallowcopy( f_NK(F) );
    8502             :   }
    8503         273 :   CHI = gel(z,3);
    8504         273 :   if (typ(CHI) != t_INT)
    8505             :   {
    8506         245 :     GEN G = gel(CHI,1), chi = gel(CHI,2);
    8507         245 :     switch(mfcharorder(CHI))
    8508             :     {
    8509         161 :       case 1: chi=gen_1; break;
    8510          77 :       case 2: chi=znchartokronecker(G,chi,1); break;
    8511           7 :       default:chi=mkintmod(znconreyexp(G,chi), znstar_get_N(G)); break;
    8512             :     }
    8513         245 :     gel(z,3) = chi;
    8514             :   }
    8515         273 :   return gerepilecopy(av, z);
    8516             : }
    8517             : 
    8518             : static GEN
    8519           0 : mfiscuspidal_i(GEN F)
    8520             : {
    8521             :   GEN P, mf, V;
    8522             :   long lv;
    8523           0 :   if (!isf(F)) pari_err_TYPE("mfiscuspidal", F);
    8524           0 :   P = f_NK(F);
    8525           0 :   if (signe(gel(P,1)) < 0 || signe(gel(P,2)) < 0 || isintzero(gel(P,3)))
    8526           0 :     pari_err_IMPL("mfiscuspidal for this F");
    8527           0 :   mf = mfinit(P, mf_CUSP);
    8528           0 :   V = mftobasis(mf, F, 1); lv = lg(V) - 1;
    8529           0 :   return lv ? mkvec2(mf, V) : NULL;
    8530             : }
    8531             : 
    8532             : long
    8533           0 : mfiscuspidal(GEN F)
    8534             : {
    8535           0 :   pari_sp av = avma;
    8536           0 :   GEN MFV = mfiscuspidal_i(F);
    8537           0 :   long r = MFV ? 1 : 0;
    8538           0 :   avma = av; return r;
    8539             : }
    8540             : 
    8541             : /* remove entry at index i, in place */
    8542             : static void
    8543          35 : vecsmallsplice_ip(GEN v, long i)
    8544             : {
    8545          35 :   long j, n = lg(v)-1;
    8546          35 :   for (j = i; j < n; j++) v[j] = v[j+1];
    8547          35 :   setlg(v,n);
    8548          35 : }
    8549             : /* remove entry at index i, in place */
    8550             : static void
    8551           0 : vecsplice_ip(GEN v, long i)
    8552             : {
    8553           0 :   long j, n = lg(v)-1;
    8554           0 :   for (j = i; j < n; j++) gel(v,j) = gel(v,j+1);
    8555           0 :   setlg(v,n);
    8556           0 : }
    8557             : GEN
    8558          14 : mfisCM(GEN F)
    8559             : {
    8560          14 :   pari_sp av = avma;
    8561             :   forprime_t S;
    8562             :   GEN P, D, v;
    8563             :   long N, k, lD, sb, p, i;
    8564          14 :   if (!isf(F)) pari_err_TYPE("mfisCM", F);
    8565          14 :   P = f_NK(F);
    8566          14 :   N = itos(gel(P,1));
    8567          14 :   k = itos(gel(P,2)); if (N < 0 || k < 0) pari_err_IMPL("mfisCM for this F");
    8568          14 :   D = mfunramneg(N);
    8569          14 :   lD = lg(D);
    8570          14 :   sb = maxss(mfsturmNk(N, k), 4*N);
    8571          14 :   v = mfcoefs_i(F, sb, 1);
    8572          14 :   u_forprime_init(&S, 2, sb);
    8573         518 :   while ((p = u_forprime_next(&S)))
    8574             :   {
    8575         490 :     GEN ap = gel(v, p+1);
    8576         490 :     if (!gequal0(ap))
    8577             :     {
    8578         399 :       for (i = 1; i < lD; i++)
    8579         238 :         if (kross(D[i], p) == -1) { vecsmallsplice_ip(D, i); lD = lg(D); }
    8580             :     }
    8581             :   }
    8582          14 :   if (lD == 1) { avma = av; return gen_0; }
    8583          14 :   if (lD == 2) { avma = av; return stoi(D[1]); }
    8584           7 :   if (k > 1) pari_err_BUG("mfisCM");
    8585           7 :   return gerepileupto(av, zv_to_ZV(D));
    8586             : }
    8587             : 
    8588             : static long
    8589         168 : mfspace_i(GEN F)
    8590             : {
    8591             :   GEN P, mf, vF;
    8592             :   long leis, l, i, N;
    8593             : 
    8594         168 :   if (!isf(F)) { checkmf(F); return mf_get_space(F); }
    8595         168 :   P = f_NK(F);
    8596         168 :   if (signe(gel(P,1)) < 0 || signe(gel(P,2)) < 0 || isintzero(gel(P,3)))
    8597           7 :     pari_err_IMPL("mfspace for this F");
    8598         161 :   gel(P,3) = mfchar2char(gel(P,3));
    8599         161 :   mf = mfinit(P, mf_FULL);
    8600         161 :   vF = mftobasis_i(mf, F); /* rigorous */
    8601         161 :   l = lg(vF); if (l == 1) return -1;
    8602         154 :   leis = lg(mf_get_eisen(mf));
    8603         399 :   for (i = 1; i < leis; i++)
    8604         322 :     if (!gequal0(gel(vF, i)))
    8605             :     {
    8606         189 :       for (i = leis; i < l; i++)
    8607         140 :         if (!gequal0(gel(vF,i))) return mf_FULL;
    8608          49 :       return mf_EISEN;
    8609             :     }
    8610          77 :   vF = mftonew_i(mf, vecslice(vF, leis, l-1), &N);
    8611          77 :   if (N != mf_get_N(mf)) return mf_OLD;
    8612          77 :   l = lg(vF);
    8613         126 :   for (i = 1; i < l; i++)
    8614          63 :     if (itos(gmael(vF,i,1)) != N) return mf_CUSP;
    8615          63 :   return mf_NEW;
    8616             : }
    8617             : long
    8618         168 : mfspace(GEN F)
    8619             : {
    8620         168 :   pari_sp av = avma;
    8621         168 :   long s = mfspace_i(F);
    8622         161 :   avma = av; return s;
    8623             : }
    8624             : 
    8625             : static GEN
    8626           0 : mfscalmul(GEN F, GEN la)
    8627           0 : { return mflinear_i(mkvec(F), mkvec(la)); }
    8628             : /* Always returns 0 if F does not belong to the new space and level > 1 */
    8629             : long
    8630           0 : mfisselfdual(GEN F)
    8631             : {
    8632           0 :   pari_sp av = avma;
    8633             :   GEN P, gN, mf, V, G, cof, cog;
    8634             :   long r;
    8635           0 :   if (!isf(F)) pari_err_TYPE("mfisselfdual", F);
    8636           0 :   cof = mfak_i(F, 1);
    8637           0 :   if (gequal0(cof)) { avma = av; return 0; }
    8638           0 :   P = f_NK(F); gN = gel(P,1);
    8639           0 :   if (signe(gN) < 0 || signe(gel(P,2)) < 0 || isintzero(gel(P,3)))
    8640           0 :     pari_err_IMPL("mfisselfdual for this F");
    8641           0 :   if (is_pm1(gN)) { avma = av; return 1; }
    8642           0 :   mf = mfsplit(mfinit(P, mf_NEW), 0, 0); /* FIXME: could guess dimlim ? */
    8643           0 :   V = mftobasis(mf, F, 1);
    8644           0 :   if (lg(V) == 1) pari_err_IMPL("mfisselfdual outside of new space");
    8645           0 :   G = mfatkin(mf, F, gN, 128);
    8646           0 :   cog = mfak_i(G, 1);
    8647           0 :   r = mfisequal(mfscalmul(F, gdiv(cog,cof)), G, 0);
    8648           0 :   avma = av; return r;
    8649             : }
    8650             : 
    8651             : static GEN
    8652           7 : lfunfindchi(GEN ldata, long prec)
    8653             : {
    8654           7 :   long k = ldata_get_k(ldata), N = itou(ldata_get_conductor(ldata));
    8655           7 :   GEN L = mfchargalois(N, odd(k), gen_2);
    8656           7 :   long i, l = lg(L), B0 = 1, B = N+1;
    8657             : 
    8658          14 :   while (l > 2)
    8659             :   {
    8660           0 :     GEN van = ldata_vecan(ldata_get_an(ldata), B, prec);
    8661             :     long n;
    8662           0 :     for (n = B0; n <= B; n++)
    8663           0 :       if (cgcd(n, N) != 1 || gequal0(gel(van,n))) gel(van,n) = NULL;
    8664           0 :     for (i = 1; i < l; i++)
    8665             :     {
    8666           0 :       GEN CHI = gel(L,i);
    8667           0 :       if (!CHI) continue;
    8668           0 :       for (n = B0; n <= B; n++)
    8669             :       {
    8670           0 :         GEN an = gel(van, n);
    8671           0 :         if (an && !gequal(an, gmul(mfchareval(CHI, n), gconj(an))))
    8672             :         {
    8673           0 :           vecsplice_ip(L,i); l = lg(L); break;
    8674             :         }
    8675             :       }
    8676             :     }
    8677           0 :     B0 = B+1; B *= 2;
    8678             :   }
    8679           7 :   return gel(L,1);
    8680             : }
    8681             : 
    8682             : GEN
    8683           7 : mffromlfun(GEN L, long prec)
    8684             : {
    8685           7 :   pari_sp ltop = avma;
    8686           7 :   GEN ldata = lfunmisc_to_ldata_shallow(L);
    8687           7 :   GEN Vga = ldata_get_gammavec(ldata);
    8688             :   GEN mf, V, vecan, a0, CHI;
    8689             :   long k, N, sb, space;
    8690           7 :   if (!gequal(Vga, mkvec2(gen_0, gen_1))) pari_err_TYPE("mffromlfun", L);
    8691           7 :   if (!ldata_isreal(ldata)) pari_err_IMPL("non-real L-functions");
    8692           7 :   k = ldata_get_k(ldata);
    8693           7 :   N = itos(ldata_get_conductor(ldata));
    8694           7 :   space = (lg(ldata) == 7)? mf_CUSP: mf_FULL;
    8695           7 :   CHI = lfunfindchi(ldata, prec);
    8696           7 :   setlg(CHI,3);
    8697           7 :   mf = mfinit(mkvec3(stoi(N), stoi(k), CHI), space);
    8698           7 :   sb = mfsturm(mf);
    8699           7 :   vecan = ldata_vecan(ldata_get_an(ldata), sb + 2, prec);
    8700           7 :   a0 = (space == mf_CUSP)? gen_0: gneg(lfun(L, gen_0, prec2nbits(prec)));
    8701           7 :   vecan = shallowconcat(a0, vecan);
    8702           7 :   V = mftobasis(mf, vecan, 1); if (lg(V) == 1) pari_err_BUG("mffromlfun");
    8703           7 :   return gerepilecopy(ltop, mflinear_i(mfbasis(mf), V));
    8704             : }

Generated by: LCOV version 1.11