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 to exceed 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.12.1 lcov report (development 25406-bf255ab81b) Lines: 7402 7589 97.5 %
Date: 2020-06-04 05:59:24 Functions: 757 762 99.3 %
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             : static const long EXTRAPREC = DEFAULTPREC-2;
      23             : 
      24             : enum {
      25             :   MF_SPLIT = 1,
      26             :   MF_EISENSPACE,
      27             :   MF_FRICKE,
      28             :   MF_MF2INIT,
      29             :   MF_SPLITN
      30             : };
      31             : 
      32             : typedef struct {
      33             :   GEN vnew, vfull, DATA, VCHIP;
      34             :   long n, newHIT, newTOTAL, cuspHIT, cuspTOTAL;
      35             : } cachenew_t;
      36             : 
      37             : static void init_cachenew(cachenew_t *c, long n, long N, GEN f);
      38             : static GEN mfinit_i(GEN NK, long space);
      39             : static GEN mfinit_Nkchi(long N, long k, GEN CHI, long space, long flraw);
      40             : static GEN mf2init_Nkchi(long N, long k, GEN CHI, long space, long flraw);
      41             : static GEN mf2basis(long N, long r, GEN CHI, GEN *pCHI1, long space);
      42             : static GEN mfeisensteinbasis(long N, long k, GEN CHI);
      43             : static GEN mfeisensteindec(GEN mf, GEN F);
      44             : static GEN initwt1newtrace(GEN mf);
      45             : static GEN initwt1trace(GEN mf);
      46             : static GEN myfactoru(long N);
      47             : static GEN mydivisorsu(long N);
      48             : static GEN Qab_Czeta(long k, long ord, GEN C, long vt);
      49             : static GEN mfcoefs_i(GEN F, long n, long d);
      50             : static GEN bhnmat_extend(GEN M, long m,long l, GEN S, cachenew_t *cache);
      51             : static GEN initnewtrace(long N, GEN CHI);
      52             : static void dbg_cachenew(cachenew_t *C);
      53             : static GEN hecke_i(long m, long l, GEN V, GEN F, GEN DATA);
      54             : static GEN c_Ek(long n, long d, GEN F);
      55             : static GEN RgV_heckef2(long n, long d, GEN V, GEN F, GEN DATA);
      56             : static GEN mfcusptrace_i(long N, long k, long n, GEN Dn, GEN TDATA);
      57             : static GEN mfnewtracecache(long N, long k, long n, cachenew_t *cache);
      58             : static GEN colnewtrace(long n0, long n, long d, long N, long k, cachenew_t *c);
      59             : static GEN dihan(GEN bnr, GEN w, GEN k0j, ulong n);
      60             : static GEN sigchi(long k, GEN CHI, long n);
      61             : static GEN sigchi2(long k, GEN CHI1, GEN CHI2, long n, long ord);
      62             : static GEN mflineardivtomat(long N, GEN vF, long n);
      63             : static GEN mfdihedralcusp(long N, GEN CHI);
      64             : static long mfdihedralcuspdim(long N, GEN CHI);
      65             : static GEN mfdihedralnew(long N, GEN CHI);
      66             : static GEN mfdihedralall(GEN LIM);
      67             : static long mfwt1cuspdim(long N, GEN CHI);
      68             : static long mf2dim_Nkchi(long N, long k, GEN CHI, ulong space);
      69             : static long mfdim_Nkchi(long N, long k, GEN CHI, long space);
      70             : static GEN charLFwtk(long N, long k, GEN CHI, long ord, long t);
      71             : static GEN mfeisensteingacx(GEN E,long w,GEN ga,long n,long prec);
      72             : static GEN mfgaexpansion(GEN mf, GEN F, GEN gamma, long n, long prec);
      73             : static GEN mfEHmat(long n, long r);
      74             : static GEN mfEHcoef(long r, long N);
      75             : static GEN mftobasis_i(GEN mf, GEN F);
      76             : 
      77             : static GEN
      78       32123 : mkgNK(GEN N, GEN k, GEN CHI, GEN P) { return mkvec4(N, k, CHI, P); }
      79             : static GEN
      80       13419 : mkNK(long N, long k, GEN CHI) { return mkgNK(stoi(N), stoi(k), CHI, pol_x(1)); }
      81             : GEN
      82        7483 : MF_get_CHI(GEN mf) { return gmael(mf,1,3); }
      83             : GEN
      84       18536 : MF_get_gN(GEN mf) { return gmael(mf,1,1); }
      85             : long
      86       17661 : MF_get_N(GEN mf) { return itou(MF_get_gN(mf)); }
      87             : GEN
      88       12810 : MF_get_gk(GEN mf) { return gmael(mf,1,2); }
      89             : long
      90        6279 : MF_get_k(GEN mf)
      91             : {
      92        6279 :   GEN gk = MF_get_gk(mf);
      93        6279 :   if (typ(gk)!=t_INT) pari_err_IMPL("half-integral weight");
      94        6279 :   return itou(gk);
      95             : }
      96             : long
      97         238 : MF_get_r(GEN mf)
      98             : {
      99         238 :   GEN gk = MF_get_gk(mf);
     100         238 :   if (typ(gk) == t_INT) pari_err_IMPL("integral weight");
     101         238 :   return itou(gel(gk, 1)) >> 1;
     102             : }
     103             : long
     104       12796 : MF_get_space(GEN mf) { return itos(gmael(mf,1,4)); }
     105             : GEN
     106        3864 : MF_get_E(GEN mf) { return gel(mf,2); }
     107             : GEN
     108       18921 : MF_get_S(GEN mf) { return gel(mf,3); }
     109             : GEN
     110        1414 : MF_get_basis(GEN mf) { return shallowconcat(gel(mf,2), gel(mf,3)); }
     111             : long
     112        4676 : MF_get_dim(GEN mf)
     113             : {
     114        4676 :   switch(MF_get_space(mf))
     115             :   {
     116         686 :     case mf_FULL:
     117         686 :       return lg(MF_get_S(mf)) - 1 + lg(MF_get_E(mf))-1;
     118         140 :     case mf_EISEN:
     119         140 :       return lg(MF_get_E(mf))-1;
     120        3850 :     default: /* mf_NEW, mf_CUSP, mf_OLD */
     121        3850 :       return lg(MF_get_S(mf)) - 1;
     122             :   }
     123             : }
     124             : GEN
     125        6867 : MFnew_get_vj(GEN mf) { return gel(mf,4); }
     126             : GEN
     127         490 : MFcusp_get_vMjd(GEN mf) { return gel(mf,4); }
     128             : GEN
     129        6244 : MF_get_M(GEN mf) { return gmael(mf,5,3); }
     130             : GEN
     131        2527 : MF_get_Minv(GEN mf) { return gmael(mf,5,2); }
     132             : GEN
     133        8106 : MF_get_Mindex(GEN mf) { return gmael(mf,5,1); }
     134             : 
     135             : /* ordinary gtocol forgets about initial 0s */
     136             : GEN
     137        2023 : sertocol(GEN S) { return gtocol0(S, -(lg(S) - 2 + valp(S))); }
     138             : /*******************************************************************/
     139             : /*     Linear algebra in cyclotomic fields (TODO: export this)     */
     140             : /*******************************************************************/
     141             : /* return r and split prime p giving projection Q(zeta_n) -> Fp, zeta -> r */
     142             : static ulong
     143         770 : QabM_init(long n, ulong *p)
     144             : {
     145         770 :   ulong pinit = 1000000007;
     146             :   forprime_t T;
     147         770 :   if (n <= 1) { *p = pinit; return 0; }
     148         763 :   u_forprime_arith_init(&T, pinit, ULONG_MAX, 1, n);
     149         763 :   *p = u_forprime_next(&T);
     150         763 :   return Flx_oneroot(ZX_to_Flx(polcyclo(n, 0), *p), *p);
     151             : }
     152             : static ulong
     153      645414 : Qab_to_Fl(GEN P, ulong r, ulong p)
     154             : {
     155             :   ulong t;
     156             :   GEN den;
     157      645414 :   P = Q_remove_denom(liftpol_shallow(P), &den);
     158      645414 :   if (typ(P) == t_POL) { GEN Pp = ZX_to_Flx(P, p); t = Flx_eval(Pp, r, p); }
     159      624127 :   else t = umodiu(P, p);
     160      645414 :   if (den) t = Fl_div(t, umodiu(den, p), p);
     161      645414 :   return t;
     162             : }
     163             : static GEN
     164       14917 : QabC_to_Flc(GEN C, ulong r, ulong p)
     165             : {
     166       14917 :   long i, l = lg(C);
     167       14917 :   GEN A = cgetg(l, t_VECSMALL);
     168      620207 :   for (i = 1; i < l; i++) uel(A,i) = Qab_to_Fl(gel(C,i), r, p);
     169       14917 :   return A;
     170             : }
     171             : static GEN
     172         385 : QabM_to_Flm(GEN M, ulong r, ulong p)
     173             : {
     174             :   long i, l;
     175         385 :   GEN A = cgetg_copy(M, &l);
     176       15302 :   for (i = 1; i < l; i++)
     177       14917 :     gel(A, i) = QabC_to_Flc(gel(M, i), r, p);
     178         385 :   return A;
     179             : }
     180             : /* A a t_POL */
     181             : static GEN
     182         553 : QabX_to_Flx(GEN A, ulong r, ulong p)
     183             : {
     184         553 :   long i, l = lg(A);
     185         553 :   GEN a = cgetg(l, t_VECSMALL);
     186         553 :   a[1] = ((ulong)A[1])&VARNBITS;
     187       40677 :   for (i = 2; i < l; i++) uel(a,i) = Qab_to_Fl(gel(A,i), r, p);
     188         553 :   return Flx_renormalize(a, l);
     189             : }
     190             : 
     191             : /* FIXME: remove */
     192             : static GEN
     193         966 : ZabM_pseudoinv_i(GEN M, GEN P, long n, GEN *pv, GEN *den, int ratlift)
     194             : {
     195         966 :   GEN v = ZabM_indexrank(M, P, n);
     196         966 :   if (pv) *pv = v;
     197         966 :   M = shallowmatextract(M,gel(v,1),gel(v,2));
     198         966 :   return ratlift? ZabM_inv_ratlift(M, P, n, den): ZabM_inv(M, P, n, den);
     199             : }
     200             : 
     201             : /* M matrix with coeff in Q(\chi)), where Q(\chi) = Q(X)/(P) for
     202             :  * P = cyclotomic Phi_n. Assume M rational if n <= 2 */
     203             : static GEN
     204        1701 : QabM_ker(GEN M, GEN P, long n)
     205             : {
     206        1701 :   if (n <= 2) return QM_ker(M);
     207         742 :   return ZabM_ker(Q_primpart(liftpol_shallow(M)), P, n);
     208             : }
     209             : /* pseudo-inverse of M. FIXME: should replace QabM_pseudoinv */
     210             : static GEN
     211        1225 : QabM_pseudoinv_i(GEN M, GEN P, long n, GEN *pv, GEN *pden)
     212             : {
     213             :   GEN cM, Mi;
     214        1225 :   if (n <= 2)
     215             :   {
     216         938 :     M = Q_primitive_part(M, &cM);
     217         938 :     Mi = ZM_pseudoinv(M, pv, pden); /* M^(-1) = Mi / (cM * den) */
     218             :   }
     219             :   else
     220             :   {
     221         287 :     M = Q_primitive_part(liftpol_shallow(M), &cM);
     222         287 :     Mi = ZabM_pseudoinv(M, P, n, pv, pden);
     223             :   }
     224        1225 :   *pden = mul_content(*pden, cM);
     225        1225 :   return Mi;
     226             : }
     227             : /* FIXME: delete */
     228             : static GEN
     229         994 : QabM_pseudoinv(GEN M, GEN P, long n, GEN *pv, GEN *pden)
     230             : {
     231         994 :   GEN Mi = QabM_pseudoinv_i(M, P, n, pv, pden);
     232         994 :   return P? gmodulo(Mi, P): Mi;
     233             : }
     234             : 
     235             : static GEN
     236        9765 : QabM_indexrank(GEN M, GEN P, long n)
     237             : {
     238             :   GEN z;
     239        9765 :   if (n <= 2)
     240             :   {
     241        8666 :     M = vec_Q_primpart(M);
     242        8666 :     z = ZM_indexrank(M); /* M^(-1) = Mi / (cM * den) */
     243             :   }
     244             :   else
     245             :   {
     246        1099 :     M = vec_Q_primpart(liftpol_shallow(M));
     247        1099 :     z = ZabM_indexrank(M, P, n);
     248             :   }
     249        9765 :   return z;
     250             : }
     251             : 
     252             : /*********************************************************************/
     253             : /*                    Simple arithmetic functions                    */
     254             : /*********************************************************************/
     255             : /* TODO: most of these should be exported and used in ifactor1.c */
     256             : /* phi(n) */
     257             : static ulong
     258      105399 : myeulerphiu(ulong n)
     259             : {
     260             :   pari_sp av;
     261      105399 :   if (n == 1) return 1;
     262       87129 :   av = avma; return gc_ulong(av, eulerphiu_fact(myfactoru(n)));
     263             : }
     264             : static long
     265       65562 : mymoebiusu(ulong n)
     266             : {
     267             :   pari_sp av;
     268       65562 :   if (n == 1) return 1;
     269       54068 :   av = avma; return gc_long(av, moebiusu_fact(myfactoru(n)));
     270             : }
     271             : 
     272             : static long
     273        2842 : mynumdivu(long N)
     274             : {
     275             :   pari_sp av;
     276        2842 :   if (N == 1) return 1;
     277        2737 :   av = avma; return gc_long(av, numdivu_fact(myfactoru(N)));
     278             : }
     279             : 
     280             : /* N\prod_{p|N} (1+1/p) */
     281             : static long
     282      337162 : mypsiu(ulong N)
     283             : {
     284      337162 :   pari_sp av = avma;
     285      337162 :   GEN P = gel(myfactoru(N), 1);
     286      337162 :   long j, l = lg(P), res = N;
     287      716198 :   for (j = 1; j < l; j++) res += res/P[j];
     288      337162 :   return gc_long(av,res);
     289             : }
     290             : /* write n = mf^2. Return m, set f. */
     291             : static ulong
     292         210 : mycore(ulong n, long *pf)
     293             : {
     294         210 :   pari_sp av = avma;
     295         210 :   GEN fa = myfactoru(n), P = gel(fa,1), E = gel(fa,2);
     296         210 :   long i, l = lg(P), m = 1, f = 1;
     297         850 :   for (i = 1; i < l; i++)
     298             :   {
     299         640 :     long j, p = P[i], e = E[i];
     300         640 :     if (e & 1) m *= p;
     301        1190 :     for (j = 2; j <= e; j+=2) f *= p;
     302             :   }
     303         210 :   *pf = f; return gc_long(av,m);
     304             : }
     305             : 
     306             : /* fa = factorization of -D > 0, return -D0 > 0 (where D0 is fundamental) */
     307             : static long
     308     8253259 : corediscs_fact(GEN fa)
     309             : {
     310     8253259 :   GEN P = gel(fa,1), E = gel(fa,2);
     311     8253259 :   long i, l = lg(P), m = 1;
     312    27307672 :   for (i = 1; i < l; i++)
     313             :   {
     314    19054413 :     long p = P[i], e = E[i];
     315    19054413 :     if (e & 1) m *= p;
     316             :   }
     317     8253259 :   if ((m&3L) != 3) m <<= 2;
     318     8253259 :   return m;
     319             : }
     320             : static long
     321        6573 : mubeta(long n)
     322             : {
     323        6573 :   pari_sp av = avma;
     324        6573 :   GEN E = gel(myfactoru(n), 2);
     325        6573 :   long i, s = 1, l = lg(E);
     326       13636 :   for (i = 1; i < l; i++)
     327             :   {
     328        7063 :     long e = E[i];
     329        7063 :     if (e >= 3) return gc_long(av,0);
     330        7063 :     if (e == 1) s *= -2;
     331             :   }
     332        6573 :   return gc_long(av,s);
     333             : }
     334             : 
     335             : /* n = n1*n2, n1 = ppo(n, m); return mubeta(n1)*moebiusu(n2).
     336             :  * N.B. If n from newt_params we, in fact, never return 0 */
     337             : static long
     338     5794061 : mubeta2(long n, long m)
     339             : {
     340     5794061 :   pari_sp av = avma;
     341     5794061 :   GEN fa = myfactoru(n), P = gel(fa,1), E = gel(fa,2);
     342     5794061 :   long i, s = 1, l = lg(P);
     343    11559926 :   for (i = 1; i < l; i++)
     344             :   {
     345     5765865 :     long p = P[i], e = E[i];
     346     5765865 :     if (m % p)
     347             :     { /* p^e in n1 */
     348     4736851 :       if (e >= 3) return gc_long(av,0);
     349     4736851 :       if (e == 1) s *= -2;
     350             :     }
     351             :     else
     352             :     { /* in n2 */
     353     1029014 :       if (e >= 2) return gc_long(av,0);
     354     1029014 :       s = -s;
     355             :     }
     356             :   }
     357     5794061 :   return gc_long(av,s);
     358             : }
     359             : 
     360             : /* write N = prod p^{ep} and n = df^2, d squarefree.
     361             :  * set g  = ppo(gcd(sqfpart(N), f), FC)
     362             :  *     N2 = prod p^if(e==1 || p|n, ep-1, ep-2) */
     363             : static void
     364     1428294 : newt_params(long N, long n, long FC, long *pg, long *pN2)
     365             : {
     366     1428294 :   GEN fa = myfactoru(N), P = gel(fa,1), E = gel(fa,2);
     367     1428294 :   long i, g = 1, N2 = 1, l = lg(P);
     368     3716811 :   for (i = 1; i < l; i++)
     369             :   {
     370     2288517 :     long p = P[i], e = E[i];
     371     2288517 :     if (e == 1)
     372     1962499 :     { if (FC % p && n % (p*p) == 0) g *= p; }
     373             :     else
     374      326018 :       N2 *= upowuu(p,(n % p)? e-2: e-1);
     375             :   }
     376     1428294 :   *pg = g; *pN2 = N2;
     377     1428294 : }
     378             : /* simplified version of newt_params for n = 1 (newdim) */
     379             : static void
     380       38332 : newd_params(long N, long *pN2)
     381             : {
     382       38332 :   GEN fa = myfactoru(N), P = gel(fa,1), E = gel(fa,2);
     383       38332 :   long i, N2 = 1, l = lg(P);
     384       96208 :   for (i = 1; i < l; i++)
     385             :   {
     386       57876 :     long p = P[i], e = E[i];
     387       57876 :     if (e > 2) N2 *= upowuu(p, e-2);
     388             :   }
     389       38332 :   *pN2 = N2;
     390       38332 : }
     391             : 
     392             : static long
     393          21 : newd_params2(long N)
     394             : {
     395          21 :   GEN fa = myfactoru(N), P = gel(fa,1), E = gel(fa,2);
     396          21 :   long i, N2 = 1, l = lg(P);
     397          56 :   for (i = 1; i < l; i++)
     398             :   {
     399          35 :     long p = P[i], e = E[i];
     400          35 :     if (e >= 2) N2 *= upowuu(p, e);
     401             :   }
     402          21 :   return N2;
     403             : }
     404             : 
     405             : /*******************************************************************/
     406             : /*   Relative trace between cyclotomic fields (TODO: export this)  */
     407             : /*******************************************************************/
     408             : /* g>=1; return g * prod_{p | g, (p,q) = 1} (1-1/p) */
     409             : static long
     410       36834 : phipart(long g, long q)
     411             : {
     412       36834 :   if (g > 1)
     413             :   {
     414       19642 :     GEN P = gel(myfactoru(g), 1);
     415       19642 :     long i, l = lg(P);
     416       40138 :     for (i = 1; i < l; i++) { long p = P[i]; if (q % p) g -= g / p; }
     417             :   }
     418       36834 :   return g;
     419             : }
     420             : /* Set s,v s.t. Trace(zeta_N^k) from Q(zeta_N) to Q(\zeta_N) = s * zeta_M^v
     421             :  * With k > 0, N = M*d and N, M != 2 mod 4 */
     422             : static long
     423       84609 : tracerelz(long *pv, long d, long M, long k)
     424             : {
     425             :   long s, g, q, muq;
     426       84609 :   if (d == 1) { *pv = k; return 1; }
     427       65471 :   *pv = 0; g = ugcd(k, d); q = d / g;
     428       65471 :   muq = mymoebiusu(q); if (!muq) return 0;
     429       47096 :   if (M != 1)
     430             :   {
     431       37758 :     long v = Fl_invsafe(q % M, M);
     432       37758 :     if (!v) return 0;
     433       27496 :     *pv = (v * (k/g)) % M;
     434             :   }
     435       36834 :   s = phipart(g, M*q); if (muq < 0) s = -s;
     436       36834 :   return s;
     437             : }
     438             : /* Pi = polcyclo(i), i = m or n. Let Ki = Q(zeta_i), initialize Tr_{Kn/Km} */
     439             : GEN
     440       33425 : Qab_trace_init(long n, long m, GEN Pn, GEN Pm)
     441             : {
     442             :   long a, i, j, N, M, vt, d, D;
     443             :   GEN T, G;
     444             : 
     445       33425 :   if (m == n || n <= 2) return mkvec(Pm);
     446       16485 :   vt = varn(Pn);
     447       16485 :   d = degpol(Pn);
     448             :   /* if (N != n) zeta_N = zeta_n^2 and zeta_n = - zeta_N^{(N+1)/2} */
     449       16485 :   N = ((n & 3) == 2)? n >> 1: n;
     450       16485 :   M = ((m & 3) == 2)? m >> 1: m; /* M | N | n */
     451       16485 :   a = N / M;
     452       16485 :   T = const_vec(d, NULL);
     453       16485 :   D = d / degpol(Pm); /* relative degree */
     454       16485 :   if (D == 1) G = NULL;
     455             :   else
     456             :   { /* zeta_M = zeta_n^A; s_j(zeta_M) = zeta_M <=> j = 1 (mod J) */
     457       15211 :     long lG, A = (N == n)? a: (a << 1), J = n / ugcd(n, A);
     458       15211 :     G = coprimes_zv(n);
     459      149912 :     for (j = lG = 1; j < n; j += J)
     460      134701 :       if (G[j]) G[lG++] = j;
     461       15211 :     setlg(G, lG); /* Gal(Q(zeta_n) / Q(zeta_m)) */
     462             :   }
     463       16485 :   T = const_vec(d, NULL);
     464       16485 :   gel(T,1) = utoipos(D); /* Tr 1 */
     465      139902 :   for (i = 1; i < d; i++)
     466             :   { /* if n = 2N, zeta_n^i = (-1)^i zeta_N^k */
     467             :     long s, v, k;
     468             :     GEN t;
     469             : 
     470      123417 :     if (gel(T, i+1)) continue;
     471       84609 :     k = (N == n)? i: ((odd(i)? i + N: i) >> 1);
     472       84609 :     if ((s = tracerelz(&v, a, M, k)))
     473             :     {
     474       55972 :       if (m != M) v *= 2;/* Tr = s * zeta_m^v */
     475       55972 :       if (n != N && odd(i)) s = -s;
     476       55972 :       t = Qab_Czeta(v, m, stoi(s), vt);
     477             :     }
     478             :     else
     479       28637 :       t = gen_0;
     480             :     /* t = Tr_{Kn/Km} zeta_n^i; fill using Galois action */
     481       84609 :     if (!G)
     482       19138 :       gel(T, i + 1) = t;
     483             :     else
     484      370349 :       for (j = 1; j <= D; j++)
     485             :       {
     486      304878 :         long z = Fl_mul(i,G[j], n);
     487      304878 :         if (z < d) gel(T, z + 1) = t;
     488             :       }
     489             :   }
     490       16485 :   return mkvec3(Pm, Pn, T);
     491             : }
     492             : /* x a t_POL modulo Phi_n */
     493             : static GEN
     494       59143 : tracerel_i(GEN T, GEN x)
     495             : {
     496       59143 :   long k, l = lg(x);
     497             :   GEN S;
     498       59143 :   if (l == 2) return gen_0;
     499       59143 :   S = gmul(gel(T,1), gel(x,2));
     500      249963 :   for (k = 3; k < l; k++) S = gadd(S, gmul(gel(T,k-1), gel(x,k)));
     501       59143 :   return S;
     502             : }
     503             : static GEN
     504      126406 : tracerel(GEN a, GEN v, GEN z)
     505             : {
     506      126406 :   a = liftpol_shallow(a);
     507      126406 :   a = simplify_shallow(z? gmul(z,a): a);
     508      126406 :   if (typ(a) == t_POL)
     509             :   {
     510       59143 :     GEN T = gel(v,3);
     511       59143 :     long degrel = itou(gel(T,1));
     512       59143 :     a = tracerel_i(T, RgX_rem(a, gel(v,2)));
     513       59143 :     if (degrel != 1) a = gdivgs(a, degrel);
     514       59143 :     if (typ(a) == t_POL) a = RgX_rem(a, gel(v,1));
     515             :   }
     516      126406 :   return a;
     517             : }
     518             : static GEN
     519        5348 : tracerel_z(GEN v, long t)
     520             : {
     521        5348 :   GEN Pn = gel(v,2);
     522        5348 :   return t? pol_xn(t, varn(Pn)): NULL;
     523             : }
     524             : /* v = Qab_trace_init(n,m); x is a t_VEC of polmodulo Phi_n; Kn = Q(zeta_n)
     525             :  * [Kn:Km]^(-1) Tr_{Kn/Km} (zeta_n^t * x); 0 <= t < [Kn:Km] */
     526             : GEN
     527           0 : Qab_tracerel(GEN v, long t, GEN a)
     528             : {
     529           0 :   if (lg(v) != 4) return a; /* => t = 0 */
     530           0 :   return tracerel(a, v, tracerel_z(v, t));
     531             : }
     532             : GEN
     533       12348 : QabV_tracerel(GEN v, long t, GEN x)
     534             : {
     535             :   GEN z;
     536       12348 :   if (lg(v) != 4) return x; /* => t = 0 */
     537        5348 :   z = tracerel_z(v, t);
     538      131754 :   pari_APPLY_same(tracerel(gel(x,i), v, z));
     539             : }
     540             : GEN
     541         133 : QabM_tracerel(GEN v, long t, GEN x)
     542             : {
     543         133 :   if (lg(v) != 4) return x;
     544         105 :   pari_APPLY_same(QabV_tracerel(v, t, gel(x,i)));
     545             : }
     546             : 
     547             : /* C*zeta_o^k mod X^o - 1 */
     548             : static GEN
     549     1020215 : Qab_Czeta(long k, long o, GEN C, long vt)
     550             : {
     551     1020215 :   if (!k) return C;
     552      557291 :   if (!odd(o))
     553             :   { /* optimization: reduce max degree by a factor 2 for free */
     554      501382 :     o >>= 1;
     555      501382 :     if (k >= o) { k -= o; C = gneg(C); if (!k) return C; }
     556             :   }
     557      369985 :   return monomial(C, k, vt);
     558             : }
     559             : /* zeta_o^k */
     560             : static GEN
     561      148393 : Qab_zeta(long k, long o, long vt) { return Qab_Czeta(k, o, gen_1, vt); }
     562             : 
     563             : /*              Operations on Dirichlet characters                       */
     564             : 
     565             : /* A Dirichlet character can be given in GP in different formats, but in this
     566             :  * package, it will be a vector CHI=[G,chi,ord], where G is the (Z/MZ)^* to
     567             :  * which the character belongs, chi is the character in Conrey format, ord is
     568             :  * the order */
     569             : 
     570             : static GEN
     571     1663830 : gmfcharorder(GEN CHI) { return gel(CHI, 3); }
     572             : long
     573     1628396 : mfcharorder(GEN CHI) { return itou(gmfcharorder(CHI)); }
     574             : static long
     575        9982 : mfcharistrivial(GEN CHI) { return !CHI || mfcharorder(CHI) == 1; }
     576             : static GEN
     577      872543 : gmfcharmodulus(GEN CHI) { return gmael3(CHI, 1, 1, 1); }
     578             : long
     579      872543 : mfcharmodulus(GEN CHI) { return itou(gmfcharmodulus(CHI)); }
     580             : GEN
     581      322812 : mfcharpol(GEN CHI) { return gel(CHI,4); }
     582             : 
     583             : /* vz[i+1] = image of (zeta_o)^i in Fp */
     584             : static ulong
     585      219611 : Qab_Czeta_Fl(long k, GEN vz, ulong C, ulong p)
     586             : {
     587             :   long o;
     588      219611 :   if (!k) return C;
     589      148484 :   o = lg(vz)-2;
     590      148484 :   if ((k << 1) == o) return Fl_neg(C,p);
     591      123123 :   return Fl_mul(C, vz[k+1], p);
     592             : }
     593             : 
     594             : static long
     595      885430 : znchareval_i(GEN CHI, long n, GEN ord)
     596      885430 : { return itos(znchareval(gel(CHI,1), gel(CHI,2), stoi(n), ord)); }
     597             : 
     598             : /* n coprime with the modulus of CHI */
     599             : static GEN
     600       12488 : mfchareval(GEN CHI, long n)
     601             : {
     602       12488 :   GEN Pn, C, go = gmfcharorder(CHI);
     603       12488 :   long k, o = go[2];
     604       12488 :   if (o == 1) return gen_1;
     605        5999 :   k = znchareval_i(CHI, n, go);
     606        5999 :   Pn = mfcharpol(CHI);
     607        5999 :   C = Qab_zeta(k, o, varn(Pn));
     608        5999 :   if (typ(C) != t_POL) return C;
     609        4872 :   return gmodulo(C, Pn);
     610             : }
     611             : /* d a multiple of ord(CHI); n coprime with char modulus;
     612             :  * return x s.t. CHI(n) = \zeta_d^x] */
     613             : static long
     614     1511874 : mfcharevalord(GEN CHI, long n, long d)
     615             : {
     616     1511874 :   if (mfcharorder(CHI) == 1) return 0;
     617      875735 :   return znchareval_i(CHI, n, utoi(d));
     618             : }
     619             : 
     620             : /* G a znstar, L a Conrey log: return a 'mfchar' */
     621             : static GEN
     622      371021 : mfcharGL(GEN G, GEN L)
     623             : {
     624      371021 :   GEN o = zncharorder(G,L);
     625      371021 :   long ord = itou(o), vt = fetch_user_var("t");
     626      371021 :   return mkvec4(G, L, o, polcyclo(ord,vt));
     627             : }
     628             : static GEN
     629        5033 : mfchartrivial()
     630        5033 : { return mfcharGL(znstar0(gen_1,1), cgetg(1,t_COL)); }
     631             : /* convert a generic character into an 'mfchar' */
     632             : static GEN
     633        3934 : get_mfchar(GEN CHI)
     634             : {
     635             :   GEN G, L;
     636        3934 :   if (typ(CHI) != t_VEC) CHI = znchar(CHI);
     637             :   else
     638             :   {
     639         889 :     long l = lg(CHI);
     640         889 :     if ((l != 3 && l != 5) || !checkznstar_i(gel(CHI,1)))
     641           7 :       pari_err_TYPE("checkNF [chi]", CHI);
     642         882 :     if (l == 5) return CHI;
     643             :   }
     644        3864 :   G = gel(CHI,1);
     645        3864 :   L = gel(CHI,2); if (typ(L) != t_COL) L = znconreylog(G,L);
     646        3864 :   return mfcharGL(G, L);
     647             : }
     648             : 
     649             : /* parse [N], [N,k], [N,k,CHI]. If 'joker' is set, allow wildcard for CHI */
     650             : static GEN
     651        9072 : checkCHI(GEN NK, long N, int joker)
     652             : {
     653             :   GEN CHI;
     654        9072 :   if (lg(NK) == 3)
     655         623 :     CHI = mfchartrivial();
     656             :   else
     657             :   {
     658             :     long i, l;
     659        8449 :     CHI = gel(NK,3); l = lg(CHI);
     660        8449 :     if (isintzero(CHI) && joker)
     661        4095 :       CHI = NULL; /* all character orbits */
     662        4354 :     else if (isintm1(CHI) && joker > 1)
     663        2373 :       CHI = gen_m1; /* sum over all character orbits */
     664        2114 :     else if ((typ(CHI) == t_VEC &&
     665         217 :              (l == 1 || l != 3 || !checkznstar_i(gel(CHI,1)))) && joker)
     666             :     {
     667         133 :       CHI = shallowtrans(CHI); /* list of characters */
     668         952 :       for (i = 1; i < l; i++) gel(CHI,i) = get_mfchar(gel(CHI,i));
     669             :     }
     670             :     else
     671             :     {
     672        1848 :       CHI = get_mfchar(CHI); /* single char */
     673        1848 :       if (N % mfcharmodulus(CHI)) pari_err_TYPE("checkNF [chi]", NK);
     674             :     }
     675             :   }
     676        9058 :   return CHI;
     677             : }
     678             : /* support half-integral weight */
     679             : static void
     680        9079 : checkNK2(GEN NK, long *N, long *nk, long *dk, GEN *CHI, int joker)
     681             : {
     682        9079 :   long l = lg(NK);
     683             :   GEN T;
     684        9079 :   if (typ(NK) != t_VEC || l < 3 || l > 4) pari_err_TYPE("checkNK", NK);
     685        9079 :   T = gel(NK,1); if (typ(T) != t_INT) pari_err_TYPE("checkNF [N]", NK);
     686        9079 :   *N = itos(T); if (*N <= 0) pari_err_TYPE("checkNF [N <= 0]", NK);
     687        9079 :   T = gel(NK,2);
     688        9079 :   switch(typ(T))
     689             :   {
     690        5705 :     case t_INT:  *nk = itos(T); *dk = 1; break;
     691        3367 :     case t_FRAC:
     692        3367 :       *nk = itos(gel(T,1));
     693        3367 :       *dk = itou(gel(T,2)); if (*dk == 2) break;
     694           7 :     default: pari_err_TYPE("checkNF [k]", NK);
     695             :   }
     696        9072 :   *CHI = checkCHI(NK, *N, joker);
     697        9058 : }
     698             : /* don't support half-integral weight */
     699             : static void
     700         126 : checkNK(GEN NK, long *N, long *k, GEN *CHI, int joker)
     701             : {
     702             :   long d;
     703         126 :   checkNK2(NK, N, k, &d, CHI, joker);
     704         126 :   if (d != 1) pari_err_TYPE("checkNF [k]", NK);
     705         126 : }
     706             : 
     707             : static GEN
     708        4851 : mfchargalois(long N, int odd, GEN flagorder)
     709             : {
     710        4851 :   GEN G = znstar0(utoi(N), 1), L = chargalois(G, flagorder);
     711        4851 :   long l = lg(L), i, j;
     712      112735 :   for (i = j = 1; i < l; i++)
     713             :   {
     714      107884 :     GEN chi = znconreyfromchar(G, gel(L,i));
     715      107884 :     if (zncharisodd(G,chi) == odd) gel(L,j++) = mfcharGL(G,chi);
     716             :   }
     717        4851 :   setlg(L, j); return L;
     718             : }
     719             : /* possible characters for non-trivial S_1(N, chi) */
     720             : static GEN
     721        1708 : mfwt1chars(long N, GEN vCHI)
     722             : {
     723        1708 :   if (vCHI) return vCHI; /*do not filter, user knows best*/
     724             :   /* Tate's theorem */
     725        1638 :   return mfchargalois(N, 1, uisprime(N)? mkvecsmall2(2,4): NULL);
     726             : }
     727             : static GEN
     728        3255 : mfchars(long N, long k, long dk, GEN vCHI)
     729        3255 : { return vCHI? vCHI: mfchargalois(N, (dk == 2)? 0: (k & 1), NULL); }
     730             : 
     731             : /* wrappers from mfchar to znchar */
     732             : static long
     733       66815 : mfcharparity(GEN CHI)
     734             : {
     735       66815 :   if (!CHI) return 1;
     736       66815 :   return zncharisodd(gel(CHI,1), gel(CHI,2)) ? -1 : 1;
     737             : }
     738             : /* if CHI is primitive, return CHI itself, not a copy */
     739             : static GEN
     740       71099 : mfchartoprimitive(GEN CHI, long *pF)
     741             : {
     742             :   pari_sp av;
     743             :   GEN chi, F;
     744       71099 :   if (!CHI) { if (pF) *pF = 1; return mfchartrivial(); }
     745       71099 :   av = avma; F = znconreyconductor(gel(CHI,1), gel(CHI,2), &chi);
     746       71099 :   if (typ(F) == t_INT) set_avma(av);
     747             :   else
     748             :   {
     749        7462 :     CHI = leafcopy(CHI);
     750        7462 :     gel(CHI,1) = znstar0(F, 1);
     751        7462 :     gel(CHI,2) = chi;
     752             :   }
     753       71099 :   if (pF) *pF = mfcharmodulus(CHI);
     754       71099 :   return CHI;
     755             : }
     756             : static long
     757      394317 : mfcharconductor(GEN CHI)
     758             : {
     759      394317 :   pari_sp av = avma;
     760      394317 :   GEN res = znconreyconductor(gel(CHI,1), gel(CHI,2), NULL);
     761      394317 :   if (typ(res) == t_VEC) res = gel(res, 1);
     762      394317 :   return gc_long(av, itos(res));
     763             : }
     764             : 
     765             : /*                      Operations on mf closures                    */
     766             : static GEN
     767       54271 : tagparams(long t, GEN NK) { return mkvec2(mkvecsmall(t), NK); }
     768             : static GEN
     769        1078 : lfuntag(long t, GEN x) { return mkvec2(mkvecsmall(t), x); }
     770             : static GEN
     771          56 : tag0(long t, GEN NK) { retmkvec(tagparams(t,NK)); }
     772             : static GEN
     773        9730 : tag(long t, GEN NK, GEN x) { retmkvec2(tagparams(t,NK), x); }
     774             : static GEN
     775       30632 : tag2(long t, GEN NK, GEN x, GEN y) { retmkvec3(tagparams(t,NK), x,y); }
     776             : static GEN
     777       13741 : tag3(long t, GEN NK, GEN x,GEN y,GEN z) { retmkvec4(tagparams(t,NK), x,y,z); }
     778             : static GEN
     779           0 : tag4(long t, GEN NK, GEN x,GEN y,GEN z,GEN a)
     780           0 : { retmkvec5(tagparams(t,NK), x,y,z,a); }
     781             : /* is F a "modular form" ? */
     782             : int
     783       16625 : checkmf_i(GEN F)
     784       16625 : { return typ(F) == t_VEC
     785       15995 :     && lg(F) > 1 && typ(gel(F,1)) == t_VEC
     786       11781 :     && lg(gel(F,1)) == 3
     787       11620 :     && typ(gmael(F,1,1)) == t_VECSMALL
     788       32620 :     && typ(gmael(F,1,2)) == t_VEC; }
     789      182161 : long mf_get_type(GEN F) { return gmael(F,1,1)[1]; }
     790      144697 : GEN mf_get_gN(GEN F) { return gmael3(F,1,2,1); }
     791      110222 : GEN mf_get_gk(GEN F) { return gmael3(F,1,2,2); }
     792             : /* k - 1/2, assume k in 1/2 + Z */
     793         413 : long mf_get_r(GEN F) { return itou(gel(mf_get_gk(F),1)) >> 1; }
     794       93149 : long mf_get_N(GEN F) { return itou(mf_get_gN(F)); }
     795       59234 : long mf_get_k(GEN F)
     796             : {
     797       59234 :   GEN gk = mf_get_gk(F);
     798       59234 :   if (typ(gk)!=t_INT) pari_err_IMPL("half-integral weight");
     799       59234 :   return itou(gk);
     800             : }
     801       41804 : GEN mf_get_CHI(GEN F) { return gmael3(F,1,2,3); }
     802       21007 : GEN mf_get_field(GEN F) { return gmael3(F,1,2,4); }
     803       16660 : GEN mf_get_NK(GEN F) { return gmael(F,1,2); }
     804             : static void
     805         504 : mf_setfield(GEN f, GEN P)
     806             : {
     807         504 :   gel(f,1) = leafcopy(gel(f,1));
     808         504 :   gmael(f,1,2) = leafcopy(gmael(f,1,2));
     809         504 :   gmael3(f,1,2,4) = P;
     810         504 : }
     811             : 
     812             : /* UTILITY FUNCTIONS */
     813             : GEN
     814        5831 : mftocol(GEN F, long lim, long d)
     815        5831 : { GEN c = mfcoefs_i(F, lim, d); settyp(c,t_COL); return c; }
     816             : GEN
     817        1428 : mfvectomat(GEN vF, long lim, long d)
     818             : {
     819        1428 :   long j, l = lg(vF);
     820        1428 :   GEN M = cgetg(l, t_MAT);
     821        7049 :   for (j = 1; j < l; j++) gel(M,j) = mftocol(gel(vF,j), lim, d);
     822        1428 :   return M;
     823             : }
     824             : 
     825             : static GEN
     826        4186 : RgV_to_ser_full(GEN x) { return RgV_to_ser(x, 0, lg(x)+1); }
     827             : /* TODO: delete */
     828             : static GEN
     829         560 : mfcoefsser(GEN F, long n) { return RgV_to_ser_full(mfcoefs_i(F,n,1)); }
     830             : static GEN
     831         833 : sertovecslice(GEN S, long n)
     832             : {
     833         833 :   GEN v = gtovec0(S, -(lg(S) - 2 + valp(S)));
     834         833 :   long l = lg(v), n2 = n + 2;
     835         833 :   if (l < n2) pari_err_BUG("sertovecslice [n too large]");
     836         833 :   return (l == n2)? v: vecslice(v, 1, n2-1);
     837             : }
     838             : 
     839             : /* a, b two RgV of the same length, multiply as truncated power series */
     840             : static GEN
     841        3318 : RgV_mul_RgXn(GEN a, GEN b)
     842             : {
     843        3318 :   long n = lg(a)-1;
     844             :   GEN c;
     845        3318 :   a = RgV_to_RgX(a,0);
     846        3318 :   b = RgV_to_RgX(b,0); c = RgXn_mul(a, b, n);
     847        3318 :   c = RgX_to_RgC(c,n); settyp(c,t_VEC); return c;
     848             : }
     849             : /* divide as truncated power series */
     850             : static GEN
     851         357 : RgV_div_RgXn(GEN a, GEN b)
     852             : {
     853         357 :   long n = lg(a)-1;
     854             :   GEN c;
     855         357 :   a = RgV_to_RgX(a,0);
     856         357 :   b = RgV_to_RgX(b,0); c = RgXn_mul(a, RgXn_inv(b,n), n);
     857         357 :   c = RgX_to_RgC(c,n); settyp(c,t_VEC); return c;
     858             : }
     859             : /* a^b */
     860             : static GEN
     861          84 : RgV_pows_RgXn(GEN a, long b)
     862             : {
     863          84 :   long n = lg(a)-1;
     864             :   GEN c;
     865          84 :   a = RgV_to_RgX(a,0);
     866          84 :   if (b < 0) { a = RgXn_inv(a, n); b = -b; }
     867          84 :   c = RgXn_powu_i(a,b,n);
     868          84 :   c = RgX_to_RgC(c,n); settyp(c,t_VEC); return c;
     869             : }
     870             : 
     871             : /* assume lg(V) >= n*d + 2 */
     872             : static GEN
     873        6720 : c_deflate(long n, long d, GEN v)
     874             : {
     875        6720 :   long i, id, l = n+2;
     876             :   GEN w;
     877        6720 :   if (d == 1) return lg(v) == l ? v: vecslice(v, 1, l-1);
     878         364 :   w = cgetg(l, typ(v));
     879       10283 :   for (i = id = 1; i < l; i++, id += d) gel(w, i) = gel(v, id);
     880         364 :   return w;
     881             : }
     882             : 
     883             : static void
     884          14 : err_cyclo(void)
     885          14 : { pari_err_IMPL("changing cyclotomic fields in mf"); }
     886             : /* Q(zeta_a) = Q(zeta_b) ? */
     887             : static int
     888         567 : same_cyc(long a, long b)
     889         567 : { return (a == b) || (odd(a) && b == (a<<1)) || (odd(b) && a == (b<<1)); }
     890             : /* need to combine elements in Q(CHI1) and Q(CHI2) with result in Q(CHI),
     891             :  * CHI = CHI1 * CHI2 or CHI / CHI2 times some character of order 2 */
     892             : static GEN
     893        2492 : chicompat(GEN CHI, GEN CHI1, GEN CHI2)
     894             : {
     895        2492 :   long o1 = mfcharorder(CHI1);
     896        2492 :   long o2 = mfcharorder(CHI2), O, o;
     897             :   GEN T1, T2, P, Po;
     898        2492 :   if (o1 <= 2 && o2 <= 2) return NULL;
     899         574 :   o = mfcharorder(CHI);
     900         574 :   Po = mfcharpol(CHI);
     901         574 :   P = mfcharpol(CHI1);
     902         574 :   if (o1 == o2)
     903             :   {
     904          21 :     if (o1 == o) return NULL;
     905          14 :     if (!same_cyc(o1,o)) err_cyclo();
     906           0 :     return mkvec4(P, gen_1,gen_1, Qab_trace_init(o1, o, P, Po));
     907             :   }
     908         553 :   O = ulcm(o1, o2);
     909         553 :   if (!same_cyc(O,o)) err_cyclo();
     910         553 :   if (O != o1) P = (O == o2)? mfcharpol(CHI2): polcyclo(O, varn(P));
     911         553 :   T1 = o1 <= 2? gen_1: utoipos(O / o1);
     912         553 :   T2 = o2 <= 2? gen_1: utoipos(O / o2);
     913         553 :   return mkvec4(P, T1, T2, O == o? gen_1: Qab_trace_init(O, o, P, Po));
     914             : }
     915             : /* *F a vector of cyclotomic numbers */
     916             : static void
     917           7 : compatlift(GEN *F, long o, GEN P)
     918             : {
     919             :   long i, l;
     920           7 :   GEN f = *F, g = cgetg_copy(f,&l);
     921          56 :   for (i = 1; i < l; i++)
     922             :   {
     923          49 :     GEN fi = lift_shallow(gel(f,i));
     924          49 :     gel(g,i) = gmodulo(typ(fi)==t_POL? RgX_inflate(fi,o): fi, P);
     925             :   }
     926           7 :   *F = g;
     927           7 : }
     928             : static void
     929         651 : chicompatlift(GEN T, GEN *F, GEN *G)
     930             : {
     931         651 :   long o1 = itou(gel(T,2)), o2 = itou(gel(T,3));
     932         651 :   GEN P = gel(T,1);
     933         651 :   if (o1 != 1) compatlift(F, o1, P);
     934         651 :   if (o2 != 1 && G) compatlift(G, o2, P);
     935         651 : }
     936             : static GEN
     937         651 : chicompatfix(GEN T, GEN F)
     938             : {
     939         651 :   GEN V = gel(T,4);
     940         651 :   if (typ(V) == t_VEC) F = gmodulo(QabV_tracerel(V, 0, F), gel(V,1));
     941         651 :   return F;
     942             : }
     943             : 
     944             : static GEN
     945         637 : c_mul(long n, long d, GEN S)
     946             : {
     947         637 :   pari_sp av = avma;
     948         637 :   long nd = n*d;
     949         637 :   GEN F = gel(S,2), G = gel(S,3);
     950         637 :   F = mfcoefs_i(F, nd, 1);
     951         637 :   G = mfcoefs_i(G, nd, 1);
     952         637 :   if (lg(S) == 5) chicompatlift(gel(S,4),&F,&G);
     953         637 :   F = c_deflate(n, d, RgV_mul_RgXn(F,G));
     954         637 :   if (lg(S) == 5) F = chicompatfix(gel(S,4), F);
     955         637 :   return gerepilecopy(av, F);
     956             : }
     957             : static GEN
     958          84 : c_pow(long n, long d, GEN S)
     959             : {
     960          84 :   pari_sp av = avma;
     961          84 :   long nd = n*d;
     962          84 :   GEN F = gel(S,2), a = gel(S,3), f = mfcoefs_i(F,nd,1);
     963          84 :   if (lg(S) == 5) chicompatlift(gel(S,4),&F, NULL);
     964          84 :   f = RgV_pows_RgXn(f, itos(a));
     965          84 :   f = c_deflate(n, d, f);
     966          84 :   if (lg(S) == 5) f = chicompatfix(gel(S,4), f);
     967          84 :   return gerepilecopy(av, f);
     968             : }
     969             : 
     970             : /* F * Theta */
     971             : static GEN
     972         406 : mfmultheta(GEN F)
     973             : {
     974         406 :   if (typ(mf_get_gk(F)) == t_FRAC && mf_get_type(F) == t_MF_DIV)
     975             :   {
     976         112 :     GEN T = gel(F,3); /* hopefully mfTheta() */
     977         112 :     if (mf_get_type(T) == t_MF_THETA && mf_get_N(T) == 4) return gel(F,2);
     978             :   }
     979         294 :   return mfmul(F, mfTheta(NULL));
     980             : }
     981             : 
     982             : static GEN
     983          42 : c_bracket(long n, long d, GEN S)
     984             : {
     985          42 :   pari_sp av = avma;
     986          42 :   long i, nd = n*d;
     987          42 :   GEN F = gel(S,2), G = gel(S,3), tF, tG, C, mpow, res, gk, gl;
     988          42 :   GEN VF = mfcoefs_i(F, nd, 1);
     989          42 :   GEN VG = mfcoefs_i(G, nd, 1);
     990          42 :   ulong j, m = itou(gel(S,4));
     991             : 
     992          42 :   if (!n)
     993             :   {
     994          14 :     if (m > 0) { avma = av; return mkvec(gen_0); }
     995           7 :     return gerepilecopy(av, mkvec(gmul(gel(VF, 1), gel(VG, 1))));
     996             :   }
     997          28 :   tF = cgetg(nd+2, t_VEC);
     998          28 :   tG = cgetg(nd+2, t_VEC);
     999          28 :   res = NULL; gk = mf_get_gk(F); gl = mf_get_gk(G);
    1000             :   /* pow[i,j+1] = i^j */
    1001          28 :   if (lg(S) == 6) chicompatlift(gel(S,5),&VF,&VG);
    1002          28 :   mpow = cgetg(m+2, t_MAT);
    1003          28 :   gel(mpow,1) = const_col(nd, gen_1);
    1004          56 :   for (j = 1; j <= m; j++)
    1005             :   {
    1006          28 :     GEN c = cgetg(nd+1, t_COL);
    1007          28 :     gel(mpow,j+1) = c;
    1008         245 :     for (i = 1; i <= nd; i++) gel(c,i) = muliu(gcoeff(mpow,i,j), i);
    1009             :   }
    1010          28 :   C = binomial(gaddgs(gk, m-1), m);
    1011          28 :   if (odd(m)) C = gneg(C);
    1012          84 :   for (j = 0; j <= m; j++)
    1013             :   { /* C = (-1)^(m-j) binom(m+l-1, j) binom(m+k-1,m-j) */
    1014             :     GEN c;
    1015          56 :     gel(tF,1) = j == 0? gel(VF,1): gen_0;
    1016          56 :     gel(tG,1) = j == m? gel(VG,1): gen_0;
    1017          56 :     gel(tF,2) = gel(VF,2); /* assume nd >= 1 */
    1018          56 :     gel(tG,2) = gel(VG,2);
    1019         518 :     for (i = 2; i <= nd; i++)
    1020             :     {
    1021         462 :       gel(tF, i+1) = gmul(gcoeff(mpow,i,j+1),   gel(VF, i+1));
    1022         462 :       gel(tG, i+1) = gmul(gcoeff(mpow,i,m-j+1), gel(VG, i+1));
    1023             :     }
    1024          56 :     c = gmul(C, c_deflate(n, d, RgV_mul_RgXn(tF, tG)));
    1025          56 :     res = res? gadd(res, c): c;
    1026          56 :     if (j < m)
    1027          56 :       C = gdiv(gmul(C, gmulsg(m-j, gaddgs(gl,m-j-1))),
    1028          28 :                gmulsg(-(j+1), gaddgs(gk,j)));
    1029             :   }
    1030          28 :   if (lg(S) == 6) res = chicompatfix(gel(S,5), res);
    1031          28 :   return gerepileupto(av, res);
    1032             : }
    1033             : /* linear combination \sum L[j] vecF[j] */
    1034             : static GEN
    1035        2856 : c_linear(long n, long d, GEN F, GEN L, GEN dL)
    1036             : {
    1037        2856 :   pari_sp av = avma;
    1038        2856 :   long j, l = lg(L);
    1039        2856 :   GEN S = NULL;
    1040       10143 :   for (j = 1; j < l; j++)
    1041             :   {
    1042        7287 :     GEN c = gel(L,j);
    1043        7287 :     if (gequal0(c)) continue;
    1044        6650 :     c = gmul(c, mfcoefs_i(gel(F,j), n, d));
    1045        6650 :     S = S? gadd(S,c): c;
    1046             :   }
    1047        2856 :   if (!S) return zerovec(n+1);
    1048        2856 :   if (!is_pm1(dL)) S = gdiv(S, dL);
    1049        2856 :   return gerepileupto(av, S);
    1050             : }
    1051             : 
    1052             : /* B_d(T_j Trace^new) as t_MF_BD(t_MF_HECKE(t_MF_NEWTRACE)) or
    1053             :  * t_MF_HECKE(t_MF_NEWTRACE)
    1054             :  * or t_MF_NEWTRACE in level N. Set d and j, return t_MF_NEWTRACE component*/
    1055             : static GEN
    1056       69181 : bhn_parse(GEN f, long *d, long *j)
    1057             : {
    1058       69181 :   long t = mf_get_type(f);
    1059       69181 :   *d = *j = 1;
    1060       69181 :   if (t == t_MF_BD) { *d = itos(gel(f,3)); f = gel(f,2); t = mf_get_type(f); }
    1061       69181 :   if (t == t_MF_HECKE) { *j = gel(f,2)[1]; f = gel(f,3); }
    1062       69181 :   return f;
    1063             : }
    1064             : /* f as above, return the t_MF_NEWTRACE component */
    1065             : static GEN
    1066       22022 : bhn_newtrace(GEN f)
    1067             : {
    1068       22022 :   long t = mf_get_type(f);
    1069       22022 :   if (t == t_MF_BD) { f = gel(f,2); t = mf_get_type(f); }
    1070       22022 :   if (t == t_MF_HECKE) f = gel(f,3);
    1071       22022 :   return f;
    1072             : }
    1073             : static int
    1074        3367 : ok_bhn_linear(GEN vf)
    1075             : {
    1076        3367 :   long i, N0 = 0, l = lg(vf);
    1077             :   GEN CHI, gk;
    1078        3367 :   if (l == 1) return 1;
    1079        3367 :   gk = mf_get_gk(gel(vf,1));
    1080        3367 :   CHI = mf_get_CHI(gel(vf,1));
    1081       17311 :   for (i = 1; i < l; i++)
    1082             :   {
    1083       15967 :     GEN f = bhn_newtrace(gel(vf,i));
    1084       15967 :     long N = mf_get_N(f);
    1085       15967 :     if (mf_get_type(f) != t_MF_NEWTRACE) return 0;
    1086       13944 :     if (N < N0) return 0; /* largest level must come last */
    1087       13944 :     N0 = N;
    1088       13944 :     if (!gequal(gk,mf_get_gk(f))) return 0; /* same k */
    1089       13944 :     if (!gequal(gel(mf_get_CHI(f),2), gel(CHI,2))) return 0; /* same CHI */
    1090             :   }
    1091        1344 :   return 1;
    1092             : }
    1093             : 
    1094             : /* vF not empty, same hypotheses as bhnmat_extend */
    1095             : static GEN
    1096        6139 : bhnmat_extend_nocache(GEN M, long N, long n, long d, GEN vF)
    1097             : {
    1098             :   cachenew_t cache;
    1099        6139 :   long l = lg(vF);
    1100             :   GEN f;
    1101        6139 :   if (l == 1) return M? M: cgetg(1, t_MAT);
    1102        6055 :   f = bhn_newtrace(gel(vF,1)); /* N.B. mf_get_N(f) divides N */
    1103        6055 :   init_cachenew(&cache, n*d, N, f);
    1104        6055 :   M = bhnmat_extend(M, n, d, vF, &cache);
    1105        6055 :   dbg_cachenew(&cache); return M;
    1106             : }
    1107             : /* c_linear of "bhn" mf closures, same hypotheses as bhnmat_extend */
    1108             : static GEN
    1109        1652 : c_linear_bhn(long n, long d, GEN F)
    1110             : {
    1111             :   pari_sp av;
    1112        1652 :   GEN M, v, vF = gel(F,2), L = gel(F,3), dL = gel(F,4);
    1113        1652 :   if (lg(L) == 1) return zerovec(n+1);
    1114        1652 :   av = avma;
    1115        1652 :   M = bhnmat_extend_nocache(NULL, mf_get_N(F), n, d, vF);
    1116        1652 :   v = RgM_RgC_mul(M,L); settyp(v, t_VEC);
    1117        1652 :   if (!is_pm1(dL)) v = gdiv(v, dL);
    1118        1652 :   return gerepileupto(av, v);
    1119             : }
    1120             : 
    1121             : /* c in K, K := Q[X]/(T) vz = vector of consecutive powers of root z of T
    1122             :  * attached to an embedding s: K -> C. Return s(c) in C */
    1123             : static GEN
    1124       75565 : Rg_embed1(GEN c, GEN vz)
    1125             : {
    1126       75565 :   long t = typ(c);
    1127       75565 :   if (t == t_POLMOD) { c = gel(c,2); t = typ(c); }
    1128       75565 :   if (t == t_POL) c = RgX_RgV_eval(c, vz);
    1129       75565 :   return c;
    1130             : }
    1131             : /* return s(P) in C[X] */
    1132             : static GEN
    1133         882 : RgX_embed1(GEN P, GEN vz)
    1134             : {
    1135             :   long i, l;
    1136         882 :   GEN Q = cgetg_copy(P, &l);
    1137         882 :   Q[1] = P[1];
    1138        2317 :   for (i = 2; i < l; i++) gel(Q,i) = Rg_embed1(gel(P,i), vz);
    1139         882 :   return normalizepol_lg(Q,l); /* normally a no-op */
    1140             : }
    1141             : /* return s(P) in C^n */
    1142             : static GEN
    1143         728 : vecembed1(GEN P, GEN vz)
    1144             : {
    1145             :   long i, l;
    1146         728 :   GEN Q = cgetg_copy(P, &l);
    1147       30758 :   for (i = 1; i < l; i++) gel(Q,i) = Rg_embed1(gel(P,i), vz);
    1148         728 :   return Q;
    1149             : }
    1150             : /* P in L = K[X]/(U), K = Q[t]/T; s an embedding of K -> C attached
    1151             :  * to a root of T, extended to an embedding of L -> C attached to a root
    1152             :  * of s(U); vT powers of the root of T, vU powers of the root of s(U).
    1153             :  * Return s(P) in C^n */
    1154             : static GEN
    1155       13314 : Rg_embed2(GEN P, long vt, GEN vT, GEN vU)
    1156             : {
    1157             :   long i, l;
    1158             :   GEN Q;
    1159       13314 :   P = liftpol_shallow(P);
    1160       13314 :   if (typ(P) != t_POL) return P;
    1161       13300 :   if (varn(P) == vt) return Rg_embed1(P, vT);
    1162             :   /* varn(P) == vx */
    1163       13293 :   Q = cgetg_copy(P, &l); Q[1] = P[1];
    1164       39669 :   for (i = 2; i < l; i++) gel(Q,i) = Rg_embed1(gel(P,i), vT);
    1165       13293 :   return Rg_embed1(Q, vU);
    1166             : }
    1167             : static GEN
    1168          42 : vecembed2(GEN P, long vt, GEN vT, GEN vU)
    1169             : {
    1170             :   long i, l;
    1171          42 :   GEN Q = cgetg_copy(P, &l);
    1172        1050 :   for (i = 1; i < l; i++) gel(Q,i) = Rg_embed2(gel(P,i), vt, vT, vU);
    1173          42 :   return Q;
    1174             : }
    1175             : static GEN
    1176         532 : RgX_embed2(GEN P, long vt, GEN vT, GEN vU)
    1177             : {
    1178             :   long i, l;
    1179         532 :   GEN Q = cgetg_copy(P, &l);
    1180        3724 :   for (i = 2; i < l; i++) gel(Q,i) = Rg_embed2(gel(P,i), vt, vT, vU);
    1181         532 :   Q[1] = P[1]; return normalizepol_lg(Q,l);
    1182             : }
    1183             : /* embed polynomial f in variable vx [ may be a scalar ], E from getembed */
    1184             : static GEN
    1185        1596 : RgX_embed(GEN f, long vx, GEN E)
    1186             : {
    1187             :   GEN vT;
    1188        1596 :   if (typ(f) != t_POL || varn(f) != vx) return mfembed(E, f);
    1189        1575 :   if (lg(E) == 1) return f;
    1190        1379 :   vT = gel(E,2);
    1191        1379 :   if (lg(E) == 3)
    1192         847 :     f = RgX_embed1(f, vT);
    1193             :   else
    1194         532 :     f = RgX_embed2(f, varn(gel(E,1)), vT, gel(E,3));
    1195        1379 :   return f;
    1196             : }
    1197             : /* embed vector, E from getembed */
    1198             : GEN
    1199        1617 : mfvecembed(GEN E, GEN v)
    1200             : {
    1201             :   GEN vT;
    1202        1617 :   if (lg(E) == 1) return v;
    1203         770 :   vT = gel(E,2);
    1204         770 :   if (lg(E) == 3)
    1205         728 :     v = vecembed1(v, vT);
    1206             :   else
    1207          42 :     v = vecembed2(v, varn(gel(E,1)), vT, gel(E,3));
    1208         770 :   return v;
    1209             : }
    1210             : GEN
    1211          63 : mfmatembed(GEN E, GEN f)
    1212             : {
    1213             :   long i, l;
    1214             :   GEN g;
    1215          63 :   if (lg(E) == 1) return f;
    1216          42 :   g = cgetg_copy(f, &l);
    1217         168 :   for (i = 1; i < l; i++) gel(g,i) = mfvecembed(E, gel(f,i));
    1218          42 :   return g;
    1219             : }
    1220             : /* embed vector of polynomials in var vx */
    1221             : static GEN
    1222          98 : RgXV_embed(GEN f, long vx, GEN E)
    1223             : {
    1224             :   long i, l;
    1225             :   GEN v;
    1226          98 :   if (lg(E) == 1) return f;
    1227          70 :   v = cgetg_copy(f, &l);
    1228        1358 :   for (i = 1; i < l; i++) gel(v,i) = RgX_embed(gel(f,i), vx, E);
    1229          70 :   return v;
    1230             : }
    1231             : 
    1232             : /* embed scalar */
    1233             : GEN
    1234       96580 : mfembed(GEN E, GEN f)
    1235             : {
    1236             :   GEN vT;
    1237       96580 :   if (lg(E) == 1) return f;
    1238       13538 :   vT = gel(E,2);
    1239       13538 :   if (lg(E) == 3)
    1240        4424 :     f = Rg_embed1(f, vT);
    1241             :   else
    1242        9114 :     f = Rg_embed2(f, varn(gel(E,1)), vT, gel(E,3));
    1243       13538 :   return f;
    1244             : }
    1245             : /* vector of the sigma(f), sigma in vE */
    1246             : static GEN
    1247         294 : RgX_embedall(GEN f, long vx, GEN vE)
    1248             : {
    1249         294 :   long i, l = lg(vE);
    1250         294 :   GEN v = cgetg(l, t_VEC);
    1251         602 :   for (i = 1; i < l; i++) gel(v,i) = RgX_embed(f, vx, gel(vE,i));
    1252         294 :   return l == 2? gel(v,1): v;
    1253             : }
    1254             : /* matrix whose colums are the sigma(v), sigma in vE */
    1255             : static GEN
    1256         336 : RgC_embedall(GEN v, GEN vE)
    1257             : {
    1258         336 :   long j, l = lg(vE);
    1259         336 :   GEN M = cgetg(l, t_MAT);
    1260         819 :   for (j = 1; j < l; j++) gel(M,j) = mfvecembed(gel(vE,j), v);
    1261         336 :   return M;
    1262             : }
    1263             : /* vector of the sigma(v), sigma in vE */
    1264             : static GEN
    1265        4907 : Rg_embedall_i(GEN v, GEN vE)
    1266             : {
    1267        4907 :   long j, l = lg(vE);
    1268        4907 :   GEN M = cgetg(l, t_VEC);
    1269       14735 :   for (j = 1; j < l; j++) gel(M,j) = mfembed(gel(vE,j), v);
    1270        4907 :   return M;
    1271             : }
    1272             : /* vector of the sigma(v), sigma in vE; if #vE == 1, return v */
    1273             : static GEN
    1274       90980 : Rg_embedall(GEN v, GEN vE)
    1275       90980 : { return (lg(vE) == 2)? mfembed(gel(vE,1), v): Rg_embedall_i(v, vE); }
    1276             : 
    1277             : static GEN
    1278         833 : c_div_i(long n, GEN S)
    1279             : {
    1280         833 :   GEN F = gel(S,2), G = gel(S,3);
    1281             :   GEN a0, a0i, H;
    1282         833 :   F = mfcoefs_i(F, n, 1);
    1283         833 :   G = mfcoefs_i(G, n, 1);
    1284         833 :   if (lg(S) == 5) chicompatlift(gel(S,4),&F,&G);
    1285         833 :   F = RgV_to_ser_full(F);
    1286         833 :   G = RgV_to_ser_full(G);
    1287         833 :   a0 = polcoef_i(G, 0, -1); /* != 0 */
    1288         833 :   if (gequal1(a0)) a0 = a0i = NULL;
    1289             :   else
    1290             :   {
    1291         602 :     a0i = ginv(a0);
    1292         602 :     G = gmul(ser_unscale(G,a0), a0i);
    1293         602 :     F = gmul(ser_unscale(F,a0), a0i);
    1294             :   }
    1295         833 :   H = gdiv(F, G);
    1296         833 :   if (a0) H = ser_unscale(H,a0i);
    1297         833 :   H = sertovecslice(H, n);
    1298         833 :   if (lg(S) == 5) H = chicompatfix(gel(S,4), H);
    1299         833 :   return H;
    1300             : }
    1301             : static GEN
    1302         833 : c_div(long n, long d, GEN S)
    1303             : {
    1304         833 :   pari_sp av = avma;
    1305         833 :   GEN D = (d==1)? c_div_i(n, S): c_deflate(n, d, c_div_i(n*d, S));
    1306         833 :   return gerepilecopy(av, D);
    1307             : }
    1308             : 
    1309             : static GEN
    1310          35 : c_shift(long n, long d, GEN F, GEN gsh)
    1311             : {
    1312          35 :   pari_sp av = avma;
    1313             :   GEN vF;
    1314          35 :   long sh = itos(gsh), n1 = n*d + sh;
    1315          35 :   if (n1 < 0) return zerovec(n+1);
    1316          35 :   vF = mfcoefs_i(F, n1, 1);
    1317          35 :   if (sh < 0) vF = shallowconcat(zerovec(-sh), vF);
    1318          35 :   else vF = vecslice(vF, sh+1, n1+1);
    1319          35 :   return gerepilecopy(av, c_deflate(n, d, vF));
    1320             : }
    1321             : 
    1322             : static GEN
    1323         147 : c_deriv(long n, long d, GEN F, GEN gm)
    1324             : {
    1325         147 :   pari_sp av = avma;
    1326         147 :   GEN V = mfcoefs_i(F, n, d), res;
    1327         147 :   long i, m = itos(gm);
    1328         147 :   if (!m) return V;
    1329         147 :   res = cgetg(n+2, t_VEC); gel(res,1) = gen_0;
    1330         147 :   if (m < 0)
    1331          49 :   { for (i=1; i <= n; i++) gel(res, i+1) = gdiv(gel(V, i+1), powuu(i,-m)); }
    1332             :   else
    1333        1953 :   { for (i=1; i <= n; i++) gel(res, i+1) = gmul(gel(V,i+1), powuu(i,m)); }
    1334         147 :   return gerepileupto(av, res);
    1335             : }
    1336             : 
    1337             : static GEN
    1338          14 : c_derivE2(long n, long d, GEN F, GEN gm)
    1339             : {
    1340          14 :   pari_sp av = avma;
    1341             :   GEN VF, VE, res, tmp, gk;
    1342          14 :   long i, m = itos(gm), nd;
    1343          14 :   if (m == 0) return mfcoefs_i(F, n, d);
    1344          14 :   nd = n*d;
    1345          14 :   VF = mfcoefs_i(F, nd, 1); VE = mfcoefs_i(mfEk(2), nd, 1);
    1346          14 :   gk = mf_get_gk(F);
    1347          14 :   if (m == 1)
    1348             :   {
    1349           7 :     res = cgetg(n+2, t_VEC);
    1350          56 :     for (i = 0; i <= n; i++) gel(res, i+1) = gmulsg(i, gel(VF, i*d+1));
    1351           7 :     tmp = c_deflate(n, d, RgV_mul_RgXn(VF, VE));
    1352           7 :     return gerepileupto(av, gsub(res, gmul(gdivgs(gk, 12), tmp)));
    1353             :   }
    1354             :   else
    1355             :   {
    1356             :     long j;
    1357          35 :     for (j = 1; j <= m; j++)
    1358             :     {
    1359          28 :       tmp = RgV_mul_RgXn(VF, VE);
    1360         140 :       for (i = 0; i <= nd; i++) gel(VF, i+1) = gmulsg(i, gel(VF, i+1));
    1361          28 :       VF = gsub(VF, gmul(gdivgs(gaddgs(gk, 2*(j-1)), 12), tmp));
    1362             :     }
    1363           7 :     return gerepilecopy(av, c_deflate(n, d, VF));
    1364             :   }
    1365             : }
    1366             : 
    1367             : /* Twist by the character (D/.) */
    1368             : static GEN
    1369           7 : c_twist(long n, long d, GEN F, GEN D)
    1370             : {
    1371           7 :   pari_sp av = avma;
    1372           7 :   GEN V = mfcoefs_i(F, n, d), res = cgetg(n+2, t_VEC);
    1373             :   long i;
    1374         119 :   for (i = 0; i <= n; i++)
    1375         112 :     gel(res, i + 1) = gmulsg(krois(D, i), gel(V, i+1));
    1376           7 :   return gerepileupto(av, res);
    1377             : }
    1378             : 
    1379             : /* form F given by closure, compute T(n)(F) as closure */
    1380             : static GEN
    1381         994 : c_hecke(long m, long l, GEN DATA, GEN F)
    1382             : {
    1383         994 :   pari_sp av = avma;
    1384         994 :   return gerepilecopy(av, hecke_i(m, l, NULL, F, DATA));
    1385             : }
    1386             : static GEN
    1387         140 : c_const(long n, long d, GEN C)
    1388             : {
    1389         140 :   GEN V = zerovec(n+1);
    1390         140 :   long i, j, l = lg(C);
    1391         140 :   if (l > d*n+2) l = d*n+2;
    1392         189 :   for (i = j = 1; i < l; i+=d, j++) gel(V, j) = gcopy(gel(C,i));
    1393         140 :   return V;
    1394             : }
    1395             : 
    1396             : /* m > 0 */
    1397             : static GEN
    1398         462 : eta3_ZXn(long m)
    1399             : {
    1400         462 :   long l = m+2, n, k;
    1401         462 :   GEN P = cgetg(l,t_POL);
    1402         462 :   P[1] = evalsigne(1)|evalvarn(0);
    1403        6125 :   for (n = 2; n < l; n++) gel(P,n) = gen_0;
    1404         462 :   for (n = k = 0;; n++)
    1405             :   {
    1406        2534 :     if (k + n >= m) { setlg(P, k+3); return P; }
    1407        2072 :     k += n;
    1408             :     /* now k = n(n+1) / 2 */
    1409        2072 :     gel(P, k+2) = odd(n)? utoineg(2*n+1): utoipos(2*n+1);
    1410             :   }
    1411             : }
    1412             : 
    1413             : static GEN
    1414         469 : c_delta(long n, long d)
    1415             : {
    1416         469 :   pari_sp ltop = avma;
    1417         469 :   long N = n*d;
    1418             :   GEN e;
    1419         469 :   if (!N) return mkvec(gen_0);
    1420         462 :   e = eta3_ZXn(N);
    1421         462 :   e = ZXn_sqr(e,N);
    1422         462 :   e = ZXn_sqr(e,N);
    1423         462 :   e = ZXn_sqr(e,N); /* eta(x)^24 */
    1424         462 :   settyp(e, t_VEC);
    1425         462 :   gel(e,1) = gen_0; /* Delta(x) = x*eta(x)^24 as a t_VEC */
    1426         462 :   return gerepilecopy(ltop, c_deflate(n, d, e));
    1427             : }
    1428             : 
    1429             : /* return s(d) such that s|f <=> d | f^2 */
    1430             : static long
    1431          49 : mysqrtu(ulong d)
    1432             : {
    1433          49 :   GEN fa = myfactoru(d), P = gel(fa,1), E = gel(fa,2);
    1434          49 :   long l = lg(P), i, s = 1;
    1435         126 :   for (i = 1; i < l; i++) s *= upowuu(P[i], (E[i]+1)>>1);
    1436          49 :   return s;
    1437             : }
    1438             : static GEN
    1439        1785 : c_theta(long n, long d, GEN psi)
    1440             : {
    1441        1785 :   long lim = usqrt(n*d), F = mfcharmodulus(psi), par = mfcharparity(psi);
    1442        1785 :   long f, d2 = d == 1? 1: mysqrtu(d);
    1443        1785 :   GEN V = zerovec(n + 1);
    1444        7966 :   for (f = d2; f <= lim; f += d2)
    1445        6181 :     if (ugcd(F, f) == 1)
    1446             :     {
    1447        6174 :       pari_sp av = avma;
    1448        6174 :       GEN c = mfchareval(psi, f);
    1449        6174 :       gel(V, f*f/d + 1) = gerepileupto(av, par < 0 ? gmulgs(c,2*f) : gmul2n(c,1));
    1450             :     }
    1451        1785 :   if (F == 1) gel(V, 1) = gen_1;
    1452        1785 :   return V; /* no gerepile needed */
    1453             : }
    1454             : 
    1455             : static GEN
    1456         189 : c_etaquo(long n, long d, GEN eta, GEN gs)
    1457             : {
    1458         189 :   pari_sp av = avma;
    1459         189 :   long s = itos(gs), nd = n*d, nds = nd - s + 1;
    1460             :   GEN c;
    1461         189 :   if (nds <= 0) return zerovec(n+1);
    1462         168 :   c = RgX_to_RgC(eta_product_ZXn(eta, nds), nds); settyp(c, t_VEC);
    1463         168 :   if (s > 0) c = shallowconcat(zerovec(s), c);
    1464         168 :   return gerepilecopy(av, c_deflate(n, d, c));
    1465             : }
    1466             : 
    1467             : static GEN
    1468          77 : c_ell(long n, long d, GEN E)
    1469             : {
    1470          77 :   pari_sp av = avma;
    1471             :   GEN v;
    1472          77 :   if (d == 1) return concat(gen_0, anell(E, n));
    1473           7 :   v = shallowconcat(gen_0, anell(E, n*d));
    1474           7 :   return gerepilecopy(av, c_deflate(n, d, v));
    1475             : }
    1476             : 
    1477             : static GEN
    1478          21 : c_cusptrace(long n, long d, GEN F)
    1479             : {
    1480          21 :   pari_sp av = avma;
    1481          21 :   GEN D = gel(F,2), res = cgetg(n+2, t_VEC);
    1482          21 :   long i, N = mf_get_N(F), k = mf_get_k(F);
    1483          21 :   gel(res, 1) = gen_0;
    1484         140 :   for (i = 1; i <= n; i++)
    1485         119 :     gel(res, i+1) = mfcusptrace_i(N, k, i*d, mydivisorsu(i*d), D);
    1486          21 :   return gerepilecopy(av, res);
    1487             : }
    1488             : 
    1489             : static GEN
    1490        1540 : c_newtrace(long n, long d, GEN F)
    1491             : {
    1492        1540 :   pari_sp av = avma;
    1493             :   cachenew_t cache;
    1494        1540 :   long N = mf_get_N(F);
    1495             :   GEN v;
    1496        1540 :   init_cachenew(&cache, n*d, N, F);
    1497        1540 :   v = colnewtrace(0, n, d, N, mf_get_k(F), &cache);
    1498        1540 :   settyp(v, t_VEC); return gerepilecopy(av, v);
    1499             : }
    1500             : 
    1501             : static GEN
    1502        5670 : c_Bd(long n, long d, GEN F, GEN A)
    1503             : {
    1504        5670 :   pari_sp av = avma;
    1505        5670 :   long a = itou(A), ad = ugcd(a,d), aad = a/ad, i, j;
    1506        5670 :   GEN w, v = mfcoefs_i(F, n/aad, d/ad);
    1507        5670 :   if (a == 1) return v;
    1508        5670 :   n++; w = zerovec(n);
    1509      115437 :   for (i = j = 1; j <= n; i++, j += aad) gel(w,j) = gcopy(gel(v,i));
    1510        5670 :   return gerepileupto(av, w);
    1511             : }
    1512             : 
    1513             : static GEN
    1514        3997 : c_dihedral(long n, long d, GEN bnr, GEN w, GEN k0j)
    1515             : {
    1516        3997 :   pari_sp av = avma;
    1517        3997 :   GEN V = dihan(bnr, w, k0j, n*d);
    1518        3997 :   GEN Tinit = gel(w,3), Pm = gel(Tinit,1);
    1519        3997 :   GEN A = c_deflate(n, d, V);
    1520        3997 :   if (degpol(Pm) == 1 || RgV_is_ZV(A)) return gerepilecopy(av, A);
    1521         735 :   return gerepileupto(av, gmodulo(A, Pm));
    1522             : }
    1523             : 
    1524             : static GEN
    1525         315 : c_mfEH(long n, long d, GEN F)
    1526             : {
    1527         315 :   pari_sp av = avma;
    1528             :   GEN v, M, A;
    1529         315 :   long i, r = mf_get_r(F);
    1530         315 :   if (n == 1)
    1531          14 :     return gerepilecopy(av, mkvec2(mfEHcoef(r,0),mfEHcoef(r,d)));
    1532             :   /* speedup mfcoef */
    1533         301 :   if (r == 1)
    1534             :   {
    1535          70 :     v = cgetg(n+2, t_VEC);
    1536          70 :     gel(v,1) = sstoQ(-1,12);
    1537       83258 :     for (i = 1; i <= n; i++)
    1538             :     {
    1539       83188 :       long id = i*d, a = id & 3;
    1540       83188 :       gel(v,i+1) = (a==1 || a==2)? gen_0: sstoQ(hclassno6u(id), 6);
    1541             :     }
    1542          70 :     return v; /* no gerepile needed */
    1543             :   }
    1544         231 :   M = mfEHmat(n*d+1,r);
    1545         231 :   if (d > 1)
    1546             :   {
    1547          35 :     long l = lg(M);
    1548         119 :     for (i = 1; i < l; i++) gel(M,i) = c_deflate(n, d, gel(M,i));
    1549             :   }
    1550         231 :   A = gel(F,2); /* [num(B), den(B)] */
    1551         231 :   v = RgC_Rg_div(RgM_RgC_mul(M, gel(A,1)), gel(A,2));
    1552         231 :   settyp(v,t_VEC); return gerepileupto(av, v);
    1553             : }
    1554             : 
    1555             : static GEN
    1556        8995 : c_mfeisen(long n, long d, GEN F)
    1557             : {
    1558        8995 :   pari_sp av = avma;
    1559        8995 :   GEN v, vchi, E0, P, T, CHI, gk = mf_get_gk(F);
    1560             :   long i, k;
    1561        8995 :   if (typ(gk) != t_INT) return c_mfEH(n, d, F);
    1562        8680 :   k = itou(gk);
    1563        8680 :   vchi = gel(F,2);
    1564        8680 :   E0 = gel(vchi,1);
    1565        8680 :   T = gel(vchi,2);
    1566        8680 :   P = gel(T,1);
    1567        8680 :   CHI = gel(vchi,3);
    1568        8680 :   v = cgetg(n+2, t_VEC);
    1569        8680 :   gel(v, 1) = gcopy(E0); /* E(0) */
    1570        8680 :   if (lg(vchi) == 5)
    1571             :   { /* E_k(chi1,chi2) */
    1572        6678 :     GEN CHI2 = gel(vchi,4), F3 = gel(F,3);
    1573        6678 :     long ord = F3[1], j = F3[2];
    1574      188923 :     for (i = 1; i <= n; i++) gel(v, i+1) = sigchi2(k, CHI, CHI2, i*d, ord);
    1575        6678 :     v = QabV_tracerel(T, j, v);
    1576             :   }
    1577             :   else
    1578             :   { /* E_k(chi) */
    1579       25998 :     for (i = 1; i <= n; i++) gel(v, i+1) = sigchi(k, CHI, i*d);
    1580             :   }
    1581        8680 :   if (degpol(P) != 1 && !RgV_is_QV(v)) return gerepileupto(av, gmodulo(v, P));
    1582        7007 :   return gerepilecopy(av, v);
    1583             : }
    1584             : 
    1585             : /* L(chi_D, 1-k) */
    1586             : static GEN
    1587          28 : lfunquadneg_naive(long D, long k)
    1588             : {
    1589          28 :   GEN B, dS, S = gen_0;
    1590          28 :   long r, N = labs(D);
    1591             :   pari_sp av;
    1592          28 :   if (k == 1 && N == 1) return gneg(ghalf);
    1593             :   /* B = N^k * denom(B) * B(x/N) */
    1594          28 :   B = ZX_rescale(Q_remove_denom(bernpol(k, 0), &dS), utoi(N));
    1595          28 :   dS = mul_denom(dS, stoi(-N*k));
    1596          28 :   av = avma;
    1597        7175 :   for (r = 0; r < N; r++)
    1598             :   {
    1599        7147 :     long c = kross(D, r);
    1600        7147 :     if (c)
    1601             :     {
    1602        5152 :       GEN tmp = poleval(B, utoi(r));
    1603        5152 :       S = c > 0 ? addii(S, tmp) : subii(S, tmp);
    1604        5152 :       S = gerepileuptoint(av, S);
    1605             :     }
    1606             :   }
    1607          28 :   return gdiv(S, dS);
    1608             : }
    1609             : 
    1610             : /* Returns vector of coeffs from F[0], F[d], ..., F[d*n] */
    1611             : static GEN
    1612       30758 : mfcoefs_i(GEN F, long n, long d)
    1613             : {
    1614       30758 :   if (n < 0) return gen_0;
    1615       30758 :   switch(mf_get_type(F))
    1616             :   {
    1617         140 :     case t_MF_CONST: return c_const(n, d, gel(F,2));
    1618        8995 :     case t_MF_EISEN: return c_mfeisen(n, d, F);
    1619         812 :     case t_MF_Ek: return c_Ek(n, d, F);
    1620         469 :     case t_MF_DELTA: return c_delta(n, d);
    1621        1547 :     case t_MF_THETA: return c_theta(n, d, gel(F,2));
    1622         189 :     case t_MF_ETAQUO: return c_etaquo(n, d, gel(F,2), gel(F,3));
    1623          77 :     case t_MF_ELL: return c_ell(n, d, gel(F,2));
    1624         637 :     case t_MF_MUL: return c_mul(n, d, F);
    1625          84 :     case t_MF_POW: return c_pow(n, d, F);
    1626          42 :     case t_MF_BRACKET: return c_bracket(n, d, F);
    1627        2856 :     case t_MF_LINEAR: return c_linear(n, d, gel(F,2), gel(F,3), gel(F,4));
    1628        1652 :     case t_MF_LINEAR_BHN: return c_linear_bhn(n, d, F);
    1629         833 :     case t_MF_DIV: return c_div(n, d, F);
    1630          35 :     case t_MF_SHIFT: return c_shift(n, d, gel(F,2), gel(F,3));
    1631         147 :     case t_MF_DERIV: return c_deriv(n, d, gel(F,2), gel(F,3));
    1632          14 :     case t_MF_DERIVE2: return c_derivE2(n, d, gel(F,2), gel(F,3));
    1633           7 :     case t_MF_TWIST: return c_twist(n, d, gel(F,2), gel(F,3));
    1634         994 :     case t_MF_HECKE: return c_hecke(n, d, gel(F,2), gel(F,3));
    1635        5670 :     case t_MF_BD: return c_Bd(n, d, gel(F,2), gel(F,3));
    1636          21 :     case t_MF_TRACE: return c_cusptrace(n, d, F);
    1637        1540 :     case t_MF_NEWTRACE: return c_newtrace(n, d, F);
    1638        3997 :     case t_MF_DIHEDRAL: return c_dihedral(n, d, gel(F,2), gel(F,3), gel(F,4));
    1639             :     default: pari_err_TYPE("mfcoefs",F); return NULL;/*LCOV_EXCL_LINE*/
    1640             :   }
    1641             : }
    1642             : 
    1643             : static GEN
    1644         308 : matdeflate(long n, long d, GEN M)
    1645             : {
    1646             :   long i, l;
    1647             :   GEN A;
    1648             :   /*  if (d == 1) return M; */
    1649         308 :   A = cgetg_copy(M,&l);
    1650        1204 :   for (i = 1; i < l; i++) gel(A,i) = c_deflate(n,d,gel(M,i));
    1651         308 :   return A;
    1652             : }
    1653             : static int
    1654        5607 : space_is_cusp(long space) { return space != mf_FULL && space != mf_EISEN; }
    1655             : /* safe with flraw mf */
    1656             : static GEN
    1657        2254 : mfcoefs_mf(GEN mf, long n, long d)
    1658             : {
    1659        2254 :   GEN MS, ME, E = MF_get_E(mf), S = MF_get_S(mf), M = MF_get_M(mf);
    1660        2254 :   long lE = lg(E), lS = lg(S), l = lE+lS-1;
    1661             : 
    1662        2254 :   if (l == 1) return cgetg(1, t_MAT);
    1663        2142 :   if (typ(M) == t_MAT && lg(M) != 1 && (n+1)*d < nbrows(M))
    1664          21 :     return matdeflate(n, d, M); /*cached; lg = 1 is possible from mfinit */
    1665        2121 :   ME = (lE == 1)? cgetg(1, t_MAT): mfvectomat(E, n, d);
    1666        2121 :   if (lS == 1)
    1667         399 :     MS = cgetg(1, t_MAT);
    1668        1722 :   else if (mf_get_type(gel(S,1)) == t_MF_DIV) /*k 1/2-integer or k=1 (exotic)*/
    1669         287 :     MS = matdeflate(n,d, mflineardivtomat(MF_get_N(mf), S, n*d));
    1670        1435 :   else if (MF_get_k(mf) == 1) /* k = 1 (dihedral) */
    1671             :   {
    1672         140 :     GEN M = mfvectomat(gmael(S,1,2), n, d);
    1673             :     long i;
    1674         140 :     MS = cgetg(lS, t_MAT);
    1675         448 :     for (i = 1; i < lS; i++)
    1676             :     {
    1677         308 :       GEN f = gel(S,i), dc = gel(f,4), c = RgM_RgC_mul(M, gel(f,3));
    1678         308 :       if (!equali1(dc)) c = RgC_Rg_div(c,dc);
    1679         308 :       gel(MS,i) = c;
    1680             :     }
    1681             :   }
    1682             :   else /* k >= 2 integer */
    1683        1295 :     MS = bhnmat_extend_nocache(NULL, MF_get_N(mf), n, d, S);
    1684        2121 :   return shallowconcat(ME,MS);
    1685             : }
    1686             : GEN
    1687        3731 : mfcoefs(GEN F, long n, long d)
    1688             : {
    1689        3731 :   if (!checkmf_i(F))
    1690             :   {
    1691          42 :     pari_sp av = avma;
    1692          42 :     GEN mf = checkMF_i(F); if (!mf) pari_err_TYPE("mfcoefs", F);
    1693          42 :     return gerepilecopy(av, mfcoefs_mf(mf,n,d));
    1694             :   }
    1695        3689 :   if (d <= 0) pari_err_DOMAIN("mfcoefs", "d", "<=", gen_0, stoi(d));
    1696        3689 :   if (n < 0) return cgetg(1, t_VEC);
    1697        3689 :   return mfcoefs_i(F, n, d);
    1698             : }
    1699             : 
    1700             : /* assume k >= 0 */
    1701             : static GEN
    1702         287 : mfak_i(GEN F, long k)
    1703             : {
    1704         287 :   if (!k) return gel(mfcoefs_i(F,0,1), 1);
    1705         154 :   return gel(mfcoefs_i(F,1,k), 2);
    1706             : }
    1707             : GEN
    1708         140 : mfcoef(GEN F, long n)
    1709             : {
    1710         140 :   pari_sp av = avma;
    1711         140 :   if (!checkmf_i(F)) pari_err_TYPE("mfcoef",F);
    1712         140 :   return n < 0? gen_0: gerepilecopy(av, mfak_i(F, n));
    1713             : }
    1714             : 
    1715             : static GEN
    1716         112 : paramconst() { return tagparams(t_MF_CONST, mkNK(1,0,mfchartrivial())); }
    1717             : static GEN
    1718          70 : mftrivial(void) { retmkvec2(paramconst(), cgetg(1,t_VEC)); }
    1719             : static GEN
    1720          42 : mf1(void) { retmkvec2(paramconst(), mkvec(gen_1)); }
    1721             : 
    1722             : /* induce mfchar CHI to G */
    1723             : static GEN
    1724      307237 : induce(GEN G, GEN CHI)
    1725             : {
    1726             :   GEN o, chi;
    1727      307237 :   if (typ(CHI) == t_INT) /* Kronecker */
    1728             :   {
    1729      300664 :     chi = znchar_quad(G, CHI);
    1730      300664 :     o = ZV_equal0(chi)? gen_1: gen_2;
    1731      300664 :     CHI = mkvec4(G,chi,o,cgetg(1,t_VEC));
    1732             :   }
    1733             :   else
    1734             :   {
    1735        6573 :     if (mfcharmodulus(CHI) == itos(znstar_get_N(G))) return CHI;
    1736        5999 :     CHI = leafcopy(CHI);
    1737        5999 :     chi = zncharinduce(gel(CHI,1), gel(CHI,2), G);
    1738        5999 :     gel(CHI,1) = G;
    1739        5999 :     gel(CHI,2) = chi;
    1740             :   }
    1741      306663 :   return CHI;
    1742             : }
    1743             : /* induce mfchar CHI to znstar(G) */
    1744             : static GEN
    1745       42245 : induceN(long N, GEN CHI)
    1746             : {
    1747       42245 :   if (mfcharmodulus(CHI) != N) CHI = induce(znstar0(utoipos(N),1), CHI);
    1748       42245 :   return CHI;
    1749             : }
    1750             : /* *pCHI1 and *pCHI2 are mfchar, induce to common modulus */
    1751             : static void
    1752        6048 : char2(GEN *pCHI1, GEN *pCHI2)
    1753             : {
    1754        6048 :   GEN CHI1 = *pCHI1, G1 = gel(CHI1,1), N1 = znstar_get_N(G1);
    1755        6048 :   GEN CHI2 = *pCHI2, G2 = gel(CHI2,1), N2 = znstar_get_N(G2);
    1756        6048 :   if (!equalii(N1,N2))
    1757             :   {
    1758        4543 :     GEN G, d = gcdii(N1,N2);
    1759        4543 :     if      (equalii(N2,d)) *pCHI2 = induce(G1, CHI2);
    1760        1386 :     else if (equalii(N1,d)) *pCHI1 = induce(G2, CHI1);
    1761             :     else
    1762             :     {
    1763         154 :       if (!equali1(d)) N2 = diviiexact(N2,d);
    1764         154 :       G = znstar0(mulii(N1,N2), 1);
    1765         154 :       *pCHI1 = induce(G, CHI1);
    1766         154 :       *pCHI2 = induce(G, CHI2);
    1767             :     }
    1768             :   }
    1769        6048 : }
    1770             : /* mfchar or charinit wrt same modulus; outputs a mfchar */
    1771             : static GEN
    1772      301693 : mfcharmul_i(GEN CHI1, GEN CHI2)
    1773             : {
    1774      301693 :   GEN G = gel(CHI1,1), chi3 = zncharmul(G, gel(CHI1,2), gel(CHI2,2));
    1775      301693 :   return mfcharGL(G, chi3);
    1776             : }
    1777             : /* mfchar or charinit; outputs a mfchar */
    1778             : static GEN
    1779        1036 : mfcharmul(GEN CHI1, GEN CHI2)
    1780             : {
    1781        1036 :   char2(&CHI1, &CHI2); return mfcharmul_i(CHI1,CHI2);
    1782             : }
    1783             : /* mfchar or charinit; outputs a mfchar */
    1784             : static GEN
    1785         126 : mfcharpow(GEN CHI, GEN n)
    1786             : {
    1787             :   GEN G, chi;
    1788         126 :   G = gel(CHI,1); chi = zncharpow(G, gel(CHI,2), n);
    1789         126 :   return mfchartoprimitive(mfcharGL(G, chi), NULL);
    1790             : }
    1791             : /* mfchar or charinit wrt same modulus; outputs a mfchar */
    1792             : static GEN
    1793        5012 : mfchardiv_i(GEN CHI1, GEN CHI2)
    1794             : {
    1795        5012 :   GEN G = gel(CHI1,1), chi3 = znchardiv(G, gel(CHI1,2), gel(CHI2,2));
    1796        5012 :   return mfcharGL(G, chi3);
    1797             : }
    1798             : /* mfchar or charinit; outputs a mfchar */
    1799             : static GEN
    1800        5012 : mfchardiv(GEN CHI1, GEN CHI2)
    1801             : {
    1802        5012 :   char2(&CHI1, &CHI2); return mfchardiv_i(CHI1,CHI2);
    1803             : }
    1804             : static GEN
    1805          49 : mfcharconj(GEN CHI)
    1806             : {
    1807          49 :   CHI = leafcopy(CHI);
    1808          49 :   gel(CHI,2) = zncharconj(gel(CHI,1), gel(CHI,2));
    1809          49 :   return CHI;
    1810             : }
    1811             : 
    1812             : /* CHI mfchar, assume 4 | N. Multiply CHI by \chi_{-4} */
    1813             : static GEN
    1814         882 : mfchilift(GEN CHI, long N)
    1815             : {
    1816         882 :   CHI = induceN(N, CHI);
    1817         882 :   return mfcharmul_i(CHI, induce(gel(CHI,1), stoi(-4)));
    1818             : }
    1819             : /* CHI defined mod N, N4 = N/4;
    1820             :  * if CHI is defined mod N4 return CHI;
    1821             :  * else if CHI' = CHI*(-4,.) is defined mod N4, return CHI' (primitive)
    1822             :  * else error */
    1823             : static GEN
    1824          35 : mfcharchiliftprim(GEN CHI, long N4)
    1825             : {
    1826          35 :   long FC = mfcharconductor(CHI);
    1827             :   GEN CHIP;
    1828          35 :   if (N4 % FC == 0) return CHI;
    1829          14 :   CHIP = mfchartoprimitive(mfchilift(CHI, N4 << 2), &FC);
    1830          14 :   if (N4 % FC) pari_err_TYPE("mfkohnenbasis [incorrect CHI]", CHI);
    1831          14 :   return CHIP;
    1832             : }
    1833             : /* ensure CHI(-1) = (-1)^k [k integer] or 1 [half-integer], by multiplying
    1834             :  * by (-4/.) if needed */
    1835             : static GEN
    1836        2576 : mfchiadjust(GEN CHI, GEN gk, long N)
    1837             : {
    1838        2576 :   long par = mfcharparity(CHI);
    1839        2576 :   if (typ(gk) == t_INT &&  mpodd(gk)) par = -par;
    1840        2576 :   return par == 1 ? CHI : mfchilift(CHI, N);
    1841             : }
    1842             : 
    1843             : static GEN
    1844        3654 : mfsamefield(GEN T, GEN P, GEN Q)
    1845             : {
    1846        3654 :   if (degpol(P) == 1) return Q;
    1847         602 :   if (degpol(Q) == 1) return P;
    1848         511 :   if (!gequal(P,Q)) pari_err_TYPE("mfsamefield [different fields]",mkvec2(P,Q));
    1849         504 :   if (T) err_cyclo();
    1850         504 :   return P;
    1851             : }
    1852             : 
    1853             : GEN
    1854         455 : mfmul(GEN f, GEN g)
    1855             : {
    1856         455 :   pari_sp av = avma;
    1857             :   GEN T, N, K, NK, CHI, CHIf, CHIg;
    1858         455 :   if (!checkmf_i(f)) pari_err_TYPE("mfmul",f);
    1859         455 :   if (!checkmf_i(g)) pari_err_TYPE("mfmul",g);
    1860         455 :   N = lcmii(mf_get_gN(f), mf_get_gN(g));
    1861         455 :   K = gadd(mf_get_gk(f), mf_get_gk(g));
    1862         455 :   CHIf = mf_get_CHI(f);
    1863         455 :   CHIg = mf_get_CHI(g);
    1864         455 :   CHI = mfchiadjust(mfcharmul(CHIf,CHIg), K, itos(N));
    1865         455 :   T = chicompat(CHI, CHIf, CHIg);
    1866         455 :   NK = mkgNK(N, K, CHI, mfsamefield(T, mf_get_field(f), mf_get_field(g)));
    1867         448 :   return gerepilecopy(av, T? tag3(t_MF_MUL,NK,f,g,T): tag2(t_MF_MUL,NK,f,g));
    1868             : }
    1869             : GEN
    1870          63 : mfpow(GEN f, long n)
    1871             : {
    1872          63 :   pari_sp av = avma;
    1873             :   GEN T, KK, NK, gn, CHI, CHIf;
    1874          63 :   if (!checkmf_i(f)) pari_err_TYPE("mfpow",f);
    1875          63 :   if (!n) return mf1();
    1876          63 :   if (n == 1) return gcopy(f);
    1877          63 :   KK = gmulsg(n,mf_get_gk(f));
    1878          63 :   gn = stoi(n);
    1879          63 :   CHIf = mf_get_CHI(f);
    1880          63 :   CHI = mfchiadjust(mfcharpow(CHIf,gn), KK, mf_get_N(f));
    1881          63 :   T = chicompat(CHI, CHIf, CHIf);
    1882          56 :   NK = mkgNK(mf_get_gN(f), KK, CHI, mf_get_field(f));
    1883          56 :   return gerepilecopy(av, T? tag3(t_MF_POW,NK,f,gn,T): tag2(t_MF_POW,NK,f,gn));
    1884             : }
    1885             : GEN
    1886          28 : mfbracket(GEN f, GEN g, long m)
    1887             : {
    1888          28 :   pari_sp av = avma;
    1889             :   GEN T, N, K, NK, CHI, CHIf, CHIg;
    1890          28 :   if (!checkmf_i(f)) pari_err_TYPE("mfbracket",f);
    1891          28 :   if (!checkmf_i(g)) pari_err_TYPE("mfbracket",g);
    1892          28 :   if (m < 0) pari_err_TYPE("mfbracket [m<0]",stoi(m));
    1893          28 :   K = gaddgs(gadd(mf_get_gk(f), mf_get_gk(g)), 2*m);
    1894          28 :   if (gsigne(K) < 0) pari_err_IMPL("mfbracket for this form");
    1895          28 :   N = lcmii(mf_get_gN(f), mf_get_gN(g));
    1896          28 :   CHIf = mf_get_CHI(f);
    1897          28 :   CHIg = mf_get_CHI(g);
    1898          28 :   CHI = mfcharmul(CHIf, CHIg);
    1899          28 :   CHI = mfchiadjust(CHI, K, itou(N));
    1900          28 :   T = chicompat(CHI, CHIf, CHIg);
    1901          28 :   NK = mkgNK(N, K, CHI, mfsamefield(T, mf_get_field(f), mf_get_field(g)));
    1902          56 :   return gerepilecopy(av, T? tag4(t_MF_BRACKET, NK, f, g, utoi(m), T)
    1903          28 :                            : tag3(t_MF_BRACKET, NK, f, g, utoi(m)));
    1904             : }
    1905             : 
    1906             : /* remove 0 entries in L */
    1907             : static int
    1908        1253 : mflinear_strip(GEN *pF, GEN *pL)
    1909             : {
    1910        1253 :   pari_sp av = avma;
    1911        1253 :   GEN F = *pF, L = *pL;
    1912        1253 :   long i, j, l = lg(L);
    1913        1253 :   GEN F2 = cgetg(l, t_VEC), L2 = cgetg(l, t_VEC);
    1914        7679 :   for (i = j = 1; i < l; i++)
    1915             :   {
    1916        6426 :     if (gequal0(gel(L,i))) continue;
    1917        3626 :     gel(F2,j) = gel(F,i);
    1918        3626 :     gel(L2,j) = gel(L,i); j++;
    1919             :   }
    1920        1253 :   if (j == l) set_avma(av);
    1921             :   else
    1922             :   {
    1923         371 :     setlg(F2,j); *pF = F2;
    1924         371 :     setlg(L2,j); *pL = L2;
    1925             :   }
    1926        1253 :   return (j > 1);
    1927             : }
    1928             : static GEN
    1929        5544 : taglinear_i(long t, GEN NK, GEN F, GEN L)
    1930             : {
    1931             :   GEN dL;
    1932        5544 :   L = Q_remove_denom(L, &dL); if (!dL) dL = gen_1;
    1933        5544 :   return tag3(t, NK, F, L, dL);
    1934             : }
    1935             : static GEN
    1936        2268 : taglinear(GEN NK, GEN F, GEN L)
    1937             : {
    1938        2268 :   long t = ok_bhn_linear(F)? t_MF_LINEAR_BHN: t_MF_LINEAR;
    1939        2268 :    return taglinear_i(t, NK, F, L);
    1940             : }
    1941             : /* assume F has parameters NK = [N,K,CHI] */
    1942             : static GEN
    1943         294 : mflinear_i(GEN NK, GEN F, GEN L)
    1944             : {
    1945         294 :   if (!mflinear_strip(&F,&L)) return mftrivial();
    1946         294 :   return taglinear(NK, F,L);
    1947             : }
    1948             : static GEN
    1949         511 : mflinear_bhn(GEN mf, GEN L)
    1950             : {
    1951             :   long i, l;
    1952         511 :   GEN P, NK, F = MF_get_S(mf);
    1953         511 :   if (!mflinear_strip(&F,&L)) return mftrivial();
    1954         504 :   l = lg(L); P = pol_x(1);
    1955        2653 :   for (i = 1; i < l; i++)
    1956             :   {
    1957        2149 :     GEN c = gel(L,i);
    1958        2149 :     if (typ(c) == t_POLMOD && varn(gel(c,1)) == 1)
    1959         518 :       P = mfsamefield(NULL, P, gel(c,1));
    1960             :   }
    1961         504 :   NK = mkgNK(MF_get_gN(mf), MF_get_gk(mf), MF_get_CHI(mf), P);
    1962         504 :   return taglinear_i(t_MF_LINEAR_BHN,  NK, F,L);
    1963             : }
    1964             : 
    1965             : /* F vector of forms with same weight and character but varying level, return
    1966             :  * global [N,k,chi,P] */
    1967             : static GEN
    1968        2821 : vecmfNK(GEN F)
    1969             : {
    1970        2821 :   long i, l = lg(F);
    1971             :   GEN N, f;
    1972        2821 :   if (l == 1) return mkNK(1, 0, mfchartrivial());
    1973        2821 :   f = gel(F,1); N = mf_get_gN(f);
    1974       34489 :   for (i = 2; i < l; i++) N = lcmii(N, mf_get_gN(gel(F,i)));
    1975        2821 :   return mkgNK(N, mf_get_gk(f), mf_get_CHI(f), mf_get_field(f));
    1976             : }
    1977             : /* do not use mflinear: mflineardivtomat rely on F being constant across the
    1978             :  * basis where mflinear strips the ones matched by 0 coeffs. Assume k and CHI
    1979             :  * constant, N is allowed to vary. */
    1980             : static GEN
    1981        1099 : vecmflinear(GEN F, GEN C)
    1982             : {
    1983        1099 :   long i, t, l = lg(C);
    1984        1099 :   GEN NK, v = cgetg(l, t_VEC);
    1985        1099 :   if (l == 1) return v;
    1986        1099 :   t = ok_bhn_linear(F)? t_MF_LINEAR_BHN: t_MF_LINEAR;
    1987        1099 :   NK = vecmfNK(F);
    1988        3871 :   for (i = 1; i < l; i++) gel(v,i) = taglinear_i(t, NK, F, gel(C,i));
    1989        1099 :   return v;
    1990             : }
    1991             : /* vecmflinear(F,C), then divide everything by E, which has valuation 0 */
    1992             : static GEN
    1993         371 : vecmflineardiv0(GEN F, GEN C, GEN E)
    1994             : {
    1995         371 :   GEN v = vecmflinear(F, C);
    1996         371 :   long i, l = lg(v);
    1997         371 :   if (l == 1) return v;
    1998         371 :   gel(v,1) = mfdiv_val(gel(v,1), E, 0);
    1999        1456 :   for (i = 2; i < l; i++)
    2000             :   { /* v[i] /= E */
    2001        1085 :     GEN f = shallowcopy(gel(v,1));
    2002        1085 :     gel(f,2) = gel(v,i);
    2003        1085 :     gel(v,i) = f;
    2004             :   }
    2005         371 :   return v;
    2006             : }
    2007             : 
    2008             : /* Non empty linear combination of linear combinations of same
    2009             :  * F_j=\sum_i \mu_{i,j}G_i so R = \sum_i (\sum_j(\la_j\mu_{i,j})) G_i */
    2010             : static GEN
    2011        1722 : mflinear_linear(GEN F, GEN L, int strip)
    2012             : {
    2013        1722 :   long l = lg(F), j;
    2014        1722 :   GEN vF, M = cgetg(l, t_MAT);
    2015        1722 :   L = shallowcopy(L);
    2016       16842 :   for (j = 1; j < l; j++)
    2017             :   {
    2018       15120 :     GEN f = gel(F,j), c = gel(f,3), d = gel(f,4);
    2019       15120 :     if (typ(c) == t_VEC) c = shallowtrans(c);
    2020       15120 :     if (!isint1(d)) gel(L,j) = gdiv(gel(L,j),d);
    2021       15120 :     gel(M,j) = c;
    2022             :   }
    2023        1722 :   vF = gmael(F,1,2); L = RgM_RgC_mul(M,L);
    2024        1722 :   if (strip && !mflinear_strip(&vF,&L)) return mftrivial();
    2025        1722 :   return taglinear(vecmfNK(vF), vF, L);
    2026             : }
    2027             : /* F non-empty vector of forms of the form mfdiv(mflinear(B,v), E) where E
    2028             :  * does not vanish at oo, or mflinear(B,v). Apply mflinear(F, L) */
    2029             : static GEN
    2030        1722 : mflineardiv_linear(GEN F, GEN L, int strip)
    2031             : {
    2032        1722 :   long l = lg(F), j;
    2033             :   GEN v, E, f;
    2034        1722 :   if (lg(L) != l) pari_err_DIM("mflineardiv_linear");
    2035        1722 :   f = gel(F,1); /* l > 1 */
    2036        1722 :   if (mf_get_type(f) != t_MF_DIV) return mflinear_linear(F,L,strip);
    2037        1547 :   E = gel(f,3);
    2038        1547 :   v = cgetg(l, t_VEC);
    2039       16303 :   for (j = 1; j < l; j++) { GEN f = gel(F,j); gel(v,j) = gel(f,2); }
    2040        1547 :   return mfdiv_val(mflinear_linear(v,L,strip), E, 0);
    2041             : }
    2042             : static GEN
    2043         434 : vecmflineardiv_linear(GEN F, GEN M)
    2044             : {
    2045         434 :   long i, l = lg(M);
    2046         434 :   GEN v = cgetg(l, t_VEC);
    2047        1792 :   for (i = 1; i < l; i++) gel(v,i) = mflineardiv_linear(F, gel(M,i), 0);
    2048         434 :   return v;
    2049             : }
    2050             : 
    2051             : static GEN
    2052         623 : tobasis(GEN mf, GEN F, GEN L)
    2053             : {
    2054         623 :   if (checkmf_i(L) && mf) return mftobasis(mf, L, 0);
    2055         616 :   if (typ(F) != t_VEC) pari_err_TYPE("mflinear",F);
    2056         616 :   if (!is_vec_t(typ(L))) pari_err_TYPE("mflinear",L);
    2057         616 :   if (lg(L) != lg(F)) pari_err_DIM("mflinear");
    2058         616 :   return L;
    2059             : }
    2060             : GEN
    2061         665 : mflinear(GEN F, GEN L)
    2062             : {
    2063         665 :   pari_sp av = avma;
    2064         665 :   GEN G, NK, P, mf = checkMF_i(F), N = NULL, K = NULL, CHI = NULL;
    2065             :   long i, l;
    2066         665 :   if (mf)
    2067             :   {
    2068         525 :     GEN gk = MF_get_gk(mf);
    2069         525 :     F = MF_get_basis(F);
    2070         525 :     if (typ(gk) != t_INT)
    2071          42 :       return gerepilecopy(av, mflineardiv_linear(F, L, 1));
    2072         483 :     if (itou(gk) > 1 && space_is_cusp(MF_get_space(mf)))
    2073             :     {
    2074         266 :       L = tobasis(mf, F, L);
    2075         266 :       return gerepilecopy(av, mflinear_bhn(mf, L));
    2076             :     }
    2077             :   }
    2078         357 :   L = tobasis(mf, F, L);
    2079         357 :   if (!mflinear_strip(&F,&L)) return mftrivial();
    2080             : 
    2081         350 :   l = lg(F);
    2082         350 :   if (l == 2 && gequal1(gel(L,1))) return gerepilecopy(av, gel(F,1));
    2083         266 :   P = pol_x(1);
    2084         854 :   for (i = 1; i < l; i++)
    2085             :   {
    2086         595 :     GEN f = gel(F,i), c = gel(L,i), Ni, Ki;
    2087         595 :     if (!checkmf_i(f)) pari_err_TYPE("mflinear", f);
    2088         595 :     Ni = mf_get_gN(f); N = N? lcmii(N, Ni): Ni;
    2089         595 :     Ki = mf_get_gk(f);
    2090         595 :     if (!K) K = Ki;
    2091         329 :     else if (!gequal(K, Ki))
    2092           7 :       pari_err_TYPE("mflinear [different weights]", mkvec2(K,Ki));
    2093         588 :     P = mfsamefield(NULL, P, mf_get_field(f));
    2094         588 :     if (typ(c) == t_POLMOD && varn(gel(c,1)) == 1)
    2095         126 :       P = mfsamefield(NULL, P, gel(c,1));
    2096             :   }
    2097         259 :   G = znstar0(N,1);
    2098         833 :   for (i = 1; i < l; i++)
    2099             :   {
    2100         581 :     GEN CHI2 = mf_get_CHI(gel(F,i));
    2101         581 :     CHI2 = induce(G, CHI2);
    2102         581 :     if (!CHI) CHI = CHI2;
    2103         322 :     else if (!gequal(CHI, CHI2))
    2104           7 :       pari_err_TYPE("mflinear [different characters]", mkvec2(CHI,CHI2));
    2105             :   }
    2106         252 :   NK = mkgNK(N, K, CHI, P);
    2107         252 :   return gerepilecopy(av, taglinear(NK,F,L));
    2108             : }
    2109             : 
    2110             : GEN
    2111          42 : mfshift(GEN F, long sh)
    2112             : {
    2113          42 :   pari_sp av = avma;
    2114          42 :   if (!checkmf_i(F)) pari_err_TYPE("mfshift",F);
    2115          42 :   return gerepilecopy(av, tag2(t_MF_SHIFT, mf_get_NK(F), F, stoi(sh)));
    2116             : }
    2117             : static long
    2118          49 : mfval(GEN F)
    2119             : {
    2120          49 :   pari_sp av = avma;
    2121          49 :   long i = 0, n, sb;
    2122             :   GEN gk, gN;
    2123          49 :   if (!checkmf_i(F)) pari_err_TYPE("mfval", F);
    2124          49 :   gN = mf_get_gN(F);
    2125          49 :   gk = mf_get_gk(F);
    2126          49 :   sb = mfsturmNgk(itou(gN), gk);
    2127          70 :   for (n = 1; n <= sb;)
    2128             :   {
    2129             :     GEN v;
    2130          63 :     if (n > 0.5*sb) n = sb+1;
    2131          63 :     v = mfcoefs_i(F, n, 1);
    2132         119 :     for (; i <= n; i++)
    2133          98 :       if (!gequal0(gel(v, i+1))) return gc_long(av,i);
    2134          21 :     n <<= 1;
    2135             :   }
    2136           7 :   return gc_long(av,-1);
    2137             : }
    2138             : 
    2139             : GEN
    2140        1946 : mfdiv_val(GEN f, GEN g, long vg)
    2141             : {
    2142             :   GEN T, N, K, NK, CHI, CHIf, CHIg;
    2143        1946 :   if (vg) { f = mfshift(f,vg); g = mfshift(g,vg); }
    2144        1946 :   N = lcmii(mf_get_gN(f), mf_get_gN(g));
    2145        1946 :   K = gsub(mf_get_gk(f), mf_get_gk(g));
    2146        1946 :   CHIf = mf_get_CHI(f);
    2147        1946 :   CHIg = mf_get_CHI(g);
    2148        1946 :   CHI = mfchiadjust(mfchardiv(CHIf, CHIg), K, itos(N));
    2149        1946 :   T = chicompat(CHI, CHIf, CHIg);
    2150        1939 :   NK = mkgNK(N, K, CHI, mfsamefield(T, mf_get_field(f), mf_get_field(g)));
    2151        1939 :   return T? tag3(t_MF_DIV, NK, f, g, T): tag2(t_MF_DIV, NK, f, g);
    2152             : }
    2153             : GEN
    2154          49 : mfdiv(GEN F, GEN G)
    2155             : {
    2156          49 :   pari_sp av = avma;
    2157          49 :   long v = mfval(G);
    2158          49 :   if (!checkmf_i(F)) pari_err_TYPE("mfdiv", F);
    2159          42 :   if (v < 0 || (v && !gequal0(mfcoefs(F, v-1, 1))))
    2160          14 :     pari_err_DOMAIN("mfdiv", "ord(G)", ">", strtoGENstr("ord(F)"),
    2161             :                     mkvec2(F, G));
    2162          28 :   return gerepilecopy(av, mfdiv_val(F, G, v));
    2163             : }
    2164             : GEN
    2165         154 : mfderiv(GEN F, long m)
    2166             : {
    2167         154 :   pari_sp av = avma;
    2168             :   GEN NK, gk;
    2169         154 :   if (!checkmf_i(F)) pari_err_TYPE("mfderiv",F);
    2170         154 :   gk = gaddgs(mf_get_gk(F), 2*m);
    2171         154 :   NK = mkgNK(mf_get_gN(F), gk, mf_get_CHI(F), mf_get_field(F));
    2172         154 :   return gerepilecopy(av, tag2(t_MF_DERIV, NK, F, stoi(m)));
    2173             : }
    2174             : GEN
    2175          21 : mfderivE2(GEN F, long m)
    2176             : {
    2177          21 :   pari_sp av = avma;
    2178             :   GEN NK, gk;
    2179          21 :   if (!checkmf_i(F)) pari_err_TYPE("mfderivE2",F);
    2180          21 :   if (m < 0) pari_err_DOMAIN("mfderivE2","m","<",gen_0,stoi(m));
    2181          21 :   gk = gaddgs(mf_get_gk(F), 2*m);
    2182          21 :   NK = mkgNK(mf_get_gN(F), gk, mf_get_CHI(F), mf_get_field(F));
    2183          21 :   return gerepilecopy(av, tag2(t_MF_DERIVE2, NK, F, stoi(m)));
    2184             : }
    2185             : 
    2186             : GEN
    2187          14 : mftwist(GEN F, GEN D)
    2188             : {
    2189          14 :   pari_sp av = avma;
    2190             :   GEN NK, CHI, NT, Da;
    2191             :   long q;
    2192          14 :   if (!checkmf_i(F)) pari_err_TYPE("mftwist", F);
    2193          14 :   if (typ(D) != t_INT) pari_err_TYPE("mftwist", D);
    2194          14 :   Da = mpabs_shallow(D);
    2195          14 :   CHI = mf_get_CHI(F); q = mfcharconductor(CHI);
    2196          14 :   NT = glcm(glcm(mf_get_gN(F), mulsi(q, Da)), sqri(Da));
    2197          14 :   NK = mkgNK(NT, mf_get_gk(F), CHI, mf_get_field(F));
    2198          14 :   return gerepilecopy(av, tag2(t_MF_TWIST, NK, F, D));
    2199             : }
    2200             : 
    2201             : /***************************************************************/
    2202             : /*                 Generic cache handling                      */
    2203             : /***************************************************************/
    2204             : enum { cache_FACT, cache_DIV, cache_H, cache_D, cache_DIH };
    2205             : typedef struct {
    2206             :   const char *name;
    2207             :   GEN cache;
    2208             :   ulong minself, maxself;
    2209             :   void (*init)(long);
    2210             :   ulong miss, maxmiss;
    2211             :   long compressed;
    2212             : } cache;
    2213             : 
    2214             : static void constfact(long lim);
    2215             : static void constdiv(long lim);
    2216             : static void consttabh(long lim);
    2217             : static void consttabdihedral(long lim);
    2218             : static void constcoredisc(long lim);
    2219             : static THREAD cache caches[] = {
    2220             : { "Factors",  NULL,  50000,    50000, &constfact, 0, 0, 0 },
    2221             : { "Divisors", NULL,  50000,    50000, &constdiv, 0, 0, 0 },
    2222             : { "H",        NULL, 100000, 10000000, &consttabh, 0, 0, 1 },
    2223             : { "CorediscF",NULL, 100000, 10000000, &constcoredisc, 0, 0, 0 },
    2224             : { "Dihedral", NULL,   1000,     3000, &consttabdihedral, 0, 0, 0 },
    2225             : };
    2226             : 
    2227             : static void
    2228         399 : cache_reset(long id) { caches[id].miss = caches[id].maxmiss = 0; }
    2229             : static void
    2230        8165 : cache_delete(long id) { guncloneNULL(caches[id].cache); }
    2231             : static void
    2232         413 : cache_set(long id, GEN S)
    2233             : {
    2234         413 :   GEN old = caches[id].cache;
    2235         413 :   caches[id].cache = gclone(S);
    2236         413 :   guncloneNULL(old);
    2237         413 : }
    2238             : 
    2239             : /* handle a cache miss: store stats, possibly reset table; return value
    2240             :  * if (now) cached; return NULL on failure. HACK: some caches contain an
    2241             :  * ulong where the 0 value is impossible, and return it (typecast to GEN) */
    2242             : static GEN
    2243   221502696 : cache_get(long id, ulong D)
    2244             : {
    2245   221502696 :   cache *S = &caches[id];
    2246   221502696 :   const ulong d = S->compressed? D>>1: D;
    2247             :   ulong max, l;
    2248             : 
    2249   221502696 :   if (!S->cache)
    2250             :   {
    2251         266 :     max = maxuu(minuu(D, S->maxself), S->minself);
    2252         266 :     S->init(max);
    2253         266 :     l = lg(S->cache);
    2254             :   }
    2255             :   else
    2256             :   {
    2257   221502430 :     l = lg(S->cache);
    2258   221502430 :     if (l <= d)
    2259             :     {
    2260         994 :       if (D > S->maxmiss) S->maxmiss = D;
    2261         994 :       if (DEBUGLEVEL >= 3)
    2262           0 :         err_printf("miss in cache %s: %lu, max = %lu\n",
    2263             :                    S->name, D, S->maxmiss);
    2264         994 :       if (S->miss++ >= 5 && D < S->maxself)
    2265             :       {
    2266          84 :         max = minuu(S->maxself, (long)(S->maxmiss * 1.2));
    2267          84 :         if (max <= S->maxself)
    2268             :         {
    2269          84 :           if (DEBUGLEVEL >= 3)
    2270           0 :             err_printf("resetting cache %s to %lu\n", S->name, max);
    2271          84 :           S->init(max); l = lg(S->cache);
    2272             :         }
    2273             :       }
    2274             :     }
    2275             :   }
    2276   221502696 :   return (l <= d)? NULL: gel(S->cache, d);
    2277             : }
    2278             : static GEN
    2279          70 : cache_report(long id)
    2280             : {
    2281          70 :   cache *S = &caches[id];
    2282          70 :   GEN v = zerocol(5);
    2283          70 :   gel(v,1) = strtoGENstr(S->name);
    2284          70 :   if (S->cache)
    2285             :   {
    2286          35 :     gel(v,2) = utoi(lg(S->cache)-1);
    2287          35 :     gel(v,3) = utoi(S->miss);
    2288          35 :     gel(v,4) = utoi(S->maxmiss);
    2289          35 :     gel(v,5) = utoi(gsizebyte(S->cache));
    2290             :   }
    2291          70 :   return v;
    2292             : }
    2293             : GEN
    2294          14 : getcache(void)
    2295             : {
    2296          14 :   pari_sp av = avma;
    2297          14 :   GEN M = cgetg(6, t_MAT);
    2298          14 :   gel(M,1) = cache_report(cache_FACT);
    2299          14 :   gel(M,2) = cache_report(cache_DIV);
    2300          14 :   gel(M,3) = cache_report(cache_H);
    2301          14 :   gel(M,4) = cache_report(cache_D);
    2302          14 :   gel(M,5) = cache_report(cache_DIH);
    2303          14 :   return gerepilecopy(av, shallowtrans(M));
    2304             : }
    2305             : 
    2306             : void
    2307        1633 : pari_close_mf(void)
    2308             : {
    2309        1633 :   cache_delete(cache_FACT);
    2310        1633 :   cache_delete(cache_DIV);
    2311        1633 :   cache_delete(cache_H);
    2312        1633 :   cache_delete(cache_D);
    2313        1633 :   cache_delete(cache_DIH);
    2314        1633 : }
    2315             : 
    2316             : /*************************************************************************/
    2317             : /* a odd, update local cache (recycle memory) */
    2318             : static GEN
    2319        2032 : update_factor_cache(long a, long lim, long *pb)
    2320             : {
    2321        2032 :   const long step = 16000; /* even; don't increase this: RAM cache thrashing */
    2322        2032 :   if (a + 2*step > lim)
    2323         224 :     *pb = lim; /* fuse last 2 chunks */
    2324             :   else
    2325        1808 :     *pb = a + step;
    2326        2032 :   return vecfactoroddu_i(a, *pb);
    2327             : }
    2328             : /* assume lim < MAX_LONG/8 */
    2329             : static void
    2330          77 : constcoredisc(long lim)
    2331             : {
    2332          77 :   pari_sp av2, av = avma;
    2333          77 :   GEN D = caches[cache_D].cache, CACHE = NULL;
    2334          77 :   long cachea, cacheb, N, LIM = !D ? 4 : lg(D)-1;
    2335          77 :   if (lim <= 0) lim = 5;
    2336          77 :   if (lim <= LIM) return;
    2337          77 :   cache_reset(cache_D);
    2338          77 :   D = zero_zv(lim);
    2339          77 :   av2 = avma;
    2340          77 :   cachea = cacheb = 0;
    2341     8253336 :   for (N = 1; N <= lim; N+=2)
    2342             :   { /* N odd */
    2343             :     long i, d, d2;
    2344             :     GEN F;
    2345     8253259 :     if (N > cacheb)
    2346             :     {
    2347        1008 :       set_avma(av2); cachea = N;
    2348        1008 :       CACHE = update_factor_cache(N, lim, &cacheb);
    2349             :     }
    2350     8253259 :     F = gel(CACHE, ((N-cachea)>>1)+1); /* factoru(N) */
    2351     8253259 :     D[N] = d = corediscs_fact(F); /* = 3 mod 4 or 4 mod 16 */
    2352     8253259 :     d2 = odd(d)? d<<3: d<<1;
    2353     8253259 :     for (i = 1;;)
    2354             :     {
    2355    11004329 :       if ((N << i) > lim) break;
    2356     5502160 :       D[N<<i] = d2; i++;
    2357     5502160 :       if ((N << i) > lim) break;
    2358     2751070 :       D[N<<i] = d; i++;
    2359             :     }
    2360             :   }
    2361          77 :   cache_set(cache_D, D);
    2362          77 :   set_avma(av);
    2363             : }
    2364             : 
    2365             : static void
    2366         112 : constfact(long lim)
    2367             : {
    2368             :   pari_sp av;
    2369         112 :   GEN VFACT = caches[cache_FACT].cache;
    2370         112 :   long LIM = VFACT? lg(VFACT)-1: 4;
    2371         112 :   if (lim <= 0) lim = 5;
    2372         112 :   if (lim <= LIM) return;
    2373          91 :   cache_reset(cache_FACT); av = avma;
    2374          91 :   cache_set(cache_FACT, vecfactoru_i(1,lim)); set_avma(av);
    2375             : }
    2376             : static void
    2377          84 : constdiv(long lim)
    2378             : {
    2379             :   pari_sp av;
    2380          84 :   GEN VFACT, VDIV = caches[cache_DIV].cache;
    2381          84 :   long N, LIM = VDIV? lg(VDIV)-1: 4;
    2382          84 :   if (lim <= 0) lim = 5;
    2383          84 :   if (lim <= LIM) return;
    2384          84 :   constfact(lim);
    2385          84 :   VFACT = caches[cache_FACT].cache;
    2386          84 :   cache_reset(cache_DIV); av = avma;
    2387          84 :   VDIV  = cgetg(lim+1, t_VEC);
    2388     4200084 :   for (N = 1; N <= lim; N++) gel(VDIV,N) = divisorsu_fact(gel(VFACT,N));
    2389          84 :   cache_set(cache_DIV, VDIV); set_avma(av);
    2390             : }
    2391             : 
    2392             : /* n > 1, D = divisors(n); sets L = 2*lambda(n), S = sigma(n) */
    2393             : static void
    2394    10567586 : lamsig(GEN D, long *pL, long *pS)
    2395             : {
    2396    10567586 :   pari_sp av = avma;
    2397    10567586 :   long i, l = lg(D), L = 1, S = D[l-1]+1;
    2398    37807024 :   for (i = 2; i < l; i++) /* skip d = 1 */
    2399             :   {
    2400    37807024 :     long d = D[i], nd = D[l-i]; /* nd = n/d */
    2401    37807024 :     if (d < nd) { L += d; S += d + nd; }
    2402             :     else
    2403             :     {
    2404    10567586 :       L <<= 1; if (d == nd) { L += d; S += d; }
    2405    10567586 :       break;
    2406             :     }
    2407             :   }
    2408    10567586 :   set_avma(av); *pL = L; *pS = S;
    2409    10567586 : }
    2410             : /* table of 6 * Hurwitz class numbers D <= lim */
    2411             : static void
    2412         147 : consttabh(long lim)
    2413             : {
    2414         147 :   pari_sp av = avma, av2;
    2415         147 :   GEN VHDH0, VDIV, CACHE = NULL;
    2416         147 :   GEN VHDH = caches[cache_H].cache;
    2417         147 :   long r, N, cachea, cacheb, lim0 = VHDH? lg(VHDH)-1: 2, LIM = lim0 << 1;
    2418             : 
    2419         147 :   if (lim <= 0) lim = 5;
    2420         147 :   if (lim <= LIM) return;
    2421         147 :   cache_reset(cache_H);
    2422         147 :   r = lim&3L; if (r) lim += 4-r;
    2423         147 :   cache_get(cache_DIV, lim);
    2424         147 :   VDIV = caches[cache_DIV].cache;
    2425         147 :   VHDH0 = cgetg(lim/2 + 1, t_VECSMALL);
    2426         147 :   VHDH0[1] = 2;
    2427         147 :   VHDH0[2] = 3;
    2428     6122627 :   for (N = 3; N <= lim0; N++) VHDH0[N] = VHDH[N];
    2429         147 :   av2 = avma;
    2430         147 :   cachea = cacheb = 0;
    2431     5283940 :   for (N = LIM + 3; N <= lim; N += 4)
    2432             :   {
    2433     5283793 :     long s = 0, limt = usqrt(N>>2), flsq = 0, ind, t, L, S;
    2434             :     GEN DN, DN2;
    2435     5283793 :     if (N + 2 >= lg(VDIV))
    2436             :     { /* use local cache */
    2437             :       GEN F;
    2438     4233961 :       if (N + 2 > cacheb)
    2439             :       {
    2440        1024 :         set_avma(av2); cachea = N;
    2441        1024 :         CACHE = update_factor_cache(N, lim+2, &cacheb);
    2442             :       }
    2443     4233961 :       F = gel(CACHE, ((N-cachea)>>1)+1); /* factoru(N) */
    2444     4233961 :       DN = divisorsu_fact(F);
    2445     4233961 :       F = gel(CACHE, ((N-cachea)>>1)+2); /* factoru(N+2) */
    2446     4233961 :       DN2 = divisorsu_fact(F);
    2447             :     }
    2448             :     else
    2449             :     { /* use global cache */
    2450     1049832 :       DN = gel(VDIV,N);
    2451     1049832 :       DN2 = gel(VDIV,N+2);
    2452             :     }
    2453     5283793 :     ind = N >> 1;
    2454  1115411521 :     for (t = 1; t <= limt; t++)
    2455             :     {
    2456  1110127728 :       ind -= (t<<2)-2; /* N/2 - 2t^2 */
    2457  1110127728 :       if (ind) s += VHDH0[ind]; else flsq = 1;
    2458             :     }
    2459     5283793 :     lamsig(DN, &L,&S);
    2460     5283793 :     VHDH0[N >> 1] = 2*S - 3*L - 2*s + flsq;
    2461     5283793 :     s = 0; flsq = 0; limt = (usqrt(N+2) - 1) >> 1;
    2462     5283793 :     ind = (N+1) >> 1;
    2463  1112795533 :     for (t = 1; t <= limt; t++)
    2464             :     {
    2465  1107511740 :       ind -= t<<2; /* (N+1)/2 - 2t(t+1) */
    2466  1107511740 :       if (ind) s += VHDH0[ind]; else flsq = 1;
    2467             :     }
    2468     5283793 :     lamsig(DN2, &L,&S);
    2469     5283793 :     VHDH0[(N+1) >> 1] = S - 3*(L >> 1) - s - flsq;
    2470             :   }
    2471         147 :   cache_set(cache_H, VHDH0); set_avma(av);
    2472             : }
    2473             : 
    2474             : /*************************************************************************/
    2475             : /* Core functions using factorizations, divisors of class numbers caches */
    2476             : /* TODO: myfactoru and factorization cache should be exported */
    2477             : static GEN
    2478    21289583 : myfactoru(long N)
    2479             : {
    2480    21289583 :   GEN z = cache_get(cache_FACT, N);
    2481    21289583 :   return z? gcopy(z): factoru(N);
    2482             : }
    2483             : static GEN
    2484    46625292 : mydivisorsu(long N)
    2485             : {
    2486    46625292 :   GEN z = cache_get(cache_DIV, N);
    2487    46625292 :   return z? leafcopy(z): divisorsu(N);
    2488             : }
    2489             : /* write -n = Df^2, D < 0 fundamental discriminant. Return D, set f. */
    2490             : static long
    2491    80347687 : mycoredisc2neg(ulong n, long *pf)
    2492             : {
    2493    80347687 :   ulong m, D = (ulong)cache_get(cache_D, n);
    2494    80347687 :   if (D) { *pf = usqrt(n/D); return -(long)D; }
    2495         196 :   m = mycore(n, pf);
    2496         196 :   if ((m&3) != 3) { m <<= 2; *pf >>= 1; }
    2497         196 :   return (long)-m;
    2498             : }
    2499             : /* write n = Df^2, D > 0 fundamental discriminant. Return D, set f. */
    2500             : static long
    2501          14 : mycoredisc2pos(ulong n, long *pf)
    2502             : {
    2503          14 :   ulong m = mycore(n, pf);
    2504          14 :   if ((m&3) != 1) { m <<= 2; *pf >>= 1; }
    2505          14 :   return (long)m;
    2506             : }
    2507             : 
    2508             : /* 1+p+...+p^e, e >= 1 */
    2509             : static ulong
    2510          49 : usumpow(ulong p, long e)
    2511             : {
    2512          49 :   ulong q = 1+p;
    2513             :   long i;
    2514          98 :   for (i = 1; i < e; i++) q = p*q + 1;
    2515          49 :   return q;
    2516             : }
    2517             : /* Hurwitz(D0 F^2)/ Hurwitz(D0)
    2518             :  * = \sum_{f|F}  f \prod_{p|f} (1-kro(D0/p)/p)
    2519             :  * = \prod_{p^e || F} (1 + (p^e-1) / (p-1) * (p-kro(D0/p))) */
    2520             : static long
    2521         294 : get_sh(long F, long D0)
    2522             : {
    2523         294 :   GEN fa = myfactoru(F), P = gel(fa,1), E = gel(fa,2);
    2524         294 :   long i, l = lg(P), t = 1;
    2525         794 :   for (i = 1; i < l; i++)
    2526             :   {
    2527         500 :     long p = P[i], e = E[i], s = kross(D0,p);
    2528         500 :     if (e == 1) { t *= 1 + p - s; continue; }
    2529         153 :     if (s == 1) { t *= upowuu(p,e); continue; }
    2530          49 :     t *= 1 + usumpow(p,e-1)*(p-s);
    2531             :   }
    2532         294 :   return t;
    2533             : }
    2534             : /* d > 0, d = 0,3 (mod 4). Return 6*hclassno(d); -d must be fundamental
    2535             :  * Faster than quadclassunit up to 5*10^5 or so */
    2536             : static ulong
    2537          42 : hclassno6u_count(ulong d)
    2538             : {
    2539          42 :   ulong a, b, b2, h = 0;
    2540          42 :   int f = 0;
    2541             : 
    2542          42 :   if (d > 500000)
    2543           7 :     return 6 * itou(gel(quadclassunit0(utoineg(d), 0, NULL, 0), 1));
    2544             : 
    2545             :   /* this part would work with -d non fundamental */
    2546          35 :   b = d&1; b2 = (1+d)>>2;
    2547          35 :   if (!b)
    2548             :   {
    2549           0 :     for (a=1; a*a<b2; a++)
    2550           0 :       if (b2%a == 0) h++;
    2551           0 :     f = (a*a==b2); b=2; b2=(4+d)>>2;
    2552             :   }
    2553        7133 :   while (b2*3 < d)
    2554             :   {
    2555        7098 :     if (b2%b == 0) h++;
    2556     1188551 :     for (a=b+1; a*a < b2; a++)
    2557     1181453 :       if (b2%a == 0) h += 2;
    2558        7098 :     if (a*a == b2) h++;
    2559        7098 :     b += 2; b2 = (b*b+d)>>2;
    2560             :   }
    2561          35 :   if (b2*3 == d) return 6*h+2;
    2562          35 :   if (f) return 6*h+3;
    2563          35 :   return 6*h;
    2564             : }
    2565             : /* D > 0; 6 * hclassno(D), using D = D0*F^2 */
    2566             : static long
    2567         336 : hclassno6u_2(ulong D, long D0, long F)
    2568             : {
    2569             :   long h;
    2570         336 :   if (F == 1) h = hclassno6u_count(D);
    2571             :   else
    2572             :   { /* second chance */
    2573         294 :     h = (ulong)cache_get(cache_H, -D0);
    2574         294 :     if (!h) h = hclassno6u_count(-D0);
    2575         294 :     h *= get_sh(F,D0);
    2576             :   }
    2577         336 :   return h;
    2578             : }
    2579             : /* D > 0; 6 * hclassno(D) (6*Hurwitz). Beware, cached value for D (=0,3 mod 4)
    2580             :  * is stored at D>>1 */
    2581             : ulong
    2582      156081 : hclassno6u(ulong D)
    2583             : {
    2584      156081 :   ulong z = (ulong)cache_get(cache_H, D);
    2585             :   long D0, F;
    2586      156081 :   if (z) return z;
    2587         336 :   D0 = mycoredisc2neg(D, &F);
    2588         336 :   return hclassno6u_2(D,D0,F);
    2589             : }
    2590             : /* same, where the decomposition D = D0*F^2 is already known */
    2591             : static ulong
    2592    66552479 : hclassno6u_i(ulong D, long D0, long F)
    2593             : {
    2594    66552479 :   ulong z = (ulong)cache_get(cache_H, D);
    2595    66552479 :   if (z) return z;
    2596           0 :   return hclassno6u_2(D,D0,F);
    2597             : }
    2598             : 
    2599             : #if 0
    2600             : /* D > 0, return h(-D) [ordinary class number].
    2601             :  * Assume consttabh(D or more) was previously called */
    2602             : static long
    2603             : hfromH(long D)
    2604             : {
    2605             :   pari_sp ltop = avma;
    2606             :   GEN m, d, fa = myfactoru(D), P = gel(fa,1), E = gel(fa,2);
    2607             :   GEN VH = caches[cache_H].cache;
    2608             :   long i, nd, S, l = lg(P);
    2609             : 
    2610             :   /* n = d[i] loops through squarefree divisors of f, where f^2 = largest square
    2611             :    * divisor of N = |D|; m[i] = moebius(n) */
    2612             :   nd = 1 << (l-1);
    2613             :   d = cgetg(nd+1, t_VECSMALL);
    2614             :   m = cgetg(nd+1, t_VECSMALL);
    2615             :   d[1] = 1; S = VH[D >> 1]; /* 6 hclassno(-D) */
    2616             :   m[1] = 1; nd = 1;
    2617             :   i = 1;
    2618             :   if (P[1] == 2 && E[1] <= 3) /* need D/n^2 to be a discriminant */
    2619             :   { if (odd(E[1]) || (E[1] == 2 && (D & 15) == 4)) i = 2; }
    2620             :   for (; i<l; i++)
    2621             :   {
    2622             :     long j, p = P[i];
    2623             :     if (E[i] == 1) continue;
    2624             :     for (j=1; j<=nd; j++)
    2625             :     {
    2626             :       long n, s, hn;
    2627             :       d[nd+j] = n = d[j] * p;
    2628             :       m[nd+j] = s = - m[j]; /* moebius(n) */
    2629             :       hn = VH[(D/(n*n)) >> 1]; /* 6 hclassno(-D/n^2) */
    2630             :       if (s > 0) S += hn; else S -= hn;
    2631             :     }
    2632             :     nd <<= 1;
    2633             :   }
    2634             :   return gc_long(ltop, S/6);
    2635             : }
    2636             : #endif
    2637             : /* D < -4 fundamental, h(D), ordinary class number */
    2638             : static long
    2639     6507354 : myh(long D)
    2640             : {
    2641     6507354 :   ulong z = (ulong)cache_get(cache_H, -D);
    2642     6507354 :   if (z) return z/6; /* should be hfromH(-D) if D non-fundamental */
    2643           0 :   return itou(quadclassno(stoi(D)));
    2644             : }
    2645             : 
    2646             : /*************************************************************************/
    2647             : /*                          TRACE FORMULAS                               */
    2648             : /* CHIP primitive, initialize for t_POLMOD output */
    2649             : static GEN
    2650       29932 : mfcharinit(GEN CHIP)
    2651             : {
    2652       29932 :   long n, o, l, vt, N = mfcharmodulus(CHIP);
    2653             :   GEN c, v, V, G, Pn;
    2654       29932 :   if (N == 1) return mkvec2(mkvec(gen_1), pol_x(0));
    2655        5348 :   G = gel(CHIP,1);
    2656        5348 :   v = ncharvecexpo(G, znconrey_normalized(G, gel(CHIP,2)));
    2657        5348 :   l = lg(v); V = cgetg(l, t_VEC);
    2658        5348 :   o = mfcharorder(CHIP);
    2659        5348 :   Pn = mfcharpol(CHIP); vt = varn(Pn);
    2660        5348 :   if (o <= 2)
    2661             :   {
    2662       58135 :     for (n = 1; n < l; n++)
    2663             :     {
    2664       53739 :       if (v[n] < 0) c = gen_0; else c = v[n]? gen_m1: gen_1;
    2665       53739 :       gel(V,n) = c;
    2666             :     }
    2667             :   }
    2668             :   else
    2669             :   {
    2670       16835 :     for (n = 1; n < l; n++)
    2671             :     {
    2672       15883 :       if (v[n] < 0) c = gen_0;
    2673             :       else
    2674             :       {
    2675        8890 :         c = Qab_zeta(v[n], o, vt);
    2676        8890 :         if (typ(c) == t_POL && lg(c) >= lg(Pn)) c = RgX_rem(c, Pn);
    2677             :       }
    2678       15883 :       gel(V,n) = c;
    2679             :     }
    2680             :   }
    2681        5348 :   return mkvec2(V, Pn);
    2682             : }
    2683             : static GEN
    2684      399553 : vchip_lift(GEN VCHI, long x, GEN C)
    2685             : {
    2686      399553 :   GEN V = gel(VCHI,1);
    2687      399553 :   long F = lg(V)-1;
    2688      399553 :   if (F == 1) return C;
    2689       18368 :   x %= F;
    2690       18368 :   if (!x) return C;
    2691       18368 :   if (x <= 0) x += F;
    2692       18368 :   return gmul(C, gel(V, x));
    2693             : }
    2694             : static long
    2695   124662909 : vchip_FC(GEN VCHI) { return lg(gel(VCHI,1))-1; }
    2696             : static GEN
    2697     4591272 : vchip_mod(GEN VCHI, GEN S)
    2698     4591272 : { return (typ(S) == t_POL)? RgX_rem(S, gel(VCHI,2)): S; }
    2699             : static GEN
    2700     1466969 : vchip_polmod(GEN VCHI, GEN S)
    2701     1466969 : { return (typ(S) == t_POL)? mkpolmod(S, gel(VCHI,2)): S; }
    2702             : 
    2703             : /* ceil(m/d) */
    2704             : static long
    2705      137144 : ceildiv(long m, long d)
    2706             : {
    2707             :   long q;
    2708      137144 :   if (!m) return 0;
    2709       40544 :   q = m/d; return m%d? q+1: q;
    2710             : }
    2711             : 
    2712             : /* contribution of scalar matrices in dimension formula */
    2713             : static GEN
    2714      296478 : A1(long N, long k)
    2715      296478 : { return sstoQ(mypsiu(N)*(k-1), 12); }
    2716             : static long
    2717        7665 : ceilA1(long N, long k)
    2718        7665 : { return ceildiv(mypsiu(N) * (k-1), 12); }
    2719             : 
    2720             : /* sturm bound, slightly larger than dimension */
    2721             : long
    2722       28609 : mfsturmNk(long N, long k) { return (mypsiu(N) * k) / 12; }
    2723             : long
    2724        2422 : mfsturmNgk(long N, GEN k)
    2725             : {
    2726        2422 :   long n,d; Qtoss(k,&n,&d);
    2727        2422 :   return 1 + (mypsiu(N)*n)/(d == 1? 12: 24);
    2728             : }
    2729             : static long
    2730          42 : mfsturmmf(GEN F) { return mfsturmNgk(mf_get_N(F), mf_get_gk(F)); }
    2731             : 
    2732             : /* List of all solutions of x^2 + x + 1 = 0 modulo N, x modulo N */
    2733             : static GEN
    2734         539 : sqrtm3modN(long N)
    2735             : {
    2736             :   pari_sp av;
    2737             :   GEN fa, P, E, B, mB, A, Q, T, R, v, gen_m3;
    2738         539 :   long l, i, n, ct, fl3 = 0, Ninit;
    2739         539 :   if (!odd(N) || (N%9) == 0) return cgetg(1,t_VECSMALL);
    2740         511 :   Ninit = N;
    2741         511 :   if ((N%3) == 0) { N /= 3; fl3 = 1; }
    2742         511 :   fa = myfactoru(N); P = gel(fa, 1); E = gel(fa, 2);
    2743         511 :   l = lg(P);
    2744         707 :   for (i = 1; i < l; i++)
    2745         518 :     if ((P[i]%3) == 2) return cgetg(1,t_VECSMALL);
    2746         189 :   A = cgetg(l, t_VECSMALL);
    2747         189 :   B = cgetg(l, t_VECSMALL);
    2748         189 :   mB= cgetg(l, t_VECSMALL);
    2749         189 :   Q = cgetg(l, t_VECSMALL); gen_m3 = utoineg(3);
    2750         385 :   for (i = 1; i < l; i++)
    2751             :   {
    2752         196 :     long p = P[i], e = E[i];
    2753         196 :     Q[i] = upowuu(p,e);
    2754         196 :     B[i] = itou( Zp_sqrt(gen_m3, utoipos(p), e) );
    2755         196 :     mB[i]= Q[i] - B[i];
    2756             :   }
    2757         189 :   ct = 1 << (l-1);
    2758         189 :   T = ZV_producttree(Q);
    2759         189 :   R = ZV_chinesetree(Q,T);
    2760         189 :   v = cgetg(ct+1, t_VECSMALL);
    2761         189 :   av = avma;
    2762         581 :   for (n = 1; n <= ct; n++)
    2763             :   {
    2764         392 :     long m = n-1, r;
    2765         812 :     for (i = 1; i < l; i++)
    2766             :     {
    2767         420 :       A[i] = (m&1L)? mB[i]: B[i];
    2768         420 :       m >>= 1;
    2769             :     }
    2770         392 :     r = itou( ZV_chinese_tree(A, Q, T, R) );
    2771         462 :     if (fl3) while (r%3) r += N;
    2772         392 :     set_avma(av); v[n] = odd(r) ? (r-1) >> 1 : (r+Ninit-1) >> 1;
    2773             :   }
    2774         189 :   return v;
    2775             : }
    2776             : 
    2777             : /* number of elliptic points of order 3 in X0(N) */
    2778             : static long
    2779        9681 : nu3(long N)
    2780             : {
    2781             :   long i, l;
    2782             :   GEN P;
    2783        9681 :   if (!odd(N) || (N%9) == 0) return 0;
    2784        8617 :   if ((N%3) == 0) N /= 3;
    2785        8617 :   P = gel(myfactoru(N), 1); l = lg(P);
    2786       12649 :   for (i = 1; i < l; i++) if ((P[i]%3) == 2) return 0;
    2787        3864 :   return 1L<<(l-1);
    2788             : }
    2789             : /* number of elliptic points of order 2 in X0(N) */
    2790             : static long
    2791       16772 : nu2(long N)
    2792             : {
    2793             :   long i, l;
    2794             :   GEN P;
    2795       16772 :   if ((N&3L) == 0) return 0;
    2796       16772 :   if (!odd(N)) N >>= 1;
    2797       16772 :   P = gel(myfactoru(N), 1); l = lg(P);
    2798       21035 :   for (i = 1; i < l; i++) if ((P[i]&3L) == 3) return 0;
    2799        3822 :   return 1L<<(l-1);
    2800             : }
    2801             : 
    2802             : /* contribution of elliptic matrices of order 3 in dimension formula
    2803             :  * Only depends on CHIP the primitive char attached to CHI */
    2804             : static GEN
    2805       41930 : A21(long N, long k, GEN CHI)
    2806             : {
    2807             :   GEN res, G, chi, o;
    2808             :   long a21, i, limx, S;
    2809       41930 :   if ((N&1L) == 0) return gen_0;
    2810       20160 :   a21 = k%3 - 1;
    2811       20160 :   if (!a21) return gen_0;
    2812       19516 :   if (N <= 3) return sstoQ(a21, 3);
    2813       10220 :   if (!CHI) return sstoQ(nu3(N) * a21, 3);
    2814         539 :   res = sqrtm3modN(N); limx = (N - 1) >> 1;
    2815         539 :   G = gel(CHI,1); chi = gel(CHI,2);
    2816         539 :   o = gmfcharorder(CHI);
    2817         931 :   for (S = 0, i = 1; i < lg(res); i++)
    2818             :   { /* (x,N) = 1; S += chi(x) + chi(x^2) */
    2819         392 :     long x = res[i];
    2820         392 :     if (x <= limx)
    2821             :     { /* CHI(x)=e(c/o), 3rd-root of 1 */
    2822         196 :       GEN c = znchareval(G, chi, utoi(x), o);
    2823         196 :       if (!signe(c)) S += 2; else S--;
    2824             :     }
    2825             :   }
    2826         539 :   return sstoQ(a21 * S, 3);
    2827             : }
    2828             : 
    2829             : /* List of all square roots of -1 modulo N */
    2830             : static GEN
    2831         595 : sqrtm1modN(long N)
    2832             : {
    2833             :   pari_sp av;
    2834             :   GEN fa, P, E, B, mB, A, Q, T, R, v;
    2835         595 :   long l, i, n, ct, fleven = 0;
    2836         595 :   if ((N&3L) == 0) return cgetg(1,t_VECSMALL);
    2837         595 :   if ((N&1L) == 0) { N >>= 1; fleven = 1; }
    2838         595 :   fa = myfactoru(N); P = gel(fa,1); E = gel(fa,2);
    2839         595 :   l = lg(P);
    2840         945 :   for (i = 1; i < l; i++)
    2841         665 :     if ((P[i]&3L) == 3) return cgetg(1,t_VECSMALL);
    2842         280 :   A = cgetg(l, t_VECSMALL);
    2843         280 :   B = cgetg(l, t_VECSMALL);
    2844         280 :   mB= cgetg(l, t_VECSMALL);
    2845         280 :   Q = cgetg(l, t_VECSMALL);
    2846         574 :   for (i = 1; i < l; i++)
    2847             :   {
    2848         294 :     long p = P[i], e = E[i];
    2849         294 :     Q[i] = upowuu(p,e);
    2850         294 :     B[i] = itou( Zp_sqrt(gen_m1, utoipos(p), e) );
    2851         294 :     mB[i]= Q[i] - B[i];
    2852             :   }
    2853         280 :   ct = 1 << (l-1);
    2854         280 :   T = ZV_producttree(Q);
    2855         280 :   R = ZV_chinesetree(Q,T);
    2856         280 :   v = cgetg(ct+1, t_VECSMALL);
    2857         280 :   av = avma;
    2858         868 :   for (n = 1; n <= ct; n++)
    2859             :   {
    2860         588 :     long m = n-1, r;
    2861        1232 :     for (i = 1; i < l; i++)
    2862             :     {
    2863         644 :       A[i] = (m&1L)? mB[i]: B[i];
    2864         644 :       m >>= 1;
    2865             :     }
    2866         588 :     r = itou( ZV_chinese_tree(A, Q, T, R) );
    2867         588 :     if (fleven && !odd(r)) r += N;
    2868         588 :     set_avma(av); v[n] = r;
    2869             :   }
    2870         280 :   return v;
    2871             : }
    2872             : 
    2873             : /* contribution of elliptic matrices of order 4 in dimension formula.
    2874             :  * Only depends on CHIP the primitive char attached to CHI */
    2875             : static GEN
    2876       41930 : A22(long N, long k, GEN CHI)
    2877             : {
    2878             :   GEN G, chi, o, res;
    2879             :   long S, a22, i, limx, o2;
    2880       41930 :   if ((N&3L) == 0) return gen_0;
    2881       28875 :   a22 = (k & 3L) - 1; /* (k % 4) - 1 */
    2882       28875 :   if (!a22) return gen_0;
    2883       28875 :   if (N <= 2) return sstoQ(a22, 4);
    2884       17577 :   if (!CHI) return sstoQ(nu2(N)*a22, 4);
    2885         805 :   if (mfcharparity(CHI) == -1) return gen_0;
    2886         595 :   res = sqrtm1modN(N); limx = (N - 1) >> 1;
    2887         595 :   G = gel(CHI,1); chi = gel(CHI,2);
    2888         595 :   o = gmfcharorder(CHI);
    2889         595 :   o2 = itou(o)>>1;
    2890        1183 :   for (S = 0, i = 1; i < lg(res); i++)
    2891             :   { /* (x,N) = 1, S += real(chi(x)) */
    2892         588 :     long x = res[i];
    2893         588 :     if (x <= limx)
    2894             :     { /* CHI(x)=e(c/o), 4th-root of 1 */
    2895         294 :       long c = itou( znchareval(G, chi, utoi(x), o) );
    2896         294 :       if (!c) S++; else if (c == o2) S--;
    2897             :     }
    2898             :   }
    2899         595 :   return sstoQ(a22 * S, 2);
    2900             : }
    2901             : 
    2902             : /* sumdiv(N,d,eulerphi(gcd(d,N/d))) */
    2903             : static long
    2904       37289 : nuinf(long N)
    2905             : {
    2906       37289 :   GEN fa = myfactoru(N), P = gel(fa,1), E = gel(fa,2);
    2907       37289 :   long i, t = 1, l = lg(P);
    2908       79289 :   for (i=1; i<l; i++)
    2909             :   {
    2910       42000 :     long p = P[i], e = E[i];
    2911       42000 :     if (odd(e))
    2912       33635 :       t *= upowuu(p,e>>1) << 1;
    2913             :     else
    2914        8365 :       t *= upowuu(p,(e>>1)-1) * (p+1);
    2915             :   }
    2916       37289 :   return t;
    2917             : }
    2918             : 
    2919             : /* contribution of hyperbolic matrices in dimension formula */
    2920             : static GEN
    2921       42378 : A3(long N, long FC)
    2922             : {
    2923             :   long i, S, NF, l;
    2924             :   GEN D;
    2925       42378 :   if (FC == 1) return sstoQ(nuinf(N),2);
    2926        5089 :   D = mydivisorsu(N); l = lg(D);
    2927        5089 :   S = 0; NF = N/FC;
    2928       40544 :   for (i = 1; i < l; i++)
    2929             :   {
    2930       35455 :     long g = ugcd(D[i], D[l-i]);
    2931       35455 :     if (NF%g == 0) S += myeulerphiu(g);
    2932             :   }
    2933        5089 :   return sstoQ(S, 2);
    2934             : }
    2935             : 
    2936             : /* special contribution in weight 2 in dimension formula */
    2937             : static long
    2938       41538 : A4(long k, long FC)
    2939       41538 : { return (k==2 && FC==1)? 1: 0; }
    2940             : /* gcd(x,N) */
    2941             : static long
    2942   143803807 : myugcd(GEN GCD, ulong x)
    2943             : {
    2944   143803807 :   ulong N = lg(GCD)-1;
    2945   143803807 :   if (x >= N) x %= N;
    2946   143803807 :   return GCD[x+1];
    2947             : }
    2948             : /* 1_{gcd(x,N) = 1} * chi(x), return NULL if 0 */
    2949             : static GEN
    2950   188268374 : mychicgcd(GEN GCD, GEN VCHI, long x)
    2951             : {
    2952   188268374 :   long N = lg(GCD)-1;
    2953   188268374 :   if (N == 1) return gen_1;
    2954   152743801 :   x = umodsu(x, N);
    2955   152743801 :   if (GCD[x+1] != 1) return NULL;
    2956   119280609 :   x %= vchip_FC(VCHI); if (!x) return gen_1;
    2957     4468065 :   return gel(gel(VCHI,1), x);
    2958             : }
    2959             : 
    2960             : /* contribution of scalar matrices to trace formula */
    2961             : static GEN
    2962     4530001 : TA1(long N, long k, GEN VCHI, GEN GCD, long n)
    2963             : {
    2964             :   GEN S;
    2965             :   ulong m;
    2966     4530001 :   if (!uissquareall(n, &m)) return gen_0;
    2967      323974 :   if (m == 1) return A1(N,k); /* common */
    2968      288330 :   S = mychicgcd(GCD, VCHI, m);
    2969      288330 :   return S? gmul(gmul(powuu(m, k-2), A1(N,k)), S): gen_0;
    2970             : }
    2971             : 
    2972             : /* All square roots modulo 4N, x modulo 2N, precomputed to accelerate TA2 */
    2973             : static GEN
    2974      116298 : mksqr(long N)
    2975             : {
    2976      116298 :   pari_sp av = avma;
    2977      116298 :   long x, N2 = N << 1, N4 = N << 2;
    2978      116298 :   GEN v = const_vec(N2, cgetg(1, t_VECSMALL));
    2979      116298 :   gel(v, N2) = mkvecsmall(0); /* x = 0 */
    2980     2967825 :   for (x = 1; x <= N; x++)
    2981             :   {
    2982     2851527 :     long r = (((x*x - 1)%N4) >> 1) + 1;
    2983     2851527 :     gel(v,r) = vecsmall_append(gel(v,r), x);
    2984             :   }
    2985      116298 :   return gerepilecopy(av, v);
    2986             : }
    2987             : 
    2988             : static GEN
    2989      116298 : mkgcd(long N)
    2990             : {
    2991             :   GEN GCD, d;
    2992             :   long i, N2;
    2993      116298 :   if (N == 1) return mkvecsmall(N);
    2994       95963 :   GCD = cgetg(N + 1, t_VECSMALL);
    2995       95963 :   d = GCD+1; /* GCD[i+1] = d[i] = gcd(i,N) = gcd(N-i,N), i = 0..N-1 */
    2996       95963 :   d[0] = N; d[1] = d[N-1] = 1; N2 = N>>1;
    2997     1396892 :   for (i = 2; i <= N2; i++) d[i] = d[N-i] = ugcd(N, i);
    2998       95963 :   return GCD;
    2999             : }
    3000             : 
    3001             : /* Table of \sum_{x^2-tx+n=0 mod Ng}chi(x) for all g dividing gcd(N,F),
    3002             :  * F^2 largest such that (t^2-4n)/F^2=0 or 1 mod 4; t >= 0 */
    3003             : static GEN
    3004    10796667 : mutglistall(long t, long N, long NF, GEN VCHI, long n, GEN MUP, GEN li, GEN GCD)
    3005             : {
    3006    10796667 :   long i, lx = lg(li);
    3007    10796667 :   GEN DNF = mydivisorsu(NF), v = zerovec(NF);
    3008    10796667 :   long j, g, lDNF = lg(DNF);
    3009    28641109 :   for (i = 1; i < lx; i++)
    3010             :   {
    3011    17844442 :     long x = (li[i] + t) >> 1, y, lD;
    3012    17844442 :     GEN D, c = mychicgcd(GCD, VCHI, x);
    3013    17844442 :     if (li[i] && li[i] != N)
    3014             :     {
    3015    11312252 :       GEN c2 = mychicgcd(GCD, VCHI, t - x);
    3016    11312252 :       if (c2) c = c? gadd(c, c2): c2;
    3017             :     }
    3018    17844442 :     if (!c) continue;
    3019    12705301 :     y = (x*(x - t) + n) / N; /* exact division */
    3020    12705301 :     D = mydivisorsu(ugcd(labs(y), NF)); lD = lg(D);
    3021    35056847 :     for (j=1; j < lD; j++) { g = D[j]; gel(v,g) = gadd(gel(v,g), c); }
    3022             :   }
    3023             :   /* j = 1 corresponds to g = 1, and MUP[1] = 1 */
    3024    25683511 :   for (j=2; j < lDNF; j++) { g = DNF[j]; gel(v,g) = gmulsg(MUP[g], gel(v,g)); }
    3025    10796667 :   return v;
    3026             : }
    3027             : 
    3028             : /* special case (N,F) = 1: easier */
    3029             : static GEN
    3030    69550670 : mutg1(long t, long N, GEN VCHI, GEN li, GEN GCD)
    3031             : { /* (N,F) = 1 */
    3032    69550670 :   GEN S = NULL;
    3033    69550670 :   long i, lx = lg(li);
    3034   144439204 :   for (i = 1; i < lx; i++)
    3035             :   {
    3036    74888534 :     long x = (li[i] + t) >> 1;
    3037    74888534 :     GEN c = mychicgcd(GCD, VCHI, x);
    3038    74888534 :     if (c) S = S? gadd(S, c): c;
    3039    74888534 :     if (li[i] && li[i] != N)
    3040             :     {
    3041    38252627 :       c = mychicgcd(GCD, VCHI, t - x);
    3042    38252627 :       if (c) S = S? gadd(S, c): c;
    3043             :     }
    3044    74888534 :     if (S && !signe(S)) S = NULL; /* strive hard to add gen_0 */
    3045             :   }
    3046    69550670 :   return S; /* single value */
    3047             : }
    3048             : 
    3049             : /* Gegenbauer pol; n > 2, P = \sum_{0<=j<=n/2} (-1)^j (n-j)!/j!(n-2*j)! X^j */
    3050             : static GEN
    3051      350203 : mfrhopol(long n)
    3052             : {
    3053             : #ifdef LONG_IS_64BIT
    3054      300174 :   const long M = 2642249;
    3055             : #else
    3056       50029 :   const long M = 1629;
    3057             : #endif
    3058      350203 :   long j, d = n >> 1; /* >= 1 */
    3059      350203 :   GEN P = cgetg(d + 3, t_POL);
    3060             : 
    3061      350203 :   if (n > M) pari_err_IMPL("mfrhopol for large weight"); /* avoid overflow */
    3062      350203 :   P[1] = evalvarn(0)|evalsigne(1);
    3063      350203 :   gel(P,2) = gen_1;
    3064      350203 :   gel(P,3) = utoineg(n-1); /* j = 1 */
    3065      350203 :   if (d > 1) gel(P,4) = utoipos(((n-3)*(n-2)) >> 1); /* j = 2 */
    3066      350203 :   if (d > 2) gel(P,5) = utoineg(((n-5)*(n-4)*(n-3)) / 6); /* j = 3 */
    3067     1288707 :   for (j = 4; j <= d; j++)
    3068      938504 :     gel(P,j+2) = divis(mulis(gel(P,j+1), (n-2*j+1)*(n-2*j+2)), (n-j+1)*(-j));
    3069      350203 :   return P;
    3070             : }
    3071             : 
    3072             : /* polrecip(Q)(t2), assume Q(0) = 1 */
    3073             : static GEN
    3074     2984520 : ZXrecip_u_eval(GEN Q, ulong t2)
    3075             : {
    3076     2984520 :   GEN T = addiu(gel(Q,3), t2);
    3077     2984520 :   long l = lg(Q), j;
    3078    32182038 :   for (j = 4; j < l; j++) T = addii(gel(Q,j), mului(t2, T));
    3079     2984520 :   return T;
    3080             : }
    3081             : /* return sh * sqrt(n)^nu * G_nu(t/(2*sqrt(n))) for t != 0
    3082             :  * else (sh/2) * sqrt(n)^nu * G_nu(0) [ implies nu is even ]
    3083             :  * G_nu(z) = \sum_{0<=j<=nu/2} (-1)^j (nu-j)!/j!(nu-2*j)! * (2z)^(nu-2*j)) */
    3084             : static GEN
    3085    73769087 : mfrhopowsimp(GEN Q, GEN sh, long nu, long t, long t2, long n)
    3086             : {
    3087             :   GEN T;
    3088    73769087 :   switch (nu)
    3089             :   {
    3090    68229371 :     case 0: return t? sh: gmul2n(sh,-1);
    3091     1125075 :     case 1: return gmulsg(t, sh);
    3092     1391999 :     case 2: return t? gmulsg(t2 - n, sh): gmul(gmul2n(stoi(-n), -1), sh);
    3093         427 :     case 3: return gmul(mulss(t, t2 - 2*n), sh);
    3094     3022215 :     default:
    3095     3022215 :       if (!t) return gmul(gmul2n(gel(Q, lg(Q) - 1), -1), sh);
    3096     2984520 :       T = ZXrecip_u_eval(Q, t2); if (odd(nu)) T = mulsi(t, T);
    3097     2984520 :       return gmul(T, sh);
    3098             :   }
    3099             : }
    3100             : 
    3101             : /* contribution of elliptic matrices to trace formula */
    3102             : static GEN
    3103     4530001 : TA2(long N, long k, GEN VCHI, long n, GEN SQRTS, GEN MUP, GEN GCD)
    3104             : {
    3105     4530001 :   const long n4 = n << 2, N4 = N << 2, nu = k - 2;
    3106     4530001 :   const long st = (!odd(N) && odd(n)) ? 2 : 1;
    3107             :   long limt, t;
    3108             :   GEN S, Q;
    3109             : 
    3110     4530001 :   limt = usqrt(n4);
    3111     4530001 :   if (limt*limt == n4) limt--;
    3112     4530001 :   Q = nu > 3 ? ZX_z_unscale(mfrhopol(nu), n) : NULL;
    3113     4530001 :   S = gen_0;
    3114   139003242 :   for (t = odd(k)? st: 0; t <= limt; t += st) /* t^2 < 4n */
    3115             :   {
    3116   134473241 :     pari_sp av = avma;
    3117   134473241 :     long t2 = t*t, D = n4 - t2, F, D0, NF;
    3118             :     GEN sh, li;
    3119             : 
    3120   134473241 :     li = gel(SQRTS, (umodsu(-D - 1, N4) >> 1) + 1);
    3121   141051491 :     if (lg(li) == 1) continue;
    3122    80347337 :     D0 = mycoredisc2neg(D, &F);
    3123    80347337 :     NF = myugcd(GCD, F);
    3124    80347337 :     if (NF == 1)
    3125             :     { /* (N,F) = 1 => single value in mutglistall */
    3126    69550670 :       GEN mut = mutg1(t, N, VCHI, li, GCD);
    3127    69550670 :       if (!mut) { set_avma(av); continue; }
    3128    66552479 :       sh = gmul(sstoQ(hclassno6u_i(D,D0,F),6), mut);
    3129             :     }
    3130             :     else
    3131             :     {
    3132    10796667 :       GEN v = mutglistall(t, N, NF, VCHI, n, MUP, li, GCD);
    3133    10796667 :       GEN DF = mydivisorsu(F);
    3134    10796667 :       long i, lDF = lg(DF);
    3135    10796667 :       sh = gen_0;
    3136    41886432 :       for (i = 1; i < lDF; i++)
    3137             :       {
    3138    31089765 :         long Ff, f = DF[i], g = myugcd(GCD, f);
    3139    31089765 :         GEN mut = gel(v, g);
    3140    31089765 :         if (gequal0(mut)) continue;
    3141    17881304 :         Ff = DF[lDF-i]; /* F/f */
    3142    17881304 :         if (Ff == 1) sh = gadd(sh, mut);
    3143             :         else
    3144             :         {
    3145    12710789 :           GEN P = gel(myfactoru(Ff), 1);
    3146    12710789 :           long j, lP = lg(P);
    3147    27194881 :           for (j = 1; j < lP; j++) { long p = P[j]; Ff -= kross(D0, p)*Ff/p; }
    3148    12710789 :           sh = gadd(sh, gmulsg(Ff, mut));
    3149             :         }
    3150             :       }
    3151    10796667 :       if (gequal0(sh)) { set_avma(av); continue; }
    3152     7216608 :       if (D0 == -3) sh = gdivgs(sh, 3);
    3153     6848688 :       else if (D0 == -4) sh = gdivgs(sh, 2);
    3154     6507354 :       else sh = gmulgs(sh, myh(D0));
    3155             :     }
    3156    73769087 :     S = gerepileupto(av, gadd(S, mfrhopowsimp(Q,sh,nu,t,t2,n)));
    3157             :   }
    3158     4530001 :   return S;
    3159             : }
    3160             : 
    3161             : /* compute global auxiliary data for TA3 */
    3162             : static GEN
    3163      116298 : mkbez(long N, long FC)
    3164             : {
    3165      116298 :   long ct, i, NF = N/FC;
    3166      116298 :   GEN w, D = mydivisorsu(N);
    3167      116298 :   long l = lg(D);
    3168             : 
    3169      116298 :   w = cgetg(l, t_VEC);
    3170      338541 :   for (i = ct = 1; i < l; i++)
    3171             :   {
    3172      318206 :     long u, v, h, c = D[i], Nc = D[l-i];
    3173      318206 :     if (c > Nc) break;
    3174      222243 :     h = cbezout(c, Nc, &u, &v);
    3175      222243 :     if (h == 1) /* shortcut */
    3176      160272 :       gel(w, ct++) = mkvecsmall4(1,u*c,1,i);
    3177       61971 :     else if (!(NF%h))
    3178       52213 :       gel(w, ct++) = mkvecsmall4(h,u*(c/h),myeulerphiu(h),i);
    3179             :   }
    3180      116298 :   setlg(w,ct); stackdummy((pari_sp)(w+ct),(pari_sp)(w+l));
    3181      116298 :   return w;
    3182             : }
    3183             : 
    3184             : /* contribution of hyperbolic matrices to trace formula, d * nd = n,
    3185             :  * DN = divisorsu(N) */
    3186             : static GEN
    3187    18914371 : auxsum(GEN VCHI, GEN GCD, long d, long nd, GEN DN, GEN BEZ)
    3188             : {
    3189    18914371 :   GEN S = gen_0;
    3190    18914371 :   long ct, g = nd - d, lDN = lg(DN), lBEZ = lg(BEZ);
    3191    49650398 :   for (ct = 1; ct < lBEZ; ct++)
    3192             :   {
    3193    30736027 :     GEN y, B = gel(BEZ, ct);
    3194    30736027 :     long ic, c, Nc, uch, h = B[1];
    3195    30736027 :     if (g%h) continue;
    3196    30069774 :     uch = B[2];
    3197    30069774 :     ic  = B[4];
    3198    30069774 :     c = DN[ic];
    3199    30069774 :     Nc= DN[lDN - ic]; /* Nc = N/c */
    3200    30069774 :     if (ugcd(Nc, nd) == 1)
    3201    24209598 :       y = mychicgcd(GCD, VCHI, d + uch*g); /* 0 if (c,d) > 1 */
    3202             :     else
    3203     5860176 :       y = NULL;
    3204    30069774 :     if (c != Nc && ugcd(Nc, d) == 1)
    3205             :     {
    3206    21472591 :       GEN y2 = mychicgcd(GCD, VCHI, nd - uch*g); /* 0 if (c,nd) > 1 */
    3207    21472591 :       if (y2) y = y? gadd(y, y2): y2;
    3208             :     }
    3209    30069774 :     if (y) S = gadd(S, gmulsg(B[3], y));
    3210             :   }
    3211    18914371 :   return S;
    3212             : }
    3213             : 
    3214             : static GEN
    3215     4530001 : TA3(long N, long k, GEN VCHI, GEN GCD, GEN Dn, GEN BEZ)
    3216             : {
    3217     4530001 :   GEN S = gen_0, DN = mydivisorsu(N);
    3218     4530001 :   long i, l = lg(Dn);
    3219    23444372 :   for (i = 1; i < l; i++)
    3220             :   {
    3221    23408728 :     long d = Dn[i], nd = Dn[l-i]; /* = n/d */
    3222             :     GEN t, u;
    3223    23408728 :     if (d > nd) break;
    3224    18914371 :     t = auxsum(VCHI, GCD, d, nd, DN, BEZ);
    3225    18914371 :     if (isintzero(t)) continue;
    3226    17809519 :     u = powuu(d,k-1); if (d == nd) u = gmul2n(u,-1);
    3227    17809519 :     S = gadd(S, gmul(u,t));
    3228             :   }
    3229     4530001 :   return S;
    3230             : }
    3231             : 
    3232             : /* special contribution in weight 2 in trace formula */
    3233             : static long
    3234     4530001 : TA4(long k, GEN VCHIP, GEN Dn, GEN GCD)
    3235             : {
    3236             :   long i, l, S;
    3237     4530001 :   if (k != 2 || vchip_FC(VCHIP) != 1) return 0;
    3238     3862187 :   l = lg(Dn); S = 0;
    3239    36228892 :   for (i = 1; i < l; i++)
    3240             :   {
    3241    32366705 :     long d = Dn[i]; /* gcd(N,n/d) == 1? */
    3242    32366705 :     if (myugcd(GCD, Dn[l-i]) == 1) S += d;
    3243             :   }
    3244     3862187 :   return S;
    3245             : }
    3246             : 
    3247             : /* precomputation of products occurring im mutg, again to accelerate TA2 */
    3248             : static GEN
    3249      116298 : mkmup(long N)
    3250             : {
    3251      116298 :   GEN fa = myfactoru(N), P = gel(fa,1), D = divisorsu_fact(fa);
    3252      116298 :   long i, lP = lg(P), lD = lg(D);
    3253      116298 :   GEN MUP = zero_zv(N);
    3254      116298 :   MUP[1] = 1;
    3255      410620 :   for (i = 2; i < lD; i++)
    3256             :   {
    3257      294322 :     long j, g = D[i], Ng = D[lD-i]; /*  N/g */
    3258      809319 :     for (j = 1; j < lP; j++) { long p = P[j]; if (Ng%p) g += g/p; }
    3259      294322 :     MUP[D[i]] = g;
    3260             :   }
    3261      116298 :   return MUP;
    3262             : }
    3263             : 
    3264             : /* quadratic non-residues mod p; p odd prime, p^2 fits in a long */
    3265             : static GEN
    3266        2653 : non_residues(long p)
    3267             : {
    3268        2653 :   long i, j, p2 = p >> 1;
    3269        2653 :   GEN v = cgetg(p2+1, t_VECSMALL), w = const_vecsmall(p-1, 1);
    3270        4410 :   for (i = 2; i <= p2; i++) w[(i*i) % p] = 0; /* no need to check 1 */
    3271        8820 :   for (i = 2, j = 1; i < p; i++) if (w[i]) v[j++] = i;
    3272        2653 :   return v;
    3273             : }
    3274             : 
    3275             : /* CHIP primitive. Return t_VECSMALL v of length q such that
    3276             :  * Tr^new_{N,CHIP}(n) = 0 whenever v[(n%q) + 1] is non-zero */
    3277             : static GEN
    3278       30030 : mfnewzerodata(long N, GEN CHIP)
    3279             : {
    3280       30030 :   GEN V, M, L, faN = myfactoru(N), PN = gel(faN,1), EN = gel(faN,2);
    3281       30030 :   GEN G = gel(CHIP,1), chi = gel(CHIP,2);
    3282       30030 :   GEN fa = znstar_get_faN(G), P = ZV_to_zv(gel(fa,1)), E = gel(fa,2);
    3283       30030 :   long i, mod, j = 1, l = lg(PN);
    3284             : 
    3285       30030 :   M = cgetg(l, t_VECSMALL); M[1] = 0;
    3286       30030 :   V = cgetg(l, t_VEC);
    3287             :   /* Tr^new(n) = 0 if (n mod M[i]) in V[i]  */
    3288       30030 :   if ((N & 3) == 0)
    3289             :   {
    3290       12054 :     long e = EN[1];
    3291       12054 :     long c = (lg(P) > 1 && P[1] == 2)? E[1]: 0; /* c = v_2(FC) */
    3292             :     /* e >= 2 */
    3293       12054 :     if (c == e-1) return NULL; /* Tr^new = 0 */
    3294       11949 :     if (c == e)
    3295             :     {
    3296        3584 :       if (e == 2)
    3297             :       { /* sc: -4 */
    3298        1764 :         gel(V,1) = mkvecsmall(3);
    3299        1764 :         M[1] = 4;
    3300             :       }
    3301        1820 :       else if (e == 3)
    3302             :       { /* sc: -8 (CHI_2(-1)=-1<=>chi[1]=1) and 8 (CHI_2(-1)=1 <=> chi[1]=0) */
    3303        1820 :         long t = signe(gel(chi,1))? 7: 3;
    3304        1820 :         gel(V,1) = mkvecsmall2(5, t);
    3305        1820 :         M[1] = 8;
    3306             :       }
    3307             :     }
    3308        8365 :     else if (e == 5 && c == 3)
    3309         154 :     { /* sc: -8 (CHI_2(-1)=-1<=>chi[1]=1) and 8 (CHI_2(-1)=1 <=> chi[1]=0) */
    3310         154 :       long t = signe(gel(chi,1))? 7: 3;
    3311         154 :       gel(V,1) = mkvecsmalln(6, 2L,4L,5L,6L,8L,t);
    3312         154 :       M[1] = 8;
    3313             :     }
    3314        8211 :     else if ((e == 4 && c == 2) || (e == 5 && c <= 2) || (e == 6 && c <= 2)
    3315        6678 :          || (e >= 7 && c == e - 3))
    3316             :     { /* sc: 4 */
    3317        1533 :       gel(V,1) = mkvecsmall3(0,2,3);
    3318        1533 :       M[1] = 4;
    3319             :     }
    3320        6678 :     else if ((e <= 4 && c == 0) || (e >= 5 && c == e - 2))
    3321             :     { /* sc: 2 */
    3322        6412 :       gel(V,1) = mkvecsmall(0);
    3323        6412 :       M[1] = 2;
    3324             :     }
    3325         266 :     else if ((e == 6 && c == 3) || (e >= 7 && c <= e - 4))
    3326             :     { /* sc: -2 */
    3327         266 :       gel(V,1) = mkvecsmalln(7, 0L,2L,3L,4L,5L,6L,7L);
    3328         266 :       M[1] = 8;
    3329             :     }
    3330             :   }
    3331       29925 :   j = M[1]? 2: 1;
    3332       64169 :   for (i = odd(N)? 1: 2; i < l; i++) /* skip p=2, done above */
    3333             :   {
    3334       34244 :     long p = PN[i], e = EN[i];
    3335       34244 :     long z = zv_search(P, p), c = z? E[z]: 0; /* c = v_p(FC) */
    3336       34244 :     if ((e <= 2 && c == 1 && itos(gel(chi,z)) == (p>>1)) /* ord(CHI_p)=2 */
    3337       32053 :         || (e >= 3 && c <= e - 2))
    3338        2653 :     { /* sc: -p */
    3339        2653 :       GEN v = non_residues(p);
    3340        2653 :       if (e != 1) v = vecsmall_prepend(v, 0);
    3341        2653 :       gel(V,j) = v;
    3342        2653 :       M[j] = p; j++;
    3343             :     }
    3344       31591 :     else if (e >= 2 && c < e)
    3345             :     { /* sc: p */
    3346        2142 :       gel(V,j) = mkvecsmall(0);
    3347        2142 :       M[j] = p; j++;
    3348             :     }
    3349             :   }
    3350       29925 :   if (j == 1) return cgetg(1, t_VECSMALL);
    3351       13986 :   setlg(V,j); setlg(M,j); mod = zv_prod(M);
    3352       13986 :   L = zero_zv(mod);
    3353       30730 :   for (i = 1; i < j; i++)
    3354             :   {
    3355       16744 :     GEN v = gel(V,i);
    3356       16744 :     long s, m = M[i], lv = lg(v);
    3357       43610 :     for (s = 1; s < lv; s++)
    3358             :     {
    3359       26866 :       long a = v[s] + 1;
    3360       53452 :       do { L[a] = 1; a += m; } while (a <= mod);
    3361             :     }
    3362             :   }
    3363       13986 :   return L;
    3364             : }
    3365             : /* v=mfnewzerodata(N,CHI); returns TRUE if newtrace(n) must be zero,
    3366             :  * (but newtrace(n) may still be zero if we return FALSE) */
    3367             : static long
    3368     1921031 : mfnewchkzero(GEN v, long n) { long q = lg(v)-1; return q && v[(n%q) + 1]; }
    3369             : 
    3370             : /* if (!VCHIP): from mftraceform_cusp;
    3371             :  * else from initnewtrace and CHI is known to be primitive */
    3372             : static GEN
    3373      116298 : inittrace(long N, GEN CHI, GEN VCHIP)
    3374             : {
    3375             :   long FC;
    3376      116298 :   if (VCHIP)
    3377      116291 :     FC = mfcharmodulus(CHI);
    3378             :   else
    3379           7 :     VCHIP = mfcharinit(mfchartoprimitive(CHI, &FC));
    3380      116298 :   return mkvecn(5, mksqr(N), mkmup(N), mkgcd(N), VCHIP, mkbez(N, FC));
    3381             : }
    3382             : 
    3383             : /* p > 2 prime; return a sorted t_VECSMALL of primes s.t Tr^new(p) = 0 for all
    3384             :  * weights > 2 */
    3385             : static GEN
    3386       29925 : inittrconj(long N, long FC)
    3387             : {
    3388             :   GEN fa, P, E, v;
    3389             :   long i, k, l;
    3390             : 
    3391       29925 :   if (FC != 1) return cgetg(1,t_VECSMALL);
    3392             : 
    3393       24577 :   fa = myfactoru(N >> vals(N));
    3394       24577 :   P = gel(fa,1); l = lg(P);
    3395       24577 :   E = gel(fa,2);
    3396       24577 :   v = cgetg(l, t_VECSMALL);
    3397       53879 :   for (i = k = 1; i < l; i++)
    3398             :   {
    3399       29302 :     long j, p = P[i]; /* > 2 */
    3400       71064 :     for (j = 1; j < l; j++)
    3401       41762 :       if (j != i && E[j] == 1 && kross(-p, P[j]) == 1) v[k++] = p;
    3402             :   }
    3403       24577 :   setlg(v,k); return v;
    3404             : }
    3405             : 
    3406             : /* assume CHIP primitive, f(CHIP) | N; NZ = mfnewzerodata(N,CHIP) */
    3407             : static GEN
    3408       29925 : initnewtrace_i(long N, GEN CHIP, GEN NZ)
    3409             : {
    3410       29925 :   GEN T = const_vec(N, cgetg(1,t_VEC)), D, VCHIP;
    3411       29925 :   long FC = mfcharmodulus(CHIP), N1, N2, i, l;
    3412             : 
    3413       29925 :   if (!NZ) NZ = mkvecsmall(1); /*Tr^new = 0; initialize data nevertheless*/
    3414       29925 :   VCHIP = mfcharinit(CHIP);
    3415       29925 :   N1 = N/FC; newd_params(N1, &N2);
    3416       29925 :   D = mydivisorsu(N1/N2); l = lg(D);
    3417       29925 :   N2 *= FC;
    3418      146216 :   for (i = 1; i < l; i++)
    3419             :   {
    3420      116291 :     long M = D[i]*N2;
    3421      116291 :     gel(T,M) = inittrace(M, CHIP, VCHIP);
    3422             :   }
    3423       29925 :   gel(T,N) = shallowconcat(gel(T,N), mkvec2(NZ, inittrconj(N,FC)));
    3424       29925 :   return T;
    3425             : }
    3426             : /* don't initialize if Tr^new = 0, return NULL */
    3427             : static GEN
    3428       30030 : initnewtrace(long N, GEN CHI)
    3429             : {
    3430       30030 :   GEN CHIP = mfchartoprimitive(CHI, NULL), NZ = mfnewzerodata(N,CHIP);
    3431       30030 :   return NZ? initnewtrace_i(N, CHIP, NZ): NULL;
    3432             : }
    3433             : 
    3434             : /* (-1)^k */
    3435             : static long
    3436        7448 : m1pk(long k) { return odd(k)? -1 : 1; }
    3437             : static long
    3438        7119 : badchar(long N, long k, GEN CHI)
    3439        7119 : { return mfcharparity(CHI) != m1pk(k) || (CHI && N % mfcharconductor(CHI)); }
    3440             : 
    3441             : /* dimension of space of cusp forms S_k(\G_0(N),CHI)
    3442             :  * Only depends on CHIP the primitive char attached to CHI */
    3443             : long
    3444       41545 : mfcuspdim(long N, long k, GEN CHI)
    3445             : {
    3446       41545 :   pari_sp av = avma;
    3447             :   long FC;
    3448             :   GEN s;
    3449       41545 :   if (k <= 0) return 0;
    3450       41545 :   if (k == 1) return mfwt1cuspdim(N, CHI);
    3451       41356 :   FC = CHI? mfcharconductor(CHI): 1;
    3452       41356 :   if (FC == 1) CHI = NULL;
    3453       41356 :   s = gsub(A1(N, k), gadd(A21(N, k, CHI), A22(N, k, CHI)));
    3454       41356 :   s = gadd(s, gsubsg(A4(k, FC), A3(N, FC)));
    3455       41356 :   return gc_long(av, itos(s));
    3456             : }
    3457             : 
    3458             : /* dimension of whole space M_k(\G_0(N),CHI)
    3459             :  * Only depends on CHIP the primitive char attached to CHI; assumes !badchar */
    3460             : long
    3461         791 : mffulldim(long N, long k, GEN CHI)
    3462             : {
    3463         791 :   pari_sp av = avma;
    3464         791 :   long FC = CHI? mfcharconductor(CHI): 1;
    3465             :   GEN s;
    3466         791 :   if (k <= 0) return (k == 0 && FC == 1)? 1: 0;
    3467         791 :   if (k == 1) return gc_long(av, itos(A3(N, FC)) + mfwt1cuspdim(N, CHI));
    3468         574 :   if (FC == 1) CHI = NULL;
    3469         574 :   s = gsub(A1(N, k), gadd(A21(N, k, CHI), A22(N, k, CHI)));
    3470         574 :   s = gadd(s, A3(N, FC));
    3471         574 :   return gc_long(av, itos(s));
    3472             : }
    3473             : 
    3474             : /* Dimension of the space of Eisenstein series */
    3475             : long
    3476         231 : mfeisensteindim(long N, long k, GEN CHI)
    3477             : {
    3478         231 :   pari_sp av = avma;
    3479         231 :   long s, FC = CHI? mfcharconductor(CHI): 1;
    3480         231 :   if (k <= 0) return (k == 0 && FC == 1)? 1: 0;
    3481         231 :   s = itos(gmul2n(A3(N, FC), 1));
    3482         231 :   if (k > 1) s -= A4(k, FC); else s >>= 1;
    3483         231 :   return gc_long(av,s);
    3484             : }
    3485             : 
    3486             : enum { _SQRTS = 1, _MUP, _GCD, _VCHIP, _BEZ, _NEWLZ, _TRCONJ };
    3487             : /* Trace of T(n) on space of cuspforms; only depends on CHIP the primitive char
    3488             :  * attached to CHI */
    3489             : static GEN
    3490     4530001 : mfcusptrace_i(long N, long k, long n, GEN Dn, GEN S)
    3491             : {
    3492     4530001 :   pari_sp av = avma;
    3493             :   GEN a, b, VCHIP, GCD;
    3494             :   long t;
    3495     4530001 :   if (!n) return gen_0;
    3496     4530001 :   VCHIP = gel(S,_VCHIP);
    3497     4530001 :   GCD = gel(S,_GCD);
    3498     4530001 :   t = TA4(k, VCHIP, Dn, GCD);
    3499     4530001 :   a = TA1(N, k, VCHIP, GCD, n); if (t) a = gaddgs(a,t);
    3500     4530001 :   b = TA2(N, k, VCHIP, n, gel(S,_SQRTS), gel(S,_MUP), GCD);
    3501     4530001 :   b = gadd(b, TA3(N, k, VCHIP, GCD, Dn, gel(S,_BEZ)));
    3502     4530001 :   b = gsub(a,b);
    3503     4530001 :   if (typ(b) != t_POL) return gerepileupto(av, b);
    3504       38675 :   return gerepilecopy(av, vchip_polmod(VCHIP, b));
    3505             : }
    3506             : 
    3507             : static GEN
    3508     5794061 : mfcusptracecache(long N, long k, long n, GEN Dn, GEN S, cachenew_t *cache)
    3509             : {
    3510     5794061 :   GEN C = NULL, T = gel(cache->vfull,N);
    3511     5794061 :   long lcache = lg(T);
    3512     5794061 :   if (n < lcache) C = gel(T, n);
    3513     5794061 :   if (C) cache->cuspHIT++; else C = mfcusptrace_i(N, k, n, Dn, S);
    3514     5794061 :   cache->cuspTOTAL++;
    3515     5794061 :   if (n < lcache) gel(T,n) = C;
    3516     5794061 :   return C;
    3517             : }
    3518             : 
    3519             : /* return the divisors of n, known to be among the elements of D */
    3520             : static GEN
    3521      339255 : div_restrict(GEN D, ulong n)
    3522             : {
    3523             :   long i, j, l;
    3524      339255 :   GEN v, VDIV = caches[cache_DIV].cache;
    3525      339255 :   if (lg(VDIV) > n) return gel(VDIV,n);
    3526           0 :   l = lg(D);
    3527           0 :   v = cgetg(l, t_VECSMALL);
    3528           0 :   for (i = j = 1; i < l; i++)
    3529             :   {
    3530           0 :     ulong d = D[i];
    3531           0 :     if (n % d == 0) v[j++] = d;
    3532             :   }
    3533           0 :   setlg(v,j); return v;
    3534             : }
    3535             : 
    3536             : /* for some prime divisors of N, Tr^new(p) = 0 */
    3537             : static int
    3538      193207 : trconj(GEN T, long N, long n)
    3539      193207 : { return (lg(T) > 1 && N % n == 0 && zv_search(T, n)); }
    3540             : 
    3541             : /* n > 0; trace formula on new space */
    3542             : static GEN
    3543     1921031 : mfnewtrace_i(long N, long k, long n, cachenew_t *cache)
    3544             : {
    3545     1921031 :   GEN VCHIP, s, Dn, DN1, SN, S = cache->DATA;
    3546             :   long FC, N1, N2, N1N2, g, i, j, lDN1;
    3547             : 
    3548     1921031 :   if (!S) return gen_0;
    3549     1921031 :   SN = gel(S,N);
    3550     1921031 :   if (mfnewchkzero(gel(SN,_NEWLZ), n)) return gen_0;
    3551     1428322 :   if (k > 2 && trconj(gel(SN,_TRCONJ), N, n)) return gen_0;
    3552     1428294 :   VCHIP = gel(SN, _VCHIP); FC = vchip_FC(VCHIP);
    3553     1428294 :   N1 = N/FC; newt_params(N1, n, FC, &g, &N2);
    3554     1428294 :   N1N2 = N1/N2;
    3555     1428294 :   DN1 = mydivisorsu(N1N2); lDN1 = lg(DN1);
    3556     1428294 :   N2 *= FC;
    3557     1428294 :   Dn = mydivisorsu(n); /* this one is probably out of cache */
    3558     1428294 :   s = gmulsg(mubeta2(N1N2,n), mfcusptracecache(N2, k, n, Dn, gel(S,N2), cache));
    3559     5454806 :   for (i = 2; i < lDN1; i++)
    3560             :   { /* skip M1 = 1, done above */
    3561     4026512 :     long M1 = DN1[i], N1M1 = DN1[lDN1-i];
    3562     4026512 :     GEN Dg = mydivisorsu(ugcd(M1, g));
    3563     4026512 :     M1 *= N2;
    3564     4026512 :     s = gadd(s, gmulsg(mubeta2(N1M1,n),
    3565     4026512 :                        mfcusptracecache(M1, k, n, Dn, gel(S,M1), cache)));
    3566     4365767 :     for (j = 2; j < lg(Dg); j++) /* skip d = 1, done above */
    3567             :     {
    3568      339255 :       long d = Dg[j], ndd = n/(d*d), M = M1/d;
    3569      339255 :       GEN z = mulsi(mubeta2(N1M1,ndd), powuu(d,k-1)), C = vchip_lift(VCHIP,d,z);
    3570      339255 :       GEN Dndd = div_restrict(Dn, ndd);
    3571      339255 :       s = gadd(s, gmul(C, mfcusptracecache(M, k, ndd, Dndd, gel(S,M), cache)));
    3572             :     }
    3573     4026512 :     s = vchip_mod(VCHIP, s);
    3574             :   }
    3575     1428294 :   return vchip_polmod(VCHIP, s);
    3576             : }
    3577             : 
    3578             : /* mfcuspdim(N,k,CHI) - mfnewdim(N,k,CHI); CHIP primitive (for efficiency) */
    3579             : static long
    3580        7938 : mfolddim_i(long N, long k, GEN CHIP)
    3581             : {
    3582        7938 :   long S, i, l, FC = mfcharmodulus(CHIP), N1 = N/FC, N2;
    3583             :   GEN D;
    3584        7938 :   newd_params(N1, &N2); /* will ensure mubeta != 0 */
    3585        7938 :   D = mydivisorsu(N1/N2); l = lg(D);
    3586        7938 :   N2 *= FC; S = 0;
    3587       31024 :   for (i = 2; i < l; i++)
    3588             :   {
    3589       23086 :     long M = D[l-i]*N2, d = mfcuspdim(M, k, CHIP);
    3590       23086 :     if (d) S -= mubeta(D[i]) * d;
    3591             :   }
    3592        7938 :   return S;
    3593             : }
    3594             : long
    3595         399 : mfolddim(long N, long k, GEN CHI)
    3596             : {
    3597         399 :   pari_sp av = avma;
    3598         399 :   GEN CHIP = mfchartoprimitive(CHI, NULL);
    3599         399 :   return gc_long(av, mfolddim_i(N, k, CHIP));
    3600             : }
    3601             : /* Only depends on CHIP the primitive char attached to CHI; assumes !badchar */
    3602             : long
    3603       15232 : mfnewdim(long N, long k, GEN CHI)
    3604             : {
    3605             :   pari_sp av;
    3606             :   long S;
    3607       15232 :   GEN CHIP = mfchartoprimitive(CHI, NULL);
    3608       15232 :   S = mfcuspdim(N, k, CHIP); if (!S) return 0;
    3609        7525 :   av = avma; return gc_long(av, S - mfolddim_i(N, k, CHIP));
    3610             : }
    3611             : 
    3612             : /* trace form, given as closure */
    3613             : static GEN
    3614         924 : mftraceform_new(long N, long k, GEN CHI)
    3615             : {
    3616             :   GEN T;
    3617         924 :   if (k == 1) return initwt1newtrace(mfinit_Nkchi(N, 1, CHI, mf_CUSP, 0));
    3618         903 :   T = initnewtrace(N,CHI); if (!T) return mftrivial();
    3619         903 :   return tag(t_MF_NEWTRACE, mkNK(N,k,CHI), T);
    3620             : }
    3621             : static GEN
    3622          14 : mftraceform_cusp(long N, long k, GEN CHI)
    3623             : {
    3624          14 :   if (k == 1) return initwt1trace(mfinit_Nkchi(N, 1, CHI, mf_CUSP, 0));
    3625           7 :   return tag(t_MF_TRACE, mkNK(N,k,CHI), inittrace(N,CHI,NULL));
    3626             : }
    3627             : static GEN
    3628          91 : mftraceform_i(GEN NK, long space)
    3629             : {
    3630             :   GEN CHI;
    3631             :   long N, k;
    3632          91 :   checkNK(NK, &N, &k, &CHI, 0);
    3633          91 :   if (!mfdim_Nkchi(N, k, CHI, space)) return mftrivial();
    3634          70 :   switch(space)
    3635             :   {
    3636          49 :     case mf_NEW: return mftraceform_new(N, k, CHI);
    3637          14 :     case mf_CUSP:return mftraceform_cusp(N, k, CHI);
    3638             :   }
    3639           7 :   pari_err_DOMAIN("mftraceform", "space", "=", utoi(space), NK);
    3640             :   return NULL;/*LCOV_EXCL_LINE*/
    3641             : }
    3642             : GEN
    3643          91 : mftraceform(GEN NK, long space)
    3644          91 : { pari_sp av = avma; return gerepilecopy(av, mftraceform_i(NK,space)); }
    3645             : 
    3646             : static GEN
    3647       15456 : hecke_data(long N, long n)
    3648       15456 : { return mkvecsmall3(n, u_ppo(n, N), N); }
    3649             : /* 1/2-integral weight */
    3650             : static GEN
    3651          84 : heckef2_data(long N, long n)
    3652             : {
    3653             :   ulong f, fN, fN2;
    3654          84 :   if (!uissquareall(n, &f)) return NULL;
    3655          77 :   fN = u_ppo(f, N); fN2 = fN*fN;
    3656          77 :   return mkvec2(myfactoru(fN), mkvecsmall4(n, N, fN2, n/fN2));
    3657             : }
    3658             : /* N = mf_get_N(F) or a multiple */
    3659             : static GEN
    3660       22372 : mfhecke_i(long n, long N, GEN F)
    3661             : {
    3662       22372 :   if (n == 1) return F;
    3663       15246 :   return tag2(t_MF_HECKE, mf_get_NK(F), hecke_data(N,n), F);
    3664             : }
    3665             : 
    3666             : GEN
    3667         105 : mfhecke(GEN mf, GEN F, long n)
    3668             : {
    3669         105 :   pari_sp av = avma;
    3670             :   GEN NK, CHI, gk, DATA;
    3671             :   long N, nk, dk;
    3672         105 :   mf = checkMF(mf);
    3673         105 :   if (!checkmf_i(F)) pari_err_TYPE("mfhecke",F);
    3674         105 :   if (n <= 0) pari_err_TYPE("mfhecke [n <= 0]", stoi(n));
    3675         105 :   if (n == 1) return gcopy(F);
    3676         105 :   gk = mf_get_gk(F);
    3677         105 :   Qtoss(gk,&nk,&dk);
    3678         105 :   CHI = mf_get_CHI(F);
    3679         105 :   N = MF_get_N(mf);
    3680         105 :   if (dk == 2)
    3681             :   {
    3682          77 :     DATA = heckef2_data(N,n);
    3683          77 :     if (!DATA) return mftrivial();
    3684             :   }
    3685             :   else
    3686          28 :     DATA = hecke_data(N,n);
    3687          98 :   NK = mkgNK(lcmii(stoi(N), mf_get_gN(F)), gk, CHI, mf_get_field(F));
    3688          98 :   return gerepilecopy(av, tag2(t_MF_HECKE, NK, DATA, F));
    3689             : }
    3690             : 
    3691             : /* form F given by closure, compute B(d)(F) as closure (q -> q^d) */
    3692             : static GEN
    3693       30135 : mfbd_i(GEN F, long d)
    3694             : {
    3695             :   GEN D, NK, gk, CHI;
    3696       30135 :   if (d == 1) return F;
    3697       11214 :   if (d <= 0) pari_err_TYPE("mfbd [d <= 0]", stoi(d));
    3698       11214 :   if (mf_get_type(F) != t_MF_BD) D = utoi(d);
    3699           7 :   else { D = mului(d, gel(F,3)); F = gel(F,2); }
    3700       11214 :   gk = mf_get_gk(F); CHI = mf_get_CHI(F);
    3701       11214 :   if (typ(gk) != t_INT) CHI = mfcharmul(CHI, get_mfchar(utoi(d << 2)));
    3702       11214 :   NK = mkgNK(muliu(mf_get_gN(F), d), gk, CHI, mf_get_field(F));
    3703       11214 :   return tag2(t_MF_BD, NK, F, D);
    3704             : }
    3705             : GEN
    3706          42 : mfbd(GEN F, long d)
    3707             : {
    3708          42 :   pari_sp av = avma;
    3709          42 :   if (!checkmf_i(F)) pari_err_TYPE("mfbd",F);
    3710          42 :   return gerepilecopy(av, mfbd_i(F, d));
    3711             : }
    3712             : 
    3713             : /* A[i+1] = a(t*i^2) */
    3714             : static GEN
    3715          98 : RgV_shimura(GEN A, long n, long t, long N, long r, GEN CHI)
    3716             : {
    3717          98 :   GEN R, a0, Pn = mfcharpol(CHI);
    3718          98 :   long m, st, ord = mfcharorder(CHI), vt = varn(Pn), Nt = t == 1? N: ulcm(N,t);
    3719             : 
    3720          98 :   R = cgetg(n + 2, t_VEC);
    3721          98 :   st = odd(r)? -t: t;
    3722          98 :   a0 = gel(A, 1);
    3723          98 :   if (!gequal0(a0))
    3724             :   {
    3725           7 :     long o = mfcharorder(CHI);
    3726           7 :     if (st != 1 && odd(o)) o <<= 1;
    3727           7 :     a0 = gmul(a0, charLFwtk(Nt, r, CHI, o, st));
    3728             :   }
    3729          98 :   gel(R, 1) = a0;
    3730         630 :   for (m = 1; m <= n; m++)
    3731             :   {
    3732         532 :     GEN Dm = mydivisorsu(u_ppo(m, Nt)), S = gel(A, m*m + 1);
    3733         532 :     long i, l = lg(Dm);
    3734         805 :     for (i = 2; i < l; i++)
    3735             :     { /* (e,Nt) = 1; skip i = 1: e = 1, done above */
    3736         273 :       long e = Dm[i], me = m / e, a = mfcharevalord(CHI, e, ord);
    3737         273 :       GEN c, C = powuu(e, r - 1);
    3738         273 :       if (kross(st, e) == -1) C = negi(C);
    3739         273 :       c = Qab_Czeta(a, ord, C, vt);
    3740         273 :       S = gadd(S, gmul(c, gel(A, me*me + 1)));
    3741             :     }
    3742         532 :     gel(R, m+1) = S;
    3743             :   }
    3744          98 :   return degpol(Pn) > 1? gmodulo(R, Pn): R;
    3745             : }
    3746             : 
    3747             : static long
    3748          28 : mfisinkohnen(GEN mf, GEN F)
    3749             : {
    3750          28 :   GEN v, gk = MF_get_gk(mf), CHI = MF_get_CHI(mf);
    3751          28 :   long i, eps, N4 = MF_get_N(mf) >> 2, sb = mfsturmNgk(N4 << 4, gk) + 1;
    3752          28 :   eps = N4 % mfcharconductor(CHI)? -1 : 1;
    3753          28 :   if (odd(MF_get_r(mf))) eps = -eps;
    3754          28 :   v = mfcoefs(F, sb, 1);
    3755         686 :   for (i = 2;     i <= sb; i+=4) if (!gequal0(gel(v,i+1))) return 0;
    3756         245 :   for (i = 2+eps; i <= sb; i+=4) if (!gequal0(gel(v,i+1))) return 0;
    3757          14 :   return 1;
    3758             : }
    3759             : 
    3760             : static long
    3761          42 : mfshimura_space_cusp(GEN mf)
    3762             : {
    3763             :   long N4;
    3764          42 :   if (MF_get_r(mf) == 1 && (N4 = MF_get_N(mf) >> 2) >= 4)
    3765             :   {
    3766          21 :     GEN E = gel(myfactoru(N4), 2);
    3767          21 :     long ma = vecsmall_max(E);
    3768          21 :     if (ma > 2 || (ma == 2 && !mfcharistrivial(MF_get_CHI(mf)))) return 0;
    3769             :   }
    3770          28 :   return 1;
    3771             : }
    3772             : 
    3773             : /* D is either a discriminant (not necessarily fundamental) with
    3774             :    sign(D)=(-1)^{k-1/2}*eps, or a positive squarefree integer t, which is then
    3775             :    transformed into a fundamental discriminant of the correct sign. */
    3776             : GEN
    3777          42 : mfshimura(GEN mf, GEN F, long t)
    3778             : {
    3779          42 :   pari_sp av = avma;
    3780             :   GEN G, res, mf2, CHI;
    3781          42 :   long sb, M, r, N, space = mf_FULL;
    3782             : 
    3783          42 :   if (!checkmf_i(F)) pari_err_TYPE("mfshimura",F);
    3784          42 :   mf = checkMF(mf);
    3785          42 :   r = MF_get_r(mf);
    3786          42 :   if (r <= 0) pari_err_DOMAIN("mfshimura", "weight", "<=", ghalf, mf_get_gk(F));
    3787          42 :   if (t <= 0 || !uissquarefree(t)) pari_err_TYPE("mfshimura [t]", stoi(t));
    3788          35 :   N = MF_get_N(mf); M = N >> 1;
    3789          35 :   if (mfiscuspidal(mf,F))
    3790             :   {
    3791          28 :     if (mfshimura_space_cusp(mf)) space = mf_CUSP;
    3792          28 :     if (mfisinkohnen(mf,F)) M = N >> 2;
    3793             :   }
    3794          35 :   CHI = MF_get_CHI(mf);
    3795          35 :   mf2 = mfinit_Nkchi(M, r << 1, mfcharpow(CHI, gen_2), space, 0);
    3796          35 :   sb = mfsturm(mf2);
    3797          35 :   G = RgV_shimura(mfcoefs_i(F, sb*sb, t), sb, t, N, r, CHI);
    3798          35 :   res = mftobasis_i(mf2, G);
    3799             :   /* not mflinear(mf2,): we want lowest possible level */
    3800          35 :   G = mflinear(MF_get_basis(mf2), res);
    3801          35 :   return gerepilecopy(av, mkvec3(mf2, G, res));
    3802             : }
    3803             : 
    3804             : /* W ZabM (ZM if n = 1), a t_INT or NULL, b t_INT, ZXQ mod P or NULL.
    3805             :  * Write a/b = A/d with d t_INT and A Zab return [W,d,A,P] */
    3806             : static GEN
    3807        7168 : mkMinv(GEN W, GEN a, GEN b, GEN P)
    3808             : {
    3809        7168 :   GEN A = (b && typ(b) == t_POL)? Q_remove_denom(QXQ_inv(b,P), &b): NULL;
    3810        7168 :   if (a && b)
    3811             :   {
    3812        1148 :     a = Qdivii(a,b);
    3813        1148 :     if (typ(a) == t_INT) b = gen_1; else { b = gel(a,2); a = gel(a,1); }
    3814        1148 :     if (is_pm1(a)) a = NULL;
    3815             :   }
    3816        7168 :   if (a) A = A? ZX_Z_mul(A,a): a; else if (!A) A = gen_1;
    3817        7168 :   if (!b) b = gen_1;
    3818        7168 :   if (!P) P = gen_0;
    3819        7168 :   return mkvec4(W,b,A,P);
    3820             : }
    3821             : /* M square invertible QabM, return [M',d], M*M' = d*Id */
    3822             : static GEN
    3823         532 : QabM_Minv(GEN M, GEN P, long n)
    3824             : {
    3825             :   GEN dW, W, dM;
    3826         532 :   M = Q_remove_denom(M, &dM);
    3827         532 :   W = P? ZabM_inv(liftpol_shallow(M), P, n, &dW): ZM_inv(M, &dW);
    3828         532 :   return mkMinv(W, dM, dW, P);
    3829             : }
    3830             : /* Simplified form of mfclean, after a QabM_indexrank: M a ZabM with full
    3831             :  * column rank and z = indexrank(M) is known */
    3832             : static GEN
    3833         826 : mfclean2(GEN M, GEN z, GEN P, long n)
    3834             : {
    3835         826 :   GEN d, Minv, y = gel(z,1), W = rowpermute(M, y);
    3836         826 :   W = P? ZabM_inv(liftpol_shallow(W), P, n, &d): ZM_inv(W, &d);
    3837         826 :   M = rowslice(M, 1, y[lg(y)-1]);
    3838         826 :   Minv = mkMinv(W, NULL, d, P);
    3839         826 :   return mkvec3(y, Minv, M);
    3840             : }
    3841             : /* M QabM, lg(M)>1 and [y,z] its rank profile. Let Minv be the inverse of the
    3842             :  * invertible square matrix in mkMinv format. Return [y,Minv, M[..y[#y],]]
    3843             :  * P cyclotomic polynomial of order n > 2 or NULL */
    3844             : static GEN
    3845        4599 : mfclean(GEN M, GEN P, long n, int ratlift)
    3846             : {
    3847        4599 :   GEN W, v, y, z, d, Minv, dM, MdM = Q_remove_denom(M, &dM);
    3848        4599 :   if (n <= 2)
    3849        3633 :     W = ZM_pseudoinv(MdM, &v, &d);
    3850             :   else
    3851         966 :     W = ZabM_pseudoinv_i(liftpol_shallow(MdM), P, n, &v, &d, ratlift);
    3852        4599 :   y = gel(v,1);
    3853        4599 :   z = gel(v,2);
    3854        4599 :   if (lg(z) != lg(MdM)) M = vecpermute(M,z);
    3855        4599 :   M = rowslice(M, 1, y[lg(y)-1]);
    3856        4599 :   Minv = mkMinv(W, dM, d, P);
    3857        4599 :   return mkvec3(y, Minv, M);
    3858             : }
    3859             : /* call mfclean using only CHI */
    3860             : static GEN
    3861        3731 : mfcleanCHI(GEN M, GEN CHI, int ratlift)
    3862             : {
    3863        3731 :   long n = mfcharorder(CHI);
    3864        3731 :   GEN P = (n <= 2)? NULL: mfcharpol(CHI);
    3865        3731 :   return mfclean(M, P, n, ratlift);
    3866             : }
    3867             : 
    3868             : /* DATA component of a t_MF_NEWTRACE. Was it stripped to save memory ? */
    3869             : static int
    3870       30919 : newtrace_stripped(GEN DATA)
    3871       30919 : { return DATA && (lg(DATA) == 5 && typ(gel(DATA,3)) == t_INT); }
    3872             : /* f a t_MF_NEWTRACE */
    3873             : static GEN
    3874       30919 : newtrace_DATA(long N, GEN f)
    3875             : {
    3876       30919 :   GEN DATA = gel(f,2);
    3877       30919 :   return newtrace_stripped(DATA)? initnewtrace(N, DATA): DATA;
    3878             : }
    3879             : /* reset cachenew for new level incorporating new DATA, tf a t_MF_NEWTRACE
    3880             :  * (+ possibly initialize 'full' for new allowed levels) */
    3881             : static void
    3882       30919 : reset_cachenew(cachenew_t *cache, long N, GEN tf)
    3883             : {
    3884             :   long i, n, l;
    3885       30919 :   GEN v, DATA = newtrace_DATA(N,tf);
    3886       30919 :   cache->DATA = DATA;
    3887       30919 :   if (!DATA) return;
    3888       30814 :   n = cache->n;
    3889       30814 :   v = cache->vfull; l = N+1; /* = lg(DATA) */
    3890     1844234 :   for (i = 1; i < l; i++)
    3891     1813420 :     if (typ(gel(v,i)) == t_INT && lg(gel(DATA,i)) != 1)
    3892       47782 :       gel(v,i) = const_vec(n, NULL);
    3893       30814 :   cache->VCHIP = gel(gel(DATA,N),_VCHIP);
    3894             : }
    3895             : /* initialize a cache of newtrace / cusptrace up to index n and level | N;
    3896             :  * DATA may be NULL (<=> Tr^new = 0). tf a t_MF_NEWTRACE */
    3897             : static void
    3898       11907 : init_cachenew(cachenew_t *cache, long n, long N, GEN tf)
    3899             : {
    3900       11907 :   long i, l = N+1; /* = lg(tf.DATA) when DATA != NULL */
    3901             :   GEN v;
    3902       11907 :   cache->n = n;
    3903       11907 :   cache->vnew = v = cgetg(l, t_VEC);
    3904      793499 :   for (i = 1; i < l; i++) gel(v,i) = (N % i)? gen_0: const_vec(n, NULL);
    3905       11907 :   cache->newHIT = cache->newTOTAL = cache->cuspHIT = cache->cuspTOTAL = 0;
    3906       11907 :   cache->vfull = v = zerovec(N);
    3907       11907 :   reset_cachenew(cache, N, tf);
    3908       11907 : }
    3909             : static void
    3910       16240 : dbg_cachenew(cachenew_t *C)
    3911             : {
    3912       16240 :   if (DEBUGLEVEL >= 2 && C)
    3913           0 :     err_printf("newtrace cache hits: new = %ld/%ld, cusp = %ld/%ld\n",
    3914             :                     C->newHIT, C->newTOTAL, C->cuspHIT, C->cuspTOTAL);
    3915       16240 : }
    3916             : 
    3917             : /* newtrace_{N,k}(d*i), i = n0, ..., n */
    3918             : static GEN
    3919      137221 : colnewtrace(long n0, long n, long d, long N, long k, cachenew_t *cache)
    3920             : {
    3921      137221 :   GEN v = cgetg(n-n0+2, t_COL);
    3922             :   long i;
    3923     3311553 :   for (i = n0; i <= n; i++) gel(v, i-n0+1) = mfnewtracecache(N, k, i*d, cache);
    3924      137221 :   return v;
    3925             : }
    3926             : /* T_n(l*m0, l*(m0+1), ..., l*m) F, F = t_MF_NEWTRACE [N,k],DATA, cache
    3927             :  * contains DATA != NULL as well as cached values of F */
    3928             : static GEN
    3929       75383 : heckenewtrace(long m0, long m, long l, long N, long NBIG, long k, long n, cachenew_t *cache)
    3930             : {
    3931       75383 :   long lD, a, k1, nl = n*l;
    3932       75383 :   GEN D, V, v = colnewtrace(m0, m, nl, N, k, cache); /* d=1 */
    3933             :   GEN VCHIP;
    3934       75383 :   if (n == 1) return v;
    3935       49434 :   VCHIP = cache->VCHIP;
    3936       49434 :   D = mydivisorsu(u_ppo(n, NBIG)); lD = lg(D);
    3937       49434 :   k1 = k - 1;
    3938      109732 :   for (a = 2; a < lD; a++)
    3939             :   { /* d > 1, (d,NBIG) = 1 */
    3940       60298 :     long i, j, d = D[a], c = ugcd(l, d), dl = d/c, m0d = ceildiv(m0, dl);
    3941       60298 :     GEN C = vchip_lift(VCHIP, d, powuu(d, k1));
    3942             :     /* m0=0: i = 1 => skip F(0) = 0 */
    3943       60298 :     if (!m0) { i = 1; j = dl; } else { i = 0; j = m0d*dl; }
    3944       60298 :     V = colnewtrace(m0d, m/dl, nl/(d*c), N, k, cache);
    3945             :     /* C = chi(d) d^(k-1) */
    3946      625058 :     for (; j <= m; i++, j += dl)
    3947      564760 :       gel(v,j-m0+1) = gadd(gel(v,j-m0+1), vchip_mod(VCHIP, gmul(C,gel(V,i+1))));
    3948             :   }
    3949       49434 :   return v;
    3950             : }
    3951             : 
    3952             : /* Given v = an[i], return an[d*i] */
    3953             : static GEN
    3954         658 : anextract(GEN v, long n, long d)
    3955             : {
    3956         658 :   GEN w = cgetg(n+2, t_VEC);
    3957             :   long i;
    3958        2744 :   for (i = 0; i <= n; i++) gel(w, i+1) = gel(v, i*d+1);
    3959         658 :   return w;
    3960             : }
    3961             : /* T_n(F)(0, l, ..., l*m) */
    3962             : static GEN
    3963        1414 : hecke_i(long m, long l, GEN V, GEN F, GEN DATA)
    3964             : {
    3965             :   long k, n, nNBIG, NBIG, lD, M, a, t, nl;
    3966             :   GEN D, v, CHI;
    3967        1414 :   if (typ(DATA) == t_VEC)
    3968             :   { /* 1/2-integral k */
    3969          98 :     if (!V) { GEN S = gel(DATA,2); V = mfcoefs_i(F, m*l*S[3], S[4]); }
    3970          98 :     return RgV_heckef2(m, l, V, F, DATA);
    3971             :   }
    3972        1316 :   k = mf_get_k(F);
    3973        1316 :   n = DATA[1]; nl = n*l;
    3974        1316 :   nNBIG = DATA[2];
    3975        1316 :   NBIG = DATA[3];
    3976        1316 :   if (nNBIG == 1) return V? V: mfcoefs_i(F,m,nl);
    3977         651 :   if (!V && mf_get_type(F) == t_MF_NEWTRACE)
    3978             :   { /* inline F to allow cache, T_n at level NBIG acting on Tr^new(N,k,CHI) */
    3979             :     cachenew_t cache;
    3980         322 :     long N = mf_get_N(F);
    3981         322 :     init_cachenew(&cache, m*nl, N, F);
    3982         322 :     v = heckenewtrace(0, m, l, N, NBIG, k, n, &cache);
    3983         322 :     dbg_cachenew(&cache);
    3984         322 :     settyp(v, t_VEC); return v;
    3985             :   }
    3986         329 :   CHI = mf_get_CHI(F);
    3987         329 :   D = mydivisorsu(nNBIG); lD = lg(D);
    3988         329 :   M = m + 1;
    3989         329 :   t = nNBIG * ugcd(nNBIG, l);
    3990         329 :   if (!V) V = mfcoefs_i(F, m * t, nl / t); /* usually nl = t */
    3991         329 :   v = anextract(V, m, t); /* mfcoefs(F, m, nl); d = 1 */
    3992         658 :   for (a = 2; a < lD; a++)
    3993             :   { /* d > 1, (d, NBIG) = 1 */
    3994         329 :     long d = D[a], c = ugcd(l, d), dl = d/c, i, idl;
    3995         329 :     GEN C = gmul(mfchareval(CHI, d), powuu(d, k-1));
    3996         329 :     GEN w = anextract(V, m/dl, t/(d*c)); /* mfcoefs(F, m/dl, nl/(d*c)) */
    3997        1008 :     for (i = idl = 1; idl <= M; i++, idl += dl)
    3998         679 :       gel(v,idl) = gadd(gel(v,idl), gmul(C, gel(w,i)));
    3999             :   }
    4000         329 :   return v;
    4001             : }
    4002             : 
    4003             : static GEN
    4004       11725 : mkmf(GEN x1, GEN x2, GEN x3, GEN x4, GEN x5)
    4005             : {
    4006       11725 :   GEN MF = obj_init(5, MF_SPLITN);
    4007       11725 :   gel(MF,1) = x1;
    4008       11725 :   gel(MF,2) = x2;
    4009       11725 :   gel(MF,3) = x3;
    4010       11725 :   gel(MF,4) = x4;
    4011       11725 :   gel(MF,5) = x5; return MF;
    4012             : }
    4013             : 
    4014             : /* return an integer b such that p | b => T_p^k Tr^new = 0, for all k > 0 */
    4015             : static long
    4016        7273 : get_badj(long N, long FC)
    4017             : {
    4018        7273 :   GEN fa = myfactoru(N), P = gel(fa,1), E = gel(fa,2);
    4019        7273 :   long i, b = 1, l = lg(P);
    4020       19397 :   for (i = 1; i < l; i++)
    4021       12124 :     if (E[i] > 1 && u_lval(FC, P[i]) < E[i]) b *= P[i];
    4022        7273 :   return b;
    4023             : }
    4024             : /* in place, assume perm strictly increasing */
    4025             : static void
    4026        1148 : vecpermute_inplace(GEN v, GEN perm)
    4027             : {
    4028        1148 :   long i, l = lg(perm);
    4029        7770 :   for (i = 1; i < l; i++) gel(v,i) = gel(v,perm[i]);
    4030        1148 : }
    4031             : 
    4032             : /* Find basis of newspace using closures; assume k >= 2 and !badchar.
    4033             :  * Return NULL if space is empty, else
    4034             :  * [mf1, list of closures T(j)traceform, list of corresponding j, matrix] */
    4035             : static GEN
    4036       14994 : mfnewinit(long N, long k, GEN CHI, cachenew_t *cache, long init)
    4037             : {
    4038             :   GEN S, vj, M, CHIP, mf1, listj, P, tf;
    4039             :   long j, ct, ctlj, dim, jin, SB, sb, two, ord, FC, badj;
    4040             : 
    4041       14994 :   dim = mfnewdim(N, k, CHI);
    4042       14994 :   if (!dim && !init) return NULL;
    4043        7273 :   sb = mfsturmNk(N, k);
    4044        7273 :   CHIP = mfchartoprimitive(CHI, &FC);
    4045             :   /* remove newtrace data from S to save space in output: negligible slowdown */
    4046        7273 :   tf = tag(t_MF_NEWTRACE, mkNK(N,k,CHIP), CHIP);
    4047        7273 :   badj = get_badj(N, FC);
    4048             :   /* try sbsmall first: Sturm bound not sharp for new space */
    4049        7273 :   SB = ceilA1(N, k);
    4050        7273 :   listj = cgetg(2*sb + 3, t_VECSMALL);
    4051      332983 :   for (j = ctlj = 1; ctlj < 2*sb + 3; j++)
    4052      325710 :     if (ugcd(j, badj) == 1) listj[ctlj++] = j;
    4053        7273 :   if (init)
    4054             :   {
    4055        3990 :     init_cachenew(cache, (SB+1)*listj[dim+1], N, tf);
    4056        3990 :     if (init == -1 || !dim) return NULL; /* old space or dim = 0 */
    4057             :   }
    4058             :   else
    4059        3283 :     reset_cachenew(cache, N, tf);
    4060             :   /* cache.DATA is not NULL */
    4061        6818 :   ord = mfcharorder(CHIP);
    4062        6818 :   P = ord <= 2? NULL: mfcharpol(CHIP);
    4063        6818 :   vj = cgetg(dim+1, t_VECSMALL);
    4064        6818 :   M = cgetg(dim+1, t_MAT);
    4065        6825 :   for (two = 1, ct = 0, jin = 1; two <= 2; two++)
    4066             :   {
    4067        6825 :     long a, jlim = jin + sb;
    4068       19642 :     for (a = jin; a <= jlim; a++)
    4069             :     {
    4070             :       GEN z, vecz;
    4071       19635 :       ct++; vj[ct] = listj[a];
    4072       19635 :       gel(M, ct) = heckenewtrace(0, SB, 1, N, N, k, vj[ct], cache);
    4073       19635 :       if (ct < dim) continue;
    4074             : 
    4075        7392 :       z = QabM_indexrank(M, P, ord);
    4076        7392 :       vecz = gel(z, 2); ct = lg(vecz) - 1;
    4077        7392 :       if (ct == dim) { M = mkvec3(z, gen_0, M); break; } /*maximal rank, done*/
    4078         574 :       vecpermute_inplace(M, vecz);
    4079         574 :       vecpermute_inplace(vj, vecz);
    4080             :     }
    4081        6825 :     if (a <= jlim) break;
    4082             :     /* sbsmall was not sufficient, use Sturm bound: must extend M */
    4083          70 :     for (j = 1; j <= ct; j++)
    4084             :     {
    4085          63 :       GEN t = heckenewtrace(SB + 1, sb, 1, N, N, k, vj[j], cache);
    4086          63 :       gel(M,j) = shallowconcat(gel(M, j), t);
    4087             :     }
    4088           7 :     jin = jlim + 1; SB = sb;
    4089             :   }
    4090        6818 :   S = cgetg(dim + 1, t_VEC);
    4091       25865 :   for (j = 1; j <= dim; j++) gel(S, j) = mfhecke_i(vj[j], N, tf);
    4092        6818 :   dbg_cachenew(cache);
    4093        6818 :   mf1 = mkvec4(utoipos(N), utoipos(k), CHI, utoi(mf_NEW));
    4094        6818 :   return mkmf(mf1, cgetg(1,t_VEC), S, vj, M);
    4095             : }
    4096             : /* k > 1 integral, mf space is mf_CUSP or mf_FULL */
    4097             : static GEN
    4098          42 : mfinittonew(GEN mf)
    4099             : {
    4100          42 :   GEN CHI = MF_get_CHI(mf), S = MF_get_S(mf), vMjd = MFcusp_get_vMjd(mf);
    4101          42 :   GEN M = MF_get_M(mf), vj, mf1;
    4102          42 :   long i, j, l, l0 = lg(S), N0 = MF_get_N(mf);
    4103         203 :   for (i = l0-1; i > 0; i--)
    4104             :   {
    4105         189 :     long N = gel(vMjd,i)[1];
    4106         189 :     if (N != N0) break;
    4107             :   }
    4108          42 :   if (i == l0-1) return NULL;
    4109          35 :   S = vecslice(S, i+1, l0-1); /* forms of conductor N0 */
    4110          35 :   l = lg(S); vj = cgetg(l, t_VECSMALL);
    4111         196 :   for (j = 1; j < l; j++) vj[j] = gel(vMjd,j+i)[2];
    4112          35 :   M = vecslice(M, lg(M)-lg(S)+1, lg(M)-1); /* their coefficients */
    4113          35 :   M = mfcleanCHI(M, CHI, 0);
    4114          35 :   mf1 = mkvec4(utoipos(N0), MF_get_gk(mf), CHI, utoi(mf_NEW));
    4115          35 :   return mkmf(mf1, cgetg(1,t_VEC), S, vj, M);
    4116             : }
    4117             : 
    4118             : /* Bd(f)[m0..m], v = f[ceil(m0/d)..floor(m/d)], m0d = ceil(m0/d) */
    4119             : static GEN
    4120       69181 : RgC_Bd_expand(long m0, long m, GEN v, long d, long m0d)
    4121             : {
    4122             :   long i, j;
    4123             :   GEN w;
    4124       69181 :   if (d == 1) return v;
    4125       20160 :   w = zerocol(m-m0+1);
    4126       20160 :   if (!m0) { i = 1; j = d; } else { i = 0; j = m0d*d; }
    4127      411103 :   for (; j <= m; i++, j += d) gel(w,j-m0+1) = gel(v,i+1);
    4128       20160 :   return w;
    4129             : }
    4130             : /* S a non-empty vector of t_MF_BD(t_MF_HECKE(t_MF_NEWTRACE)); M the matrix
    4131             :  * of their coefficients r*0, r*1, ..., r*m0 (~ mfvectomat) or NULL (empty),
    4132             :  * extend it to coeffs up to m > m0. The forms B_d(T_j(tf_N))in S should be
    4133             :  * sorted by level N, then j, then increasing d. No reordering here. */
    4134             : static GEN
    4135        8218 : bhnmat_extend(GEN M, long m, long r, GEN S, cachenew_t *cache)
    4136             : {
    4137        8218 :   long i, mr, m0, m0r, Nold = 0, jold = 0, l = lg(S);
    4138        8218 :   GEN MAT = cgetg(l, t_MAT), v = NULL;
    4139        8218 :   if (M) { m0 = nbrows(M); m0r = m0 * r; } else m0 = m0r = 0;
    4140        8218 :   mr = m*r;
    4141       77399 :   for (i = 1; i < l; i++)
    4142             :   {
    4143             :     long d, j, md, N;
    4144       69181 :     GEN c, f = bhn_parse(gel(S,i), &d,&j); /* t_MF_NEWTRACE */
    4145       69181 :     N = mf_get_N(f);
    4146       69181 :     md = ceildiv(m0r,d);
    4147       69181 :     if (N != Nold) { reset_cachenew(cache, N, f); Nold = N; jold = 0; }
    4148       69181 :     if (!cache->DATA) { gel(MAT,i) = zerocol(m+1); continue; }
    4149       69181 :     if (j != jold || md)
    4150       55363 :     { v = heckenewtrace(md, mr/d, 1, N, N, mf_get_k(f), j,cache); jold=j; }
    4151       69181 :     c = RgC_Bd_expand(m0r, mr, v, d, md);
    4152       69181 :     if (r > 1) c = c_deflate(m-m0, r, c);
    4153       69181 :     if (M) c = shallowconcat(gel(M,i), c);
    4154       69181 :     gel(MAT,i) = c;
    4155             :   }
    4156        8218 :   return MAT;
    4157             : }
    4158             : 
    4159             : static GEN
    4160        3045 : mfinitcusp(long N, long k, GEN CHI, cachenew_t *cache, long space)
    4161             : {
    4162             :   long L, l, lDN1, FC, N1, d1, i, init;
    4163        3045 :   GEN vS, vMjd, DN1, vmf, CHIP = mfchartoprimitive(CHI, &FC);
    4164             : 
    4165        3045 :   d1 = (space == mf_OLD)? mfolddim_i(N, k, CHIP): mfcuspdim(N, k, CHIP);
    4166        3045 :   if (!d1) return NULL;
    4167        2793 :   N1 = N/FC; DN1 = mydivisorsu(N1); lDN1 = lg(DN1);
    4168        2793 :   init = (space == mf_OLD)? -1: 1;
    4169        2793 :   vmf = cgetg(lDN1, t_VEC);
    4170       16590 :   for (i = lDN1 - 1, l = 1; i; i--)
    4171             :   { /* by decreasing level to allow cache */
    4172       13797 :     GEN mf = mfnewinit(FC*DN1[i], k, CHIP, cache, init);
    4173       13797 :     if (mf) gel(vmf, l++) = mf;
    4174       13797 :     init = 0;
    4175             :   }
    4176        2793 :   setlg(vmf,l); vmf = vecreverse(vmf); /* reorder by increasing level */
    4177             : 
    4178        2793 :   L = mfsturmNk(N, k)+1;
    4179        2793 :   vS = vectrunc_init(L);
    4180        2793 :   vMjd = vectrunc_init(L);
    4181        8785 :   for (i = 1; i < l; i++)
    4182             :   {
    4183        5992 :     GEN DNM, mf = gel(vmf,i), S = MF_get_S(mf), vj = MFnew_get_vj(mf);
    4184        5992 :     long a, lDNM, lS = lg(S), M = MF_get_N(mf);
    4185        5992 :     DNM = mydivisorsu(N / M); lDNM = lg(DNM);
    4186       23002 :     for (a = 1; a < lS; a++)
    4187             :     {
    4188       17010 :       GEN tf = gel(S,a);
    4189       17010 :       long b, j = vj[a];
    4190       42189 :       for (b = 1; b < lDNM; b++)
    4191             :       {
    4192       25179 :         long d = DNM[b];
    4193       25179 :         vectrunc_append(vS, mfbd_i(tf, d));
    4194       25179 :         vectrunc_append(vMjd, mkvecsmall3(M, j, d));
    4195             :       }
    4196             :     }
    4197             :   }
    4198        2793 :   return mkmf(NULL, cgetg(1, t_VEC), vS, vMjd, NULL);
    4199             : }
    4200             : 
    4201             : long
    4202        3535 : mfsturm_mf(GEN mf)
    4203             : {
    4204        3535 :   GEN Mindex = MF_get_Mindex(mf);
    4205        3535 :   long n = lg(Mindex)-1;
    4206        3535 :   return n? Mindex[n]-1: 0;
    4207             : }
    4208             : 
    4209             : long
    4210         588 : mfsturm(GEN T)
    4211             : {
    4212             :   long N, nk, dk;
    4213         588 :   GEN CHI, mf = checkMF_i(T);
    4214         588 :   if (mf) return mfsturm_mf(mf);
    4215           7 :   checkNK2(T, &N, &nk, &dk, &CHI, 0);
    4216           7 :   return dk == 1 ? mfsturmNk(N, nk) : mfsturmNk(N, (nk + 1) >> 1);
    4217             : }
    4218             : long
    4219           7 : mfisequal(GEN F, GEN G, long lim)
    4220             : {
    4221           7 :   pari_sp av = avma;
    4222             :   long b;
    4223           7 :   if (!checkmf_i(F)) pari_err_TYPE("mfisequal",F);
    4224           7 :   if (!checkmf_i(G)) pari_err_TYPE("mfisequal",G);
    4225           7 :   b = lim? lim: maxss(mfsturmmf(F), mfsturmmf(G));
    4226           7 :   return gc_long(av, gequal(mfcoefs_i(F, b, 1), mfcoefs_i(G, b, 1)));
    4227             : }
    4228             : 
    4229             : GEN
    4230          35 : mffields(GEN mf)
    4231             : {
    4232          35 :   if (checkmf_i(mf)) return gcopy(mf_get_field(mf));
    4233          35 :   mf = checkMF(mf); return gcopy(MF_get_fields(mf));
    4234             : }
    4235             : 
    4236             : GEN
    4237         322 : mfeigenbasis(GEN mf)
    4238             : {
    4239         322 :   pari_sp ltop = avma;
    4240             :   GEN F, S, v, vP;
    4241             :   long i, l, k, dS;
    4242             : 
    4243         322 :   mf = checkMF(mf);
    4244         322 :   k = MF_get_k(mf);
    4245         322 :   S = MF_get_S(mf); dS = lg(S)-1;
    4246         322 :   if (!dS) return cgetg(1, t_VEC);
    4247         315 :   F = MF_get_newforms(mf);
    4248         315 :   vP = MF_get_fields(mf);
    4249         315 :   if (k == 1)
    4250             :   {
    4251         196 :     if (MF_get_space(mf) == mf_FULL)
    4252             :     {
    4253          14 :       long dE = lg(MF_get_E(mf)) - 1;
    4254          14 :       if (dE) F = rowslice(F, dE+1, dE+dS);
    4255             :     }
    4256         196 :     v = vecmflineardiv_linear(S, F);
    4257         196 :     l = lg(v);
    4258             :   }
    4259             :   else
    4260             :   {
    4261         119 :     GEN (*L)(GEN, GEN) = (MF_get_space(mf) == mf_FULL)? mflinear: mflinear_bhn;
    4262         119 :     l = lg(F); v = cgetg(l, t_VEC);
    4263         413 :     for (i = 1; i < l; i++) gel(v,i) = L(mf, gel(F,i));
    4264             :   }
    4265         819 :   for (i = 1; i < l; i++) mf_setfield(gel(v,i), gel(vP,i));
    4266         315 :   return gerepilecopy(ltop, v);
    4267             : }
    4268             : 
    4269             : /* Minv = [M, d, A], v a t_COL; A a Zab, d a t_INT; return (A/d) * M*v */
    4270             : static GEN
    4271        5887 : Minv_RgC_mul(GEN Minv, GEN v)
    4272             : {
    4273        5887 :   GEN M = gel(Minv,1), d = gel(Minv,2), A = gel(Minv,3);
    4274        5887 :   v = RgM_RgC_mul(M, v);
    4275        5887 :   if (!equali1(A))
    4276             :   {
    4277        1568 :     if (typ(A) == t_POL && degpol(A) > 0) A = mkpolmod(A, gel(Minv,4));
    4278        1568 :     v = RgC_Rg_mul(v, A);
    4279             :   }
    4280        5887 :   if (!equali1(d)) v = RgC_Rg_div(v, d);
    4281        5887 :   return v;
    4282             : }
    4283             : static GEN
    4284        1099 : Minv_RgM_mul(GEN Minv, GEN B)
    4285             : {
    4286        1099 :   long j, l = lg(B);
    4287        1099 :   GEN M = cgetg(l, t_MAT);
    4288        4627 :   for (j = 1; j < l; j++) gel(M,j) = Minv_RgC_mul(Minv, gel(B,j));
    4289        1099 :   return M;
    4290             : }
    4291             : /* B * Minv; allow B = NULL for Id */
    4292             : static GEN
    4293        2212 : RgM_Minv_mul(GEN B, GEN Minv)
    4294             : {
    4295        2212 :   GEN M = gel(Minv,1), d = gel(Minv,2), A = gel(Minv,3);
    4296        2212 :   if (B) M = RgM_mul(B, M);
    4297        2212 :   if (!equali1(A))
    4298             :   {
    4299         882 :     if (typ(A) == t_POL) A = mkpolmod(A, gel(Minv,4));
    4300         882 :     M = RgM_Rg_mul(M, A);
    4301             :   }
    4302        2212 :   if (!equali1(d)) M = RgM_Rg_div(M,d);
    4303        2212 :   return M;
    4304             : }
    4305             : 
    4306             : /* perm vector of strictly increasing indices, v a vector or arbitrary length;
    4307             :  * the last r entries of perm fall beyond v.
    4308             :  * Return v o perm[1..(-r)], discarding the last r entries of v */
    4309             : static GEN
    4310        1127 : vecpermute_partial(GEN v, GEN perm, long *r)
    4311             : {
    4312        1127 :   long i, n = lg(v)-1, l = lg(perm);
    4313             :   GEN w;
    4314        1127 :   if (perm[l-1] <= n) { *r = 0; return vecpermute(v,perm); }
    4315          63 :   for (i = 1; i < l; i++)
    4316          63 :     if (perm[i] > n) break;
    4317          21 :   *r = l - i; l = i;
    4318          21 :   w = cgetg(l, typ(v));
    4319          63 :   for (i = 1; i < l; i++) gel(w,i) = gel(v,perm[i]);
    4320          21 :   return w;
    4321             : }
    4322             : 
    4323             : /* given form F, find coeffs of F on mfbasis(mf). If power series, not
    4324             :  * guaranteed correct if precision less than Sturm bound */
    4325             : static GEN
    4326        1183 : mftobasis_i(GEN mf, GEN F)
    4327             : {
    4328             :   GEN v, Mindex, Minv;
    4329        1183 :   if (!MF_get_dim(mf)) return cgetg(1, t_COL);
    4330        1183 :   Mindex = MF_get_Mindex(mf);
    4331        1183 :   Minv = MF_get_Minv(mf);
    4332        1183 :   if (checkmf_i(F))
    4333             :   {
    4334         252 :     long n = Mindex[lg(Mindex)-1];
    4335         252 :     v = vecpermute(mfcoefs_i(F, n, 1), Mindex);
    4336         252 :     return Minv_RgC_mul(Minv, v);
    4337             :   }
    4338             :   else
    4339             :   {
    4340         931 :     GEN A = gel(Minv,1), d = gel(Minv,2);
    4341             :     long r;
    4342         931 :     v = F;
    4343         931 :     switch(typ(F))
    4344             :     {
    4345           0 :       case t_SER: v = sertocol(v);
    4346         931 :       case t_VEC: case t_COL: break;
    4347           0 :       default: pari_err_TYPE("mftobasis", F);
    4348             :     }
    4349         931 :     if (lg(v) == 1) pari_err_TYPE("mftobasis",v);
    4350         931 :     v = vecpermute_partial(v, Mindex, &r);
    4351         931 :     if (!r) return Minv_RgC_mul(Minv, v); /* single solution */
    4352             :     /* affine space of dimension r */
    4353          21 :     v = RgM_RgC_mul(vecslice(A, 1, lg(v)-1), v);
    4354          21 :     if (!equali1(d)) v = RgC_Rg_div(v,d);
    4355          21 :     return mkvec2(v, vecslice(A, lg(A)-r, lg(A)-1));
    4356             :   }
    4357             : }
    4358             : 
    4359             : static GEN
    4360         546 : const_mat(long n, GEN x)
    4361             : {
    4362         546 :   long j, l = n+1;
    4363         546 :   GEN A = cgetg(l,t_MAT);
    4364        3990 :   for (j = 1; j < l; j++) gel(A,j) = const_col(n, x);
    4365         546 :   return A;
    4366             : }
    4367             : 
    4368             : /* L is the mftobasis of a form on CUSP space. We allow mf_FULL or mf_CUSP */
    4369             : static GEN
    4370         273 : mftonew_i(GEN mf, GEN L, long *plevel)
    4371             : {
    4372             :   GEN S, listMjd, CHI, res, Aclos, Acoef, D, perm;
    4373         273 :   long N1, LC, lD, i, l, t, level, N = MF_get_N(mf);
    4374             : 
    4375         273 :   if (MF_get_k(mf) == 1) pari_err_IMPL("mftonew in weight 1");
    4376         273 :   listMjd = MFcusp_get_vMjd(mf);
    4377         273 :   CHI = MF_get_CHI(mf); LC = mfcharconductor(CHI);
    4378         273 :   S = MF_get_S(mf);
    4379             : 
    4380         273 :   N1 = N/LC;
    4381         273 :   D = mydivisorsu(N1); lD = lg(D);
    4382         273 :   perm = cgetg(N1+1, t_VECSMALL);
    4383        1995 :   for (i = 1; i < lD; i++) perm[D[i]] = i;
    4384         273 :   Aclos = const_mat(lD-1, cgetg(1,t_VEC));
    4385         273 :   Acoef = const_mat(lD-1, cgetg(1,t_VEC));
    4386         273 :   l = lg(listMjd);
    4387        2863 :   for (i = 1; i < l; i++)
    4388             :   {
    4389             :     long M, d;
    4390             :     GEN v;
    4391        2590 :     if (gequal0(gel(L,i))) continue;
    4392         266 :     v = gel(listMjd, i);
    4393         266 :     M = perm[ v[1]/LC ];
    4394         266 :     d = perm[ v[3] ];
    4395         266 :     gcoeff(Aclos,M,d) = vec_append(gcoeff(Aclos,M,d), gel(S,i));
    4396         266 :     gcoeff(Acoef,M,d) = shallowconcat(gcoeff(Acoef,M,d), gel(L,i));
    4397             :   }
    4398         273 :   res = cgetg(l, t_VEC); level = 1;
    4399        1995 :   for (i = t = 1; i < lD; i++)
    4400             :   {
    4401        1722 :     long j, M = D[i]*LC;
    4402        1722 :     GEN gM = utoipos(M);
    4403       15120 :     for (j = 1; j < lD; j++)
    4404             :     {
    4405       13398 :       GEN f = gcoeff(Aclos,i,j), C, NK;
    4406             :       long d;
    4407       13398 :       if (lg(f) == 1) continue;
    4408         238 :       NK = mf_get_NK(gel(f,1));
    4409         238 :       d = D[j];
    4410         238 :       C = gcoeff(Acoef,i,j);
    4411         238 :       level = ulcm(level, M*d);
    4412         238 :       gel(res,t++) = mkvec3(gM, utoipos(d), mflinear_i(NK,f,C));
    4413             :     }
    4414             :   }
    4415         273 :   if (plevel) *plevel = level;
    4416         273 :   setlg(res, t); return res;
    4417             : }
    4418             : GEN
    4419          35 : mftonew(GEN mf, GEN F)
    4420             : {
    4421          35 :   pari_sp av = avma;
    4422             :   GEN ES;
    4423             :   long s;
    4424          35 :   mf = checkMF(mf);
    4425          35 :   s = MF_get_space(mf);
    4426          35 :   if (s != mf_FULL && s != mf_CUSP)
    4427           7 :     pari_err_TYPE("mftonew [not a full or cuspidal space]", mf);
    4428          28 :   ES = mftobasisES(mf,F);
    4429          21 :   if (!gequal0(gel(ES,1)))
    4430           0 :     pari_err_TYPE("mftonew [not a cuspidal form]", F);
    4431          21 :   F = gel(ES,2);
    4432          21 :   return gerepilecopy(av, mftonew_i(mf,F, NULL));
    4433             : }
    4434             : 
    4435             : static GEN mfeisenstein_i(long k, GEN CHI1, GEN CHI2);
    4436             : 
    4437             : /* mfinit(F * Theta) */
    4438             : static GEN
    4439          84 : mf2init(GEN mf)
    4440             : {
    4441          84 :   GEN CHI = MF_get_CHI(mf), gk = gadd(MF_get_gk(mf), ghalf);
    4442          84 :   long N = MF_get_N(mf);
    4443          84 :   return mfinit_Nkchi(N, itou(gk), mfchiadjust(CHI, gk, N), mf_FULL, 0);
    4444             : }
    4445             : 
    4446             : static long
    4447         518 : mfvec_first_cusp(GEN v)
    4448             : {
    4449         518 :   long i, l = lg(v);
    4450        1330 :   for (i = 1; i < l; i++)
    4451             :   {
    4452        1246 :     GEN F = gel(v,i);
    4453        1246 :     long t = mf_get_type(F);
    4454        1246 :     if (t == t_MF_BD) { F = gel(F,2); t = mf_get_type(F); }
    4455        1246 :     if (t == t_MF_HECKE) { F = gel(F,3); t = mf_get_type(F); }
    4456        1246 :     if (t == t_MF_NEWTRACE) break;
    4457             :   }
    4458         518 :   return i;
    4459             : }
    4460             : /* vF a vector of mf F of type DIV(LINEAR(BAS,L), f) in (lcm) level N,
    4461             :  * F[2]=LINEAR(BAS,L), F[2][2]=BAS=fixed basis (Eisenstein or bhn type),
    4462             :  * F[2][3]=L, F[3]=f; mfvectomat(vF, n) */
    4463             : static GEN
    4464         525 : mflineardivtomat(long N, GEN vF, long n)
    4465             : {
    4466         525 :   GEN F, M, f, fc, ME, dB, B, a0, V = NULL;
    4467         525 :   long lM, lF = lg(vF), j;
    4468             : 
    4469         525 :   if (lF == 1) return cgetg(1,t_MAT);
    4470         518 :   F = gel(vF,1);
    4471         518 :   if (lg(F) == 5)
    4472             :   { /* chicompat */
    4473         238 :     V = gmael(F,4,4);
    4474         238 :     if (typ(V) == t_INT) V = NULL;
    4475             :   }
    4476         518 :   M = gmael(F,2,2); /* BAS */
    4477         518 :   lM = lg(M);
    4478         518 :   j = mfvec_first_cusp(M);
    4479         518 :   if (j == 1) ME = NULL;
    4480             :   else
    4481             :   { /* BAS starts by Eisenstein */
    4482         133 :     ME = mfvectomat(vecslice(M,1,j-1), n, 1);
    4483         133 :     M = vecslice(M, j,lM-1);
    4484             :   }
    4485         518 :   M = bhnmat_extend_nocache(NULL, N, n, 1, M);
    4486         518 :   if (ME) M = shallowconcat(ME,M);
    4487             :   /* M = mfcoefs of BAS */
    4488         518 :   B = cgetg(lF, t_MAT);
    4489         518 :   dB= cgetg(lF, t_VEC);
    4490        2478 :   for (j = 1; j < lF; j++)
    4491             :   {
    4492        1960 :     GEN g = gel(vF, j); /* t_MF_DIV */
    4493        1960 :     gel(B,j) = RgM_RgC_mul(M, gmael(g,2,3));
    4494        1960 :     gel(dB,j)= gmael(g,2,4);
    4495             :   }
    4496         518 :   f = mfcoefsser(gel(F,3),n);
    4497         518 :   a0 = polcoef_i(f, 0, -1);
    4498         518 :   if (gequal0(a0) || gequal1(a0))
    4499         294 :     a0 = NULL;
    4500             :   else
    4501         224 :     f = gdiv(ser_unscale(f, a0), a0);
    4502         518 :   fc = ginv(f);
    4503        2478 :   for (j = 1; j < lF; j++)
    4504             :   {
    4505        1960 :     pari_sp av = avma;
    4506        1960 :     GEN LISer = RgV_to_ser_full(gel(B,j)), f;
    4507        1960 :     if (a0) LISer = gdiv(ser_unscale(LISer, a0), a0);
    4508        1960 :     f = gmul(LISer, fc);
    4509        1960 :     if (a0) f = ser_unscale(f, ginv(a0));
    4510        1960 :     f = sertocol(f); setlg(f, n+2);
    4511        1960 :     if (!gequal1(gel(dB,j))) f = RgC_Rg_div(f, gel(dB,j));
    4512        1960 :     gel(B,j) = gerepileupto(av,f);
    4513             :   }
    4514         518 :   if (V) B = gmodulo(QabM_tracerel(V, 0, B), gel(V,1));
    4515         518 :   return B;
    4516             : }
    4517             : 
    4518             : static GEN
    4519         189 : mfheckemat_mfcoefs(GEN mf, GEN B, GEN DATA)
    4520             : {
    4521         189 :   GEN Mindex = MF_get_Mindex(mf), Minv = MF_get_Minv(mf);
    4522         189 :   long j, l = lg(B), sb = mfsturm_mf(mf);
    4523         189 :   GEN b = MF_get_basis(mf), Q = cgetg(l, t_VEC);
    4524         609 :   for (j = 1; j < l; j++)
    4525             :   {
    4526         420 :     GEN v = hecke_i(sb, 1, gel(B,j), gel(b,j), DATA); /* Tn b[j] */
    4527         420 :     settyp(v,t_COL); gel(Q,j) = vecpermute(v, Mindex);
    4528             :   }
    4529         189 :   return Minv_RgM_mul(Minv,Q);
    4530             : }
    4531             : /* T_p^2, p prime, 1/2-integral weight; B = mfcoefs(mf,sb*p^2,1) or (mf,sb,p^2)
    4532             :  * if p|N */
    4533             : static GEN
    4534           7 : mfheckemat_mfcoefs_p2(GEN mf, long p, GEN B)
    4535             : {
    4536           7 :   pari_sp av = avma;
    4537           7 :   GEN DATA = heckef2_data(MF_get_N(mf), p*p);
    4538           7 :   return gerepileupto(av, mfheckemat_mfcoefs(mf, B, DATA));
    4539             : }
    4540             : /* convert Mindex from row-index to mfcoef indexation: a(n) is stored in
    4541             :  * mfcoefs()[n+1], so subtract 1 from all indices */
    4542             : static GEN
    4543          49 : Mindex_as_coef(GEN mf)
    4544             : {
    4545          49 :   GEN v, Mindex = MF_get_Mindex(mf);
    4546          49 :   long i, l = lg(Mindex);
    4547          49 :   v = cgetg(l, t_VECSMALL);
    4548         210 :   for (i = 1; i < l; i++) v[i] = Mindex[i]-1;
    4549          49 :   return v;
    4550             : }
    4551             : /* T_p, p prime; B = mfcoefs(mf,sb*p,1) or (mf,sb,p) if p|N; integral weight */
    4552             : static GEN
    4553          35 : mfheckemat_mfcoefs_p(GEN mf, long p, GEN B)
    4554             : {
    4555          35 :   pari_sp av = avma;
    4556          35 :   GEN vm, Q, C, Minv = MF_get_Minv(mf);
    4557          35 :   long lm, k, i, j, l = lg(B), N = MF_get_N(mf);
    4558             : 
    4559          35 :   if (N % p == 0) return Minv_RgM_mul(Minv, rowpermute(B, MF_get_Mindex(mf)));
    4560          21 :   k = MF_get_k(mf);
    4561          21 :   C = gmul(mfchareval(MF_get_CHI(mf), p), powuu(p, k-1));
    4562          21 :   vm = Mindex_as_coef(mf); lm = lg(vm);
    4563          21 :   Q = cgetg(l, t_MAT);
    4564         147 :   for (j = 1; j < l; j++) gel(Q,j) = cgetg(lm, t_COL);
    4565         147 :   for (i = 1; i < lm; i++)
    4566             :   {
    4567         126 :     long m = vm[i], mp = m*p;
    4568         126 :     GEN Cm = (m % p) == 0? C : NULL;
    4569        1260 :     for (j = 1; j < l; j++)
    4570             :     {
    4571        1134 :       GEN S = gel(B,j), s = gel(S, mp + 1);
    4572        1134 :       if (Cm) s = gadd(s, gmul(C, gel(S, m/p + 1)));
    4573        1134 :       gcoeff(Q, i, j) = s;
    4574             :     }
    4575             :   }
    4576          21 :   return gerepileupto(av, Minv_RgM_mul(Minv,Q));
    4577             : }
    4578             : /* Matrix of T(p), p prime, dim(mf) > 0 and integral weight */
    4579             : static GEN
    4580         182 : mfheckemat_p(GEN mf, long p)
    4581             : {
    4582         182 :   pari_sp av = avma;
    4583         182 :   long N = MF_get_N(mf), sb = mfsturm_mf(mf);
    4584         182 :   GEN B = (N % p)? mfcoefs_mf(mf, sb * p, 1): mfcoefs_mf(mf, sb, p);
    4585         182 :   return gerepileupto(av, mfheckemat_mfcoefs(mf, B, hecke_data(N,p)));
    4586             : }
    4587             : 
    4588             : /* mf_NEW != (0), weight > 1, p prime. Use
    4589             :  * T(p) T(j) = T(j*p) + p^{k-1} \chi(p) 1_{p | j, p \nmid N} T(j/p) */
    4590             : static GEN
    4591         875 : mfnewmathecke_p(GEN mf, long p)
    4592             : {
    4593         875 :   pari_sp av = avma;
    4594         875 :   GEN tf, vj = MFnew_get_vj(mf), CHI = MF_get_CHI(mf);
    4595         875 :   GEN Mindex = MF_get_Mindex(mf), Minv = MF_get_Minv(mf);
    4596         875 :   long N = MF_get_N(mf), k = MF_get_k(mf);
    4597         875 :   long i, j, lvj = lg(vj), lim = vj[lvj-1] * p;
    4598         875 :   GEN M, perm, V, need = zero_zv(lim);
    4599         875 :   GEN C = (N % p)? gmul(mfchareval(CHI,p), powuu(p,k-1)): NULL;
    4600         875 :   tf = mftraceform_new(N, k, CHI);
    4601        3759 :   for (i = 1; i < lvj; i++)
    4602             :   {
    4603        2884 :     j = vj[i]; need[j*p] = 1;
    4604        2884 :     if (N % p && j % p == 0) need[j/p] = 1;
    4605             :   }
    4606         875 :   perm = zero_zv(lim);
    4607         875 :   V = cgetg(lim+1, t_VEC);
    4608       12047 :   for (i = j = 1; i <= lim; i++)
    4609       11172 :     if (need[i]) { gel(V,j) = mfhecke_i(i, N, tf); perm[i] = j; j++; }
    4610         875 :   setlg(V, j);
    4611         875 :   V = bhnmat_extend_nocache(NULL, N, mfsturm_mf(mf), 1, V);
    4612         875 :   V = rowpermute(V, Mindex); /* V[perm[i]] = coeffs(T_i newtrace) */
    4613         875 :   M = cgetg(lvj, t_MAT);
    4614        3759 :   for (i = 1; i < lvj; i++)
    4615             :   {
    4616             :     GEN t;
    4617        2884 :     j = vj[i]; t = gel(V, perm[j*p]);
    4618        2884 :     if (C && j % p == 0) t = RgC_add(t, RgC_Rg_mul(gel(V, perm[j/p]),C));
    4619        2884 :     gel(M,i) = t;
    4620             :   }
    4621         875 :   return gerepileupto(av, Minv_RgM_mul(Minv, M));
    4622             : }
    4623             : 
    4624             : GEN
    4625          77 : mfheckemat(GEN mf, GEN vn)
    4626             : {
    4627          77 :   pari_sp av = avma;
    4628          77 :   long lv, lvP, i, N, dim, nk, dk, p, sb, flint = (typ(vn)==t_INT);
    4629             :   GEN CHI, res, vT, FA, B, vP;
    4630             : 
    4631          77 :   mf = checkMF(mf);
    4632          77 :   if (typ(vn) != t_VECSMALL) vn = gtovecsmall(vn);
    4633          77 :   N = MF_get_N(mf); CHI = MF_get_CHI(mf); Qtoss(MF_get_gk(mf), &nk, &dk);
    4634          77 :   dim = MF_get_dim(mf);
    4635          77 :   lv = lg(vn);
    4636          77 :   res = cgetg(lv, t_VEC);
    4637          77 :   FA = cgetg(lv, t_VEC);
    4638          77 :   vP = cgetg(lv, t_VEC);
    4639          77 :   vT = const_vec(vecsmall_max(vn), NULL);
    4640         182 :   for (i = 1; i < lv; i++)
    4641             :   {
    4642         105 :     ulong n = (ulong)labs(vn[i]);
    4643             :     GEN fa;
    4644         105 :     if (!n) pari_err_TYPE("mfheckemat", vn);
    4645         105 :     if (dk == 1 || uissquareall(n, &n)) fa = myfactoru(n);
    4646           0 :     else { n = 0; fa = myfactoru(1); } /* dummy: T_{vn[i]} = 0 */
    4647         105 :     vn[i] = n;
    4648         105 :     gel(FA,i) = fa;
    4649         105 :     gel(vP,i) = gel(fa,1);
    4650             :   }
    4651          77 :   vP = shallowconcat1(vP); vecsmall_sort(vP);
    4652          77 :   vP = vecsmall_uniq_sorted(vP); /* all primes occurring in vn */
    4653          77 :   lvP = lg(vP); if (lvP == 1) goto END;
    4654          56 :   p = vP[lvP-1];
    4655          56 :   sb = mfsturm_mf(mf);
    4656          56 :   if (dk == 1 && nk != 1 && MF_get_space(mf) == mf_NEW)
    4657          21 :     B = NULL; /* special purpose mfnewmathecke_p is faster */
    4658          35 :   else if (lvP == 2 && N % p == 0)
    4659          21 :     B = mfcoefs_mf(mf, sb, dk==2? p*p: p); /* single prime | N, can optimize */
    4660             :   else
    4661          14 :     B = mfcoefs_mf(mf, sb * (dk==2? p*p: p), 1); /* general initialization */
    4662         126 :   for (i = 1; i < lvP; i++)
    4663             :   {
    4664          70 :     long j, l, q, e = 1;
    4665             :     GEN C, Tp, u1, u0;
    4666          70 :     p = vP[i];
    4667         189 :     for (j = 1; j < lv; j++) e = maxss(e, z_lval(vn[j], p));
    4668          70 :     if (!B)
    4669          28 :       Tp = mfnewmathecke_p(mf, p);
    4670          42 :     else if (dk == 2)
    4671           7 :       Tp = mfheckemat_mfcoefs_p2(mf,p, (lvP==2||N%p)? B: matdeflate(sb,p*p,B));
    4672             :     else
    4673          35 :       Tp = mfheckemat_mfcoefs_p(mf, p, (lvP==2||N%p)? B: matdeflate(sb,p,B));
    4674          70 :     gel(vT, p) = Tp;
    4675          70 :     if (e == 1) continue;
    4676          14 :     u0 = gen_1;
    4677          14 :     if (dk == 2)
    4678             :     {
    4679           0 :       C = N % p? gmul(mfchareval(CHI,p*p), powuu(p, nk-2)): NULL;
    4680           0 :       if (e == 2) u0 = sstoQ(p+1,p); /* special case T_{p^4} */
    4681             :     }
    4682             :     else
    4683          14 :       C = N % p? gmul(mfchareval(CHI,p),   powuu(p, nk-1)): NULL;
    4684          28 :     for (u1=Tp, q=p, l=2; l <= e; l++)
    4685             :     { /* u0 = T_{p^{l-2}}, u1 = T_{p^{l-1}} for l > 2 */
    4686          14 :       GEN v = gmul(Tp, u1);
    4687          14 :       if (C) v = gsub(v, gmul(C, u0));
    4688             :       /* q = p^l, vT[q] = T_q for k integer else T_{q^2} */
    4689          14 :       q *= p; u0 = u1; gel(vT, q) = u1 = v;
    4690             :     }
    4691             :   }
    4692          56 : END:
    4693             :   /* vT[p^e] = T_{p^e} for all p^e occurring below */
    4694         182 :   for (i = 1; i < lv; i++)
    4695             :   {
    4696         105 :     long n = vn[i], j, lP;
    4697             :     GEN fa, P, E, M;
    4698         105 :     if (n == 0) { gel(res,i) = zeromat(dim,dim); continue; }
    4699         105 :     if (n == 1) { gel(res,i) = matid(dim); continue; }
    4700          77 :     fa = gel(FA,i);
    4701          77 :     P = gel(fa,1); lP = lg(P);
    4702          77 :     E = gel(fa,2); M = gel(vT, upowuu(P[1], E[1]));
    4703          84 :     for (j = 2; j < lP; j++) M = RgM_mul(M, gel(vT, upowuu(P[j], E[j])));
    4704          77 :     gel(res,i) = M;
    4705             :   }
    4706          77 :   if (flint) res = gel(res,1);
    4707          77 :   return gerepilecopy(av, res);
    4708             : }
    4709             : 
    4710             : /* f = \sum_i v[i] T_listj[i] (Trace Form) attached to v; replace by f/a_1(f) */
    4711             : static GEN
    4712        1323 : mf_normalize(GEN mf, GEN v)
    4713             : {
    4714        1323 :   GEN c, dc = NULL, M = MF_get_M(mf), Mindex = MF_get_Mindex(mf);
    4715        1323 :   v = Q_primpart(v);
    4716        1323 :   c = RgMrow_RgC_mul(M, v, 2); /* a_1(f) */
    4717        1323 :   if (gequal1(c)) return v;
    4718         791 :   if (typ(c) == t_POL) c = gmodulo(c, mfcharpol(MF_get_CHI(mf)));
    4719         791 :   if (typ(c) == t_POLMOD && varn(gel(c,1)) == 1 && degpol(gel(c,1)) >= 40
    4720           7 :                          && Mindex[1] == 2
    4721           7 :                          && mfcharorder(MF_get_CHI(mf)) <= 2)
    4722           7 :   { /* normalize using expansion at infinity (small coefficients) */
    4723           7 :     GEN w, P = gel(c,1), a1 = gel(c,2);
    4724           7 :     long i, l = lg(Mindex);
    4725           7 :     w = cgetg(l, t_COL);
    4726           7 :     gel(w,1) = gen_1;
    4727         280 :     for (i = 2; i < l; i++)
    4728             :     {
    4729         273 :       c = liftpol_shallow(RgMrow_RgC_mul(M, v, Mindex[i]));
    4730         273 :       gel(w,i) = QXQ_div(c, a1, P);
    4731             :     }
    4732             :     /* w = expansion at oo of normalized form */
    4733           7 :     v = Minv_RgC_mul(MF_get_Minv(mf), Q_remove_denom(w, &dc));
    4734           7 :     v = gmodulo(v, P); /* back to mfbasis coefficients */
    4735             :   }
    4736             :   else
    4737             :   {
    4738         784 :     c = ginv(c);
    4739         784 :     if (typ(c) == t_POLMOD) c = Q_remove_denom(c, &dc);
    4740         784 :     v = RgC_Rg_mul(v, c);
    4741             :   }
    4742         791 :   if (dc) v = RgC_Rg_div(v, dc);
    4743         791 :   return v;
    4744             : }
    4745             : static void
    4746         343 : pol_red(GEN NF, GEN *pP, GEN *pa, long flag)
    4747             : {
    4748         343 :   GEN dP, a, P = *pP;
    4749         343 :   long d = degpol(P);
    4750             : 
    4751         343 :   *pa = a = pol_x(varn(P));
    4752         343 :   if (d > 30) return;
    4753             : 
    4754         336 :   dP = RgX_disc(P);
    4755         336 :   if (typ(dP) != t_INT)
    4756          84 :   { dP = gnorm(dP); if (typ(dP) != t_INT) pari_err_BUG("mfnewsplit"); }
    4757         336 :   if (d == 2 || expi(dP) < 62)
    4758             :   {
    4759         308 :     if (expi(dP) < 31)
    4760         308 :       P = NF? rnfpolredabs(NF, P,flag): polredabs0(P,flag);
    4761             :     else
    4762           0 :       P = NF? rnfpolredbest(NF,P,flag): polredbest(P,flag);
    4763         308 :     if (flag)
    4764             :     {
    4765         280 :       a = gel(P,2); if (typ(a) == t_POLMOD) a = gel(a,2);
    4766         280 :       P = gel(P,1);
    4767             :     }
    4768             :   }
    4769         336 :   *pP = P;
    4770         336 :   *pa = a;
    4771             : }
    4772             : 
    4773             : /* Diagonalize and normalize. See mfsplit for meaning of flag. */
    4774             : static GEN
    4775         966 : mfspclean(GEN mf, GEN mf0, GEN NF, long ord, GEN simplesp, long flag)
    4776             : {
    4777         966 :   const long vz = 1;
    4778         966 :   long i, l = lg(simplesp), dim = MF_get_dim(mf);
    4779         966 :   GEN res = cgetg(l, t_MAT), pols = cgetg(l, t_VEC);
    4780         966 :   GEN zeros = (mf == mf0)? NULL: zerocol(dim - MF_get_dim(mf0));
    4781        2317 :   for (i = 1; i < l; i++)
    4782             :   {
    4783        1351 :     GEN ATP = gel(simplesp, i), A = gel(ATP,1), P = gel(ATP,3);
    4784        1351 :     long d = degpol(P);
    4785        1351 :     GEN a, v = (flag && d > flag)? NULL: gel(A,1);
    4786        1351 :     if (d == 1) P = pol_x(vz);
    4787             :     else
    4788             :     {
    4789         343 :       pol_red(NF, &P, &a, !!v);
    4790         343 :       if (v)
    4791             :       { /* Mod(a,P) root of charpoly(T), K*gpowers(a) = eigenvector of T */
    4792         315 :         GEN K, den, M = cgetg(d+1, t_MAT), T = gel(ATP,2);
    4793             :         long j;
    4794         315 :         T = shallowtrans(T);
    4795         315 :         gel(M,1) = vec_ei(d,1); /* basis of cyclic vectors */
    4796        1113 :         for (j = 2; j <= d; j++) gel(M,j) = RgM_RgC_mul(T, gel(M,j-1));
    4797         315 :         M = Q_primpart(M);
    4798         112 :         K = NF? ZabM_inv(liftpol_shallow(M), nf_get_pol(NF), ord, &den)
    4799         315 :               : ZM_inv(M,&den);
    4800         315 :         K = shallowtrans(K);
    4801         315 :         v = gequalX(a)? pol_x_powers(d, vz): RgXQ_powers(a, d-1, P);
    4802         315 :         v = gmodulo(RgM_RgC_mul(A, RgM_RgC_mul(K,v)), P);
    4803             :       }
    4804             :     }
    4805        1351 :     if (v)
    4806             :     {
    4807        1323 :       v = mf_normalize(mf0, v); if (zeros) v = shallowconcat(zeros,v);
    4808        1323 :       gel(res,i) = v; if (flag) setlg(res,i+1);
    4809             :     }
    4810             :     else
    4811          28 :       gel(res,i) = zerocol(dim);
    4812        1351 :     gel(pols,i) = P;
    4813             :   }
    4814         966 :   return mkvec2(res, pols);
    4815             : }
    4816             : 
    4817             : /* return v = v_{X-r}(P), and set Z = P / (X-r)^v */
    4818             : static long
    4819          70 : RgX_valrem_root(GEN P, GEN r, GEN *Z)
    4820             : {
    4821             :   long v;
    4822         140 :   for (v = 0; degpol(P); v++)
    4823             :   {
    4824         140 :     GEN t, Q = RgX_div_by_X_x(P, r, &t);
    4825         140 :     if (!gequal0(t)) break;
    4826          70 :     P = Q;
    4827             :   }
    4828          70 :   *Z = P; return v;
    4829             : }
    4830             : static GEN
    4831        1071 : mynffactor(GEN NF, GEN P, long dimlim)
    4832             : {
    4833             :   long i, l, v;
    4834             :   GEN R, E;
    4835        1071 :   if (dimlim != 1)
    4836             :   {
    4837         511 :     R = NF? nffactor(NF, P): QX_factor(P);
    4838         511 :     if (!dimlim) return R;
    4839          21 :     E = gel(R,2);
    4840          21 :     R = gel(R,1); l = lg(R);
    4841          98 :     for (i = 1; i < l; i++)
    4842          91 :       if (degpol(gel(R,i)) > dimlim) break;
    4843          21 :     if (i == 1) return NULL;
    4844          21 :     setlg(E,i);
    4845          21 :     setlg(R,i); return mkmat2(R, E);
    4846             :   }
    4847             :   /* dimlim = 1 */
    4848         560 :   R = nfroots(NF, P); l = lg(R);
    4849         560 :   if (l == 1) return NULL;
    4850         497 :   v = varn(P);
    4851         497 :   settyp(R, t_COL);
    4852         497 :   if (degpol(P) == l-1)
    4853         441 :     E = const_col(l-1, gen_1);
    4854             :   else
    4855             :   {
    4856          56 :     E = cgetg(l, t_COL);
    4857         126 :     for (i = 1; i < l; i++) gel(E,i) = utoi(RgX_valrem_root(P, gel(R,i), &P));
    4858             :   }
    4859         497 :   R = deg1_from_roots(R, v);
    4860         497 :   return mkmat2(R, E);
    4861             : }
    4862             : 
    4863             : /* Let K be a number field attached to NF (Q if NF = NULL). A K-vector
    4864             :  * space of dimension d > 0 is given by a t_MAT A (n x d, full column rank)
    4865             :  * giving a K-basis, X a section (d x n: left pseudo-inverse of A). Return a
    4866             :  * pair (T, fa), where T is an element of the Hecke algebra (a sum of Tp taken
    4867             :  * from vector vTp) acting on A (a d x d t_MAT) and fa is the factorization of
    4868             :  * its characteristic polynomial, limited to factors of degree <= dimlim if
    4869             :  * dimlim != 0 (return NULL if there are no factors of degree <= dimlim) */
    4870             : static GEN
    4871        1064 : findbestsplit(GEN NF, GEN vTp, GEN A, GEN X, long dimlim, long vz)
    4872             : {
    4873        1064 :   GEN T = NULL, Tkeep = NULL, fakeep = NULL;
    4874        1064 :   long lmax = 0, i, lT = lg(vTp);
    4875        1148 :   for (i = 1; i < lT; i++)
    4876             :   {
    4877        1148 :     GEN D, P, E, fa, TpA = gel(vTp,i);
    4878             :     long l;
    4879        2072 :     if (typ(TpA) == t_INT) break;
    4880        1071 :     if (lg(TpA) > lg(A)) TpA = RgM_mul(X, RgM_mul(TpA, A)); /* Tp | A */
    4881        1071 :     T = T ? RgM_add(T, TpA) : TpA;
    4882        1071 :     if (!NF) { P = QM_charpoly_ZX(T); setvarn(P, vz); }
    4883             :     else
    4884             :     {
    4885         203 :       P = charpoly(Q_remove_denom(T, &D), vz);
    4886         203 :       if (D) P = gdiv(RgX_unscale(P, D), powiu(D, degpol(P)));
    4887             :     }
    4888        1071 :     fa = mynffactor(NF, P, dimlim);
    4889        1071 :     if (!fa) return NULL;
    4890        1008 :     E = gel(fa, 2);
    4891             :     /* characteristic polynomial is separable ? */
    4892        1008 :     if (isint1(vecmax(E))) { Tkeep = T; fakeep = fa; break; }
    4893          84 :     l = lg(E);
    4894             :     /* characteristic polynomial has more factors than before ? */
    4895          84 :     if (l > lmax) { lmax = l; Tkeep = T; fakeep = fa; }
    4896             :   }
    4897        1001 :   return mkvec2(Tkeep, fakeep);
    4898             : }
    4899             : 
    4900             : static GEN
    4901         161 : nfcontent(GEN nf, GEN v)
    4902             : {
    4903         161 :   long i, l = lg(v);
    4904         161 :   GEN c = gel(v,1);
    4905         777 :   for (i = 2; i < l; i++) c = idealadd(nf, c, gel(v,i));
    4906         161 :   if (typ(c) == t_MAT && gequal1(gcoeff(c,1,1))) c = gen_1;
    4907         161 :   return c;
    4908             : }
    4909             : static GEN
    4910         252 : nf_primpart(GEN nf, GEN B)
    4911             : {
    4912         252 :   switch(typ(B))
    4913             :   {
    4914         161 :     case t_COL:
    4915             :     {
    4916         161 :       GEN A = matalgtobasis(nf, B), c = nfcontent(nf, A);
    4917         161 :       if (typ(c) == t_INT) return B;
    4918          21 :       c = idealred_elt(nf,c);
    4919          21 :       A = Q_primpart( nfC_nf_mul(nf, A, Q_primpart(nfinv(nf,c))) );
    4920          21 :       A = liftpol_shallow( matbasistoalg(nf, A) );
    4921          21 :       if (gexpo(A) > gexpo(B)) A = B;
    4922          21 :       return A;
    4923             :     }
    4924          91 :     case t_MAT:
    4925             :     {
    4926             :       long i, l;
    4927          91 :       GEN A = cgetg_copy(B, &l);
    4928         252 :       for (i = 1; i < l; i++) gel(A,i) = nf_primpart(nf, gel(B,i));
    4929          91 :       return A;
    4930             :     }
    4931           0 :     default:
    4932           0 :       pari_err_TYPE("nf_primpart", B);
    4933             :       return NULL; /*LCOV_EXCL_LINE*/
    4934             :   }
    4935             : }
    4936             : 
    4937             : /* rotate entries of v to accomodate new entry 'x' (push out oldest entry) */
    4938             : static void
    4939        1029 : vecpush(GEN v, GEN x)
    4940             : {
    4941             :   long i;
    4942        5145 :   for (i = lg(v)-1; i > 1; i--) gel(v,i) = gel(v,i-1);
    4943        1029 :   gel(v,1) = x;
    4944        1029 : }
    4945             : 
    4946             : /* sort t_VEC of vector spaces by increasing dimension */
    4947             : static GEN
    4948         966 : sort_by_dim(GEN v)
    4949             : {
    4950         966 :   long i, l = lg(v);
    4951         966 :   GEN D = cgetg(l, t_VECSMALL);
    4952        2317 :   for (i = 1; i < l; i++) D[i] = lg(gmael(v,i,2));
    4953         966 :   return vecpermute(v , vecsmall_indexsort(D));
    4954             : }
    4955             : static GEN
    4956         966 : split_starting_space(GEN mf)
    4957             : {
    4958         966 :   long d = MF_get_dim(mf), d2;
    4959         966 :   GEN id = matid(d);
    4960         966 :   switch(MF_get_space(mf))
    4961             :   {
    4962         959 :     case mf_NEW:
    4963         959 :     case mf_CUSP: return mkvec2(id, id);
    4964             :   }
    4965           7 :   d2 = lg(MF_get_S(mf))-1;
    4966           7 :   return mkvec2(vecslice(id, d-d2+1,d),
    4967             :                 shallowconcat(zeromat(d2,d-d2),matid(d2)));
    4968             : }
    4969             : /* If dimlim > 0, keep only the dimension <= dimlim eigenspaces.
    4970             :  * See mfsplit for the meaning of flag. */
    4971             : static GEN
    4972        1365 : split_ii(GEN mf, long dimlim, long flag, long *pnewd)
    4973             : {
    4974             :   forprime_t iter;
    4975        1365 :   GEN CHI = MF_get_CHI(mf), empty = cgetg(1, t_VEC), mf0 = mf;
    4976             :   GEN NF, POLCYC, todosp, Tpbigvec, simplesp;
    4977        1365 :   long N = MF_get_N(mf), k = MF_get_k(mf);
    4978        1365 :   long ord, FC, NEWT, dimsimple = 0, newd = -1;
    4979        1365 :   const long NBH = 5, vz = 1;
    4980             :   ulong p;
    4981             : 
    4982        1365 :   switch(MF_get_space(mf))
    4983             :   {
    4984        1162 :     case mf_NEW: break;
    4985         196 :     case mf_CUSP:
    4986             :     case mf_FULL:
    4987         196 :       if (k > 1) { mf0 = mfinittonew(mf); break; }
    4988         175 :       newd = lg(MF_get_S(mf))-1 - mfolddim(N, k, CHI);
    4989         175 :       break;
    4990           7 :     default: pari_err_TYPE("mfsplit [space does not contain newspace]", mf);
    4991             :       return NULL; /*LCOV_EXCL_LINE*/
    4992             :   }
    4993        1358 :   if (newd < 0) newd = mf0? MF_get_dim(mf0): 0;
    4994        1358 :   *pnewd = newd;
    4995        1358 :   if (!newd) return mkvec2(cgetg(1, t_MAT), empty);
    4996             : 
    4997         966 :   NEWT = (k > 1 && MF_get_space(mf0) == mf_NEW);
    4998         966 :   todosp = mkvec( split_starting_space(mf0) );
    4999         966 :   simplesp = empty;
    5000         966 :   FC = mfcharconductor(CHI);
    5001         966 :   ord = mfcharorder(CHI);
    5002         966 :   if (ord <= 2) NF = POLCYC = NULL;
    5003             :   else
    5004             :   {
    5005         161 :     POLCYC = mfcharpol(CHI);
    5006         161 :     NF = nfinit(POLCYC,DEFAULTPREC);
    5007             :   }
    5008         966 :   Tpbigvec = zerovec(NBH);
    5009         966 :   u_forprime_init(&iter, 2, ULONG_MAX);
    5010        1288 :   while (dimsimple < newd && (p = u_forprime_next(&iter)))
    5011             :   {
    5012             :     GEN nextsp;
    5013             :     long ind;
    5014        1274 :     if (N % (p*p) == 0 && N/p % FC == 0) continue; /* T_p = 0 in this case */
    5015        1029 :     vecpush(Tpbigvec, NEWT? mfnewmathecke_p(mf0,p): mfheckemat_p(mf0,p));
    5016        1029 :     nextsp = empty;
    5017        2093 :     for (ind = 1; ind < lg(todosp); ind++)
    5018             :     {
    5019        1064 :       GEN tmp = gel(todosp, ind), fa, P, E, D, Tp, DTp;
    5020        1064 :       GEN A = gel(tmp, 1);
    5021        1064 :       GEN X = gel(tmp, 2);
    5022             :       long lP, i;
    5023        1064 :       tmp = findbestsplit(NF, Tpbigvec, A, X, dimlim, vz);
    5024        1722 :       if (!tmp) continue; /* nothing there */
    5025        1001 :       Tp = gel(tmp, 1);
    5026        1001 :       fa = gel(tmp, 2);
    5027        1001 :       P = gel(fa, 1);
    5028        1001 :       E = gel(fa, 2); lP = lg(P);
    5029             :       /* lP > 1 */
    5030        1001 :       if (DEBUGLEVEL) err_printf("Exponents = %Ps\n", E);
    5031        1001 :       if (lP == 2)
    5032             :       {
    5033         707 :         GEN P1 = gel(P,1);
    5034         707 :         long e1 = itos(gel(E,1)), d1 = degpol(P1);
    5035         707 :         if (e1 * d1 == lg(Tp)-1)
    5036             :         {
    5037         658 :           if (e1 > 1) nextsp = vec_append(nextsp, mkvec2(A,X));
    5038             :           else
    5039             :           { /* simple module */
    5040         644 :             simplesp = vec_append(simplesp, mkvec3(A,Tp,P1));
    5041         644 :             dimsimple += d1;
    5042             :           }
    5043         658 :           continue;
    5044             :         }
    5045             :       }
    5046             :       /* Found splitting */
    5047         343 :       DTp = Q_remove_denom(Tp, &D);
    5048        1148 :       for (i = 1; i < lP; i++)
    5049             :       {
    5050         805 :         GEN Ai, Xi, dXi, AAi, v, y, Pi = gel(P,i);
    5051         805 :         Ai = RgX_RgM_eval(D? RgX_rescale(Pi,D): Pi, DTp);
    5052         805 :         Ai = QabM_ker(Ai, POLCYC, ord);
    5053         805 :         if (NF) Ai = nf_primpart(NF, Ai);
    5054             : 
    5055         805 :         AAi = RgM_mul(A, Ai);
    5056             :         /* gives section, works on nonsquare matrices */
    5057         805 :         Xi = QabM_pseudoinv(Ai, POLCYC, ord, &v, &dXi);
    5058         805 :         Xi = RgM_Rg_div(Xi, dXi);
    5059         805 :         y = gel(v,1);
    5060         805 :         if (isint1(gel(E,i)))
    5061             :         {
    5062         707 :           GEN Tpi = RgM_mul(Xi, RgM_mul(rowpermute(Tp,y), Ai));
    5063         707 :           simplesp = vec_append(simplesp, mkvec3(AAi, Tpi, Pi));
    5064         707 :           dimsimple += degpol(Pi);
    5065             :         }
    5066             :         else
    5067             :         {
    5068          98 :           Xi = RgM_mul(Xi, rowpermute(X,y));
    5069          98 :           nextsp = vec_append(nextsp, mkvec2(AAi, Xi));
    5070             :         }
    5071             :       }
    5072             :     }
    5073        1029 :     todosp = nextsp; if (lg(todosp) == 1) break;
    5074             :   }
    5075         966 :   if (DEBUGLEVEL) err_printf("end split, need to clean\n");
    5076         966 :   return mfspclean(mf, mf0, NF, ord, sort_by_dim(simplesp), flag);
    5077             : }
    5078             : static GEN
    5079          28 : dim_filter(GEN v, long dim)
    5080             : {
    5081          28 :   GEN P = gel(v,2);
    5082          28 :   long j, l = lg(P);
    5083         140 :   for (j = 1; j < l; j++)
    5084         126 :     if (degpol(gel(P,j)) > dim)
    5085             :     {
    5086          14 :       v = mkvec2(vecslice(gel(v,1),1,j-1), vecslice(P,1,j-1));
    5087          14 :       break;
    5088             :     }
    5089          28 :   return v;
    5090             : }
    5091             : static long
    5092         203 : dim_sum(GEN v)
    5093             : {
    5094         203 :   GEN P = gel(v,2);
    5095         203 :   long j, l = lg(P), d = 0;
    5096         490 :   for (j = 1; j < l; j++) d += degpol(gel(P,j));
    5097         203 :   return d;
    5098             : }
    5099             : static GEN
    5100        1295 : split_i(GEN mf, long dimlim, long flag)
    5101        1295 : { long junk; return split_ii(mf, dimlim, flag, &junk); }
    5102             : /* mf is either already split or output by mfinit. Splitting is done only for
    5103             :  * newspace except in weight 1. If flag = 0 (default) split completely.
    5104             :  * If flag = d > 0, only give the Galois polynomials in degree > d
    5105             :  * Flag is ignored if dimlim = 1. */
    5106             : GEN
    5107          98 : mfsplit(GEN mf0, long dimlim, long flag)
    5108             : {
    5109          98 :   pari_sp av = avma;
    5110          98 :   GEN v, mf = checkMF_i(mf0);
    5111          98 :   if (!mf) pari_err_TYPE("mfsplit", mf0);
    5112          98 :   if ((v = obj_check(mf, MF_SPLIT)))
    5113          28 :   { if (dimlim) v = dim_filter(v, dimlim); }
    5114          70 :   else if (dimlim && (v = obj_check(mf, MF_SPLITN)))
    5115          21 :   { v = (itos(gel(v,1)) >= dimlim)? dim_filter(gel(v,2), dimlim): NULL; }
    5116          98 :   if (!v)
    5117             :   {
    5118             :     long newd;
    5119          70 :     v = split_ii(mf, dimlim, flag, &newd);
    5120          70 :     if (lg(v) == 1) obj_insert(mf, MF_SPLITN, mkvec2(utoi(dimlim), v));
    5121          70 :     else if (!flag)
    5122             :     {
    5123          49 :       if (dim_sum(v) == newd) obj_insert(mf, MF_SPLIT,v);
    5124          21 :       else obj_insert(mf, MF_SPLITN, mkvec2(utoi(dimlim), v));
    5125             :     }
    5126             :   }
    5127          98 :   return gerepilecopy(av, v);
    5128             : }
    5129             : static GEN
    5130         385 : split(GEN mf) { return split_i(mf,0,0); }
    5131             : GEN
    5132         735 : MF_get_newforms(GEN mf) { return gel(obj_checkbuild(mf,MF_SPLIT,&split),1); }
    5133             : GEN
    5134         560 : MF_get_fields(GEN mf) { return gel(obj_checkbuild(mf,MF_SPLIT,&split),2); }
    5135             : 
    5136             : /*************************************************************************/
    5137             : /*                     Modular forms of Weight 1                         */
    5138             : /*************************************************************************/
    5139             : /* S_1(G_0(N)), small N. Return 1 if definitely empty; return 0 if maybe
    5140             :  * non-empty  */
    5141             : static int
    5142       16142 : wt1empty(long N)
    5143             : {
    5144       16142 :   if (N <= 100) switch (N)
    5145             :   { /* non-empty [32/100] */
    5146        5446 :     case 23: case 31: case 39: case 44: case 46:
    5147             :     case 47: case 52: case 55: case 56: case 57:
    5148             :     case 59: case 62: case 63: case 68: case 69:
    5149             :     case 71: case 72: case 76: case 77: case 78:
    5150             :     case 79: case 80: case 83: case 84: case 87:
    5151             :     case 88: case 92: case 93: case 94: case 95:
    5152        5446 :     case 99: case 100: return 0;
    5153        3542 :     default: return 1;
    5154             :   }
    5155        7154 :   if (N <= 600) switch(N)
    5156             :   { /* empty [111/500] */
    5157         336 :     case 101: case 102: case 105: case 106: case 109:
    5158             :     case 113: case 121: case 122: case 123: case 125:
    5159             :     case 130: case 134: case 137: case 146: case 149:
    5160             :     case 150: case 153: case 157: case 162: case 163:
    5161             :     case 169: case 170: case 173: case 178: case 181:
    5162             :     case 182: case 185: case 187: case 193: case 194:
    5163             :     case 197: case 202: case 205: case 210: case 218:
    5164             :     case 221: case 226: case 233: case 241: case 242:
    5165             :     case 245: case 246: case 250: case 257: case 265:
    5166             :     case 267: case 269: case 274: case 277: case 281:
    5167             :     case 289: case 293: case 298: case 305: case 306:
    5168             :     case 313: case 314: case 317: case 326: case 337:
    5169             :     case 338: case 346: case 349: case 353: case 361:
    5170             :     case 362: case 365: case 369: case 370: case 373:
    5171             :     case 374: case 377: case 386: case 389: case 394:
    5172             :     case 397: case 401: case 409: case 410: case 421:
    5173             :     case 425: case 427: case 433: case 442: case 449:
    5174             :     case 457: case 461: case 466: case 481: case 482:
    5175             :     case 485: case 490: case 493: case 509: case 514:
    5176             :     case 521: case 530: case 533: case 534: case 538:
    5177             :     case 541: case 545: case 554: case 557: case 562:
    5178             :     case 565: case 569: case 577: case 578: case 586:
    5179         336 :     case 593: return 1;
    5180        6804 :     default: return 0;
    5181             :   }
    5182          14 :   return 0;
    5183             : }
    5184             : 
    5185             : static GEN
    5186          28 : initwt1trace(GEN mf)
    5187             : {
    5188          28 :   GEN S = MF_get_S(mf), v, H;
    5189             :   long l, i;
    5190          28 :   if (lg(S) == 1) return mftrivial();
    5191          28 :   H = mfheckemat(mf, Mindex_as_coef(mf));
    5192          28 :   l = lg(H); v = cgetg(l, t_VEC);
    5193          63 :   for (i = 1; i < l; i++) gel(v,i) = gtrace(gel(H,i));
    5194          28 :   v = Minv_RgC_mul(MF_get_Minv(mf), v);
    5195          28 :   return mflineardiv_linear(S, v, 1);
    5196             : }
    5197             : static GEN
    5198          21 : initwt1newtrace(GEN mf)
    5199             : {
    5200          21 :   GEN v, D, S, Mindex, CHI = MF_get_CHI(mf);
    5201          21 :   long FC, lD, i, sb, N1, N2, lM, N = MF_get_N(mf);
    5202          21 :   CHI = mfchartoprimitive(CHI, &FC);
    5203          21 :   if (N % FC || mfcharparity(CHI) == 1) return mftrivial();
    5204          21 :   D = mydivisorsu(N/FC); lD = lg(D);
    5205          21 :   S = MF_get_S(mf);
    5206          21 :   if (lg(S) == 1) return mftrivial();
    5207          21 :   N2 = newd_params2(N);
    5208          21 :   N1 = N / N2;
    5209          21 :   Mindex = MF_get_Mindex(mf);
    5210          21 :   lM = lg(Mindex);
    5211          21 :   sb = Mindex[lM-1];
    5212          21 :   v = zerovec(sb+1);
    5213          42 :   for (i = 1; i < lD; i++)
    5214             :   {
    5215          21 :     long M = FC*D[i], j;
    5216          21 :     GEN tf = initwt1trace(M == N? mf: mfinit_Nkchi(M, 1, CHI, mf_CUSP, 0));
    5217             :     GEN listd, w;
    5218          21 :     if (mf_get_type(tf) == t_MF_CONST) continue;
    5219          21 :     w = mfcoefs_i(tf, sb, 1);
    5220          21 :     if (M == N) { v = gadd(v, w); continue; }
    5221           0 :     listd = mydivisorsu(u_ppo(ugcd(N/M, N1), FC));
    5222           0 :     for (j = 1; j < lg(listd); j++)
    5223             :     {
    5224           0 :       long d = listd[j], d2 = d*d; /* coprime to FC */
    5225           0 :       GEN dk = mfchareval(CHI, d);
    5226           0 :       long NMd = N/(M*d), m;
    5227           0 :       for (m = 1; m <= sb/d2; m++)
    5228             :       {
    5229           0 :         long be = mubeta2(NMd, m);
    5230           0 :         if (be)
    5231             :         {
    5232           0 :           GEN c = gmul(dk, gmulsg(be, gel(w, m+1)));
    5233           0 :           long n = m*d2;
    5234           0 :           gel(v, n+1) = gadd(gel(v, n+1), c);
    5235             :         }
    5236             :       }
    5237             :     }
    5238             :   }
    5239          21 :   if (gequal0(gel(v,2))) return mftrivial();
    5240          21 :   v = vecpermute(v,Mindex);
    5241          21 :   v = Minv_RgC_mul(MF_get_Minv(mf), v);
    5242          21 :   return mflineardiv_linear(S, v, 1);
    5243             : }
    5244             : 
    5245             : /* Matrix of T(p), p \nmid N */
    5246             : static GEN
    5247         196 : Tpmat(long p, long lim, GEN CHI)
    5248             : {
    5249         196 :   GEN M = zeromatcopy(lim, p*lim), chip = mfchareval(CHI, p); /* != 0 */
    5250             :   long i, j, pi, pj;
    5251         196 :   gcoeff(M, 1, 1) = gaddsg(1, chip);
    5252        4585 :   for (i = 1, pi = p; i < lim; i++,  pi += p) gcoeff(M, i+1, pi+1) = gen_1;
    5253        1869 :   for (j = 1, pj = p; pj < lim; j++, pj += p) gcoeff(M, pj+1, j+1) = chip;
    5254         196 :   return M;
    5255             : }
    5256             : 
    5257             : /* assume !wt1empty(N), in particular N>25 */
    5258             : /* Returns [[lim,p], mf (weight 2), p*lim x dim matrix] */
    5259             : static GEN
    5260        1799 : mfwt1_pre(long N)
    5261             : {
    5262        1799 :   GEN M, mf = mfinit_Nkchi(N, 2, mfchartrivial(), mf_CUSP, 0);
    5263             :   /*not empty for N>25*/
    5264             :   long p, lim;
    5265        1799 :   if (uisprime(N))
    5266             :   {
    5267         392 :     p = 2; /*N>25 is not 2 */
    5268         392 :     lim = ceilA1(N, 3);
    5269             :   }
    5270             :   else
    5271             :   {
    5272             :     forprime_t S;
    5273        1407 :     u_forprime_init(&S, 2, N);
    5274        2527 :     while ((p = u_forprime_next(&S)))
    5275        2527 :       if (N % p) break;
    5276        1407 :     lim = mfsturm_mf(mf) + 1;
    5277             :   }
    5278             :   /* p = smalllest prime not dividing N */
    5279        1799 :   M = bhnmat_extend_nocache(MF_get_M(mf), N, p*lim-1, 1, MF_get_S(mf));
    5280        1799 :   return mkvec3(mkvecsmall2(lim, p), mf, M);
    5281             : }
    5282             : 
    5283             : /* lg(A) > 1, E a t_POL */
    5284             : static GEN
    5285        1176 : mfmatsermul(GEN A, GEN E)
    5286             : {
    5287        1176 :   long j, l = lg(A), r = nbrows(A);
    5288        1176 :   GEN M = cgetg(l, t_MAT);
    5289        1176 :   E = RgXn_red_shallow(E, r+1);
    5290       14182 :   for (j = 1; j < l; j++)
    5291             :   {
    5292       13006 :     GEN c = RgV_to_RgX(gel(A,j), 0);
    5293       13006 :     gel(M, j) = RgX_to_RgC(RgXn_mul(c, E, r+1), r);
    5294             :   }
    5295        1176 :   return M;
    5296             : }
    5297             : /* lg(Ap) > 1, Ep an Flxn */
    5298             : static GEN
    5299         728 : mfmatsermul_Fl(GEN Ap, GEN Ep, ulong p)
    5300             : {
    5301         728 :   long j, l = lg(Ap), r = nbrows(Ap);
    5302         728 :   GEN M = cgetg(l, t_MAT);
    5303        9590 :   for (j = 1; j < l; j++)
    5304             :   {
    5305        8862 :     GEN c = Flv_to_Flx(gel(Ap,j), 0);
    5306        8862 :     gel(M,j) = Flx_to_Flv(Flxn_mul(c, Ep, r+1, p), r);
    5307             :   }
    5308         728 :   return M;
    5309             : }
    5310             : 
    5311             : /* CHI mod F | N, return mfchar of modulus N.
    5312             :  * FIXME: wasteful, G should be precomputed  */
    5313             : static GEN
    5314       12264 : mfcharinduce(GEN CHI, long N)
    5315             : {
    5316             :   GEN G, chi;
    5317       12264 :   if (mfcharmodulus(CHI) == N) return CHI;
    5318        1141 :   G = znstar0(utoipos(N), 1);
    5319        1141 :   chi = zncharinduce(gel(CHI,1), gel(CHI,2), G);
    5320        1141 :   CHI = leafcopy(CHI);
    5321        1141 :   gel(CHI,1) = G;
    5322        1141 :   gel(CHI,2) = chi; return CHI;
    5323             : }
    5324             : 
    5325             : static GEN
    5326        3983 : gmfcharno(GEN CHI)
    5327             : {
    5328        3983 :   GEN G = gel(CHI,1), chi = gel(CHI,2);
    5329        3983 :   return mkintmod(znconreyexp(G, chi), znstar_get_N(G));
    5330             : }
    5331             : static long
    5332       12838 : mfcharno(GEN CHI)
    5333             : {
    5334       12838 :   GEN n = znconreyexp(gel(CHI,1), gel(CHI,2));
    5335       12838 :   return itou(n);
    5336             : }
    5337             : 
    5338             : /* return k such that minimal mfcharacter in Galois orbit of CHI is CHI^k */
    5339             : static long
    5340       11354 : mfconreyminimize(GEN CHI)
    5341             : {
    5342       11354 :   GEN G = gel(CHI,1), cyc, chi;
    5343       11354 :   cyc = ZV_to_zv(znstar_get_cyc(G));
    5344       11354 :   chi = ZV_to_zv(znconreychar(G, gel(CHI,2)));
    5345       11354 :   return zv_cyc_minimize(cyc, chi, coprimes_zv(mfcharorder(CHI)));
    5346             : }
    5347             : 
    5348             : /* find scalar c such that first non-0 entry of c*v is 1; return c*v
    5349             :  * (set c = NULL for 1) */
    5350             : static GEN
    5351        1701 : RgV_normalize(GEN v, GEN *pc)
    5352             : {
    5353        1701 :   long i, l = lg(v);
    5354        1701 :   *pc = NULL;
    5355        3948 :   for (i = 1; i < l; i++)
    5356             :   {
    5357        3948 :     GEN c = gel(v,i);
    5358        3948 :     if (!gequal0(c))
    5359             :     {
    5360        1701 :       if (gequal1(c)) { *pc = gen_1; return v; }
    5361         595 :       *pc = ginv(c); return RgV_Rg_mul(v, *pc);
    5362             :     }
    5363             :   }
    5364           0 :   return v;
    5365             : }
    5366             : static GEN
    5367        2289 : mftreatdihedral(GEN DIH, GEN POLCYC, long ordchi, long biglim, GEN *pS)
    5368             : {
    5369             :   GEN M, Minv, C;
    5370             :   long l, i;
    5371        2289 :   l = lg(DIH); if (l == 1) return NULL;
    5372        2289 :   if (!pS) return DIH;
    5373         728 :   C = cgetg(l, t_VEC);
    5374         728 :   M = cgetg(l, t_MAT);
    5375        2044 :   for (i = 1; i < l; i++)
    5376             :   {
    5377        1316 :     GEN c, v = mfcoefs_i(gel(DIH,i), biglim, 1);
    5378        1316 :     gel(M,i) = RgV_normalize(v, &c);
    5379        1316 :     gel(C,i) = Rg_col_ei(c, l-1, i);
    5380             :   }
    5381         728 :   Minv = gel(mfclean(M,POLCYC,ordchi,0),2);
    5382         728 :   M = RgM_Minv_mul(M, Minv);
    5383         728 :   C = RgM_Minv_mul(C, Minv);
    5384         728 :   *pS = vecmflinear(DIH, C);
    5385         728 :   return M;
    5386             : }
    5387             : 
    5388             : static GEN
    5389         189 : mfstabiter(GEN *pVC, GEN M, GEN A2, GEN E1inv, long lim, GEN P, long ordchi)
    5390             : {
    5391             :   GEN A, VC, con;
    5392         189 :   E1inv = primitive_part(E1inv, &con);
    5393         189 :   VC = con? ginv(con): gen_1;
    5394         189 :   A = mfmatsermul(A2, E1inv);
    5395             :   for(;;)
    5396         105 :   {
    5397         294 :     GEN R = shallowconcat(RgM_mul(M,A), rowslice(A,1,lim));
    5398         294 :     GEN B = QabM_ker(R, P, ordchi);
    5399         294 :     long lA = lg(A), lB = lg(B);
    5400         294 :     if (lB == 1) return NULL;
    5401         294 :     if (lB == lA) { *pVC = gmul(*pVC, VC); return A; }
    5402         105 :     B = rowslice(B, 1, lA-1);
    5403         105 :     if (ordchi > 2) B = gmodulo(B, P);
    5404         105 :     A = Q_primitive_part(RgM_mul(A,B), &con);
    5405         105 :     VC = gmul(VC,B); /* first VC is a scalar, then a RgM */
    5406         105 :     if (con) VC = RgM_Rg_div(VC, con);
    5407             :   }
    5408             : }
    5409             : static long
    5410         189 : mfstabitermodp(GEN Mp, GEN Ap, long p, long lim)
    5411             : {
    5412         189 :   GEN VC = NULL;
    5413             :   while (1)
    5414          21 :   {
    5415         210 :     GEN Rp = shallowconcat(Flm_mul(Mp,Ap,p), rowslice(Ap,1,lim));
    5416         210 :     GEN Bp = Flm_ker(Rp, p);
    5417         210 :     long lA = lg(Ap), lB = lg(Bp);
    5418         210 :     if (lB == 1) return 0;
    5419         210 :     if (lB == lA) return lA-1;
    5420          21 :     Bp = rowslice(Bp, 1, lA-1);
    5421          21 :     Ap = Flm_mul(Ap, Bp, p);
    5422          21 :     VC = VC? Flm_mul(VC, Bp, p): Bp;
    5423             :   }
    5424             : }
    5425             : 
    5426             : static GEN
    5427         350 : mfintereis(GEN *pVC, GEN A, GEN M2, GEN y, GEN den, GEN E2, GEN P, long ordchi)
    5428             : {
    5429         350 :   GEN z, M1 = mfmatsermul(A,E2), M1den = isint1(den)? M1: RgM_Rg_mul(M1,den);
    5430         350 :   M2 = RgM_mul(M2, rowpermute(M1, y));
    5431         350 :   z = QabM_ker(RgM_sub(M2,M1den), P, ordchi);
    5432         350 :   if (lg(z) == 1) return NULL;
    5433         350 :   if (ordchi > 2) z = gmodulo(z, P);
    5434         350 :   *pVC = typ(*pVC) == t_INT? z: RgM_mul(*pVC, z);
    5435         350 :   return RgM_mul(A,z);
    5436             : }
    5437             : static GEN
    5438         357 : mfintereismodp(GEN *pVC, GEN A, GEN M2, GEN E2, long dih, ulong p)
    5439             : {
    5440         357 :   GEN M1 = mfmatsermul_Fl(A, E2, p), z;
    5441         357 :   long j, lx = lg(A);
    5442         357 :   z = Flm_ker(shallowconcat(M1, M2), p);
    5443         357 :   j = lg(z) - 1; if (j == dih) return NULL;
    5444        1533 :   for (; j; j--) setlg(z[j], lx);
    5445         350 :   *pVC = *pVC? Flm_mul(*pVC, z, p): z;
    5446         350 :   return Flm_mul(A,z,p);
    5447             : }
    5448             : 
    5449             : static GEN
    5450         196 : mfcharinv_i(GEN CHI)
    5451             : {
    5452         196 :   GEN G = gel(CHI,1);
    5453         196 :   CHI = leafcopy(CHI); gel(CHI,2) =  zncharconj(G, gel(CHI,2)); return CHI;
    5454             : }
    5455             : 
    5456             : /* upper bound dim S_1(Gamma_0(N),chi) performing the linear algebra mod p */
    5457             : static long
    5458         196 : mfwt1dimmodp(GEN A, GEN ES, GEN M, long ordchi, long dih, long lim)
    5459             : {
    5460             :   GEN Ap, ES1p, VC;
    5461         196 :   ulong p, r = QabM_init(ordchi, &p);
    5462             : 
    5463         196 :   Ap = QabM_to_Flm(A, r, p);
    5464         196 :   VC = NULL;
    5465         196 :   ES1p = QabX_to_Flx(gel(ES,1), r, p);
    5466         196 :   if (lg(ES) >= 3)
    5467             :   {
    5468         182 :     GEN M2 = mfmatsermul_Fl(Ap, ES1p, p);
    5469         182 :     pari_sp av = avma;
    5470             :     long i;
    5471         532 :     for (i = 2; i < lg(ES); i++)
    5472             :     {
    5473         357 :       GEN ESip = QabX_to_Flx(gel(ES,i), r, p);
    5474         357 :       Ap = mfintereismodp(&VC, Ap, M2, ESip, dih, p);
    5475         357 :       if (!Ap) return dih;
    5476         350 :       gerepileall(av, 2, &Ap,&VC);
    5477             :     }
    5478             :   }
    5479             :   /* intersection of Eisenstein series quotients non empty: use Schaeffer */
    5480         189 :   Ap = mfmatsermul_Fl(Ap, Flxn_inv(ES1p,nbrows(Ap),p), p);
    5481         189 :   return mfstabitermodp(QabM_to_Flm(M,r,p), Ap, p, lim);
    5482             : }
    5483             : 
    5484             : /* Compute the full S_1(\G_0(N),\chi). If pS is NULL, only the dimension
    5485             :  * dim, in the form of a vector having dim components. Otherwise output
    5486             :  * a basis: ptvf contains a pointer to the vector of forms, and the
    5487             :  * program returns the corresponding matrix of Fourier expansions.
    5488             :  * ptdimdih gives the dimension of the subspace generated by dihedral forms;
    5489             :  * TMP is from mfwt1_pre or NULL. */
    5490             : static GEN
    5491       10815 : mfwt1basis(long N, GEN CHI, GEN TMP, GEN *pS, long *ptdimdih)
    5492             : {
    5493             :   GEN ES, E, mf, A, M, Tp, den, VC, C, POLCYC, ES1, ES1INV, DIH, a0, a0i;
    5494             :   long plim, lim, biglim, i, p, dA, dimp, ordchi, dih;
    5495             : 
    5496       10815 :   if (ptdimdih) *ptdimdih = 0;
    5497       10815 :   if (pS) *pS = NULL;
    5498       10815 :   if (wt1empty(N) || mfcharparity(CHI) != -1) return NULL;
    5499       10528 :   ordchi = mfcharorder(CHI);
    5500       10528 :   if (uisprime(N) && ordchi > 4) return NULL;
    5501       10500 :   if (!pS)
    5502             :   {
    5503        7042 :     dih = mfdihedralcuspdim(N, CHI);
    5504        7042 :     DIH = zerovec(dih);
    5505             :   }
    5506             :   else
    5507             :   {
    5508        3458 :     DIH = mfdihedralcusp(N, CHI);
    5509        3458 :     dih = lg(DIH) - 1;
    5510             :   }
    5511       10500 :   POLCYC = (ordchi <= 2)? NULL: mfcharpol(CHI);
    5512       10500 :   if (ptdimdih) *ptdimdih = dih;
    5513       10500 :   biglim = mfsturmNk(N, 2);
    5514       10500 :   if (N <= 600) switch(N)
    5515             :   {
    5516             :     long m;
    5517          14 :     case 219: case 273: case 283: case 331: case 333: case 344: case 416:
    5518             :     case 438: case 468: case 491: case 504: case 546: case 553: case 563:
    5519             :     case 566: case 581: case 592:
    5520          14 :       break; /* one chi with both exotic and dihedral forms */
    5521        9436 :     default: /* only dihedral forms */
    5522        9436 :       if (!dih) return NULL;
    5523             :       /* fall through */
    5524             :     case 124: case 133: case 148: case 171: case 201: case 209: case 224:
    5525             :     case 229: case 248: case 261: case 266: case 288: case 296: case 301:
    5526             :     case 309: case 325: case 342: case 371: case 372: case 380: case 399:
    5527             :     case 402: case 403: case 404: case 408: case 418: case 432: case 444:
    5528             :     case 448: case 451: case 453: case 458: case 496: case 497: case 513:
    5529             :     case 522: case 527: case 532: case 576: case 579:
    5530             :       /* no chi with both exotic and dihedral; one chi with exotic forms */
    5531        3192 :       if (dih) return mftreatdihedral(DIH, POLCYC, ordchi, biglim, pS);
    5532         910 :       m = mfcharno(mfcharinduce(CHI,N));
    5533         910 :       if (N == 124 && (m != 67 && m != 87)) return NULL;
    5534         784 :       if (N == 133 && (m != 83 && m !=125)) return NULL;
    5535         490 :       if (N == 148 && (m !=105 && m !=117)) return NULL;
    5536         364 :       if (N == 171 && (m != 94 && m !=151)) return NULL;
    5537         364 :       if (N == 201 && (m != 29 && m !=104)) return NULL;
    5538         364 :       if (N == 209 && (m != 87 && m !=197)) return NULL;
    5539         364 :       if (N == 224 && (m != 95 && m !=191)) return NULL;
    5540         364 :       if (N == 229 && (m !=107 && m !=122)) return NULL;
    5541         364 :       if (N == 248 && (m != 87 && m !=191)) return NULL;
    5542         273 :       if (N == 261 && (m != 46 && m !=244)) return NULL;
    5543         273 :       if (N == 266 && (m != 83 && m !=125)) return NULL;
    5544         273 :       if (N == 288 && (m != 31 && m !=223)) return NULL;
    5545         273 :       if (N == 296 && (m !=105 && m !=265)) return NULL;
    5546             :   }
    5547         196 :   if (!TMP) TMP = mfwt1_pre(N);
    5548         196 :   lim = gel(TMP,1)[1]; p = gel(TMP,1)[2]; plim = p*lim;
    5549         196 :   mf  = gel(TMP,2);
    5550         196 :   A   = gel(TMP,3); /* p*lim x dim matrix */
    5551         196 :   E = mfeisensteinbasis(N, 1, mfcharinv_i(CHI));
    5552         196 :   ES = RgM_to_RgXV(mfvectomat(E, plim+1, 1), 0);
    5553         196 :   Tp = Tpmat(p, lim, CHI);
    5554         196 :   dimp = mfwt1dimmodp(A, ES, Tp, ordchi, dih, lim);
    5555         196 :   if (!dimp) return NULL;
    5556         196 :   if (dimp == dih) return mftreatdihedral(DIH, POLCYC, ordchi, biglim, pS);
    5557         189 :   VC = gen_1; ES1 = gel(ES,1); /* does not vanish at oo */
    5558         189 :   if (lg(ES) > 2)
    5559             :   {
    5560             :     pari_sp btop;
    5561         175 :     GEN Ar = rowslice(A, 1, (3*lim)/2 + 1), M2 = mfmatsermul(Ar, ES1);
    5562             :     GEN v, y, M2M2I, M2I;
    5563         175 :     M2I = QabM_pseudoinv(M2, POLCYC, ordchi, &v, &den);
    5564         175 :     M2M2I = RgM_mul(M2,M2I);
    5565         175 :     y = gel(v,1); btop = avma;
    5566         525 :     for (i = 2; i < lg(ES); i++)
    5567             :     {
    5568         350 :       Ar = mfintereis(&VC, Ar, M2M2I, y, den, gel(ES,i), POLCYC,ordchi);
    5569         350 :       if (!Ar) return NULL;
    5570         350 :       if (gc_needed(btop, 1))
    5571             :       {
    5572           0 :         if (DEBUGMEM > 1) pari_warn(warnmem,"mfwt1basis i = %ld", i);
    5573           0 :         gerepileall(btop, 2, &Ar, &VC);
    5574             :       }
    5575             :     }
    5576         175 :     A = RgM_mul(A, vecslice(VC,1, lg(Ar)-1));
    5577             :   }
    5578         189 :   a0 = gel(ES1,2); /* non-zero */
    5579         189 :   if (gequal1(a0)) a0 = a0i = NULL;
    5580             :   else
    5581             :   {
    5582         189 :     a0i = ginv(a0);
    5583         189 :     ES1 = RgX_Rg_mul(RgX_unscale(ES1,a0), a0i);
    5584             :   }
    5585         189 :   ES1INV = RgXn_inv(ES1, plim-1);
    5586         189 :   if (a0) ES1INV = RgX_Rg_mul(RgX_unscale(ES1INV, a0i), a0i);
    5587         189 :   A = mfstabiter(&VC, Tp, A, ES1INV, lim, POLCYC, ordchi);
    5588         189 :   if (!A) return NULL;
    5589         189 :   dA = lg(A);
    5590         189 :   C = cgetg(dA, t_VEC);
    5591         189 :   M = cgetg(dA, t_MAT);
    5592         574 :   for (i = 1; i < dA; i++)
    5593             :   {
    5594         385 :     GEN c, v = gel(A,i);
    5595         385 :     gel(M,i) = RgV_normalize(v, &c);
    5596         385 :     gel(C,i) = RgC_Rg_mul(gel(VC,i), c);
    5597             :   }
    5598         189 :   if (pS)
    5599             :   {
    5600         140 :     GEN Minv = gel(mfclean(M, POLCYC, ordchi, 0), 2);
    5601         140 :     M = RgM_Minv_mul(M, Minv);
    5602         140 :     C = RgM_Minv_mul(C, Minv);
    5603         140 :     *pS = vecmflineardiv0(MF_get_S(mf), C, gel(E,1));
    5604             :   }
    5605         189 :   return M;
    5606             : }
    5607             : 
    5608             : static void
    5609         322 : MF_set_space(GEN mf, long x) { gmael(mf,1,4) = utoi(x); }
    5610             : static GEN
    5611         168 : mfwt1_cusptonew(GEN mf)
    5612             : {
    5613         168 :   const long vy = 1;
    5614         168 :   GEN vP, F, S, Snew, vF, v = split(mf);
    5615             :   long i, lP, dSnew, ct;
    5616             : 
    5617         168 :   F = gel(v,1);
    5618         168 :   vP= gel(v,2); lP = lg(vP);
    5619         168 :   if (lP == 1) { obj_insert(mf, MF_SPLIT, v); return NULL; }
    5620         154 :   MF_set_space(mf, mf_NEW);
    5621         154 :   S = MF_get_S(mf);
    5622         154 :   dSnew = dim_sum(v);
    5623         154 :   Snew = cgetg(dSnew + 1, t_VEC); ct = 0;
    5624         154 :   vF = cgetg(lP, t_MAT);
    5625         329 :   for (i = 1; i < lP; i++)
    5626             :   {
    5627         175 :     GEN V, P = gel(vP,i), f = liftpol_shallow(gel(F,i));
    5628         175 :     long j, d = degpol(P);
    5629         175 :     gel(vF,i) = V = zerocol(dSnew);
    5630         175 :     if (d == 1)
    5631             :     {
    5632          84 :       gel(Snew, ct+1) = mflineardiv_linear(S, f, 0);
    5633          84 :       gel(V, ct+1) = gen_1;
    5634             :     }
    5635             :     else
    5636             :     {
    5637          91 :       f = RgXV_to_RgM(f,d);
    5638         280 :       for (j = 1; j <= d; j++)
    5639             :       {
    5640         189 :         gel(Snew, ct+j) = mflineardiv_linear(S, row(f,j), 0);
    5641         189 :         gel(V, ct+j) = mkpolmod(pol_xn(j-1,vy), P);
    5642             :       }
    5643             :     }
    5644         175 :     ct += d;
    5645             :   }
    5646         154 :   obj_insert(mf, MF_SPLIT, mkvec2(vF, vP));
    5647         154 :   gel(mf,3) = Snew; return mf;
    5648             : }
    5649             : static GEN
    5650        3570 : mfwt1init(long N, GEN CHI, GEN TMP, long space, long flraw)
    5651             : {
    5652        3570 :   GEN mf, mf1, S, M = mfwt1basis(N, CHI, TMP, &S, NULL);
    5653        3570 :   if (!M) return NULL;
    5654         868 :   mf1 = mkvec4(stoi(N), gen_1, CHI, utoi(mf_CUSP));
    5655         868 :   mf = mkmf(mf1, cgetg(1,t_VEC), S, gen_0, NULL);
    5656         868 :   if (space == mf_NEW)
    5657             :   {
    5658         168 :     gel(mf,5) = mfcleanCHI(M,CHI, 0);
    5659         168 :     mf = mfwt1_cusptonew(mf); if (!mf) return NULL;
    5660         154 :     if (!flraw) M = mfcoefs_mf(mf, mfsturmNk(N,1)+1, 1);
    5661             :   }
    5662         854 :   gel(mf,5) = flraw? zerovec(3): mfcleanCHI(M, CHI, 0);
    5663         854 :   return mf;
    5664             : }
    5665             : 
    5666             : static GEN
    5667         973 : mfEMPTY(GEN mf1)
    5668             : {
    5669         973 :   GEN Minv = mkMinv(cgetg(1,t_MAT), NULL,NULL,NULL);
    5670         973 :   GEN M = mkvec3(cgetg(1,t_VECSMALL), Minv, cgetg(1,t_MAT));
    5671         973 :   return mkmf(mf1, cgetg(1,t_VEC), cgetg(1,t_VEC), cgetg(1,t_VEC), M);
    5672             : }
    5673             : static GEN
    5674         616 : mfEMPTYall(long N, GEN gk, GEN vCHI, long space)
    5675             : {
    5676             :   long i, l;
    5677             :   GEN v, gN, gs;
    5678         616 :   if (!vCHI) return cgetg(1, t_VEC);
    5679          14 :   gN = utoipos(N); gs = utoi(space);
    5680          14 :   l = lg(vCHI); v = cgetg(l, t_VEC);
    5681          42 :   for (i = 1; i < l; i++) gel(v,i) = mfEMPTY(mkvec4(gN,gk,gel(vCHI,i),gs));
    5682          14 :   return v;
    5683             : }
    5684             : 
    5685             : static GEN
    5686        3983 : fmt_dim(GEN CHI, long d, long dih)
    5687        3983 : { return mkvec4(gmfcharorder(CHI), gmfcharno(CHI), utoi(d), stoi(dih)); }
    5688             : /* merge two vector of fmt_dim's for the same vector of characters. If CHI
    5689             :  * is not NULL, remove dim-0 spaces and add character from CHI */
    5690             : static GEN
    5691           7 : merge_dims(GEN V, GEN W, GEN CHI)
    5692             : {
    5693           7 :   long i, j, id, l = lg(V);
    5694           7 :   GEN A = cgetg(l, t_VEC);
    5695           7 :   if (l == 1) return A;
    5696           7 :   id = CHI? 1: 3;
    5697          21 :   for (i = j = 1; i < l; i++)
    5698             :   {
    5699          14 :     GEN v = gel(V,i), w = gel(W,i);
    5700          14 :     long dv = itou(gel(v,id)), dvh = itou(gel(v,id+1)), d;
    5701          14 :     long dw = itou(gel(w,id)), dwh = itou(gel(w,id+1));
    5702          14 :     d = dv + dw;
    5703          14 :     if (d || CHI)
    5704          14 :       gel(A,j++) = CHI? fmt_dim(gel(CHI,i),d, dvh+dwh)
    5705          14 :                       : mkvec2s(d,dvh+dwh);
    5706             :   }
    5707           7 :   setlg(A, j); return A;
    5708             : }
    5709             : static GEN
    5710        3010 : mfdim0all(GEN w)
    5711             : {
    5712        3038 :   if (w) retconst_vec(lg(w)-1, zerovec(2));
    5713        3003 :   return cgetg(1,t_VEC);
    5714             : }
    5715             : static long
    5716        7245 : mfwt1cuspdim_i(long N, GEN CHI, GEN TMP, long *dih)
    5717             : {
    5718        7245 :   pari_sp av = avma;
    5719        7245 :   GEN b = mfwt1basis(N, CHI, TMP, NULL, dih);
    5720        7245 :   return gc_long(av, b? lg(b)-1: 0);
    5721             : }
    5722             : static long
    5723         406 : mfwt1cuspdim(long N, GEN CHI) { return mfwt1cuspdim_i(N, CHI, NULL, NULL); }
    5724             : static GEN
    5725        4144 : mfwt1cuspdimall(long N, GEN vCHI)
    5726             : {
    5727             :   GEN z, TMP, w;
    5728             :   long i, j, l;
    5729        4144 :   if (wt1empty(N)) return mfdim0all(vCHI);
    5730        1141 :   w = mfwt1chars(N,vCHI);
    5731        1141 :   l = lg(w); if (l == 1) return cgetg(1,t_VEC);
    5732        1141 :   z = cgetg(l, t_VEC);
    5733        1141 :   TMP = mfwt1_pre(N);
    5734        7861 :   for (i = j = 1; i < l; i++)
    5735             :   {
    5736        6720 :     GEN CHI = gel(w,i);
    5737        6720 :     long dih, d = mfwt1cuspdim_i(N, CHI, TMP, &dih);
    5738        6720 :     if (vCHI)
    5739          42 :       gel(z,j++) = mkvec2s(d, dih);
    5740        6678 :     else if (d)
    5741        1428 :       gel(z,j++) = fmt_dim(CHI, d, dih);
    5742             :   }
    5743        1141 :   setlg(z,j); return z;
    5744             : }
    5745             : 
    5746             : /* dimension of S_1(Gamma_1(N)) */
    5747             : static long
    5748        4123 : mfwt1cuspdimsum(long N)
    5749             : {
    5750        4123 :   pari_sp av = avma;
    5751        4123 :   GEN v = mfwt1cuspdimall(N, NULL);
    5752        4123 :   long i, ct = 0, l = lg(v);
    5753        5544 :   for (i = 1; i < l; i++)
    5754             :   {
    5755        1421 :     GEN w = gel(v,i); /* [ord(CHI),*,dim,*] */
    5756        1421 :     ct += itou(gel(w,3))*myeulerphiu(itou(gel(w,1)));
    5757             :   }
    5758        4123 :   return gc_long(av,ct);
    5759             : }
    5760             : 
    5761             : static GEN
    5762          56 : mfwt1newdimall(long N, GEN vCHI)
    5763             : {
    5764             :   GEN z, w, vTMP, fa, P, E;
    5765             :   long i, c, l, lw, P1;
    5766          56 :   if (wt1empty(N)) return mfdim0all(vCHI);
    5767          56 :   w = mfwt1chars(N,vCHI);
    5768          56 :   lw = lg(w); if (lw == 1) return cgetg(1,t_VEC);
    5769          56 :   vTMP = const_vec(N, NULL);
    5770          56 :   gel(vTMP,N) = mfwt1_pre(N);
    5771             :   /* if p || N and p \nmid F(CHI), S_1^new(G0(N),chi) = 0 */
    5772          56 :   fa = znstar_get_faN(gmael(w,1,1));
    5773          56 :   P = gel(fa,1); l = lg(P);
    5774          56 :   E = gel(fa,2);
    5775         154 :   for (i = P1 = 1; i < l; i++)
    5776          98 :     if (E[i] == 1) P1 *= itou(gel(P,i));
    5777             :   /* P1 = \prod_{v_p(N) = 1} p */
    5778          56 :   z = cgetg(lw, t_VEC);
    5779         182 :   for (i = c = 1; i < lw; i++)
    5780             :   {
    5781             :     long S, j, l, F, dihnew;
    5782         126 :     GEN D, CHI = gel(w,i), CHIP = mfchartoprimitive(CHI,&F);
    5783             : 
    5784         126 :     S = F % P1? 0: mfwt1cuspdim_i(N, CHI, gel(vTMP,N), &dihnew);
    5785         126 :     if (!S)
    5786             :     {
    5787          56 :       if (vCHI) gel(z, c++) = zerovec(2);
    5788          56 :       continue;
    5789             :     }
    5790          70 :     D = mydivisorsu(N/F); l = lg(D);
    5791          77 :     for (j = l-2; j > 0; j--) /* skip last M = N */
    5792             :     {
    5793           7 :       long M = D[j]*F, m, s, dih;
    5794           7 :       GEN TMP = gel(vTMP,M);
    5795           7 :       if (wt1empty(M) || !(m = mubeta(D[l-j]))) continue; /*m = mubeta(N/M)*/
    5796           7 :       if (!TMP) gel(vTMP,M) = TMP = mfwt1_pre(M);
    5797           7 :       s = mfwt1cuspdim_i(M, CHIP, TMP, &dih);
    5798           7 :       if (s) { S += m * s; dihnew += m * dih; }
    5799             :     }
    5800          70 :     if (vCHI)
    5801          63 :       gel(z,c++) = mkvec2s(S, dihnew);
    5802           7 :     else if (S)
    5803           7 :       gel(z, c++) = fmt_dim(CHI, S, dihnew);
    5804             :   }
    5805          56 :   setlg(z,c); return z;
    5806             : }
    5807             : 
    5808             : static GEN
    5809          28 : mfwt1olddimall(long N, GEN vCHI)
    5810             : {
    5811             :   long i, j, l;
    5812             :   GEN z, w;
    5813          28 :   if (wt1empty(N)) return mfdim0all(vCHI);
    5814          28 :   w = mfwt1chars(N,vCHI);
    5815          28 :   l = lg(w); z = cgetg(l, t_VEC);
    5816          84 :   for (i = j = 1; i < l; i++)
    5817             :   {
    5818          56 :     GEN CHI = gel(w,i);
    5819          56 :     long d = mfolddim(N, 1, CHI);
    5820          56 :     if (vCHI)
    5821          28 :       gel(z,j++) = mkvec2s(d,d?-1:0);
    5822          28 :     else if (d)
    5823           7 :       gel(z, j++) = fmt_dim(CHI, d, -1);
    5824             :   }
    5825          28 :   setlg(z,j); return z;
    5826             : }
    5827             : 
    5828             : static long
    5829         469 : mfwt1olddimsum(long N)
    5830             : {
    5831             :   GEN D;
    5832         469 :   long N2, i, l, S = 0;
    5833         469 :   newd_params(N, &N2); /* will ensure mubeta != 0 */
    5834         469 :   D = mydivisorsu(N/N2); l = lg(D);
    5835        2485 :   for (i = 2; i < l; i++)
    5836             :   {
    5837        2016 :     long M = D[l-i]*N2, d = mfwt1cuspdimsum(M);
    5838        2016 :     if (d) S -= mubeta(D[i]) * d;
    5839             :   }
    5840         469 :   return S;
    5841             : }
    5842             : static long
    5843        1050 : mfwt1newdimsum(long N)
    5844             : {
    5845        1050 :   long S = mfwt1cuspdimsum(N);
    5846        1050 :   return S? S - mfwt1olddimsum(N): 0;
    5847             : }
    5848             : 
    5849             : /* return the automorphism of a degree-2 nf */
    5850             : static GEN
    5851        5712 : nf2_get_conj(GEN nf)
    5852             : {
    5853        5712 :   GEN pol = nf_get_pol(nf);
    5854        5712 :   return deg1pol_shallow(gen_m1, negi(gel(pol,3)), varn(pol));
    5855             : }
    5856             : 
    5857             : static long
    5858         210 : mfisdihedral(GEN vF, GEN DIH)
    5859             : {
    5860         210 :   GEN vG = gel(DIH,1), M = gel(DIH,2), v, G, bnr, w, gen, D, f, nf, con;
    5861             :   GEN f0, f0b, xin;
    5862             :   long i, l, e, j, L, n;
    5863         210 :   if (lg(M) == 1) return 0;
    5864          28 :   v = RgM_RgC_invimage(M, vF);
    5865          28 :   if (!v) return 0;
    5866          28 :   l = lg(v);
    5867          28 :   for (i = 1; i < l; i++)
    5868          28 :     if (!gequal0(gel(v,i))) break;
    5869          28 :   if (i == l) return 0;
    5870          28 :   G = gel(vG,i);
    5871          28 :   bnr = gel(G,2); D = cyc_get_expo(bnr_get_cyc(bnr));
    5872          28 :   w = gel(G,3);
    5873          28 :   f = bnr_get_mod(bnr);
    5874          28 :   nf = bnr_get_nf(bnr);
    5875          28 :   con = nf2_get_conj(nf);
    5876          28 :   f0 = gel(f,1); f0b = galoisapply(nf, con, f0);
    5877          28 :   xin = zv_to_ZV(gel(w,2)); /* xi(bnr.gen[i]) = e(xin[i] / D) */
    5878          28 :   if (!gequal(f0,f0b))
    5879             :   { /* finite part of conductor not ambiguous */
    5880          14 :     GEN a = idealmul(nf, f0, idealdivexact(nf, f0b, idealadd(nf, f0, f0b)));
    5881          14 :     GEN bnr0 = bnr, S;
    5882          14 :     bnr = Buchray(bnr_get_bnf(bnr), mkvec2(a, gel(f,2)), nf_INIT | nf_GEN);
    5883          14 :     S = bnrsurjection(bnr, bnr0);
    5884          14 :     xin = RgV_RgM_mul(xin, gel(S,1));
    5885             :     /* still xi(gen[i]) = e(xin[i] / D), for the new generators */
    5886             :   }
    5887          28 :   gen = bnr_get_gen(bnr); L = lg(gen);
    5888          42 :   for (j = 1, e = itou(D); j < L; j++)
    5889             :   {
    5890          35 :     GEN Ng = idealnorm(nf, gel(gen,j));
    5891          35 :     GEN a = shifti(gel(xin,j), 1); /* xi(g_j^2) = e(a/D) */
    5892          35 :     GEN b = FpV_dotproduct(xin, isprincipalray(bnr,Ng), D);
    5893          35 :     GEN m = Fp_sub(a, b, D); /* xi(g_j/\bar{g_j}) = e(m/D) */
    5894          35 :     e = ugcd(e, itou(m)); if (e == 1) break;
    5895             :   }
    5896          28 :   n = itou(D) / e;
    5897          28 :   return n == 1? 4: 2*n;
    5898             : }
    5899             : 
    5900             : static ulong
    5901         119 : myradicalu(ulong n) { return zv_prod(gel(myfactoru(n),1)); }
    5902             : 
    5903             : /* list of fundamental discriminants unramified outside N, with sign s
    5904             :  * [s = 0 => no sign condition] */
    5905             : static GEN
    5906         119 : mfunram(long N, long s)
    5907             : {
    5908         119 :   long cN = myradicalu(N >> vals(N)), p = 1, m = 1, l, c, i;
    5909         119 :   GEN D = mydivisorsu(cN), res;
    5910         119 :   l = lg(D);
    5911         119 :   if (s == 1) m = 0; else if (s == -1) p = 0;
    5912         119 :   res = cgetg(6*l - 5, t_VECSMALL);
    5913         119 :   c = 1;
    5914         119 :   if (!odd(N))
    5915             :   { /* d = 1 */
    5916          56 :     if (p) res[c++] = 8;
    5917          56 :     if (m) { res[c++] =-8; res[c++] =-4; }
    5918             :   }
    5919         364 :   for (i = 2; i < l; i++)
    5920             :   { /* skip d = 1, done above */
    5921         245 :     long d = D[i], d4 = d & 3L; /* d odd, squarefree, d4 = 1 or 3 */
    5922         245 :     if (d4 == 1) { if (p) res[c++] = d; }
    5923         182 :     else         { if (m) res[c++] =-d; }
    5924         245 :     if (!odd(N))
    5925             :     {
    5926          56 :       if (p) { res[c++] = 8*d; if (d4 == 3) res[c++] = 4*d; }
    5927          56 :       if (m) { res[c++] =-8*d; if (d4 == 1) res[c++] =-4*d; }
    5928             :     }
    5929             :   }
    5930         119 :   setlg(res, c); return res;
    5931             : }
    5932             : 
    5933             : /* Return 1 if F is definitely not S4 type; return 0 on failure. */
    5934             : static long
    5935         105 : mfisnotS4(long N, GEN w)
    5936             : {
    5937         105 :   GEN D = mfunram(N, 0);
    5938         105 :   long i, lD = lg(D), lw = lg(w);
    5939         616 :   for (i = 1; i < lD; i++)
    5940             :   {
    5941         511 :     long p, d = D[i], ok = 0;
    5942        1442 :     for (p = 2; p < lw; p++)
    5943        1442 :       if (w[p] && kross(d,p) == -1) { ok = 1; break; }
    5944         511 :     if (!ok) return 0;
    5945             :   }
    5946         105 :   return 1;
    5947             : }
    5948             : 
    5949             : /* Return 1 if Q(sqrt(5)) \not\subset Q(F), i.e. F is definitely not A5 type;
    5950             :  * return 0 on failure. */
    5951             : static long
    5952         105 : mfisnotA5(GEN F)
    5953             : {
    5954         105 :   GEN CHI = mf_get_CHI(F), P = mfcharpol(CHI), T, Q;
    5955             : 
    5956         105 :   if (mfcharorder(CHI) % 5 == 0) return 0;
    5957         105 :   T = mf_get_field(F); if (degpol(T) == 1) return 1;
    5958         105 :   if (degpol(P) > 1) T = rnfequation(P,T);
    5959         105 :   Q = gsubgs(pol_xn(2,varn(T)), 5);
    5960         105 :   return (typ(nfisincl(Q, T)) == t_INT);
    5961             : }
    5962             : 
    5963             : /* v[p+1]^2 / chi(p) - 2 = z + 1/z with z primitive root of unity of order n,
    5964             :  * return n */
    5965             : static long
    5966        6741 : mffindrootof1(GEN v, long p, GEN CHI)
    5967             : {
    5968        6741 :   GEN ap = gel(v,p+1), u0, u1, u1k, u2;
    5969        6741 :   long c = 1;
    5970        6741 :   if (gequal0(ap)) return 2;
    5971        5033 :   u0 = gen_2; u1k = u1 = gsubgs(gdiv(gsqr(ap), mfchareval(CHI, p)), 2);
    5972       14812 :   while (!gequalsg(2, liftpol_shallow(u1))) /* u1 = z^c + z^-c */
    5973             :   {
    5974        9779 :     u2 = gsub(gmul(u1k, u1), u0);
    5975        9779 :     u0 = u1; u1 = u2; c++;
    5976             :   }
    5977        5033 :   return c;
    5978             : }
    5979             : 
    5980             : /* we known that F is not dihedral */
    5981             : static long
    5982         182 : mfgaloistype_i(long N, GEN CHI, GEN F, GEN v)
    5983             : {
    5984             :   forprime_t iter;
    5985         182 :   long lim = lg(v)-2;
    5986         182 :   GEN w = zero_zv(lim);
    5987             :   pari_sp av;
    5988             :   ulong p;
    5989         182 :   u_forprime_init(&iter, 2, lim);
    5990         182 :   av = avma;
    5991        5292 :   while((p = u_forprime_next(&iter))) if (N%p) switch(mffindrootof1(v, p, CHI))
    5992             :   {
    5993        1400 :     case 1: case 2: continue;
    5994        3451 :     case 3: w[p] = 1; break;
    5995          70 :     case 4: return -24; /* S4 */
    5996           0 :     case 5: return -60; /* A5 */
    5997           7 :     default: pari_err_DOMAIN("mfgaloistype", "form", "not a",
    5998             :                              strtoGENstr("cuspidal eigenform"), F);
    5999           0 :     set_avma(av);
    6000             :   }
    6001         364 :   if (mfisnotS4(N,w) && mfisnotA5(F)) return -12; /* A4 */
    6002           0 :   return 0; /* FAILURE */
    6003             : }
    6004             : 
    6005             : static GEN
    6006         210 : mfgaloistype0(long N, GEN CHI, GEN F, GEN DIH, long lim)
    6007             : {
    6008         210 :   pari_sp av = avma;
    6009         210 :   GEN vF = mftocol(F, lim, 1);
    6010         210 :   long t = mfisdihedral(vF, DIH);
    6011         210 :   if (t) { set_avma(av); return stoi(t); }
    6012             :   for(;;)
    6013             :   {
    6014         182 :     t = mfgaloistype_i(N, CHI, F, vF);
    6015         175 :     set_avma(av); if (t) return stoi(t);
    6016           0 :     lim += lim >> 1; vF = mfcoefs_i(F,lim,1);
    6017             :   }
    6018             : }
    6019             : 
    6020             : /* If f is NULL, give all the galoistypes, otherwise just for f */
    6021             : GEN
    6022         217 : mfgaloistype(GEN NK, GEN f)
    6023             : {
    6024         217 :   pari_sp av = avma;
    6025         217 :   GEN CHI, T, F, DIH, mf = checkMF_i(NK);
    6026             :   long N, k, lL, i, lim, SB;
    6027             : 
    6028         217 :   if (f && !checkmf_i(f)) pari_err_TYPE("mfgaloistype", f);
    6029         210 :   if (mf)
    6030             :   {
    6031         175 :     N = MF_get_N(mf);
    6032         175 :     k = MF_get_k(mf);
    6033         175 :     CHI = MF_get_CHI(mf);
    6034             :   }
    6035             :   else
    6036             :   {
    6037          35 :     checkNK(NK, &N, &k, &CHI, 0);
    6038          35 :     mf = f? NULL: mfinit_i(NK, mf_NEW);
    6039             :   }
    6040         210 :   if (k != 1) pari_err_DOMAIN("mfgaloistype", "k", "!=", gen_1, stoi(k));
    6041         210 :   SB = mf? mfsturm_mf(mf): mfsturmNk(N,1);
    6042         210 :   DIH = mfdihedralnew(N,CHI);
    6043         210 :   lim = lg(DIH) == 1? 200: SB;
    6044         210 :   DIH = mkvec2(DIH, mfvectomat(DIH,SB,1));
    6045         210 :   if (f) return gerepileuptoint(av, mfgaloistype0(N,CHI, f, DIH, lim));
    6046         112 :   F = mfeigenbasis(mf); lL = lg(F);
    6047         112 :   T = cgetg(lL, t_VEC);
    6048         224 :   for (i=1; i < lL; i++) gel(T,i) = mfgaloistype0(N, CHI, gel(F,i), DIH, lim);
    6049         112 :   return gerepileupto(av, T);
    6050             : }
    6051             : 
    6052             : /******************************************************************/
    6053             : /*                   Find all dihedral forms.                     */
    6054             : /******************************************************************/
    6055             : /* lim >= 2 */
    6056             : static void
    6057          14 : consttabdihedral(long lim)
    6058          14 : { cache_set(cache_DIH, mfdihedralall(mkvecsmall2(1,lim))); }
    6059             : 
    6060             : /* a ideal coprime to bnr modulus */
    6061             : static long
    6062       76356 : mfdiheval(GEN bnr, GEN w, GEN a)
    6063             : {
    6064       76356 :   GEN L, cycn = gel(w,1), chin = gel(w,2);
    6065       76356 :   long ordmax = cycn[1];
    6066       76356 :   L = ZV_to_Flv(isprincipalray(bnr,a), ordmax);
    6067       76356 :   return Flv_dotproduct(chin, L, ordmax);
    6068             : }
    6069             : 
    6070             : /* A(x^k) mod T */
    6071             : static GEN
    6072       32221 : Galois(GEN A, long k, GEN T)
    6073             : {
    6074       32221 :   if (typ(A) != t_POL) return A;
    6075       12061 :   return gmod(RgX_inflate(A, k), T);
    6076             : }
    6077             : static GEN
    6078         791 : vecGalois(GEN v, long k, GEN T)
    6079             : {
    6080             :   long i, l;
    6081         791 :   GEN w = cgetg_copy(v,&l);
    6082       33012 :   for (i = 1; i < l; i++) gel(w,i) = Galois(gel(v,i), k, T);
    6083         791 :   return w;
    6084             : }
    6085             : 
    6086             : static GEN
    6087      145733 : fix_pol(GEN S, GEN Pn, int *trace)
    6088             : {
    6089      145733 :   if (typ(S) != t_POL) return S;
    6090      102116 :   S = RgX_rem(S, Pn);
    6091      102116 :   if (typ(S) == t_POL)
    6092             :   {
    6093      102116 :     switch(lg(S))
    6094             :     {
    6095       34797 :       case 2: return gen_0;
    6096       16247 :       case 3: return gel(S,2);
    6097             :     }
    6098       51072 :     *trace = 1;
    6099             :   }
    6100       51072 :   return S;
    6101             : }
    6102             : 
    6103             : static GEN
    6104       10913 : dihan(GEN bnr, GEN w, GEN k0j, ulong lim)
    6105             : {
    6106       10913 :   GEN nf = bnr_get_nf(bnr), f = bid_get_ideal(bnr_get_bid(bnr));
    6107       10913 :   GEN v = zerovec(lim+1), cycn = gel(w,1), Tinit = gel(w,3);
    6108       10913 :   GEN Pn = gel(Tinit,lg(Tinit)==4? 2: 1);
    6109       10913 :   long j, ordmax = cycn[1], k0 = k0j[1], jdeg = k0j[2];
    6110       10913 :   long D = itos(nf_get_disc(nf)), vt = varn(Pn);
    6111       10913 :   int trace = 0;
    6112             :   ulong p, n;
    6113             :   forprime_t T;
    6114             : 
    6115       10913 :   if (!lim) return v;
    6116       10703 :   gel(v,2) = gen_1;
    6117       10703 :   u_forprime_init(&T, 2, lim);
    6118             :   /* fill in prime powers first */
    6119       80185 :   while ((p = u_forprime_next(&T)))
    6120             :   {
    6121             :     GEN vP, vchiP, S;
    6122             :     long k, lP;
    6123             :     ulong q, qk;
    6124       69482 :     if (kross(D,p) >= 0) q = p;
    6125       28196 :     else if (!(q = umuluu_le(p,p,lim))) continue;
    6126             :     /* q = Norm P */
    6127       46767 :     vP = idealprimedec(nf, utoipos(p));
    6128       46767 :     lP = lg(vP);
    6129       46767 :     vchiP = cgetg(lP, t_VECSMALL);
    6130      126994 :     for (j = k = 1; j < lP; j++)
    6131             :     {
    6132       80227 :       GEN P = gel(vP,j);
    6133       80227 :       if (!idealval(nf, f, P)) vchiP[k++] = mfdiheval(bnr,w,P);
    6134             :     }
    6135       46767 :     if (k == 1) continue;
    6136       45080 :     setlg(vchiP, k); lP = k;
    6137       45080 :     if (lP == 2)
    6138             :     { /* one prime above p not dividing f */
    6139       13804 :       long s, s0 = vchiP[1];
    6140       24157 :       for (qk=q, s = s0;; s = Fl_add(s,s0,ordmax))
    6141             :       {
    6142       24157 :         S = Qab_zeta(s, ordmax, vt);
    6143       24157 :         gel(v, qk+1) = fix_pol(S, Pn, &trace);
    6144       24157 :         if (!(qk = umuluu_le(qk,q,lim))) break;
    6145             :       }
    6146             :     }
    6147             :     else /* two primes above p not dividing f */
    6148             :     {
    6149       31276 :       long s, s0 = vchiP[1], s1 = vchiP[2];
    6150       31276 :       for (qk=q, k = 1;; k++)
    6151       13426 :       { /* sum over a,b s.t. Norm( P1^a P2^b ) = q^k, i.e. a+b = k */
    6152             :         long a;
    6153       44702 :         GEN S = gen_0;
    6154      154049 :         for (a = 0; a <= k; a++)
    6155             :         {
    6156      109347 :           s = Fl_add(Fl_mul(a, s0, ordmax), Fl_mul(k-a, s1, ordmax), ordmax);
    6157      109347 :           S = gadd(S, Qab_zeta(s, ordmax, vt));
    6158             :         }
    6159       44702 :         gel(v, qk+1) = fix_pol(S, Pn, &trace);
    6160       44702 :         if (!(qk = umuluu_le(qk,q,lim))) break;
    6161             :       }
    6162             :     }
    6163             :   }
    6164             :   /* complete with non-prime powers */
    6165      190232 :   for (n = 2; n <= lim; n++)
    6166             :   {
    6167      179529 :     GEN S, fa = myfactoru(n), P = gel(fa, 1), E = gel(fa, 2);
    6168             :     long q;
    6169      179529 :     if (lg(P) == 2) continue;
    6170             :     /* not a prime power */
    6171       76874 :     q = upowuu(P[1],E[1]);
    6172       76874 :     S = gmul(gel(v, q + 1), gel(v, n/q + 1));
    6173       76874 :     gel(v, n+1) = fix_pol(S, Pn, &trace);
    6174             :   }
    6175       10703 :   if (trace)
    6176             :   {
    6177        5558 :     v = QabV_tracerel(Tinit, jdeg, v);
    6178             :     /* Apply Galois Mod(k0, ordw) */
    6179        5558 :     if (k0 > 1) { GEN Pm = gel(Tinit,1); v = vecGalois(v, k0, Pm); }
    6180             :   }
    6181       10703 :   return v;
    6182             : }
    6183             : 
    6184             : /* as cyc_normalize for t_VECSMALL cyc */
    6185             : static GEN
    6186       26782 : cyc_normalize_zv(GEN cyc)
    6187             : {
    6188       26782 :   long i, o = cyc[1], l = lg(cyc); /* > 1 */
    6189       26782 :   GEN D = cgetg(l, t_VECSMALL);
    6190       31136 :   D[1] = o; for (i = 2; i < l; i++) D[i] = o / cyc[i];
    6191       26782 :   return D;
    6192             : }
    6193             : /* as char_normalize for t_VECSMALLs */
    6194             : static GEN
    6195      117950 : char_normalize_zv(GEN chi, GEN ncyc)
    6196             : {
    6197      117950 :   long i, l = lg(chi);
    6198      117950 :   GEN c = cgetg(l, t_VECSMALL);
    6199      117950 :   if (l > 1) {
    6200      117950 :     c[1] = chi[1];
    6201      159376 :     for (i = 2; i < l; i++) c[i] = chi[i] * ncyc[i];
    6202             :   }
    6203      117950 :   return c;
    6204             : }
    6205             : 
    6206             : static GEN
    6207        8946 : dihan_bnf(long D)
    6208        8946 : { setrand(gen_1); return Buchall(quadpoly(stoi(D)), 0, LOWDEFAULTPREC); }
    6209             : static GEN
    6210       37233 : dihan_bnr(GEN bnf, GEN A)
    6211       37233 : { setrand(gen_1); return Buchray(bnf, A, nf_INIT|nf_GEN); }
    6212             : 
    6213             : /* Hecke xi * (D/.) = Dirichlet chi, return v in Q^r st chi(g_i) = e(v[i]).
    6214             :  * cycn = cyc_normalize_zv(bnr.cyc), chin = char_normalize_zv(chi,cyc) */
    6215             : static GEN
    6216       34412 : bnrchartwist2conrey(GEN chin, GEN cycn, GEN bnrconreyN, GEN kroconreyN)
    6217             : {
    6218       34412 :   long l = lg(bnrconreyN), c1 = cycn[1], i;
    6219       34412 :   GEN v = cgetg(l, t_COL);
    6220      125132 :   for (i = 1; i < l; i++)
    6221             :   {
    6222       90720 :     GEN d = sstoQ(zv_dotproduct(chin, gel(bnrconreyN,i)), c1);
    6223       90720 :     if (kroconreyN[i] < 0) d = gadd(d, ghalf);
    6224       90720 :     gel(v,i) = d;
    6225             :   }
    6226       34412 :   return v;
    6227             : }
    6228             : 
    6229             : /* chi(g_i) = e(v[i]) denormalize wrt Conrey generators orders */
    6230             : static GEN
    6231       34412 : conreydenormalize(GEN znN, GEN v)
    6232             : {
    6233       34412 :   GEN gcyc = znstar_get_conreycyc(znN), w;
    6234       34412 :   long l = lg(v), i;
    6235       34412 :   w = cgetg(l, t_COL);
    6236      125132 :   for (i = 1; i < l; i++)
    6237       90720 :     gel(w,i) = modii(gmul(gel(v,i), gel(gcyc,i)), gel(gcyc,i));
    6238       34412 :   return w;
    6239             : }
    6240             : 
    6241             : static long
    6242       83538 : Miyake(GEN vchi, GEN gb, GEN cycn)
    6243             : {
    6244       83538 :   long i, e = cycn[1], lb = lg(gb);
    6245       83538 :   GEN v = char_normalize_zv(vchi, cycn);
    6246      124264 :   for (i = 1; i < lb; i++)
    6247       99666 :     if ((zv_dotproduct(v, gel(gb,i)) -  v[i]) % e) return 1;
    6248       24598 :   return 0;
    6249             : }
    6250             : 
    6251             : /* list of Hecke characters not induced by a Dirichlet character up to Galois
    6252             :  * conjugation, whose conductor is bnr.cond; cycn = cyc_normalize(bnr.cyc)*/
    6253             : static GEN
    6254       26782 : mklvchi(GEN bnr, GEN cycn, GEN gb)
    6255             : {
    6256       26782 :   GEN cyc = bnr_get_cyc(bnr), cycsmall = ZV_to_zv(cyc);
    6257       26782 :   GEN vchi = cyc2elts(cycsmall);
    6258       26782 :   long ordmax = cycsmall[1], c, i, l;
    6259       26782 :   l = lg(vchi);
    6260      303450 :   for (i = c = 1; i < l; i++)
    6261             :   {
    6262      276668 :     GEN chi = gel(vchi,i);
    6263      276668 :     if (!gb || Miyake(chi, gb, cycn)) gel(vchi, c++) = Flv_to_ZV(chi);
    6264             :   }
    6265       26782 :   setlg(vchi, c); l = c;
    6266      278852 :   for (i = 1; i < l; i++)
    6267             :   {
    6268      252070 :     GEN chi = gel(vchi,i);
    6269             :     long n;
    6270      252070 :     if (!chi) continue;
    6271     1054578 :     for (n = 2; n < ordmax; n++)
    6272      965496 :       if (ugcd(n, ordmax) == 1)
    6273             :       {
    6274      397194 :         GEN tmp = vecmodii(gmulsg(n, chi), cyc);
    6275             :         long j;
    6276     7616616 :         for (j = i+1; j < l; j++)
    6277     7219422 :           if (gel(vchi,j) && gequal(gel(vchi,j), tmp)) gel(vchi,j) = NULL;
    6278             :       }
    6279             :   }
    6280      278852 :   for (i = c = 1; i < l; i++)
    6281             :   {
    6282      252070 :     GEN chi = gel(vchi,i);
    6283      252070 :     if (chi && bnrisconductor(bnr, chi)) gel(vchi, c++) = chi;
    6284             :   }
    6285       26782 :   setlg(vchi, c); return vchi;
    6286             : }
    6287             : 
    6288             : static GEN
    6289        7784 : get_gb(GEN bnr, GEN con)
    6290             : {
    6291        7784 :   GEN gb, g = bnr_get_gen(bnr), nf = bnr_get_nf(bnr);
    6292        7784 :   long i, l = lg(g);
    6293        7784 :   gb = cgetg(l, t_VEC);
    6294       18270 :   for (i = 1; i < l; i++)
    6295       10486 :     gel(gb,i) = ZV_to_zv(isprincipalray(bnr, galoisapply(nf, con, gel(g,i))));
    6296        7784 :   return gb;
    6297             : }
    6298             : static GEN
    6299       15834 : get_bnrconreyN(GEN bnr, GEN znN)
    6300             : {
    6301       15834 :   GEN z, g = znstar_get_conreygen(znN);
    6302       15834 :   long i, l = lg(g);
    6303       15834 :   z = cgetg(l, t_VEC);
    6304       57050 :   for (i = 1; i < l; i++) gel(z,i) = ZV_to_zv(isprincipalray(bnr,gel(g,i)));
    6305       15834 :   return z;
    6306             : }
    6307             : /* con = NULL if D > 0 or if D < 0 and id != idcon. */
    6308             : static GEN
    6309       33670 : mfdihedralcommon(GEN bnf, GEN id, GEN znN, GEN kroconreyN, long N, long D, GEN con)
    6310             : {
    6311       33670 :   GEN bnr = dihan_bnr(bnf, id), cyc = ZV_to_zv( bnr_get_cyc(bnr) );
    6312             :   GEN bnrconreyN, cycn, cycN, Lvchi, res, P, vT;
    6313             :   long j, ordmax, l, lc, deghecke, degrel, vt;
    6314             : 
    6315       33670 :   lc = lg(cyc); if (lc == 1) return NULL;
    6316       26782 :   cycn = cyc_normalize_zv(cyc);
    6317       26782 :   Lvchi = mklvchi(bnr, cycn, con? get_gb(bnr, con): NULL);
    6318       26782 :   l = lg(Lvchi);
    6319       26782 :   if (l == 1) return NULL;
    6320             : 
    6321       15834 :   bnrconreyN = get_bnrconreyN(bnr, znN);
    6322       15834 :   cycN = ZV_to_zv(znstar_get_cyc(znN));
    6323       15834 :   ordmax = cyc[1];
    6324       15834 :   vT = const_vec(odd(ordmax)? ordmax << 1: ordmax, NULL);
    6325       15834 :   vt = fetch_user_var("t");
    6326       15834 :   P = polcyclo(ordmax, vt);
    6327       15834 :   gel(vT,ordmax) = Qab_trace_init(ordmax, ordmax, P, P);
    6328       15834 :   deghecke = myeulerphiu(ordmax);
    6329       15834 :   res = cgetg(l, t_VEC);
    6330       50246 :   for (j = 1; j < l; j++)
    6331             :   {
    6332       34412 :     GEN T, v, vchi = ZV_to_zv(gel(Lvchi,j));
    6333       34412 :     GEN chi, chin = char_normalize_zv(vchi, cycn);
    6334             :     long o, vnum, k0;
    6335       34412 :     v = bnrchartwist2conrey(chin, cycn, bnrconreyN, kroconreyN);
    6336       34412 :     o = itou(Q_denom(v));
    6337       34412 :     T = gel(vT, o);
    6338       34412 :     if (!T) gel(vT,o) = T = Qab_trace_init(ordmax, o, P, polcyclo(o,vt));
    6339       34412 :     chi = conreydenormalize(znN, v);
    6340       34412 :     vnum = itou(znconreyexp(znN, chi));
    6341       34412 :     chi = ZV_to_zv(znconreychar(znN,chi));
    6342       34412 :     degrel = deghecke / degpol(gel(T,1));
    6343       34412 :     k0 = zv_cyc_minimize(cycN, chi, coprimes_zv(o));
    6344       34412 :     vnum = Fl_powu(vnum, k0, N);
    6345             :     /* encodes degrel forms: jdeg = 0..degrel-1 */
    6346       34412 :     gel(res,j) = mkvec3(mkvecsmalln(5, N, k0, vnum, D, degrel),
    6347             :                         id, mkvec3(cycn,chin,T));
    6348             :   }
    6349       15834 :   return res;
    6350             : }
    6351             : 
    6352             : static long
    6353       49322 : not_cond(long D, long n)
    6354             : {
    6355       49322 :   if (D > 0) return n == 4 && (D&7L) != 1;
    6356       30086 :   return n == 2 || n == 3 || (n == 4 && (D&7L)==1);
    6357             : }
    6358             : /* Append to v all dihedral weight 1 forms coming from D, if fundamental.
    6359             :  * level in [l1, l2] */
    6360             : static void
    6361       18578 : append_dihedral(GEN v, long D, long l1, long l2)
    6362             : {
    6363       18578 :   long Da = labs(D), no, i, numi, ct, min, max;
    6364             :   GEN bnf, con, LI, resall, arch1, arch2;
    6365             :   pari_sp av;
    6366             : 
    6367             :   /* min <= Nf <= max */
    6368       18578 :   max = l2 / Da;
    6369       18578 :   if (l1 == l2)
    6370             :   { /* assume Da | l2 */
    6371           0 :     min = max;
    6372           0 :     if (D > 0 && min < 3) return;
    6373             :   }
    6374             :   else /* assume l1 < l2 */
    6375       18578 :     min = (l1 + Da-1)/Da;
    6376       18578 :   if (!sisfundamental(D)) return;
    6377             : 
    6378        5684 :   av = avma;
    6379        5684 :   bnf = dihan_bnf(D);
    6380        5684 :   con = nf2_get_conj(bnf_get_nf(bnf));
    6381        5684 :   LI = ideallist(bnf, max);
    6382       55006 :   numi = 0; for (i = min; i <= max; i++) numi += lg(gel(LI, i)) - 1;
    6383        5684 :   if (D > 0)
    6384             :   {
    6385        1414 :     numi <<= 1;
    6386        1414 :     arch1 = mkvec2(gen_1,gen_0);
    6387        1414 :     arch2 = mkvec2(gen_0,gen_1);
    6388             :   }
    6389             :   else
    6390        4270 :     arch1 = arch2 = NULL;
    6391        5684 :   resall = cgetg(numi+1, t_VEC); ct = 1;
    6392       55006 :   for (no = min; no <= max; no++) if (!not_cond(D, no))
    6393             :   {
    6394       44604 :     long N = Da*no, lgc, lglis;
    6395       44604 :     GEN LIs = gel(LI, no), znN = znstar0(utoipos(N), 1), conreyN, kroconreyN;
    6396             : 
    6397       44604 :     conreyN = znstar_get_conreygen(znN); lgc = lg(conreyN);
    6398       44604 :     kroconreyN = cgetg(lgc, t_VECSMALL);
    6399      165928 :     for (i = 1; i < lgc; i++) kroconreyN[i] = krosi(D, gel(conreyN, i));
    6400       44604 :     lglis = lg(LIs);
    6401       87752 :     for (i = 1; i < lglis; i++)
    6402             :     {
    6403       43148 :       GEN id = gel(LIs, i), idcon, z;
    6404             :       long j;
    6405       43148 :       if (typ(id) == t_INT) continue;
    6406       28154 :       idcon = galoisapply(bnf, con, id);
    6407       51380 :       for (j = i; j < lglis; j++)
    6408       51380 :         if (gequal(idcon, gel(LIs, j))) { gel(LIs, j) = gen_0; break; }
    6409       28154 :       if (D < 0)
    6410             :       {
    6411       17458 :         GEN conk = i == j ? con : NULL;
    6412       17458 :         z = mfdihedralcommon(bnf, id, znN, kroconreyN, N, D, conk);
    6413       17458 :         if (z) gel(resall, ct++) = z;
    6414             :       }
    6415             :       else
    6416             :       {
    6417             :         GEN ide;
    6418       10696 :         ide = mkvec2(id, arch1);
    6419       10696 :         z = mfdihedralcommon(bnf, ide, znN, kroconreyN, N, D, NULL);
    6420       10696 :         if (z) gel(resall, ct++) = z;
    6421       10696 :         if (gequal(idcon,id)) continue;
    6422        5516 :         ide = mkvec2(id, arch2);
    6423        5516 :         z = mfdihedralcommon(bnf, ide, znN, kroconreyN, N, D, NULL);
    6424        5516 :         if (z) gel(resall, ct++) = z;
    6425             :       }
    6426             :     }
    6427             :   }
    6428        5684 :   if (ct == 1) set_avma(av);
    6429             :   else
    6430             :   {
    6431        4788 :     setlg(resall, ct);
    6432        4788 :     vectrunc_append(v, gerepilecopy(av, shallowconcat1(resall)));
    6433             :   }
    6434             : }
    6435             : 
    6436             : static long
    6437       42042 : di_N(GEN a) { return gel(a,1)[1]; }
    6438             : /* All primitive dihedral wt1 forms: LIM a t_VECSMALL with a single component
    6439             :  * (only level LIM) or 2 components [m,M], m < M (between m and M) */
    6440             : static GEN
    6441          14 : mfdihedralall(GEN LIM)
    6442             : {
    6443             :   GEN res, z;
    6444             :   long limD, ct, i, l1, l2;
    6445             : 
    6446          14 :   if (lg(LIM) == 2) l1 = l2 = LIM[1]; else { l1 = LIM[1]; l2 = LIM[2]; }
    6447          14 :   limD = l2;
    6448          14 :   res = vectrunc_init(2*limD);
    6449          14 :   if (l1 == l2)
    6450             :   {
    6451           0 :     GEN D = mydivisorsu(l1);
    6452           0 :     long l = lg(D), j;
    6453           0 :     for (j = 2; j < l; j++)
    6454             :     { /* skip d = 1 */
    6455           0 :       long d = D[j];
    6456           0 :       if (d == 2) continue;
    6457           0 :       append_dihedral(res, -d, l1,l2);
    6458           0 :       if (d >= 5 && D[l-j] >= 3) append_dihedral(res, d, l1,l2); /* Nf >= 3 */
    6459             :     }
    6460             :   }
    6461             :   else
    6462             :   {
    6463             :     long D;
    6464       13986 :     for (D = -3; D >= -limD; D--) append_dihedral(res, D, l1,l2);
    6465          14 :     limD /= 3; /* Nf >= 3 (GTM 193, prop 3.3.18) */
    6466        4620 :     for (D = 5; D <= limD;   D++) append_dihedral(res, D, l1,l2);
    6467             :   }
    6468          14 :   ct = lg(res);
    6469          14 :   if (ct > 1) res = shallowconcat1(res);
    6470          14 :   if (l1 == l2) return res; /* single level */
    6471          14 :   if (ct > 1)
    6472             :   { /* sort wrt N */
    6473          14 :     res = vecpermute(res, indexvecsort(res, mkvecsmall(1)));
    6474          14 :     ct = lg(res);
    6475             :   }
    6476          14 :   z = const_vec(l2-l1+1, cgetg(1,t_VEC));
    6477        7658 :   for (i = 1; i < ct;)
    6478             :   { /* regroup result sharing the same N */
    6479        7644 :     long n = di_N(gel(res,i)), j = i+1, k;
    6480             :     GEN v;
    6481       34412 :     while (j < ct && di_N(gel(res,j)) == n) j++;
    6482        7644 :     n -= l1-1;
    6483        7644 :     gel(z, n) = v = cgetg(j-i+1, t_VEC);
    6484       42056 :     for (k = 1; i < j; k++,i++) gel(v,k) = gel(res,i);
    6485             :   }
    6486          14 :   return z;
    6487             : }
    6488             : 
    6489             : /* return [vF, index], where vecpermute(vF,index) generates dihedral forms
    6490             :  * for character CHI */
    6491             : static GEN
    6492       23779 : mfdihedralnew_i(long N, GEN CHI)
    6493             : {
    6494             :   GEN bnf, Tinit, Pm, vf, M, V, NK, SP;
    6495             :   long Dold, d, ordw, i, SB, c, l, k0, k1, chino, chinoorig, lv;
    6496             : 
    6497       23779 :   SP = cache_get(cache_DIH, N);
    6498       23779 :   if (!SP) SP = mfdihedralall(mkvecsmall(N));
    6499       23779 :   lv = lg(SP); if (lv == 1) return NULL;
    6500       11354 :   CHI = mfcharinduce(CHI,N);
    6501       11354 :   ordw = mfcharorder(CHI);
    6502       11354 :   chinoorig = mfcharno(CHI);
    6503       11354 :   k0 = mfconreyminimize(CHI);
    6504       11354 :   chino = Fl_powu(chinoorig, k0, N);
    6505       11354 :   k1 = Fl_inv(k0 % ordw, ordw);
    6506       11354 :   V = cgetg(lv, t_VEC);
    6507       11354 :   d = 0;
    6508       35245 :   for (i = l = 1; i < lv; i++)
    6509             :   {
    6510       23891 :     GEN sp = gel(SP,i), T = gel(sp,1);
    6511       23891 :     if (T[3] != chino) continue;
    6512        3563 :     d += T[5];
    6513        3563 :     if (k1 != 1)
    6514             :     {
    6515          77 :       GEN t = leafcopy(T);
    6516          77 :       t[3] = chinoorig;
    6517          77 :       t[2] = (t[2]*k1) % ordw;
    6518          77 :       sp = mkvec4(t, gel(sp,2), gel(sp,3), gel(sp,4));
    6519             :     }
    6520        3563 :     gel(V, l++) = sp;
    6521             :   }
    6522       11354 :   setlg(V, l); /* dihedral forms of level N and character CHI */
    6523       11354 :   if (l == 1) return NULL;
    6524             : 
    6525        2338 :   SB = myeulerphiu(ordw) * mfsturmNk(N,1) + 1;
    6526        2338 :   M = cgetg(d+1, t_MAT);
    6527        2338 :   vf = cgetg(d+1, t_VEC);
    6528        2338 :   NK = mkNK(N, 1, CHI);
    6529        2338 :   bnf = NULL; Dold = 0;
    6530        5901 :   for (i = c = 1; i < l; i++)
    6531             :   { /* T = [N, k0, conreyno, D, degrel] */
    6532        3563 :     GEN bnr, Vi = gel(V,i), T = gel(Vi,1), id = gel(Vi,2), w = gel(Vi,3);
    6533        3563 :     long jdeg, k0i = T[2], D = T[4], degrel = T[5];
    6534             : 
    6535        3563 :     if (D != Dold) { Dold = D; bnf = dihan_bnf(D); }
    6536        3563 :     bnr = dihan_bnr(bnf, id);
    6537       10479 :     for (jdeg = 0; jdeg < degrel; jdeg++,c++)
    6538             :     {
    6539        6916 :       GEN k0j = mkvecsmall2(k0i, jdeg), an = dihan(bnr, w, k0j, SB);
    6540        6916 :       settyp(an, t_COL); gel(M,c) = Q_primpart(an);
    6541        6916 :       gel(vf,c) = tag3(t_MF_DIHEDRAL, NK, bnr, w, k0j);
    6542             :     }
    6543             :   }
    6544        2338 :   Tinit = gmael3(V,1,3,3); Pm = gel(Tinit,1);
    6545        2338 :   V = QabM_indexrank(M, degpol(Pm)==1? NULL: Pm, ordw);
    6546        2338 :   return mkvec2(vf,gel(V,2));
    6547             : }
    6548             : static long
    6549       15820 : mfdihedralnewdim(long N, GEN CHI)
    6550             : {
    6551       15820 :   pari_sp av = avma;
    6552       15820 :   GEN S = mfdihedralnew_i(N, CHI);
    6553       15820 :   return gc_long(av, S? lg(gel(S,2))-1: 0);
    6554             : }
    6555             : static GEN
    6556        7959 : mfdihedralnew(long N, GEN CHI)
    6557             : {
    6558        7959 :   pari_sp av = avma;
    6559        7959 :   GEN S = mfdihedralnew_i(N, CHI);
    6560        7959 :   if (!S) { set_avma(av); return cgetg(1, t_VEC); }
    6561         777 :   return vecpermute(gel(S,1), gel(S,2));
    6562             : }
    6563             : 
    6564             : static long
    6565        7042 : mfdihedralcuspdim(long N, GEN CHI)
    6566             : {
    6567        7042 :   pari_sp av = avma;
    6568             :   GEN D, CHIP;
    6569             :   long F, i, lD, dim;
    6570             : 
    6571        7042 :   CHIP = mfchartoprimitive(CHI, &F);
    6572        7042 :   D = mydivisorsu(N/F); lD = lg(D);
    6573        7042 :   dim = mfdihedralnewdim(N, CHI); /* d = 1 */
    6574       15820 :   for (i = 2; i < lD; i++)
    6575             :   {
    6576        8778 :     long d = D[i], a = mfdihedralnewdim(N / d, CHIP);
    6577        8778 :     if (a) dim += a * mynumdivu(d);
    6578             :   }
    6579        7042 :   return gc_long(av,dim);
    6580             : }
    6581             : 
    6582             : static GEN
    6583        5901 : mfbdall(GEN E, long N)
    6584             : {
    6585        5901 :   GEN v, D = mydivisorsu(N);
    6586        5901 :   long i, j, nD = lg(D) - 1, nE = lg(E) - 1;
    6587        5901 :   v = cgetg(nD*nE + 1, t_VEC);
    6588        7812 :   for (j = 1; j <= nE; j++)
    6589             :   {
    6590        1911 :     GEN Ej = gel(E, j);
    6591        6125 :     for (i = 0; i < nD; i++) gel(v, i*nE + j) = mfbd_i(Ej, D[i+1]);
    6592             :   }
    6593        5901 :   return v;
    6594             : }
    6595             : static GEN
    6596        3458 : mfdihedralcusp(long N, GEN CHI)
    6597             : {
    6598        3458 :   pari_sp av = avma;
    6599             :   GEN D, CHIP, z;
    6600             :   long F, i, lD;
    6601             : 
    6602        3458 :   CHIP = mfchartoprimitive(CHI, &F);
    6603        3458 :   D = mydivisorsu(N/F); lD = lg(D);
    6604        3458 :   z = cgetg(lD, t_VEC);
    6605        3458 :   gel(z,1) = mfdihedralnew(N, CHI);
    6606        7749 :   for (i = 2; i < lD; i++) /* skip 1 */
    6607             :   {
    6608        4291 :     GEN LF = mfdihedralnew(N / D[i], CHIP);
    6609        4291 :     gel(z,i) = mfbdall(LF, D[i]);
    6610             :   }
    6611        3458 :   return gerepilecopy(av, shallowconcat1(z));
    6612             : }
    6613             : 
    6614             : /* used to decide between ratlift and comatrix for ZM_inv; ratlift is better
    6615             :  * when N has many divisors */
    6616             : static int
    6617        2450 : abundant(ulong N) { return mynumdivu(N) >= 8; }
    6618             : 
    6619             : /* CHI an mfchar */
    6620             : static int
    6621         294 : cmp_ord(void *E, GEN a, GEN b)
    6622             : {
    6623         294 :   GEN chia = MF_get_CHI(a), chib = MF_get_CHI(b);
    6624         294 :   (void)E; return cmpii(gmfcharorder(chia), gmfcharorder(chib));
    6625             : }
    6626             : /* mfinit structure.
    6627             : -- mf[1] contains [N,k,CHI,space],
    6628             : -- mf[2] contains vector of closures of Eisenstein series, empty if not
    6629             :    full space.
    6630             : -- mf[3] contains vector of closures, so #mf[3] = dimension of cusp/new space.
    6631             : -- mf[4] contains the corresponding indices: either j for T(j)tf if newspace,
    6632             :    or [M,j,d] for B(d)T(j)tf_M if cuspspace or oldspace.
    6633             : -- mf[5] contains the matrix M of first coefficients of basis, never cleaned.
    6634             :  * NK is either [N,k] or [N,k,CHI].
    6635             :  * mfinit does not do the splitting, only the basis generation. */
    6636             : 
    6637             : /* Set flraw to 1 if do not need mf[5]: no mftobasis etc..., only the
    6638             :    expansions of the basis elements are needed. */
    6639             : 
    6640             : static GEN
    6641        4795 : mfinit_Nkchi(long N, long k, GEN CHI, long space, long flraw)
    6642             : {
    6643        4795 :   GEN M = NULL, mf = NULL, mf1 = mkvec4(utoi(N), stoi(k), CHI, utoi(space));
    6644        4795 :   long sb = mfsturmNk(N, k);
    6645             :   cachenew_t cache;
    6646        4795 :   if (k < 0 || badchar(N, k, CHI)) return mfEMPTY(mf1);
    6647        4760 :   if (k == 0) /*nothing*/;
    6648        4718 :   else if (k == 1)
    6649             :   {
    6650         364 :     switch (space)
    6651             :     {
    6652         336 :       case mf_NEW:
    6653             :       case mf_FULL:
    6654         336 :       case mf_CUSP: mf = mfwt1init(N, CHI, NULL, space, flraw); break;
    6655          14 :       case mf_EISEN:break;
    6656           7 :       case mf_OLD: pari_err_IMPL("mfinit in weight 1 for old space");
    6657           7 :       default: pari_err_FLAG("mfinit");
    6658             :     }
    6659             :   }
    6660             :   else /* k >= 2 */
    6661             :   {
    6662        4354 :     long ord = mfcharorder(CHI);
    6663        4354 :     GEN z = NULL, P = (ord <= 2)? NULL: mfcharpol(CHI);
    6664        4354 :     switch(space)
    6665             :     {
    6666         105 :       case mf_EISEN:
    6667         105 :         break;
    6668        1197 :       case mf_NEW:
    6669        1197 :         mf = mfnewinit(N, k, CHI, &cache, 1);
    6670        1197 :         if (mf && !flraw) { M = MF_get_M(mf); z = MF_get_Mindex(mf); }
    6671        1197 :         break;
    6672        3045 :       case mf_OLD:
    6673             :       case mf_CUSP:
    6674             :       case mf_FULL:
    6675        3045 :         mf = mfinitcusp(N, k, CHI, &cache, space);
    6676        3045 :         if (mf && !flraw)
    6677             :         {
    6678        2163 :           GEN S = MF_get_S(mf);
    6679        2163 :           M = bhnmat_extend(M, sb+1, 1, S, &cache);
    6680        2163 :           if (space != mf_FULL) gel(mf,5) = mfcleanCHI(M, CHI, abundant(N));
    6681             :         }
    6682        3045 :         dbg_cachenew(&cache);
    6683        3045 :         break;
    6684           7 :       default: pari_err_FLAG("mfinit");
    6685             :     }
    6686        4347 :     if (z) gel(mf,5) = mfclean2(M, z, P, ord);
    6687             :   }
    6688        4739 :   if (!mf) mf = mfEMPTY(mf1);
    6689             :   else
    6690             :   {
    6691        3829 :     gel(mf,1) = mf1;
    6692        3829 :     if (flraw) gel(mf,5) = zerovec(3);
    6693             :   }
    6694        4739 :   if (!space_is_cusp(space))
    6695             :   {
    6696         742 :     GEN E = mfeisensteinbasis(N, k, CHI);
    6697         742 :     gel(mf,2) = E;
    6698         742 :     if (!flraw)
    6699             :     {
    6700         476 :       if (M)
    6701         189 :         M = shallowconcat(mfvectomat(E, sb+1, 1), M);
    6702             :       else
    6703         287 :         M = mfcoefs_mf(mf, sb+1, 1);
    6704         476 :       gel(mf,5) = mfcleanCHI(M, CHI, abundant(N));
    6705             :     }
    6706             :   }
    6707        4739 :   return mf;
    6708             : }
    6709             : 
    6710             : /* mfinit for k = nk/dk */
    6711             : static GEN
    6712        2590 : mfinit_Nndkchi(long N, long nk, long dk, GEN CHI, long space, long flraw)
    6713         238 : { return (dk == 2)? mf2init_Nkchi(N, nk >> 1, CHI, space, flraw)
    6714        2828 :                   : mfinit_Nkchi(N, nk, CHI, space, flraw); }
    6715             : static GEN
    6716        3248 : mfinit_i(GEN NK, long space)
    6717             : {
    6718             :   GEN CHI, mf;
    6719             :   long N, k, dk, joker;
    6720        3248 :   if (checkmf_i(NK))
    6721             :   {
    6722         140 :     N = mf_get_N(NK);
    6723         140 :     Qtoss(mf_get_gk(NK), &k, &dk);
    6724         140 :     CHI = mf_get_CHI(NK);
    6725             :   }
    6726        3108 :   else if ((mf = checkMF_i(NK)))
    6727             :   {
    6728          21 :     long s = MF_get_space(mf);
    6729          21 :     if (s == space) return mf;
    6730          21 :     Qtoss(MF_get_gk(mf), &k, &dk);
    6731          21 :     if (dk == 1 && k > 1 && space == mf_NEW && (s == mf_CUSP || s == mf_FULL))
    6732          21 :       return mfinittonew(mf);
    6733           0 :     N = MF_get_N(mf);
    6734           0 :     CHI = MF_get_CHI(mf);
    6735             :   }
    6736             :   else
    6737        3087 :     checkNK2(NK, &N, &k, &dk, &CHI, 1);
    6738        3206 :   joker = !CHI || typ(CHI) == t_COL;
    6739        3206 :   if (joker)
    6740             :   {
    6741        1141 :     GEN mf, vCHI = CHI;
    6742             :     long i, j, l;
    6743        1141 :     if (CHI && lg(CHI) == 1) return cgetg(1,t_VEC);
    6744        1134 :     if (k < 0) return mfEMPTYall(N, sstoQ(k,dk), CHI, space);
    6745        1120 :     if (k == 1 && dk == 1 && space != mf_EISEN)
    6746         483 :     {
    6747             :       GEN TMP, gN, gs;
    6748        1085 :       if (space != mf_CUSP && space != mf_NEW)
    6749           0 :         pari_err_IMPL("mfinit([N,1,wildcard], space != cusp or new space)");
    6750        1085 :       if (wt1empty(N)) return mfEMPTYall(N, gen_1, CHI, space);
    6751         483 :       vCHI = mfwt1chars(N,vCHI);
    6752         483 :       l = lg(vCHI); mf = cgetg(l, t_VEC); if (l == 1) return mf;
    6753         483 :       TMP = mfwt1_pre(N); gN = utoipos(N); gs = utoi(space);
    6754        3717 :       for (i = j = 1; i < l; i++)
    6755             :       {
    6756        3234 :         pari_sp av = avma;
    6757        3234 :         GEN c = gel(vCHI,i), z = mfwt1init(N, c, TMP, space, 0);
    6758        3234 :         if (!z) {
    6759        2590 :           set_avma(av);
    6760        2590 :           if (CHI) z = mfEMPTY(mkvec4(gN,gen_1,c,gs));
    6761             :         }
    6762        3234 :         if (z) gel(mf, j++) = z;
    6763             :       }
    6764             :     }
    6765             :     else
    6766             :     {
    6767          35 :       vCHI = mfchars(N,k,dk,vCHI);
    6768          35 :       l = lg(vCHI); mf = cgetg(l, t_VEC);
    6769         119 :       for (i = j = 1; i < l; i++)
    6770             :       {
    6771          84 :         pari_sp av = avma;
    6772          84 :         GEN v = mfinit_Nndkchi(N, k, dk, gel(vCHI,i), space, 0);
    6773          84 :         if (MF_get_dim(v) || CHI) gel(mf, j++) = v; else set_avma(av);
    6774             :       }
    6775             :     }
    6776         518 :     setlg(mf,j);
    6777         518 :     if (!CHI) gen_sort_inplace(mf, NULL, &cmp_ord, NULL);
    6778         518 :     return mf;
    6779             :   }
    6780        2065 :   return mfinit_Nndkchi(N, k, dk, CHI, space, 0);
    6781             : }
    6782             : GEN
    6783        2289 : mfinit(GEN NK, long space)
    6784             : {
    6785        2289 :   pari_sp av = avma;
    6786        2289 :   return gerepilecopy(av, mfinit_i(NK, space));
    6787             : }
    6788             : 
    6789             : /* UTILITY FUNCTIONS */
    6790             : static void
    6791         364 : cusp_canon(GEN cusp, long N, long *pA, long *pC)
    6792             : {
    6793         364 :   pari_sp av = avma;
    6794             :   long A, C, tc, cg;
    6795         364 :   if (N <= 0) pari_err_DOMAIN("mfcuspwidth","N","<=",gen_0,stoi(N));
    6796         357 :   if (!cusp || (tc = typ(cusp)) == t_INFINITY) { *pA = 1; *pC = N; return; }
    6797         350 :   if (tc != t_INT && tc != t_FRAC) pari_err_TYPE("checkcusp", cusp);
    6798         350 :   Qtoss(cusp, &A,&C);
    6799         350 :   if (N % C)
    6800             :   {
    6801             :     ulong uC;
    6802          14 :     long u = Fl_invgen((C-1)%N + 1, N, &uC);
    6803          14 :     A = Fl_mul(A, u, N);
    6804          14 :     C = (long)uC;
    6805             :   }
    6806         350 :   cg = ugcd(C, N/C);
    6807         420 :   while (ugcd(A, N) > 1) A += cg;
    6808         350 :   *pA = A % N; *pC = C; set_avma(av);
    6809             : }
    6810             : static long
    6811         903 : mfcuspcanon_width(long N, long C)
    6812         903 : { return (!C || C == N)? 1 : N / ugcd(N, Fl_sqr(umodsu(C,N),N)); }
    6813             : /* v = [a,c] a ZC, width of cusp (a:c) */
    6814             : static long
    6815        8750 : mfZC_width(long N, GEN v)
    6816             : {
    6817        8750 :   ulong C = umodiu(gel(v,2), N);
    6818        8750 :   return (C == 0)? 1: N / ugcd(N, Fl_sqr(C,N));
    6819             : }
    6820             : long
    6821         161 : mfcuspwidth(GEN gN, GEN cusp)
    6822             : {
    6823         161 :   long N = 0, A, C;
    6824             :   GEN mf;
    6825         161 :   if (typ(gN) == t_INT) N = itos(gN);
    6826          42 :   else if ((mf = checkMF_i(gN))) N = MF_get_N(mf);
    6827           0 :   else pari_err_TYPE("mfcuspwidth", gN);
    6828         161 :   cusp_canon(cusp, N, &A, &C);
    6829         154 :   return mfcuspcanon_width(N, C);
    6830             : }
    6831             : 
    6832             : /* Q a t_INT */
    6833             : static GEN
    6834          14 : findq(GEN al, GEN Q)
    6835             : {
    6836             :   long n;
    6837          14 :   if (typ(al) == t_FRAC && cmpii(gel(al,2), Q) <= 0)
    6838           0 :     return mkvec(mkvec2(gel(al,1), gel(al,2)));
    6839          14 :   n = 1 + (long)ceil(2.0781*gtodouble(glog(Q, LOWDEFAULTPREC)));
    6840          14 :   return contfracpnqn(gboundcf(al,n), n);
    6841             : }
    6842             : static GEN
    6843          91 : findqga(long N, GEN z)
    6844             : {
    6845          91 :   GEN Q, LDC, CK = NULL, DK = NULL, ma, x, y = imag_i(z);
    6846             :   long j, l;
    6847          91 :   if (gcmpgs(gmulsg(2*N, y), 1) >= 0) return NULL;
    6848          14 :   x = real_i(z);
    6849          14 :   Q = ground(ginv(gsqrt(gmulsg(N, y), LOWDEFAULTPREC)));
    6850          14 :   LDC = findq(gmulsg(-N,x), Q);
    6851          14 :   ma = gen_1; l = lg(LDC);
    6852          35 :   for (j = 1; j < l; j++)
    6853             :   {
    6854          21 :     GEN D, DC = gel(LDC,j), C1 = gel(DC,2);
    6855          21 :     if (cmpii(C1,Q) > 0) break;
    6856          21 :     D = gel(DC,1);
    6857          21 :     if (ugcdiu(D,N) == 1)
    6858             :     {
    6859           7 :       GEN C = mului(N, C1), den;
    6860           7 :       den = gadd(gsqr(gmul(C,y)), gsqr(gadd(D, gmul(C,x))));
    6861           7 :       if (gcmp(den, ma) < 0) { ma = den; CK = C; DK = D; }
    6862             :     }
    6863             :   }
    6864          14 :   return DK? mkvec2(CK, DK): NULL;
    6865             : }
    6866             : 
    6867             : static long
    6868         154 : valNC2(GEN P, GEN E, long e)
    6869             : {
    6870         154 :   long i, d = 1, l = lg(P);
    6871         476 :   for (i = 1; i < l; i++)
    6872             :   {
    6873         322 :     long v = u_lval(e, P[i]) << 1;
    6874         322 :     if (v == E[i] + 1) v--;
    6875         322 :     d *= upowuu(P[i], v);
    6876             :   }
    6877         154 :   return d;
    6878             : }
    6879             : 
    6880             : static GEN
    6881          42 : findqganew(long N, GEN z)
    6882             : {
    6883          42 :   GEN MI, DI, x = real_i(z), y = imag_i(z), Ck = gen_0, Dk = gen_1, fa, P, E;
    6884             :   long i;
    6885          42 :   MI = ginv(utoi(N));
    6886          42 :   DI = mydivisorsu(mysqrtu(N));
    6887          42 :   fa = myfactoru(N); P = gel(fa,1); E = gel(fa,2);
    6888         196 :   for (i = 1; i < lg(DI); i++)
    6889             :   {
    6890         154 :     long e = DI[i], g;
    6891             :     GEN U, C, D, m;
    6892         154 :     (void)cxredsl2(gmulsg(e, z), &U);
    6893         154 :     C = gcoeff(U,2,1); if (!signe(C)) continue;
    6894         154 :     D = gcoeff(U,2,2);
    6895         154 :     g = ugcdiu(D,e);
    6896         154 :     if (g > 1) { C = muliu(C,e/g); D = diviuexact(D,g); } else C = muliu(C,e);
    6897         154 :     m = gadd(gsqr(gadd(gmul(C, x), D)), gsqr(gmul(C, y)));
    6898         154 :     m = gdivgs(m, valNC2(P, E, e));
    6899         154 :     if (gcmp(m, MI) < 0) { MI = m; Ck = C; Dk = D; }
    6900             :   }
    6901          42 :   return signe(Ck)? mkvec2(Ck, Dk): NULL;
    6902             : }
    6903             : 
    6904             : /* Return z' and U = [a,b;c,d] \in SL_2(Z), z' = U*z,
    6905             :  * Im(z')/width(U.oo) > sqrt(3)/(2N). Set *pczd = c*z+d */
    6906             : static GEN
    6907         168 : cxredga0N(long N, GEN z, GEN *pU, GEN *pczd, long flag)
    6908             : {
    6909         168 :   GEN v = NULL, A, B, C, D;
    6910             :   long e;
    6911         168 :   if (N == 1) return cxredsl2_i(z, pU, pczd);
    6912         133 :   e = gexpo(gel(z,2));
    6913         133 :   if (e < 0) z = gprec_wensure(z, precision(z) + nbits2extraprec(-e));
    6914         133 :   v = flag? findqganew(N,z): findqga(N,z);
    6915         133 :   if (!v) { *pU = matid(2); *pczd = gen_1; return z; }
    6916          49 :   C = gel(v,1);
    6917          49 :   D = gel(v,2);
    6918          49 :   if (!is_pm1(bezout(C,D, &B,&A))) pari_err_BUG("cxredga0N [gcd > 1]");
    6919          49 :   B = negi(B);
    6920          49 :   *pU = mkmat2(mkcol2(A,C), mkcol2(B,D));
    6921          49 :   *pczd = gadd(gmul(C,z), D);
    6922          49 :   return gdiv(gadd(gmul(A,z), B), *pczd);
    6923             : }
    6924             : 
    6925             : static GEN
    6926         154 : lfunthetaall(GEN b, GEN vL, GEN t, long bitprec)
    6927             : {
    6928         154 :   long i, l = lg(vL);
    6929         154 :   GEN v = cgetg(l, t_VEC);
    6930         336 :   for (i = 1; i < l; i++)
    6931             :   {
    6932         182 :     GEN T, L = gel(vL,i), a0 = gel(L,1), ldata = gel(L,2);
    6933         182 :     GEN van = gel(ldata_get_an(ldata),2);
    6934         182 :     if (lg(van) == 1)
    6935             :     {
    6936           0 :       T = gmul(b, a0);
    6937           0 :       if (isexactzero(T)) { GEN z = real_0_bit(-bitprec); T = mkcomplex(z,z); }
    6938             :     }
    6939             :     else
    6940             :     {
    6941         182 :       T = gmul2n(lfuntheta(ldata, t, 0, bitprec), -1);
    6942         182 :       T = gmul(b, gadd(a0, T));
    6943             :     }
    6944         182 :     gel(v,i) = T;
    6945             :   }
    6946         154 :   return l == 2? gel(v,1): v;
    6947             : }
    6948             : 
    6949             : /* P in ZX, irreducible */
    6950             : static GEN
    6951         175 : ZX_roots(GEN P, long prec)
    6952             : {
    6953         175 :   long d = degpol(P);
    6954         175 :   if (d == 1) return mkvec(gen_0);
    6955         175 :   if (d == 2 && isint1(gel(P,2)) && isintzero(gel(P,3)) && isint1(gel(P,4)))
    6956           7 :     return mkvec2(powIs(3), gen_I()); /* order as polroots */
    6957         280 :   return (ZX_sturm_irred(P) == d)? ZX_realroots_irred(P, prec)
    6958         280 :                                  : QX_complex_roots(P, prec);
    6959             : }
    6960             : /* initializations for RgX_RgV_eval / RgC_embed */
    6961             : static GEN
    6962         210 : rootspowers(GEN v)
    6963             : {
    6964         210 :   long i, l = lg(v);
    6965         210 :   GEN w = cgetg(l, t_VEC);
    6966         826 :   for (i = 1; i < l; i++) gel(w,i) = gpowers(gel(v,i), l-2);
    6967         210 :   return w;
    6968             : }
    6969             : /* mf embeddings attached to Q(chi)/(T), chi attached to cyclotomic P */
    6970             : static GEN
    6971         875 : getembed(GEN P, GEN T, GEN zcyclo, long prec)
    6972             : {
    6973             :   long i, l;
    6974             :   GEN v;
    6975         875 :   if (degpol(P) == 1) P = NULL; /* mfcharpol for quadratic char */
    6976         875 :   if (degpol(T) == 1) T = NULL; /* dim 1 orbit */
    6977         875 :   if (T && P)
    6978          35 :   { /* K(y) / (T(y)), K = Q(t)/(P) cyclotomic */
    6979          35 :     GEN vr = RgX_is_ZX(T)? ZX_roots(T,prec): roots(RgX_embed1(T,zcyclo), prec);
    6980          35 :     v = rootspowers(vr); l = lg(v);
    6981         105 :     for (i = 1; i < l; i++) gel(v,i) = mkcol3(P,zcyclo,gel(v,i));
    6982             :   }
    6983         840 :   else if (T)
    6984             :   { /* Q(y) / (T(y)), T non-cyclotomic */
    6985         175 :     GEN vr = ZX_roots(T, prec);
    6986         175 :     v = rootspowers(vr); l = lg(v);
    6987         721 :     for (i = 1; i < l; i++) gel(v,i) = mkcol2(T, gel(v,i));
    6988             :   }
    6989             :   else /* cyclotomic or rational */
    6990         665 :     v = mkvec(P? mkvec2(P, zcyclo): cgetg(1,t_VEC));
    6991         875 :   return v;
    6992             : }
    6993             : static GEN
    6994         728 : grootsof1_CHI(GEN CHI, long prec)
    6995         728 : { return grootsof1(mfcharorder(CHI), prec); }
    6996             : /* return the [Q(F):Q(chi)] embeddings of F */
    6997             : static GEN
    6998         574 : mfgetembed(GEN F, long prec)
    6999             : {
    7000         574 :   GEN T = mf_get_field(F), CHI = mf_get_CHI(F), P = mfcharpol(CHI);
    7001         574 :   return getembed(P, T, grootsof1_CHI(CHI, prec), prec);
    7002             : }
    7003             : static GEN
    7004           7 : mfchiembed(GEN mf, long prec)
    7005             : {
    7006           7 :   GEN CHI = MF_get_CHI(mf), P = mfcharpol(CHI);
    7007           7 :   return getembed(P, pol_x(0), grootsof1_CHI(CHI, prec), prec);
    7008             : }
    7009             : /* mfgetembed for the successive eigenforms in MF_get_newforms */
    7010             : static GEN
    7011         147 : mfeigenembed(GEN mf, long prec)
    7012             : {
    7013         147 :   GEN vP = MF_get_fields(mf), vF = MF_get_newforms(mf);
    7014         147 :   GEN zcyclo, vE, CHI = MF_get_CHI(mf), P = mfcharpol(CHI);
    7015         147 :   long i, l = lg(vP);
    7016         147 :   vF = Q_remove_denom(liftpol_shallow(vF), NULL);
    7017         147 :   prec += nbits2extraprec(gexpo(vF));
    7018         147 :   zcyclo = grootsof1_CHI(CHI, prec);
    7019         147 :   vE = cgetg(l, t_VEC);
    7020         441 :   for (i = 1; i < l; i++) gel(vE,i) = getembed(P, gel(vP,i), zcyclo, prec);
    7021         147 :   return vE;
    7022             : }
    7023             : 
    7024             : static int
    7025          28 : checkPv(GEN P, GEN v)
    7026          28 : { return typ(P) == t_POL && is_vec_t(typ(v)) && lg(v)-1 >= degpol(P); }
    7027             : static int
    7028          28 : checkemb_i(GEN E)
    7029             : {
    7030          28 :   long t = typ(E), l = lg(E);
    7031          28 :   if (t == t_VEC) return l == 1 || (l == 3 && checkPv(gel(E,1), gel(E,2)));
    7032          21 :   if (t != t_COL) return 0;
    7033          21 :   if (l == 3) return checkPv(gel(E,1), gel(E,2));
    7034          21 :   return l == 4 && is_vec_t(typ(gel(E,2))) && checkPv(gel(E,1), gel(E,3));
    7035             : }
    7036             : static GEN
    7037          28 : anyembed(GEN v, GEN E)
    7038             : {
    7039          28 :   switch(typ(v))
    7040             :   {
    7041          21 :     case t_VEC: case t_COL: return mfvecembed(E, v);
    7042           7 :     case t_MAT: return mfmatembed(E, v);
    7043             :   }
    7044           0 :   return mfembed(E, v);
    7045             : }
    7046             : GEN
    7047          49 : mfembed0(GEN E, GEN v, long prec)
    7048             : {
    7049          49 :   pari_sp av = avma;
    7050          49 :   GEN mf, vE = NULL;
    7051          49 :   if (checkmf_i(E)) vE = mfgetembed(E, prec);
    7052          35 :   else if ((mf = checkMF_i(E))) vE = mfchiembed(mf, prec);
    7053          49 :   if (vE)
    7054             :   {
    7055          21 :     long i, l = lg(vE);
    7056             :     GEN w;
    7057          21 :     if (!v) return gerepilecopy(av, l == 2? gel(vE,1): vE);
    7058           0 :     w = cgetg(l, t_VEC);
    7059           0 :     for (i = 1; i < l; i++) gel(w,i) = anyembed(v, gel(vE,i));
    7060           0 :     return gerepilecopy(av, l == 2? gel(w,1): w);
    7061             :   }
    7062          28 :   if (!checkemb_i(E) || !v) pari_err_TYPE("mfembed", E);
    7063          28 :   return gerepilecopy(av, anyembed(v,E));
    7064             : }
    7065             : 
    7066             : /* dummy lfun create for theta evaluation */
    7067             : static GEN
    7068         882 : mfthetaancreate(GEN van, GEN N, GEN k)
    7069             : {
    7070         882 :   GEN L = zerovec(6);
    7071         882 :   gel(L,1) = lfuntag(t_LFUN_GENERIC, van);
    7072         882 :   gel(L,3) = mkvec2(gen_0, gen_1);
    7073         882 :   gel(L,4) = k;
    7074         882 :   gel(L,5) = N; return L;
    7075             : }
    7076             : /* destroy van and prepare to evaluate theta(sigma(van)), for all sigma in
    7077             :  * embeddings vector vE */
    7078             : static GEN
    7079         322 : van_embedall(GEN van, GEN vE, GEN gN, GEN gk)
    7080             : {
    7081         322 :   GEN a0 = gel(van,1), vL;
    7082         322 :   long i, lE = lg(vE), l = lg(van);
    7083         322 :   van++; van[0] = evaltyp(t_VEC) | evallg(l-1); /* remove a0 */
    7084         322 :   vL = cgetg(lE, t_VEC);
    7085         847 :   for (i = 1; i < lE; i++)
    7086             :   {
    7087         525 :     GEN E = gel(vE,i), v = mfvecembed(E, van);
    7088         525 :     gel(vL,i) = mkvec2(mfembed(E,a0), mfthetaancreate(v, gN, gk));
    7089             :   }
    7090         322 :   return vL;
    7091             : }
    7092             : 
    7093             : static int
    7094        1022 : cusp_AC(GEN cusp, long *A, long *C)
    7095             : {
    7096        1022 :   switch(typ(cusp))
    7097             :   {
    7098         105 :     case t_INFINITY: *A = 1; *C = 0; break;
    7099         273 :     case t_INT:  *A = itos(cusp); *C = 1; break;
    7100         427 :     case t_FRAC: *A = itos(gel(cusp, 1)); *C = itos(gel(cusp, 2)); break;
    7101         217 :     case t_REAL: case t_COMPLEX:
    7102         217 :       *A = 0; *C = 0;
    7103         217 :       if (gsigne(imag_i(cusp)) <= 0)
    7104           7 :         pari_err_DOMAIN("mfeval","imag(tau)","<=",gen_0,cusp);
    7105         210 :       return 0;
    7106           0 :     default: pari_err_TYPE("cusp_AC", cusp);
    7107             :   }
    7108         805 :   return 1;
    7109             : }
    7110             : static GEN
    7111         518 : cusp2mat(long A, long C)
    7112             : { long B, D;
    7113         518 :   cbezout(A, C, &D, &B);
    7114         518 :   return mkmat22s(A, -B, C, D);
    7115             : }
    7116             : static GEN
    7117          21 : mkS(void) { return mkmat22s(0,-1,1,0); }
    7118             : 
    7119             : /* if t is a cusp, return F(t), else NULL */
    7120             : static GEN
    7121         350 : evalcusp(GEN mf, GEN F, GEN t, long prec)
    7122             : {
    7123             :   long A, C;
    7124             :   GEN R;
    7125         350 :   if (!cusp_AC(t, &A,&C)) return NULL;
    7126         189 :   if (C % mf_get_N(F) == 0) return gel(mfcoefs_i(F, 0, 1), 1);
    7127         175 :   R = mfgaexpansion(mf, F, cusp2mat(A,C), 0, prec);
    7128         175 :   return gequal0(gel(R,1))? gmael(R,3,1): gen_0;
    7129             : }
    7130             : /* Evaluate an mf closure numerically, i.e., in the usual sense, either for a
    7131             :  * single tau or a vector of tau; for each, return a vector of results
    7132             :  * corresponding to all complex embeddings of F. If flag is non-zero, allow
    7133             :  * replacing F by F | gamma to increase imag(gamma^(-1).tau) [ expensive if
    7134             :  * MF_EISENSPACE not present ] */
    7135             : static GEN
    7136         161 : mfeval_i(GEN mf, GEN F, GEN vtau, long flag, long bitprec)
    7137             : {
    7138             :   GEN L0, vL, vb, sqN, vczd, vTAU, vs, van, vE;
    7139         161 :   long N = MF_get_N(mf), N0, ta, lv, i, prec = nbits2prec(bitprec);
    7140         161 :   GEN gN = utoipos(N), gk = mf_get_gk(F), gk1 = gsubgs(gk,1), vgk;
    7141         161 :   long flscal = 0;
    7142             : 
    7143             :   /* gen_0 is ignored, second component assumes Ramanujan-Petersson in
    7144             :    * 1/2-integer weight */
    7145         161 :   vgk = mkvec2(gen_0, mfiscuspidal(mf,F)? gmul2n(gk1,-1): gk1);
    7146         161 :   ta = typ(vtau);
    7147         161 :   if (!is_vec_t(ta)) { flscal = 1; vtau = mkvec(vtau); ta = t_VEC; }
    7148         161 :   lv = lg(vtau);
    7149         161 :   sqN = sqrtr_abs(utor(N, prec));
    7150         161 :   vs = const_vec(lv-1, NULL);
    7151         161 :   vb = const_vec(lv-1, NULL);
    7152         161 :   vL = cgetg(lv, t_VEC);
    7153         161 :   vTAU = cgetg(lv, t_VEC);
    7154         161 :   vczd = cgetg(lv, t_VEC);
    7155         161 :   L0 = mfthetaancreate(NULL, gN, vgk); /* only for thetacost */
    7156         161 :   vE = mfgetembed(F, prec);
    7157         161 :   N0 = 0;
    7158         343 :   for (i = 1; i < lv; i++)
    7159             :   {
    7160         189 :     GEN z = gel(vtau,i), tau, U;
    7161             :     long w, n;
    7162             : 
    7163         189 :     gel(vs,i) = evalcusp(mf, F, z, prec);
    7164         182 :     if (gel(vs,i)) continue;
    7165         154 :     tau = cxredga0N(N, z, &U, &gel(vczd,i), flag);
    7166         154 :     if (!flag) w = 0; else { w = mfZC_width(N, gel(U,1)); tau = gdivgs(tau,w); }
    7167         154 :     gel(vTAU,i) = mulcxmI(gmul(tau, sqN));
    7168         154 :     n = lfunthetacost(L0, real_i(gel(vTAU,i)), 0, bitprec);
    7169         154 :     if (N0 < n) N0 = n;
    7170         154 :     if (flag)
    7171             :     {
    7172          42 :       GEN A, al, v = mfslashexpansion(mf, F, ZM_inv(U,NULL), n, 0, &A, prec);
    7173          42 :       gel(vL,i) = van_embedall(v, vE, gN, vgk);
    7174          42 :       al = gel(A,1);
    7175          42 :       if (!gequal0(al))
    7176           7 :         gel(vb,i) = gexp(gmul(gmul(gmulsg(w,al),PiI2(prec)), tau), prec);
    7177             :     }
    7178             :   }
    7179         154 :   if (!flag)
    7180             :   {
    7181         112 :     van = mfcoefs_i(F, N0, 1);
    7182         112 :     vL = const_vec(lv-1, van_embedall(van, vE, gN, vgk));
    7183             :   }
    7184         336 :   for (i = 1; i < lv; i++)
    7185             :   {
    7186             :     GEN T;
    7187         182 :     if (gel(vs,i)) continue;
    7188         154 :     T = gpow(gel(vczd,i), gneg(gk), prec);
    7189         154 :     if (flag && gel(vb,i)) T = gmul(T, gel(vb,i));
    7190         154 :     gel(vs,i) = lfunthetaall(T, gel(vL,i), gel(vTAU,i), bitprec);
    7191             :   }
    7192         154 :   return flscal? gel(vs,1): vs;
    7193             : }
    7194             : 
    7195             : static long
    7196        1134 : mfistrivial(GEN F)
    7197             : {
    7198        1134 :   switch(mf_get_type(F))
    7199             :   {
    7200           7 :     case t_MF_CONST: return lg(gel(F,2)) == 1;
    7201         259 :     case t_MF_LINEAR: case t_MF_LINEAR_BHN: return gequal0(gel(F,3));
    7202         868 :     default: return 0;
    7203             :   }
    7204             : }
    7205             : 
    7206             : static long
    7207         952 : mf_same_k(GEN mf, GEN f) { return gequal(MF_get_gk(mf), mf_get_gk(f)); }
    7208             : static long
    7209         910 : mf_same_CHI(GEN mf, GEN f)
    7210             : {
    7211         910 :   GEN F1, F2, chi1, chi2, CHI1 = MF_get_CHI(mf), CHI2 = mf_get_CHI(f);
    7212             :   /* are the primitive chars attached to CHI1 and CHI2 equal ? */
    7213         910 :   F1 = znconreyconductor(gel(CHI1,1), gel(CHI1,2), &chi1);
    7214         910 :   if (typ(F1) == t_VEC) F1 = gel(F1,1);
    7215         910 :   F2 = znconreyconductor(gel(CHI2,1), gel(CHI2,2), &chi2);
    7216         910 :   if (typ(F2) == t_VEC) F2 = gel(F2,1);
    7217         910 :   return equalii(F1,F2) && ZV_equal(chi1,chi2);
    7218             : }
    7219             : /* check k and CHI rigorously, but not coefficients nor N */
    7220             : static long
    7221         231 : mfisinspace_i(GEN mf, GEN F)
    7222             : {
    7223         231 :   return mfistrivial(F) || (mf_same_k(mf,F) && mf_same_CHI(mf,F));
    7224             : }
    7225             : static void
    7226           7 : err_space(GEN F)
    7227           7 : { pari_err_DOMAIN("mftobasis", "form", "does not belong to",
    7228           0 :                   strtoGENstr("space"), F); }
    7229             : 
    7230             : static long
    7231         147 : mfcheapeisen(GEN mf)
    7232             : {
    7233         147 :   long k, L, N = MF_get_N(mf);
    7234             :   GEN P;
    7235         147 :   if (N <= 70) return 1;
    7236          84 :   k = itos(gceil(MF_get_gk(mf)));
    7237          84 :   if (odd(k)) k--;
    7238          84 :   switch (k)
    7239             :   {
    7240           0 :     case 2:  L = 190; break;
    7241          14 :     case 4:  L = 162; break;
    7242          70 :     case 6:
    7243          70 :     case 8:  L = 88; break;
    7244           0 :     case 10: L = 78; break;
    7245           0 :     default: L = 66; break;
    7246             :   }
    7247          84 :   P = gel(myfactoru(N), 1);
    7248          84 :   return P[lg(P)-1] <= L;
    7249             : }
    7250             : 
    7251             : static GEN
    7252         182 : myimag_i(GEN tau)
    7253             : {
    7254         182 :   long tc = typ(tau);
    7255         182 :   if (tc == t_INFINITY || tc == t_INT || tc == t_FRAC)
    7256          28 :     return gen_1;
    7257         154 :   if (tc == t_VEC)
    7258             :   {
    7259             :     long ltau, i;
    7260           7 :     GEN z = cgetg_copy(tau, &ltau);
    7261          42 :     for (i=1; i<ltau; i++) gel(z,i) = myimag_i(gel(tau,i));
    7262           7 :     return z;
    7263             :   }
    7264         147 :   return imag_i(tau);
    7265             : }
    7266             : 
    7267             : static GEN
    7268         147 : mintau(GEN vtau)
    7269             : {
    7270         147 :   if (!is_vec_t(typ(vtau))) return myimag_i(vtau);
    7271           7 :   return (lg(vtau) == 1)? gen_1: vecmin(myimag_i(vtau));
    7272             : }
    7273             : 
    7274             : /* initialization for mfgaexpansion: what does not depend on cusp */
    7275             : static GEN
    7276         945 : mf_eisendec(GEN mf, GEN F, long prec)
    7277             : {
    7278         945 :   GEN B = liftpol_shallow(mfeisensteindec(mf, F)), v = variables_vecsmall(B);
    7279         945 :   GEN Mvecj = obj_check(mf, MF_EISENSPACE);
    7280         945 :   long l = lg(v), i, ord;
    7281         945 :   if (lg(Mvecj) < 5) Mvecj = gel(Mvecj,1);
    7282         945 :   ord = itou(gel(Mvecj,4));
    7283        1001 :   for (i = 1; i < l; i++)
    7284         714 :     if (v[i] != 1)
    7285             :     {
    7286             :       GEN d;
    7287             :       long e;
    7288         658 :       B = Q_remove_denom(B, &d);
    7289         658 :       e = gexpo(B);
    7290         658 :       if (e > 0) prec += nbits2prec(e);
    7291         658 :       B = gsubst(B, v[i], rootsof1u_cx(ord, prec));
    7292         658 :       if (d) B = gdiv(B, d);
    7293         658 :       break;
    7294             :     }
    7295         945 :   return B;
    7296             : }
    7297             : 
    7298             : GEN
    7299         161 : mfeval(GEN mf0, GEN F, GEN vtau, long bitprec)
    7300             : {
    7301         161 :   pari_sp av = avma;
    7302         161 :   long flnew = 1;
    7303         161 :   GEN mf = checkMF_i(mf0);
    7304         161 :   if (!mf) pari_err_TYPE("mfeval", mf0);
    7305         161 :   if (!checkmf_i(F)) pari_err_TYPE("mfeval", F);
    7306         161 :   if (!mfisinspace_i(mf, F)) err_space(F);
    7307         161 :   if (!obj_check(mf, MF_EISENSPACE)) flnew = mfcheapeisen(mf);
    7308         161 :   if (flnew && gcmpgs(gmulsg(2*MF_get_N(mf), mintau(vtau)), 1) >= 0) flnew = 0;
    7309         161 :   return gerepilecopy(av, mfeval_i(mf, F, vtau, flnew, bitprec));
    7310             : }
    7311             : 
    7312             : static long
    7313         189 : val(GEN v, long bit)
    7314             : {
    7315         189 :   long c, l = lg(v);
    7316         392 :   for (c = 1; c < l; c++)
    7317         378 :     if (gexpo(gel(v,c)) > -bit) return c-1;
    7318          14 :   return -1;
    7319             : }
    7320             : GEN
    7321         203 : mfcuspval(GEN mf, GEN F, GEN cusp, long bitprec)
    7322             : {
    7323         203 :   pari_sp av = avma;
    7324         203 :   long lvE, w, N, sb, n, A, C, prec = nbits2prec(bitprec);
    7325             :   GEN ga, gk, vE;
    7326         203 :   mf = checkMF(mf);
    7327         203 :   if (!checkmf_i(F)) pari_err_TYPE("mfcuspval",F);
    7328         203 :   N = MF_get_N(mf);
    7329         203 :   cusp_canon(cusp, N, &A, &C);
    7330         203 :   gk = mf_get_gk(F);
    7331         203 :   if (typ(gk) != t_INT)
    7332             :   {
    7333          42 :     GEN FT = mfmultheta(F), mf2 = obj_checkbuild(mf, MF_MF2INIT, &mf2init);
    7334          42 :     GEN r = mfcuspval(mf2, FT, cusp, bitprec);
    7335          42 :     if ((C & 3L) == 2)
    7336             :     {
    7337          14 :       GEN z = sstoQ(1,4);
    7338          14 :       r = gsub(r, typ(r) == t_VEC? const_vec(lg(r)-1, z): z);
    7339             :     }
    7340          42 :     return gerepileupto(av, r);
    7341             :   }
    7342         161 :   vE = mfgetembed(F, prec);
    7343         161 :   lvE = lg(vE);
    7344         161 :   w = mfcuspcanon_width(N, C);
    7345         161 :   sb = w * mfsturmNk(N, itos(gk));
    7346         161 :   ga = cusp2mat(A,C);
    7347         168 :   for (n = 8;; n = minss(sb, n << 1))
    7348           7 :   {
    7349         168 :     GEN R = mfgaexpansion(mf, F, ga, n, prec), res = liftpol_shallow(gel(R,3));
    7350         168 :     GEN v = cgetg(lvE-1, t_VECSMALL);
    7351         168 :     long j, ok = 1;
    7352         168 :     res = RgC_embedall(res, vE);
    7353         357 :     for (j = 1; j < lvE; j++)
    7354             :     {
    7355         189 :       v[j] = val(gel(res,j), bitprec/2);
    7356         189 :       if (v[j] < 0) ok = 0;
    7357             :     }
    7358         168 :     if (ok)
    7359             :     {
    7360         154 :       res = cgetg(lvE, t_VEC);
    7361         329 :       for (j = 1; j < lvE; j++) gel(res,j) = gadd(gel(R,1), sstoQ(v[j], w));
    7362         154 :       return gerepilecopy(av, lvE==2? gel(res,1): res);
    7363             :     }
    7364          14 :     if (n == sb) return lvE==2? mkoo(): const_vec(lvE-1, mkoo()); /* 0 */
    7365             :   }
    7366             : }
    7367             : 
    7368             : long
    7369         217 : mfiscuspidal(GEN mf, GEN F)
    7370             : {
    7371         217 :   pari_sp av = avma;
    7372             :   GEN mf2;
    7373         217 :   if (space_is_cusp(MF_get_space(mf))) return 1;
    7374          91 :   if (typ(mf_get_gk(F)) == t_INT)
    7375             :   {
    7376          56 :     GEN v = mftobasis(mf,F,0), vE = vecslice(v, 1, lg(MF_get_E(mf))-1);
    7377          56 :     return gc_long(av, gequal0(vE));
    7378             :   }
    7379          35 :   if (!gequal0(mfak_i(F, 0))) return 0;
    7380          21 :   mf2 = obj_checkbuild(mf, MF_MF2INIT, &mf2init);
    7381          21 :   return mfiscuspidal(mf2, mfmultheta(F));
    7382             : }
    7383             : 
    7384             : /* F = vector of newforms in mftobasis format */
    7385             : static GEN
    7386          91 : mffrickeeigen_i(GEN mf, GEN F, GEN vE, long prec)
    7387             : {
    7388          91 :   GEN M, Z, L0, gN = MF_get_gN(mf), gk = MF_get_gk(mf);
    7389          91 :   long N0, i, lM, bit = prec2nbits(prec), k = itou(gk);
    7390          91 :   long LIM = 5; /* Sturm bound is enough */
    7391             : 
    7392          91 :   L0 = mfthetaancreate(NULL, gN, gk); /* only for thetacost */
    7393          91 : START:
    7394          91 :   N0 = lfunthetacost(L0, gen_1, LIM, bit);
    7395          91 :   M = mfcoefs_mf(mf, N0, 1);
    7396          91 :   lM = lg(F);
    7397          91 :   Z = cgetg(lM, t_VEC);
    7398         259 :   for (i = 1; i < lM; i++)
    7399             :   { /* expansion of D * F[i] */
    7400         168 :     GEN D, z, van = RgM_RgC_mul(M, Q_remove_denom(gel(F,i), &D));
    7401         168 :     GEN L = van_embedall(van, gel(vE,i), gN, gk);
    7402         168 :     long l = lg(L), j, bit_add = D? expi(D): 0;
    7403         168 :     gel(Z,i) = z = cgetg(l, t_VEC);
    7404         511 :     for (j = 1; j < l; j++)
    7405             :     {
    7406             :       GEN v, C, C0;
    7407             :       long m, e;
    7408         476 :       for (m = 0; m <= LIM; m++)
    7409             :       {
    7410         476 :         v = lfuntheta(gmael(L,j,2), gen_1, m, bit);
    7411         476 :         if (gexpo(v) > bit_add - bit/2) break;
    7412             :       }
    7413         343 :       if (m > LIM) { LIM <<= 1; goto START; }
    7414         343 :       C = mulcxpowIs(gdiv(v,conj_i(v)), 2*m - k);
    7415         343 :       C0 = grndtoi(C, &e); if (e < 5-bit_accuracy(precision(C))) C = C0;
    7416         343 :       gel(z,j) = C;
    7417             :     }
    7418             :   }
    7419          91 :   return Z;
    7420             : }
    7421             : static GEN
    7422          70 : mffrickeeigen(GEN mf, GEN vE, long prec)
    7423             : {
    7424          70 :   GEN D = obj_check(mf, MF_FRICKE);
    7425          70 :   if (D) { long p = gprecision(D); if (!p || p >= prec) return D; }
    7426          63 :   D = mffrickeeigen_i(mf, MF_get_newforms(mf), vE, prec);
    7427          63 :   return obj_insert(mf, MF_FRICKE, D);
    7428             : }
    7429             : 
    7430             : /* integral weight, new space for primitive quadratic character CHIP;
    7431             :  * MF = vector of embedded eigenforms coefs on mfbasis, by orbit.
    7432             :  * Assume N > Q > 1 and (Q,f(CHIP)) = 1 */
    7433             : static GEN
    7434          56 : mfatkineigenquad(GEN mf, GEN CHIP, long Q, GEN MF, long bitprec)
    7435             : {
    7436             :   GEN L0, la2, S, F, vP, tau, wtau, Z, va, vb, den, coe, sqrtQ, sqrtN;
    7437          56 :   GEN M, gN, gk = MF_get_gk(mf);
    7438          56 :   long N0, x, yq, i, j, lF, dim, muQ, prec = nbits2prec(bitprec);
    7439          56 :   long N = MF_get_N(mf), k = itos(gk), NQ = N / Q;
    7440             : 
    7441             :   /* Q coprime to FC */
    7442          56 :   F = MF_get_newforms(mf);
    7443          56 :   vP = MF_get_fields(mf);
    7444          56 :   lF = lg(F);
    7445          56 :   Z = cgetg(lF, t_VEC);
    7446          56 :   S = MF_get_S(mf); dim = lg(S) - 1;
    7447          56 :   muQ = mymoebiusu(Q);
    7448          56 :   if (muQ)
    7449             :   {
    7450          42 :     GEN SQ = cgetg(dim+1,t_VEC), Qk = gpow(stoi(Q), sstoQ(k-2, 2), prec);
    7451          42 :     long i, bit2 = bitprec >> 1;
    7452         154 :     for (j = 1; j <= dim; j++) gel(SQ,j) = mfak_i(gel(S,j), Q);
    7453          84 :     for (i = 1; i < lF; i++)
    7454             :     {
    7455          42 :       GEN S = RgV_dotproduct(gel(F,i), SQ), T = gel(vP,i);
    7456             :       long e;
    7457          42 :       if (degpol(T) > 1 && typ(S) != t_POLMOD) S = gmodulo(S, T);
    7458          42 :       S = grndtoi(gdiv(conjvec(S, prec), Qk), &e);
    7459          42 :       if (e > -bit2) pari_err_PREC("mfatkineigenquad");
    7460          42 :       if (muQ == -1) S = gneg(S);
    7461          42 :       gel(Z,i) = S;
    7462             :     }
    7463          42 :     return Z;
    7464             :   }
    7465          14 :   la2 = mfchareval(CHIP, Q); /* 1 or -1 */
    7466          14 :   (void)cbezout(Q, NQ, &x, &yq);
    7467          14 :   sqrtQ = sqrtr_abs(utor(Q,prec));
    7468          14 :   tau = mkcomplex(gadd(sstoQ(-1, NQ), ginv(utoi(1000))),
    7469             :                   divru(sqrtQ, N));
    7470          14 :   den = gaddgs(gmulsg(NQ, tau), 1);
    7471          14 :   wtau = gdiv(gsub(gmulsg(x, tau), sstoQ(yq, Q)), den);
    7472          14 :   coe = gpowgs(gmul(sqrtQ, den), k);
    7473             : 
    7474          14 :   sqrtN = sqrtr_abs(utor(N,prec));
    7475          14 :   tau  = mulcxmI(gmul(tau,  sqrtN));
    7476          14 :   wtau = mulcxmI(gmul(wtau, sqrtN));
    7477          14 :   gN = utoipos(N);
    7478          14 :   L0 = mfthetaancreate(NULL, gN, gk); /* only for thetacost */
    7479          14 :   N0 = maxss(lfunthetacost(L0,real_i(tau), 0,bitprec),
    7480             :              lfunthetacost(L0,real_i(wtau),0,bitprec));
    7481          14 :   M = mfcoefs_mf(mf, N0, 1);
    7482          14 :   va = cgetg(dim+1, t_VEC);
    7483          14 :   vb = cgetg(dim+1, t_VEC);
    7484         105 :   for (j = 1; j <= dim; j++)
    7485             :   {
    7486          91 :     GEN L, v = vecslice(gel(M,j), 2, N0+1); /* remove a0 */
    7487          91 :     settyp(v, t_VEC); L = mfthetaancreate(v, gN, gk);
    7488          91 :     gel(va,j) = lfuntheta(L, tau,0,bitprec);
    7489          91 :     gel(vb,j) = lfuntheta(L,wtau,0,bitprec);
    7490             :   }
    7491          84 :   for (i = 1; i < lF; i++)
    7492             :   {
    7493          70 :     GEN z, FE = gel(MF,i);
    7494          70 :     long l = lg(FE);
    7495          70 :     z = cgetg(l, t_VEC);
    7496          70 :     for (j = 1; j < l; j++)
    7497             :     {
    7498          70 :       GEN f = gel(FE,j), a = RgV_dotproduct(va,f), b = RgV_dotproduct(vb,f);
    7499          70 :       GEN la = ground( gdiv(b, gmul(a,coe)) );
    7500          70 :       if (!gequal(gsqr(la), la2)) pari_err_PREC("mfatkineigenquad");
    7501          70 :       if (typ(la) == t_INT)
    7502             :       {
    7503          70 :         if (j != 1) pari_err_BUG("mfatkineigenquad");
    7504          70 :         z = const_vec(l-1, la); break;
    7505             :       }
    7506           0 :       gel(z,j) = la;
    7507             :     }
    7508          70 :     gel(Z,i) = z;
    7509             :   }
    7510          14 :   return Z;
    7511             : }
    7512             : 
    7513             : static GEN
    7514          84 : myusqrt(ulong a, long prec)
    7515             : {
    7516          84 :   if (a == 1UL) return gen_1;
    7517          70 :   if (uissquareall(a, &a)) return utoipos(a);
    7518          49 :   return sqrtr_abs(utor(a, prec));
    7519             : }
    7520             : /* Assume mf is a non-trivial new space, rational primitive character CHIP
    7521             :  * and (Q,FC) = 1 */
    7522             : static GEN
    7523          98 : mfatkinmatnewquad(GEN mf, GEN CHIP, long Q, long flag, long PREC)
    7524             : {
    7525          98 :   GEN cM, M, D, MF, den, vE, F = MF_get_newforms(mf);
    7526          98 :   long i, c, e, prec, bitprec, lF = lg(F), N = MF_get_N(mf), k = MF_get_k(mf);
    7527             : 
    7528          98 :   if (Q == 1) return mkvec4(gen_0, matid(MF_get_dim(mf)), gen_1, mf);
    7529          98 :   den = gel(MF_get_Minv(mf), 2);
    7530          98 :   bitprec = expi(den) + 64;
    7531          98 :   if (!flag) bitprec = maxss(bitprec, prec2nbits(PREC));
    7532             : 
    7533          28 : START:
    7534          98 :   prec = nbits2prec(bitprec);
    7535          98 :   vE = mfeigenembed(mf, prec);
    7536          98 :   M = cgetg(lF, t_VEC);
    7537         266 :   for (i = 1; i < lF; i++) gel(M,i) = RgC_embedall(gel(F,i), gel(vE,i));
    7538          98 :   if (Q != N)
    7539             :   {
    7540          56 :     D = mfatkineigenquad(mf, CHIP, Q, M, bitprec);
    7541          56 :     c = odd(k)? Q: 1;
    7542             :   }
    7543             :   else
    7544             :   {
    7545          42 :     D = mffrickeeigen(mf, vE, DEFAULTPREC);
    7546          42 :     c = mfcharmodulus(CHIP); if (odd(k)) c = -Q/c;
    7547             :   }
    7548          98 :   D = shallowconcat1(D);
    7549          98 :   if (vec_isconst(D)) { MF = diagonal_shallow(D); flag = 0; }
    7550             :   else
    7551             :   {
    7552          63 :     M = shallowconcat1(M);
    7553          63 :     MF = RgM_mul(matmuldiagonal(M,D), ginv(M));
    7554             :   }
    7555          98 :   if (!flag) return mkvec4(gen_0, MF, gen_1, mf);
    7556             : 
    7557          21 :   if (c > 0)
    7558          21 :     cM = myusqrt(c, PREC);
    7559             :   else
    7560             :   {
    7561           0 :     MF = imag_i(MF); c = -c;
    7562           0 :     cM = mkcomplex(gen_0, myusqrt(c,PREC));
    7563             :   }
    7564          21 :   if (c != 1) MF = RgM_Rg_mul(MF, myusqrt(c,prec));
    7565          21 :   MF = grndtoi(RgM_Rg_mul(MF,den), &e);
    7566          21 :   if (e > -32) { bitprec <<= 1; goto START; }
    7567          21 :   MF = RgM_Rg_div(MF, den);
    7568          21 :   if (is_rational_t(typ(cM)) && !isint1(cM))
    7569           0 :   { MF = RgM_Rg_div(MF, cM); cM = gen_1; }
    7570          21 :   return mkvec4(gen_0, MF, cM, mf);
    7571             : }
    7572             : 
    7573             : /* let CHI mod N, Q || N, return \bar{CHI_Q} * CHI_{N/Q} */
    7574             : static GEN
    7575          91 : mfcharAL(GEN CHI, long Q)
    7576             : {
    7577          91 :   GEN G = gel(CHI,1), c = gel(CHI,2), cycc, d, P, E, F;
    7578          91 :   long l = lg(c), N = mfcharmodulus(CHI), i;
    7579          91 :   if (N == Q) return mfcharconj(CHI);
    7580          42 :   if (N == 1) return CHI;
    7581          42 :   CHI = leafcopy(CHI);
    7582          42 :   gel(CHI,2) = d = leafcopy(c);
    7583          42 :   F = znstar_get_faN(G);
    7584          42 :   P = gel(F,1);
    7585          42 :   E = gel(F,2);
    7586          42 :   cycc = znstar_get_conreycyc(G);
    7587          42 :   if (!odd(Q) && equaliu(gel(P,1), 2) && E[1] >= 3)
    7588          14 :     gel(d,2) = Fp_neg(gel(d,2), gel(cycc,2));
    7589          56 :   else for (i = 1; i < l; i++)
    7590          28 :     if (!umodui(Q, gel(P,i))) gel(d,i) = Fp_neg(gel(d,i), gel(cycc,i));
    7591          42 :   return CHI;
    7592             : }
    7593             : static long
    7594         210 : atkin_get_NQ(long N, long Q, const char *f)
    7595             : {
    7596         210 :   long NQ = N / Q;
    7597         210 :   if (N % Q) pari_err_DOMAIN(f,"N % Q","!=",gen_0,utoi(Q));
    7598         210 :   if (ugcd(NQ, Q) > 1) pari_err_DOMAIN(f,"gcd(Q,N/Q)","!=",gen_1,utoi(Q));
    7599         210 :   return NQ;
    7600             : }
    7601             : 
    7602             : /* transform mf to new_NEW if possible */
    7603             : static GEN
    7604        1267 : MF_set_new(GEN mf)
    7605             : {
    7606        1267 :   GEN vMjd, vj, gk = MF_get_gk(mf);
    7607             :   long l, j;
    7608        1267 :   if (MF_get_space(mf) != mf_CUSP
    7609        1267 :       || typ(gk) != t_INT || itou(gk) == 1) return mf;
    7610         175 :   vMjd = MFcusp_get_vMjd(mf); l = lg(vMjd);
    7611         175 :   if (l > 1 && gel(vMjd,1)[1] != MF_get_N(mf)) return mf; /* oldspace != 0 */
    7612         168 :   mf = shallowcopy(mf);
    7613         168 :   gel(mf,1) = shallowcopy(gel(mf,1));
    7614         168 :   MF_set_space(mf, mf_NEW);
    7615         168 :   vj = cgetg(l, t_VECSMALL);
    7616         917 :   for (j = 1; j < l; j++) vj[j] = gel(vMjd, j)[2];
    7617         168 :   gel(mf,4) = vj; return mf;
    7618             : }
    7619             : 
    7620             : /* if flag = 1, rationalize, else don't */
    7621             : static GEN
    7622         189 : mfatkininit_i(GEN mf, long Q, long flag, long prec)
    7623             : {
    7624             :   GEN M, B, C, CHI, CHIAL, G, chi, P, z, g, mfB, s, Mindex, Minv;
    7625         189 :   long j, l, lim, ord, FC, NQ, cQ, nk, dk, N = MF_get_N(mf);
    7626             : 
    7627         189 :   B = MF_get_basis(mf); l = lg(B);
    7628         189 :   M = cgetg(l, t_MAT); if (l == 1) return mkvec4(gen_0,M,gen_1,mf);
    7629         189 :   Qtoss(MF_get_gk(mf), &nk,&dk);
    7630         189 :   Q = labs(Q);
    7631         189 :   NQ = atkin_get_NQ(N, Q, "mfatkininit");
    7632         189 :   CHI = MF_get_CHI(mf);
    7633         189 :   CHI = mfchartoprimitive(CHI, &FC);
    7634         189 :   ord = mfcharorder(CHI);
    7635         189 :   mf = MF_set_new(mf);
    7636         189 :   if (MF_get_space(mf) == mf_NEW && ord <= 2 && NQ % FC == 0 && dk == 1)
    7637          98 :     return mfatkinmatnewquad(mf, CHI, Q, flag, prec);
    7638             :   /* now flag != 0 */
    7639          91 :   G   = gel(CHI,1);
    7640          91 :   chi = gel(CHI,2);
    7641          91 :   if (Q == N) { g = mkmat22s(0, -1, N, 0); cQ = NQ; } /* Fricke */
    7642             :   else
    7643             :   {
    7644          28 :     GEN F, gQP = utoi(ugcd(Q, FC));
    7645             :     long t, v;
    7646          28 :     chi = znchardecompose(G, chi, gQP);
    7647          28 :     F = znconreyconductor(G, chi, &chi);
    7648          28 :     G = znstar0(F,1);
    7649          28 :     (void)cbezout(Q, NQ, &t, &v);
    7650          28 :     g = mkmat22s(Q*t, 1, -N*v, Q);
    7651          28 :     cQ = -NQ*v;
    7652             :   }
    7653          91 :   C = s = gen_1;
    7654             :   /* N.B. G,chi are G_Q,chi_Q [primitive] at this point */
    7655          91 :   if (lg(chi) != 1) C = ginv( znchargauss(G, chi, gen_1, prec2nbits(prec)) );
    7656          91 :   if (dk == 1)
    7657          84 :   { if (odd(nk)) s = myusqrt(Q,prec); }
    7658             :   else
    7659             :   {
    7660           7 :     long r = nk >> 1; /* k-1/2 */
    7661           7 :     s = gpow(utoipos(Q), mkfracss(odd(r)? 1: 3, 4), prec);
    7662           7 :     if (odd(cQ))
    7663             :     {
    7664           7 :       long t = r + ((cQ-1) >> 1);
    7665           7 :       s = mkcomplex(s, odd(t)? gneg(s): s);
    7666             :     }
    7667             :   }
    7668          91 :   if (!isint1(s)) C = gmul(C, s);
    7669          91 :   CHIAL = mfcharAL(CHI, Q);
    7670          91 :   if (dk == 2)
    7671           7 :     CHIAL = mfcharmul(CHIAL, induce(gel(CHIAL,1), utoipos(odd(Q) ? Q<<2 : Q)));
    7672          91 :   CHIAL = mfchartoprimitive(CHIAL,NULL);
    7673          91 :   mfB = gequal(CHIAL,CHI)? mf: mfinit_Nndkchi(N,nk,dk,CHIAL,MF_get_space(mf),0);
    7674          91 :   Mindex = MF_get_Mindex(mfB);
    7675          91 :   Minv = MF_get_Minv(mfB);
    7676          91 :   P = z = NULL;
    7677          91 :   if (ord > 2) { P = mfcharpol(CHI); z = rootsof1u_cx(ord, prec); }
    7678          91 :   lim = maxss(mfsturm(mfB), mfsturm(mf)) + 1;
    7679         287 :   for (j = 1; j < l; j++)
    7680             :   {
    7681         196 :     GEN v = mfslashexpansion(mf, gel(B,j), g, lim, 0, NULL, prec+EXTRAPREC);
    7682             :     long junk;
    7683         196 :     if (!isint1(C)) v = RgV_Rg_mul(v, C);
    7684         196 :     v = bestapprnf(v, P, z, prec);
    7685         196 :     v = vecpermute_partial(v, Mindex, &junk);
    7686         196 :     v = Minv_RgC_mul(Minv, v); /* cf mftobasis_i */
    7687         196 :     gel(M, j) = v;
    7688             :   }
    7689          91 :   if (is_rational_t(typ(C)) && !gequal1(C)) { M = gdiv(M, C); C = gen_1; }
    7690          91 :   if (mfB == mf) mfB = gen_0;
    7691          91 :   return mkvec4(mfB, M, C, mf);
    7692             : }
    7693             : GEN
    7694          77 : mfatkininit(GEN mf, long Q, long prec)
    7695             : {
    7696          77 :   pari_sp av = avma;
    7697          77 :   mf = checkMF(mf); return gerepilecopy(av, mfatkininit_i(mf, Q, 1, prec));
    7698             : }
    7699             : static void
    7700          56 : checkmfa(GEN z)
    7701             : {
    7702          56 :   if (typ(z) != t_VEC || lg(z) != 5 || typ(gel(z,2)) != t_MAT
    7703          56 :       || !checkMF_i(gel(z,4))
    7704          56 :       || (!isintzero(gel(z,1)) && !checkMF_i(gel(z,1))))
    7705           0 :     pari_err_TYPE("mfatkin [please apply mfatkininit()]",z);
    7706          56 : }
    7707             : 
    7708             : /* Apply atkin Q to closure F */
    7709             : GEN
    7710          56 : mfatkin(GEN mfa, GEN F)
    7711             : {
    7712          56 :   pari_sp av = avma;
    7713             :   GEN z, mfB, MQ, mf;
    7714          56 :   checkmfa(mfa);
    7715          56 :   mfB= gel(mfa,1);
    7716          56 :   MQ = gel(mfa,2);
    7717          56 :   mf = gel(mfa,4);
    7718          56 :   if (typ(mfB) == t_INT) mfB = mf;
    7719          56 :   z = RgM_RgC_mul(MQ, mftobasis_i(mf,F));
    7720          56 :   return gerepileupto(av, mflinear(mfB, z));
    7721             : }
    7722             : 
    7723             : GEN
    7724          49 : mfatkineigenvalues(GEN mf, long Q, long prec)
    7725             : {
    7726          49 :   pari_sp av = avma;
    7727             :   GEN vF, L, CHI, M, mfatk, C, MQ, vE, mfB;
    7728             :   long N, NQ, l, i;
    7729             : 
    7730          49 :   mf = checkMF(mf); N = MF_get_N(mf);
    7731          49 :   vF = MF_get_newforms(mf); l = lg(vF);
    7732             :   /* N.B. k is integral */
    7733          49 :   if (l == 1) { set_avma(av); return cgetg(1, t_VEC); }
    7734          49 :   L = cgetg(l, t_VEC);
    7735          49 :   if (Q == 1)
    7736             :   {
    7737           7 :     GEN vP = MF_get_fields(mf);
    7738          21 :     for (i = 1; i < l; i++) gel(L,i) = const_vec(degpol(gel(vP,i)), gen_1);
    7739           7 :     return L;
    7740             :   }
    7741          42 :   vE = mfeigenembed(mf,prec);
    7742          42 :   if (Q == N) return gerepileupto(av, mffrickeeigen(mf, vE, prec));
    7743          21 :   Q = labs(Q);
    7744          21 :   NQ = atkin_get_NQ(N, Q, "mfatkineigenvalues"); /* != 1 */
    7745          21 :   mfatk = mfatkininit(mf, Q, prec);
    7746          21 :   mfB= gel(mfatk,1); if (typ(mfB) != t_VEC) mfB = mf;
    7747          21 :   MQ = gel(mfatk,2);
    7748          21 :   C  = gel(mfatk,3);
    7749          21 :   M = row(mfcoefs_mf(mfB,1,1), 2); /* vec of a_1(b_i) for mfbasis functions */
    7750          56 :   for (i = 1; i < l; i++)
    7751             :   {
    7752          35 :     GEN c = RgV_dotproduct(RgM_RgC_mul(MQ,gel(vF,i)), M); /* C * eigen_i */
    7753          35 :     gel(L,i) = Rg_embedall_i(c, gel(vE,i));
    7754             :   }
    7755          21 :   if (!gequal1(C)) L = gdiv(L, C);
    7756          21 :   CHI = MF_get_CHI(mf);
    7757          21 :   if (mfcharorder(CHI) <= 2 && NQ % mfcharconductor(CHI) == 0) L = ground(L);
    7758          21 :   return gerepilecopy(av, L);
    7759             : }
    7760             : 
    7761             : /* expand B_d V, keeping same length */
    7762             : static GEN
    7763        5852 : bdexpand(GEN V, long d)
    7764             : {
    7765             :   GEN W;
    7766             :   long N, n;
    7767        5852 :   if (d == 1) return V;
    7768        2121 :   N = lg(V)-1; W = zerovec(N);
    7769       42749 :   for (n = 0; n <= (N-1)/d; n++) gel(W, n*d+1) = gel(V, n+1);
    7770        2121 :   return W;
    7771             : }
    7772             : /* expand B_d V, increasing length up to lim */
    7773             : static GEN
    7774         287 : bdexpandall(GEN V, long d, long lim)
    7775             : {
    7776             :   GEN W;
    7777             :   long N, n;
    7778         287 :   if (d == 1) return V;
    7779          35 :   N = lg(V)-1; W = zerovec(lim);
    7780         259 :   for (n = 0; n <= N-1 && n*d <= lim; n++) gel(W, n*d+1) = gel(V, n+1);
    7781          35 :   return W;
    7782             : }
    7783             : 
    7784             : static void
    7785        8813 : parse_vecj(GEN T, GEN *E1, GEN *E2)
    7786             : {
    7787        8813 :   if (lg(T)==3) { *E1 = gel(T,1); *E2 = gel(T,2); }
    7788        4732 :   else { *E1 = T; *E2 = NULL; }
    7789        8813 : }
    7790             : 
    7791             : /* g in M_2(Z) ? */
    7792             : static int
    7793        2744 : check_M2Z(GEN g)
    7794        2744 : {  return typ(g) == t_MAT && lg(g) == 3 && lgcols(g) == 3 && RgM_is_ZM(g); }
    7795             : /* g in SL_2(Z) ? */
    7796             : static int
    7797        1673 : check_SL2Z(GEN g) { return check_M2Z(g) && equali1(ZM_det(g)); }
    7798             : 
    7799             : static GEN
    7800        9023 : mfcharcxeval(GEN CHI, long n, long prec)
    7801             : {
    7802        9023 :   ulong ord, N = mfcharmodulus(CHI);
    7803             :   GEN ordg;
    7804        9023 :   if (N == 1) return gen_1;
    7805        3696 :   if (ugcd(N, labs(n)) > 1) return gen_0;
    7806        3696 :   ordg = gmfcharorder(CHI);
    7807        3696 :   ord = itou(ordg);
    7808        3696 :   return rootsof1q_cx(znchareval_i(CHI,n,ordg), ord, prec);
    7809             : }
    7810             : 
    7811             : static GEN
    7812        4837 : RgV_shift(GEN V, GEN gn)
    7813             : {
    7814             :   long i, n, l;
    7815             :   GEN W;
    7816        4837 :   if (typ(gn) != t_INT) pari_err_BUG("RgV_shift [n not integral]");
    7817        4837 :   n = itos(gn);
    7818        4837 :   if (n < 0) pari_err_BUG("RgV_shift [n negative]");
    7819        4837 :   if (!n) return V;
    7820         112 :   W = cgetg_copy(V, &l); if (n > l-1) n = l-1;
    7821         308 :   for (i=1; i <= n; i++) gel(W,i) = gen_0;
    7822        4900 :   for (    ; i < l; i++) gel(W,i) = gel(V, i-n);
    7823         112 :   return W;
    7824             : }
    7825             : static GEN
    7826        7483 : hash_eisengacx(hashtable *H, void *E, long w, GEN ga, long n, long prec)
    7827             : {
    7828        7483 :   ulong h = H->hash(E);
    7829        7483 :   hashentry *e = hash_search2(H, E, h);
    7830             :   GEN v;
    7831        7483 :   if (e) v = (GEN)e->val;
    7832             :   else
    7833             :   {
    7834        5012 :     v = mfeisensteingacx((GEN)E, w, ga, n, prec);
    7835        5012 :     hash_insert2(H, E, (void*)v, h);
    7836             :   }
    7837        7483 :   return v;
    7838             : }
    7839             : static GEN
    7840        4837 : vecj_expand(GEN B, hashtable *H, long w, GEN ga, long n, long prec)
    7841             : {
    7842             :   GEN E1, E2, v;
    7843        4837 :   parse_vecj(B, &E1, &E2);
    7844        4837 :   v = hash_eisengacx(H, (void*)E1, w, ga, n, prec);
    7845        4837 :   if (E2)
    7846             :   {
    7847        2590 :     GEN u = hash_eisengacx(H, (void*)E2, w, ga, n, prec);
    7848        2590 :     GEN a = gadd(gel(v,1), gel(u,1));
    7849        2590 :     GEN b = RgV_mul_RgXn(gel(v,2), gel(u,2));
    7850        2590 :     v = mkvec2(a,b);
    7851             :   }
    7852        4837 :   return v;
    7853             : }
    7854             : static GEN
    7855        1008 : shift_M(GEN M, GEN Valpha, long w)
    7856             : {
    7857        1008 :   long i, l = lg(Valpha);
    7858        1008 :   GEN almin = vecmin(Valpha);
    7859        5845 :   for (i = 1; i < l; i++)
    7860             :   {
    7861        4837 :     GEN alpha = gel(Valpha, i), gsh = gmulsg(w, gsub(alpha,almin));
    7862        4837 :     gel(M,i) = RgV_shift(gel(M,i), gsh);
    7863             :   }
    7864        1008 :   return almin;
    7865             : }
    7866             : static GEN mfeisensteinspaceinit(GEN NK);
    7867             : #if 0
    7868             : /* ga in M_2^+(Z)), n >= 0 */
    7869             : static GEN
    7870             : mfgaexpansion_init(GEN mf, GEN ga, long n, long prec)
    7871             : {
    7872             :   GEN M, Mvecj, vecj, almin, Valpha;
    7873             :   long i, w, l, N = MF_get_N(mf), c = itos(gcoeff(ga,2,1));
    7874             :   hashtable *H;
    7875             : 
    7876             :   if (c % N == 0)
    7877             :   { /* ga in G_0(N), trivial case; w = 1 */
    7878             :     GEN chid = mfcharcxeval(MF_get_CHI(mf), itos(gcoeff(ga,2,2)), prec);
    7879             :     return mkvec2(chid, utoi(n));
    7880             :   }
    7881             : 
    7882             :   Mvecj = obj_checkbuild(mf, MF_EISENSPACE, &mfeisensteinspaceinit);
    7883             :   if (lg(Mvecj) < 5) pari_err_IMPL("mfgaexpansion_init in this case");
    7884             :   w = mfcuspcanon_width(N, c);
    7885             :   vecj = gel(Mvecj, 3);
    7886             :   l = lg(vecj);
    7887             :   M = cgetg(l, t_VEC);
    7888             :   Valpha = cgetg(l, t_VEC);
    7889             :   H = hash_create(l, (ulong(*)(void*))&hash_GEN,
    7890             :                      (int(*)(void*,void*))&gidentical, 1);
    7891             :   for (i = 1; i < l; i++)
    7892             :   {
    7893             :     GEN v = vecj_expand(gel(vecj,i), H, w, ga, n, prec);
    7894             :     gel(Valpha,i) = gel(v,1);
    7895             :     gel(M,i) = gel(v,2);
    7896             :   }
    7897             :   almin = shift_M(M, Valpha, w);
    7898             :   return mkvec3(almin, utoi(w), M);
    7899             : }
    7900             : /* half-integer weight not supported; vF = [F,eisendec(F)].
    7901             :  * Minit = mfgaexpansion_init(mf, ga, n, prec) */
    7902             : static GEN
    7903             : mfgaexpansion_with_init(GEN Minit, GEN vF)
    7904             : {
    7905             :   GEN v;
    7906             :   if (lg(Minit) == 3)
    7907             :   { /* ga in G_0(N) */
    7908             :     GEN chid = gel(Minit,1), gn = gel(Minit,2);
    7909             :     v = mfcoefs_i(gel(vF,1), itou(gn), 1);
    7910             :     v = mkvec3(gen_0, gen_1, RgV_Rg_mul(v,chid));
    7911             :   }
    7912             :   else
    7913             :   {
    7914             :     GEN V = RgM_RgC_mul(gel(Minit,3), gel(vF,2));
    7915             :     v = mkvec3(gel(Minit,1), gel(Minit,2), V);
    7916             :   }
    7917             :   return v;
    7918             : }
    7919             : #endif
    7920             : 
    7921             : /* B = mfeisensteindec(F) already embedded, ga in M_2^+(Z)), n >= 0 */
    7922             : static GEN
    7923        1008 : mfgaexpansion_i(GEN mf, GEN B0, GEN ga, long n, long prec)
    7924             : {
    7925        1008 :   GEN M, Mvecj, vecj, almin, Valpha, B, E = NULL;
    7926        1008 :   long i, j, w, nw, l, N = MF_get_N(mf), bit = prec2nbits(prec) / 2;
    7927             :   hashtable *H;
    7928             : 
    7929        1008 :   Mvecj = obj_check(mf, MF_EISENSPACE);
    7930        1008 :   if (lg(Mvecj) < 5) { E = gel(Mvecj, 2); Mvecj = gel(Mvecj, 1); }
    7931        1008 :   vecj = gel(Mvecj, 3);
    7932        1008 :   l = lg(vecj);
    7933        1008 :   B = cgetg(l, t_COL);
    7934        1008 :   M = cgetg(l, t_VEC);
    7935        1008 :   Valpha = cgetg(l, t_VEC);
    7936        1008 :   w = mfZC_width(N, gel(ga,1));
    7937        1008 :   nw = E ? n + w : n;
    7938        1008 :   H = hash_create(l, (ulong(*)(void*))&hash_GEN,
    7939             :                      (int(*)(void*,void*))&gidentical, 1);
    7940        8743 :   for (i = j = 1; i < l; i++)
    7941             :   {
    7942             :     GEN v;
    7943        7735 :     if (gequal0(gel(B0,i))) continue;
    7944        4837 :     v = vecj_expand(gel(vecj,i), H, w, ga, nw, prec);
    7945        4837 :     gel(B,j) = gel(B0,i);
    7946        4837 :     gel(Valpha,j) = gel(v,1);
    7947        4837 :     gel(M,j) = gel(v,2); j++;
    7948             :   }
    7949        1008 :   setlg(Valpha, j);
    7950        1008 :   setlg(B, j);
    7951        1008 :   setlg(M, j); l = j;
    7952        1008 :   if (l == 1) return mkvec3(gen_0, utoi(w), zerovec(n+1));
    7953        1008 :   almin = shift_M(M, Valpha, w);
    7954        1008 :   B = RgM_RgC_mul(M, B); l = lg(B);
    7955      147602 :   for (i = 1; i < l; i++)
    7956      146594 :     if (gexpo(gel(B,i)) < -bit) gel(B,i) = gen_0;
    7957        1008 :   settyp(B, t_VEC);
    7958        1008 :   if (E)
    7959             :   {
    7960             :     GEN v, e;
    7961          56 :     long ell = 0, vB, ve;
    7962         126 :     for (i = 1; i < l; i++)
    7963         126 :       if (!gequal0(gel(B,i))) break;
    7964          56 :     vB = i-1;
    7965          56 :     v = hash_eisengacx(H, (void*)E, w, ga, n + vB, prec);
    7966          56 :     e = gel(v,2); l = lg(e);
    7967          56 :     for (i = 1; i < l; i++)
    7968          56 :       if (!gequal0(gel(e,i))) break;
    7969          56 :     ve = i-1;
    7970          56 :     almin = gsub(almin, gel(v,1));
    7971          56 :     if (gsigne(almin) < 0)
    7972             :     {
    7973           0 :       GEN gell = gceil(gmulsg(-w, almin));
    7974           0 :       ell = itos(gell);
    7975           0 :       almin = gadd(almin, gdivgs(gell, w));
    7976           0 :       if (nw < ell) pari_err_IMPL("alpha < 0 in mfgaexpansion");
    7977             :     }
    7978          56 :     if (ve) { ell += ve; e = vecslice(e, ve+1, l-1); }
    7979          56 :     B = vecslice(B, ell + 1, minss(n + ell + 1, lg(B)-1));
    7980          56 :     B = RgV_div_RgXn(B, e);
    7981             :   }
    7982        1008 :   return mkvec3(almin, utoi(w), B);
    7983             : }
    7984             : 
    7985             : /* Theta multiplier: assume 4 | C, (C,D)=1 */
    7986             : static GEN
    7987         301 : mfthetamultiplier(GEN C, GEN D)
    7988             : {
    7989         301 :   long s = kronecker(C, D);
    7990         301 :   if (Mod4(D) == 1) return s > 0 ? gen_1: gen_m1;
    7991          84 :   return s > 0? powIs(3): gen_I();
    7992             : }
    7993             : /* theta | [*,*;C,D] defined over Q(i) [else over Q] */
    7994             : static int
    7995          56 : mfthetaI(long C, long D) { return odd(C) || (D & 3) == 3; }
    7996             : /* (theta | M) [0..n], assume (C,D) = 1 */
    7997             : static GEN
    7998         301 : mfthetaexpansion(GEN M, long n)
    7999             : {
    8000         301 :   GEN w, s, al, sla, E, V = zerovec(n+1), C = gcoeff(M,2,1), D = gcoeff(M,2,2);
    8001         301 :   long lim, la, f, C4 = Mod4(C);
    8002         301 :   switch (C4)
    8003             :   {
    8004          70 :     case 0: al = gen_0; w = gen_1;
    8005          70 :       s = mfthetamultiplier(C,D);
    8006          70 :       lim = usqrt(n); gel(V, 1) = s;
    8007          70 :       s = gmul2n(s, 1);
    8008         756 :       for (f = 1; f <= lim; f++) gel(V, f*f + 1) = s;
    8009          70 :       break;
    8010         105 :     case 2: al = sstoQ(1,4); w = gen_1;
    8011         105 :       E = subii(C, shifti(D,1)); /* (E, D) = 1 */
    8012         105 :       s = gmul2n(mfthetamultiplier(E, D), 1);
    8013         105 :       if ((!signe(E) && equalim1(D)) || (signe(E) > 0 && signe(C) < 0))
    8014          14 :         s = gneg(s);
    8015         105 :       lim = (usqrt(n << 2) - 1) >> 1;
    8016         966 :       for (f = 0; f <= lim; f++) gel(V, f*(f+1) + 1) = s;
    8017         105 :       break;
    8018         126 :     default: al = gen_0; w = utoipos(4);
    8019         126 :       la = (-Mod4(D)*C4) & 3L;
    8020         126 :       E = negi(addii(D, mului(la, C)));
    8021         126 :       s = mfthetamultiplier(E, C); /* (E,C) = 1 */
    8022         126 :       if (signe(C) < 0 && signe(E) >= 0) s = gneg(s);
    8023         126 :       s = gsub(s, mulcxI(s));
    8024         126 :       sla = gmul(s, powIs(-la));
    8025         126 :       lim = usqrt(n); gel(V, 1) = gmul2n(s, -1);
    8026        1624 :       for (f = 1; f <= lim; f++) gel(V, f*f + 1) = odd(f) ? sla : s;
    8027         126 :       break;
    8028             :   }
    8029         301 :   return mkvec3(al, w, V);
    8030             : }
    8031             : 
    8032             : /* F 1/2 integral weight */
    8033             : static GEN
    8034         301 : mf2gaexpansion(GEN mf2, GEN F, GEN ga, long n, long prec)
    8035             : {
    8036         301 :   GEN FT = mfmultheta(F), mf = obj_checkbuild(mf2, MF_MF2INIT, &mf2init);
    8037         301 :   GEN res, V1, Tres, V2, al, V, gsh, C = gcoeff(ga,2,1);
    8038         301 :   long w2, N = MF_get_N(mf), w = mfcuspcanon_width(N, umodiu(C,N));
    8039         301 :   long ext = (Mod4(C) != 2)? 0: (w+3) >> 2;
    8040         301 :   long prec2 = prec + nbits2extraprec((long)M_PI/(2*M_LN2)*sqrt(n + ext));
    8041         301 :   res = mfgaexpansion(mf, FT, ga, n + ext, prec2);
    8042         301 :   Tres = mfthetaexpansion(ga, n + ext);
    8043         301 :   V1 = gel(res,3);
    8044         301 :   V2 = gel(Tres,3);
    8045         301 :   al = gsub(gel(res,1), gel(Tres,1));
    8046         301 :   w2 = itos(gel(Tres,2));
    8047         301 :   if (w != itos(gel(res,2)) || w % w2)
    8048           0 :     pari_err_BUG("mf2gaexpansion [incorrect w2 or w]");
    8049         301 :   if (w2 != w) V2 = bdexpand(V2, w/w2);
    8050         301 :   V = RgV_div_RgXn(V1, V2);
    8051         301 :   gsh = gfloor(gmulsg(w, al));
    8052         301 :   if (!gequal0(gsh))
    8053             :   {
    8054          35 :     al = gsub(al, gdivgs(gsh, w));
    8055          35 :     if (gsigne(gsh) > 0)
    8056             :     {
    8057           0 :       V = RgV_shift(V, gsh);
    8058           0 :       V = vecslice(V, 1, n + 1);
    8059             :     }
    8060             :     else
    8061             :     {
    8062          35 :       long sh = -itos(gsh), i;
    8063          35 :       if (sh > ext) pari_err_BUG("mf2gaexpansion [incorrect sh]");
    8064         154 :       for (i = 1; i <= sh; i++)
    8065         119 :         if (!gequal0(gel(V,i))) pari_err_BUG("mf2gaexpansion [sh too large]");
    8066          35 :       V = vecslice(V, sh+1, n + sh+1);
    8067             :     }
    8068             :   }
    8069         301 :   obj_free(mf); return mkvec3(al, stoi(w), gprec_wtrunc(V, prec));
    8070             : }
    8071             : 
    8072             : static GEN
    8073          70 : mfgaexpansionatkin(GEN mf, GEN F, GEN C, GEN D, long Q, long n, long prec)
    8074             : {
    8075          70 :   GEN mfa = mfatkininit_i(mf, Q, 0, prec), MQ = gel(mfa,2);
    8076          70 :   long i, FC, k = MF_get_k(mf);
    8077          70 :   GEN x, v, V, z, s, CHI = mfchartoprimitive(MF_get_CHI(mf), &FC);
    8078             : 
    8079             :   /* V = mfcoefs(F | w_Q, n), can't use mfatkin because MQ non-rational */
    8080          70 :   V = RgM_RgC_mul(mfcoefs_mf(mf,n,1), RgM_RgC_mul(MQ, mftobasis_i(mf,F)));
    8081          70 :   (void)bezout(utoipos(Q), C, &x, &v);
    8082          70 :   s = mfchareval(CHI, (umodiu(x, FC) * umodiu(D, FC)) % FC);
    8083          70 :   s = gdiv(s, gpow(utoipos(Q), sstoQ(k,2), prec));
    8084          70 :   V = RgV_Rg_mul(V, s);
    8085          70 :   z = rootsof1powinit(umodiu(D,Q)*umodiu(v,Q) % Q, Q, prec);
    8086        8253 :   for (i = 1; i <= n+1; i++) gel(V,i) = gmul(gel(V,i), rootsof1pow(z, i-1));
    8087          70 :   return mkvec3(gen_0, utoipos(Q), V);
    8088             : }
    8089             : 
    8090             : static long
    8091          70 : inveis_extraprec(long N, GEN ga, GEN Mvecj, long n)
    8092             : {
    8093          70 :   long e, w = mfZC_width(N, gel(ga,1));
    8094          70 :   GEN f, E = gel(Mvecj,2), v = mfeisensteingacx(E, w, ga, n, DEFAULTPREC);
    8095          70 :   v = gel(v,2);
    8096          70 :   f = RgV_to_RgX(v,0); n -= RgX_valrem(f, &f);
    8097          70 :   e = gexpo(RgXn_inv(f, n+1));
    8098          70 :   return (e > 0)? nbits2extraprec(e): 0;
    8099             : }
    8100             : /* allow F of the form [F, mf_eisendec(F)]~ */
    8101             : static GEN
    8102        1666 : mfgaexpansion(GEN mf, GEN F, GEN ga, long n, long prec)
    8103             : {
    8104        1666 :   GEN v, EF = NULL, res, Mvecj, c, d;
    8105             :   long precnew, N;
    8106             : 
    8107        1666 :   if (n < 0) pari_err_DOMAIN("mfgaexpansion", "n", "<", gen_0, stoi(n));
    8108        1666 :   if (typ(F) == t_COL && lg(F) == 3) { EF = gel(F,2); F = gel(F,1); }
    8109        1666 :   if (!checkmf_i(F)) pari_err_TYPE("mfgaexpansion", F);
    8110        1666 :   if (!check_SL2Z(ga)) pari_err_TYPE("mfgaexpansion",ga);
    8111        1666 :   if (typ(mf_get_gk(F)) != t_INT) return mf2gaexpansion(mf, F, ga, n, prec);
    8112        1365 :   c = gcoeff(ga,2,1);
    8113        1365 :   d = gcoeff(ga,2,2);
    8114        1365 :   N = MF_get_N(mf);
    8115        1365 :   if (!umodiu(c, mf_get_N(F)))
    8116             :   { /* trivial case: ga in Gamma_0(N) */
    8117         287 :     long w = mfcuspcanon_width(N, umodiu(c,N));
    8118         287 :     GEN CHI = mf_get_CHI(F);
    8119         287 :     GEN chid = mfcharcxeval(CHI, umodiu(d,mfcharmodulus(CHI)), prec);
    8120         287 :     v = mfcoefs_i(F, n/w, 1); if (!isint1(chid)) v = RgV_Rg_mul(v,chid);
    8121         287 :     return mkvec3(gen_0, stoi(w), bdexpandall(v,w,n+1));
    8122             :   }
    8123        1078 :   mf = MF_set_new(mf);
    8124        1078 :   if (MF_get_space(mf) == mf_NEW)
    8125             :   {
    8126         441 :     long cN = umodiu(c,N), g = ugcd(cN,N), Q = N/g;
    8127         441 :     GEN CHI = MF_get_CHI(mf);
    8128         441 :     if (ugcd(cN, Q)==1 && mfcharorder(CHI) <= 2
    8129         217 :                        && g % mfcharconductor(CHI) == 0
    8130         112 :                        && degpol(mf_get_field(F)) == 1)
    8131          70 :       return mfgaexpansionatkin(mf, F, c, d, Q, n, prec);
    8132             :   }
    8133        1008 :   Mvecj = obj_checkbuild(mf, MF_EISENSPACE, &mfeisensteinspaceinit);
    8134        1008 :   precnew = prec;
    8135        1008 :   if (lg(Mvecj) < 5) precnew += inveis_extraprec(N, ga, Mvecj, n);
    8136        1008 :   if (!EF) EF = mf_eisendec(mf, F, precnew);
    8137        1008 :   res = mfgaexpansion_i(mf, EF, ga, n, precnew);
    8138        1008 :   return precnew == prec ? res : gprec_wtrunc(res, prec);
    8139             : }
    8140             : 
    8141             : /* parity = -1 or +1 */
    8142             : static GEN
    8143         217 : findd(long N, long parity)
    8144             : {
    8145         217 :   GEN L, D = mydivisorsu(N);
    8146         217 :   long i, j, l = lg(D);
    8147         217 :   L = cgetg(l, t_VEC);
    8148        1218 :   for (i = j = 1; i < l; i++)
    8149             :   {
    8150        1001 :     long d = D[i];
    8151        1001 :     if (parity == -1) d = -d;
    8152        1001 :     if (sisfundamental(d)) gel(L,j++) = stoi(d);
    8153             :   }
    8154         217 :   setlg(L,j); return L;
    8155             : }
    8156             : /* does ND contain a divisor of N ? */
    8157             : static int
    8158         413 : seenD(long N, GEN ND)
    8159             : {
    8160         413 :   long j, l = lg(ND);
    8161         427 :   for (j = 1; j < l; j++)
    8162          14 :     if (N % ND[j] == 0) return 1;
    8163         413 :   return 0;
    8164             : }
    8165             : static GEN
    8166          42 : search_levels(GEN vN, const char *f)
    8167             : {
    8168          42 :   switch(typ(vN))
    8169             :   {
    8170           7 :     case t_INT: vN = mkvecsmall(itos(vN)); break;
    8171          35 :     case t_VEC: case t_COL: vN = ZV_to_zv(vN); break;
    8172           0 :     case t_VECSMALL: vN = leafcopy(vN); break;
    8173           0 :     default: pari_err_TYPE(f, vN);
    8174             :   }
    8175          42 :   vecsmall_sort(vN); return vN;
    8176             : }
    8177             : GEN
    8178          14 : mfsearch(GEN NK, GEN V, long space)
    8179             : {
    8180          14 :   pari_sp av = avma;
    8181             :   GEN F, gk, NbyD, vN;
    8182             :   long n, nk, dk, parity, nV, i, lvN;
    8183             : 
    8184          14 :   if (typ(NK) != t_VEC || lg(NK) != 3) pari_err_TYPE("mfsearch", NK);
    8185          14 :   gk = gel(NK,2);
    8186          14 :   if (typ(gmul2n(gk, 1)) != t_INT) pari_err_TYPE("mfsearch [k]", gk);
    8187          14 :   switch(typ(V))
    8188             :   {
    8189          14 :     case t_VEC: V = shallowtrans(V);
    8190          14 :     case t_COL: break;
    8191           0 :     default: pari_err_TYPE("mfsearch [V]", V);
    8192             :   }
    8193          14 :   vN = search_levels(gel(NK,1), "mfsearch [N]");
    8194          14 :   lvN = lg(vN);
    8195             : 
    8196          14 :   Qtoss(gk, &nk,&dk);
    8197          14 :   parity = (dk == 1 && odd(nk)) ? -1 : 1;
    8198          14 :   nV = lg(V)-2;
    8199          14 :   F = cgetg(1, t_VEC);
    8200          14 :   NbyD = const_vec(vN[lvN-1], cgetg(1,t_VECSMALL));
    8201         231 :   for (n = 1; n < lvN; n++)
    8202             :   {
    8203         217 :     long N = vN[n];
    8204             :     GEN L;
    8205         217 :     if (N <= 0 || (dk == 2 && (N & 3))) continue;
    8206         217 :     L = findd(N, parity);
    8207         630 :     for (i = 1; i < lg(L); i++)
    8208             :     {
    8209         413 :       GEN mf, M, CO, gD = gel(L,i);
    8210         413 :       GEN *ND = (GEN*)NbyD + itou(gD); /* points to NbyD[|D|] */
    8211             : 
    8212         413 :       if (seenD(N, *ND)) continue;
    8213         413 :       mf = mfinit_Nndkchi(N, nk, dk, get_mfchar(gD), space, 1);
    8214         413 :       M = mfcoefs_mf(mf, nV, 1);
    8215         413 :       CO = inverseimage(M, V); if (lg(CO) == 1) continue;
    8216             : 
    8217          42 :       F = vec_append(F, mflinear(mf,CO));
    8218          42 :       *ND = vecsmall_append(*ND, N); /* add to NbyD[|D|] */
    8219             :     }
    8220             :   }
    8221          14 :   return gerepilecopy(av, F);
    8222             : }
    8223             : 
    8224             : static GEN
    8225         882 : search_from_split(GEN mf, GEN vap, GEN vlp)
    8226             : {
    8227         882 :   pari_sp av = avma;
    8228         882 :   long lvlp = lg(vlp), j, jv, l1;
    8229         882 :   GEN v, NK, S1, S, M = NULL;
    8230             : 
    8231         882 :   S1 = gel(split_i(mf, 1, 0), 1); /* rational newforms */
    8232         882 :   l1 = lg(S1);
    8233         882 :   if (l1 == 1) return gc_NULL(av);
    8234         448 :   v = cgetg(l1, t_VEC);
    8235         448 :   S = MF_get_S(mf);
    8236         448 :   NK = mf_get_NK(gel(S,1));
    8237         448 :   if (lvlp > 1) M = rowpermute(mfcoefs_mf(mf, vlp[lvlp-1], 1), vlp);
    8238         966 :   for (j = jv = 1; j < l1; j++)
    8239             :   {
    8240         518 :     GEN vF = gel(S1,j);
    8241             :     long t;
    8242         651 :     for (t = lvlp-1; t > 0; t--)
    8243             :     { /* lhs = vlp[j]-th coefficient of eigenform */
    8244         595 :       GEN rhs = gel(vap,t), lhs = RgMrow_RgC_mul(M, vF, t);
    8245         595 :       if (!gequal(lhs, rhs)) break;
    8246             :     }
    8247         518 :     if (!t) gel(v,jv++) = mflinear_i(NK,S,vF);
    8248             :   }
    8249         448 :   if (jv == 1) return gc_NULL(av);
    8250          56 :   setlg(v,jv); return v;
    8251             : }
    8252             : GEN
    8253          28 : mfeigensearch(GEN NK, GEN AP)
    8254             : {
    8255          28 :   pari_sp av = avma;
    8256          28 :   GEN k, vN, vap, vlp, vres = cgetg(1, t_VEC), D;
    8257             :   long n, lvN, i, l, even;
    8258             : 
    8259          28 :   if (!AP) l = 1;
    8260             :   else
    8261             :   {
    8262          28 :     l = lg(AP);
    8263          28 :     if (typ(AP) != t_VEC) pari_err_TYPE("mfeigensearch",AP);
    8264             :   }
    8265          28 :   vap = cgetg(l, t_VEC);
    8266          28 :   vlp = cgetg(l, t_VECSMALL);
    8267          28 :   if (l > 1)
    8268             :   {
    8269          28 :     GEN perm = indexvecsort(AP, mkvecsmall(1));
    8270          77 :     for (i = 1; i < l; i++)
    8271             :     {
    8272          49 :       GEN v = gel(AP,perm[i]), gp, ap;
    8273          49 :       if (typ(v) != t_VEC || lg(v) != 3) pari_err_TYPE("mfeigensearch", AP);
    8274          49 :       gp = gel(v,1);
    8275          49 :       ap = gel(v,2);
    8276          49 :       if (typ(gp) != t_INT || (typ(ap) != t_INT && typ(ap) != t_INTMOD))
    8277           0 :         pari_err_TYPE("mfeigensearch", AP);
    8278          49 :       gel(vap,i) = ap;
    8279          49 :       vlp[i] = itos(gp)+1; if (vlp[i] < 0) pari_err_TYPE("mfeigensearch", AP);
    8280             :     }
    8281             :   }
    8282          28 :   l = lg(NK);
    8283          28 :   if (typ(NK) != t_VEC || l != 3) pari_err_TYPE("mfeigensearch",NK);
    8284          28 :   k = gel(NK,2);
    8285          28 :   vN = search_levels(gel(NK,1), "mfeigensearch [N]");
    8286          28 :   lvN = lg(vN);
    8287          28 :   vecsmall_sort(vlp);
    8288          28 :   even = !mpodd(k);
    8289         966 :   for (n = 1; n < lvN; n++)
    8290             :   {
    8291         938 :     pari_sp av2 = avma;
    8292             :     GEN mf, L;
    8293         938 :     long N = vN[n];
    8294         938 :     if (even) D = gen_1;
    8295             :     else
    8296             :     {
    8297         112 :       long r = (N&3L);
    8298         112 :       if (r == 1 || r == 2) continue;
    8299          56 :       D = stoi( corediscs(-N, NULL) ); /* < 0 */
    8300             :     }
    8301         882 :     mf = mfinit_i(mkvec3(utoipos(N), k, D), mf_NEW);
    8302         882 :     L = search_from_split(mf, vap, vlp);
    8303         882 :     if (L) vres = shallowconcat(vres, L); else set_avma(av2);
    8304             :   }
    8305          28 :   return gerepilecopy(av, vres);
    8306             : }
    8307             : 
    8308             : /* tf_{N,k}(n) */
    8309             : static GEN
    8310     3174332 : mfnewtracecache(long N, long k, long n, cachenew_t *cache)
    8311             : {
    8312     3174332 :   GEN C = NULL, S;
    8313             :   long lcache;
    8314     3174332 :   if (!n) return gen_0;
    8315     3070053 :   S = gel(cache->vnew,N);
    8316     3070053 :   lcache = lg(S);
    8317     3070053 :   if (n < lcache) C = gel(S, n);
    8318     3070053 :   if (C) cache->newHIT++;
    8319     1921031 :   else C = mfnewtrace_i(N,k,n,cache);
    8320     3070053 :   cache->newTOTAL++;
    8321     3070053 :   if (n < lcache) gel(S,n) = C;
    8322     3070053 :   return C;
    8323             : }
    8324             : 
    8325             : static long
    8326        1386 : mfdim_Nkchi(long N, long k, GEN CHI, long space)
    8327             : {
    8328        1386 :   if (k < 0 || badchar(N,k,CHI)) return 0;
    8329        1085 :   if (k == 0)
    8330          35 :     return mfcharistrivial(CHI) && !space_is_cusp(space)? 1: 0;
    8331        1050 :   switch(space)
    8332             :   {
    8333         238 :     case mf_NEW: return mfnewdim(N,k,CHI);
    8334         196 :     case mf_CUSP:return mfcuspdim(N,k,CHI);
    8335         168 :     case mf_OLD: return mfolddim(N,k,CHI);
    8336         217 :     case mf_FULL:return mffulldim(N,k,CHI);
    8337         231 :     case mf_EISEN: return mfeisensteindim(N,k,CHI);
    8338           0 :     default: pari_err_FLAG("mfdim");
    8339             :   }
    8340             :   return 0;/*LCOV_EXCL_LINE*/
    8341             : }
    8342             : static long
    8343        2114 : mfwt1dimsum(long N, long space)
    8344             : {
    8345        2114 :   switch(space)
    8346             :   {
    8347        1050 :     case mf_NEW:  return mfwt1newdimsum(N);
    8348        1057 :     case mf_CUSP: return mfwt1cuspdimsum(N);
    8349           7 :     case mf_OLD:  return mfwt1olddimsum(N);
    8350             :   }
    8351           0 :   pari_err_FLAG("mfdim");
    8352             :   return 0; /*LCOV_EXCL_LINE*/
    8353             : }
    8354             : /* mfdim for k = nk/dk */
    8355             : static long
    8356       44744 : mfdim_Nndkchi(long N, long nk, long dk, GEN CHI, long space)
    8357       43463 : { return (dk == 2)? mf2dim_Nkchi(N, nk >> 1, CHI, space)
    8358       88186 :                   : mfdim_Nkchi(N, nk, CHI, space); }
    8359             : /* FIXME: use direct dim Gamma1(N) formula, don't compute individual spaces */
    8360             : static long
    8361         252 : mfwtkdimsum(long N, long k, long dk, long space)
    8362             : {
    8363         252 :   GEN w = mfchars(N, k, dk, NULL);
    8364         252 :   long i, j, D = 0, l = lg(w);
    8365        1239 :   for (i = j = 1; i < l; i++)
    8366             :   {
    8367         987 :     GEN CHI = gel(w,i);
    8368         987 :     long d = mfdim_Nndkchi(N,k,dk,CHI,space);
    8369         987 :     if (d) D += d * myeulerphiu(mfcharorder(CHI));
    8370             :   }
    8371         252 :   return D;
    8372             : }
    8373             : static GEN
    8374         105 : mfwt1dims(long N, GEN vCHI, long space)
    8375             : {
    8376         105 :   GEN D = NULL;
    8377         105 :   switch(space)
    8378             :   {
    8379          56 :     case mf_NEW: D = mfwt1newdimall(N, vCHI); break;
    8380          21 :     case mf_CUSP:D = mfwt1cuspdimall(N, vCHI); break;
    8381          28 :     case mf_OLD: D = mfwt1olddimall(N, vCHI); break;
    8382           0 :     default: pari_err_FLAG("mfdim");
    8383             :   }
    8384         105 :   return D;
    8385             : }
    8386             : static GEN
    8387        2961 : mfwtkdims(long N, long k, long dk, GEN vCHI, long space)
    8388             : {
    8389        2961 :   GEN D, w = mfchars(N, k, dk, vCHI);
    8390        2961 :   long i, j, l = lg(w);
    8391        2961 :   D = cgetg(l, t_VEC);
    8392       46592 :   for (i = j = 1; i < l; i++)
    8393             :   {
    8394       43631 :     GEN CHI = gel(w,i);
    8395       43631 :     long d = mfdim_Nndkchi(N,k,dk,CHI,space);
    8396       43631 :     if (vCHI)
    8397         574 :       gel(D, j++) = mkvec2s(d, 0);
    8398       43057 :     else if (d)
    8399        2520 :       gel(D, j++) = fmt_dim(CHI, d, 0);
    8400             :   }
    8401        2961 :   setlg(D,j); return D;
    8402             : }
    8403             : GEN
    8404        5719 : mfdim(GEN NK, long space)
    8405             : {
    8406        5719 :   pari_sp av = avma;
    8407             :   long N, k, dk, joker;
    8408             :   GEN CHI, mf;
    8409        5719 :   if ((mf = checkMF_i(NK))) return utoi(MF_get_dim(mf));
    8410        5586 :   checkNK2(NK, &N, &k, &dk, &CHI, 2);
    8411        5586 :   if (!CHI) joker = 1;
    8412             :   else
    8413        2611 :     switch(typ(CHI))
    8414             :     {
    8415        2373 :       case t_INT: joker = 2; break;
    8416         112 :       case t_COL: joker = 3; break;
    8417         126 :       default: joker = 0; break;
    8418             :     }
    8419        5586 :   if (joker)
    8420             :   {
    8421             :     long d;
    8422             :     GEN D;
    8423        5460 :     if (k < 0) switch(joker)
    8424             :     {
    8425           0 :       case 1: return cgetg(1,t_VEC);
    8426           7 :       case 2: return gen_0;
    8427           0 :       case 3: return mfdim0all(CHI);
    8428             :     }
    8429        5453 :     if (k == 0)
    8430             :     {
    8431          28 :       if (space_is_cusp(space)) switch(joker)
    8432             :       {
    8433           7 :         case 1: return cgetg(1,t_VEC);
    8434           0 :         case 2: return gen_0;
    8435           7 :         case 3: return mfdim0all(CHI);
    8436             :       }
    8437          14 :       switch(joker)
    8438             :       {
    8439             :         long i, l;
    8440           7 :         case 1: retmkvec(fmt_dim(mfchartrivial(),0,0));
    8441           0 :         case 2: return gen_1;
    8442           7 :         case 3: l = lg(CHI); D = cgetg(l,t_VEC);
    8443          35 :                 for (i = 1; i < l; i++)
    8444             :                 {
    8445          28 :                   long t = mfcharistrivial(gel(CHI,i));
    8446          28 :                   gel(D,i) = mkvec2(t? gen_1: gen_0, gen_0);
    8447             :                 }
    8448           7 :                 return D;
    8449             :       }
    8450             :     }
    8451        5425 :     if (dk == 1 && k == 1 && space != mf_EISEN)
    8452         105 :     {
    8453        2219 :       long fix = 0, space0 = space;
    8454        2219 :       if (space == mf_FULL) space = mf_CUSP; /* remove Eisenstein part */
    8455        2219 :       if (joker == 2)
    8456             :       {
    8457        2114 :         d = mfwt1dimsum(N, space);
    8458        2114 :         if (space0 == mf_FULL) d += mfwtkdimsum(N,k,dk,mf_EISEN);/*add it back*/
    8459        2114 :         set_avma(av); return utoi(d);
    8460             :       }
    8461             :       /* must initialize explicitly: trivial spaces for E_k/S_k differ */
    8462         105 :       if (space0 == mf_FULL)
    8463             :       {
    8464           7 :         if (!CHI) fix = 1; /* must remove 0 spaces */
    8465           7 :         CHI = mfchars(N, k, dk, CHI);
    8466             :       }
    8467         105 :       D = mfwt1dims(N, CHI, space);
    8468         105 :       if (space0 == mf_FULL)
    8469             :       {
    8470           7 :         GEN D2 = mfwtkdims(N, k, dk, CHI, mf_EISEN);
    8471           7 :         D = merge_dims(D, D2, fix? CHI: NULL);
    8472             :       }
    8473             :     }
    8474             :     else
    8475             :     {
    8476        3206 :       if (joker==2) { d = mfwtkdimsum(N,k,dk,space); set_avma(av); return utoi(d); }
    8477        2954 :       D = mfwtkdims(N, k, dk, CHI, space);
    8478             :     }
    8479        3059 :     if (!CHI) return gerepileupto(av, vecsort(D, mkvecsmall(1)));
    8480         105 :     return gerepilecopy(av, D);
    8481             :   }
    8482         126 :   return utoi( mfdim_Nndkchi(N, k, dk, CHI, space) );
    8483             : }
    8484             : 
    8485             : GEN
    8486         315 : mfbasis(GEN NK, long space)
    8487             : {
    8488         315 :   pari_sp av = avma;
    8489             :   long N, k, dk;
    8490             :   GEN mf, CHI;
    8491         315 :   if ((mf = checkMF_i(NK))) return concat(gel(mf,2), gel(mf,3));
    8492           7 :   checkNK2(NK, &N, &k, &dk, &CHI, 0);
    8493           7 :   if (dk == 2) return gerepilecopy(av, mf2basis(N, k>>1, CHI, NULL, space));
    8494           7 :   mf = mfinit_Nkchi(N, k, CHI, space, 1);
    8495           7 :   return gerepilecopy(av, MF_get_basis(mf));
    8496             : }
    8497             : 
    8498             : static GEN
    8499          49 : deg1ser_shallow(GEN a1, GEN a0, long v, long e)
    8500          49 : { return RgX_to_ser(deg1pol_shallow(a1, a0, v), e+2); }
    8501             : /* r / x + O(1) */
    8502             : static GEN
    8503          49 : simple_pole(GEN r)
    8504             : {
    8505          49 :   GEN S = deg1ser_shallow(gen_0, r, 0, 1);
    8506          49 :   setvalp(S, -1); return S;
    8507             : }
    8508             : 
    8509             : /* F form, E embedding; mfa = mfatkininit or root number (eigenform case) */
    8510             : static GEN
    8511         154 : mflfuncreate(GEN mfa, GEN F, GEN E, GEN N, GEN gk)
    8512             : {
    8513         154 :   GEN LF = cgetg(8,t_VEC), polar = cgetg(1,t_COL), eps;
    8514         154 :   long k = itou(gk);
    8515         154 :   gel(LF,1) = lfuntag(t_LFUN_MFCLOS, mkvec3(F,E,gen_1));
    8516         154 :   if (typ(mfa) != t_VEC)
    8517          98 :     eps = mfa; /* cuspidal eigenform: root number; no poles */
    8518             :   else
    8519             :   { /* mfatkininit */
    8520          56 :     GEN a0, b0, vF, vG, G = NULL;
    8521          56 :     GEN M = gel(mfa,2), C = gel(mfa,3), mf = gel(mfa,4);
    8522          56 :     M = gdiv(mfmatembed(E, M), C);
    8523          56 :     vF = mfvecembed(E, mftobasis_i(mf, F));
    8524          56 :     vG = RgM_RgC_mul(M, vF);
    8525          56 :     if (gequal(vF,vG)) eps = gen_1;
    8526          42 :     else if (gequal(vF,gneg(vG))) eps = gen_m1;
    8527             :     else
    8528             :     { /* not self-dual */
    8529          42 :       eps = NULL;
    8530          42 :       G = mfatkin(mfa, F);
    8531          42 :       gel(LF,2) = lfuntag(t_LFUN_MFCLOS, mkvec3(G,E,ginv(C)));
    8532          42 :       gel(LF,6) = powIs(k);
    8533             :     }
    8534             :     /* polar part */
    8535          56 :     a0 = mfembed(E, mfcoef(F,0));
    8536          56 :     b0 = eps? gmul(eps,a0): gdiv(mfembed(E, mfcoef(G,0)), C);
    8537          56 :     if (!gequal0(b0))
    8538             :     {
    8539          28 :       b0 = mulcxpowIs(gmul2n(b0,1), k);
    8540          28 :       polar = vec_append(polar, mkvec2(gk, simple_pole(b0)));
    8541             :     }
    8542          56 :     if (!gequal0(a0))
    8543             :     {
    8544          21 :       a0 = gneg(gmul2n(a0,1));
    8545          21 :       polar = vec_append(polar, mkvec2(gen_0, simple_pole(a0)));
    8546             :     }
    8547             :   }
    8548         154 :   if (eps) /* self-dual */
    8549             :   {
    8550         112 :     gel(LF,2) = mfcharorder(mf_get_CHI(F)) <= 2? gen_0: gen_1;
    8551         112 :     gel(LF,6) = mulcxpowIs(eps,k);
    8552             :   }
    8553         154 :   gel(LF,3) = mkvec2(gen_0, gen_1);
    8554         154 :   gel(LF,4) = gk;
    8555         154 :   gel(LF,5) = N;
    8556         154 :   if (lg(polar) == 1) setlg(LF,7); else gel(LF,7) = polar;
    8557         154 :   return LF;
    8558             : }
    8559             : static GEN
    8560         126 : mflfuncreateall(long sd, GEN mfa, GEN F, GEN vE, GEN gN, GEN gk)
    8561             : {
    8562         126 :   long i, l = lg(vE);
    8563         126 :   GEN L = cgetg(l, t_VEC);
    8564         280 :   for (i = 1; i < l; i++)
    8565         154 :     gel(L,i) = mflfuncreate(sd? gel(mfa,i): mfa, F, gel(vE,i), gN, gk);
    8566         126 :   return L;
    8567             : }
    8568             : GEN
    8569          77 : lfunmf(GEN mf, GEN F, long bitprec)
    8570             : {
    8571          77 :   pari_sp av = avma;
    8572          77 :   long i, l, prec = nbits2prec(bitprec);
    8573             :   GEN L, gk, gN;
    8574          77 :   mf = checkMF(mf);
    8575          77 :   gk = MF_get_gk(mf);
    8576          77 :   gN = MF_get_gN(mf);
    8577          77 :   if (typ(gk)!=t_INT) pari_err_IMPL("half-integral weight");
    8578          77 :   if (F)
    8579             :   {
    8580             :     GEN v;
    8581          70 :     long s = MF_get_space(mf);
    8582          70 :     if (!checkmf_i(F)) pari_err_TYPE("lfunmf", F);
    8583          70 :     if (!mfisinspace_i(mf, F)) err_space(F);
    8584          70 :     L = NULL;
    8585          70 :     if ((s == mf_NEW || s == mf_CUSP || s == mf_FULL)
    8586          56 :         && gequal(mfcoefs_i(F,1,1), mkvec2(gen_0,gen_1)))
    8587             :     { /* check if eigenform */
    8588          35 :       GEN vP, vF, b = mftobasis_i(mf, F);
    8589          35 :       long lF, d = degpol(mf_get_field(F));
    8590          35 :       v = mfsplit(mf, d, 0);
    8591          35 :       vF = gel(v,1);
    8592          35 :       vP = gel(v,2); lF = lg(vF);
    8593          35 :       for (i = 1; i < lF; i++)
    8594          28 :         if (degpol(gel(vP,i)) == d && gequal(gel(vF,i), b))
    8595             :         {
    8596          28 :           GEN vE = mfgetembed(F, prec);
    8597          28 :           GEN Z = mffrickeeigen_i(mf, mkvec(b), mkvec(vE), prec);
    8598          28 :           L = mflfuncreateall(1, gel(Z,1), F, vE, gN, gk);
    8599          28 :           break;
    8600             :         }
    8601             :     }
    8602          70 :     if (!L)
    8603             :     { /* not an eigenform: costly general case */
    8604          42 :       GEN mfa = mfatkininit_i(mf, itou(gN), 1, prec);
    8605          42 :       L = mflfuncreateall(0,mfa, F, mfgetembed(F,prec), gN, gk);
    8606             :     }
    8607          70 :     if (lg(L) == 2) L = gel(L,1);
    8608             :   }
    8609             :   else
    8610             :   {
    8611           7 :     GEN M = mfeigenbasis(mf), vE = mfeigenembed(mf, prec);
    8612           7 :     GEN v = mffrickeeigen(mf, vE, prec);
    8613           7 :     l = lg(vE); L = cgetg(l, t_VEC);
    8614          63 :     for (i = 1; i < l; i++)
    8615          56 :       gel(L,i) = mflfuncreateall(1,gel(v,i), gel(M,i), gel(vE,i), gN, gk);
    8616             :   }
    8617          77 :   return gerepilecopy(av, L);
    8618             : }
    8619             : 
    8620             : GEN
    8621          28 : mffromell(GEN E)
    8622             : {
    8623          28 :   pari_sp av = avma;
    8624             :   GEN mf, F, z, v, S;
    8625             :   long N, i, l;
    8626             : 
    8627          28 :   checkell(E);
    8628          28 :   if (ell_get_type(E) != t_ELL_Q) pari_err_TYPE("mfffromell [E not over Q]", E);
    8629          28 :   N = itos(ellQ_get_N(E));
    8630          28 :   mf = mfinit_i(mkvec2(utoi(N), gen_2), mf_NEW);
    8631          28 :   v = split_i(mf, 1, 0);
    8632          28 :   S = gel(v,1); l = lg(S); /* rational newforms */
    8633          28 :   F = tag(t_MF_ELL, mkNK(N,2,mfchartrivial()), E);
    8634          28 :   z = mftobasis_i(mf, F);
    8635          28 :   for(i = 1; i < l; i++)
    8636          28 :     if (gequal(z, gel(S,i))) break;
    8637          28 :   if (i == l) pari_err_BUG("mffromell [E is not modular]");
    8638          28 :   return gerepilecopy(av, mkvec3(mf, F, z));
    8639             : }
    8640             : 
    8641             : /* returns -1 if not, degree otherwise */
    8642             : long
    8643          98 : polishomogeneous(GEN P)
    8644             : {
    8645             :   long i, D, l;
    8646          98 :   if (typ(P) != t_POL) return 0;
    8647          49 :   D = -1; l = lg(P);
    8648         231 :   for (i = 2; i < l; i++)
    8649             :   {
    8650         182 :     GEN c = gel(P,i);
    8651             :     long d;
    8652         182 :     if (gequal0(c)) continue;
    8653          84 :     d = polishomogeneous(c);
    8654          84 :     if (d < 0) return -1;
    8655          84 :     if (D < 0) D = d + i-2; else if (D != d + i-2) return -1;
    8656             :   }
    8657          49 :   return D;
    8658             : }
    8659             : 
    8660             : /* P a t_POL, 1 if spherical, 0 otherwise */
    8661             : static int
    8662          14 : RgX_isspherical(GEN Qi, GEN P)
    8663             : {
    8664          14 :   pari_sp av = avma;
    8665             :   GEN va, S;
    8666             :   long lva, i, j;
    8667          14 :   if (degpol(P) <= 1) return 1;
    8668          14 :   va = variables_vecsmall(P); lva = lg(va);
    8669          14 :   if (lva > lg(Qi)) pari_err(e_MISC, "too many variables in mffromqf");
    8670          14 :   S = gen_0;
    8671          42 :   for (j = 1; j < lva; j++)
    8672             :   {
    8673          28 :     GEN col = gel(Qi, j), Pj = deriv(P, va[j]);
    8674          70 :     for (i = 1; i <= j; i++)
    8675             :     {
    8676          42 :       GEN coe = gel(col, i);
    8677          42 :       if (i != j) coe = gmul2n(coe, 1);
    8678          42 :       if (!gequal0(coe)) S = gadd(S, gmul(coe, deriv(Pj, va[i])));
    8679             :     }
    8680             :   }
    8681          14 :   return gc_bool(av, gequal0(S));
    8682             : }
    8683             : 
    8684             : static GEN
    8685          49 : c_QFsimple_i(long n, GEN Q, GEN P)
    8686             : {
    8687          49 :   GEN V, v = qfrep0(Q, utoi(n), 1);
    8688          49 :   long i, l = lg(v);
    8689          49 :   V = cgetg(l+1, t_VEC);
    8690          91 :   if (!P || equali1(P))
    8691             :   {
    8692          42 :     gel(V,1) = gen_1;
    8693         420 :     for (i = 2; i <= l; i++) gel(V,i) = utoi(v[i-1] << 1);
    8694             :   }
    8695             :   else
    8696             :   {
    8697           7 :     gel(V,1) = gcopy(P);
    8698           7 :     for (i = 2; i <= l; i++) gel(V,i) = gmulgs(P, v[i-1] << 1);
    8699             :   }
    8700          49 :   return V;
    8701             : }
    8702             : 
    8703             : /* v a t_VECSMALL of variable numbers, lg(r) >= lg(v), r is a vector of
    8704             :  * scalars [not involving any variable in v] */
    8705             : static GEN
    8706          14 : gsubstvec_i(GEN e, GEN v, GEN r)
    8707             : {
    8708          14 :   long i, l = lg(v);
    8709          42 :   for(i = 1; i < l; i++) e = gsubst(e, v[i], gel(r,i));
    8710          14 :   return e;
    8711             : }
    8712             : static GEN
    8713          56 : c_QF_i(long n, GEN Q, GEN P)
    8714             : {
    8715          56 :   pari_sp av = avma;
    8716             :   GEN V, v, va;
    8717             :   long i, l;
    8718          56 :   if (!P || typ(P) != t_POL) return gerepileupto(av, c_QFsimple_i(n, Q, P));
    8719           7 :   v = gel(minim(Q, utoi(2*n), NULL), 3);
    8720           7 :   va = variables_vecsmall(P);
    8721           7 :   V = zerovec(n + 1); l = lg(v);
    8722          21 :   for (i = 1; i < l; i++)
    8723             :   {
    8724          14 :     pari_sp av = avma;
    8725          14 :     GEN X = gel(v,i);
    8726          14 :     long c = (itos(qfeval(Q, X)) >> 1) + 1;
    8727          14 :     gel(V, c) = gerepileupto(av, gadd(gel(V, c), gsubstvec_i(P, va, X)));
    8728             :   }
    8729           7 :   return gmul2n(V, 1);
    8730             : }
    8731             : 
    8732             : GEN
    8733          63 : mffromqf(GEN Q, GEN P)
    8734             : {
    8735          63 :   pari_sp av = avma;
    8736             :   GEN G, Qi, F, D, N, mf, v, gk, chi;
    8737             :   long m, d, space;
    8738          63 :   if (typ(Q) != t_MAT) pari_err_TYPE("mffromqf", Q);
    8739          63 :   if (!RgM_is_ZM(Q) || !qfiseven(Q))
    8740           0 :     pari_err_TYPE("mffromqf [not integral or even]", Q);
    8741          63 :   m = lg(Q)-1;
    8742          63 :   Qi = ZM_inv(Q, &N);
    8743          63 :   if (!qfiseven(Qi)) N = shifti(N, 1);
    8744          63 :   d = 0;
    8745          63 :   if (!P || gequal1(P)) P = NULL;
    8746             :   else
    8747             :   {
    8748          21 :     P = simplify_shallow(P);
    8749          21 :     if (typ(P) == t_POL)
    8750             :     {
    8751          14 :       d = polishomogeneous(P);
    8752          14 :       if (d < 0) pari_err_TYPE("mffromqf [not homogeneous t_POL]", P);
    8753          14 :       if (!RgX_isspherical(Qi, P))
    8754           0 :         pari_err_TYPE("mffromqf [not a spherical t_POL]", P);
    8755             :     }
    8756             :   }
    8757          63 :   gk = sstoQ(m + 2*d, 2);
    8758          63 :   D = ZM_det(Q);
    8759          63 :   if (!odd(m)) { if ((m & 3) == 2) D = negi(D); } else D = shifti(D, 1);
    8760          63 :   space = d > 0 ? mf_CUSP : mf_FULL;
    8761          63 :   G = znstar0(N,1);
    8762          63 :   chi = mkvec2(G, znchar_quad(G,D));
    8763          63 :   mf = mfinit(mkvec3(N, gk, chi), space);
    8764          63 :   if (odd(d))
    8765             :   {
    8766           7 :     F = mftrivial();
    8767           7 :     v = zerocol(MF_get_dim(mf));
    8768             :   }
    8769             :   else
    8770             :   {
    8771          56 :     F = c_QF_i(mfsturm(mf), Q, P);
    8772          56 :     v = mftobasis_i(mf, F);
    8773          56 :     F = mflinear(mf, v);
    8774             :   }
    8775          63 :   return gerepilecopy(av, mkvec3(mf, F, v));
    8776             : }
    8777             : 
    8778             : /***********************************************************************/
    8779             : /*                          Eisenstein Series                          */
    8780             : /***********************************************************************/
    8781             : /* \sigma_{k-1}(\chi,n) */
    8782             : static GEN
    8783       23996 : sigchi(long k, GEN CHI, long n)
    8784             : {
    8785       23996 :   pari_sp av = avma;
    8786       23996 :   GEN S = gen_1, D = mydivisorsu(u_ppo(n,mfcharmodulus(CHI)));
    8787       23996 :   long i, l = lg(D), ord = mfcharorder(CHI), vt = varn(mfcharpol(CHI));
    8788       83279 :   for (i = 2; i < l; i++) /* skip D[1] = 1 */
    8789             :   {
    8790       59283 :     long d = D[i], a = mfcharevalord(CHI, d, ord);
    8791       59283 :     S = gadd(S, Qab_Czeta(a, ord, powuu(d, k-1), vt));
    8792             :   }
    8793       23996 :   return gerepileupto(av,S);
    8794             : }
    8795             : 
    8796             : /* write n = n0*n1*n2, (n0,N1*N2) = 1, n1 | N1^oo, n2 | N2^oo;
    8797             :  * return NULL if (n,N1,N2) > 1, else return factoru(n0) */
    8798             : static GEN
    8799      329427 : sigchi2_dec(long n, long N1, long N2, long *pn1, long *pn2)
    8800             : {
    8801      329427 :   GEN P0, E0, P, E, fa = myfactoru(n);
    8802             :   long i, j, l;
    8803      329427 :   *pn1 = 1;
    8804      329427 :   *pn2 = 1;
    8805      329427 :   if (N1 == 1 && N2 == 1) return fa;
    8806      315938 :   P = gel(fa,1); l = lg(P);
    8807      315938 :   E = gel(fa,2);
    8808      315938 :   P0 = cgetg(l, t_VECSMALL);
    8809      315938 :   E0 = cgetg(l, t_VECSMALL);
    8810      743008 :   for (i = j = 1; i < l; i++)
    8811             :   {
    8812      449792 :     long p = P[i], e = E[i];
    8813      449792 :     if (N1 % p == 0)
    8814             :     {
    8815       56224 :       if (N2 % p == 0) return NULL;
    8816       33502 :       *pn1 *= upowuu(p,e);
    8817             :     }
    8818      393568 :     else if (N2 % p == 0)
    8819       87724 :       *pn2 *= upowuu(p,e);
    8820      305844 :     else { P0[j] = p; E0[j] = e; j++; }
    8821             :   }
    8822      293216 :   setlg(P0, j);
    8823      293216 :   setlg(E0, j); return mkvec2(P0,E0);
    8824             : }
    8825             : 
    8826             : /* sigma_{k-1}(\chi_1,\chi_2,n), ord multiple of lcm(ord(CHI1),ord(CHI2)) */
    8827             : static GEN
    8828      274939 : sigchi2(long k, GEN CHI1, GEN CHI2, long n, long ord)
    8829             : {
    8830      274939 :   pari_sp av = avma;
    8831      274939 :   GEN S = gen_0, D;
    8832      274939 :   long i, l, n1, n2, vt, N1 = mfcharmodulus(CHI1), N2 = mfcharmodulus(CHI2);
    8833      274939 :   D = sigchi2_dec(n, N1, N2, &n1, &n2); if (!D) { set_avma(av); return S; }
    8834      256886 :   D = divisorsu_fact(D); l = lg(D);
    8835      256886 :   vt = varn(mfcharpol(CHI1));
    8836      952910 :   for (i = 1; i < l; i++)
    8837             :   { /* S += d^(k-1)*chi1(d)*chi2(n/d) */
    8838      696024 :     long a, d = n2*D[i], nd = n1*D[l-i]; /* (d,N1)=1; (n/d,N2) = 1 */
    8839      696024 :     a = mfcharevalord(CHI1, d, ord) + mfcharevalord(CHI2, nd, ord);
    8840      696024 :     if (a >= ord) a -= ord;
    8841      696024 :     S = gadd(S, Qab_Czeta(a, ord, powuu(d, k-1), vt));
    8842             :   }
    8843      256886 :   return gerepileupto(av, S);
    8844             : }
    8845             : 
    8846             : /**************************************************************************/
    8847             : /**           Dirichlet characters with precomputed values               **/
    8848             : /**************************************************************************/
    8849             : /* CHI mfchar */
    8850             : static GEN
    8851       13230 : mfcharcxinit(GEN CHI, long prec)
    8852             : {
    8853       13230 :   GEN G = gel(CHI,1), chi = gel(CHI,2), z, V;
    8854       13230 :   GEN v = ncharvecexpo(G, znconrey_normalized(G,chi));
    8855       13230 :   long n, l = lg(v), o = mfcharorder(CHI);
    8856       13230 :   V = cgetg(l, t_VEC);
    8857       13230 :   z = grootsof1(o, prec); /* Mod(t, Phi_o(t)) -> e(1/o) */
    8858      120085 :   for (n = 1; n < l; n++) gel(V,n) = v[n] < 0? gen_0: gel(z, v[n]+1);
    8859       13230 :   return mkvecn(6, G, chi, gmfcharorder(CHI), v, V, mfcharpol(CHI));
    8860             : }
    8861             : /* v a "CHIvec" */
    8862             : static long
    8863    23965403 : CHIvec_N(GEN v) { return itou(znstar_get_N(gel(v,1))); }
    8864             : static GEN
    8865       14406 : CHIvec_CHI(GEN v)
    8866       14406 : { return mkvec4(gel(v,1), gel(v,2), gel(v,3), gel(v,6)); }
    8867             : /* character order */
    8868             : static long
    8869       38486 : CHIvec_ord(GEN v) { return itou(gel(v,3)); }
    8870             : /* character exponents, i.e. t such that chi(n) = e(t) */
    8871             : static GEN
    8872      416829 : CHIvec_expo(GEN v) { return gel(v,4); }
    8873             : /* character values chi(n) */
    8874             : static GEN
    8875    23334311 : CHIvec_val(GEN v) { return gel(v,5); }
    8876             : /* CHI(n) */
    8877             : static GEN
    8878    23324910 : mychareval(GEN v, long n)
    8879             : {
    8880    23324910 :   long N = CHIvec_N(v), ind = n%N;
    8881    23324910 :   if (ind <= 0) ind += N;
    8882    23324910 :   return gel(CHIvec_val(v), ind);
    8883             : }
    8884             : /* return c such that CHI(n) = e(c / ordz) or -1 if (n,N) > 1 */
    8885             : static long
    8886      416829 : mycharexpo(GEN v, long n)
    8887             : {
    8888      416829 :   long N = CHIvec_N(v), ind = n%N;
    8889      416829 :   if (ind <= 0) ind += N;
    8890      416829 :   return CHIvec_expo(v)[ind];
    8891             : }
    8892             : /* faster than mfcharparity */
    8893             : static long
    8894       53823 : CHIvec_parity(GEN v) { return mycharexpo(v,-1) ? -1: 1; }
    8895             : /**************************************************************************/
    8896             : 
    8897             : static ulong
    8898       54488 : sigchi2_Fl(long k, GEN CHI1vec, GEN CHI2vec, long n, GEN vz, ulong p)
    8899             : {
    8900       54488 :   pari_sp av = avma;
    8901       54488 :   long ordz = lg(vz)-2, i, l, n1, n2;
    8902       54488 :   ulong S = 0;
    8903       54488 :   GEN D = sigchi2_dec(n, CHIvec_N(CHI1vec), CHIvec_N(CHI2vec), &n1, &n2);
    8904       54488 :   if (!D) return gc_ulong(av,S);
    8905       49819 :   D = divisorsu_fact(D);
    8906       49819 :   l = lg(D);
    8907      169470 :   for (i = 1; i < l; i++)
    8908             :   { /* S += d^(k-1)*chi1(d)*chi2(n/d) */
    8909      119651 :     long a, d = n2*D[i], nd = n1*D[l-i]; /* (d,N1)=1, (n/d,N2)=1 */
    8910      119651 :     a = mycharexpo(CHI2vec, nd) + mycharexpo(CHI1vec, d);
    8911      119651 :     if (a >= ordz) a -= ordz;
    8912      119651 :     S = Fl_add(S, Qab_Czeta_Fl(a, vz, Fl_powu(d,k-1,p), p), p);
    8913             :   }
    8914       49819 :   return gc_ulong(av,S);
    8915             : }
    8916             : 
    8917             : /**********************************************************************/
    8918             : /* Fourier expansions of Eisenstein series                            */
    8919             : /**********************************************************************/
    8920             : /* L(CHI_t,0) / 2, CHI_t(n) = CHI(n)(t/n) as a character modulo N*t,
    8921             :  * order(CHI) | ord != 0 */
    8922             : static GEN
    8923        2163 : charLFwt1(long N, GEN CHI, long ord, long t)
    8924             : {
    8925             :   GEN S;
    8926             :   long r, vt;
    8927             : 
    8928        2163 :   if (N == 1 && t == 1) return mkfrac(gen_m1,stoi(4));
    8929        2163 :   S = gen_0; vt = varn(mfcharpol(CHI));
    8930       64393 :   for (r = 1; r < N; r++)
    8931             :   { /* S += r*chi(r) */
    8932             :     long a;
    8933       62230 :     if (ugcd(N,r) != 1) continue;
    8934       50190 :     a = mfcharevalord(CHI,r,ord);
    8935       50190 :     if (t != 1 && kross(t, r) < 0) r = -r;
    8936       50190 :     S = gadd(S, Qab_Czeta(a, ord, stoi(r), vt));
    8937             :   }
    8938        2163 :   return gdivgs(S, -2*N);
    8939             : }
    8940             : /* L(CHI,0) / 2, mod p */
    8941             : static ulong
    8942        1960 : charLFwt1_Fl(GEN CHIvec, GEN vz, ulong p)
    8943             : {
    8944        1960 :   long r, m = CHIvec_N(CHIvec);
    8945             :   ulong S;
    8946        1960 :   if (m == 1) return Rg_to_Fl(mkfrac(gen_m1,stoi(4)), p);
    8947        1960 :   S = 0;
    8948       95746 :   for (r = 1; r < m; r++)
    8949             :   { /* S += r*chi(r) */
    8950       93786 :     long a = mycharexpo(CHIvec,r);
    8951       93786 :     if (a < 0) continue;
    8952       91490 :     S = Fl_add(S, Qab_Czeta_Fl(a, vz, r, p), p);
    8953             :   }
    8954        1960 :   return Fl_div(Fl_neg(S,p), 2*m, p);
    8955             : }
    8956             : /* L(CHI_t,1-k) / 2, CHI_t(n) = CHI(n) * (t/n), order(CHI) | ord != 0;
    8957             :  * assume conductor of CHI_t divides N */
    8958             : static GEN
    8959        3682 : charLFwtk(long N, long k, GEN CHI, long ord, long t)
    8960             : {
    8961             :   GEN S, P, dS;
    8962             :   long r, vt;
    8963             : 
    8964        3682 :   if (k == 1) return charLFwt1(N, CHI, ord, t);
    8965        1519 :   if (N == 1 && t == 1) return gdivgs(bernfrac(k),-2*k);
    8966         917 :   S = gen_0; vt = varn(mfcharpol(CHI));
    8967         917 :   P = ZX_rescale(Q_remove_denom(bernpol(k,0), &dS), utoi(N));
    8968         917 :   dS = mul_denom(dS, stoi(-2*N*k));
    8969       13342 :   for (r = 1; r < N; r++)
    8970             :   { /* S += P(r)*chi(r) */
    8971             :     long a;
    8972             :     GEN C;
    8973       12425 :     if (ugcd(r,N) != 1) continue;
    8974       10080 :     a = mfcharevalord(CHI,r,ord);
    8975       10080 :     C = poleval(P, utoi(r));
    8976       10080 :     if (t != 1 && kross(t, r) < 0) C = gneg(C);
    8977       10080 :     S = gadd(S, Qab_Czeta(a, ord, C, vt));
    8978             :   }
    8979         917 :   return gdiv(S, dS);
    8980             : }
    8981             : /* L(CHI,1-k) / 2, mod p */
    8982             : static ulong
    8983        2723 : charLFwtk_Fl(long k, GEN CHIvec, GEN vz, ulong p)
    8984             : {
    8985             :   GEN P;
    8986             :   long r, m;
    8987             :   ulong S;
    8988        2723 :   if (k == 1) return charLFwt1_Fl(CHIvec, vz, p);
    8989         763 :   m = CHIvec_N(CHIvec);
    8990         763 :   if (m == 1) return Rg_to_Fl(gdivgs(bernfrac(k),-2*k), p);
    8991         448 :   S = 0;
    8992         448 :   P = RgX_to_Flx(RgX_rescale(bernpol(k,0), utoi(m)), p);
    8993       10038 :   for (r = 1; r < m; r++)
    8994             :   { /* S += P(r)*chi(r) */
    8995        9590 :     long a = mycharexpo(CHIvec,r);
    8996        9590 :     if (a < 0) continue;
    8997        8470 :     S = Fl_add(S, Qab_Czeta_Fl(a, vz, Flx_eval(P,r,p), p), p);
    8998             :   }
    8999         448 :   return Fl_div(Fl_neg(S,p), 2*k*m, p);
    9000             : }
    9001             : 
    9002             : static GEN
    9003        6622 : mfeisenstein2_0(long k, GEN CHI1, GEN CHI2, long ord)
    9004             : {
    9005        6622 :   if (k == 1 && mfcharistrivial(CHI1))
    9006        2163 :     return charLFwtk(mfcharmodulus(CHI2), 1, CHI2, ord, 1);
    9007        4459 :   else if (mfcharistrivial(CHI2))
    9008        1330 :     return charLFwtk(mfcharmodulus(CHI1), k, CHI1, ord, 1);
    9009        3129 :   else return gen_0;
    9010             : }
    9011             : static ulong
    9012        4137 : mfeisenstein2_0_Fl(long k, GEN CHI1vec, GEN CHI2vec, GEN vz, ulong p)
    9013             : {
    9014        4137 :   if (k == 1 && CHIvec_ord(CHI1vec) == 1)
    9015        1960 :     return charLFwtk_Fl(k, CHI2vec, vz, p);
    9016        2177 :   else if (CHIvec_ord(CHI2vec) == 1)
    9017         763 :     return charLFwtk_Fl(k, CHI1vec, vz, p);
    9018        1414 :   else return 0;
    9019             : }
    9020             : static GEN
    9021         126 : NK_eisen2(long k, GEN CHI1, GEN CHI2, long ord)
    9022             : {
    9023         126 :   long o, N = mfcharmodulus(CHI1)*mfcharmodulus(CHI2);
    9024         126 :   GEN CHI = mfcharmul(CHI1, CHI2);
    9025         126 :   o = mfcharorder(CHI);
    9026         126 :   if ((ord & 3) == 2) ord >>= 1;
    9027         126 :   if ((o & 3) == 2) o >>= 1;
    9028         126 :   if (ord != o) pari_err_IMPL("mfeisenstein for these characters");
    9029         119 :   return mkNK(N, k, CHI);
    9030             : }
    9031             : static GEN
    9032         343 : mfeisenstein_i(long k, GEN CHI1, GEN CHI2)
    9033             : {
    9034         343 :   long s = 1, ord, vt;
    9035             :   GEN E0, NK, vchi, T;
    9036         343 :   if (CHI2) { CHI2 = get_mfchar(CHI2); if (mfcharparity(CHI2) < 0) s = -s; }
    9037         343 :   if (CHI1) { CHI1 = get_mfchar(CHI1); if (mfcharparity(CHI1) < 0) s = -s; }
    9038         329 :   if (s != m1pk(k)) return mftrivial();
    9039         308 :   if (!CHI1) CHI1 = mfchartrivial();
    9040         308 :   if (!CHI2)
    9041             :   { /* E_k(chi1) */
    9042         182 :     vt = varn(mfcharpol(CHI1));
    9043         182 :     ord = mfcharorder(CHI1);
    9044         182 :     NK = mkNK(mfcharmodulus(CHI1), k, CHI1);
    9045         182 :     E0 = charLFwtk(mfcharmodulus(CHI1), k, CHI1, ord, 1);
    9046         182 :     vchi = mkvec3(E0, mkvec(mfcharpol(CHI1)), CHI1);
    9047         182 :     return tag(t_MF_EISEN, NK, vchi);
    9048             :   }
    9049             :   /* E_k(chi1,chi2) */
    9050         126 :   vt = varn(mfcharpol(CHI1));
    9051         126 :   ord = ulcm(mfcharorder(CHI1), mfcharorder(CHI2));
    9052         126 :   NK = NK_eisen2(k, CHI1, CHI2, ord);
    9053         119 :   E0 = mfeisenstein2_0(k, CHI1, CHI2, ord);
    9054         119 :   T = mkvec(polcyclo(ord, vt));
    9055         119 :   vchi = mkvec4(E0, T, CHI1, CHI2);
    9056         119 :   return tag2(t_MF_EISEN, NK, vchi, mkvecsmall2(ord,0));
    9057             : }
    9058             : GEN
    9059         343 : mfeisenstein(long k, GEN CHI1, GEN CHI2)
    9060             : {
    9061         343 :   pari_sp av = avma;
    9062         343 :   if (k < 1) pari_err_DOMAIN("mfeisenstein", "k", "<", gen_1, stoi(k));
    9063         343 :   return gerepilecopy(av, mfeisenstein_i(k, CHI1, CHI2));
    9064             : }
    9065             : 
    9066             : static GEN
    9067        1610 : mfeisenstein2all(long N0, GEN NK, long k, GEN CHI1, GEN CHI2, GEN T, long o)
    9068             : {
    9069        1610 :   GEN E, E0 = mfeisenstein2_0(k, CHI1,CHI2, o), vchi = mkvec4(E0, T, CHI1,CHI2);
    9070        1610 :   long j, d = (lg(T)==4)? itou(gmael(T,3,1)): 1;
    9071        1610 :   E = cgetg(d+1, t_VEC);
    9072        3269 :   for (j=1; j<=d; j++) gel(E,j) = tag2(t_MF_EISEN, NK,vchi,mkvecsmall2(o,j-1));
    9073        1610 :   return mfbdall(E, N0 / mf_get_N(gel(E,1)));
    9074             : }
    9075             : 
    9076             : /* list of characters on G = (Z/NZ)^*, v[i] = NULL if (i,N) > 1, else
    9077             :  * the conductor of Conrey label i, [conductor, primitive char].
    9078             :  * Trivial chi (label 1) comes first */
    9079             : static GEN
    9080         707 : zncharsG(GEN G)
    9081             : {
    9082         707 :   long i, l, N = itou(znstar_get_N(G));
    9083             :   GEN vCHI, V;
    9084         707 :   if (N == 1) return mkvec2(gen_1,cgetg(1,t_COL));
    9085         707 :   vCHI = const_vec(N,NULL);
    9086         707 :   V = cyc2elts(znstar_get_conreycyc(G));
    9087         707 :   l = lg(V);
    9088       23667 :   for (i = 1; i < l; i++)
    9089             :   {
    9090       22960 :     GEN chi0, chi = zc_to_ZC(gel(V,i)), n, F;
    9091       22960 :     F = znconreyconductor(G, chi, &chi0);
    9092       22960 :     if (typ(F) != t_INT) F = gel(F,1);
    9093       22960 :     n = znconreyexp(G, chi);
    9094       22960 :     gel(vCHI, itos(n)) = mkvec2(chi0, F);
    9095             :   }
    9096         707 :   return vCHI;
    9097             : }
    9098             : 
    9099             : /* CHI primitive, f(CHI) | N. Return pairs (CHI1,CHI2) both primitive
    9100             :  * such that f(CHI1)*f(CHI2) | N and CHI1 * CHI2 = CHI;
    9101             :  * if k = 1, CHI1 is even; if k = 2, omit (1,1) if CHI = 1 */
    9102             : static GEN
    9103         910 : mfeisensteinbasis_i(long N0, long k, GEN CHI)
    9104             : {
    9105         910 :   GEN G = gel(CHI,1), chi = gel(CHI,2), vT = const_vec(myeulerphiu(N0), NULL);
    9106         910 :   GEN CHI0, GN, chiN, Lchi, LG, V, RES, NK, T, C = mfcharpol(CHI);
    9107         910 :   long i, j, l, n, n1, N, ord = mfcharorder(CHI);
    9108         910 :   long F = mfcharmodulus(CHI), vt = varn(mfcharpol(CHI));
    9109             : 
    9110         910 :   CHI0 = (F == 1)? CHI: mfchartrivial();
    9111         910 :   j = 1; RES = cgetg(N0+1, t_VEC);
    9112         910 :   T = gel(vT,ord) = Qab_trace_init(ord, ord, C, C);
    9113         910 :   if (F != 1 || k != 2)
    9114             :   { /* N1 = 1 */
    9115         770 :     NK = mkNK(F, k, CHI);
    9116         770 :     gel(RES, j++) = mfeisenstein2all(N0, NK, k, CHI0, CHI, T, ord);
    9117         770 :     if (F != 1 && k != 1)
    9118         266 :       gel(RES, j++) = mfeisenstein2all(N0, NK, k, CHI, CHI0, T, ord);
    9119             :   }
    9120         910 :   if (N0 == 1) { setlg(RES,j); return RES; }
    9121         840 :   GN = G; chiN = chi;
    9122         840 :   if (F == N0) N = N0;
    9123             :   else
    9124             :   {
    9125         504 :     GEN faN = myfactoru(N0), P = gel(faN,1), E = gel(faN,2);
    9126         504 :     long lP = lg(P);
    9127        1316 :     for (i = N = 1; i < lP; i++)
    9128             :     {
    9129         812 :       long p = P[i];
    9130         812 :       N *= upowuu(p, maxuu(E[i]/2, z_lval(F,p)));
    9131             :     }
    9132         504 :     if ((N & 3) == 2) N >>= 1;
    9133         504 :     if (N == 1) { setlg(RES,j); return RES; }
    9134         371 :     if (F != N)
    9135             :     {
    9136         105 :       GN = znstar0(utoipos(N),1);
    9137         105 :       chiN = zncharinduce(G, chi, GN);
    9138             :     }
    9139             :   }
    9140         707 :   LG = const_vec(N, NULL); /* LG[d] = znstar(d,1) or NULL */
    9141         707 :   gel(LG,1) = gel(CHI0,1);
    9142         707 :   gel(LG,F) = G;
    9143         707 :   gel(LG,N) = GN;
    9144         707 :   Lchi = coprimes_zv(N);
    9145         707 :   n = itou(znconreyexp(GN,chiN));
    9146         707 :   V = zncharsG(GN); l = lg(V);
    9147       31241 :   for (n1 = 2; n1 < l; n1++) /* skip 1 (trivial char) */
    9148             :   {
    9149       30534 :     GEN v = gel(V,n1), w, chi1, chi2, G1, G2, CHI1, CHI2;
    9150             :     long N12, N1, N2, no, o12, t, m;
    9151       30534 :     if (!Lchi[n1] || n1 == n) continue; /* skip trivial chi2 */
    9152       21581 :     chi1 = gel(v,1); N1 = itou(gel(v,2)); /* conductor of chi1 */
    9153       21581 :     w = gel(V, Fl_div(n,n1,N));
    9154       21581 :     chi2 = gel(w,1); N2 = itou(gel(w,2)); /* conductor of chi2 */
    9155       21581 :     N12 = N1 * N2;
    9156       21581 :     if (N0 % N12) continue;
    9157             : 
    9158         763 :     G1 = gel(LG,N1); if (!G1) gel(LG,N1) = G1 = znstar0(utoipos(N1), 1);
    9159         763 :     if (k == 1 && zncharisodd(G1,chi1)) continue;
    9160         574 :     G2 = gel(LG,N2); if (!G2) gel(LG,N2) = G2 = znstar0(utoipos(N2), 1);
    9161         574 :     CHI1 = mfcharGL(G1, chi1);
    9162         574 :     CHI2 = mfcharGL(G2, chi2);
    9163         574 :     o12 = ulcm(mfcharorder(CHI1), mfcharorder(CHI2));
    9164             :     /* remove Galois orbit: same trace */
    9165         574 :     no = Fl_powu(n1, ord, N);
    9166         875 :     for (t = 1+ord, m = n1; t <= o12; t += ord)
    9167             :     { /* m <-> CHI1^t, if t in Gal(Q(chi1,chi2)/Q), omit (CHI1^t,CHI2^t) */
    9168         301 :       m = Fl_mul(m, no, N); if (!m) break;
    9169         301 :       if (ugcd(t, o12) == 1) Lchi[m] = 0;
    9170             :     }
    9171         574 :     T = gel(vT,o12);
    9172         574 :     if (!T) T = gel(vT,o12) = Qab_trace_init(o12, ord, polcyclo(o12,vt), C);
    9173         574 :     NK = mkNK(N12, k, CHI);
    9174         574 :     gel(RES, j++) = mfeisenstein2all(N0, NK, k, CHI1, CHI2, T, o12);
    9175             :   }
    9176         707 :   setlg(RES,j); return RES;
    9177             : }
    9178             : 
    9179             : static GEN
    9180         700 : mfbd_E2(GEN E2, long d, GEN CHI)
    9181             : {
    9182         700 :   GEN E2d = mfbd_i(E2, d);
    9183         700 :   GEN F = mkvec2(E2, E2d), L = mkvec2(gen_1, utoineg(d));
    9184             :   /* cannot use mflinear_i: E2 and E2d do not have the same level */
    9185         700 :   return tag3(t_MF_LINEAR, mkNK(d,2,CHI), F, L, gen_1);
    9186             : }
    9187             : /* C-basis of E_k(Gamma_0(N),chi). If k = 1, the first basis element must not
    9188             :  * vanish at oo [used in mfwt1basis]. Here E_1(CHI), whose q^0 coefficient
    9189             :  * does not vanish (since L(CHI,0) does not) *if* CHI is not trivial; which
    9190             :  * must be the case in weight 1.
    9191             :  *
    9192             :  * (k>=3): In weight k >= 3, basis is B(d) E(CHI1,(CHI/CHI1)_prim), where
    9193             :  * CHI1 is primitive modulo N1, and if N2 is the conductor of CHI/CHI1
    9194             :  * then d*N1*N2 | N.
    9195             :  * (k=2): In weight k=2, same if CHI is nontrivial. If CHI is trivial, must
    9196             :  * not take CHI1 trivial, and must add E_2(tau)-dE_2(d tau)), where
    9197             :  * d|N, d > 1.
    9198             :  * (k=1): In weight k=1, same as k >= 3 except that we restrict to CHI1 even */
    9199             : static GEN
    9200         938 : mfeisensteinbasis(long N, long k, GEN CHI)
    9201             : {
    9202             :   long i, F;
    9203             :   GEN L;
    9204         938 :   if (badchar(N, k, CHI)) return cgetg(1, t_VEC);
    9205         938 :   if (k == 0) return mfcharistrivial(CHI)? mkvec(mf1()): cgetg(1, t_VEC);
    9206         910 :   CHI = mfchartoprimitive(CHI, &F);
    9207         910 :   L = mfeisensteinbasis_i(N, k, CHI);
    9208         910 :   if (F == 1 && k == 2)
    9209             :   {
    9210         140 :     GEN v, E2 = mfeisenstein(2, NULL, NULL), D = mydivisorsu(N);
    9211         140 :     long nD = lg(D)-1;
    9212         140 :     v = cgetg(nD, t_VEC); L = vec_append(L,v);
    9213         833 :     for (i = 1; i < nD; i++) gel(v,i) = mfbd_E2(E2, D[i+1], CHI);
    9214             :   }
    9215         910 :   return lg(L) == 1? L: shallowconcat1(L);
    9216             : }
    9217             : 
    9218             : static GEN
    9219          77 : not_in_space(GEN F, long flag)
    9220             : {
    9221          77 :   if (!flag) err_space(F);
    9222          70 :   return cgetg(1, t_COL);
    9223             : }
    9224             : /* when flag set, no error */
    9225             : GEN
    9226         819 : mftobasis(GEN mf, GEN F, long flag)
    9227             : {
    9228         819 :   pari_sp av2, av = avma;
    9229             :   GEN G, v, y, gk;
    9230         819 :   long N, B, ismf = checkmf_i(F);
    9231             : 
    9232         819 :   mf = checkMF(mf);
    9233         819 :   if (ismf)
    9234             :   {
    9235         728 :     if (mfistrivial(F)) return zerocol(MF_get_dim(mf));
    9236         721 :     if (!mf_same_k(mf, F) || !mf_same_CHI(mf, F)) return not_in_space(F, flag);
    9237             :   }
    9238         770 :   N = MF_get_N(mf);
    9239         770 :   gk = MF_get_gk(mf);
    9240         770 :   if (ismf)
    9241             :   {
    9242         679 :     long NF = mf_get_N(F);
    9243         679 :     B = maxuu(mfsturmNgk(NF,gk), mfsturmNgk(N,gk)) + 1;
    9244         679 :     v = mfcoefs_i(F,B,1);
    9245             :   }
    9246             :   else
    9247             :   {
    9248          91 :     B = mfsturmNgk(N, gk) + 1;
    9249          91 :     switch(typ(F))
    9250             :     { /* F(0),...,F(lg(v)-2) */
    9251          63 :       case t_SER: v = sertocol(F); settyp(v,t_VEC); break;
    9252          14 :       case t_VEC: v = F; break;
    9253           7 :       case t_COL: v = shallowtrans(F); break;
    9254           7 :       default: pari_err_TYPE("mftobasis",F);
    9255             :                v = NULL;/*LCOV_EXCL_LINE*/
    9256             :     }
    9257          84 :     if (flag) B = minss(B, lg(v)-2);
    9258             :   }
    9259         763 :   y = mftobasis_i(mf, v);
    9260         763 :   if (typ(y) == t_VEC)
    9261             :   {
    9262          21 :     if (flag) return gerepilecopy(av, y);
    9263           0 :     pari_err(e_MISC, "not enough coefficients in mftobasis");
    9264             :   }
    9265         742 :   av2 = avma;
    9266         742 :   if (MF_get_space(mf) == mf_FULL || mfsturm(mf)+1 == B) return y;
    9267         287 :   G = mflinear(mf, y);
    9268         287 :   if (!gequal(v, mfcoefs_i(G, lg(v)-2,1))) y = NULL;
    9269         287 :   if (!y) { set_avma(av); return not_in_space(F, flag); }
    9270         252 :   set_avma(av2); return gerepileupto(av, y);
    9271             : }
    9272             : 
    9273             : /* assume N > 0; first cusp is always 0 */
    9274             : static GEN
    9275          49 : mfcusps_i(long N)
    9276             : {
    9277             :   long i, c, l;
    9278             :   GEN D, v;
    9279             : 
    9280          49 :   if (N == 1) return mkvec(gen_0);
    9281          49 :   D = mydivisorsu(N); l = lg(D); /* left on stack */
    9282          49 :   c = mfnumcuspsu_fact(myfactoru(N));
    9283          49 :   v = cgetg(c + 1, t_VEC);
    9284         350 :   for (i = c = 1; i < l; i++)
    9285             :   {
    9286         301 :     long C = D[i], NC = D[l-i], lima = ugcd(C, NC), A0, A;
    9287         889 :     for (A0 = 0; A0 < lima; A0++)
    9288         588 :       if (ugcd(A0, lima) == 1)
    9289             :       {
    9290         539 :         A = A0; while (ugcd(A,C) > 1) A += lima;
    9291         392 :         gel(v, c++) = sstoQ(A, C);
    9292             :       }
    9293             :   }
    9294          49 :   return v;
    9295             : }
    9296             : /* List of cusps of Gamma_0(N) */
    9297             : GEN
    9298          28 : mfcusps(GEN gN)
    9299             : {
    9300             :   long N;
    9301             :   GEN mf;
    9302          28 :   if (typ(gN) == t_INT) N = itos(gN);
    9303          14 :   else if ((mf = checkMF_i(gN))) N = MF_get_N(mf);
    9304           0 :   else { pari_err_TYPE("mfcusps", gN); N = 0; }
    9305          28 :   if (N <= 0) pari_err_DOMAIN("mfcusps", "N", "<=", gen_0, stoi(N));
    9306          28 :   return mfcusps_i(N);
    9307             : }
    9308             : 
    9309             : long
    9310         315 : mfcuspisregular(GEN NK, GEN cusp)
    9311             : {
    9312             :   long v, N, dk, nk, t, o;
    9313             :   GEN mf, CHI, go, A, C, g, c, d;
    9314         315 :   if ((mf = checkMF_i(NK)))
    9315             :   {
    9316          49 :     GEN gk = MF_get_gk(mf);
    9317          49 :     N = MF_get_N(mf);
    9318          49 :     CHI = MF_get_CHI(mf);
    9319          49 :     Qtoss(gk, &nk, &dk);
    9320             :   }
    9321             :   else
    9322         266 :     checkNK2(NK, &N, &nk, &dk, &CHI, 0);
    9323         315 :   if (typ(cusp) == t_INFINITY) return 1;
    9324         315 :   if (typ(cusp) == t_FRAC) { A = gel(cusp,1); C = gel(cusp,2); }
    9325          28 :   else { A = cusp; C = gen_1; }
    9326         315 :   g = diviuexact(mului(N,C), ugcd(N, Fl_sqr(umodiu(C,N), N)));
    9327         315 :   c = mulii(negi(C),g);
    9328         315 :   d = addiu(mulii(A,g), 1);
    9329         315 :   if (!CHI) return 1;
    9330         315 :   go = gmfcharorder(CHI);
    9331         315 :   v = vali(go); if (v < 2) go = shifti(go, 2-v);
    9332         315 :   t = itou( znchareval(gel(CHI,1), gel(CHI,2), d, go) );
    9333         315 :   if (dk == 1) return t == 0;
    9334         154 :   o = itou(go);
    9335         154 :   if (kronecker(c,d) < 0) t = Fl_add(t, o/2, o);
    9336         154 :   if (Mod4(d) == 1) return t == 0;
    9337          14 :   t = Fl_sub(t, Fl_mul(o/4, nk, o), o);
    9338          14 :   return t == 0;
    9339             : }
    9340             : 
    9341             : /* Some useful closures */
    9342             : 
    9343             : /* sum_{d|n} d^k */
    9344             : static GEN
    9345       37660 : mysumdivku(ulong n, ulong k)
    9346             : {
    9347       37660 :   GEN fa = myfactoru(n);
    9348       37660 :   return k == 1? usumdiv_fact(fa): usumdivk_fact(fa,k);
    9349             : }
    9350             : static GEN
    9351         812 : c_Ek(long n, long d, GEN F)
    9352             : {
    9353         812 :   GEN E = cgetg(n + 2, t_VEC), C = gel(F,2);
    9354         812 :   long i, k = mf_get_k(F);
    9355         812 :   gel (E, 1) = gen_1;
    9356       25270 :   for (i = 1; i <= n; i++)
    9357             :   {
    9358       24458 :     pari_sp av = avma;
    9359       24458 :     gel(E, i+1) = gerepileupto(av, gmul(C, mysumdivku(i*d, k-1)));
    9360             :   }
    9361         812 :   return E;
    9362             : }
    9363             : 
    9364             : GEN
    9365         364 : mfEk(long k)
    9366             : {
    9367         364 :   pari_sp av = avma;
    9368             :   GEN E0, NK;
    9369         364 :   if (k < 0 || odd(k)) pari_err_TYPE("mfEk [incorrect k]", stoi(k));
    9370         364 :   if (!k) return mf1();
    9371         357 :   E0 = gdivsg(-2*k, bernfrac(k));
    9372         357 :   NK = mkNK(1,k,mfchartrivial());
    9373         357 :   return gerepilecopy(av, tag(t_MF_Ek, NK, E0));
    9374             : }
    9375             : 
    9376             : GEN
    9377          56 : mfDelta(void)
    9378             : {
    9379          56 :   pari_sp av = avma;
    9380          56 :   return gerepilecopy(av, tag0(t_MF_DELTA, mkNK(1,12,mfchartrivial())));
    9381             : }
    9382             : 
    9383             : GEN
    9384         742 : mfTheta(GEN psi)
    9385             : {
    9386         742 :   pari_sp av = avma;
    9387             :   GEN N, gk, psi2;
    9388             :   long par;
    9389         742 :   if (!psi) { psi = mfchartrivial(); N = utoipos(4); par = 1; }
    9390             :   else
    9391             :   {
    9392             :     long FC;
    9393          21 :     psi = get_mfchar(psi);
    9394          21 :     FC = mfcharconductor(psi);
    9395          21 :     if (mfcharmodulus(psi) != FC)
    9396           0 :       pari_err_TYPE("mfTheta [nonprimitive character]", psi);
    9397          21 :     par = mfcharparity(psi);
    9398          21 :     N = shifti(sqru(FC),2);
    9399             :   }
    9400         742 :   if (par > 0) { gk = ghalf; psi2 = psi; }
    9401           7 :   else { gk = gsubsg(2, ghalf); psi2 = mfcharmul(psi, get_mfchar(stoi(-4))); }
    9402         742 :   return gerepilecopy(av, tag(t_MF_THETA, mkgNK(N, gk, psi2, pol_x(1)), psi));
    9403             : }
    9404             : 
    9405             : /* Output 0 if not desired eta product: if flag=0 (default) require
    9406             :  * holomorphic at cusps. If flag set, accept meromorphic, but sill in some
    9407             :  * modular function space */
    9408             : GEN
    9409         196 : mffrometaquo(GEN eta, long flag)
    9410             : {
    9411         196 :   pari_sp av = avma;
    9412             :   GEN NK, N, k, BR, P;
    9413         196 :   long v, cusp = 0;
    9414         196 :   if (!etaquotype(&eta, &N,&k,&P, &v, NULL, flag? NULL: &cusp) || cusp < 0)
    9415             :   {
    9416          14 :     set_avma(av); return gen_0;
    9417             :   }
    9418         182 :   if (lg(gel(eta,1)) == 1) { set_avma(av); return mf1(); }
    9419         175 :   BR = mkvec2(ZV_to_zv(gel(eta,1)), ZV_to_zv(gel(eta,2)));
    9420         175 :   if (v < 0) v = 0;
    9421         175 :   NK = mkgNK(N, k, get_mfchar(P), pol_x(1));
    9422         175 :   return gerepilecopy(av, tag2(t_MF_ETAQUO, NK, BR, utoi(v)));
    9423             : }
    9424             : 
    9425             : /* Q^(-r) */
    9426             : static GEN
    9427         361 : RgXn_negpow(GEN Q, long r, long L)
    9428             : {
    9429         361 :   if (r < 0) r = -r; else Q = RgXn_inv_i(Q, L);
    9430         361 :   if (r != 1) Q = RgXn_powu_i(Q, r, L);
    9431         361 :   return Q;
    9432             : }
    9433             : /* flag same as in mffrometaquo: if set, accept meromorphic. */
    9434             : static GEN
    9435          42 : mfisetaquo_i(GEN F, long flag)
    9436             : {
    9437             :   GEN gk, P, E, M, S, G, CHI, v, w;
    9438             :   long b, l, L, N, vS, m, j;
    9439          42 :   const long bextra = 10;
    9440             : 
    9441          42 :   if (!checkmf_i(F)) pari_err_TYPE("mfisetaquo",F);
    9442          42 :   CHI = mf_get_CHI(F); if (mfcharorder(CHI) > 2) return NULL;
    9443          42 :   N = mf_get_N(F);
    9444          42 :   gk = mf_get_gk(F);
    9445          42 :   b = mfsturmNgk(N, gk);
    9446          42 :   L = maxss(N, b) + bextra;
    9447          42 :   S = mfcoefs_i(F, L, 1);
    9448          42 :   if (!RgV_is_ZV(S)) return NULL;
    9449         203 :   for (vS = 1; vS <= L+1; vS++)
    9450         203 :     if (signe(gel(S,vS))) break;
    9451          42 :   vS--; if (vS) { S = vecslice(S, vS+1, L+1); L -= vS; }
    9452          42 :   S = RgV_to_RgX(S, 0); l = lg(S)-2;
    9453          42 :   P = cgetg(l, t_COL);
    9454          42 :   E = cgetg(l, t_COL); w = v = gen_0; /* w = weight, v = valuation */
    9455         550 :   for (m = j = 1; m+2 < lg(S); m++)
    9456             :   {
    9457         515 :     GEN c = gel(S,m+2);
    9458             :     long r;
    9459         515 :     if (is_bigint(c)) return NULL;
    9460         508 :     r = -itos(c);
    9461         508 :     if (r)
    9462             :     {
    9463         361 :       S = ZXn_mul(S, RgXn_negpow(eta_ZXn(m, L), r, L), L);
    9464         361 :       gel(P,j) = utoipos(m);
    9465         361 :       gel(E,j) = stoi(r);
    9466         361 :       v = addmuliu(v, gel(E,j), m);
    9467         361 :       w = addis(w, r);
    9468         361 :       j++;
    9469             :     }
    9470             :   }
    9471          35 :   if (!equalii(w, gmul2n(gk, 1)) || (!flag && !equalii(v, muluu(24,vS))))
    9472           7 :     return NULL;
    9473          28 :   setlg(P, j);
    9474          28 :   setlg(E, j); M = mkmat2(P, E); G = mffrometaquo(M, flag);
    9475          28 :   return (typ(G) != t_INT
    9476          28 :           && (mfsturmmf(G) <= b + bextra || mfisequal(F, G, b)))? M: NULL;
    9477             : }
    9478             : GEN
    9479          42 : mfisetaquo(GEN F, long flag)
    9480             : {
    9481          42 :   pari_sp av = avma;
    9482          42 :   GEN M = mfisetaquo_i(F, flag);
    9483          42 :   if (!M) { set_avma(av); return gen_0; }
    9484          28 :   return gerepilecopy(av, M);
    9485             : }
    9486             : 
    9487             : #if 0
    9488             : /* number of primitive characters modulo N */
    9489             : static ulong
    9490             : numprimchars(ulong N)
    9491             : {
    9492             :   GEN fa, P, E;
    9493             :   long i, l;
    9494             :   ulong n;
    9495             :   if ((N & 3) == 2) return 0;
    9496             :   fa = myfactoru(N);
    9497             :   P = gel(fa,1); l = lg(P);
    9498             :   E = gel(fa,2);
    9499             :   for (i = n = 1; i < l; i++)
    9500             :   {
    9501             :     ulong p = P[i], e = E[i];
    9502             :     if (e == 2) n *= p-2; else n *= (p-1)*(p-1)*upowuu(p,e-2);
    9503             :   }
    9504             :   return n;
    9505             : }
    9506             : #endif
    9507             : 
    9508             : /* Space generated by products of two Eisenstein series */
    9509             : 
    9510             : static int
    9511       73122 : cmp_small_priority(void *E, GEN a, GEN b)
    9512             : {
    9513       73122 :   GEN prio = (GEN)E;
    9514       73122 :   return cmpss(prio[(long)a], prio[(long)b]);
    9515             : }
    9516             : static long
    9517        1148 : znstar_get_expo(GEN G) { return itou(cyc_get_expo(znstar_get_cyc(G))); }
    9518             : 
    9519             : /* Return [vchi, bymod, vG]:
    9520             :  * vG[f] = znstar(f,1) for f a conductor of (at least) a char mod N; else NULL
    9521             :  * bymod[f] = vecsmall of conrey indexes of chars modulo f | N; else NULL
    9522             :  * vchi[n] = a list of CHIvec [G0,chi0,o,ncharvecexpo(G0,nchi0),...]:
    9523             :  *   chi0 = primitive char attached to Conrey Mod(n,N)
    9524             :  * (resp. NULL if (n,N) > 1) */
    9525             : static GEN
    9526         574 : charsmodN(long N)
    9527             : {
    9528         574 :   GEN D, G, prio, phio, dummy = cgetg(1,t_VEC);
    9529         574 :   GEN vP, vG = const_vec(N,NULL), vCHI  = const_vec(N,NULL);
    9530         574 :   GEN bymod = const_vec(N,NULL);
    9531         574 :   long pn, i, l, vt = fetch_user_var("t");
    9532         574 :   D = mydivisorsu(N); l = lg(D);
    9533        3598 :   for (i = 1; i < l; i++)
    9534        3024 :     gel(bymod, D[i]) = vecsmalltrunc_init(myeulerphiu(D[i])+1);
    9535         574 :   gel(vG,N) = G = znstar0(utoipos(N),1);
    9536         574 :   pn = znstar_get_expo(G);  /* exponent(Z/NZ)^* */
    9537         574 :   vP = const_vec(pn,NULL);
    9538       26152 :   for (i = 1; i <= N; i++)
    9539             :   {
    9540             :     GEN P, gF, G0, chi0, nchi0, chi, v, go;
    9541             :     long j, F, o;
    9542       25578 :     if (ugcd(i,N) != 1) continue;
    9543       13601 :     chi = znconreylog(G, utoipos(i));
    9544       13601 :     gF = znconreyconductor(G, chi, &chi0);
    9545       13601 :     F = (typ(gF) == t_INT)? itou(gF): itou(gel(gF,1));
    9546       13601 :     G0 = gel(vG, F); if (!G0) G0 = gel(vG,F) = znstar0(gF, 1);
    9547       13601 :     nchi0 = znconreylog_normalize(G0,chi0);
    9548       13601 :     go = gel(nchi0,1); o = itou(go); /* order(chi0) */
    9549       13601 :     v = ncharvecexpo(G0, nchi0);
    9550       13601 :     if (!equaliu(go, pn)) v = zv_z_mul(v, pn / o);
    9551       13601 :     P = gel(vP, o); if (!P) P = gel(vP,o) = polcyclo(o,vt);
    9552             :     /* mfcharcxinit with dummy complex powers */
    9553       13601 :     gel(vCHI,i) = mkvecn(6, G0, chi0, go, v, dummy, P);
    9554       13601 :     D = mydivisorsu(N / F); l = lg(D);
    9555       39179 :     for (j = 1; j < l; j++) vecsmalltrunc_append(gel(bymod, F*D[j]), i);
    9556             :   }
    9557         574 :   phio = zero_zv(pn); l = lg(vCHI); prio = cgetg(l, t_VEC);
    9558       26152 :   for (i = 1; i < l; i++)
    9559             :   {
    9560       25578 :     GEN CHI = gel(vCHI,i);
    9561             :     long o;
    9562       25578 :     if (!CHI) continue;
    9563       13601 :     o = CHIvec_ord(CHI);
    9564       13601 :     if (!phio[o]) phio[o] = myeulerphiu(o);
    9565       13601 :     prio[i] = phio[o];
    9566             :   }
    9567         574 :   l = lg(bymod);
    9568             :   /* sort characters by increasing value of phi(order) */
    9569       26152 :   for (i = 1; i < l; i++)
    9570             :   {
    9571       25578 :     GEN z = gel(bymod,i);
    9572       25578 :     if (z) gen_sort_inplace(z, (void*)prio, &cmp_small_priority, NULL);
    9573             :   }
    9574         574 :   return mkvec3(vCHI, bymod, vG);
    9575             : }
    9576             : 
    9577             : static GEN
    9578        4893 : mfeisenstein2pure(long k, GEN CHI1, GEN CHI2, long ord, GEN P, long lim)
    9579             : {
    9580        4893 :   GEN c, V = cgetg(lim+2, t_COL);
    9581             :   long n;
    9582        4893 :   c = mfeisenstein2_0(k, CHI1, CHI2, ord);
    9583        4893 :   if (P) c = grem(c, P);
    9584        4893 :   gel(V,1) = c;
    9585       97587 :   for (n=1; n <= lim; n++)
    9586             :   {
    9587       92694 :     c = sigchi2(k, CHI1, CHI2, n, ord);
    9588       92694 :     if (P) c = grem(c, P);
    9589       92694 :     gel(V,n+1) = c;
    9590             :   }
    9591        4893 :   return V;
    9592             : }
    9593             : static GEN
    9594        4137 : mfeisenstein2pure_Fl(long k, GEN CHI1vec, GEN CHI2vec, GEN vz, ulong p, long lim)
    9595             : {
    9596        4137 :   GEN V = cgetg(lim+2, t_VECSMALL);
    9597             :   long n;
    9598        4137 :   V[1] = mfeisenstein2_0_Fl(k, CHI1vec, CHI2vec, vz, p);
    9599       58625 :   for (n=1; n <= lim; n++) V[n+1] = sigchi2_Fl(k, CHI1vec, CHI2vec, n, vz, p);
    9600        4137 :   return V;
    9601             : }
    9602             : 
    9603             : static GEN
    9604         224 : getcolswt2(GEN M, GEN D, ulong p)
    9605             : {
    9606         224 :   GEN R, v = gel(M,1);
    9607         224 :   long i, l = lg(M) - 1;
    9608         224 :   R = cgetg(l, t_MAT); /* skip D[1] = 1 */
    9609         896 :   for (i = 1; i < l; i++)
    9610             :   {
    9611         672 :     GEN w = Flv_Fl_mul(gel(M,i+1), D[i+1], p);
    9612         672 :     gel(R,i) = Flv_sub(v, w, p);
    9613             :   }
    9614         224 :   return R;
    9615             : }
    9616             : static GEN
    9617        5124 : expandbd(GEN V, long d)
    9618             : {
    9619             :   long L, n, nd;
    9620             :   GEN W;
    9621        5124 :   if (d == 1) return V;
    9622        1988 :   L = lg(V)-1; W = zerocol(L); /* nd = n/d */
    9623       17500 :   for (n = nd = 0; n < L; n += d, nd++) gel(W, n+1) = gel(V, nd+1);
    9624        1988 :   return W;
    9625             : }
    9626             : static GEN
    9627        6587 : expandbd_Fl(GEN V, long d)
    9628             : {
    9629             :   long L, n, nd;
    9630             :   GEN W;
    9631        6587 :   if (d == 1) return V;
    9632        2450 :   L = lg(V)-1; W = zero_Flv(L); /* nd = n/d */
    9633       15729 :   for (n = nd = 0; n < L; n += d, nd++) W[n+1] = V[nd+1];
    9634        2450 :   return W;
    9635             : }
    9636             : static void
    9637        4137 : getcols_i(GEN *pM, GEN *pvj, GEN gk, GEN CHI1vec, GEN CHI2vec, long NN1, GEN vz,
    9638             :           ulong p, long lim)
    9639             : {
    9640        4137 :   GEN CHI1 = CHIvec_CHI(CHI1vec), CHI2 = CHIvec_CHI(CHI2vec);
    9641        4137 :   long N2 = CHIvec_N(CHI2vec);
    9642        4137 :   GEN vj, M, D = mydivisorsu(NN1/N2);
    9643        4137 :   long i, l = lg(D), k = gk[2];
    9644        4137 :   GEN V = mfeisenstein2pure_Fl(k, CHI1vec, CHI2vec, vz, p, lim);
    9645        4137 :   M = cgetg(l, t_MAT);
    9646       10724 :   for (i = 1; i < l; i++) gel(M,i) = expandbd_Fl(V, D[i]);
    9647        4137 :   if (k == 2 && N2 == 1 && CHIvec_N(CHI1vec) == 1)
    9648             :   {
    9649         224 :     M = getcolswt2(M, D, p); l--;
    9650         224 :     D = vecslice(D, 2, l);
    9651             :   }
    9652        4137 :   *pM = M;
    9653        4137 :   *pvj = vj = cgetg(l, t_VEC);
    9654       10500 :   for (i = 1; i < l; i++) gel(vj,i) = mkvec4(gk, CHI1, CHI2, utoipos(D[i]));
    9655        4137 : }
    9656             : 
    9657             : /* find all CHI1, CHI2 mod N such that CHI1*CHI2 = CHI, f(CHI1)*f(CHI2) | N.
    9658             :  * set M = mfcoefs(B_e E(CHI1,CHI2), lim), vj = [e,i1,i2] */
    9659             : static void
    9660        1687 : getcols(GEN *pM, GEN *pv, long k, long nCHI, GEN allN, GEN vz, ulong p,
    9661             :         long lim)
    9662             : {
    9663        1687 :   GEN vCHI = gel(allN,1), gk = utoi(k);
    9664        1687 :   GEN M = cgetg(1,t_MAT), v = cgetg(1,t_VEC);
    9665        1687 :   long i1, N = lg(vCHI)-1;
    9666       84938 :   for (i1 = 1; i1 <= N; i1++)
    9667             :   {
    9668       83251 :     GEN CHI1vec = gel(vCHI, i1), CHI2vec, M1, v1;
    9669             :     long NN1, i2;
    9670      145859 :     if (!CHI1vec) continue;
    9671       65632 :     if (k == 1 && CHIvec_parity(CHI1vec) == -1) continue;
    9672       40936 :     NN1 = N/CHIvec_N(CHI1vec); /* N/f(chi1) */;
    9673       40936 :     i2 = Fl_div(nCHI,i1, N);
    9674       40936 :     if (!i2) i2 = 1;
    9675       40936 :     CHI2vec = gel(vCHI,i2);
    9676       40936 :     if (NN1 % CHIvec_N(CHI2vec)) continue; /* f(chi1)f(chi2) | N ? */
    9677        3024 :     getcols_i(&M1, &v1, gk, CHI1vec, CHI2vec, NN1, vz, p, lim);
    9678        3024 :     M = shallowconcat(M, M1);
    9679        3024 :     v = shallowconcat(v, v1);
    9680             :   }
    9681        1687 :   *pM = M;
    9682        1687 :   *pv = v;
    9683        1687 : }
    9684             : 
    9685             : static void
    9686        1120 : update_Mj(GEN *M, GEN *vecj, GEN *pz, ulong p)
    9687             : {
    9688             :   GEN perm;
    9689        1120 :   *pz = Flm_indexrank(*M, p); perm = gel(*pz,2);
    9690        1120 :   *M = vecpermute(*M, perm);
    9691        1120 :   *vecj = vecpermute(*vecj, perm);
    9692        1120 : }
    9693             : static int
    9694         357 : getcolsgen(long dim, GEN *pM, GEN *pvj, GEN *pz, long k, long ell, long nCHI,
    9695             :            GEN allN, GEN vz, ulong p, long lim)
    9696             : {
    9697         357 :   GEN vCHI = gel(allN,1), bymod = gel(allN,2), gell = utoi(ell);
    9698         357 :   long i1, N = lg(vCHI)-1;
    9699         357 :   long L = lim+1;
    9700         357 :   if (lg(*pvj)-1 >= dim) update_Mj(pM, pvj, pz, p);
    9701         357 :   if (lg(*pvj)-1 == dim) return 1;
    9702        1526 :   for (i1 = 1; i1 <= N; i1++)
    9703             :   {
    9704        1505 :     GEN CHI1vec = gel(vCHI, i1), T;
    9705             :     long par1, j, l, N1, NN1;
    9706             : 
    9707        1505 :     if (!CHI1vec) continue;
    9708        1484 :     par1 = CHIvec_parity(CHI1vec);
    9709        1484 :     if (ell == 1 && par1 == -1) continue;
    9710         903 :     if (odd(ell)) par1 = -par1;
    9711         903 :     N1 = CHIvec_N(CHI1vec);
    9712         903 :     NN1 = N/N1;
    9713         903 :     T = gel(bymod, NN1); l = lg(T);
    9714        3528 :     for (j = 1; j < l; j++)
    9715             :     {
    9716        2947 :       long i2 = T[j], l1, l2, j1, s, nC;
    9717        2947 :       GEN M, M1, M2, vj, vj1, vj2, CHI2vec = gel(vCHI, i2);
    9718        2947 :       if (CHIvec_parity(CHI2vec) != par1) continue;
    9719        1113 :       nC = Fl_div(nCHI, Fl_mul(i1,i2,N), N);
    9720        1113 :       getcols(&M2, &vj2, k-ell, nC, allN, vz, p, lim);
    9721        1113 :       l2 = lg(M2); if (l2 == 1) continue;
    9722        1113 :       getcols_i(&M1, &vj1, gell, CHI1vec, CHI2vec, NN1, vz, p, lim);
    9723        1113 :       l1 = lg(M1);
    9724        1113 :       M1 = Flm_to_FlxV(M1, 0);
    9725        1113 :       M2 = Flm_to_FlxV(M2, 0);
    9726        1113 :       M  = cgetg((l1-1)*(l2-1) + 1, t_MAT);
    9727        1113 :       vj = cgetg((l1-1)*(l2-1) + 1, t_VEC);
    9728        2737 :       for (j1 = s = 1; j1 < l1; j1++)
    9729             :       {
    9730        1624 :         GEN E = gel(M1,j1), v = gel(vj1,j1);
    9731             :         long j2;
    9732        6811 :         for (j2 = 1; j2 < l2; j2++, s++)
    9733             :         {
    9734        5187 :           GEN c = Flx_to_Flv(Flxn_mul(E, gel(M2,j2), L, p), L);
    9735        5187 :           gel(M,s) = c;
    9736        5187 :           gel(vj,s) = mkvec2(v, gel(vj2,j2));
    9737             :         }
    9738             :       }
    9739        1113 :       *pM = shallowconcat(*pM, M);
    9740        1113 :       *pvj = shallowconcat(*pvj, vj);
    9741        1113 :       if (lg(*pvj)-1 >= dim) update_Mj(pM, pvj, pz, p);
    9742        1113 :       if (lg(*pvj)-1 == dim) return 1;
    9743             :     }
    9744             :   }
    9745          21 :   if (ell == 1)
    9746             :   {
    9747          21 :     update_Mj(pM, pvj, pz, p);
    9748          21 :     return (lg(*pvj)-1 == dim);
    9749             :   }
    9750           0 :   return 0;
    9751             : }
    9752             : 
    9753             : static GEN
    9754        1456 : mkF2bd(long d, long lim)
    9755             : {
    9756        1456 :   GEN V = zerovec(lim + 1);
    9757             :   long n;
    9758        1456 :   gel(V, 1) = ginv(stoi(-24));
    9759       14623 :   for (n = 1; n <= lim/d; n++) gel(V, n*d + 1) = mysumdivku(n, 1);
    9760        1456 :   return V;
    9761             : }
    9762             : 
    9763             : static GEN
    9764        5467 : mkeisen(GEN E, long ord, GEN P, long lim)
    9765             : {
    9766        5467 :   long k = itou(gel(E,1)), e = itou(gel(E,4));
    9767        5467 :   GEN CHI1 = gel(E,2), CHI2 = gel(E,3);
    9768        5467 :   if (k == 2 && mfcharistrivial(CHI1) && mfcharistrivial(CHI2))
    9769         574 :     return gsub(mkF2bd(1,lim), gmulgs(mkF2bd(e,lim), e));
    9770             :   else
    9771             :   {
    9772        4893 :     GEN V = mfeisenstein2pure(k, CHI1, CHI2, ord, P, lim);
    9773        4893 :     return expandbd(V, e);
    9774             :   }
    9775             : }
    9776             : static GEN
    9777         532 : mkM(GEN vj, long pn, GEN P, long lim)
    9778             : {
    9779         532 :   long j, l = lg(vj), L = lim+1;
    9780         532 :   GEN M = cgetg(l, t_MAT);
    9781        4508 :   for (j = 1; j < l; j++)
    9782             :   {
    9783             :     GEN E1, E2;
    9784        3976 :     parse_vecj(gel(vj,j), &E1,&E2);
    9785        3976 :     E1 = RgV_to_RgX(mkeisen(E1, pn, P, lim), 0);
    9786        3976 :     if (E2)
    9787             :     {
    9788        1491 :       E2 = RgV_to_RgX(mkeisen(E2, pn, P, lim), 0);
    9789        1491 :       E1 = RgXn_mul(E1, E2, L);
    9790             :     }
    9791        3976 :     E1 = RgX_to_RgC(E1, L);
    9792        3976 :     if (P && E2) E1 = RgXQV_red(E1, P);
    9793        3976 :     gel(M,j) = E1;
    9794             :   }
    9795         532 :   return M;
    9796             : }
    9797             : 
    9798             : /* assume N > 2 */
    9799             : static GEN
    9800          35 : mffindeisen1(long N)
    9801             : {
    9802          35 :   GEN G = znstar0(utoipos(N), 1), L = chargalois(G, NULL), chi0 = NULL;
    9803          35 :   long j, m = N, l = lg(L);
    9804         259 :   for (j = 1; j < l; j++)
    9805             :   {
    9806         245 :     GEN chi = gel(L,j);
    9807         245 :     long r = myeulerphiu(itou(zncharorder(G,chi)));
    9808         245 :     if (r >= m) continue;
    9809         182 :     chi = znconreyfromchar(G, chi);
    9810         182 :     if (zncharisodd(G,chi)) { m = r; chi0 = chi; if (r == 1) break; }
    9811             :   }
    9812          35 :   if (!chi0) pari_err_BUG("mffindeisen1 [no Eisenstein series found]");
    9813          35 :   chi0 = znchartoprimitive(G,chi0);
    9814          35 :   return mfcharGL(gel(chi0,1), gel(chi0,2));
    9815             : }
    9816             : 
    9817             : static GEN
    9818         574 : mfeisensteinspaceinit_i(long N, long k, GEN CHI)
    9819             : {
    9820         574 :   GEN M, Minv, vj, vG, GN, allN, P, vz, z = NULL;
    9821         574 :   long nCHI, lim, ell, ord, dim = mffulldim(N, k, CHI);
    9822             :   ulong r, p;
    9823             : 
    9824         574 :   if (!dim) retmkvec3(cgetg(1,t_VECSMALL),
    9825             :                       mkvec2(cgetg(1,t_MAT),gen_1),cgetg(1,t_VEC));
    9826         574 :   lim = mfsturmNk(N, k) + 1;
    9827         574 :   allN = charsmodN(N);
    9828         574 :   vG = gel(allN,3);
    9829         574 :   GN = gel(vG,N);
    9830         574 :   ord = znstar_get_expo(GN);
    9831         574 :   P = ord <= 2? NULL: polcyclo(ord, varn(mfcharpol(CHI)));
    9832         574 :   CHI = induce(GN, CHI); /* lift CHI mod N before mfcharno*/
    9833         574 :   nCHI = mfcharno(CHI);
    9834         574 :   r = QabM_init(ord, &p);
    9835         574 :   vz = Fl_powers(r, ord, p);
    9836         574 :   getcols(&M, &vj, k, nCHI, allN, vz, p, lim);
    9837         595 :   for (ell = k>>1; ell >= 1; ell--)
    9838         357 :     if (getcolsgen(dim, &M, &vj, &z, k, ell, nCHI, allN, vz, p, lim)) break;
    9839         574 :   if (!z) update_Mj(&M, &vj, &z, p);
    9840         574 :   if (lg(vj) - 1 < dim) return NULL;
    9841         532 :   M = mkM(vj, ord, P, lim);
    9842         532 :   Minv = QabM_Minv(rowpermute(M, gel(z,1)), P, ord);
    9843         532 :   return mkvec4(gel(z,1), Minv, vj, utoi(ord));
    9844             : }
    9845             : /* true mf */
    9846             : static GEN
    9847         532 : mfeisensteinspaceinit(GEN mf)
    9848             : {
    9849         532 :   pari_sp av = avma;
    9850         532 :   GEN z, CHI = MF_get_CHI(mf);
    9851         532 :   long N = MF_get_N(mf), k = MF_get_k(mf);
    9852         532 :   if (!CHI) CHI = mfchartrivial();
    9853         532 :   z = mfeisensteinspaceinit_i(N, k, CHI);
    9854         532 :   if (!z)
    9855             :   {
    9856          35 :     GEN E, CHIN = mffindeisen1(N), CHI0 = mfchartrivial();
    9857          35 :     z = mfeisensteinspaceinit_i(N, k+1, mfcharmul(CHI, CHIN));
    9858          35 :     if (z) E = mkvec4(gen_1, CHI0, CHIN, gen_1);
    9859             :     else
    9860             :     {
    9861           7 :       z = mfeisensteinspaceinit_i(N, k+2, CHI);
    9862           7 :       E = mkvec4(gen_2, CHI0, CHI0, utoipos(N));
    9863             :     }
    9864          35 :     z = mkvec2(z, E);
    9865             :   }
    9866         532 :   return gerepilecopy(av, z);
    9867             : }
    9868             : 
    9869             : /* decomposition of modular form on eisenspace */
    9870             : static GEN
    9871         945 : mfeisensteindec(GEN mf, GEN F)
    9872             : {
    9873         945 :   pari_sp av = avma;
    9874             :   GEN M, Mindex, Mvecj, V, B, CHI;
    9875             :   long o, ord;
    9876             : 
    9877         945 :   Mvecj = obj_checkbuild(mf, MF_EISENSPACE, &mfeisensteinspaceinit);
    9878         945 :   if (lg(Mvecj) < 5)
    9879             :   {
    9880          56 :     GEN E, e = gel(Mvecj,2), gkE = gel(e,1);
    9881          56 :     long dE = itou(gel(e,4));
    9882          56 :     Mvecj = gel(Mvecj,1);
    9883          56 :     E = mfeisenstein(itou(gkE), NULL, gel(e,3));
    9884          56 :     if (dE != 1) E = mfbd_E2(E, dE, gel(e,2)); /* here k = 2 */
    9885          56 :     F = mfmul(F, E);
    9886             :   }
    9887         945 :   M = gel(Mvecj, 2);
    9888         945 :   if (lg(M) == 1) return cgetg(1, t_VEC);
    9889         945 :   Mindex = gel(Mvecj, 1);
    9890         945 :   ord = itou(gel(Mvecj,4));
    9891         945 :   V = mfcoefs(F, Mindex[lg(Mindex)-1]-1, 1); settyp(V, t_COL);
    9892         945 :   CHI = mf_get_CHI(F);
    9893         945 :   o = mfcharorder(CHI);
    9894         945 :   if (o > 2 && o != ord)
    9895             :   { /* convert Mod(.,polcyclo(o)) to Mod(., polcyclo(N)) for o | N,
    9896             :      * o and N both != 2 (mod 4) */
    9897          84 :     GEN z, P = gel(M,4); /* polcyclo(ord) */
    9898          84 :     long vt = varn(P);
    9899          84 :     z = gmodulo(pol_xn(ord/o, vt), P);
    9900          84 :     if (ord % o) pari_err_TYPE("mfeisensteindec", V);
    9901          84 :     V = gsubst(liftpol_shallow(V), vt, z);
    9902             :   }
    9903         945 :   B = Minv_RgC_mul(M, vecpermute(V, Mindex));
    9904         945 :   return gerepileupto(av, B);
    9905             : }
    9906             : 
    9907             : /*********************************************************************/
    9908             : /*                        END EISENSPACE                             */
    9909             : /*********************************************************************/
    9910             : 
    9911             : static GEN
    9912          70 : sertocol2(GEN S, long l)
    9913             : {
    9914          70 :   GEN C = cgetg(l + 2, t_COL);
    9915             :   long i;
    9916         420 :   for (i = 0; i <= l; i++) gel(C, i+1) = polcoef_i(S, i, -1);
    9917          70 :   return C;
    9918             : }
    9919             : 
    9920             : /* Compute polynomial P0 such that F=E4^(k/4)P0(E6/E4^(3/2)). */
    9921             : static GEN
    9922          14 : mfcanfindp0(GEN F, long k)
    9923             : {
    9924          14 :   pari_sp ltop = avma;
    9925             :   GEN E4, E6, V, V1, Q, W, res, M, B;
    9926             :   long l, j;
    9927          14 :   l = k/6 + 2;
    9928          14 :   V = mfcoefsser(F,l);
    9929          14 :   E4 = mfcoefsser(mfEk(4),l);
    9930          14 :   E6 = mfcoefsser(mfEk(6),l);
    9931          14 :   V1 = gdiv(V, gpow(E4, sstoQ(k,4), 0));
    9932          14 :   Q = gdiv(E6, gpow(E4, sstoQ(3,2), 0));
    9933          14 :   W = gpowers(Q, l - 1);
    9934          14 :   M = cgetg(l + 1, t_MAT);
    9935          70 :   for (j = 1; j <= l; j++) gel(M,j) = sertocol2(gel(W,j), l);
    9936          14 :   B = sertocol2(V1, l);
    9937          14 :   res = inverseimage(M, B);
    9938          14 :   if (lg(res) == 1) err_space(F);
    9939          14 :   return gerepilecopy(ltop, gtopolyrev(res, 0));
    9940             : }
    9941             : 
    9942             : /* Compute the first n+1 Taylor coeffs at tau=I of a modular form
    9943             :  * on SL_2(Z). */
    9944             : GEN
    9945          14 : mftaylor(GEN F, long n, long flreal, long prec)
    9946             : {
    9947          14 :   pari_sp ltop = avma;
    9948          14 :   GEN P0, Pm1 = gen_0, v;
    9949          14 :   GEN X2 = mkpoln(3, ghalf,gen_0,gneg(ghalf)); /* (x^2-1) / 2 */
    9950             :   long k, m;
    9951          14 :   if (!checkmf_i(F)) pari_err_TYPE("mftaylor",F);
    9952          14 :   k = mf_get_k(F);
    9953          14 :   if (mf_get_N(F) != 1 || k < 0) pari_err_IMPL("mftaylor for this form");
    9954          14 :   P0 = mfcanfindp0(F, k);
    9955          14 :   v = cgetg(n+2, t_VEC); gel(v, 1) = RgX_coeff(P0,0);
    9956         154 :   for (m = 0; m < n; m++)
    9957             :   {
    9958         140 :     GEN P1 = gdivgs(gmulsg(-(k + 2*m), RgX_shift(P0,1)), 12);
    9959         140 :     P1 = gadd(P1, gmul(X2, RgX_deriv(P0)));
    9960         140 :     if (m) P1 = gsub(P1, gdivgs(gmulsg(m*(m+k-1), Pm1), 144));
    9961         140 :     Pm1 = P0; P0 = P1;
    9962         140 :     gel(v, m+2) = RgX_coeff(P0, 0);
    9963             :   }
    9964          14 :   if (flreal)
    9965             :   {
    9966           7 :     GEN pi2 = Pi2n(1, prec), pim4 = gmulsg(-2, pi2), VPC;
    9967           7 :     GEN C = gmulsg(3, gdiv(gpowgs(ggamma(ginv(utoi(4)), prec), 8), gpowgs(pi2, 6)));
    9968             :     /* E_4(i): */
    9969           7 :     GEN facn = gen_1;
    9970           7 :     VPC = gpowers(gmul(pim4, gsqrt(C, prec)), n);
    9971           7 :     C = gpow(C, sstoQ(k,4), prec);
    9972          84 :     for (m = 0; m <= n; m++)
    9973             :     {
    9974          77 :       gel(v, m+1) = gdiv(gmul(C, gmul(gel(v, m+1), gel(VPC, m+1))), facn);
    9975          77 :       facn = gmulgs(facn, m+1);
    9976             :     }
    9977             :   }
    9978          14 :   return gerepilecopy(ltop, v);
    9979             : }
    9980             : 
    9981             : #if 0
    9982             : /* To be used in mfeigensearch() */
    9983             : GEN
    9984             : mfreadratfile()
    9985             : {
    9986             :   GEN eqn;
    9987             :   pariFILE *F = pari_fopengz("rateigen300.gp");
    9988             :   eqn = gp_readvec_stream(F->file);
    9989             :   pari_fclose(F);
    9990             :   return eqn;
    9991             : }
    9992             : #endif
    9993             :  /*****************************************************************/
    9994             : /*           EISENSTEIN CUSPS: COMPLEX DIRECTLY: one F_k         */
    9995             : /*****************************************************************/
    9996             : 
    9997             : /* CHIvec = charinit(CHI); data = [N1g/g1,N2g/g2,g1/g,g2/g,C/g1,C/g2,
    9998             :  * (N1g/g1)^{-1},(N2g/g2)^{-1}] */
    9999             : 
   10000             : /* nm = n/m;
   10001             :  * z1 = powers of \z_{C/g}^{(Ae/g)^{-1}},
   10002             :  * z2 = powers of \z_N^{A^{-1}(g1g2/C)}]
   10003             :  * N.B. : we compute value and conjugate at the end, so it is (Ae/g)^{-1}
   10004             :  * and not -(Ae/g)^{-1} */
   10005             : static GEN
   10006     7643496 : eiscnm(long nm, long m, GEN CHI1vec, GEN CHI2vec, GEN data, GEN z1)
   10007             : {
   10008     7643496 :   long Cg1 = data[5], s10 = (nm*data[7]) % Cg1, r10 = (nm - data[1]*s10) / Cg1;
   10009     7643496 :   long Cg2 = data[6], s20 = (m *data[8]) % Cg2, r20 = (m  - data[2]*s20) / Cg2;
   10010             :   long j1, r1, s1;
   10011     7643496 :   GEN T = gen_0;
   10012    18404232 :   for (j1 = 0, r1 = r10, s1 = s10; j1 < data[3]; j1++, r1 -= data[1], s1 += Cg1)
   10013             :   {
   10014    10760736 :     GEN c1 = mychareval(CHI1vec, r1);
   10015    10760736 :     if (!gequal0(c1))
   10016             :     {
   10017             :       long j2, r2, s2;
   10018     7907396 :       GEN S = gen_0;
   10019    20468378 :       for (j2 = 0, r2 = r20, s2 = s20; j2 < data[4]; j2++, r2 -= data[2], s2 += Cg2)
   10020             :       {
   10021    12560982 :         GEN c2 = mychareval(CHI2vec, r2);
   10022    12560982 :         if (!gequal0(c2)) S = gadd(S, gmul(c2, rootsof1pow(z1, s1*s2)));
   10023             :       }
   10024     7907396 :       T = gadd(T, gmul(c1, S));
   10025             :     }
   10026             :   }
   10027     7643496 :   return conj_i(T);
   10028             : }
   10029             : 
   10030             : static GEN
   10031      593467 : fg1g2n(long n, long k, GEN CHI1vec, GEN CHI2vec, GEN data, GEN z1, GEN z2)
   10032             : {
   10033      593467 :   pari_sp av = avma;
   10034      593467 :   GEN S = gen_0, D = mydivisorsu(n);
   10035      593467 :   long i, l = lg(D);
   10036     4415215 :   for (i = 1; i < l; i++)
   10037             :   {
   10038     3821748 :     long m = D[i], nm = D[l-i]; /* n/m */
   10039     3821748 :     GEN u = eiscnm( nm,  m, CHI1vec, CHI2vec, data, z1);
   10040     3821748 :     GEN v = eiscnm(-nm, -m, CHI1vec, CHI2vec, data, z1);
   10041     3821748 :     GEN w = odd(k) ? gsub(u, v) : gadd(u, v);
   10042     3821748 :     S = gadd(S, gmul(powuu(m, k-1), w));
   10043             :   }
   10044      593467 :   return gerepileupto(av, gmul(S, rootsof1pow(z2, n)));
   10045             : }
   10046             : 
   10047             : static GEN
   10048       13230 : gausssumcx(GEN CHIvec, long prec)
   10049             : {
   10050             :   GEN z, S, V;
   10051       13230 :   long m, N = CHIvec_N(CHIvec);
   10052       13230 :   if (N == 1) return gen_1;
   10053        7210 :   V = CHIvec_val(CHIvec);
   10054        7210 :   z = rootsof1u_cx(N, prec);
   10055        7210 :   S = gmul(z, gel(V, N));
   10056      100835 :   for (m = N-1; m >= 1; m--) S = gmul(z, gadd(gel(V, m), S));
   10057        7210 :   return S;
   10058             : }
   10059             : 
   10060             : /* Computation of Q_k(\z_N^s) as a polynomial in \z_N^s. FIXME: explicit
   10061             :  * formula ? */
   10062             : static GEN
   10063        2191 : mfqk(long k, long N)
   10064             : {
   10065             :   GEN X, P, ZI, Q, Xm1, invden;
   10066             :   long i;
   10067        2191 :   ZI = gdivgs(RgX_shift_shallow(RgV_to_RgX(identity_ZV(N-1), 0), 1), N);
   10068        2191 :   if (k == 1) return ZI;
   10069        1113 :   P = gsubgs(pol_xn(N,0), 1);
   10070        1113 :   invden = RgXQ_powu(ZI, k, P);
   10071        1113 :   X = pol_x(0); Q = gneg(X); Xm1 = gsubgs(X, 1);
   10072        2765 :   for (i = 2; i < k; i++)
   10073        1652 :     Q = RgX_shift_shallow(ZX_add(gmul(Xm1, ZX_deriv(Q)), gmulsg(-i, Q)), 1);
   10074        1113 :   return RgXQ_mul(Q, invden, P);
   10075             : }
   10076             : 
   10077             : /* CHI mfchar; M is a multiple of the conductor of CHI, but is NOT
   10078             :  * necessarily its modulus */
   10079             : static GEN
   10080        3066 : mfskcx(long k, GEN CHI, long M, long prec)
   10081             : {
   10082             :   GEN S, CHIvec, P;
   10083             :   long F, m, i, l;
   10084        3066 :   CHI = mfchartoprimitive(CHI, &F);
   10085        3066 :   CHIvec = mfcharcxinit(CHI, prec);
   10086        3066 :   if (F == 1) S = gdivgs(bernfrac(k), k);
   10087             :   else
   10088             :   {
   10089        2191 :     GEN Q = mfqk(k, F), V = CHIvec_val(CHIvec);
   10090        2191 :     S = gmul(gel(V, F), RgX_coeff(Q, 0));
   10091       38682 :     for (m = 1; m < F; m++) S = gadd(S, gmul(gel(V, m), RgX_coeff(Q, m)));
   10092        2191 :     S = conj_i(S);
   10093             :   }
   10094             :   /* prime divisors of M not dividing f(chi) */
   10095        3066 :   P = gel(myfactoru(u_ppo(M/F,F)), 1); l = lg(P);
   10096        3192 :   for (i = 1; i < l; i++)
   10097             :   {
   10098         126 :     long p = P[i];
   10099         126 :     S = gmul(S, gsubsg(1, gdiv(mychareval(CHIvec, p), powuu(p, k))));
   10100             :   }
   10101        3066 :   return gmul(gmul(gausssumcx(CHIvec, prec), S), powuu(M/F, k));
   10102             : }
   10103             : 
   10104             : static GEN
   10105        5684 : f00_i(long k, GEN CHI1vec, GEN CHI2vec, GEN G2, GEN S, long prec)
   10106             : {
   10107             :   GEN c, a;
   10108        5684 :   long N1 = CHIvec_N(CHI1vec), N2 = CHIvec_N(CHI2vec);
   10109        5684 :   if (S[2] != N1) return gen_0;
   10110        3066 :   c = mychareval(CHI1vec, S[3]);
   10111        3066 :   if (isintzero(c)) return gen_0;
   10112        3066 :   a = mfskcx(k, mfchardiv(CHIvec_CHI(CHI2vec), CHIvec_CHI(CHI1vec)), N1*N2, prec);
   10113        3066 :   a = gmul(a, conj_i(gmul(c,G2)));
   10114        3066 :   return gdiv(a, mulsi(-N2, powuu(S[1], k-1)));
   10115             : }
   10116             : 
   10117             : static GEN
   10118        4487 : f00(long k, GEN CHI1vec,GEN CHI2vec, GEN G1,GEN G2, GEN data, long prec)
   10119             : {
   10120             :   GEN T1, T2;
   10121        4487 :   T2 = f00_i(k, CHI1vec, CHI2vec, G2, data, prec);
   10122        4487 :   if (k > 1) return T2;
   10123        1197 :   T1 = f00_i(k, CHI2vec, CHI1vec, G1, data, prec);
   10124        1197 :   return gadd(T1, T2);
   10125             : }
   10126             : 
   10127             : /* ga in SL_2(Z), find beta [a,b;c,d] in Gamma_0(N) and mu in Z such that
   10128             :  * beta * ga * T^u = [A',B';C',D'] with C' | N and N | B', C' > 0 */
   10129             : static void
   10130        5082 : mfgatogap(GEN ga, long N, long *pA, long *pC, long *pD, long *pd, long *pmu)
   10131             : {
   10132        5082 :   GEN A = gcoeff(ga,1,1), B = gcoeff(ga,1,2);
   10133        5082 :   GEN C = gcoeff(ga,2,1), D = gcoeff(ga,2,2), a, b, c, d;
   10134             :   long t, Ap, Cp, B1, D1, mu;
   10135        5082 :   Cp = itou(bezout(muliu(A,N), C, &c, &d)); /* divides N */
   10136        5082 :   t = 0;
   10137        5082 :   if (Cp > 1)
   10138             :   { /* (d, N/Cp) = 1, find t such that (d - t*(A*N/Cp), N) = 1 */
   10139        2408 :     long dN = umodiu(d,Cp), Q = (N/Cp * umodiu(A,Cp)) % Cp;
   10140        2779 :     while (ugcd(dN, Cp) > 1) { t++; dN = Fl_sub(dN, Q, Cp); }
   10141             :   }
   10142        5082 :   if (t)
   10143             :   {
   10144         371 :     c = addii(c, mului(t, diviuexact(C,Cp)));
   10145         371 :     d = subii(d, mului(t, muliu(A, N/Cp))); /* (d,N) = 1 */
   10146             :   }
   10147        5082 :   D1 = umodiu(mulii(d,D), N);
   10148        5082 :   (void)bezout(d, mulis(c,-N), &a, &b); /* = 1 */
   10149        5082 :   t = 0; Ap = umodiu(addii(mulii(a,A), mulii(b,C)), N); /* (Ap,Cp) = 1 */
   10150        6937 :   while (ugcd(Ap, N) > 1) { t++; Ap = Fl_add(Ap, Cp, N); }
   10151        5082 :   B1 = umodiu(a,N)*umodiu(B,N) + umodiu(b,N)*umodiu(D,N) + t*D1;
   10152        5082 :   B1 %= N;
   10153        5082 :   *pmu = mu = Fl_neg(Fl_div(B1, Ap, N), N);
   10154             :   /* A', D' and d only needed modulo N */
   10155        5082 :   *pd = umodiu(d, N);
   10156        5082 :   *pA = Ap;
   10157        5082 :   *pC = Cp; *pD = (D1 + Cp*mu) % N;
   10158        5082 : }
   10159             : 
   10160             : #if 0
   10161             : /* CHI is a mfchar, return alpha(CHI) */
   10162             : static long
   10163             : mfalchi(GEN CHI, long AN, long cg)
   10164             : {
   10165             :   GEN G = gel(CHI,1), chi = gel(CHI,2), go = gmfcharorder(CHI);
   10166             :   long o = itou(go), a = itos( znchareval(G, chi, stoi(1 + AN/cg), go) );
   10167             :   if (a < 0 || (cg * a) % o) pari_err_BUG("mfalchi");
   10168             :   return (cg * a) / o;
   10169             : }
   10170             : #endif
   10171             : /* return A such that CHI1(t) * CHI2(t) = e(A) or NULL if (t,N1*N2) > 1 */
   10172             : static GEN
   10173       10164 : mfcharmuleval(GEN CHI1vec, GEN CHI2vec, long t)
   10174             : {
   10175       10164 :   long a1 = mycharexpo(CHI1vec, t), o1 = CHIvec_ord(CHI1vec);
   10176       10164 :   long a2 = mycharexpo(CHI2vec, t), o2 = CHIvec_ord(CHI2vec);;
   10177       10164 :   if (a1 < 0 || a2 < 0) return NULL;
   10178       10164 :   return sstoQ(a1*o2 + a2*o1, o1*o2);
   10179             : }
   10180             : static GEN
   10181        5082 : mfcharmulcxeval(GEN CHI1vec, GEN CHI2vec, long t, long prec)
   10182             : {
   10183        5082 :   GEN A = mfcharmuleval(CHI1vec, CHI2vec, t);
   10184             :   long n, d;
   10185        5082 :   if (!A) return gen_0;
   10186        5082 :   Qtoss(A, &n,&d); return rootsof1q_cx(n, d, prec);
   10187             : }
   10188             : /* alpha(CHI1 * CHI2) */
   10189             : static long
   10190        5082 : mfalchi2(GEN CHI1vec, GEN CHI2vec, long AN, long cg)
   10191             : {
   10192        5082 :   GEN A = mfcharmuleval(CHI1vec, CHI2vec, 1 + AN/cg);
   10193             :   long a;
   10194        5082 :   if (!A) pari_err_BUG("mfalchi2");
   10195        5082 :   A = gmulsg(cg, A);
   10196        5082 :   if (typ(A) != t_INT) pari_err_BUG("mfalchi2");
   10197        5082 :   a = itos(A) % cg; if (a < 0) a += cg;
   10198        5082 :   return a;
   10199             : }
   10200             : 
   10201             : /* return g = (a,b), set u >= 0 s.t. g = a * u (mod b) */
   10202             : static long
   10203       20328 : mybezout(long a, long b, long *pu)
   10204             : {
   10205       20328 :   long junk, g = cbezout(a, b, pu, &junk);
   10206       20328 :   if (*pu < 0) *pu += b/g;
   10207       20328 :   return g;
   10208             : }
   10209             : 
   10210             : /* E = [k, CHI1,CHI2, e], CHI1 and CHI2 primitive mfchars such that,
   10211             :  * CHI1(-1)*CHI2(-1) = (-1)^k; expansion of (B_e (E_k(CHI1,CHI2))) | ga.
   10212             :  * w is the width for the space of the calling function. */
   10213             : static GEN
   10214        5082 : mfeisensteingacx(GEN E, long w, GEN ga, long lim, long prec)
   10215             : {
   10216        5082 :   GEN CHI1vec, CHI2vec, CHI1 = gel(E,2), CHI2 = gel(E,3), v, S, ALPHA;
   10217             :   GEN G1, G2, z1, z2, data;
   10218        5082 :   long k = itou(gel(E,1)), e = itou(gel(E,4));
   10219        5082 :   long N1 = mfcharmodulus(CHI1);
   10220        5082 :   long N2 = mfcharmodulus(CHI2), N = e * N1 * N2;
   10221             :   long NsurC, cg, wN, A, C, Ai, d, mu, alchi, na, da;
   10222             :   long eg, g, gH, U, u0, u1, u2, Aig, H, m, n, t, Cg, NC1, NC2;
   10223             : 
   10224        5082 :   mfgatogap(ga, N, &A, &C, &Ai, &d, &mu);
   10225        5082 :   CHI1vec = mfcharcxinit(CHI1, prec);
   10226        5082 :   CHI2vec = mfcharcxinit(CHI2, prec);
   10227        5082 :   NsurC = N/C; cg  = ugcd(C, NsurC); wN = NsurC / cg;
   10228        5082 :   if (w%wN) pari_err_BUG("mfeisensteingacx [wN does not divide w]");
   10229        5082 :   alchi = mfalchi2(CHI1vec, CHI2vec, A*N, cg);
   10230        5082 :   ALPHA = sstoQ(alchi, NsurC);
   10231             : 
   10232        5082 :   g = mybezout(A*e, C, &u0); Cg = C/g; eg = e/g;
   10233        5082 :   NC1 = mybezout(N1, Cg, &u1);
   10234        5082 :   NC2 = mybezout(N2, Cg, &u2);
   10235        5082 :   H = (NC1*NC2*g)/Cg;
   10236        5082 :   Aig = (Ai*H)%N; if (Aig < 0) Aig += N;
   10237        5082 :   z1 = rootsof1powinit(u0, Cg, prec);
   10238        5082 :   z2 = rootsof1powinit(Aig, N, prec);
   10239        5082 :   data = mkvecsmalln(8, N1/NC1, N2/NC2, NC1, NC2, Cg/NC1, Cg/NC2, u1, u2);
   10240        5082 :   v = zerovec(lim + 1);
   10241             :   /* need n*H = alchi (mod cg) */
   10242        5082 :   gH = mybezout(H, cg, &U);
   10243        5082 :   if (gH > 1)
   10244             :   {
   10245         399 :     if (alchi % gH) return mkvec2(gen_0, v);
   10246         399 :     alchi /= gH; cg /= gH; H /= gH;
   10247             :   }
   10248        5082 :   G1 = gausssumcx(CHI1vec, prec);
   10249        5082 :   G2 = gausssumcx(CHI2vec, prec);
   10250        5082 :   if (!alchi)
   10251        4487 :     gel(v,1) = f00(k, CHI1vec,CHI2vec,G1,G2, mkvecsmall3(NC2,Cg,A*eg), prec);
   10252        5082 :   n = Fl_mul(alchi,U,cg); if (!n) n = cg;
   10253        5082 :   m = (n*H - alchi) / cg; /* positive, exact division */
   10254      598549 :   for (; m <= lim; n+=cg, m+=H)
   10255      593467 :     gel(v, m+1) = fg1g2n(n, k, CHI1vec, CHI2vec, data, z1,z2);
   10256        5082 :   t = (2*e)/g; if (odd(k)) t = -t;
   10257        5082 :   v = gdiv(v, gmul(conj_i(gmul(G1,G2)), mulsi(t, powuu(eg*N2/NC2, k-1))));
   10258        5082 :   if (k == 2 && N1 == 1 && N2 == 1) v = gsub(mkF2bd(wN,lim), gmulsg(e,v));
   10259             : 
   10260        5082 :   Qtoss(ALPHA, &na,&da);
   10261        5082 :   S = conj_i( mfcharmulcxeval(CHI1vec,CHI2vec,d,prec) ); /* CHI(1/d) */
   10262        5082 :   if (wN > 1)
   10263             :   {
   10264        3927 :     GEN z = rootsof1powinit(-mu, wN, prec);
   10265        3927 :     long i, l = lg(v);
   10266      571123 :     for (i = 1; i < l; i++) gel(v,i) = gmul(gel(v,i), rootsof1pow(z,i-1));
   10267             :   }
   10268        5082 :   v = RgV_Rg_mul(v, gmul(S, rootsof1q_cx(-mu*na, da, prec)));
   10269        5082 :   return mkvec2(ALPHA, bdexpand(v, w/wN));
   10270             : }
   10271             : 
   10272             : /*****************************************************************/
   10273             : /*                       END EISENSTEIN CUSPS                    */
   10274             : /*****************************************************************/
   10275             : 
   10276             : static GEN
   10277        1596 : mfchisimpl(GEN CHI)
   10278             : {
   10279             :   GEN G, chi;
   10280        1596 :   if (typ(CHI) == t_INT) return CHI;
   10281        1596 :   G = gel(CHI, 1); chi = gel(CHI, 2);
   10282        1596 :   switch(mfcharorder(CHI))
   10283             :   {
   10284        1148 :     case 1: chi = gen_1; break;
   10285         427 :     case 2: chi = znchartokronecker(G,chi,1); break;
   10286          21 :     default:chi = mkintmod(znconreyexp(G,chi), znstar_get_N(G)); break;
   10287             :   }
   10288        1596 :   return chi;
   10289             : }
   10290             : 
   10291             : GEN
   10292         700 : mfparams(GEN F)
   10293             : {
   10294         700 :   pari_sp av = avma;
   10295             :   GEN z, mf, CHI;
   10296         700 :   if ((mf = checkMF_i(F)))
   10297             :   {
   10298          14 :     long N = MF_get_N(mf);
   10299          14 :     GEN gk = MF_get_gk(mf);
   10300          14 :     CHI = MF_get_CHI(mf);
   10301          14 :     z = mkvec5(utoi(N), gk, CHI, utoi(MF_get_space(mf)), mfcharpol(CHI));
   10302             :   }
   10303             :   else
   10304             :   {
   10305         686 :     if (!checkmf_i(F)) pari_err_TYPE("mfparams", F);
   10306         686 :     z = vec_append(mf_get_NK(F), mfcharpol(mf_get_CHI(F)));
   10307             :   }
   10308         700 :   gel(z,3) = mfchisimpl(gel(z,3));
   10309         700 :   return gerepilecopy(av, z);
   10310             : }
   10311             : 
   10312             : GEN
   10313          14 : mfisCM(GEN F)
   10314             : {
   10315          14 :   pari_sp av = avma;
   10316             :   forprime_t S;
   10317             :   GEN D, v;
   10318             :   long N, k, lD, sb, p, i;
   10319          14 :   if (!checkmf_i(F)) pari_err_TYPE("mfisCM", F);
   10320          14 :   N = mf_get_N(F);
   10321          14 :   k = mf_get_k(F); if (N < 0 || k < 0) pari_err_IMPL("mfisCM for this F");
   10322          14 :   D = mfunram(N, -1);
   10323          14 :   lD = lg(D);
   10324          14 :   sb = maxss(mfsturmNk(N, k), 4*N);
   10325          14 :   v = mfcoefs_i(F, sb, 1);
   10326          14 :   u_forprime_init(&S, 2, sb);
   10327         504 :   while ((p = u_forprime_next(&S)))
   10328             :   {
   10329         490 :     GEN ap = gel(v, p+1);
   10330         490 :     if (!gequal0(ap))
   10331         406 :       for (i = 1; i < lD; i++)
   10332         245 :         if (kross(D[i], p) == -1) { D = vecsplice(D, i); lD--; }
   10333             :   }
   10334          14 :   if (lD == 1) { set_avma(av); return gen_0; }
   10335          14 :   if (lD == 2) { set_avma(av); return stoi(D[1]); }
   10336           7 :   if (k > 1) pari_err_BUG("mfisCM");
   10337           7 :   return gerepileupto(av, zv_to_ZV(D));
   10338             : }
   10339             : 
   10340             : static long
   10341         287 : mfspace_i(GEN mf, GEN F)
   10342             : {
   10343             :   GEN v, vF, gk;
   10344             :   long n, nE, i, l, s, N;
   10345             : 
   10346         287 :   mf = checkMF(mf); s = MF_get_space(mf);
   10347         287 :   if (!F) return s;
   10348         287 :   if (!checkmf_i(F)) pari_err_TYPE("mfspace",F);
   10349         287 :   v = mftobasis(mf, F, 1);
   10350         287 :   n = lg(v)-1; if (!n) return -1;
   10351         224 :   nE = lg(MF_get_E(mf))-1;
   10352         224 :   switch(s)
   10353             :   {
   10354          56 :     case mf_NEW: case mf_OLD: case mf_EISEN: return s;
   10355         140 :     case mf_FULL:
   10356         140 :       if (mf_get_type(F) == t_MF_THETA) return mf_EISEN;
   10357         133 :       if (!gequal0(vecslice(v,1,nE)))
   10358          63 :         return gequal0(vecslice(v,nE+1,n))? mf_EISEN: mf_FULL;
   10359             :   }
   10360             :   /* mf is mf_CUSP or mf_FULL, F a cusp form */
   10361          98 :   gk = mf_get_gk(F);
   10362          98 :   if (typ(gk) == t_FRAC || equali1(gk)) return mf_CUSP;
   10363          84 :   vF = mftonew_i(mf, vecslice(v, nE+1, n), &N);
   10364          84 :   if (N != MF_get_N(mf)) return mf_OLD;
   10365          56 :   l = lg(vF);
   10366          91 :   for (i = 1; i < l; i++)
   10367          56 :     if (itos(gmael(vF,i,1)) != N) return mf_CUSP;
   10368          35 :   return mf_NEW;
   10369             : }
   10370             : long
   10371         287 : mfspace(GEN mf, GEN F)
   10372         287 : { pari_sp av = avma; return gc_long(av, mfspace_i(mf,F)); }
   10373             : static GEN
   10374          21 : lfunfindchi(GEN ldata, GEN van, long prec)
   10375             : {
   10376          21 :   GEN gN = ldata_get_conductor(ldata), gk = ldata_get_k(ldata);
   10377          21 :   GEN G = znstar0(gN,1), cyc = znstar_get_conreycyc(G), L, go, vz;
   10378          21 :   long N = itou(gN), odd = typ(gk) == t_INT && mpodd(gk);
   10379          21 :   long i, j, o, l, B0 = 2, B = lg(van)-1, bit = 10 - prec2nbits(prec);
   10380             : 
   10381             :   /* if van is integral, chi must be trivial */
   10382          21 :   if (typ(van) == t_VECSMALL) return mfcharGL(G, zerocol(lg(cyc)-1));
   10383          14 :   L = cyc2elts(cyc); l = lg(L);
   10384          42 :   for (i = j = 1; i < l; i++)
   10385             :   {
   10386          28 :     GEN chi = zc_to_ZC(gel(L,i));
   10387          28 :     if (zncharisodd(G,chi) == odd) gel(L,j++) = mfcharGL(G,chi);
   10388             :   }
   10389          14 :   setlg(L,j); l = j;
   10390          14 :   if (l <= 2) return gel(L,1);
   10391           0 :   o = znstar_get_expo(G); go = utoi(o);
   10392           0 :   vz = grootsof1(o, prec);
   10393             :   for (;;)
   10394           0 :   {
   10395             :     long n;
   10396           0 :     for (n = B0; n <= B; n++)
   10397             :     {
   10398             :       GEN an, r;
   10399             :       long j;
   10400           0 :       if (ugcd(n, N) != 1) continue;
   10401           0 :       an = gel(van,n); if (gexpo(an) < bit) continue;
   10402           0 :       r = gdiv(an, conj_i(an));
   10403           0 :       for (i = 1; i < l; i++)
   10404             :       {
   10405           0 :         GEN CHI = gel(L,i);
   10406           0 :         if (gexpo(gsub(r, gel(vz, znchareval_i(CHI,n,go)+1))) > bit)
   10407           0 :           gel(L,i) = NULL;
   10408             :       }
   10409           0 :       for (i = j = 1; i < l; i++)
   10410           0 :         if (gel(L,i)) gel(L,j++) = gel(L,i);
   10411           0 :       l = j; setlg(L,l);
   10412           0 :       if (l == 2) return gel(L,1);
   10413             :     }
   10414           0 :     B0 = B+1; B <<= 1;
   10415           0 :     van = ldata_vecan(ldata_get_an(ldata), B, prec);
   10416             :   }
   10417             : }
   10418             : 
   10419             : GEN
   10420          21 : mffromlfun(GEN L, long prec)
   10421             : {
   10422          21 :   pari_sp av = avma;
   10423          21 :   GEN ldata = lfunmisc_to_ldata_shallow(L), Vga = ldata_get_gammavec(ldata);
   10424          21 :   GEN van, a0, CHI, NK, gk = ldata_get_k(ldata);
   10425             :   long N, space;
   10426          21 :   if (!gequal(Vga, mkvec2(gen_0, gen_1))) pari_err_TYPE("mffromlfun", L);
   10427          21 :   N = itou(ldata_get_conductor(ldata));
   10428          21 :   van = ldata_vecan(ldata_get_an(ldata), mfsturmNgk(N,gk) + 2, prec);
   10429          21 :   CHI = lfunfindchi(ldata, van, prec);
   10430          21 :   if (typ(van) != t_VEC) van = vecsmall_to_vec_inplace(van);
   10431          21 :   space = (lg(ldata) == 7)? mf_CUSP: mf_FULL;
   10432          21 :   a0 = (space == mf_CUSP)? gen_0: gneg(lfun(L, gen_0, prec2nbits(prec)));
   10433          21 :   NK = mkvec3(utoi(N), gk, mfchisimpl(CHI));
   10434          21 :   return gerepilecopy(av, mkvec3(NK, utoi(space), shallowconcat(a0, van)));
   10435             : }
   10436             : /*******************************************************************/
   10437             : /*                                                                 */
   10438             : /*                       HALF-INTEGRAL WEIGHT                      */
   10439             : /*                                                                 */
   10440             : /*******************************************************************/
   10441             : /* We use the prefix mf2; k represents the weight -1/2, so e.g.
   10442             :    k = 2 is weight 5/2. N is the level, so 4\mid N, and CHI is the
   10443             :    character, always even. */
   10444             : 
   10445             : static long
   10446        3360 : lamCO(long r, long s, long p)
   10447             : {
   10448        3360 :   if ((s << 1) <= r)
   10449             :   {
   10450        1232 :     long rp = r >> 1;
   10451        1232 :     if (odd(r)) return upowuu(p, rp) << 1;
   10452         336 :     else return (p + 1)*upowuu(p, rp - 1);
   10453             :   }
   10454        2128 :   else return upowuu(p, r - s) << 1;
   10455             : }
   10456             : 
   10457             : static int
   10458        1568 : condC(GEN faN, GEN valF)
   10459             : {
   10460        1568 :   GEN P = gel(faN, 1), E = gel(faN, 2);
   10461        1568 :   long l = lg(P), i;
   10462        3696 :   for (i = 1; i < l; i++)
   10463        3024 :     if ((P[i] & 3L) == 3)
   10464             :     {
   10465        1120 :       long r = E[i];
   10466        1120 :       if (odd(r) || r < (valF[i] << 1)) return 1;
   10467             :     }
   10468         672 :   return 0;
   10469             : }
   10470             : 
   10471             : /* returns 2*zetaCO; weight is k + 1/2 */
   10472             : static long
   10473        3696 : zeta2CO(GEN faN, GEN valF, long r2, long s2, long k)
   10474             : {
   10475        3696 :   if (r2 >= 4) return lamCO(r2, s2, 2) << 1;
   10476        2912 :   if (r2 == 3) return 6;
   10477        1568 :   if (condC(faN, valF)) return 4;
   10478         672 :   if (odd(k)) return s2 ? 3 : 5; else return s2 ? 5: 3;
   10479             : }
   10480             : 
   10481             : /* returns 4 times last term in formula */
   10482             : static long
   10483        3696 : dim22(long N, long F, long k)
   10484             : {
   10485        3696 :   pari_sp av = avma;
   10486        3696 :   GEN vF, faN = myfactoru(N), P = gel(faN, 1), E = gel(faN, 2);
   10487        3696 :   long i, D, l = lg(P);
   10488        3696 :   vF = cgetg(l, t_VECSMALL);
   10489        9968 :   for (i = 1; i < l; i++) vF[i] = u_lval(F, P[i]);
   10490        3696 :   D = zeta2CO(faN, vF, E[1], vF[1], k);
   10491        6272 :   for (i = 2; i < l; i++) D *= lamCO(E[i], vF[i], P[i]);
   10492        3696 :   return gc_long(av,D);
   10493             : }
   10494             : 
   10495             : /* PSI not necessarily primitive, of conductor F */
   10496             : static int
   10497       13846 : charistotallyeven(GEN PSI, long F)
   10498             : {
   10499       13846 :   pari_sp av = avma;
   10500       13846 :   GEN P = gel(myfactoru(F), 1);
   10501       13846 :   GEN G = gel(PSI,1), psi = gel(PSI,2);
   10502             :   long i;
   10503       14350 :   for (i = 1; i < lg(P); i++)
   10504             :   {
   10505         532 :     GEN psip = znchardecompose(G, psi, utoipos(P[i]));
   10506         532 :     if (zncharisodd(G, psip)) return gc_bool(av,0);
   10507             :   }
   10508       13818 :   return gc_bool(av,1);
   10509             : }
   10510             : 
   10511             : static GEN
   10512      299775 : get_PSI(GEN CHI, long t)
   10513             : {
   10514      299775 :   long r = t & 3L, t2 = (r == 2 || r == 3) ? t << 2 : t;
   10515      299775 :   return mfcharmul_i(CHI, induce(gel(CHI,1), utoipos(t2)));
   10516             : }
   10517             : /* space = mf_CUSP, mf_EISEN or mf_FULL, weight k + 1/2 */
   10518             : static long
   10519       41363 : mf2dimwt12(long N, GEN CHI, long space)
   10520             : {
   10521       41363 :   pari_sp av = avma;
   10522       41363 :   GEN D = mydivisorsu(N >> 2);
   10523       41363 :   long i, l = lg(D), dim3 = 0, dim4 = 0;
   10524             : 
   10525       41363 :   CHI = induceN(N, CHI);
   10526      341138 :   for (i = 1; i < l; i++)
   10527             :   {
   10528      299775 :     long rp, t = D[i], Mt = D[l-i];
   10529      299775 :     GEN PSI = get_PSI(CHI,t);
   10530      299775 :     rp = mfcharconductor(PSI);
   10531      299775 :     if (Mt % (rp*rp) == 0) { dim4++; if (charistotallyeven(PSI,rp)) dim3++; }
   10532             :   }
   10533       41363 :   set_avma(av);
   10534       41363 :   switch (space)
   10535             :   {
   10536       40439 :     case mf_CUSP: return dim4 - dim3;
   10537         462 :     case mf_EISEN:return dim3;
   10538         462 :     case mf_FULL: return dim4;
   10539             :   }
   10540             :   return 0; /*LCOV_EXCL_LINE*/
   10541             : }
   10542             : 
   10543             : static long
   10544         693 : mf2dimwt32(long N, GEN CHI, long F, long space)
   10545             : {
   10546             :   long D;
   10547         693 :   switch(space)
   10548             :   {
   10549         231 :     case mf_CUSP: D = mypsiu(N) - 6*dim22(N, F, 1);
   10550         231 :       if (D%24) pari_err_BUG("mfdim");
   10551         231 :       return D/24 + mf2dimwt12(N, CHI, 4);
   10552         231 :     case mf_FULL: D = mypsiu(N) + 6*dim22(N, F, 0);
   10553         231 :       if (D%24) pari_err_BUG("mfdim");
   10554         231 :       return D/24 + mf2dimwt12(N, CHI, 1);
   10555         231 :     case mf_EISEN: D = dim22(N, F, 0) + dim22(N, F, 1);
   10556         231 :       if (D & 3L) pari_err_BUG("mfdim");
   10557         231 :       return (D >> 2) - mf2dimwt12(N, CHI, 3);
   10558             :   }
   10559             :   return 0; /*LCOV_EXCL_LINE*/
   10560             : }
   10561             : 
   10562             : /* F = conductor(CHI), weight k = r+1/2 */
   10563             : static long
   10564       43701 : checkmf2(long N, long r, GEN CHI, long F, long space)
   10565             : {
   10566       43701 :   switch(space)
   10567             :   {
   10568       43680 :     case mf_FULL: case mf_CUSP: case mf_EISEN: break;
   10569          14 :     case mf_NEW: case mf_OLD:
   10570          14 :       pari_err_TYPE("half-integral weight [new/old spaces]", utoi(space));
   10571           7 :     default:
   10572           7 :       pari_err_TYPE("half-integral weight [incorrect space]",utoi(space));
   10573             :   }
   10574       43680 :   if (N & 3L)
   10575           0 :     pari_err_DOMAIN("half-integral weight", "N % 4", "!=", gen_0, stoi(N));
   10576       43680 :   return r >= 0 && mfcharparity(CHI) == 1 && N % F == 0;
   10577             : }
   10578             : 
   10579             : /* weight k = r + 1/2 */
   10580             : static long
   10581       43463 : mf2dim_Nkchi(long N, long r, GEN CHI, ulong space)
   10582             : {
   10583       43463 :   long D, D2, F = mfcharconductor(CHI);
   10584       43463 :   if (!checkmf2(N, r, CHI, F, space)) return 0;
   10585       43442 :   if (r == 0) return mf2dimwt12(N, CHI, space);
   10586        2772 :   if (r == 1) return mf2dimwt32(N, CHI