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.16.1 lcov report (development 28403-bea3a26501) Lines: 7524 7734 97.3 %
Date: 2023-03-30 07:42:39 Functions: 766 772 99.2 %
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; either version 2 of the License, or (at your option) any later
       8             : version. It is distributed in the hope that it will be useful, but WITHOUT
       9             : ANY WARRANTY WHATSOEVER.
      10             : 
      11             : Check the License for details. You should have received a copy of it, along
      12             : with the package; see the file 'COPYING'. If not, write to the Free Software
      13             : Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
      14             : 
      15             : /*************************************************************************/
      16             : /*                                                                       */
      17             : /*              Modular forms package based on trace formulas            */
      18             : /*                                                                       */
      19             : /*************************************************************************/
      20             : #include "pari.h"
      21             : #include "paripriv.h"
      22             : 
      23             : #define DEBUGLEVEL DEBUGLEVEL_mf
      24             : 
      25             : enum {
      26             :   MF_SPLIT = 1,
      27             :   MF_EISENSPACE,
      28             :   MF_FRICKE,
      29             :   MF_MF2INIT,
      30             :   MF_SPLITN
      31             : };
      32             : 
      33             : typedef struct {
      34             :   GEN vnew, vfull, DATA, VCHIP;
      35             :   long n, newHIT, newTOTAL, cuspHIT, cuspTOTAL;
      36             : } cachenew_t;
      37             : 
      38             : static void init_cachenew(cachenew_t *c, long n, long N, GEN f);
      39             : static long mf1cuspdim_i(long N, GEN CHI, GEN TMP, GEN vSP, long *dih);
      40             : static GEN mfinit_i(GEN NK, long space);
      41             : static GEN mfinit_Nkchi(long N, long k, GEN CHI, long space, long flraw);
      42             : static GEN mf2init_Nkchi(long N, long k, GEN CHI, long space, long flraw);
      43             : static GEN mf2basis(long N, long r, GEN CHI, GEN *pCHI1, long space);
      44             : static GEN mfeisensteinbasis(long N, long k, GEN CHI);
      45             : static GEN mfeisensteindec(GEN mf, GEN F);
      46             : static GEN initwt1newtrace(GEN mf);
      47             : static GEN initwt1trace(GEN mf);
      48             : static GEN myfactoru(long N);
      49             : static GEN mydivisorsu(long N);
      50             : static GEN Qab_Czeta(long k, long ord, GEN C, long vt);
      51             : static GEN mfcoefs_i(GEN F, long n, long d);
      52             : static GEN bhnmat_extend(GEN M, long m,long l, GEN S, cachenew_t *cache);
      53             : static GEN initnewtrace(long N, GEN CHI);
      54             : static void dbg_cachenew(cachenew_t *C);
      55             : static GEN hecke_i(long m, long l, GEN V, GEN F, GEN DATA);
      56             : static GEN c_Ek(long n, long d, GEN F);
      57             : static GEN RgV_heckef2(long n, long d, GEN V, GEN F, GEN DATA);
      58             : static GEN mfcusptrace_i(long N, long k, long n, GEN Dn, GEN TDATA);
      59             : static GEN mfnewtracecache(long N, long k, long n, cachenew_t *cache);
      60             : static GEN colnewtrace(long n0, long n, long d, long N, long k, cachenew_t *c);
      61             : static GEN dihan(GEN bnr, GEN w, GEN k0j, long m, ulong n);
      62             : static GEN sigchi(long k, GEN CHI, long n);
      63             : static GEN sigchi2(long k, GEN CHI1, GEN CHI2, long n, long ord);
      64             : static GEN mflineardivtomat(long N, GEN vF, long n);
      65             : static GEN mfdihedralcusp(long N, GEN CHI, GEN vSP);
      66             : static long mfdihedralcuspdim(long N, GEN CHI, GEN vSP);
      67             : static GEN mfdihedralnew(long N, GEN CHI, GEN SP);
      68             : static GEN mfdihedral(long N);
      69             : static GEN mfdihedralall(long N);
      70             : static long mf1cuspdim(long N, GEN CHI, GEN vSP);
      71             : static long mf2dim_Nkchi(long N, long k, GEN CHI, ulong space);
      72             : static long mfdim_Nkchi(long N, long k, GEN CHI, long space);
      73             : static GEN charLFwtk(long N, long k, GEN CHI, long ord, long t);
      74             : static GEN mfeisensteingacx(GEN E,long w,GEN ga,long n,long prec);
      75             : static GEN mfgaexpansion(GEN mf, GEN F, GEN gamma, long n, long prec);
      76             : static GEN mfEHmat(long n, long r);
      77             : static GEN mfEHcoef(long r, long N);
      78             : static GEN mftobasis_i(GEN mf, GEN F);
      79             : 
      80             : static GEN
      81       36323 : mkgNK(GEN N, GEN k, GEN CHI, GEN P) { return mkvec4(N, k, CHI, P); }
      82             : static GEN
      83       14854 : mkNK(long N, long k, GEN CHI) { return mkgNK(stoi(N), stoi(k), CHI, pol_x(1)); }
      84             : GEN
      85        7861 : MF_get_CHI(GEN mf) { return gmael(mf,1,3); }
      86             : GEN
      87       19376 : MF_get_gN(GEN mf) { return gmael(mf,1,1); }
      88             : long
      89       18487 : MF_get_N(GEN mf) { return itou(MF_get_gN(mf)); }
      90             : GEN
      91       13384 : MF_get_gk(GEN mf) { return gmael(mf,1,2); }
      92             : long
      93        6685 : MF_get_k(GEN mf)
      94             : {
      95        6685 :   GEN gk = MF_get_gk(mf);
      96        6685 :   if (typ(gk)!=t_INT) pari_err_IMPL("half-integral weight");
      97        6685 :   return itou(gk);
      98             : }
      99             : long
     100         245 : MF_get_r(GEN mf)
     101             : {
     102         245 :   GEN gk = MF_get_gk(mf);
     103         245 :   if (typ(gk) == t_INT) pari_err_IMPL("integral weight");
     104         245 :   return itou(gel(gk, 1)) >> 1;
     105             : }
     106             : long
     107       13748 : MF_get_space(GEN mf) { return itos(gmael(mf,1,4)); }
     108             : GEN
     109        4193 : MF_get_E(GEN mf) { return gel(mf,2); }
     110             : GEN
     111       20328 : MF_get_S(GEN mf) { return gel(mf,3); }
     112             : GEN
     113        1659 : MF_get_basis(GEN mf) { return shallowconcat(gel(mf,2), gel(mf,3)); }
     114             : long
     115        5271 : MF_get_dim(GEN mf)
     116             : {
     117        5271 :   switch(MF_get_space(mf))
     118             :   {
     119         693 :     case mf_FULL:
     120         693 :       return lg(MF_get_S(mf)) - 1 + lg(MF_get_E(mf))-1;
     121         140 :     case mf_EISEN:
     122         140 :       return lg(MF_get_E(mf))-1;
     123        4438 :     default: /* mf_NEW, mf_CUSP, mf_OLD */
     124        4438 :       return lg(MF_get_S(mf)) - 1;
     125             :   }
     126             : }
     127             : GEN
     128        7077 : MFnew_get_vj(GEN mf) { return gel(mf,4); }
     129             : GEN
     130         490 : MFcusp_get_vMjd(GEN mf) { return gel(mf,4); }
     131             : GEN
     132        6748 : MF_get_M(GEN mf) { return gmael(mf,5,3); }
     133             : GEN
     134        4564 : MF_get_Minv(GEN mf) { return gmael(mf,5,2); }
     135             : GEN
     136        9982 : MF_get_Mindex(GEN mf) { return gmael(mf,5,1); }
     137             : 
     138             : /* ordinary gtocol forgets about initial 0s */
     139             : GEN
     140        2387 : sertocol(GEN S) { return gtocol0(S, -(lg(S) - 2 + valser(S))); }
     141             : /*******************************************************************/
     142             : /*     Linear algebra in cyclotomic fields (TODO: export this)     */
     143             : /*******************************************************************/
     144             : /* return r and split prime p giving projection Q(zeta_n) -> Fp, zeta -> r */
     145             : static ulong
     146        1211 : QabM_init(long n, ulong *p)
     147             : {
     148        1211 :   ulong pinit = 1000000007;
     149             :   forprime_t T;
     150        1211 :   if (n <= 1) { *p = pinit; return 0; }
     151        1204 :   u_forprime_arith_init(&T, pinit, ULONG_MAX, 1, n);
     152        1204 :   *p = u_forprime_next(&T);
     153        1204 :   return Flx_oneroot(ZX_to_Flx(polcyclo(n, 0), *p), *p);
     154             : }
     155             : static ulong
     156     8534960 : Qab_to_Fl(GEN P, ulong r, ulong p)
     157             : {
     158             :   ulong t;
     159             :   GEN den;
     160     8534960 :   P = Q_remove_denom(liftpol_shallow(P), &den);
     161     8534960 :   if (typ(P) == t_POL) { GEN Pp = ZX_to_Flx(P, p); t = Flx_eval(Pp, r, p); }
     162     8399335 :   else t = umodiu(P, p);
     163     8534960 :   if (den) t = Fl_div(t, umodiu(den, p), p);
     164     8534960 :   return t;
     165             : }
     166             : static GEN
     167       38164 : QabC_to_Flc(GEN C, ulong r, ulong p)
     168             : {
     169       38164 :   long i, l = lg(C);
     170       38164 :   GEN A = cgetg(l, t_VECSMALL);
     171     8341333 :   for (i = 1; i < l; i++) uel(A,i) = Qab_to_Fl(gel(C,i), r, p);
     172       38164 :   return A;
     173             : }
     174             : static GEN
     175         595 : QabM_to_Flm(GEN M, ulong r, ulong p)
     176             : {
     177             :   long i, l;
     178         595 :   GEN A = cgetg_copy(M, &l);
     179       38759 :   for (i = 1; i < l; i++)
     180       38164 :     gel(A, i) = QabC_to_Flc(gel(M, i), r, p);
     181         595 :   return A;
     182             : }
     183             : /* A a t_POL */
     184             : static GEN
     185        1484 : QabX_to_Flx(GEN A, ulong r, ulong p)
     186             : {
     187        1484 :   long i, l = lg(A);
     188        1484 :   GEN a = cgetg(l, t_VECSMALL);
     189        1484 :   a[1] = ((ulong)A[1])&VARNBITS;
     190      233023 :   for (i = 2; i < l; i++) uel(a,i) = Qab_to_Fl(gel(A,i), r, p);
     191        1484 :   return Flx_renormalize(a, l);
     192             : }
     193             : 
     194             : /* FIXME: remove */
     195             : static GEN
     196        1092 : ZabM_pseudoinv_i(GEN M, GEN P, long n, GEN *pv, GEN *den, int ratlift)
     197             : {
     198        1092 :   GEN v = ZabM_indexrank(M, P, n);
     199        1092 :   if (pv) *pv = v;
     200        1092 :   M = shallowmatextract(M,gel(v,1),gel(v,2));
     201        1092 :   return ratlift? ZabM_inv_ratlift(M, P, n, den): ZabM_inv(M, P, n, den);
     202             : }
     203             : 
     204             : /* M matrix with coeff in Q(\chi)), where Q(\chi) = Q(X)/(P) for
     205             :  * P = cyclotomic Phi_n. Assume M rational if n <= 2 */
     206             : static GEN
     207        1561 : QabM_ker(GEN M, GEN P, long n)
     208             : {
     209        1561 :   if (n <= 2) return QM_ker(M);
     210         378 :   return ZabM_ker(row_Q_primpart(liftpol_shallow(M)), P, n);
     211             : }
     212             : /* pseudo-inverse of M. FIXME: should replace QabM_pseudoinv */
     213             : static GEN
     214        1274 : QabM_pseudoinv_i(GEN M, GEN P, long n, GEN *pv, GEN *pden)
     215             : {
     216             :   GEN cM, Mi;
     217        1274 :   if (n <= 2)
     218             :   {
     219        1134 :     M = Q_primitive_part(M, &cM);
     220        1134 :     Mi = ZM_pseudoinv(M, pv, pden); /* M^(-1) = Mi / (cM * den) */
     221             :   }
     222             :   else
     223             :   {
     224         140 :     M = Q_primitive_part(liftpol_shallow(M), &cM);
     225         140 :     Mi = ZabM_pseudoinv(M, P, n, pv, pden);
     226             :   }
     227        1274 :   *pden = mul_content(*pden, cM);
     228        1274 :   return Mi;
     229             : }
     230             : /* FIXME: delete */
     231             : static GEN
     232        1015 : QabM_pseudoinv(GEN M, GEN P, long n, GEN *pv, GEN *pden)
     233             : {
     234        1015 :   GEN Mi = QabM_pseudoinv_i(M, P, n, pv, pden);
     235        1015 :   return P? gmodulo(Mi, P): Mi;
     236             : }
     237             : 
     238             : static GEN
     239       10283 : QabM_indexrank(GEN M, GEN P, long n)
     240             : {
     241             :   GEN z;
     242       10283 :   if (n <= 2)
     243             :   {
     244        9128 :     M = vec_Q_primpart(M);
     245        9128 :     z = ZM_indexrank(M); /* M^(-1) = Mi / (cM * den) */
     246             :   }
     247             :   else
     248             :   {
     249        1155 :     M = vec_Q_primpart(liftpol_shallow(M));
     250        1155 :     z = ZabM_indexrank(M, P, n);
     251             :   }
     252       10283 :   return z;
     253             : }
     254             : 
     255             : /*********************************************************************/
     256             : /*                    Simple arithmetic functions                    */
     257             : /*********************************************************************/
     258             : /* TODO: most of these should be exported and used in ifactor1.c */
     259             : /* phi(n) */
     260             : static ulong
     261      106407 : myeulerphiu(ulong n)
     262             : {
     263             :   pari_sp av;
     264      106407 :   if (n == 1) return 1;
     265       87787 :   av = avma; return gc_ulong(av, eulerphiu_fact(myfactoru(n)));
     266             : }
     267             : static long
     268       65688 : mymoebiusu(ulong n)
     269             : {
     270             :   pari_sp av;
     271       65688 :   if (n == 1) return 1;
     272       54173 :   av = avma; return gc_long(av, moebiusu_fact(myfactoru(n)));
     273             : }
     274             : 
     275             : static long
     276        2933 : mynumdivu(long N)
     277             : {
     278             :   pari_sp av;
     279        2933 :   if (N == 1) return 1;
     280        2828 :   av = avma; return gc_long(av, numdivu_fact(myfactoru(N)));
     281             : }
     282             : 
     283             : /* N\prod_{p|N} (1+1/p) */
     284             : static long
     285      383950 : mypsiu(ulong N)
     286             : {
     287             :   pari_sp av;
     288             :   GEN P;
     289             :   long j, l, a;
     290      383950 :   if (N == 1) return 1;
     291      302883 :   av = avma; P = gel(myfactoru(N), 1); l = lg(P);
     292      722183 :   for (a = N, j = 1; j < l; j++) a += a / P[j];
     293      302883 :   return gc_long(av, a);
     294             : }
     295             : /* write n = mf^2. Return m, set f. */
     296             : static ulong
     297          70 : mycore(ulong n, long *pf)
     298             : {
     299          70 :   pari_sp av = avma;
     300          70 :   GEN fa = myfactoru(n), P = gel(fa,1), E = gel(fa,2);
     301          70 :   long i, l = lg(P), m = 1, f = 1;
     302         266 :   for (i = 1; i < l; i++)
     303             :   {
     304         196 :     long j, p = P[i], e = E[i];
     305         196 :     if (e & 1) m *= p;
     306         455 :     for (j = 2; j <= e; j+=2) f *= p;
     307             :   }
     308          70 :   *pf = f; return gc_long(av,m);
     309             : }
     310             : 
     311             : /* fa = factorization of -D > 0, return -D0 > 0 (where D0 is fundamental) */
     312             : static long
     313     4369208 : corediscs_fact(GEN fa)
     314             : {
     315     4369208 :   GEN P = gel(fa,1), E = gel(fa,2);
     316     4369208 :   long i, l = lg(P), m = 1;
     317    14413146 :   for (i = 1; i < l; i++)
     318             :   {
     319    10043938 :     long p = P[i], e = E[i];
     320    10043938 :     if (e & 1) m *= p;
     321             :   }
     322     4369208 :   if ((m&3L) != 3) m <<= 2;
     323     4369208 :   return m;
     324             : }
     325             : static long
     326        6916 : mubeta(long n)
     327             : {
     328        6916 :   pari_sp av = avma;
     329        6916 :   GEN E = gel(myfactoru(n), 2);
     330        6916 :   long i, s = 1, l = lg(E);
     331       14350 :   for (i = 1; i < l; i++)
     332             :   {
     333        7434 :     long e = E[i];
     334        7434 :     if (e >= 3) return gc_long(av,0);
     335        7434 :     if (e == 1) s *= -2;
     336             :   }
     337        6916 :   return gc_long(av,s);
     338             : }
     339             : 
     340             : /* n = n1*n2, n1 = ppo(n, m); return mubeta(n1)*moebiusu(n2).
     341             :  * N.B. If n from newt_params we, in fact, never return 0 */
     342             : static long
     343     7600969 : mubeta2(long n, long m)
     344             : {
     345     7600969 :   pari_sp av = avma;
     346     7600969 :   GEN fa = myfactoru(n), P = gel(fa,1), E = gel(fa,2);
     347     7600969 :   long i, s = 1, l = lg(P);
     348    15287726 :   for (i = 1; i < l; i++)
     349             :   {
     350     7686757 :     long p = P[i], e = E[i];
     351     7686757 :     if (m % p)
     352             :     { /* p^e in n1 */
     353     6529076 :       if (e >= 3) return gc_long(av,0);
     354     6529076 :       if (e == 1) s *= -2;
     355             :     }
     356             :     else
     357             :     { /* in n2 */
     358     1157681 :       if (e >= 2) return gc_long(av,0);
     359     1157681 :       s = -s;
     360             :     }
     361             :   }
     362     7600969 :   return gc_long(av,s);
     363             : }
     364             : 
     365             : /* write N = prod p^{ep} and n = df^2, d squarefree.
     366             :  * set g  = ppo(gcd(sqfpart(N), f), FC)
     367             :  *     N2 = prod p^if(e==1 || p|n, ep-1, ep-2) */
     368             : static void
     369     1861815 : newt_params(long N, long n, long FC, long *pg, long *pN2)
     370             : {
     371     1861815 :   GEN fa = myfactoru(N), P = gel(fa,1), E = gel(fa,2);
     372     1861815 :   long i, g = 1, N2 = 1, l = lg(P);
     373     4972696 :   for (i = 1; i < l; i++)
     374             :   {
     375     3110881 :     long p = P[i], e = E[i];
     376     3110881 :     if (e == 1)
     377     2719696 :     { if (FC % p && n % (p*p) == 0) g *= p; }
     378             :     else
     379      391185 :       N2 *= upowuu(p,(n % p)? e-2: e-1);
     380             :   }
     381     1861815 :   *pg = g; *pN2 = N2;
     382     1861815 : }
     383             : /* simplified version of newt_params for n = 1 (newdim) */
     384             : static void
     385       39627 : newd_params(long N, long *pN2)
     386             : {
     387       39627 :   GEN fa = myfactoru(N), P = gel(fa,1), E = gel(fa,2);
     388       39627 :   long i, N2 = 1, l = lg(P);
     389       99302 :   for (i = 1; i < l; i++)
     390             :   {
     391       59675 :     long p = P[i], e = E[i];
     392       59675 :     if (e > 2) N2 *= upowuu(p, e-2);
     393             :   }
     394       39627 :   *pN2 = N2;
     395       39627 : }
     396             : 
     397             : static long
     398          21 : newd_params2(long N)
     399             : {
     400          21 :   GEN fa = myfactoru(N), P = gel(fa,1), E = gel(fa,2);
     401          21 :   long i, N2 = 1, l = lg(P);
     402          56 :   for (i = 1; i < l; i++)
     403             :   {
     404          35 :     long p = P[i], e = E[i];
     405          35 :     if (e >= 2) N2 *= upowuu(p, e);
     406             :   }
     407          21 :   return N2;
     408             : }
     409             : 
     410             : /*******************************************************************/
     411             : /*   Relative trace between cyclotomic fields (TODO: export this)  */
     412             : /*******************************************************************/
     413             : /* g>=1; return g * prod_{p | g, (p,q) = 1} (1-1/p) */
     414             : static long
     415       36862 : phipart(long g, long q)
     416             : {
     417       36862 :   if (g > 1)
     418             :   {
     419       19663 :     GEN P = gel(myfactoru(g), 1);
     420       19663 :     long i, l = lg(P);
     421       40180 :     for (i = 1; i < l; i++) { long p = P[i]; if (q % p) g -= g / p; }
     422             :   }
     423       36862 :   return g;
     424             : }
     425             : /* Set s,v s.t. Trace(zeta_N^k) from Q(zeta_N) to Q(\zeta_N) = s * zeta_M^v
     426             :  * With k > 0, N = M*d and N, M != 2 mod 4 */
     427             : static long
     428       84735 : tracerelz(long *pv, long d, long M, long k)
     429             : {
     430             :   long s, g, q, muq;
     431       84735 :   if (d == 1) { *pv = k; return 1; }
     432       65597 :   *pv = 0; g = ugcd(k, d); q = d / g;
     433       65597 :   muq = mymoebiusu(q); if (!muq) return 0;
     434       47166 :   if (M != 1)
     435             :   {
     436       37821 :     long v = Fl_invsafe(q % M, M);
     437       37821 :     if (!v) return 0;
     438       27517 :     *pv = (v * (k/g)) % M;
     439             :   }
     440       36862 :   s = phipart(g, M*q); if (muq < 0) s = -s;
     441       36862 :   return s;
     442             : }
     443             : /* Pi = polcyclo(i), i = m or n. Let Ki = Q(zeta_i), initialize Tr_{Kn/Km} */
     444             : GEN
     445       34006 : Qab_trace_init(long n, long m, GEN Pn, GEN Pm)
     446             : {
     447             :   long a, i, j, N, M, vt, d, D;
     448             :   GEN T, G;
     449             : 
     450       34006 :   if (m == n || n <= 2) return mkvec(Pm);
     451       16548 :   vt = varn(Pn);
     452       16548 :   d = degpol(Pn);
     453             :   /* if (N != n) zeta_N = zeta_n^2 and zeta_n = - zeta_N^{(N+1)/2} */
     454       16548 :   N = ((n & 3) == 2)? n >> 1: n;
     455       16548 :   M = ((m & 3) == 2)? m >> 1: m; /* M | N | n */
     456       16548 :   a = N / M;
     457       16548 :   T = const_vec(d, NULL);
     458       16548 :   D = d / degpol(Pm); /* relative degree */
     459       16548 :   if (D == 1) G = NULL;
     460             :   else
     461             :   { /* zeta_M = zeta_n^A; s_j(zeta_M) = zeta_M <=> j = 1 (mod J) */
     462       15274 :     long lG, A = (N == n)? a: (a << 1), J = n / ugcd(n, A);
     463       15274 :     G = coprimes_zv(n);
     464      150241 :     for (j = lG = 1; j < n; j += J)
     465      134967 :       if (G[j]) G[lG++] = j;
     466       15274 :     setlg(G, lG); /* Gal(Q(zeta_n) / Q(zeta_m)) */
     467             :   }
     468       16548 :   T = const_vec(d, NULL);
     469       16548 :   gel(T,1) = utoipos(D); /* Tr 1 */
     470      140112 :   for (i = 1; i < d; i++)
     471             :   { /* if n = 2N, zeta_n^i = (-1)^i zeta_N^k */
     472             :     long s, v, k;
     473             :     GEN t;
     474             : 
     475      123564 :     if (gel(T, i+1)) continue;
     476       84735 :     k = (N == n)? i: ((odd(i)? i + N: i) >> 1);
     477       84735 :     if ((s = tracerelz(&v, a, M, k)))
     478             :     {
     479       56000 :       if (m != M) v *= 2;/* Tr = s * zeta_m^v */
     480       56000 :       if (n != N && odd(i)) s = -s;
     481       56000 :       t = Qab_Czeta(v, m, stoi(s), vt);
     482             :     }
     483             :     else
     484       28735 :       t = gen_0;
     485             :     /* t = Tr_{Kn/Km} zeta_n^i; fill using Galois action */
     486       84735 :     if (!G)
     487       19138 :       gel(T, i + 1) = t;
     488             :     else
     489      370811 :       for (j = 1; j <= D; j++)
     490             :       {
     491      305214 :         long z = Fl_mul(i,G[j], n);
     492      305214 :         if (z < d) gel(T, z + 1) = t;
     493             :       }
     494             :   }
     495       16548 :   return mkvec3(Pm, Pn, T);
     496             : }
     497             : /* x a t_POL modulo Phi_n */
     498             : static GEN
     499       80248 : tracerel_i(GEN T, GEN x)
     500             : {
     501       80248 :   long k, l = lg(x);
     502             :   GEN S;
     503       80248 :   if (l == 2) return gen_0;
     504       80248 :   S = gmul(gel(T,1), gel(x,2));
     505      283269 :   for (k = 3; k < l; k++) S = gadd(S, gmul(gel(T,k-1), gel(x,k)));
     506       80248 :   return S;
     507             : }
     508             : static GEN
     509      253827 : tracerel(GEN a, GEN v, GEN z)
     510             : {
     511      253827 :   a = liftpol_shallow(a);
     512      253827 :   a = simplify_shallow(z? gmul(z,a): a);
     513      253827 :   if (typ(a) == t_POL)
     514             :   {
     515       80248 :     GEN T = gel(v,3);
     516       80248 :     long degrel = itou(gel(T,1));
     517       80248 :     a = tracerel_i(T, RgX_rem(a, gel(v,2)));
     518       80248 :     if (degrel != 1) a = gdivgu(a, degrel);
     519       80248 :     if (typ(a) == t_POL) a = RgX_rem(a, gel(v,1));
     520             :   }
     521      253827 :   return a;
     522             : }
     523             : static GEN
     524        6937 : tracerel_z(GEN v, long t)
     525             : {
     526        6937 :   GEN Pn = gel(v,2);
     527        6937 :   return t? pol_xn(t, varn(Pn)): NULL;
     528             : }
     529             : /* v = Qab_trace_init(n,m); x is a t_VEC of polmodulo Phi_n; Kn = Q(zeta_n)
     530             :  * [Kn:Km]^(-1) Tr_{Kn/Km} (zeta_n^t * x); 0 <= t < [Kn:Km] */
     531             : GEN
     532           0 : Qab_tracerel(GEN v, long t, GEN a)
     533             : {
     534           0 :   if (lg(v) != 4) return a; /* => t = 0 */
     535           0 :   return tracerel(a, v, tracerel_z(v, t));
     536             : }
     537             : GEN
     538       16086 : QabV_tracerel(GEN v, long t, GEN x)
     539             : {
     540             :   GEN z;
     541       16086 :   if (lg(v) != 4) return x; /* => t = 0 */
     542        6937 :   z = tracerel_z(v, t);
     543      260764 :   pari_APPLY_same(tracerel(gel(x,i), v, z));
     544             : }
     545             : GEN
     546         147 : QabM_tracerel(GEN v, long t, GEN x)
     547             : {
     548         147 :   if (lg(v) != 4) return x;
     549         105 :   pari_APPLY_same(QabV_tracerel(v, t, gel(x,i)));
     550             : }
     551             : 
     552             : /* C*zeta_o^k mod X^o - 1 */
     553             : static GEN
     554     2188543 : Qab_Czeta(long k, long o, GEN C, long vt)
     555             : {
     556     2188543 :   if (!k) return C;
     557     1455734 :   if (!odd(o))
     558             :   { /* optimization: reduce max degree by a factor 2 for free */
     559     1404634 :     o >>= 1;
     560     1404634 :     if (k >= o) { k -= o; C = gneg(C); if (!k) return C; }
     561             :   }
     562     1109444 :   return monomial(C, k, vt);
     563             : }
     564             : /* zeta_o^k */
     565             : static GEN
     566      200242 : Qab_zeta(long k, long o, long vt) { return Qab_Czeta(k, o, gen_1, vt); }
     567             : 
     568             : /*              Operations on Dirichlet characters                       */
     569             : 
     570             : /* A Dirichlet character can be given in GP in different formats, but in this
     571             :  * package, it will be a vector CHI=[G,chi,ord], where G is the (Z/MZ)^* to
     572             :  * which the character belongs, chi is the character in Conrey format, ord is
     573             :  * the order */
     574             : 
     575             : static GEN
     576     3718820 : gmfcharorder(GEN CHI) { return gel(CHI, 3); }
     577             : long
     578     3681370 : mfcharorder(GEN CHI) { return itou(gmfcharorder(CHI)); }
     579             : static long
     580        2632 : mfcharistrivial(GEN CHI) { return !CHI || mfcharorder(CHI) == 1; }
     581             : static GEN
     582     1546545 : gmfcharmodulus(GEN CHI) { return gmael3(CHI, 1, 1, 1); }
     583             : long
     584     1546545 : mfcharmodulus(GEN CHI) { return itou(gmfcharmodulus(CHI)); }
     585             : GEN
     586      562709 : mfcharpol(GEN CHI) { return gel(CHI,4); }
     587             : 
     588             : /* vz[i+1] = image of (zeta_o)^i in Fp */
     589             : static ulong
     590      220514 : Qab_Czeta_Fl(long k, GEN vz, ulong C, ulong p)
     591             : {
     592             :   long o;
     593      220514 :   if (!k) return C;
     594      148631 :   o = lg(vz)-2;
     595      148631 :   if ((k << 1) == o) return Fl_neg(C,p);
     596      123123 :   return Fl_mul(C, vz[k+1], p);
     597             : }
     598             : 
     599             : static long
     600     2507092 : znchareval_i(GEN CHI, long n, GEN ord)
     601     2507092 : { return itos(znchareval(gel(CHI,1), gel(CHI,2), stoi(n), ord)); }
     602             : 
     603             : /* n coprime with the modulus of CHI */
     604             : static GEN
     605       13972 : mfchareval(GEN CHI, long n)
     606             : {
     607       13972 :   GEN Pn, C, go = gmfcharorder(CHI);
     608       13972 :   long k, o = go[2];
     609       13972 :   if (o == 1) return gen_1;
     610        7378 :   k = znchareval_i(CHI, n, go);
     611        7378 :   Pn = mfcharpol(CHI);
     612        7378 :   C = Qab_zeta(k, o, varn(Pn));
     613        7378 :   if (typ(C) != t_POL) return C;
     614        5320 :   return gmodulo(C, Pn);
     615             : }
     616             : /* d a multiple of ord(CHI); n coprime with char modulus;
     617             :  * return x s.t. CHI(n) = \zeta_d^x] */
     618             : static long
     619     3561152 : mfcharevalord(GEN CHI, long n, long d)
     620             : {
     621     3561152 :   if (mfcharorder(CHI) == 1) return 0;
     622     2496018 :   return znchareval_i(CHI, n, utoi(d));
     623             : }
     624             : 
     625             : /* G a znstar, L a Conrey log: return a 'mfchar' */
     626             : static GEN
     627      373506 : mfcharGL(GEN G, GEN L)
     628             : {
     629      373506 :   GEN o = zncharorder(G,L);
     630      373506 :   long ord = itou(o), vt = fetch_user_var("t");
     631      373506 :   return mkvec4(G, L, o, polcyclo(ord,vt));
     632             : }
     633             : static GEN
     634        5614 : mfchartrivial()
     635        5614 : { return mfcharGL(znstar0(gen_1,1), cgetg(1,t_COL)); }
     636             : /* convert a generic character into an 'mfchar' */
     637             : static GEN
     638        4025 : get_mfchar(GEN CHI)
     639             : {
     640             :   GEN G, L;
     641        4025 :   if (typ(CHI) != t_VEC) CHI = znchar(CHI);
     642             :   else
     643             :   {
     644         889 :     long l = lg(CHI);
     645         889 :     if ((l != 3 && l != 5) || !checkznstar_i(gel(CHI,1)))
     646           7 :       pari_err_TYPE("checkNF [chi]", CHI);
     647         882 :     if (l == 5) return CHI;
     648             :   }
     649        3955 :   G = gel(CHI,1);
     650        3955 :   L = gel(CHI,2); if (typ(L) != t_COL) L = znconreylog(G,L);
     651        3955 :   return mfcharGL(G, L);
     652             : }
     653             : 
     654             : /* parse [N], [N,k], [N,k,CHI]. If 'joker' is set, allow wildcard for CHI */
     655             : static GEN
     656        9128 : checkCHI(GEN NK, long N, int joker)
     657             : {
     658             :   GEN CHI;
     659        9128 :   if (lg(NK) == 3)
     660         644 :     CHI = mfchartrivial();
     661             :   else
     662             :   {
     663             :     long i, l;
     664        8484 :     CHI = gel(NK,3); l = lg(CHI);
     665        8484 :     if (isintzero(CHI) && joker)
     666        4116 :       CHI = NULL; /* all character orbits */
     667        4368 :     else if (isintm1(CHI) && joker > 1)
     668        2373 :       CHI = gen_m1; /* sum over all character orbits */
     669        1995 :     else if ((typ(CHI) == t_VEC &&
     670         217 :              (l == 1 || l != 3 || !checkznstar_i(gel(CHI,1)))) && joker)
     671             :     {
     672         133 :       CHI = shallowtrans(CHI); /* list of characters */
     673         952 :       for (i = 1; i < l; i++) gel(CHI,i) = get_mfchar(gel(CHI,i));
     674             :     }
     675             :     else
     676             :     {
     677        1862 :       CHI = get_mfchar(CHI); /* single char */
     678        1862 :       if (N % mfcharmodulus(CHI)) pari_err_TYPE("checkNF [chi]", NK);
     679             :     }
     680             :   }
     681        9114 :   return CHI;
     682             : }
     683             : /* support half-integral weight */
     684             : static void
     685        9135 : checkNK2(GEN NK, long *N, long *nk, long *dk, GEN *CHI, int joker)
     686             : {
     687        9135 :   long l = lg(NK);
     688             :   GEN T;
     689        9135 :   if (typ(NK) != t_VEC || l < 3 || l > 4) pari_err_TYPE("checkNK", NK);
     690        9135 :   T = gel(NK,1); if (typ(T) != t_INT) pari_err_TYPE("checkNF [N]", NK);
     691        9135 :   *N = itos(T); if (*N <= 0) pari_err_TYPE("checkNF [N <= 0]", NK);
     692        9135 :   T = gel(NK,2);
     693        9135 :   switch(typ(T))
     694             :   {
     695        5754 :     case t_INT:  *nk = itos(T); *dk = 1; break;
     696        3374 :     case t_FRAC:
     697        3374 :       *nk = itos(gel(T,1));
     698        3374 :       *dk = itou(gel(T,2)); if (*dk == 2) break;
     699           7 :     default: pari_err_TYPE("checkNF [k]", NK);
     700             :   }
     701        9128 :   *CHI = checkCHI(NK, *N, joker);
     702        9114 : }
     703             : /* don't support half-integral weight */
     704             : static void
     705         133 : checkNK(GEN NK, long *N, long *k, GEN *CHI, int joker)
     706             : {
     707             :   long d;
     708         133 :   checkNK2(NK, N, k, &d, CHI, joker);
     709         133 :   if (d != 1) pari_err_TYPE("checkNF [k]", NK);
     710         133 : }
     711             : 
     712             : static GEN
     713        4872 : mfchargalois(long N, int odd, GEN flagorder)
     714             : {
     715        4872 :   GEN G = znstar0(utoi(N), 1), L = chargalois(G, flagorder);
     716        4872 :   long l = lg(L), i, j;
     717      113526 :   for (i = j = 1; i < l; i++)
     718             :   {
     719      108654 :     GEN chi = znconreyfromchar(G, gel(L,i));
     720      108654 :     if (zncharisodd(G,chi) == odd) gel(L,j++) = mfcharGL(G,chi);
     721             :   }
     722        4872 :   setlg(L, j); return L;
     723             : }
     724             : /* possible characters for nontrivial S_1(N, chi) */
     725             : static GEN
     726        1729 : mf1chars(long N, GEN vCHI)
     727             : {
     728        1729 :   if (vCHI) return vCHI; /*do not filter, user knows best*/
     729             :   /* Tate's theorem */
     730        1659 :   return mfchargalois(N, 1, uisprime(N)? mkvecsmall2(2,4): NULL);
     731             : }
     732             : static GEN
     733        3255 : mfchars(long N, long k, long dk, GEN vCHI)
     734        3255 : { return vCHI? vCHI: mfchargalois(N, (dk == 2)? 0: (k & 1), NULL); }
     735             : 
     736             : /* wrappers from mfchar to znchar */
     737             : static long
     738       68250 : mfcharparity(GEN CHI)
     739             : {
     740       68250 :   if (!CHI) return 1;
     741       68250 :   return zncharisodd(gel(CHI,1), gel(CHI,2)) ? -1 : 1;
     742             : }
     743             : /* if CHI is primitive, return CHI itself, not a copy */
     744             : static GEN
     745       73920 : mfchartoprimitive(GEN CHI, long *pF)
     746             : {
     747             :   pari_sp av;
     748             :   GEN chi, F;
     749       73920 :   if (!CHI) { if (pF) *pF = 1; return mfchartrivial(); }
     750       73920 :   av = avma; F = znconreyconductor(gel(CHI,1), gel(CHI,2), &chi);
     751       73920 :   if (typ(F) == t_INT) set_avma(av);
     752             :   else
     753             :   {
     754        7805 :     CHI = leafcopy(CHI);
     755        7805 :     gel(CHI,1) = znstar0(F, 1);
     756        7805 :     gel(CHI,2) = chi;
     757             :   }
     758       73920 :   if (pF) *pF = mfcharmodulus(CHI);
     759       73920 :   return CHI;
     760             : }
     761             : static long
     762      396389 : mfcharconductor(GEN CHI)
     763             : {
     764      396389 :   pari_sp av = avma;
     765      396389 :   GEN res = znconreyconductor(gel(CHI,1), gel(CHI,2), NULL);
     766      396389 :   if (typ(res) == t_VEC) res = gel(res, 1);
     767      396389 :   return gc_long(av, itos(res));
     768             : }
     769             : 
     770             : /*                      Operations on mf closures                    */
     771             : static GEN
     772       61747 : tagparams(long t, GEN NK) { return mkvec2(mkvecsmall(t), NK); }
     773             : static GEN
     774        1127 : lfuntag(long t, GEN x) { return mkvec2(mkvecsmall(t), x); }
     775             : static GEN
     776          56 : tag0(long t, GEN NK) { retmkvec(tagparams(t,NK)); }
     777             : static GEN
     778       10003 : tag(long t, GEN NK, GEN x) { retmkvec2(tagparams(t,NK), x); }
     779             : static GEN
     780       35861 : tag2(long t, GEN NK, GEN x, GEN y) { retmkvec3(tagparams(t,NK), x,y); }
     781             : static GEN
     782       15701 : tag3(long t, GEN NK, GEN x,GEN y,GEN z) { retmkvec4(tagparams(t,NK), x,y,z); }
     783             : static GEN
     784           0 : tag4(long t, GEN NK, GEN x,GEN y,GEN z,GEN a)
     785           0 : { retmkvec5(tagparams(t,NK), x,y,z,a); }
     786             : /* is F a "modular form" ? */
     787             : int
     788       16898 : checkmf_i(GEN F)
     789       16898 : { return typ(F) == t_VEC
     790       16261 :     && lg(F) > 1 && typ(gel(F,1)) == t_VEC
     791       11991 :     && lg(gel(F,1)) == 3
     792       11830 :     && typ(gmael(F,1,1)) == t_VECSMALL
     793       33159 :     && typ(gmael(F,1,2)) == t_VEC; }
     794      227514 : long mf_get_type(GEN F) { return gmael(F,1,1)[1]; }
     795      181146 : GEN mf_get_gN(GEN F) { return gmael3(F,1,2,1); }
     796      136528 : GEN mf_get_gk(GEN F) { return gmael3(F,1,2,2); }
     797             : /* k - 1/2, assume k in 1/2 + Z */
     798         413 : long mf_get_r(GEN F) { return itou(gel(mf_get_gk(F),1)) >> 1; }
     799      116298 : long mf_get_N(GEN F) { return itou(mf_get_gN(F)); }
     800       70574 : long mf_get_k(GEN F)
     801             : {
     802       70574 :   GEN gk = mf_get_gk(F);
     803       70574 :   if (typ(gk)!=t_INT) pari_err_IMPL("half-integral weight");
     804       70574 :   return itou(gk);
     805             : }
     806       61012 : GEN mf_get_CHI(GEN F) { return gmael3(F,1,2,3); }
     807       23954 : GEN mf_get_field(GEN F) { return gmael3(F,1,2,4); }
     808       18543 : GEN mf_get_NK(GEN F) { return gmael(F,1,2); }
     809             : static void
     810         518 : mf_setfield(GEN f, GEN P)
     811             : {
     812         518 :   gel(f,1) = leafcopy(gel(f,1));
     813         518 :   gmael(f,1,2) = leafcopy(gmael(f,1,2));
     814         518 :   gmael3(f,1,2,4) = P;
     815         518 : }
     816             : 
     817             : /* UTILITY FUNCTIONS */
     818             : GEN
     819        9065 : mftocol(GEN F, long lim, long d)
     820        9065 : { GEN c = mfcoefs_i(F, lim, d); settyp(c,t_COL); return c; }
     821             : GEN
     822        2093 : mfvectomat(GEN vF, long lim, long d)
     823             : {
     824        2093 :   long j, l = lg(vF);
     825        2093 :   GEN M = cgetg(l, t_MAT);
     826       10339 :   for (j = 1; j < l; j++) gel(M,j) = mftocol(gel(vF,j), lim, d);
     827        2093 :   return M;
     828             : }
     829             : 
     830             : static GEN
     831        4655 : RgV_to_ser_full(GEN x) { return RgV_to_ser(x, 0, lg(x)+1); }
     832             : /* TODO: delete */
     833             : static GEN
     834         665 : mfcoefsser(GEN F, long n) { return RgV_to_ser_full(mfcoefs_i(F,n,1)); }
     835             : static GEN
     836         833 : sertovecslice(GEN S, long n)
     837             : {
     838         833 :   GEN v = gtovec0(S, -(lg(S) - 2 + valser(S)));
     839         833 :   long l = lg(v), n2 = n + 2;
     840         833 :   if (l < n2) pari_err_BUG("sertovecslice [n too large]");
     841         833 :   return (l == n2)? v: vecslice(v, 1, n2-1);
     842             : }
     843             : 
     844             : /* a, b two RgV of the same length, multiply as truncated power series */
     845             : static GEN
     846        3339 : RgV_mul_RgXn(GEN a, GEN b)
     847             : {
     848        3339 :   long n = lg(a)-1;
     849             :   GEN c;
     850        3339 :   a = RgV_to_RgX(a,0);
     851        3339 :   b = RgV_to_RgX(b,0); c = RgXn_mul(a, b, n);
     852        3339 :   c = RgX_to_RgC(c,n); settyp(c,t_VEC); return c;
     853             : }
     854             : /* divide as truncated power series */
     855             : static GEN
     856         399 : RgV_div_RgXn(GEN a, GEN b)
     857             : {
     858         399 :   long n = lg(a)-1;
     859             :   GEN c;
     860         399 :   a = RgV_to_RgX(a,0);
     861         399 :   b = RgV_to_RgX(b,0); c = RgXn_div_i(a, b, n);
     862         399 :   c = RgX_to_RgC(c,n); settyp(c,t_VEC); return c;
     863             : }
     864             : /* a^b */
     865             : static GEN
     866         112 : RgV_pows_RgXn(GEN a, long b)
     867             : {
     868         112 :   long n = lg(a)-1;
     869             :   GEN c;
     870         112 :   a = RgV_to_RgX(a,0);
     871         112 :   if (b < 0) { a = RgXn_inv(a, n); b = -b; }
     872         112 :   c = RgXn_powu_i(a,b,n);
     873         112 :   c = RgX_to_RgC(c,n); settyp(c,t_VEC); return c;
     874             : }
     875             : 
     876             : /* assume lg(V) >= n*d + 2 */
     877             : static GEN
     878        8645 : c_deflate(long n, long d, GEN v)
     879             : {
     880        8645 :   long i, id, l = n+2;
     881             :   GEN w;
     882        8645 :   if (d == 1) return lg(v) == l ? v: vecslice(v, 1, l-1);
     883         441 :   w = cgetg(l, typ(v));
     884       10724 :   for (i = id = 1; i < l; i++, id += d) gel(w, i) = gel(v, id);
     885         441 :   return w;
     886             : }
     887             : 
     888             : static void
     889          14 : err_cyclo(void)
     890          14 : { pari_err_IMPL("changing cyclotomic fields in mf"); }
     891             : /* Q(zeta_a) = Q(zeta_b) ? */
     892             : static int
     893         616 : same_cyc(long a, long b)
     894         616 : { return (a == b) || (odd(a) && b == (a<<1)) || (odd(b) && a == (b<<1)); }
     895             : /* need to combine elements in Q(CHI1) and Q(CHI2) with result in Q(CHI),
     896             :  * CHI = CHI1 * CHI2 or CHI / CHI2 times some character of order 2 */
     897             : static GEN
     898        2723 : chicompat(GEN CHI, GEN CHI1, GEN CHI2)
     899             : {
     900        2723 :   long o1 = mfcharorder(CHI1);
     901        2723 :   long o2 = mfcharorder(CHI2), O, o;
     902             :   GEN T1, T2, P, Po;
     903        2723 :   if (o1 <= 2 && o2 <= 2) return NULL;
     904         623 :   o = mfcharorder(CHI);
     905         623 :   Po = mfcharpol(CHI);
     906         623 :   P = mfcharpol(CHI1);
     907         623 :   if (o1 == o2)
     908             :   {
     909          21 :     if (o1 == o) return NULL;
     910          14 :     if (!same_cyc(o1,o)) err_cyclo();
     911           0 :     return mkvec4(P, gen_1,gen_1, Qab_trace_init(o1, o, P, Po));
     912             :   }
     913         602 :   O = ulcm(o1, o2);
     914         602 :   if (!same_cyc(O,o)) err_cyclo();
     915         602 :   if (O != o1) P = (O == o2)? mfcharpol(CHI2): polcyclo(O, varn(P));
     916         602 :   T1 = o1 <= 2? gen_1: utoipos(O / o1);
     917         602 :   T2 = o2 <= 2? gen_1: utoipos(O / o2);
     918         602 :   return mkvec4(P, T1, T2, O == o? gen_1: Qab_trace_init(O, o, P, Po));
     919             : }
     920             : /* *F a vector of cyclotomic numbers */
     921             : static void
     922           7 : compatlift(GEN *F, long o, GEN P)
     923             : {
     924             :   long i, l;
     925           7 :   GEN f = *F, g = cgetg_copy(f,&l);
     926          56 :   for (i = 1; i < l; i++)
     927             :   {
     928          49 :     GEN fi = lift_shallow(gel(f,i));
     929          49 :     gel(g,i) = gmodulo(typ(fi)==t_POL? RgX_inflate(fi,o): fi, P);
     930             :   }
     931           7 :   *F = g;
     932           7 : }
     933             : static void
     934         651 : chicompatlift(GEN T, GEN *F, GEN *G)
     935             : {
     936         651 :   long o1 = itou(gel(T,2)), o2 = itou(gel(T,3));
     937         651 :   GEN P = gel(T,1);
     938         651 :   if (o1 != 1) compatlift(F, o1, P);
     939         651 :   if (o2 != 1 && G) compatlift(G, o2, P);
     940         651 : }
     941             : static GEN
     942         651 : chicompatfix(GEN T, GEN F)
     943             : {
     944         651 :   GEN V = gel(T,4);
     945         651 :   if (typ(V) == t_VEC) F = gmodulo(QabV_tracerel(V, 0, F), gel(V,1));
     946         651 :   return F;
     947             : }
     948             : 
     949             : static GEN
     950         637 : c_mul(long n, long d, GEN S)
     951             : {
     952         637 :   pari_sp av = avma;
     953         637 :   long nd = n*d;
     954         637 :   GEN F = gel(S,2), G = gel(S,3);
     955         637 :   F = mfcoefs_i(F, nd, 1);
     956         637 :   G = mfcoefs_i(G, nd, 1);
     957         637 :   if (lg(S) == 5) chicompatlift(gel(S,4),&F,&G);
     958         637 :   F = c_deflate(n, d, RgV_mul_RgXn(F,G));
     959         637 :   if (lg(S) == 5) F = chicompatfix(gel(S,4), F);
     960         637 :   return gerepilecopy(av, F);
     961             : }
     962             : static GEN
     963         112 : c_pow(long n, long d, GEN S)
     964             : {
     965         112 :   pari_sp av = avma;
     966         112 :   long nd = n*d;
     967         112 :   GEN F = gel(S,2), a = gel(S,3), f = mfcoefs_i(F,nd,1);
     968         112 :   if (lg(S) == 5) chicompatlift(gel(S,4),&F, NULL);
     969         112 :   f = RgV_pows_RgXn(f, itos(a));
     970         112 :   f = c_deflate(n, d, f);
     971         112 :   if (lg(S) == 5) f = chicompatfix(gel(S,4), f);
     972         112 :   return gerepilecopy(av, f);
     973             : }
     974             : 
     975             : /* F * Theta */
     976             : static GEN
     977         448 : mfmultheta(GEN F)
     978             : {
     979         448 :   if (typ(mf_get_gk(F)) == t_FRAC && mf_get_type(F) == t_MF_DIV)
     980             :   {
     981         154 :     GEN T = gel(F,3); /* hopefully mfTheta() */
     982         154 :     if (mf_get_type(T) == t_MF_THETA && mf_get_N(T) == 4) return gel(F,2);
     983             :   }
     984         294 :   return mfmul(F, mfTheta(NULL));
     985             : }
     986             : 
     987             : static GEN
     988          42 : c_bracket(long n, long d, GEN S)
     989             : {
     990          42 :   pari_sp av = avma;
     991          42 :   long i, nd = n*d;
     992          42 :   GEN F = gel(S,2), G = gel(S,3), tF, tG, C, mpow, res, gk, gl;
     993          42 :   GEN VF = mfcoefs_i(F, nd, 1);
     994          42 :   GEN VG = mfcoefs_i(G, nd, 1);
     995          42 :   ulong j, m = itou(gel(S,4));
     996             : 
     997          42 :   if (!n)
     998             :   {
     999          14 :     if (m > 0) { set_avma(av); return mkvec(gen_0); }
    1000           7 :     return gerepilecopy(av, mkvec(gmul(gel(VF, 1), gel(VG, 1))));
    1001             :   }
    1002          28 :   tF = cgetg(nd+2, t_VEC);
    1003          28 :   tG = cgetg(nd+2, t_VEC);
    1004          28 :   res = NULL; gk = mf_get_gk(F); gl = mf_get_gk(G);
    1005             :   /* pow[i,j+1] = i^j */
    1006          28 :   if (lg(S) == 6) chicompatlift(gel(S,5),&VF,&VG);
    1007          28 :   mpow = cgetg(m+2, t_MAT);
    1008          28 :   gel(mpow,1) = const_col(nd, gen_1);
    1009          56 :   for (j = 1; j <= m; j++)
    1010             :   {
    1011          28 :     GEN c = cgetg(nd+1, t_COL);
    1012          28 :     gel(mpow,j+1) = c;
    1013         245 :     for (i = 1; i <= nd; i++) gel(c,i) = muliu(gcoeff(mpow,i,j), i);
    1014             :   }
    1015          28 :   C = binomial(gaddgs(gk, m-1), m);
    1016          28 :   if (odd(m)) C = gneg(C);
    1017          84 :   for (j = 0; j <= m; j++)
    1018             :   { /* C = (-1)^(m-j) binom(m+l-1, j) binom(m+k-1,m-j) */
    1019             :     GEN c;
    1020          56 :     gel(tF,1) = j == 0? gel(VF,1): gen_0;
    1021          56 :     gel(tG,1) = j == m? gel(VG,1): gen_0;
    1022          56 :     gel(tF,2) = gel(VF,2); /* assume nd >= 1 */
    1023          56 :     gel(tG,2) = gel(VG,2);
    1024         518 :     for (i = 2; i <= nd; i++)
    1025             :     {
    1026         462 :       gel(tF, i+1) = gmul(gcoeff(mpow,i,j+1),   gel(VF, i+1));
    1027         462 :       gel(tG, i+1) = gmul(gcoeff(mpow,i,m-j+1), gel(VG, i+1));
    1028             :     }
    1029          56 :     c = gmul(C, c_deflate(n, d, RgV_mul_RgXn(tF, tG)));
    1030          56 :     res = res? gadd(res, c): c;
    1031          56 :     if (j < m)
    1032          56 :       C = gdiv(gmul(C, gmulsg(m-j, gaddgs(gl,m-j-1))),
    1033          28 :                gmulsg(-(j+1), gaddgs(gk,j)));
    1034             :   }
    1035          28 :   if (lg(S) == 6) res = chicompatfix(gel(S,5), res);
    1036          28 :   return gerepileupto(av, res);
    1037             : }
    1038             : /* linear combination \sum L[j] vecF[j] */
    1039             : static GEN
    1040        2961 : c_linear(long n, long d, GEN F, GEN L, GEN dL)
    1041             : {
    1042        2961 :   pari_sp av = avma;
    1043        2961 :   long j, l = lg(L);
    1044        2961 :   GEN S = NULL;
    1045       10598 :   for (j = 1; j < l; j++)
    1046             :   {
    1047        7637 :     GEN c = gel(L,j);
    1048        7637 :     if (gequal0(c)) continue;
    1049        6881 :     c = gmul(c, mfcoefs_i(gel(F,j), n, d));
    1050        6881 :     S = S? gadd(S,c): c;
    1051             :   }
    1052        2961 :   if (!S) return zerovec(n+1);
    1053        2961 :   if (!is_pm1(dL)) S = gdiv(S, dL);
    1054        2961 :   return gerepileupto(av, S);
    1055             : }
    1056             : 
    1057             : /* B_d(T_j Trace^new) as t_MF_BD(t_MF_HECKE(t_MF_NEWTRACE)) or
    1058             :  * t_MF_HECKE(t_MF_NEWTRACE)
    1059             :  * or t_MF_NEWTRACE in level N. Set d and j, return t_MF_NEWTRACE component*/
    1060             : static GEN
    1061       81662 : bhn_parse(GEN f, long *d, long *j)
    1062             : {
    1063       81662 :   long t = mf_get_type(f);
    1064       81662 :   *d = *j = 1;
    1065       81662 :   if (t == t_MF_BD) { *d = itos(gel(f,3)); f = gel(f,2); t = mf_get_type(f); }
    1066       81662 :   if (t == t_MF_HECKE) { *j = gel(f,2)[1]; f = gel(f,3); }
    1067       81662 :   return f;
    1068             : }
    1069             : /* f as above, return the t_MF_NEWTRACE component */
    1070             : static GEN
    1071       31689 : bhn_newtrace(GEN f)
    1072             : {
    1073       31689 :   long t = mf_get_type(f);
    1074       31689 :   if (t == t_MF_BD) { f = gel(f,2); t = mf_get_type(f); }
    1075       31689 :   if (t == t_MF_HECKE) f = gel(f,3);
    1076       31689 :   return f;
    1077             : }
    1078             : static int
    1079        3780 : ok_bhn_linear(GEN vf)
    1080             : {
    1081        3780 :   long i, N0 = 0, l = lg(vf);
    1082             :   GEN CHI, gk;
    1083        3780 :   if (l == 1) return 1;
    1084        3780 :   gk = mf_get_gk(gel(vf,1));
    1085        3780 :   CHI = mf_get_CHI(gel(vf,1));
    1086       26943 :   for (i = 1; i < l; i++)
    1087             :   {
    1088       25480 :     GEN f = bhn_newtrace(gel(vf,i));
    1089       25480 :     long N = mf_get_N(f);
    1090       25480 :     if (mf_get_type(f) != t_MF_NEWTRACE) return 0;
    1091       23163 :     if (N < N0) return 0; /* largest level must come last */
    1092       23163 :     N0 = N;
    1093       23163 :     if (!gequal(gk,mf_get_gk(f))) return 0; /* same k */
    1094       23163 :     if (!gequal(gel(mf_get_CHI(f),2), gel(CHI,2))) return 0; /* same CHI */
    1095             :   }
    1096        1463 :   return 1;
    1097             : }
    1098             : 
    1099             : /* vF not empty, same hypotheses as bhnmat_extend */
    1100             : static GEN
    1101        6314 : bhnmat_extend_nocache(GEN M, long N, long n, long d, GEN vF)
    1102             : {
    1103             :   cachenew_t cache;
    1104        6314 :   long l = lg(vF);
    1105             :   GEN f;
    1106        6314 :   if (l == 1) return M? M: cgetg(1, t_MAT);
    1107        6209 :   f = bhn_newtrace(gel(vF,1)); /* N.B. mf_get_N(f) divides N */
    1108        6209 :   init_cachenew(&cache, n*d, N, f);
    1109        6209 :   M = bhnmat_extend(M, n, d, vF, &cache);
    1110        6209 :   dbg_cachenew(&cache); return M;
    1111             : }
    1112             : /* c_linear of "bhn" mf closures, same hypotheses as bhnmat_extend */
    1113             : static GEN
    1114        1652 : c_linear_bhn(long n, long d, GEN F)
    1115             : {
    1116             :   pari_sp av;
    1117        1652 :   GEN M, v, vF = gel(F,2), L = gel(F,3), dL = gel(F,4);
    1118        1652 :   if (lg(L) == 1) return zerovec(n+1);
    1119        1652 :   av = avma;
    1120        1652 :   M = bhnmat_extend_nocache(NULL, mf_get_N(F), n, d, vF);
    1121        1652 :   v = RgM_RgC_mul(M,L); settyp(v, t_VEC);
    1122        1652 :   if (!is_pm1(dL)) v = gdiv(v, dL);
    1123        1652 :   return gerepileupto(av, v);
    1124             : }
    1125             : 
    1126             : /* c in K, K := Q[X]/(T) vz = vector of consecutive powers of root z of T
    1127             :  * attached to an embedding s: K -> C. Return s(c) in C */
    1128             : static GEN
    1129       84658 : Rg_embed1(GEN c, GEN vz)
    1130             : {
    1131       84658 :   long t = typ(c);
    1132       84658 :   if (t == t_POLMOD) { c = gel(c,2); t = typ(c); }
    1133       84658 :   if (t == t_POL) c = RgX_RgV_eval(c, vz);
    1134       84658 :   return c;
    1135             : }
    1136             : /* return s(P) in C[X] */
    1137             : static GEN
    1138         910 : RgX_embed1(GEN P, GEN vz)
    1139             : {
    1140             :   long i, l;
    1141         910 :   GEN Q = cgetg_copy(P, &l);
    1142         910 :   Q[1] = P[1];
    1143        2373 :   for (i = 2; i < l; i++) gel(Q,i) = Rg_embed1(gel(P,i), vz);
    1144         910 :   return normalizepol_lg(Q,l); /* normally a no-op */
    1145             : }
    1146             : /* return s(P) in C^n */
    1147             : static GEN
    1148         798 : vecembed1(GEN P, GEN vz)
    1149             : {
    1150             :   long i, l;
    1151         798 :   GEN Q = cgetg_copy(P, &l);
    1152       39858 :   for (i = 1; i < l; i++) gel(Q,i) = Rg_embed1(gel(P,i), vz);
    1153         798 :   return Q;
    1154             : }
    1155             : /* P in L = K[X]/(U), K = Q[t]/T; s an embedding of K -> C attached
    1156             :  * to a root of T, extended to an embedding of L -> C attached to a root
    1157             :  * of s(U); vT powers of the root of T, vU powers of the root of s(U).
    1158             :  * Return s(P) in C^n */
    1159             : static GEN
    1160       13328 : Rg_embed2(GEN P, long vt, GEN vT, GEN vU)
    1161             : {
    1162             :   long i, l;
    1163             :   GEN Q;
    1164       13328 :   P = liftpol_shallow(P);
    1165       13328 :   if (typ(P) != t_POL) return P;
    1166       13300 :   if (varn(P) == vt) return Rg_embed1(P, vT);
    1167             :   /* varn(P) == vx */
    1168       13293 :   Q = cgetg_copy(P, &l); Q[1] = P[1];
    1169       39669 :   for (i = 2; i < l; i++) gel(Q,i) = Rg_embed1(gel(P,i), vT);
    1170       13293 :   return Rg_embed1(Q, vU);
    1171             : }
    1172             : static GEN
    1173          42 : vecembed2(GEN P, long vt, GEN vT, GEN vU)
    1174             : {
    1175             :   long i, l;
    1176          42 :   GEN Q = cgetg_copy(P, &l);
    1177        1050 :   for (i = 1; i < l; i++) gel(Q,i) = Rg_embed2(gel(P,i), vt, vT, vU);
    1178          42 :   return Q;
    1179             : }
    1180             : static GEN
    1181         532 : RgX_embed2(GEN P, long vt, GEN vT, GEN vU)
    1182             : {
    1183             :   long i, l;
    1184         532 :   GEN Q = cgetg_copy(P, &l);
    1185        3724 :   for (i = 2; i < l; i++) gel(Q,i) = Rg_embed2(gel(P,i), vt, vT, vU);
    1186         532 :   Q[1] = P[1]; return normalizepol_lg(Q,l);
    1187             : }
    1188             : /* embed polynomial f in variable 0 [ may be a scalar ], E from getembed */
    1189             : static GEN
    1190        1645 : RgX_embed(GEN f, GEN E)
    1191             : {
    1192             :   GEN vT;
    1193        1645 :   if (typ(f) != t_POL || varn(f) != 0) return mfembed(E, f);
    1194        1603 :   if (lg(E) == 1) return f;
    1195        1407 :   vT = gel(E,2);
    1196        1407 :   if (lg(E) == 3)
    1197         875 :     f = RgX_embed1(f, vT);
    1198             :   else
    1199         532 :     f = RgX_embed2(f, varn(gel(E,1)), vT, gel(E,3));
    1200        1407 :   return f;
    1201             : }
    1202             : /* embed vector, E from getembed */
    1203             : GEN
    1204        1694 : mfvecembed(GEN E, GEN v)
    1205             : {
    1206             :   GEN vT;
    1207        1694 :   if (lg(E) == 1) return v;
    1208         840 :   vT = gel(E,2);
    1209         840 :   if (lg(E) == 3)
    1210         798 :     v = vecembed1(v, vT);
    1211             :   else
    1212          42 :     v = vecembed2(v, varn(gel(E,1)), vT, gel(E,3));
    1213         840 :   return v;
    1214             : }
    1215             : GEN
    1216          70 : mfmatembed(GEN E, GEN f)
    1217             : {
    1218             :   long i, l;
    1219             :   GEN g;
    1220          70 :   if (lg(E) == 1) return f;
    1221          42 :   g = cgetg_copy(f, &l);
    1222         168 :   for (i = 1; i < l; i++) gel(g,i) = mfvecembed(E, gel(f,i));
    1223          42 :   return g;
    1224             : }
    1225             : /* embed vector of polynomials in var 0 */
    1226             : static GEN
    1227          98 : RgXV_embed(GEN f, GEN E)
    1228             : {
    1229             :   long i, l;
    1230             :   GEN v;
    1231          98 :   if (lg(E) == 1) return f;
    1232          70 :   v = cgetg_copy(f, &l);
    1233        1358 :   for (i = 1; i < l; i++) gel(v,i) = RgX_embed(gel(f,i), E);
    1234          70 :   return v;
    1235             : }
    1236             : 
    1237             : /* embed scalar */
    1238             : GEN
    1239      100663 : mfembed(GEN E, GEN f)
    1240             : {
    1241             :   GEN vT;
    1242      100663 :   if (lg(E) == 1) return f;
    1243       13587 :   vT = gel(E,2);
    1244       13587 :   if (lg(E) == 3)
    1245        4459 :     f = Rg_embed1(f, vT);
    1246             :   else
    1247        9128 :     f = Rg_embed2(f, varn(gel(E,1)), vT, gel(E,3));
    1248       13587 :   return f;
    1249             : }
    1250             : /* vector of the sigma(f), sigma in vE */
    1251             : static GEN
    1252         322 : RgX_embedall(GEN f, GEN vE)
    1253             : {
    1254         322 :   long i, l = lg(vE);
    1255             :   GEN v;
    1256         322 :   if (l == 2) return RgX_embed(f, gel(vE,1));
    1257          35 :   v = cgetg(l, t_VEC);
    1258         105 :   for (i = 1; i < l; i++) gel(v,i) = RgX_embed(f, gel(vE,i));
    1259          35 :   return v;
    1260             : }
    1261             : /* matrix whose colums are the sigma(v), sigma in vE */
    1262             : static GEN
    1263         343 : RgC_embedall(GEN v, GEN vE)
    1264             : {
    1265         343 :   long j, l = lg(vE);
    1266         343 :   GEN M = cgetg(l, t_MAT);
    1267         861 :   for (j = 1; j < l; j++) gel(M,j) = mfvecembed(gel(vE,j), v);
    1268         343 :   return M;
    1269             : }
    1270             : /* vector of the sigma(v), sigma in vE */
    1271             : static GEN
    1272        4907 : Rg_embedall_i(GEN v, GEN vE)
    1273             : {
    1274        4907 :   long j, l = lg(vE);
    1275        4907 :   GEN M = cgetg(l, t_VEC);
    1276       14735 :   for (j = 1; j < l; j++) gel(M,j) = mfembed(gel(vE,j), v);
    1277        4907 :   return M;
    1278             : }
    1279             : /* vector of the sigma(v), sigma in vE; if #vE == 1, return v */
    1280             : static GEN
    1281       95000 : Rg_embedall(GEN v, GEN vE)
    1282       95000 : { return (lg(vE) == 2)? mfembed(gel(vE,1), v): Rg_embedall_i(v, vE); }
    1283             : 
    1284             : static GEN
    1285         833 : c_div_i(long n, GEN S)
    1286             : {
    1287         833 :   GEN F = gel(S,2), G = gel(S,3);
    1288             :   GEN a0, a0i, H;
    1289         833 :   F = mfcoefs_i(F, n, 1);
    1290         833 :   G = mfcoefs_i(G, n, 1);
    1291         833 :   if (lg(S) == 5) chicompatlift(gel(S,4),&F,&G);
    1292         833 :   F = RgV_to_ser_full(F);
    1293         833 :   G = RgV_to_ser_full(G);
    1294         833 :   a0 = polcoef_i(G, 0, -1); /* != 0 */
    1295         833 :   if (gequal1(a0)) a0 = a0i = NULL;
    1296             :   else
    1297             :   {
    1298         602 :     a0i = ginv(a0);
    1299         602 :     G = gmul(ser_unscale(G,a0), a0i);
    1300         602 :     F = gmul(ser_unscale(F,a0), a0i);
    1301             :   }
    1302         833 :   H = gdiv(F, G);
    1303         833 :   if (a0) H = ser_unscale(H,a0i);
    1304         833 :   H = sertovecslice(H, n);
    1305         833 :   if (lg(S) == 5) H = chicompatfix(gel(S,4), H);
    1306         833 :   return H;
    1307             : }
    1308             : static GEN
    1309         833 : c_div(long n, long d, GEN S)
    1310             : {
    1311         833 :   pari_sp av = avma;
    1312         833 :   GEN D = (d==1)? c_div_i(n, S): c_deflate(n, d, c_div_i(n*d, S));
    1313         833 :   return gerepilecopy(av, D);
    1314             : }
    1315             : 
    1316             : static GEN
    1317          35 : c_shift(long n, long d, GEN F, GEN gsh)
    1318             : {
    1319          35 :   pari_sp av = avma;
    1320             :   GEN vF;
    1321          35 :   long sh = itos(gsh), n1 = n*d + sh;
    1322          35 :   if (n1 < 0) return zerovec(n+1);
    1323          35 :   vF = mfcoefs_i(F, n1, 1);
    1324          35 :   if (sh < 0) vF = shallowconcat(zerovec(-sh), vF);
    1325          35 :   else vF = vecslice(vF, sh+1, n1+1);
    1326          35 :   return gerepilecopy(av, c_deflate(n, d, vF));
    1327             : }
    1328             : 
    1329             : static GEN
    1330         147 : c_deriv(long n, long d, GEN F, GEN gm)
    1331             : {
    1332         147 :   pari_sp av = avma;
    1333         147 :   GEN V = mfcoefs_i(F, n, d), res;
    1334         147 :   long i, m = itos(gm);
    1335         147 :   if (!m) return V;
    1336         147 :   res = cgetg(n+2, t_VEC); gel(res,1) = gen_0;
    1337         147 :   if (m < 0)
    1338          49 :   { for (i=1; i <= n; i++) gel(res, i+1) = gdiv(gel(V, i+1), powuu(i,-m)); }
    1339             :   else
    1340        1953 :   { for (i=1; i <= n; i++) gel(res, i+1) = gmul(gel(V,i+1), powuu(i,m)); }
    1341         147 :   return gerepileupto(av, res);
    1342             : }
    1343             : 
    1344             : static GEN
    1345          14 : c_derivE2(long n, long d, GEN F, GEN gm)
    1346             : {
    1347          14 :   pari_sp av = avma;
    1348             :   GEN VF, VE, res, tmp, gk;
    1349          14 :   long i, m = itos(gm), nd;
    1350          14 :   if (m == 0) return mfcoefs_i(F, n, d);
    1351          14 :   nd = n*d;
    1352          14 :   VF = mfcoefs_i(F, nd, 1); VE = mfcoefs_i(mfEk(2), nd, 1);
    1353          14 :   gk = mf_get_gk(F);
    1354          14 :   if (m == 1)
    1355             :   {
    1356           7 :     res = cgetg(n+2, t_VEC);
    1357          56 :     for (i = 0; i <= n; i++) gel(res, i+1) = gmulsg(i, gel(VF, i*d+1));
    1358           7 :     tmp = c_deflate(n, d, RgV_mul_RgXn(VF, VE));
    1359           7 :     return gerepileupto(av, gsub(res, gmul(gdivgu(gk, 12), tmp)));
    1360             :   }
    1361             :   else
    1362             :   {
    1363             :     long j;
    1364          35 :     for (j = 1; j <= m; j++)
    1365             :     {
    1366          28 :       tmp = RgV_mul_RgXn(VF, VE);
    1367         140 :       for (i = 0; i <= nd; i++) gel(VF, i+1) = gmulsg(i, gel(VF, i+1));
    1368          28 :       VF = gsub(VF, gmul(gdivgu(gaddgs(gk, 2*(j-1)), 12), tmp));
    1369             :     }
    1370           7 :     return gerepilecopy(av, c_deflate(n, d, VF));
    1371             :   }
    1372             : }
    1373             : 
    1374             : /* Twist by the character (D/.) */
    1375             : static GEN
    1376           7 : c_twist(long n, long d, GEN F, GEN D)
    1377             : {
    1378           7 :   pari_sp av = avma;
    1379           7 :   GEN V = mfcoefs_i(F, n, d), res = cgetg(n+2, t_VEC);
    1380             :   long i;
    1381         119 :   for (i = 0; i <= n; i++)
    1382         112 :     gel(res, i + 1) = gmulsg(krois(D, i), gel(V, i+1));
    1383           7 :   return gerepileupto(av, res);
    1384             : }
    1385             : 
    1386             : /* form F given by closure, compute T(n)(F) as closure */
    1387             : static GEN
    1388         994 : c_hecke(long m, long l, GEN DATA, GEN F)
    1389             : {
    1390         994 :   pari_sp av = avma;
    1391         994 :   return gerepilecopy(av, hecke_i(m, l, NULL, F, DATA));
    1392             : }
    1393             : static GEN
    1394         140 : c_const(long n, long d, GEN C)
    1395             : {
    1396         140 :   GEN V = zerovec(n+1);
    1397         140 :   long i, j, l = lg(C);
    1398         140 :   if (l > d*n+2) l = d*n+2;
    1399         189 :   for (i = j = 1; i < l; i+=d, j++) gel(V, j) = gcopy(gel(C,i));
    1400         140 :   return V;
    1401             : }
    1402             : 
    1403             : /* m > 0 */
    1404             : static GEN
    1405         469 : eta3_ZXn(long m)
    1406             : {
    1407         469 :   long l = m+2, n, k;
    1408         469 :   GEN P = cgetg(l,t_POL);
    1409         469 :   P[1] = evalsigne(1)|evalvarn(0);
    1410        6489 :   for (n = 2; n < l; n++) gel(P,n) = gen_0;
    1411         469 :   for (n = k = 0;; n++)
    1412             :   {
    1413        2611 :     if (k + n >= m) { setlg(P, k+3); return P; }
    1414        2142 :     k += n;
    1415             :     /* now k = n(n+1) / 2 */
    1416        2142 :     gel(P, k+2) = odd(n)? utoineg(2*n+1): utoipos(2*n+1);
    1417             :   }
    1418             : }
    1419             : 
    1420             : static GEN
    1421         476 : c_delta(long n, long d)
    1422             : {
    1423         476 :   pari_sp ltop = avma;
    1424         476 :   long N = n*d;
    1425             :   GEN e;
    1426         476 :   if (!N) return mkvec(gen_0);
    1427         469 :   e = eta3_ZXn(N);
    1428         469 :   e = ZXn_sqr(e,N);
    1429         469 :   e = ZXn_sqr(e,N);
    1430         469 :   e = ZXn_sqr(e,N); /* eta(x)^24 */
    1431         469 :   settyp(e, t_VEC);
    1432         469 :   gel(e,1) = gen_0; /* Delta(x) = x*eta(x)^24 as a t_VEC */
    1433         469 :   return gerepilecopy(ltop, c_deflate(n, d, e));
    1434             : }
    1435             : 
    1436             : /* return s(d) such that s|f <=> d | f^2 */
    1437             : static long
    1438          56 : mysqrtu(ulong d)
    1439             : {
    1440          56 :   GEN fa = myfactoru(d), P = gel(fa,1), E = gel(fa,2);
    1441          56 :   long l = lg(P), i, s = 1;
    1442         140 :   for (i = 1; i < l; i++) s *= upowuu(P[i], (E[i]+1)>>1);
    1443          56 :   return s;
    1444             : }
    1445             : static GEN
    1446        1855 : c_theta(long n, long d, GEN psi)
    1447             : {
    1448        1855 :   long lim = usqrt(n*d), F = mfcharmodulus(psi), par = mfcharparity(psi);
    1449        1855 :   long f, d2 = d == 1? 1: mysqrtu(d);
    1450        1855 :   GEN V = zerovec(n + 1);
    1451        8134 :   for (f = d2; f <= lim; f += d2)
    1452        6279 :     if (ugcd(F, f) == 1)
    1453             :     {
    1454        6272 :       pari_sp av = avma;
    1455        6272 :       GEN c = mfchareval(psi, f);
    1456        6272 :       gel(V, f*f/d + 1) = gerepileupto(av, par < 0? gmulgu(c,2*f): gmul2n(c,1));
    1457             :     }
    1458        1855 :   if (F == 1) gel(V, 1) = gen_1;
    1459        1855 :   return V; /* no gerepile needed */
    1460             : }
    1461             : 
    1462             : static GEN
    1463         203 : c_etaquo(long n, long d, GEN eta, GEN gs)
    1464             : {
    1465         203 :   pari_sp av = avma;
    1466         203 :   long s = itos(gs), nd = n*d, nds = nd - s + 1;
    1467             :   GEN c;
    1468         203 :   if (nds <= 0) return zerovec(n+1);
    1469         182 :   c = RgX_to_RgC(eta_product_ZXn(eta, nds), nds); settyp(c, t_VEC);
    1470         182 :   if (s > 0) c = shallowconcat(zerovec(s), c);
    1471         182 :   return gerepilecopy(av, c_deflate(n, d, c));
    1472             : }
    1473             : 
    1474             : static GEN
    1475          77 : c_ell(long n, long d, GEN E)
    1476             : {
    1477          77 :   pari_sp av = avma;
    1478             :   GEN v;
    1479          77 :   if (d == 1) return gconcat(gen_0, ellan(E, n));
    1480           7 :   v = vec_prepend(ellan(E, n*d), gen_0);
    1481           7 :   return gerepilecopy(av, c_deflate(n, d, v));
    1482             : }
    1483             : 
    1484             : static GEN
    1485          21 : c_cusptrace(long n, long d, GEN F)
    1486             : {
    1487          21 :   pari_sp av = avma;
    1488          21 :   GEN D = gel(F,2), res = cgetg(n+2, t_VEC);
    1489          21 :   long i, N = mf_get_N(F), k = mf_get_k(F);
    1490          21 :   gel(res, 1) = gen_0;
    1491         140 :   for (i = 1; i <= n; i++)
    1492         119 :     gel(res, i+1) = mfcusptrace_i(N, k, i*d, mydivisorsu(i*d), D);
    1493          21 :   return gerepilecopy(av, res);
    1494             : }
    1495             : 
    1496             : static GEN
    1497        1582 : c_newtrace(long n, long d, GEN F)
    1498             : {
    1499        1582 :   pari_sp av = avma;
    1500             :   cachenew_t cache;
    1501        1582 :   long N = mf_get_N(F);
    1502             :   GEN v;
    1503        1582 :   init_cachenew(&cache, n == 1? 1: n*d, N, F);
    1504        1582 :   v = colnewtrace(0, n, d, N, mf_get_k(F), &cache);
    1505        1582 :   settyp(v, t_VEC); return gerepilecopy(av, v);
    1506             : }
    1507             : 
    1508             : static GEN
    1509        7196 : c_Bd(long n, long d, GEN F, GEN A)
    1510             : {
    1511        7196 :   pari_sp av = avma;
    1512        7196 :   long a = itou(A), ad = ugcd(a,d), aad = a/ad, i, j;
    1513        7196 :   GEN w, v = mfcoefs_i(F, n/aad, d/ad);
    1514        7196 :   if (a == 1) return v;
    1515        7196 :   n++; w = zerovec(n);
    1516      209139 :   for (i = j = 1; j <= n; i++, j += aad) gel(w,j) = gcopy(gel(v,i));
    1517        7196 :   return gerepileupto(av, w);
    1518             : }
    1519             : 
    1520             : static GEN
    1521        5579 : c_dihedral(long n, long d, GEN F)
    1522             : {
    1523        5579 :   pari_sp av = avma;
    1524        5579 :   GEN CHI = mf_get_CHI(F);
    1525        5579 :   GEN w = gel(F,3), V = dihan(gel(F,2), w, gel(F,4), mfcharorder(CHI), n*d);
    1526        5579 :   GEN Tinit = gel(w,3), Pm = gel(Tinit,1);
    1527        5579 :   GEN A = c_deflate(n, d, V);
    1528        5579 :   if (degpol(Pm) == 1 || RgV_is_ZV(A)) return gerepilecopy(av, A);
    1529        1043 :   return gerepileupto(av, gmodulo(A, Pm));
    1530             : }
    1531             : 
    1532             : static GEN
    1533         315 : c_mfEH(long n, long d, GEN F)
    1534             : {
    1535         315 :   pari_sp av = avma;
    1536             :   GEN v, M, A;
    1537         315 :   long i, r = mf_get_r(F);
    1538         315 :   if (n == 1)
    1539          14 :     return gerepilecopy(av, mkvec2(mfEHcoef(r,0),mfEHcoef(r,d)));
    1540             :   /* speedup mfcoef */
    1541         301 :   if (r == 1)
    1542             :   {
    1543          70 :     v = cgetg(n+2, t_VEC);
    1544          70 :     gel(v,1) = sstoQ(-1,12);
    1545       83258 :     for (i = 1; i <= n; i++)
    1546             :     {
    1547       83188 :       long id = i*d, a = id & 3;
    1548       83188 :       gel(v,i+1) = (a==1 || a==2)? gen_0: uutoQ(hclassno6u(id), 6);
    1549             :     }
    1550          70 :     return v; /* no gerepile needed */
    1551             :   }
    1552         231 :   M = mfEHmat(n*d+1,r);
    1553         231 :   if (d > 1)
    1554             :   {
    1555          35 :     long l = lg(M);
    1556         119 :     for (i = 1; i < l; i++) gel(M,i) = c_deflate(n, d, gel(M,i));
    1557             :   }
    1558         231 :   A = gel(F,2); /* [num(B), den(B)] */
    1559         231 :   v = RgC_Rg_div(RgM_RgC_mul(M, gel(A,1)), gel(A,2));
    1560         231 :   settyp(v,t_VEC); return gerepileupto(av, v);
    1561             : }
    1562             : 
    1563             : static GEN
    1564       11228 : c_mfeisen(long n, long d, GEN F)
    1565             : {
    1566       11228 :   pari_sp av = avma;
    1567       11228 :   GEN v, vchi, E0, P, T, CHI, gk = mf_get_gk(F);
    1568             :   long i, k;
    1569       11228 :   if (typ(gk) != t_INT) return c_mfEH(n, d, F);
    1570       10913 :   k = itou(gk);
    1571       10913 :   vchi = gel(F,2);
    1572       10913 :   E0 = gel(vchi,1);
    1573       10913 :   T = gel(vchi,2);
    1574       10913 :   P = gel(T,1);
    1575       10913 :   CHI = gel(vchi,3);
    1576       10913 :   v = cgetg(n+2, t_VEC);
    1577       10913 :   gel(v, 1) = gcopy(E0); /* E(0) */
    1578       10913 :   if (lg(vchi) == 5)
    1579             :   { /* E_k(chi1,chi2) */
    1580        8820 :     GEN CHI2 = gel(vchi,4), F3 = gel(F,3);
    1581        8820 :     long ord = F3[1], j = F3[2];
    1582      508634 :     for (i = 1; i <= n; i++) gel(v, i+1) = sigchi2(k, CHI, CHI2, i*d, ord);
    1583        8820 :     v = QabV_tracerel(T, j, v);
    1584             :   }
    1585             :   else
    1586             :   { /* E_k(chi) */
    1587       26285 :     for (i = 1; i <= n; i++) gel(v, i+1) = sigchi(k, CHI, i*d);
    1588             :   }
    1589       10913 :   if (degpol(P) != 1 && !RgV_is_QV(v)) return gerepileupto(av, gmodulo(v, P));
    1590        7980 :   return gerepilecopy(av, v);
    1591             : }
    1592             : 
    1593             : /* N^k * (D * B_k)(x/N), set D = denom(B_k) */
    1594             : static GEN
    1595        1561 : bern_init(long N, long k, GEN *pD)
    1596        1561 : { return ZX_rescale(Q_remove_denom(bernpol(k, 0), pD), utoi(N)); }
    1597             : 
    1598             : /* L(chi_D, 1-k) */
    1599             : static GEN
    1600          28 : lfunquadneg_naive(long D, long k)
    1601             : {
    1602             :   GEN B, dS, S;
    1603          28 :   long r, N = labs(D);
    1604             :   pari_sp av;
    1605          28 :   if (k == 1 && N == 1) return gneg(ghalf);
    1606          28 :   B = bern_init(N, k, &dS);
    1607          28 :   dS = mul_denom(dS, stoi(-N*k));
    1608          28 :   av = avma;
    1609        7175 :   for (r = 0, S = gen_0; r < N; r++)
    1610             :   {
    1611        7147 :     long c = kross(D, r);
    1612        7147 :     if (c)
    1613             :     {
    1614        5152 :       GEN t = ZX_Z_eval(B, utoi(r));
    1615        5152 :       S = c > 0 ? addii(S, t) : subii(S, t);
    1616        5152 :       S = gerepileuptoint(av, S);
    1617             :     }
    1618             :   }
    1619          28 :   return gdiv(S, dS);
    1620             : }
    1621             : 
    1622             : /* Returns vector of coeffs from F[0], F[d], ..., F[d*n] */
    1623             : static GEN
    1624       36365 : mfcoefs_i(GEN F, long n, long d)
    1625             : {
    1626       36365 :   if (n < 0) return gen_0;
    1627       36365 :   switch(mf_get_type(F))
    1628             :   {
    1629         140 :     case t_MF_CONST: return c_const(n, d, gel(F,2));
    1630       11228 :     case t_MF_EISEN: return c_mfeisen(n, d, F);
    1631         812 :     case t_MF_Ek: return c_Ek(n, d, F);
    1632         476 :     case t_MF_DELTA: return c_delta(n, d);
    1633        1617 :     case t_MF_THETA: return c_theta(n, d, gel(F,2));
    1634         203 :     case t_MF_ETAQUO: return c_etaquo(n, d, gel(F,2), gel(F,3));
    1635          77 :     case t_MF_ELL: return c_ell(n, d, gel(F,2));
    1636         637 :     case t_MF_MUL: return c_mul(n, d, F);
    1637         112 :     case t_MF_POW: return c_pow(n, d, F);
    1638          42 :     case t_MF_BRACKET: return c_bracket(n, d, F);
    1639        2961 :     case t_MF_LINEAR: return c_linear(n, d, gel(F,2), gel(F,3), gel(F,4));
    1640        1652 :     case t_MF_LINEAR_BHN: return c_linear_bhn(n, d, F);
    1641         833 :     case t_MF_DIV: return c_div(n, d, F);
    1642          35 :     case t_MF_SHIFT: return c_shift(n, d, gel(F,2), gel(F,3));
    1643         147 :     case t_MF_DERIV: return c_deriv(n, d, gel(F,2), gel(F,3));
    1644          14 :     case t_MF_DERIVE2: return c_derivE2(n, d, gel(F,2), gel(F,3));
    1645           7 :     case t_MF_TWIST: return c_twist(n, d, gel(F,2), gel(F,3));
    1646         994 :     case t_MF_HECKE: return c_hecke(n, d, gel(F,2), gel(F,3));
    1647        7196 :     case t_MF_BD: return c_Bd(n, d, gel(F,2), gel(F,3));
    1648          21 :     case t_MF_TRACE: return c_cusptrace(n, d, F);
    1649        1582 :     case t_MF_NEWTRACE: return c_newtrace(n, d, F);
    1650        5579 :     case t_MF_DIHEDRAL: return c_dihedral(n, d, F);
    1651             :     default: pari_err_TYPE("mfcoefs",F); return NULL;/*LCOV_EXCL_LINE*/
    1652             :   }
    1653             : }
    1654             : 
    1655             : static GEN
    1656         385 : matdeflate(long n, long d, GEN M)
    1657             : {
    1658             :   long i, l;
    1659             :   GEN A;
    1660             :   /*  if (d == 1) return M; */
    1661         385 :   A = cgetg_copy(M,&l);
    1662        1575 :   for (i = 1; i < l; i++) gel(A,i) = c_deflate(n,d,gel(M,i));
    1663         385 :   return A;
    1664             : }
    1665             : static int
    1666        5747 : space_is_cusp(long space) { return space != mf_FULL && space != mf_EISEN; }
    1667             : /* safe with flraw mf */
    1668             : static GEN
    1669        2576 : mfcoefs_mf(GEN mf, long n, long d)
    1670             : {
    1671        2576 :   GEN MS, ME, E = MF_get_E(mf), S = MF_get_S(mf), M = MF_get_M(mf);
    1672        2576 :   long lE = lg(E), lS = lg(S), l = lE+lS-1;
    1673             : 
    1674        2576 :   if (l == 1) return cgetg(1, t_MAT);
    1675        2464 :   if (typ(M) == t_MAT && lg(M) != 1 && (n+1)*d < nbrows(M))
    1676          21 :     return matdeflate(n, d, M); /*cached; lg = 1 is possible from mfinit */
    1677        2443 :   ME = (lE == 1)? cgetg(1, t_MAT): mfvectomat(E, n, d);
    1678        2443 :   if (lS == 1)
    1679         448 :     MS = cgetg(1, t_MAT);
    1680        1995 :   else if (mf_get_type(gel(S,1)) == t_MF_DIV) /*k 1/2-integer or k=1 (exotic)*/
    1681         364 :     MS = matdeflate(n,d, mflineardivtomat(MF_get_N(mf), S, n*d));
    1682        1631 :   else if (MF_get_k(mf) == 1) /* k = 1 (dihedral) */
    1683             :   {
    1684         308 :     GEN M = mfvectomat(gmael(S,1,2), n, d);
    1685             :     long i;
    1686         308 :     MS = cgetg(lS, t_MAT);
    1687        1589 :     for (i = 1; i < lS; i++)
    1688             :     {
    1689        1281 :       GEN f = gel(S,i), dc = gel(f,4), c = RgM_RgC_mul(M, gel(f,3));
    1690        1281 :       if (!equali1(dc)) c = RgC_Rg_div(c,dc);
    1691        1281 :       gel(MS,i) = c;
    1692             :     }
    1693             :   }
    1694             :   else /* k >= 2 integer */
    1695        1323 :     MS = bhnmat_extend_nocache(NULL, MF_get_N(mf), n, d, S);
    1696        2443 :   return shallowconcat(ME,MS);
    1697             : }
    1698             : GEN
    1699        3787 : mfcoefs(GEN F, long n, long d)
    1700             : {
    1701        3787 :   if (!checkmf_i(F))
    1702             :   {
    1703          42 :     pari_sp av = avma;
    1704          42 :     GEN mf = checkMF_i(F); if (!mf) pari_err_TYPE("mfcoefs", F);
    1705          42 :     return gerepilecopy(av, mfcoefs_mf(mf,n,d));
    1706             :   }
    1707        3745 :   if (d <= 0) pari_err_DOMAIN("mfcoefs", "d", "<=", gen_0, stoi(d));
    1708        3745 :   if (n < 0) return cgetg(1, t_VEC);
    1709        3745 :   return mfcoefs_i(F, n, d);
    1710             : }
    1711             : 
    1712             : /* assume k >= 0 */
    1713             : static GEN
    1714         308 : mfak_i(GEN F, long k)
    1715             : {
    1716         308 :   if (!k) return gel(mfcoefs_i(F,0,1), 1);
    1717         154 :   return gel(mfcoefs_i(F,1,k), 2);
    1718             : }
    1719             : GEN
    1720         154 : mfcoef(GEN F, long n)
    1721             : {
    1722         154 :   pari_sp av = avma;
    1723         154 :   if (!checkmf_i(F)) pari_err_TYPE("mfcoef",F);
    1724         154 :   return n < 0? gen_0: gerepilecopy(av, mfak_i(F, n));
    1725             : }
    1726             : 
    1727             : static GEN
    1728         126 : paramconst() { return tagparams(t_MF_CONST, mkNK(1,0,mfchartrivial())); }
    1729             : static GEN
    1730          84 : mftrivial(void) { retmkvec2(paramconst(), cgetg(1,t_VEC)); }
    1731             : static GEN
    1732          42 : mf1(void) { retmkvec2(paramconst(), mkvec(gen_1)); }
    1733             : 
    1734             : /* induce mfchar CHI to G */
    1735             : static GEN
    1736      307783 : induce(GEN G, GEN CHI)
    1737             : {
    1738             :   GEN o, chi;
    1739      307783 :   if (typ(CHI) == t_INT) /* Kronecker */
    1740             :   {
    1741      300776 :     chi = znchar_quad(G, CHI);
    1742      300776 :     o = ZV_equal0(chi)? gen_1: gen_2;
    1743      300776 :     CHI = mkvec4(G,chi,o,cgetg(1,t_VEC));
    1744             :   }
    1745             :   else
    1746             :   {
    1747        7007 :     if (mfcharmodulus(CHI) == itos(znstar_get_N(G))) return CHI;
    1748        6391 :     CHI = leafcopy(CHI);
    1749        6391 :     chi = zncharinduce(gel(CHI,1), gel(CHI,2), G);
    1750        6391 :     gel(CHI,1) = G;
    1751        6391 :     gel(CHI,2) = chi;
    1752             :   }
    1753      307167 :   return CHI;
    1754             : }
    1755             : /* induce mfchar CHI to znstar(N) */
    1756             : static GEN
    1757       42364 : induceN(long N, GEN CHI)
    1758             : {
    1759       42364 :   if (mfcharmodulus(CHI) != N) CHI = induce(znstar0(utoipos(N),1), CHI);
    1760       42364 :   return CHI;
    1761             : }
    1762             : /* *pCHI1 and *pCHI2 are mfchar, induce to common modulus */
    1763             : static void
    1764        6419 : char2(GEN *pCHI1, GEN *pCHI2)
    1765             : {
    1766        6419 :   GEN CHI1 = *pCHI1, G1 = gel(CHI1,1), N1 = znstar_get_N(G1);
    1767        6419 :   GEN CHI2 = *pCHI2, G2 = gel(CHI2,1), N2 = znstar_get_N(G2);
    1768        6419 :   if (!equalii(N1,N2))
    1769             :   {
    1770        4851 :     GEN G, d = gcdii(N1,N2);
    1771        4851 :     if      (equalii(N2,d)) *pCHI2 = induce(G1, CHI2);
    1772        1540 :     else if (equalii(N1,d)) *pCHI1 = induce(G2, CHI1);
    1773             :     else
    1774             :     {
    1775         154 :       if (!equali1(d)) N2 = diviiexact(N2,d);
    1776         154 :       G = znstar0(mulii(N1,N2), 1);
    1777         154 :       *pCHI1 = induce(G, CHI1);
    1778         154 :       *pCHI2 = induce(G, CHI2);
    1779             :     }
    1780             :   }
    1781        6419 : }
    1782             : /* mfchar or charinit wrt same modulus; outputs a mfchar */
    1783             : static GEN
    1784      301861 : mfcharmul_i(GEN CHI1, GEN CHI2)
    1785             : {
    1786      301861 :   GEN G = gel(CHI1,1), chi3 = zncharmul(G, gel(CHI1,2), gel(CHI2,2));
    1787      301861 :   return mfcharGL(G, chi3);
    1788             : }
    1789             : /* mfchar or charinit; outputs a mfchar */
    1790             : static GEN
    1791        1106 : mfcharmul(GEN CHI1, GEN CHI2)
    1792             : {
    1793        1106 :   char2(&CHI1, &CHI2); return mfcharmul_i(CHI1,CHI2);
    1794             : }
    1795             : /* mfchar or charinit; outputs a mfchar */
    1796             : static GEN
    1797         147 : mfcharpow(GEN CHI, GEN n)
    1798             : {
    1799             :   GEN G, chi;
    1800         147 :   G = gel(CHI,1); chi = zncharpow(G, gel(CHI,2), n);
    1801         147 :   return mfchartoprimitive(mfcharGL(G, chi), NULL);
    1802             : }
    1803             : /* mfchar or charinit wrt same modulus; outputs a mfchar */
    1804             : static GEN
    1805        5313 : mfchardiv_i(GEN CHI1, GEN CHI2)
    1806             : {
    1807        5313 :   GEN G = gel(CHI1,1), chi3 = znchardiv(G, gel(CHI1,2), gel(CHI2,2));
    1808        5313 :   return mfcharGL(G, chi3);
    1809             : }
    1810             : /* mfchar or charinit; outputs a mfchar */
    1811             : static GEN
    1812        5313 : mfchardiv(GEN CHI1, GEN CHI2)
    1813             : {
    1814        5313 :   char2(&CHI1, &CHI2); return mfchardiv_i(CHI1,CHI2);
    1815             : }
    1816             : static GEN
    1817          56 : mfcharconj(GEN CHI)
    1818             : {
    1819          56 :   CHI = leafcopy(CHI);
    1820          56 :   gel(CHI,2) = zncharconj(gel(CHI,1), gel(CHI,2));
    1821          56 :   return CHI;
    1822             : }
    1823             : 
    1824             : /* CHI mfchar, assume 4 | N. Multiply CHI by \chi_{-4} */
    1825             : static GEN
    1826         980 : mfchilift(GEN CHI, long N)
    1827             : {
    1828         980 :   CHI = induceN(N, CHI);
    1829         980 :   return mfcharmul_i(CHI, induce(gel(CHI,1), stoi(-4)));
    1830             : }
    1831             : /* CHI defined mod N, N4 = N/4;
    1832             :  * if CHI is defined mod N4 return CHI;
    1833             :  * else if CHI' = CHI*(-4,.) is defined mod N4, return CHI' (primitive)
    1834             :  * else error */
    1835             : static GEN
    1836          35 : mfcharchiliftprim(GEN CHI, long N4)
    1837             : {
    1838          35 :   long FC = mfcharconductor(CHI);
    1839             :   GEN CHIP;
    1840          35 :   if (N4 % FC == 0) return CHI;
    1841          14 :   CHIP = mfchartoprimitive(mfchilift(CHI, N4 << 2), &FC);
    1842          14 :   if (N4 % FC) pari_err_TYPE("mfkohnenbasis [incorrect CHI]", CHI);
    1843          14 :   return CHIP;
    1844             : }
    1845             : /* ensure CHI(-1) = (-1)^k [k integer] or 1 [half-integer], by multiplying
    1846             :  * by (-4/.) if needed */
    1847             : static GEN
    1848        2821 : mfchiadjust(GEN CHI, GEN gk, long N)
    1849             : {
    1850        2821 :   long par = mfcharparity(CHI);
    1851        2821 :   if (typ(gk) == t_INT &&  mpodd(gk)) par = -par;
    1852        2821 :   return par == 1 ? CHI : mfchilift(CHI, N);
    1853             : }
    1854             : 
    1855             : static GEN
    1856        3878 : mfsamefield(GEN T, GEN P, GEN Q)
    1857             : {
    1858        3878 :   if (degpol(P) == 1) return Q;
    1859         602 :   if (degpol(Q) == 1) return P;
    1860         511 :   if (!gequal(P,Q)) pari_err_TYPE("mfsamefield [different fields]",mkvec2(P,Q));
    1861         504 :   if (T) err_cyclo();
    1862         504 :   return P;
    1863             : }
    1864             : 
    1865             : GEN
    1866         455 : mfmul(GEN f, GEN g)
    1867             : {
    1868         455 :   pari_sp av = avma;
    1869             :   GEN T, N, K, NK, CHI, CHIf, CHIg;
    1870         455 :   if (!checkmf_i(f)) pari_err_TYPE("mfmul",f);
    1871         455 :   if (!checkmf_i(g)) pari_err_TYPE("mfmul",g);
    1872         455 :   N = lcmii(mf_get_gN(f), mf_get_gN(g));
    1873         455 :   K = gadd(mf_get_gk(f), mf_get_gk(g));
    1874         455 :   CHIf = mf_get_CHI(f);
    1875         455 :   CHIg = mf_get_CHI(g);
    1876         455 :   CHI = mfchiadjust(mfcharmul(CHIf,CHIg), K, itos(N));
    1877         455 :   T = chicompat(CHI, CHIf, CHIg);
    1878         455 :   NK = mkgNK(N, K, CHI, mfsamefield(T, mf_get_field(f), mf_get_field(g)));
    1879         448 :   return gerepilecopy(av, T? tag3(t_MF_MUL,NK,f,g,T): tag2(t_MF_MUL,NK,f,g));
    1880             : }
    1881             : GEN
    1882          77 : mfpow(GEN f, long n)
    1883             : {
    1884          77 :   pari_sp av = avma;
    1885             :   GEN T, KK, NK, gn, CHI, CHIf;
    1886          77 :   if (!checkmf_i(f)) pari_err_TYPE("mfpow",f);
    1887          77 :   if (!n) return mf1();
    1888          77 :   if (n == 1) return gcopy(f);
    1889          77 :   KK = gmulsg(n,mf_get_gk(f));
    1890          77 :   gn = stoi(n);
    1891          77 :   CHIf = mf_get_CHI(f);
    1892          77 :   CHI = mfchiadjust(mfcharpow(CHIf,gn), KK, mf_get_N(f));
    1893          77 :   T = chicompat(CHI, CHIf, CHIf);
    1894          70 :   NK = mkgNK(mf_get_gN(f), KK, CHI, mf_get_field(f));
    1895          70 :   return gerepilecopy(av, T? tag3(t_MF_POW,NK,f,gn,T): tag2(t_MF_POW,NK,f,gn));
    1896             : }
    1897             : GEN
    1898          28 : mfbracket(GEN f, GEN g, long m)
    1899             : {
    1900          28 :   pari_sp av = avma;
    1901             :   GEN T, N, K, NK, CHI, CHIf, CHIg;
    1902          28 :   if (!checkmf_i(f)) pari_err_TYPE("mfbracket",f);
    1903          28 :   if (!checkmf_i(g)) pari_err_TYPE("mfbracket",g);
    1904          28 :   if (m < 0) pari_err_TYPE("mfbracket [m<0]",stoi(m));
    1905          28 :   K = gaddgs(gadd(mf_get_gk(f), mf_get_gk(g)), 2*m);
    1906          28 :   if (gsigne(K) < 0) pari_err_IMPL("mfbracket for this form");
    1907          28 :   N = lcmii(mf_get_gN(f), mf_get_gN(g));
    1908          28 :   CHIf = mf_get_CHI(f);
    1909          28 :   CHIg = mf_get_CHI(g);
    1910          28 :   CHI = mfcharmul(CHIf, CHIg);
    1911          28 :   CHI = mfchiadjust(CHI, K, itou(N));
    1912          28 :   T = chicompat(CHI, CHIf, CHIg);
    1913          28 :   NK = mkgNK(N, K, CHI, mfsamefield(T, mf_get_field(f), mf_get_field(g)));
    1914          56 :   return gerepilecopy(av, T? tag4(t_MF_BRACKET, NK, f, g, utoi(m), T)
    1915          28 :                            : tag3(t_MF_BRACKET, NK, f, g, utoi(m)));
    1916             : }
    1917             : 
    1918             : /* remove 0 entries in L */
    1919             : static int
    1920        1260 : mflinear_strip(GEN *pF, GEN *pL)
    1921             : {
    1922        1260 :   pari_sp av = avma;
    1923        1260 :   GEN F = *pF, L = *pL;
    1924        1260 :   long i, j, l = lg(L);
    1925        1260 :   GEN F2 = cgetg(l, t_VEC), L2 = cgetg(l, t_VEC);
    1926        7693 :   for (i = j = 1; i < l; i++)
    1927             :   {
    1928        6433 :     if (gequal0(gel(L,i))) continue;
    1929        3633 :     gel(F2,j) = gel(F,i);
    1930        3633 :     gel(L2,j) = gel(L,i); j++;
    1931             :   }
    1932        1260 :   if (j == l) set_avma(av);
    1933             :   else
    1934             :   {
    1935         371 :     setlg(F2,j); *pF = F2;
    1936         371 :     setlg(L2,j); *pL = L2;
    1937             :   }
    1938        1260 :   return (j > 1);
    1939             : }
    1940             : static GEN
    1941        6356 : taglinear_i(long t, GEN NK, GEN F, GEN L)
    1942             : {
    1943             :   GEN dL;
    1944        6356 :   L = Q_remove_denom(L, &dL); if (!dL) dL = gen_1;
    1945        6356 :   return tag3(t, NK, F, L, dL);
    1946             : }
    1947             : static GEN
    1948        2569 : taglinear(GEN NK, GEN F, GEN L)
    1949             : {
    1950        2569 :   long t = ok_bhn_linear(F)? t_MF_LINEAR_BHN: t_MF_LINEAR;
    1951        2569 :    return taglinear_i(t, NK, F, L);
    1952             : }
    1953             : /* assume F has parameters NK = [N,K,CHI] */
    1954             : static GEN
    1955         294 : mflinear_i(GEN NK, GEN F, GEN L)
    1956             : {
    1957         294 :   if (!mflinear_strip(&F,&L)) return mftrivial();
    1958         294 :   return taglinear(NK, F,L);
    1959             : }
    1960             : static GEN
    1961         511 : mflinear_bhn(GEN mf, GEN L)
    1962             : {
    1963             :   long i, l;
    1964         511 :   GEN P, NK, F = MF_get_S(mf);
    1965         511 :   if (!mflinear_strip(&F,&L)) return mftrivial();
    1966         504 :   l = lg(L); P = pol_x(1);
    1967        2653 :   for (i = 1; i < l; i++)
    1968             :   {
    1969        2149 :     GEN c = gel(L,i);
    1970        2149 :     if (typ(c) == t_POLMOD && varn(gel(c,1)) == 1)
    1971         518 :       P = mfsamefield(NULL, P, gel(c,1));
    1972             :   }
    1973         504 :   NK = mkgNK(MF_get_gN(mf), MF_get_gk(mf), MF_get_CHI(mf), P);
    1974         504 :   return taglinear_i(t_MF_LINEAR_BHN,  NK, F,L);
    1975             : }
    1976             : 
    1977             : /* F vector of forms with same weight and character but varying level, return
    1978             :  * global [N,k,chi,P] */
    1979             : static GEN
    1980        3227 : vecmfNK(GEN F)
    1981             : {
    1982        3227 :   long i, l = lg(F);
    1983             :   GEN N, f;
    1984        3227 :   if (l == 1) return mkNK(1, 0, mfchartrivial());
    1985        3227 :   f = gel(F,1); N = mf_get_gN(f);
    1986       45255 :   for (i = 2; i < l; i++) N = lcmii(N, mf_get_gN(gel(F,i)));
    1987        3227 :   return mkgNK(N, mf_get_gk(f), mf_get_CHI(f), mf_get_field(f));
    1988             : }
    1989             : /* do not use mflinear: mflineardivtomat rely on F being constant across the
    1990             :  * basis where mflinear strips the ones matched by 0 coeffs. Assume k and CHI
    1991             :  * constant, N is allowed to vary. */
    1992             : static GEN
    1993        1211 : vecmflinear(GEN F, GEN C)
    1994             : {
    1995        1211 :   long i, t, l = lg(C);
    1996        1211 :   GEN NK, v = cgetg(l, t_VEC);
    1997        1211 :   if (l == 1) return v;
    1998        1211 :   t = ok_bhn_linear(F)? t_MF_LINEAR_BHN: t_MF_LINEAR;
    1999        1211 :   NK = vecmfNK(F);
    2000        4494 :   for (i = 1; i < l; i++) gel(v,i) = taglinear_i(t, NK, F, gel(C,i));
    2001        1211 :   return v;
    2002             : }
    2003             : /* vecmflinear(F,C), then divide everything by E, which has valuation 0 */
    2004             : static GEN
    2005         427 : vecmflineardiv0(GEN F, GEN C, GEN E)
    2006             : {
    2007         427 :   GEN v = vecmflinear(F, C);
    2008         427 :   long i, l = lg(v);
    2009         427 :   if (l == 1) return v;
    2010         427 :   gel(v,1) = mfdiv_val(gel(v,1), E, 0);
    2011        1631 :   for (i = 2; i < l; i++)
    2012             :   { /* v[i] /= E */
    2013        1204 :     GEN f = shallowcopy(gel(v,1));
    2014        1204 :     gel(f,2) = gel(v,i);
    2015        1204 :     gel(v,i) = f;
    2016             :   }
    2017         427 :   return v;
    2018             : }
    2019             : 
    2020             : /* Non empty linear combination of linear combinations of same
    2021             :  * F_j=\sum_i \mu_{i,j}G_i so R = \sum_i (\sum_j(\la_j\mu_{i,j})) G_i */
    2022             : static GEN
    2023        2016 : mflinear_linear(GEN F, GEN L, int strip)
    2024             : {
    2025        2016 :   long l = lg(F), j;
    2026        2016 :   GEN vF, M = cgetg(l, t_MAT);
    2027        2016 :   L = shallowcopy(L);
    2028       18522 :   for (j = 1; j < l; j++)
    2029             :   {
    2030       16506 :     GEN f = gel(F,j), c = gel(f,3), d = gel(f,4);
    2031       16506 :     if (typ(c) == t_VEC) c = shallowtrans(c);
    2032       16506 :     if (!isint1(d)) gel(L,j) = gdiv(gel(L,j),d);
    2033       16506 :     gel(M,j) = c;
    2034             :   }
    2035        2016 :   vF = gmael(F,1,2); L = RgM_RgC_mul(M,L);
    2036        2016 :   if (strip && !mflinear_strip(&vF,&L)) return mftrivial();
    2037        2016 :   return taglinear(vecmfNK(vF), vF, L);
    2038             : }
    2039             : /* F nonempty vector of forms of the form mfdiv(mflinear(B,v), E) where E
    2040             :  * does not vanish at oo, or mflinear(B,v). Apply mflinear(F, L) */
    2041             : static GEN
    2042        2016 : mflineardiv_linear(GEN F, GEN L, int strip)
    2043             : {
    2044        2016 :   long l = lg(F), j;
    2045             :   GEN v, E, f;
    2046        2016 :   if (lg(L) != l) pari_err_DIM("mflineardiv_linear");
    2047        2016 :   f = gel(F,1); /* l > 1 */
    2048        2016 :   if (mf_get_type(f) != t_MF_DIV) return mflinear_linear(F,L,strip);
    2049        1708 :   E = gel(f,3);
    2050        1708 :   v = cgetg(l, t_VEC);
    2051       17059 :   for (j = 1; j < l; j++) { GEN f = gel(F,j); gel(v,j) = gel(f,2); }
    2052        1708 :   return mfdiv_val(mflinear_linear(v,L,strip), E, 0);
    2053             : }
    2054             : static GEN
    2055         476 : vecmflineardiv_linear(GEN F, GEN M)
    2056             : {
    2057         476 :   long i, l = lg(M);
    2058         476 :   GEN v = cgetg(l, t_VEC);
    2059        1918 :   for (i = 1; i < l; i++) gel(v,i) = mflineardiv_linear(F, gel(M,i), 0);
    2060         476 :   return v;
    2061             : }
    2062             : 
    2063             : static GEN
    2064         630 : tobasis(GEN mf, GEN F, GEN L)
    2065             : {
    2066         630 :   if (checkmf_i(L) && mf) return mftobasis(mf, L, 0);
    2067         623 :   if (typ(F) != t_VEC) pari_err_TYPE("mflinear",F);
    2068         623 :   if (!is_vec_t(typ(L))) pari_err_TYPE("mflinear",L);
    2069         623 :   if (lg(L) != lg(F)) pari_err_DIM("mflinear");
    2070         623 :   return L;
    2071             : }
    2072             : GEN
    2073         672 : mflinear(GEN F, GEN L)
    2074             : {
    2075         672 :   pari_sp av = avma;
    2076         672 :   GEN G, NK, P, mf = checkMF_i(F), N = NULL, K = NULL, CHI = NULL;
    2077             :   long i, l;
    2078         672 :   if (mf)
    2079             :   {
    2080         525 :     GEN gk = MF_get_gk(mf);
    2081         525 :     F = MF_get_basis(F);
    2082         525 :     if (typ(gk) != t_INT)
    2083          42 :       return gerepilecopy(av, mflineardiv_linear(F, L, 1));
    2084         483 :     if (itou(gk) > 1 && space_is_cusp(MF_get_space(mf)))
    2085             :     {
    2086         266 :       L = tobasis(mf, F, L);
    2087         266 :       return gerepilecopy(av, mflinear_bhn(mf, L));
    2088             :     }
    2089             :   }
    2090         364 :   L = tobasis(mf, F, L);
    2091         364 :   if (!mflinear_strip(&F,&L)) return mftrivial();
    2092             : 
    2093         357 :   l = lg(F);
    2094         357 :   if (l == 2 && gequal1(gel(L,1))) return gerepilecopy(av, gel(F,1));
    2095         273 :   P = pol_x(1);
    2096         868 :   for (i = 1; i < l; i++)
    2097             :   {
    2098         602 :     GEN f = gel(F,i), c = gel(L,i), Ni, Ki;
    2099         602 :     if (!checkmf_i(f)) pari_err_TYPE("mflinear", f);
    2100         602 :     Ni = mf_get_gN(f); N = N? lcmii(N, Ni): Ni;
    2101         602 :     Ki = mf_get_gk(f);
    2102         602 :     if (!K) K = Ki;
    2103         329 :     else if (!gequal(K, Ki))
    2104           7 :       pari_err_TYPE("mflinear [different weights]", mkvec2(K,Ki));
    2105         595 :     P = mfsamefield(NULL, P, mf_get_field(f));
    2106         595 :     if (typ(c) == t_POLMOD && varn(gel(c,1)) == 1)
    2107         126 :       P = mfsamefield(NULL, P, gel(c,1));
    2108             :   }
    2109         266 :   G = znstar0(N,1);
    2110         847 :   for (i = 1; i < l; i++)
    2111             :   {
    2112         588 :     GEN CHI2 = mf_get_CHI(gel(F,i));
    2113         588 :     CHI2 = induce(G, CHI2);
    2114         588 :     if (!CHI) CHI = CHI2;
    2115         322 :     else if (!gequal(CHI, CHI2))
    2116           7 :       pari_err_TYPE("mflinear [different characters]", mkvec2(CHI,CHI2));
    2117             :   }
    2118         259 :   NK = mkgNK(N, K, CHI, P);
    2119         259 :   return gerepilecopy(av, taglinear(NK,F,L));
    2120             : }
    2121             : 
    2122             : GEN
    2123          42 : mfshift(GEN F, long sh)
    2124             : {
    2125          42 :   pari_sp av = avma;
    2126          42 :   if (!checkmf_i(F)) pari_err_TYPE("mfshift",F);
    2127          42 :   return gerepilecopy(av, tag2(t_MF_SHIFT, mf_get_NK(F), F, stoi(sh)));
    2128             : }
    2129             : static long
    2130          49 : mfval(GEN F)
    2131             : {
    2132          49 :   pari_sp av = avma;
    2133          49 :   long i = 0, n, sb;
    2134             :   GEN gk, gN;
    2135          49 :   if (!checkmf_i(F)) pari_err_TYPE("mfval", F);
    2136          49 :   gN = mf_get_gN(F);
    2137          49 :   gk = mf_get_gk(F);
    2138          49 :   sb = mfsturmNgk(itou(gN), gk);
    2139          70 :   for (n = 1; n <= sb;)
    2140             :   {
    2141             :     GEN v;
    2142          63 :     if (n > 0.5*sb) n = sb+1;
    2143          63 :     v = mfcoefs_i(F, n, 1);
    2144         119 :     for (; i <= n; i++)
    2145          98 :       if (!gequal0(gel(v, i+1))) return gc_long(av,i);
    2146          21 :     n <<= 1;
    2147             :   }
    2148           7 :   return gc_long(av,-1);
    2149             : }
    2150             : 
    2151             : GEN
    2152        2163 : mfdiv_val(GEN f, GEN g, long vg)
    2153             : {
    2154             :   GEN T, N, K, NK, CHI, CHIf, CHIg;
    2155        2163 :   if (vg) { f = mfshift(f,vg); g = mfshift(g,vg); }
    2156        2163 :   N = lcmii(mf_get_gN(f), mf_get_gN(g));
    2157        2163 :   K = gsub(mf_get_gk(f), mf_get_gk(g));
    2158        2163 :   CHIf = mf_get_CHI(f);
    2159        2163 :   CHIg = mf_get_CHI(g);
    2160        2163 :   CHI = mfchiadjust(mfchardiv(CHIf, CHIg), K, itos(N));
    2161        2163 :   T = chicompat(CHI, CHIf, CHIg);
    2162        2156 :   NK = mkgNK(N, K, CHI, mfsamefield(T, mf_get_field(f), mf_get_field(g)));
    2163        2156 :   return T? tag3(t_MF_DIV, NK, f, g, T): tag2(t_MF_DIV, NK, f, g);
    2164             : }
    2165             : GEN
    2166          49 : mfdiv(GEN F, GEN G)
    2167             : {
    2168          49 :   pari_sp av = avma;
    2169          49 :   long v = mfval(G);
    2170          49 :   if (!checkmf_i(F)) pari_err_TYPE("mfdiv", F);
    2171          42 :   if (v < 0 || (v && !gequal0(mfcoefs(F, v-1, 1))))
    2172          14 :     pari_err_DOMAIN("mfdiv", "ord(G)", ">", strtoGENstr("ord(F)"),
    2173             :                     mkvec2(F, G));
    2174          28 :   return gerepilecopy(av, mfdiv_val(F, G, v));
    2175             : }
    2176             : GEN
    2177         154 : mfderiv(GEN F, long m)
    2178             : {
    2179         154 :   pari_sp av = avma;
    2180             :   GEN NK, gk;
    2181         154 :   if (!checkmf_i(F)) pari_err_TYPE("mfderiv",F);
    2182         154 :   gk = gaddgs(mf_get_gk(F), 2*m);
    2183         154 :   NK = mkgNK(mf_get_gN(F), gk, mf_get_CHI(F), mf_get_field(F));
    2184         154 :   return gerepilecopy(av, tag2(t_MF_DERIV, NK, F, stoi(m)));
    2185             : }
    2186             : GEN
    2187          21 : mfderivE2(GEN F, long m)
    2188             : {
    2189          21 :   pari_sp av = avma;
    2190             :   GEN NK, gk;
    2191          21 :   if (!checkmf_i(F)) pari_err_TYPE("mfderivE2",F);
    2192          21 :   if (m < 0) pari_err_DOMAIN("mfderivE2","m","<",gen_0,stoi(m));
    2193          21 :   gk = gaddgs(mf_get_gk(F), 2*m);
    2194          21 :   NK = mkgNK(mf_get_gN(F), gk, mf_get_CHI(F), mf_get_field(F));
    2195          21 :   return gerepilecopy(av, tag2(t_MF_DERIVE2, NK, F, stoi(m)));
    2196             : }
    2197             : 
    2198             : GEN
    2199          14 : mftwist(GEN F, GEN D)
    2200             : {
    2201          14 :   pari_sp av = avma;
    2202             :   GEN NK, CHI, NT, Da;
    2203             :   long q;
    2204          14 :   if (!checkmf_i(F)) pari_err_TYPE("mftwist", F);
    2205          14 :   if (typ(D) != t_INT) pari_err_TYPE("mftwist", D);
    2206          14 :   Da = mpabs_shallow(D);
    2207          14 :   CHI = mf_get_CHI(F); q = mfcharconductor(CHI);
    2208          14 :   NT = glcm(glcm(mf_get_gN(F), mulsi(q, Da)), sqri(Da));
    2209          14 :   NK = mkgNK(NT, mf_get_gk(F), CHI, mf_get_field(F));
    2210          14 :   return gerepilecopy(av, tag2(t_MF_TWIST, NK, F, D));
    2211             : }
    2212             : 
    2213             : /***************************************************************/
    2214             : /*                 Generic cache handling                      */
    2215             : /***************************************************************/
    2216             : enum { cache_FACT, cache_DIV, cache_H, cache_D, cache_DIH };
    2217             : typedef struct {
    2218             :   const char *name;
    2219             :   GEN cache;
    2220             :   ulong minself, maxself;
    2221             :   void (*init)(long);
    2222             :   ulong miss, maxmiss;
    2223             :   long compressed;
    2224             : } cache;
    2225             : 
    2226             : static void constfact(long lim);
    2227             : static void constdiv(long lim);
    2228             : static void consttabh(long lim);
    2229             : static void consttabdihedral(long lim);
    2230             : static void constcoredisc(long lim);
    2231             : static THREAD cache caches[] = {
    2232             : { "Factors",  NULL,  50000,    50000, &constfact, 0, 0, 0 },
    2233             : { "Divisors", NULL,  50000,    50000, &constdiv, 0, 0, 0 },
    2234             : { "H",        NULL, 100000, 10000000, &consttabh, 0, 0, 1 },
    2235             : { "CorediscF",NULL, 100000, 10000000, &constcoredisc, 0, 0, 0 },
    2236             : { "Dihedral", NULL,   1000,     3000, &consttabdihedral, 0, 0, 0 },
    2237             : };
    2238             : 
    2239             : static void
    2240         598 : cache_reset(long id) { caches[id].miss = caches[id].maxmiss = 0; }
    2241             : static void
    2242        8995 : cache_delete(long id) { guncloneNULL(caches[id].cache); }
    2243             : static void
    2244         612 : cache_set(long id, GEN S)
    2245             : {
    2246         612 :   GEN old = caches[id].cache;
    2247         612 :   caches[id].cache = gclone(S);
    2248         612 :   guncloneNULL(old);
    2249         612 : }
    2250             : 
    2251             : /* handle a cache miss: store stats, possibly reset table; return value
    2252             :  * if (now) cached; return NULL on failure. HACK: some caches contain an
    2253             :  * ulong where the 0 value is impossible, and return it (typecast to GEN) */
    2254             : static GEN
    2255   447780063 : cache_get(long id, ulong D)
    2256             : {
    2257   447780063 :   cache *S = &caches[id];
    2258   447780063 :   const ulong d = S->compressed? D>>1: D;
    2259             :   ulong max, l;
    2260             : 
    2261   447780063 :   if (!S->cache)
    2262             :   {
    2263         440 :     max = maxuu(minuu(D, S->maxself), S->minself);
    2264         440 :     S->init(max);
    2265         440 :     l = lg(S->cache);
    2266             :   }
    2267             :   else
    2268             :   {
    2269   447779623 :     l = lg(S->cache);
    2270   447779623 :     if (l <= d)
    2271             :     {
    2272         327 :       if (D > S->maxmiss) S->maxmiss = D;
    2273         327 :       if (DEBUGLEVEL >= 3)
    2274           0 :         err_printf("miss in cache %s: %lu, max = %lu\n",
    2275             :                    S->name, D, S->maxmiss);
    2276         327 :       if (S->miss++ >= 5 && D < S->maxself)
    2277             :       {
    2278          14 :         max = minuu(S->maxself, (long)(S->maxmiss * 1.2));
    2279          14 :         if (max <= S->maxself)
    2280             :         {
    2281          14 :           if (DEBUGLEVEL >= 3)
    2282           0 :             err_printf("resetting cache %s to %lu\n", S->name, max);
    2283          14 :           S->init(max); l = lg(S->cache);
    2284             :         }
    2285             :       }
    2286             :     }
    2287             :   }
    2288   447780063 :   return (l <= d)? NULL: gel(S->cache, d);
    2289             : }
    2290             : static GEN
    2291          70 : cache_report(long id)
    2292             : {
    2293          70 :   cache *S = &caches[id];
    2294          70 :   GEN v = zerocol(5);
    2295          70 :   gel(v,1) = strtoGENstr(S->name);
    2296          70 :   if (S->cache)
    2297             :   {
    2298          35 :     gel(v,2) = utoi(lg(S->cache)-1);
    2299          35 :     gel(v,3) = utoi(S->miss);
    2300          35 :     gel(v,4) = utoi(S->maxmiss);
    2301          35 :     gel(v,5) = utoi(gsizebyte(S->cache));
    2302             :   }
    2303          70 :   return v;
    2304             : }
    2305             : GEN
    2306          14 : getcache(void)
    2307             : {
    2308          14 :   pari_sp av = avma;
    2309          14 :   GEN M = cgetg(6, t_MAT);
    2310          14 :   gel(M,1) = cache_report(cache_FACT);
    2311          14 :   gel(M,2) = cache_report(cache_DIV);
    2312          14 :   gel(M,3) = cache_report(cache_H);
    2313          14 :   gel(M,4) = cache_report(cache_D);
    2314          14 :   gel(M,5) = cache_report(cache_DIH);
    2315          14 :   return gerepilecopy(av, shallowtrans(M));
    2316             : }
    2317             : 
    2318             : void
    2319        1799 : pari_close_mf(void)
    2320             : {
    2321        1799 :   cache_delete(cache_FACT);
    2322        1799 :   cache_delete(cache_DIV);
    2323        1799 :   cache_delete(cache_H);
    2324        1799 :   cache_delete(cache_D);
    2325        1799 :   cache_delete(cache_DIH);
    2326        1799 : }
    2327             : 
    2328             : /*************************************************************************/
    2329             : /* a odd, update local cache (recycle memory) */
    2330             : static GEN
    2331        2956 : update_factor_cache(long a, long lim, long *pb)
    2332             : {
    2333        2956 :   const long step = 16000; /* even; don't increase this: RAM cache thrashing */
    2334        2956 :   if (a + 2*step > lim)
    2335         233 :     *pb = lim; /* fuse last 2 chunks */
    2336             :   else
    2337        2723 :     *pb = a + step;
    2338        2956 :   return vecfactoroddu_i(a, *pb);
    2339             : }
    2340             : /* assume lim < MAX_LONG/8 */
    2341             : static void
    2342          47 : constcoredisc(long lim)
    2343             : {
    2344          47 :   pari_sp av2, av = avma;
    2345          47 :   GEN D = caches[cache_D].cache, CACHE = NULL;
    2346          47 :   long cachea, cacheb, N, LIM = !D ? 4 : lg(D)-1;
    2347          47 :   if (lim <= 0) lim = 5;
    2348          47 :   if (lim <= LIM) return;
    2349          47 :   cache_reset(cache_D);
    2350          47 :   D = zero_zv(lim);
    2351          36 :   av2 = avma;
    2352          36 :   cachea = cacheb = 0;
    2353     4369396 :   for (N = 1; N <= lim; N+=2)
    2354             :   { /* N odd */
    2355             :     long i, d, d2;
    2356             :     GEN F;
    2357     4369349 :     if (N > cacheb)
    2358             :     {
    2359         530 :       set_avma(av2); cachea = N;
    2360         530 :       CACHE = update_factor_cache(N, lim, &cacheb);
    2361             :     }
    2362     4369349 :     F = gel(CACHE, ((N-cachea)>>1)+1); /* factoru(N) */
    2363     4369349 :     D[N] = d = corediscs_fact(F); /* = 3 mod 4 or 4 mod 16 */
    2364     4369400 :     d2 = odd(d)? d<<3: d<<1;
    2365     4369974 :     for (i = 1;;)
    2366             :     {
    2367     5826312 :       if ((N << i) > lim) break;
    2368     2913890 :       D[N<<i] = d2; i++;
    2369     2913890 :       if ((N << i) > lim) break;
    2370     1456338 :       D[N<<i] = d; i++;
    2371             :     }
    2372             :   }
    2373          47 :   cache_set(cache_D, D);
    2374          47 :   set_avma(av);
    2375             : }
    2376             : 
    2377             : static void
    2378         207 : constfact(long lim)
    2379             : {
    2380             :   pari_sp av;
    2381         207 :   GEN VFACT = caches[cache_FACT].cache;
    2382         207 :   long LIM = VFACT? lg(VFACT)-1: 4;
    2383         207 :   if (lim <= 0) lim = 5;
    2384         207 :   if (lim <= LIM) return;
    2385         186 :   cache_reset(cache_FACT); av = avma;
    2386         186 :   cache_set(cache_FACT, vecfactoru_i(1,lim)); set_avma(av);
    2387             : }
    2388             : static void
    2389         179 : constdiv(long lim)
    2390             : {
    2391             :   pari_sp av;
    2392         179 :   GEN VFACT, VDIV = caches[cache_DIV].cache;
    2393         179 :   long N, LIM = VDIV? lg(VDIV)-1: 4;
    2394         179 :   if (lim <= 0) lim = 5;
    2395         179 :   if (lim <= LIM) return;
    2396         179 :   constfact(lim);
    2397         179 :   VFACT = caches[cache_FACT].cache;
    2398         179 :   cache_reset(cache_DIV); av = avma;
    2399         179 :   VDIV  = cgetg(lim+1, t_VEC);
    2400     8236502 :   for (N = 1; N <= lim; N++) gel(VDIV,N) = divisorsu_fact(gel(VFACT,N));
    2401         179 :   cache_set(cache_DIV, VDIV); set_avma(av);
    2402             : }
    2403             : 
    2404             : /* n > 1, D = divisors(n); sets L = 2*lambda(n), S = sigma(n) */
    2405             : static void
    2406    19482374 : lamsig(GEN D, long *pL, long *pS)
    2407             : {
    2408    19482374 :   pari_sp av = avma;
    2409    19482374 :   long i, l = lg(D), L = 1, S = D[l-1]+1;
    2410    73369637 :   for (i = 2; i < l; i++) /* skip d = 1 */
    2411             :   {
    2412    76190977 :     long d = D[i], nd = D[l-i]; /* nd = n/d */
    2413    76190977 :     if (d < nd) { L += d; S += d + nd; }
    2414             :     else
    2415             :     {
    2416    22303714 :       L <<= 1; if (d == nd) { L += d; S += d; }
    2417    22303714 :       break;
    2418             :     }
    2419             :   }
    2420    19482374 :   set_avma(av); *pL = L; *pS = S;
    2421    22710665 : }
    2422             : /* table of 6 * Hurwitz class numbers D <= lim */
    2423             : static void
    2424         186 : consttabh(long lim)
    2425             : {
    2426         186 :   pari_sp av = avma, av2;
    2427         186 :   GEN VHDH0, VDIV, CACHE = NULL;
    2428         186 :   GEN VHDH = caches[cache_H].cache;
    2429         186 :   long r, N, cachea, cacheb, lim0 = VHDH? lg(VHDH)-1: 2, LIM = lim0 << 1;
    2430             : 
    2431         186 :   if (lim <= 0) lim = 5;
    2432         186 :   if (lim <= LIM) return;
    2433         186 :   cache_reset(cache_H);
    2434         186 :   r = lim&3L; if (r) lim += 4-r;
    2435         186 :   cache_get(cache_DIV, lim);
    2436         186 :   VDIV = caches[cache_DIV].cache;
    2437         186 :   VHDH0 = cgetg(lim/2 + 1, t_VECSMALL);
    2438         186 :   VHDH0[1] = 2;
    2439         186 :   VHDH0[2] = 3;
    2440      483976 :   for (N = 3; N <= lim0; N++) VHDH0[N] = VHDH[N];
    2441         186 :   av2 = avma;
    2442         186 :   cachea = cacheb = 0;
    2443    11727235 :   for (N = LIM + 3; N <= lim; N += 4)
    2444             :   {
    2445    11775327 :     long s = 0, limt = usqrt(N>>2), flsq = 0, ind, t, L, S;
    2446             :     GEN DN, DN2;
    2447    11670331 :     if (N + 2 >= lg(VDIV))
    2448             :     { /* use local cache */
    2449             :       GEN F;
    2450     9511273 :       if (N + 2 > cacheb)
    2451             :       {
    2452        2426 :         set_avma(av2); cachea = N;
    2453        2426 :         CACHE = update_factor_cache(N, lim+2, &cacheb);
    2454             :       }
    2455     9511272 :       F = gel(CACHE, ((N-cachea)>>1)+1); /* factoru(N) */
    2456     9511272 :       DN = divisorsu_fact(F);
    2457     9179435 :       F = gel(CACHE, ((N-cachea)>>1)+2); /* factoru(N+2) */
    2458     9179435 :       DN2 = divisorsu_fact(F);
    2459             :     }
    2460             :     else
    2461             :     { /* use global cache */
    2462     2159058 :       DN = gel(VDIV,N);
    2463     2159058 :       DN2 = gel(VDIV,N+2);
    2464             :     }
    2465    11178428 :     ind = N >> 1;
    2466   974847083 :     for (t = 1; t <= limt; t++)
    2467             :     {
    2468   963668655 :       ind -= (t<<2)-2; /* N/2 - 2t^2 */
    2469   963668655 :       if (ind) s += VHDH0[ind]; else flsq = 1;
    2470             :     }
    2471    11178428 :     lamsig(DN, &L,&S);
    2472    11280541 :     VHDH0[N >> 1] = 2*S - 3*L - 2*s + flsq;
    2473    11280541 :     s = 0; flsq = 0; limt = (usqrt(N+2) - 1) >> 1;
    2474    10504600 :     ind = (N+1) >> 1;
    2475   974189365 :     for (t = 1; t <= limt; t++)
    2476             :     {
    2477   963684765 :       ind -= t<<2; /* (N+1)/2 - 2t(t+1) */
    2478   963684765 :       if (ind) s += VHDH0[ind]; else flsq = 1;
    2479             :     }
    2480    10504600 :     lamsig(DN2, &L,&S);
    2481    11727049 :     VHDH0[(N+1) >> 1] = S - 3*(L >> 1) - s - flsq;
    2482             :   }
    2483          78 :   cache_set(cache_H, VHDH0); set_avma(av);
    2484             : }
    2485             : 
    2486             : /*************************************************************************/
    2487             : /* Core functions using factorizations, divisors of class numbers caches */
    2488             : /* TODO: myfactoru and factorization cache should be exported */
    2489             : static GEN
    2490    33529903 : myfactoru(long N)
    2491             : {
    2492    33529903 :   GEN z = cache_get(cache_FACT, N);
    2493    33529903 :   return z? gcopy(z): factoru(N);
    2494             : }
    2495             : static GEN
    2496    68799368 : mydivisorsu(long N)
    2497             : {
    2498    68799368 :   GEN z = cache_get(cache_DIV, N);
    2499    68799368 :   return z? leafcopy(z): divisorsu(N);
    2500             : }
    2501             : /* write -n = Df^2, D < 0 fundamental discriminant. Return D, set f. */
    2502             : static long
    2503   176273777 : mycoredisc2neg(ulong n, long *pf)
    2504             : {
    2505   176273777 :   ulong m, D = (ulong)cache_get(cache_D, n);
    2506   176273777 :   if (D) { *pf = usqrt(n/D); return -(long)D; }
    2507          56 :   m = mycore(n, pf);
    2508          56 :   if ((m&3) != 3) { m <<= 2; *pf >>= 1; }
    2509          56 :   return (long)-m;
    2510             : }
    2511             : /* write n = Df^2, D > 0 fundamental discriminant. Return D, set f. */
    2512             : static long
    2513          14 : mycoredisc2pos(ulong n, long *pf)
    2514             : {
    2515          14 :   ulong m = mycore(n, pf);
    2516          14 :   if ((m&3) != 1) { m <<= 2; *pf >>= 1; }
    2517          14 :   return (long)m;
    2518             : }
    2519             : 
    2520             : /* D < 0 fundamental. Return 6*hclassno(-D); faster than quadclassunit up
    2521             :  * to 5*10^5 or so */
    2522             : static ulong
    2523          43 : hclassno6_count(long D)
    2524             : {
    2525          43 :   ulong a, b, b2, h = 0, d = -D;
    2526          43 :   int f = 0;
    2527             : 
    2528          43 :   if (d > 500000) return 6 * quadclassnos(D);
    2529             :   /* this part would work with -d non fundamental */
    2530          36 :   b = d&1; b2 = (1+d)>>2;
    2531          36 :   if (!b)
    2532             :   {
    2533         876 :     for (a=1; a*a<b2; a++)
    2534         873 :       if (b2%a == 0) h++;
    2535           3 :     f = (a*a==b2); b=2; b2=(4+d)>>2;
    2536             :   }
    2537        7175 :   while (b2*3 < d)
    2538             :   {
    2539        7139 :     if (b2%b == 0) h++;
    2540     1172517 :     for (a=b+1; a*a < b2; a++)
    2541     1165378 :       if (b2%a == 0) h += 2;
    2542        7139 :     if (a*a == b2) h++;
    2543        7139 :     b += 2; b2 = (b*b+d)>>2;
    2544             :   }
    2545          36 :   if (b2*3 == d) return 6*h+2;
    2546          36 :   if (f) return 6*h+3;
    2547          36 :   return 6*h;
    2548             : }
    2549             : /* D0 < 0; 6 * hclassno(-D), using D = D0*F^2 */
    2550             : static long
    2551          61 : hclassno6u_2(long D0, long F)
    2552             : {
    2553             :   long h;
    2554          61 :   if (F == 1) h = hclassno6_count(D0);
    2555             :   else
    2556             :   { /* second chance */
    2557          18 :     h = (ulong)cache_get(cache_H, -D0);
    2558          18 :     if (!h) h = hclassno6_count(D0);
    2559          18 :     h *= uhclassnoF_fact(myfactoru(F), D0);
    2560             :   }
    2561          61 :   return h;
    2562             : }
    2563             : /* D > 0; 6 * hclassno(D) (6*Hurwitz). Beware, cached value for D (=0,3 mod 4)
    2564             :  * is stored at D>>1 */
    2565             : ulong
    2566     2235036 : hclassno6u(ulong D)
    2567             : {
    2568     2235036 :   ulong z = (ulong)cache_get(cache_H, D);
    2569             :   long D0, F;
    2570     2235037 :   if (z) return z;
    2571          61 :   D0 = mycoredisc2neg(D, &F);
    2572          61 :   return hclassno6u_2(D0,F);
    2573             : }
    2574             : /* same as hclassno6u without creating caches */
    2575             : ulong
    2576       86918 : hclassno6u_no_cache(ulong D)
    2577             : {
    2578       86918 :   cache *S = &caches[cache_H];
    2579             :   long D0, F;
    2580       86918 :   if (S->cache)
    2581             :   {
    2582       76156 :     const ulong d = D>>1; /* compressed */
    2583       76156 :     if ((ulong)lg(S->cache) > d) return S->cache[d];
    2584             :   }
    2585       86648 :   S = &caches[cache_D];
    2586       86648 :   if (!S->cache || (ulong)lg(S->cache) <= D) return 0;
    2587           0 :   D0 = mycoredisc2neg(D, &F);
    2588           0 :   return hclassno6u_2(D0,F);
    2589             : }
    2590             : /* same, where the decomposition D = D0*F^2 is already known */
    2591             : static ulong
    2592   156310125 : hclassno6u_i(ulong D, long D0, long F)
    2593             : {
    2594   156310125 :   ulong z = (ulong)cache_get(cache_H, D);
    2595   156310125 :   if (z) return z;
    2596           0 :   return hclassno6u_2(D0,F);
    2597             : }
    2598             : 
    2599             : /* D < -4 fundamental, h(D), ordinary class number */
    2600             : static long
    2601    10619294 : myh(long D)
    2602             : {
    2603    10619294 :   ulong z = (ulong)cache_get(cache_H, -D);
    2604    10619294 :   return z? z / 6: quadclassnos(D);
    2605             : }
    2606             : 
    2607             : /*************************************************************************/
    2608             : /*                          TRACE FORMULAS                               */
    2609             : /* CHIP primitive, initialize for t_POLMOD output */
    2610             : static GEN
    2611       30926 : mfcharinit(GEN CHIP)
    2612             : {
    2613       30926 :   long n, o, l, vt, N = mfcharmodulus(CHIP);
    2614             :   GEN c, v, V, G, Pn;
    2615       30926 :   if (N == 1) return mkvec2(mkvec(gen_1), pol_x(0));
    2616        5460 :   G = gel(CHIP,1);
    2617        5460 :   v = ncharvecexpo(G, znconrey_normalized(G, gel(CHIP,2)));
    2618        5460 :   l = lg(v); V = cgetg(l, t_VEC);
    2619        5460 :   o = mfcharorder(CHIP);
    2620        5460 :   Pn = mfcharpol(CHIP); vt = varn(Pn);
    2621        5460 :   if (o <= 2)
    2622             :   {
    2623       59143 :     for (n = 1; n < l; n++)
    2624             :     {
    2625       54635 :       if (v[n] < 0) c = gen_0; else c = v[n]? gen_m1: gen_1;
    2626       54635 :       gel(V,n) = c;
    2627             :     }
    2628             :   }
    2629             :   else
    2630             :   {
    2631       16835 :     for (n = 1; n < l; n++)
    2632             :     {
    2633       15883 :       if (v[n] < 0) c = gen_0;
    2634             :       else
    2635             :       {
    2636        8890 :         c = Qab_zeta(v[n], o, vt);
    2637        8890 :         if (typ(c) == t_POL && lg(c) >= lg(Pn)) c = RgX_rem(c, Pn);
    2638             :       }
    2639       15883 :       gel(V,n) = c;
    2640             :     }
    2641             :   }
    2642        5460 :   return mkvec2(V, Pn);
    2643             : }
    2644             : static GEN
    2645      407470 : vchip_lift(GEN VCHI, long x, GEN C)
    2646             : {
    2647      407470 :   GEN V = gel(VCHI,1);
    2648      407470 :   long F = lg(V)-1;
    2649      407470 :   if (F == 1) return C;
    2650       18368 :   x %= F;
    2651       18368 :   if (!x) return C;
    2652       18368 :   if (x <= 0) x += F;
    2653       18368 :   return gmul(C, gel(V, x));
    2654             : }
    2655             : static long
    2656   279152309 : vchip_FC(GEN VCHI) { return lg(gel(VCHI,1))-1; }
    2657             : static GEN
    2658     6406926 : vchip_mod(GEN VCHI, GEN S)
    2659     6406926 : { return (typ(S) == t_POL)? RgX_rem(S, gel(VCHI,2)): S; }
    2660             : static GEN
    2661     1900490 : vchip_polmod(GEN VCHI, GEN S)
    2662     1900490 : { return (typ(S) == t_POL)? mkpolmod(S, gel(VCHI,2)): S; }
    2663             : 
    2664             : /* contribution of scalar matrices in dimension formula */
    2665             : static GEN
    2666      350490 : A1(long N, long k) { return uutoQ(mypsiu(N)*(k-1), 12); }
    2667             : static long
    2668        7483 : ceilA1(long N, long k) { return ceildivuu(mypsiu(N) * (k-1), 12); }
    2669             : 
    2670             : /* sturm bound, slightly larger than dimension */
    2671             : long
    2672       21476 : mfsturmNk(long N, long k) { return (mypsiu(N) * k) / 12; }
    2673             : long
    2674        2492 : mfsturmNgk(long N, GEN k)
    2675             : {
    2676        2492 :   long n,d; Qtoss(k,&n,&d);
    2677        2492 :   return 1 + (mypsiu(N)*n)/(d == 1? 12: 24);
    2678             : }
    2679             : static long
    2680          49 : mfsturmmf(GEN F) { return mfsturmNgk(mf_get_N(F), mf_get_gk(F)); }
    2681             : 
    2682             : /* List of all solutions of x^2 + x + 1 = 0 modulo N, x modulo N */
    2683             : static GEN
    2684         539 : sqrtm3modN(long N)
    2685             : {
    2686             :   pari_sp av;
    2687             :   GEN fa, P, E, B, mB, A, Q, T, R, v, gen_m3;
    2688         539 :   long l, i, n, ct, fl3 = 0, Ninit;
    2689         539 :   if (!odd(N) || (N%9) == 0) return cgetg(1,t_VECSMALL);
    2690         511 :   Ninit = N;
    2691         511 :   if ((N%3) == 0) { N /= 3; fl3 = 1; }
    2692         511 :   fa = myfactoru(N); P = gel(fa, 1); E = gel(fa, 2);
    2693         511 :   l = lg(P);
    2694         707 :   for (i = 1; i < l; i++)
    2695         518 :     if ((P[i]%3) == 2) return cgetg(1,t_VECSMALL);
    2696         189 :   A = cgetg(l, t_VECSMALL);
    2697         189 :   B = cgetg(l, t_VECSMALL);
    2698         189 :   mB= cgetg(l, t_VECSMALL);
    2699         189 :   Q = cgetg(l, t_VECSMALL); gen_m3 = utoineg(3);
    2700         385 :   for (i = 1; i < l; i++)
    2701             :   {
    2702         196 :     long p = P[i], e = E[i];
    2703         196 :     Q[i] = upowuu(p,e);
    2704         196 :     B[i] = itou( Zp_sqrt(gen_m3, utoipos(p), e) );
    2705         196 :     mB[i]= Q[i] - B[i];
    2706             :   }
    2707         189 :   ct = 1 << (l-1);
    2708         189 :   T = ZV_producttree(Q);
    2709         189 :   R = ZV_chinesetree(Q,T);
    2710         189 :   v = cgetg(ct+1, t_VECSMALL);
    2711         189 :   av = avma;
    2712         581 :   for (n = 1; n <= ct; n++)
    2713             :   {
    2714         392 :     long m = n-1, r;
    2715         812 :     for (i = 1; i < l; i++)
    2716             :     {
    2717         420 :       A[i] = (m&1L)? mB[i]: B[i];
    2718         420 :       m >>= 1;
    2719             :     }
    2720         392 :     r = itou( ZV_chinese_tree(A, Q, T, R) );
    2721         462 :     if (fl3) while (r%3) r += N;
    2722         392 :     set_avma(av); v[n] = odd(r) ? (r-1) >> 1 : (r+Ninit-1) >> 1;
    2723             :   }
    2724         189 :   return v;
    2725             : }
    2726             : 
    2727             : /* number of elliptic points of order 3 in X0(N) */
    2728             : static long
    2729       10101 : nu3(long N)
    2730             : {
    2731             :   long i, l;
    2732             :   GEN P;
    2733       10101 :   if (!odd(N) || (N%9) == 0) return 0;
    2734        8897 :   if ((N%3) == 0) N /= 3;
    2735        8897 :   P = gel(myfactoru(N), 1); l = lg(P);
    2736       13048 :   for (i = 1; i < l; i++) if ((P[i]%3) == 2) return 0;
    2737        3969 :   return 1L<<(l-1);
    2738             : }
    2739             : /* number of elliptic points of order 2 in X0(N) */
    2740             : static long
    2741       17297 : nu2(long N)
    2742             : {
    2743             :   long i, l;
    2744             :   GEN P;
    2745       17297 :   if ((N&3L) == 0) return 0;
    2746       17297 :   if (!odd(N)) N >>= 1;
    2747       17297 :   P = gel(myfactoru(N), 1); l = lg(P);
    2748       21700 :   for (i = 1; i < l; i++) if ((P[i]&3L) == 3) return 0;
    2749        3941 :   return 1L<<(l-1);
    2750             : }
    2751             : 
    2752             : /* contribution of elliptic matrices of order 3 in dimension formula
    2753             :  * Only depends on CHIP the primitive char attached to CHI */
    2754             : static GEN
    2755       43043 : A21(long N, long k, GEN CHI)
    2756             : {
    2757             :   GEN res, G, chi, o;
    2758             :   long a21, i, limx, S;
    2759       43043 :   if ((N&1L) == 0) return gen_0;
    2760       20825 :   a21 = k%3 - 1;
    2761       20825 :   if (!a21) return gen_0;
    2762       20181 :   if (N <= 3) return sstoQ(a21, 3);
    2763       10640 :   if (!CHI) return sstoQ(nu3(N) * a21, 3);
    2764         539 :   res = sqrtm3modN(N); limx = (N - 1) >> 1;
    2765         539 :   G = gel(CHI,1); chi = gel(CHI,2);
    2766         539 :   o = gmfcharorder(CHI);
    2767         931 :   for (S = 0, i = 1; i < lg(res); i++)
    2768             :   { /* (x,N) = 1; S += chi(x) + chi(x^2) */
    2769         392 :     long x = res[i];
    2770         392 :     if (x <= limx)
    2771             :     { /* CHI(x)=e(c/o), 3rd-root of 1 */
    2772         196 :       GEN c = znchareval(G, chi, utoi(x), o);
    2773         196 :       if (!signe(c)) S += 2; else S--;
    2774             :     }
    2775             :   }
    2776         539 :   return sstoQ(a21 * S, 3);
    2777             : }
    2778             : 
    2779             : /* List of all square roots of -1 modulo N */
    2780             : static GEN
    2781         595 : sqrtm1modN(long N)
    2782             : {
    2783             :   pari_sp av;
    2784             :   GEN fa, P, E, B, mB, A, Q, T, R, v;
    2785         595 :   long l, i, n, ct, fleven = 0;
    2786         595 :   if ((N&3L) == 0) return cgetg(1,t_VECSMALL);
    2787         595 :   if ((N&1L) == 0) { N >>= 1; fleven = 1; }
    2788         595 :   fa = myfactoru(N); P = gel(fa,1); E = gel(fa,2);
    2789         595 :   l = lg(P);
    2790         945 :   for (i = 1; i < l; i++)
    2791         665 :     if ((P[i]&3L) == 3) return cgetg(1,t_VECSMALL);
    2792         280 :   A = cgetg(l, t_VECSMALL);
    2793         280 :   B = cgetg(l, t_VECSMALL);
    2794         280 :   mB= cgetg(l, t_VECSMALL);
    2795         280 :   Q = cgetg(l, t_VECSMALL);
    2796         574 :   for (i = 1; i < l; i++)
    2797             :   {
    2798         294 :     long p = P[i], e = E[i];
    2799         294 :     Q[i] = upowuu(p,e);
    2800         294 :     B[i] = itou( Zp_sqrt(gen_m1, utoipos(p), e) );
    2801         294 :     mB[i]= Q[i] - B[i];
    2802             :   }
    2803         280 :   ct = 1 << (l-1);
    2804         280 :   T = ZV_producttree(Q);
    2805         280 :   R = ZV_chinesetree(Q,T);
    2806         280 :   v = cgetg(ct+1, t_VECSMALL);
    2807         280 :   av = avma;
    2808         868 :   for (n = 1; n <= ct; n++)
    2809             :   {
    2810         588 :     long m = n-1, r;
    2811        1232 :     for (i = 1; i < l; i++)
    2812             :     {
    2813         644 :       A[i] = (m&1L)? mB[i]: B[i];
    2814         644 :       m >>= 1;
    2815             :     }
    2816         588 :     r = itou( ZV_chinese_tree(A, Q, T, R) );
    2817         588 :     if (fleven && !odd(r)) r += N;
    2818         588 :     set_avma(av); v[n] = r;
    2819             :   }
    2820         280 :   return v;
    2821             : }
    2822             : 
    2823             : /* contribution of elliptic matrices of order 4 in dimension formula.
    2824             :  * Only depends on CHIP the primitive char attached to CHI */
    2825             : static GEN
    2826       43043 : A22(long N, long k, GEN CHI)
    2827             : {
    2828             :   GEN G, chi, o, res;
    2829             :   long S, a22, i, limx, o2;
    2830       43043 :   if ((N&3L) == 0) return gen_0;
    2831       29617 :   a22 = (k & 3L) - 1; /* (k % 4) - 1 */
    2832       29617 :   if (!a22) return gen_0;
    2833       29617 :   if (N <= 2) return sstoQ(a22, 4);
    2834       18102 :   if (!CHI) return sstoQ(nu2(N)*a22, 4);
    2835         805 :   if (mfcharparity(CHI) == -1) return gen_0;
    2836         595 :   res = sqrtm1modN(N); limx = (N - 1) >> 1;
    2837         595 :   G = gel(CHI,1); chi = gel(CHI,2);
    2838         595 :   o = gmfcharorder(CHI);
    2839         595 :   o2 = itou(o)>>1;
    2840        1183 :   for (S = 0, i = 1; i < lg(res); i++)
    2841             :   { /* (x,N) = 1, S += real(chi(x)) */
    2842         588 :     long x = res[i];
    2843         588 :     if (x <= limx)
    2844             :     { /* CHI(x)=e(c/o), 4th-root of 1 */
    2845         294 :       long c = itou( znchareval(G, chi, utoi(x), o) );
    2846         294 :       if (!c) S++; else if (c == o2) S--;
    2847             :     }
    2848             :   }
    2849         595 :   return sstoQ(a22 * S, 2);
    2850             : }
    2851             : 
    2852             : /* sumdiv(N,d,eulerphi(gcd(d,N/d))) */
    2853             : static long
    2854       38269 : nuinf(long N)
    2855             : {
    2856       38269 :   GEN fa = myfactoru(N), P = gel(fa,1), E = gel(fa,2);
    2857       38269 :   long i, t = 1, l = lg(P);
    2858       81361 :   for (i=1; i<l; i++)
    2859             :   {
    2860       43092 :     long p = P[i], e = E[i];
    2861       43092 :     if (odd(e))
    2862       34475 :       t *= upowuu(p,e>>1) << 1;
    2863             :     else
    2864        8617 :       t *= upowuu(p,(e>>1)-1) * (p+1);
    2865             :   }
    2866       38269 :   return t;
    2867             : }
    2868             : 
    2869             : /* contribution of hyperbolic matrices in dimension formula */
    2870             : static GEN
    2871       43491 : A3(long N, long FC)
    2872             : {
    2873             :   long i, S, NF, l;
    2874             :   GEN D;
    2875       43491 :   if (FC == 1) return uutoQ(nuinf(N),2);
    2876        5222 :   D = mydivisorsu(N); l = lg(D);
    2877        5222 :   S = 0; NF = N/FC;
    2878       41209 :   for (i = 1; i < l; i++)
    2879             :   {
    2880       35987 :     long g = ugcd(D[i], D[l-i]);
    2881       35987 :     if (NF%g == 0) S += myeulerphiu(g);
    2882             :   }
    2883        5222 :   return uutoQ(S, 2);
    2884             : }
    2885             : 
    2886             : /* special contribution in weight 2 in dimension formula */
    2887             : static long
    2888       42609 : A4(long k, long FC)
    2889       42609 : { return (k==2 && FC==1)? 1: 0; }
    2890             : /* gcd(x,N) */
    2891             : static long
    2892   282856308 : myugcd(GEN GCD, ulong x)
    2893             : {
    2894   282856308 :   ulong N = lg(GCD)-1;
    2895   282856308 :   if (x >= N) x %= N;
    2896   282856308 :   return GCD[x+1];
    2897             : }
    2898             : /* 1_{gcd(x,N) = 1} * chi(x), return NULL if 0 */
    2899             : static GEN
    2900   401925058 : mychicgcd(GEN GCD, GEN VCHI, long x)
    2901             : {
    2902   401925058 :   long N = lg(GCD)-1;
    2903   401925058 :   if (N == 1) return gen_1;
    2904   327568442 :   x = umodsu(x, N);
    2905   327568442 :   if (GCD[x+1] != 1) return NULL;
    2906   271535724 :   x %= vchip_FC(VCHI); if (!x) return gen_1;
    2907     4468548 :   return gel(gel(VCHI,1), x);
    2908             : }
    2909             : 
    2910             : /* contribution of scalar matrices to trace formula */
    2911             : static GEN
    2912     6346506 : TA1(long N, long k, GEN VCHI, GEN GCD, long n)
    2913             : {
    2914             :   GEN S;
    2915             :   ulong m;
    2916     6346506 :   if (!uissquareall(n, &m)) return gen_0;
    2917      376117 :   if (m == 1) return A1(N,k); /* common */
    2918      339906 :   S = mychicgcd(GCD, VCHI, m);
    2919      339906 :   return S? gmul(gmul(powuu(m, k-2), A1(N,k)), S): gen_0;
    2920             : }
    2921             : 
    2922             : /* All square roots modulo 4N, x modulo 2N, precomputed to accelerate TA2 */
    2923             : static GEN
    2924      120183 : mksqr(long N)
    2925             : {
    2926      120183 :   pari_sp av = avma;
    2927      120183 :   long x, N2 = N << 1, N4 = N << 2;
    2928      120183 :   GEN v = const_vec(N2, cgetg(1, t_VECSMALL));
    2929      120183 :   gel(v, N2) = mkvecsmall(0); /* x = 0 */
    2930     3412724 :   for (x = 1; x <= N; x++)
    2931             :   {
    2932     3292541 :     long r = (((x*x - 1)%N4) >> 1) + 1;
    2933     3292541 :     gel(v,r) = vecsmall_append(gel(v,r), x);
    2934             :   }
    2935      120183 :   return gerepilecopy(av, v);
    2936             : }
    2937             : 
    2938             : static GEN
    2939      120183 : mkgcd(long N)
    2940             : {
    2941             :   GEN GCD, d;
    2942             :   long i, N2;
    2943      120183 :   if (N == 1) return mkvecsmall(N);
    2944       99232 :   GCD = cgetg(N + 1, t_VECSMALL);
    2945       99232 :   d = GCD+1; /* GCD[i+1] = d[i] = gcd(i,N) = gcd(N-i,N), i = 0..N-1 */
    2946       99232 :   d[0] = N; d[1] = d[N-1] = 1; N2 = N>>1;
    2947     1616146 :   for (i = 2; i <= N2; i++) d[i] = d[N-i] = ugcd(N, i);
    2948       99232 :   return GCD;
    2949             : }
    2950             : 
    2951             : /* Table of \sum_{x^2-tx+n=0 mod Ng}chi(x) for all g dividing gcd(N,F),
    2952             :  * F^2 largest such that (t^2-4n)/F^2=0 or 1 mod 4; t >= 0 */
    2953             : static GEN
    2954    15168332 : mutglistall(long t, long N, long NF, GEN VCHI, long n, GEN MUP, GEN li, GEN GCD)
    2955             : {
    2956    15168332 :   long i, lx = lg(li);
    2957    15168332 :   GEN DNF = mydivisorsu(NF), v = zerovec(NF);
    2958    15168332 :   long j, g, lDNF = lg(DNF);
    2959    42336102 :   for (i = 1; i < lx; i++)
    2960             :   {
    2961    27167770 :     long x = (li[i] + t) >> 1, y, lD;
    2962    27167770 :     GEN D, c = mychicgcd(GCD, VCHI, x);
    2963    27167770 :     if (li[i] && li[i] != N)
    2964             :     {
    2965    18064080 :       GEN c2 = mychicgcd(GCD, VCHI, t - x);
    2966    18064080 :       if (c2) c = c? gadd(c, c2): c2;
    2967             :     }
    2968    27167770 :     if (!c) continue;
    2969    22035685 :     y = (x*(x - t) + n) / N; /* exact division */
    2970    22035685 :     D = mydivisorsu(ugcd(labs(y), NF)); lD = lg(D);
    2971    59375885 :     for (j=1; j < lD; j++) { g = D[j]; gel(v,g) = gadd(gel(v,g), c); }
    2972             :   }
    2973             :   /* j = 1 corresponds to g = 1, and MUP[1] = 1 */
    2974    35048060 :   for (j=2; j < lDNF; j++) { g = DNF[j]; gel(v,g) = gmulsg(MUP[g], gel(v,g)); }
    2975    15168332 :   return v;
    2976             : }
    2977             : 
    2978             : /* special case (N,F) = 1: easier */
    2979             : static GEN
    2980   161105370 : mutg1(long t, long N, GEN VCHI, GEN li, GEN GCD)
    2981             : { /* (N,F) = 1 */
    2982   161105370 :   GEN S = NULL;
    2983   161105370 :   long i, lx = lg(li);
    2984   338082946 :   for (i = 1; i < lx; i++)
    2985             :   {
    2986   176977576 :     long x = (li[i] + t) >> 1;
    2987   176977576 :     GEN c = mychicgcd(GCD, VCHI, x);
    2988   176977576 :     if (c) S = S? gadd(S, c): c;
    2989   176977576 :     if (li[i] && li[i] != N)
    2990             :     {
    2991    97904849 :       c = mychicgcd(GCD, VCHI, t - x);
    2992    97904849 :       if (c) S = S? gadd(S, c): c;
    2993             :     }
    2994   176977576 :     if (S && !signe(S)) S = NULL; /* strive hard to add gen_0 */
    2995             :   }
    2996   161105370 :   return S; /* single value */
    2997             : }
    2998             : 
    2999             : /* Gegenbauer pol; n > 2, P = \sum_{0<=j<=n/2} (-1)^j (n-j)!/j!(n-2*j)! X^j */
    3000             : GEN
    3001      360603 : mfrhopol(long n)
    3002             : {
    3003             : #ifdef LONG_IS_64BIT
    3004      309132 :   const long M = 2642249;
    3005             : #else
    3006       51471 :   const long M = 1629;
    3007             : #endif
    3008      360603 :   long j, d = n >> 1; /* >= 1 */
    3009      360603 :   GEN P = cgetg(d + 3, t_POL);
    3010             : 
    3011      360603 :   if (n > M) pari_err_IMPL("mfrhopol for large weight"); /* avoid overflow */
    3012      360603 :   P[1] = evalvarn(0)|evalsigne(1);
    3013      360603 :   gel(P,2) = gen_1;
    3014      360603 :   gel(P,3) = utoineg(n-1); /* j = 1 */
    3015      360603 :   if (d > 1) gel(P,4) = utoipos(((n-3)*(n-2)) >> 1); /* j = 2 */
    3016      360603 :   if (d > 2) gel(P,5) = utoineg(((n-5)*(n-4)*(n-3)) / 6); /* j = 3 */
    3017     1515452 :   for (j = 4; j <= d; j++)
    3018     1154849 :     gel(P,j+2) = divis(mulis(gel(P,j+1), (n-2*j+1)*(n-2*j+2)), (n-j+1)*(-j));
    3019      360603 :   return P;
    3020             : }
    3021             : 
    3022             : /* polrecip(Q)(t2), assume Q(0) = 1 */
    3023             : GEN
    3024     3248424 : mfrhopol_u_eval(GEN Q, ulong t2)
    3025             : {
    3026     3248424 :   GEN T = addiu(gel(Q,3), t2);
    3027     3248427 :   long l = lg(Q), j;
    3028    37882090 :   for (j = 4; j < l; j++) T = addii(gel(Q,j), mului(t2, T));
    3029     3248422 :   return T;
    3030             : }
    3031             : GEN
    3032       56611 : mfrhopol_eval(GEN Q, GEN t2)
    3033             : {
    3034             :   long l, j;
    3035             :   GEN T;
    3036       56611 :   if (lgefint(t2) == 3) return mfrhopol_u_eval(Q, t2[2]);
    3037           0 :   l = lg(Q); T = addii(gel(Q,3), t2);
    3038           0 :   for (j = 4; j < l; j++) T = addii(gel(Q,j), mulii(t2, T));
    3039           0 :   return T;
    3040             : }
    3041             : /* return sh * sqrt(n)^nu * G_nu(t/(2*sqrt(n))) for t != 0
    3042             :  * else (sh/2) * sqrt(n)^nu * G_nu(0) [ implies nu is even ]
    3043             :  * G_nu(z) = \sum_{0<=j<=nu/2} (-1)^j (nu-j)!/j!(nu-2*j)! * (2z)^(nu-2*j)) */
    3044             : static GEN
    3045   167881458 : mfrhopowsimp(GEN Q, GEN sh, long nu, long t, long t2, long n)
    3046             : {
    3047             :   GEN T;
    3048   167881458 :   switch (nu)
    3049             :   {
    3050   161999103 :     case 0: return t? sh: gmul2n(sh,-1);
    3051     1125222 :     case 1: return gmulsg(t, sh);
    3052     1519427 :     case 2: return t? gmulsg(t2 - n, sh): gmul(gmul2n(stoi(-n), -1), sh);
    3053         427 :     case 3: return gmul(mulss(t, t2 - 2*n), sh);
    3054     3237279 :     default:
    3055     3237279 :       if (!t) return gmul(gmul2n(gel(Q, lg(Q) - 1), -1), sh);
    3056     3191809 :       T = mfrhopol_u_eval(Q, t2); if (odd(nu)) T = mulsi(t, T);
    3057     3191809 :       return gmul(T, sh);
    3058             :   }
    3059             : }
    3060             : 
    3061             : /* contribution of elliptic matrices to trace formula */
    3062             : static GEN
    3063     6346506 : TA2(long N, long k, GEN VCHI, long n, GEN SQRTS, GEN MUP, GEN GCD)
    3064             : {
    3065     6346506 :   const long n4 = n << 2, N4 = N << 2, nu = k - 2;
    3066     6346506 :   const long st = (!odd(N) && odd(n)) ? 2 : 1;
    3067             :   long limt, t;
    3068             :   GEN S, Q;
    3069             : 
    3070     6346506 :   limt = usqrt(n4);
    3071     6346506 :   if (limt*limt == n4) limt--;
    3072     6346506 :   Q = nu > 3 ? ZX_z_unscale(mfrhopol(nu), n) : NULL;
    3073     6346506 :   S = gen_0;
    3074   325461462 :   for (t = odd(k)? st: 0; t <= limt; t += st) /* t^2 < 4n */
    3075             :   {
    3076   319114956 :     pari_sp av = avma;
    3077   319114956 :     long t2 = t*t, D = n4 - t2, F, D0, NF;
    3078             :     GEN sh, li;
    3079             : 
    3080   319114956 :     li = gel(SQRTS, (umodsu(-D - 1, N4) >> 1) + 1);
    3081   327507200 :     if (lg(li) == 1) continue;
    3082   176273702 :     D0 = mycoredisc2neg(D, &F);
    3083   176273702 :     NF = myugcd(GCD, F);
    3084   176273702 :     if (NF == 1)
    3085             :     { /* (N,F) = 1 => single value in mutglistall */
    3086   161105370 :       GEN mut = mutg1(t, N, VCHI, li, GCD);
    3087   161105370 :       if (!mut) { set_avma(av); continue; }
    3088   156310125 :       sh = gmul(uutoQ(hclassno6u_i(D,D0,F),6), mut);
    3089             :     }
    3090             :     else
    3091             :     {
    3092    15168332 :       GEN v = mutglistall(t, N, NF, VCHI, n, MUP, li, GCD);
    3093    15168332 :       GEN DF = mydivisorsu(F);
    3094    15168332 :       long i, lDF = lg(DF);
    3095    15168332 :       sh = gen_0;
    3096    61172560 :       for (i = 1; i < lDF; i++)
    3097             :       {
    3098    46004228 :         long Ff, f = DF[i], g = myugcd(GCD, f);
    3099    46004228 :         GEN mut = gel(v, g);
    3100    46004228 :         if (gequal0(mut)) continue;
    3101    31110100 :         Ff = DF[lDF-i]; /* F/f */
    3102    31110100 :         if (Ff == 1) sh = gadd(sh, mut);
    3103             :         else
    3104             :         {
    3105    22300784 :           GEN P = gel(myfactoru(Ff), 1);
    3106    22300784 :           long j, lP = lg(P);
    3107    49187570 :           for (j = 1; j < lP; j++) { long p = P[j]; Ff -= kross(D0, p)*Ff/p; }
    3108    22300784 :           sh = gadd(sh, gmulsg(Ff, mut));
    3109             :         }
    3110             :       }
    3111    15168332 :       if (gequal0(sh)) { set_avma(av); continue; }
    3112    11571333 :       if (D0 == -3) sh = gdivgu(sh, 3);
    3113    11085851 :       else if (D0 == -4) sh = gdivgu(sh, 2);
    3114    10619294 :       else sh = gmulgu(sh, myh(D0));
    3115             :     }
    3116   167881458 :     S = gerepileupto(av, gadd(S, mfrhopowsimp(Q,sh,nu,t,t2,n)));
    3117             :   }
    3118     6346506 :   return S;
    3119             : }
    3120             : 
    3121             : /* compute global auxiliary data for TA3 */
    3122             : static GEN
    3123      120183 : mkbez(long N, long FC)
    3124             : {
    3125      120183 :   long ct, i, NF = N/FC;
    3126      120183 :   GEN w, D = mydivisorsu(N);
    3127      120183 :   long l = lg(D);
    3128             : 
    3129      120183 :   w = cgetg(l, t_VEC);
    3130      349902 :   for (i = ct = 1; i < l; i++)
    3131             :   {
    3132      328951 :     long u, v, h, c = D[i], Nc = D[l-i];
    3133      328951 :     if (c > Nc) break;
    3134      229719 :     h = cbezout(c, Nc, &u, &v);
    3135      229719 :     if (h == 1) /* shortcut */
    3136      165410 :       gel(w, ct++) = mkvecsmall4(1,u*c,1,i);
    3137       64309 :     else if (!(NF%h))
    3138       54439 :       gel(w, ct++) = mkvecsmall4(h,u*(c/h),myeulerphiu(h),i);
    3139             :   }
    3140      120183 :   setlg(w,ct); stackdummy((pari_sp)(w+ct),(pari_sp)(w+l));
    3141      120183 :   return w;
    3142             : }
    3143             : 
    3144             : /* contribution of hyperbolic matrices to trace formula, d * nd = n,
    3145             :  * DN = divisorsu(N) */
    3146             : static GEN
    3147    33101424 : auxsum(GEN VCHI, GEN GCD, long d, long nd, GEN DN, GEN BEZ)
    3148             : {
    3149    33101424 :   GEN S = gen_0;
    3150    33101424 :   long ct, g = nd - d, lDN = lg(DN), lBEZ = lg(BEZ);
    3151    85010205 :   for (ct = 1; ct < lBEZ; ct++)
    3152             :   {
    3153    51908781 :     GEN y, B = gel(BEZ, ct);
    3154    51908781 :     long ic, c, Nc, uch, h = B[1];
    3155    51908781 :     if (g%h) continue;
    3156    50704319 :     uch = B[2];
    3157    50704319 :     ic  = B[4];
    3158    50704319 :     c = DN[ic];
    3159    50704319 :     Nc= DN[lDN - ic]; /* Nc = N/c */
    3160    50704319 :     if (ugcd(Nc, nd) == 1)
    3161    43286041 :       y = mychicgcd(GCD, VCHI, d + uch*g); /* 0 if (c,d) > 1 */
    3162             :     else
    3163     7418278 :       y = NULL;
    3164    50704319 :     if (c != Nc && ugcd(Nc, d) == 1)
    3165             :     {
    3166    38184836 :       GEN y2 = mychicgcd(GCD, VCHI, nd - uch*g); /* 0 if (c,nd) > 1 */
    3167    38184836 :       if (y2) y = y? gadd(y, y2): y2;
    3168             :     }
    3169    50704319 :     if (y) S = gadd(S, gmulsg(B[3], y));
    3170             :   }
    3171    33101424 :   return S;
    3172             : }
    3173             : 
    3174             : static GEN
    3175     6346506 : TA3(long N, long k, GEN VCHI, GEN GCD, GEN Dn, GEN BEZ)
    3176             : {
    3177     6346506 :   GEN S = gen_0, DN = mydivisorsu(N);
    3178     6346506 :   long i, l = lg(Dn);
    3179    39447930 :   for (i = 1; i < l; i++)
    3180             :   {
    3181    39411719 :     long d = Dn[i], nd = Dn[l-i]; /* = n/d */
    3182             :     GEN t, u;
    3183    39411719 :     if (d > nd) break;
    3184    33101424 :     t = auxsum(VCHI, GCD, d, nd, DN, BEZ);
    3185    33101424 :     if (isintzero(t)) continue;
    3186    31987577 :     u = powuu(d,k-1); if (d == nd) u = gmul2n(u,-1);
    3187    31987577 :     S = gadd(S, gmul(u,t));
    3188             :   }
    3189     6346506 :   return S;
    3190             : }
    3191             : 
    3192             : /* special contribution in weight 2 in trace formula */
    3193             : static long
    3194     6346506 : TA4(long k, GEN VCHIP, GEN Dn, GEN GCD)
    3195             : {
    3196             :   long i, l, S;
    3197     6346506 :   if (k != 2 || vchip_FC(VCHIP) != 1) return 0;
    3198     5662951 :   l = lg(Dn); S = 0;
    3199    66241329 :   for (i = 1; i < l; i++)
    3200             :   {
    3201    60578378 :     long d = Dn[i]; /* gcd(N,n/d) == 1? */
    3202    60578378 :     if (myugcd(GCD, Dn[l-i]) == 1) S += d;
    3203             :   }
    3204     5662951 :   return S;
    3205             : }
    3206             : 
    3207             : /* precomputation of products occurring im mutg, again to accelerate TA2 */
    3208             : static GEN
    3209      120183 : mkmup(long N)
    3210             : {
    3211      120183 :   GEN fa = myfactoru(N), P = gel(fa,1), D = divisorsu_fact(fa);
    3212      120183 :   long i, lP = lg(P), lD = lg(D);
    3213      120183 :   GEN MUP = zero_zv(N);
    3214      120183 :   MUP[1] = 1;
    3215      424445 :   for (i = 2; i < lD; i++)
    3216             :   {
    3217      304262 :     long j, g = D[i], Ng = D[lD-i]; /*  N/g */
    3218      834575 :     for (j = 1; j < lP; j++) { long p = P[j]; if (Ng%p) g += g/p; }
    3219      304262 :     MUP[D[i]] = g;
    3220             :   }
    3221      120183 :   return MUP;
    3222             : }
    3223             : 
    3224             : /* quadratic nonresidues mod p; p odd prime, p^2 fits in a long */
    3225             : static GEN
    3226        2702 : non_residues(long p)
    3227             : {
    3228        2702 :   long i, j, p2 = p >> 1;
    3229        2702 :   GEN v = cgetg(p2+1, t_VECSMALL), w = const_vecsmall(p-1, 1);
    3230        4459 :   for (i = 2; i <= p2; i++) w[(i*i) % p] = 0; /* no need to check 1 */
    3231        8918 :   for (i = 2, j = 1; i < p; i++) if (w[i]) v[j++] = i;
    3232        2702 :   return v;
    3233             : }
    3234             : 
    3235             : /* CHIP primitive. Return t_VECSMALL v of length q such that
    3236             :  * Tr^new_{N,CHIP}(n) = 0 whenever v[(n%q) + 1] is nonzero */
    3237             : static GEN
    3238       31024 : mfnewzerodata(long N, GEN CHIP)
    3239             : {
    3240       31024 :   GEN V, M, L, faN = myfactoru(N), PN = gel(faN,1), EN = gel(faN,2);
    3241       31024 :   GEN G = gel(CHIP,1), chi = gel(CHIP,2);
    3242       31024 :   GEN fa = znstar_get_faN(G), P = ZV_to_zv(gel(fa,1)), E = gel(fa,2);
    3243       31024 :   long i, mod, j = 1, l = lg(PN);
    3244             : 
    3245       31024 :   M = cgetg(l, t_VECSMALL); M[1] = 0;
    3246       31024 :   V = cgetg(l, t_VEC);
    3247             :   /* Tr^new(n) = 0 if (n mod M[i]) in V[i]  */
    3248       31024 :   if ((N & 3) == 0)
    3249             :   {
    3250       12467 :     long e = EN[1];
    3251       12467 :     long c = (lg(P) > 1 && P[1] == 2)? E[1]: 0; /* c = v_2(FC) */
    3252             :     /* e >= 2 */
    3253       12467 :     if (c == e-1) return NULL; /* Tr^new = 0 */
    3254       12362 :     if (c == e)
    3255             :     {
    3256        3696 :       if (e == 2)
    3257             :       { /* sc: -4 */
    3258        1764 :         gel(V,1) = mkvecsmall(3);
    3259        1764 :         M[1] = 4;
    3260             :       }
    3261        1932 :       else if (e == 3)
    3262             :       { /* sc: -8 (CHI_2(-1)=-1<=>chi[1]=1) and 8 (CHI_2(-1)=1 <=> chi[1]=0) */
    3263        1932 :         long t = signe(gel(chi,1))? 7: 3;
    3264        1932 :         gel(V,1) = mkvecsmall2(5, t);
    3265        1932 :         M[1] = 8;
    3266             :       }
    3267             :     }
    3268        8666 :     else if (e == 5 && c == 3)
    3269         154 :     { /* sc: -8 (CHI_2(-1)=-1<=>chi[1]=1) and 8 (CHI_2(-1)=1 <=> chi[1]=0) */
    3270         154 :       long t = signe(gel(chi,1))? 7: 3;
    3271         154 :       gel(V,1) = mkvecsmalln(6, 2L,4L,5L,6L,8L,t);
    3272         154 :       M[1] = 8;
    3273             :     }
    3274        8512 :     else if ((e == 4 && c == 2) || (e == 5 && c <= 2) || (e == 6 && c <= 2)
    3275        6937 :          || (e >= 7 && c == e - 3))
    3276             :     { /* sc: 4 */
    3277        1575 :       gel(V,1) = mkvecsmall3(0,2,3);
    3278        1575 :       M[1] = 4;
    3279             :     }
    3280        6937 :     else if ((e <= 4 && c == 0) || (e >= 5 && c == e - 2))
    3281             :     { /* sc: 2 */
    3282        6580 :       gel(V,1) = mkvecsmall(0);
    3283        6580 :       M[1] = 2;
    3284             :     }
    3285         357 :     else if ((e == 6 && c == 3) || (e >= 7 && c <= e - 4))
    3286             :     { /* sc: -2 */
    3287         357 :       gel(V,1) = mkvecsmalln(7, 0L,2L,3L,4L,5L,6L,7L);
    3288         357 :       M[1] = 8;
    3289             :     }
    3290             :   }
    3291       30919 :   j = M[1]? 2: 1;
    3292       66276 :   for (i = odd(N)? 1: 2; i < l; i++) /* skip p=2, done above */
    3293             :   {
    3294       35357 :     long p = PN[i], e = EN[i];
    3295       35357 :     long z = zv_search(P, p), c = z? E[z]: 0; /* c = v_p(FC) */
    3296       35357 :     if ((e <= 2 && c == 1 && itos(gel(chi,z)) == (p>>1)) /* ord(CHI_p)=2 */
    3297       33166 :         || (e >= 3 && c <= e - 2))
    3298        2702 :     { /* sc: -p */
    3299        2702 :       GEN v = non_residues(p);
    3300        2702 :       if (e != 1) v = vecsmall_prepend(v, 0);
    3301        2702 :       gel(V,j) = v;
    3302        2702 :       M[j] = p; j++;
    3303             :     }
    3304       32655 :     else if (e >= 2 && c < e)
    3305             :     { /* sc: p */
    3306        2233 :       gel(V,j) = mkvecsmall(0);
    3307        2233 :       M[j] = p; j++;
    3308             :     }
    3309             :   }
    3310       30919 :   if (j == 1) return cgetg(1, t_VECSMALL);
    3311       14539 :   setlg(V,j); setlg(M,j); mod = zv_prod(M);
    3312       14539 :   L = zero_zv(mod);
    3313       31836 :   for (i = 1; i < j; i++)
    3314             :   {
    3315       17297 :     GEN v = gel(V,i);
    3316       17297 :     long s, m = M[i], lv = lg(v);
    3317       45507 :     for (s = 1; s < lv; s++)
    3318             :     {
    3319       28210 :       long a = v[s] + 1;
    3320       54796 :       do { L[a] = 1; a += m; } while (a <= mod);
    3321             :     }
    3322             :   }
    3323       14539 :   return L;
    3324             : }
    3325             : /* v=mfnewzerodata(N,CHI); returns TRUE if newtrace(n) must be zero,
    3326             :  * (but newtrace(n) may still be zero if we return FALSE) */
    3327             : static long
    3328     2580436 : mfnewchkzero(GEN v, long n) { long q = lg(v)-1; return q && v[(n%q) + 1]; }
    3329             : 
    3330             : /* if (!VCHIP): from mftraceform_cusp;
    3331             :  * else from initnewtrace and CHI is known to be primitive */
    3332             : static GEN
    3333      120183 : inittrace(long N, GEN CHI, GEN VCHIP)
    3334             : {
    3335             :   long FC;
    3336      120183 :   if (VCHIP)
    3337      120176 :     FC = mfcharmodulus(CHI);
    3338             :   else
    3339           7 :     VCHIP = mfcharinit(mfchartoprimitive(CHI, &FC));
    3340      120183 :   return mkvecn(5, mksqr(N), mkmup(N), mkgcd(N), VCHIP, mkbez(N, FC));
    3341             : }
    3342             : 
    3343             : /* p > 2 prime; return a sorted t_VECSMALL of primes s.t Tr^new(p) = 0 for all
    3344             :  * weights > 2 */
    3345             : static GEN
    3346       30919 : inittrconj(long N, long FC)
    3347             : {
    3348             :   GEN fa, P, E, v;
    3349             :   long i, k, l;
    3350             : 
    3351       30919 :   if (FC != 1) return cgetg(1,t_VECSMALL);
    3352             : 
    3353       25459 :   fa = myfactoru(N >> vals(N));
    3354       25459 :   P = gel(fa,1); l = lg(P);
    3355       25459 :   E = gel(fa,2);
    3356       25459 :   v = cgetg(l, t_VECSMALL);
    3357       55874 :   for (i = k = 1; i < l; i++)
    3358             :   {
    3359       30415 :     long j, p = P[i]; /* > 2 */
    3360       74186 :     for (j = 1; j < l; j++)
    3361       43771 :       if (j != i && E[j] == 1 && kross(-p, P[j]) == 1) v[k++] = p;
    3362             :   }
    3363       25459 :   setlg(v,k); return v;
    3364             : }
    3365             : 
    3366             : /* assume CHIP primitive, f(CHIP) | N; NZ = mfnewzerodata(N,CHIP) */
    3367             : static GEN
    3368       30919 : initnewtrace_i(long N, GEN CHIP, GEN NZ)
    3369             : {
    3370       30919 :   GEN T = const_vec(N, cgetg(1,t_VEC)), D, VCHIP;
    3371       30919 :   long FC = mfcharmodulus(CHIP), N1, N2, i, l;
    3372             : 
    3373       30919 :   if (!NZ) NZ = mkvecsmall(1); /*Tr^new = 0; initialize data nevertheless*/
    3374       30919 :   VCHIP = mfcharinit(CHIP);
    3375       30919 :   N1 = N/FC; newd_params(N1, &N2);
    3376       30919 :   D = mydivisorsu(N1/N2); l = lg(D);
    3377       30919 :   N2 *= FC;
    3378      151095 :   for (i = 1; i < l; i++)
    3379             :   {
    3380      120176 :     long M = D[i]*N2;
    3381      120176 :     gel(T,M) = inittrace(M, CHIP, VCHIP);
    3382             :   }
    3383       30919 :   gel(T,N) = shallowconcat(gel(T,N), mkvec2(NZ, inittrconj(N,FC)));
    3384       30919 :   return T;
    3385             : }
    3386             : /* don't initialize if Tr^new = 0, return NULL */
    3387             : static GEN
    3388       31024 : initnewtrace(long N, GEN CHI)
    3389             : {
    3390       31024 :   GEN CHIP = mfchartoprimitive(CHI, NULL), NZ = mfnewzerodata(N,CHIP);
    3391       31024 :   return NZ? initnewtrace_i(N, CHIP, NZ): NULL;
    3392             : }
    3393             : 
    3394             : /* (-1)^k */
    3395             : static long
    3396        8092 : m1pk(long k) { return odd(k)? -1 : 1; }
    3397             : static long
    3398        7735 : badchar(long N, long k, GEN CHI)
    3399        7735 : { return mfcharparity(CHI) != m1pk(k) || (CHI && N % mfcharconductor(CHI)); }
    3400             : 
    3401             : 
    3402             : static long
    3403       42686 : mfcuspdim_i(long N, long k, GEN CHI, GEN vSP)
    3404             : {
    3405       42686 :   pari_sp av = avma;
    3406             :   long FC;
    3407             :   GEN s;
    3408       42686 :   if (k <= 0) return 0;
    3409       42686 :   if (k == 1) return CHI? mf1cuspdim(N, CHI, vSP): 0;
    3410       42427 :   FC = CHI? mfcharconductor(CHI): 1;
    3411       42427 :   if (FC == 1) CHI = NULL;
    3412       42427 :   s = gsub(A1(N, k), gadd(A21(N, k, CHI), A22(N, k, CHI)));
    3413       42427 :   s = gadd(s, gsubsg(A4(k, FC), A3(N, FC)));
    3414       42427 :   return gc_long(av, itos(s));
    3415             : }
    3416             : /* dimension of space of cusp forms S_k(\G_0(N),CHI)
    3417             :  * Only depends on CHIP the primitive char attached to CHI */
    3418             : long
    3419        3339 : mfcuspdim(long N, long k, GEN CHI) { return mfcuspdim_i(N, k, CHI, NULL); }
    3420             : 
    3421             : /* dimension of whole space M_k(\G_0(N),CHI)
    3422             :  * Only depends on CHIP the primitive char attached to CHI; assumes !badchar */
    3423             : long
    3424         833 : mffulldim(long N, long k, GEN CHI)
    3425             : {
    3426         833 :   pari_sp av = avma;
    3427         833 :   long FC = CHI? mfcharconductor(CHI): 1;
    3428             :   GEN s;
    3429         833 :   if (k <= 0) return (k == 0 && FC == 1)? 1: 0;
    3430         833 :   if (k == 1) return gc_long(av, itos(A3(N, FC)) + mf1cuspdim(N, CHI, NULL));
    3431         616 :   if (FC == 1) CHI = NULL;
    3432         616 :   s = gsub(A1(N, k), gadd(A21(N, k, CHI), A22(N, k, CHI)));
    3433         616 :   s = gadd(s, A3(N, FC));
    3434         616 :   return gc_long(av, itos(s));
    3435             : }
    3436             : 
    3437             : /* Dimension of the space of Eisenstein series */
    3438             : long
    3439         231 : mfeisensteindim(long N, long k, GEN CHI)
    3440             : {
    3441         231 :   pari_sp av = avma;
    3442         231 :   long s, FC = CHI? mfcharconductor(CHI): 1;
    3443         231 :   if (k <= 0) return (k == 0 && FC == 1)? 1: 0;
    3444         231 :   s = itos(gmul2n(A3(N, FC), 1));
    3445         231 :   if (k > 1) s -= A4(k, FC); else s >>= 1;
    3446         231 :   return gc_long(av,s);
    3447             : }
    3448             : 
    3449             : enum { _SQRTS = 1, _MUP, _GCD, _VCHIP, _BEZ, _NEWLZ, _TRCONJ };
    3450             : /* Trace of T(n) on space of cuspforms; only depends on CHIP the primitive char
    3451             :  * attached to CHI */
    3452             : static GEN
    3453     6346506 : mfcusptrace_i(long N, long k, long n, GEN Dn, GEN S)
    3454             : {
    3455     6346506 :   pari_sp av = avma;
    3456             :   GEN a, b, VCHIP, GCD;
    3457             :   long t;
    3458     6346506 :   if (!n) return gen_0;
    3459     6346506 :   VCHIP = gel(S,_VCHIP);
    3460     6346506 :   GCD = gel(S,_GCD);
    3461     6346506 :   t = TA4(k, VCHIP, Dn, GCD);
    3462     6346506 :   a = TA1(N, k, VCHIP, GCD, n); if (t) a = gaddgs(a,t);
    3463     6346506 :   b = TA2(N, k, VCHIP, n, gel(S,_SQRTS), gel(S,_MUP), GCD);
    3464     6346506 :   b = gadd(b, TA3(N, k, VCHIP, GCD, Dn, gel(S,_BEZ)));
    3465     6346506 :   b = gsub(a,b);
    3466     6346506 :   if (typ(b) != t_POL) return gerepileupto(av, b);
    3467       38675 :   return gerepilecopy(av, vchip_polmod(VCHIP, b));
    3468             : }
    3469             : 
    3470             : static GEN
    3471     7600969 : mfcusptracecache(long N, long k, long n, GEN Dn, GEN S, cachenew_t *cache)
    3472             : {
    3473     7600969 :   GEN C = NULL, T = gel(cache->vfull,N);
    3474     7600969 :   long lcache = lg(T);
    3475     7600969 :   if (n < lcache) C = gel(T, n);
    3476     7600969 :   if (C) cache->cuspHIT++; else C = mfcusptrace_i(N, k, n, Dn, S);
    3477     7600969 :   cache->cuspTOTAL++;
    3478     7600969 :   if (n < lcache) gel(T,n) = C;
    3479     7600969 :   return C;
    3480             : }
    3481             : 
    3482             : /* return the divisors of n, known to be among the elements of D */
    3483             : static GEN
    3484      318955 : div_restrict(GEN D, ulong n)
    3485             : {
    3486             :   long i, j, l;
    3487      318955 :   GEN v, VDIV = caches[cache_DIV].cache;
    3488      318955 :   if (lg(VDIV) > n) return gel(VDIV,n);
    3489           0 :   l = lg(D);
    3490           0 :   v = cgetg(l, t_VECSMALL);
    3491           0 :   for (i = j = 1; i < l; i++)
    3492             :   {
    3493           0 :     ulong d = D[i];
    3494           0 :     if (n % d == 0) v[j++] = d;
    3495             :   }
    3496           0 :   setlg(v,j); return v;
    3497             : }
    3498             : 
    3499             : /* for some prime divisors of N, Tr^new(p) = 0 */
    3500             : static int
    3501      199322 : trconj(GEN T, long N, long n)
    3502      199322 : { return (lg(T) > 1 && N % n == 0 && zv_search(T, n)); }
    3503             : 
    3504             : /* n > 0; trace formula on new space */
    3505             : static GEN
    3506     2580436 : mfnewtrace_i(long N, long k, long n, cachenew_t *cache)
    3507             : {
    3508     2580436 :   GEN VCHIP, s, Dn, DN1, SN, S = cache->DATA;
    3509             :   long FC, N1, N2, N1N2, g, i, j, lDN1;
    3510             : 
    3511     2580436 :   if (!S) return gen_0;
    3512     2580436 :   SN = gel(S,N);
    3513     2580436 :   if (mfnewchkzero(gel(SN,_NEWLZ), n)) return gen_0;
    3514     1861843 :   if (k > 2 && trconj(gel(SN,_TRCONJ), N, n)) return gen_0;
    3515     1861815 :   VCHIP = gel(SN, _VCHIP); FC = vchip_FC(VCHIP);
    3516     1861815 :   N1 = N/FC; newt_params(N1, n, FC, &g, &N2);
    3517     1861815 :   N1N2 = N1/N2;
    3518     1861815 :   DN1 = mydivisorsu(N1N2); lDN1 = lg(DN1);
    3519     1861815 :   N2 *= FC;
    3520     1861815 :   Dn = mydivisorsu(n); /* this one is probably out of cache */
    3521     1861815 :   s = gmulsg(mubeta2(N1N2,n), mfcusptracecache(N2, k, n, Dn, gel(S,N2), cache));
    3522     7282014 :   for (i = 2; i < lDN1; i++)
    3523             :   { /* skip M1 = 1, done above */
    3524     5420199 :     long M1 = DN1[i], N1M1 = DN1[lDN1-i];
    3525     5420199 :     GEN Dg = mydivisorsu(ugcd(M1, g));
    3526     5420199 :     M1 *= N2;
    3527     5420199 :     s = gadd(s, gmulsg(mubeta2(N1M1,n),
    3528     5420199 :                        mfcusptracecache(M1, k, n, Dn, gel(S,M1), cache)));
    3529     5739154 :     for (j = 2; j < lg(Dg); j++) /* skip d = 1, done above */
    3530             :     {
    3531      318955 :       long d = Dg[j], ndd = n/(d*d), M = M1/d;
    3532      318955 :       GEN z = mulsi(mubeta2(N1M1,ndd), powuu(d,k-1)), C = vchip_lift(VCHIP,d,z);
    3533      318955 :       GEN Dndd = div_restrict(Dn, ndd);
    3534      318955 :       s = gadd(s, gmul(C, mfcusptracecache(M, k, ndd, Dndd, gel(S,M), cache)));
    3535             :     }
    3536     5420199 :     s = vchip_mod(VCHIP, s);
    3537             :   }
    3538     1861815 :   return vchip_polmod(VCHIP, s);
    3539             : }
    3540             : 
    3541             : static GEN
    3542       12355 : get_DIH(long N)
    3543             : {
    3544       12355 :   GEN x = cache_get(cache_DIH, N);
    3545       12355 :   return x? gcopy(x): mfdihedral(N);
    3546             : }
    3547             : static GEN
    3548        2373 : get_vDIH(long N, GEN D)
    3549             : {
    3550        2373 :   GEN x = const_vec(N, NULL);
    3551             :   long i, l;
    3552        2373 :   if (!D) D = mydivisorsu(N);
    3553        2373 :   l = lg(D);
    3554       14504 :   for (i = 1; i < l; i++) { long d = D[i]; gel(x, d) = get_DIH(d); }
    3555        2373 :   return x;
    3556             : }
    3557             : 
    3558             : /* divisors of N which are multiple of F */
    3559             : static GEN
    3560         322 : divisorsNF(long N, long F)
    3561             : {
    3562         322 :   GEN D = mydivisorsu(N / F);
    3563         322 :   long l = lg(D), i;
    3564         833 :   for (i = 1; i < l; i++) D[i] = N / D[i];
    3565         322 :   return D;
    3566             : }
    3567             : /* mfcuspdim(N,k,CHI) - mfnewdim(N,k,CHI); CHIP primitive (for efficiency) */
    3568             : static long
    3569        8239 : mfolddim_i(long N, long k, GEN CHIP, GEN vSP)
    3570             : {
    3571        8239 :   long S, i, l, F = mfcharmodulus(CHIP), N1 = N / F, N2;
    3572             :   GEN D;
    3573        8239 :   newd_params(N1, &N2); /* will ensure mubeta != 0 */
    3574        8239 :   D = mydivisorsu(N1/N2); l = lg(D); S = 0;
    3575        8239 :   if (k == 1 && !vSP) vSP = get_vDIH(N, divisorsNF(N, F));
    3576       32011 :   for (i = 2; i < l; i++)
    3577             :   {
    3578       23772 :     long d = mfcuspdim_i(N / D[i], k, CHIP, vSP);
    3579       23772 :     if (d) S -= mubeta(D[i]) * d;
    3580             :   }
    3581        8239 :   return S;
    3582             : }
    3583             : long
    3584         224 : mfolddim(long N, long k, GEN CHI)
    3585             : {
    3586         224 :   pari_sp av = avma;
    3587         224 :   GEN CHIP = mfchartoprimitive(CHI, NULL);
    3588         224 :   return gc_long(av, mfolddim_i(N, k, CHIP, NULL));
    3589             : }
    3590             : /* Only depends on CHIP the primitive char attached to CHI; assumes !badchar */
    3591             : long
    3592       15575 : mfnewdim(long N, long k, GEN CHI)
    3593             : {
    3594             :   pari_sp av;
    3595             :   long S, F;
    3596       15575 :   GEN vSP, CHIP = mfchartoprimitive(CHI, &F);
    3597       15575 :   vSP = (k == 1)? get_vDIH(N, divisorsNF(N, F)): NULL;
    3598       15575 :   S = mfcuspdim_i(N, k, CHIP, vSP); if (!S) return 0;
    3599        7742 :   av = avma; return gc_long(av, S - mfolddim_i(N, k, CHIP, vSP));
    3600             : }
    3601             : 
    3602             : /* trace form, given as closure */
    3603             : static GEN
    3604         938 : mftraceform_new(long N, long k, GEN CHI)
    3605             : {
    3606             :   GEN T;
    3607         938 :   if (k == 1) return initwt1newtrace(mfinit_Nkchi(N, 1, CHI, mf_CUSP, 0));
    3608         917 :   T = initnewtrace(N,CHI); if (!T) return mftrivial();
    3609         917 :   return tag(t_MF_NEWTRACE, mkNK(N,k,CHI), T);
    3610             : }
    3611             : static GEN
    3612          14 : mftraceform_cusp(long N, long k, GEN CHI)
    3613             : {
    3614          14 :   if (k == 1) return initwt1trace(mfinit_Nkchi(N, 1, CHI, mf_CUSP, 0));
    3615           7 :   return tag(t_MF_TRACE, mkNK(N,k,CHI), inittrace(N,CHI,NULL));
    3616             : }
    3617             : static GEN
    3618          98 : mftraceform_i(GEN NK, long space)
    3619             : {
    3620             :   GEN CHI;
    3621             :   long N, k;
    3622          98 :   checkNK(NK, &N, &k, &CHI, 0);
    3623          98 :   if (!mfdim_Nkchi(N, k, CHI, space)) return mftrivial();
    3624          77 :   switch(space)
    3625             :   {
    3626          56 :     case mf_NEW: return mftraceform_new(N, k, CHI);
    3627          14 :     case mf_CUSP:return mftraceform_cusp(N, k, CHI);
    3628             :   }
    3629           7 :   pari_err_DOMAIN("mftraceform", "space", "=", utoi(space), NK);
    3630             :   return NULL;/*LCOV_EXCL_LINE*/
    3631             : }
    3632             : GEN
    3633          98 : mftraceform(GEN NK, long space)
    3634          98 : { pari_sp av = avma; return gerepilecopy(av, mftraceform_i(NK,space)); }
    3635             : 
    3636             : static GEN
    3637       17500 : hecke_data(long N, long n)
    3638       17500 : { return mkvecsmall3(n, u_ppo(n, N), N); }
    3639             : /* 1/2-integral weight */
    3640             : static GEN
    3641          84 : heckef2_data(long N, long n)
    3642             : {
    3643             :   ulong f, fN, fN2;
    3644          84 :   if (!uissquareall(n, &f)) return NULL;
    3645          77 :   fN = u_ppo(f, N); fN2 = fN*fN;
    3646          77 :   return mkvec2(myfactoru(fN), mkvecsmall4(n, N, fN2, n/fN2));
    3647             : }
    3648             : /* N = mf_get_N(F) or a multiple */
    3649             : static GEN
    3650       24472 : mfhecke_i(long n, long N, GEN F)
    3651             : {
    3652       24472 :   if (n == 1) return F;
    3653       17129 :   return tag2(t_MF_HECKE, mf_get_NK(F), hecke_data(N,n), F);
    3654             : }
    3655             : 
    3656             : GEN
    3657         105 : mfhecke(GEN mf, GEN F, long n)
    3658             : {
    3659         105 :   pari_sp av = avma;
    3660             :   GEN NK, CHI, gk, DATA;
    3661             :   long N, nk, dk;
    3662         105 :   mf = checkMF(mf);
    3663         105 :   if (!checkmf_i(F)) pari_err_TYPE("mfhecke",F);
    3664         105 :   if (n <= 0) pari_err_TYPE("mfhecke [n <= 0]", stoi(n));
    3665         105 :   if (n == 1) return gcopy(F);
    3666         105 :   gk = mf_get_gk(F);
    3667         105 :   Qtoss(gk,&nk,&dk);
    3668         105 :   CHI = mf_get_CHI(F);
    3669         105 :   N = MF_get_N(mf);
    3670         105 :   if (dk == 2)
    3671             :   {
    3672          77 :     DATA = heckef2_data(N,n);
    3673          77 :     if (!DATA) return mftrivial();
    3674             :   }
    3675             :   else
    3676          28 :     DATA = hecke_data(N,n);
    3677          98 :   NK = mkgNK(lcmii(stoi(N), mf_get_gN(F)), gk, CHI, mf_get_field(F));
    3678          98 :   return gerepilecopy(av, tag2(t_MF_HECKE, NK, DATA, F));
    3679             : }
    3680             : 
    3681             : /* form F given by closure, compute B(d)(F) as closure (q -> q^d) */
    3682             : static GEN
    3683       35399 : mfbd_i(GEN F, long d)
    3684             : {
    3685             :   GEN D, NK, gk, CHI;
    3686       35399 :   if (d == 1) return F;
    3687       13293 :   if (d <= 0) pari_err_TYPE("mfbd [d <= 0]", stoi(d));
    3688       13293 :   if (mf_get_type(F) != t_MF_BD) D = utoi(d);
    3689           7 :   else { D = mului(d, gel(F,3)); F = gel(F,2); }
    3690       13293 :   gk = mf_get_gk(F); CHI = mf_get_CHI(F);
    3691       13293 :   if (typ(gk) != t_INT) CHI = mfcharmul(CHI, get_mfchar(utoi(d << 2)));
    3692       13293 :   NK = mkgNK(muliu(mf_get_gN(F), d), gk, CHI, mf_get_field(F));
    3693       13293 :   return tag2(t_MF_BD, NK, F, D);
    3694             : }
    3695             : GEN
    3696          42 : mfbd(GEN F, long d)
    3697             : {
    3698          42 :   pari_sp av = avma;
    3699          42 :   if (!checkmf_i(F)) pari_err_TYPE("mfbd",F);
    3700          42 :   return gerepilecopy(av, mfbd_i(F, d));
    3701             : }
    3702             : 
    3703             : /* A[i+1] = a(t*i^2) */
    3704             : static GEN
    3705         105 : RgV_shimura(GEN A, long n, long t, long N, long r, GEN CHI)
    3706             : {
    3707         105 :   GEN R, a0, Pn = mfcharpol(CHI);
    3708         105 :   long m, st, ord = mfcharorder(CHI), vt = varn(Pn), Nt = t == 1? N: ulcm(N,t);
    3709             : 
    3710         105 :   R = cgetg(n + 2, t_VEC);
    3711         105 :   st = odd(r)? -t: t;
    3712         105 :   a0 = gel(A, 1);
    3713         105 :   if (!gequal0(a0))
    3714             :   {
    3715          14 :     long o = mfcharorder(CHI);
    3716          14 :     if (st != 1 && odd(o)) o <<= 1;
    3717          14 :     a0 = gmul(a0, charLFwtk(Nt, r, CHI, o, st));
    3718             :   }
    3719         105 :   gel(R, 1) = a0;
    3720         637 :   for (m = 1; m <= n; m++)
    3721             :   {
    3722         532 :     GEN Dm = mydivisorsu(u_ppo(m, Nt)), S = gel(A, m*m + 1);
    3723         532 :     long i, l = lg(Dm);
    3724         805 :     for (i = 2; i < l; i++)
    3725             :     { /* (e,Nt) = 1; skip i = 1: e = 1, done above */
    3726         273 :       long e = Dm[i], me = m / e, a = mfcharevalord(CHI, e, ord);
    3727         273 :       GEN c, C = powuu(e, r - 1);
    3728         273 :       if (kross(st, e) == -1) C = negi(C);
    3729         273 :       c = Qab_Czeta(a, ord, C, vt);
    3730         273 :       S = gadd(S, gmul(c, gel(A, me*me + 1)));
    3731             :     }
    3732         532 :     gel(R, m+1) = S;
    3733             :   }
    3734         105 :   return degpol(Pn) > 1? gmodulo(R, Pn): R;
    3735             : }
    3736             : 
    3737             : static long
    3738          28 : mfisinkohnen(GEN mf, GEN F)
    3739             : {
    3740          28 :   GEN v, gk = MF_get_gk(mf), CHI = MF_get_CHI(mf);
    3741          28 :   long i, eps, N4 = MF_get_N(mf) >> 2, sb = mfsturmNgk(N4 << 4, gk) + 1;
    3742          28 :   eps = N4 % mfcharconductor(CHI)? -1 : 1;
    3743          28 :   if (odd(MF_get_r(mf))) eps = -eps;
    3744          28 :   v = mfcoefs(F, sb, 1);
    3745         686 :   for (i = 2;     i <= sb; i+=4) if (!gequal0(gel(v,i+1))) return 0;
    3746         245 :   for (i = 2+eps; i <= sb; i+=4) if (!gequal0(gel(v,i+1))) return 0;
    3747          14 :   return 1;
    3748             : }
    3749             : 
    3750             : static long
    3751          42 : mfshimura_space_cusp(GEN mf)
    3752             : {
    3753             :   long N4;
    3754          42 :   if (MF_get_r(mf) == 1 && (N4 = MF_get_N(mf) >> 2) >= 4)
    3755             :   {
    3756          21 :     GEN E = gel(myfactoru(N4), 2);
    3757          21 :     long ma = vecsmall_max(E);
    3758          21 :     if (ma > 2 || (ma == 2 && !mfcharistrivial(MF_get_CHI(mf)))) return 0;
    3759             :   }
    3760          28 :   return 1;
    3761             : }
    3762             : 
    3763             : /* D is either a discriminant (not necessarily fundamental) with
    3764             :    sign(D)=(-1)^{k-1/2}*eps, or a positive squarefree integer t, which is then
    3765             :    transformed into a fundamental discriminant of the correct sign. */
    3766             : GEN
    3767          49 : mfshimura(GEN mf, GEN F, long t)
    3768             : {
    3769          49 :   pari_sp av = avma;
    3770             :   GEN G, res, mf2, CHI;
    3771          49 :   long sb, M, r, N, space = mf_FULL;
    3772             : 
    3773          49 :   if (!checkmf_i(F)) pari_err_TYPE("mfshimura",F);
    3774          49 :   mf = checkMF(mf);
    3775          49 :   r = MF_get_r(mf);
    3776          49 :   if (r <= 0) pari_err_DOMAIN("mfshimura", "weight", "<=", ghalf, mf_get_gk(F));
    3777          49 :   if (t <= 0 || !uissquarefree(t)) pari_err_TYPE("mfshimura [t]", stoi(t));
    3778          42 :   N = MF_get_N(mf); M = N >> 1;
    3779          42 :   if (mfiscuspidal(mf,F))
    3780             :   {
    3781          28 :     if (mfshimura_space_cusp(mf)) space = mf_CUSP;
    3782          28 :     if (mfisinkohnen(mf,F)) M = N >> 2;
    3783             :   }
    3784          42 :   CHI = MF_get_CHI(mf);
    3785          42 :   mf2 = mfinit_Nkchi(M, r << 1, mfcharpow(CHI, gen_2), space, 0);
    3786          42 :   sb = mfsturm(mf2);
    3787          42 :   G = RgV_shimura(mfcoefs_i(F, sb*sb, t), sb, t, N, r, CHI);
    3788          42 :   res = mftobasis_i(mf2, G);
    3789             :   /* not mflinear(mf2,): we want lowest possible level */
    3790          42 :   G = mflinear(MF_get_basis(mf2), res);
    3791          42 :   return gerepilecopy(av, mkvec3(mf2, G, res));
    3792             : }
    3793             : 
    3794             : /* W ZabM (ZM if n = 1), a t_INT or NULL, b t_INT, ZXQ mod P or NULL.
    3795             :  * Write a/b = A/d with d t_INT and A Zab return [W,d,A,P] */
    3796             : static GEN
    3797        7630 : mkMinv(GEN W, GEN a, GEN b, GEN P)
    3798             : {
    3799        7630 :   GEN A = (b && typ(b) == t_POL)? Q_remove_denom(QXQ_inv(b,P), &b): NULL;
    3800        7630 :   if (a && b)
    3801             :   {
    3802        1281 :     a = Qdivii(a,b);
    3803        1281 :     if (typ(a) == t_INT) b = gen_1; else { b = gel(a,2); a = gel(a,1); }
    3804        1281 :     if (is_pm1(a)) a = NULL;
    3805             :   }
    3806        7630 :   if (a) A = A? ZX_Z_mul(A,a): a; else if (!A) A = gen_1;
    3807        7630 :   if (!b) b = gen_1;
    3808        7630 :   if (!P) P = gen_0;
    3809        7630 :   return mkvec4(W,b,A,P);
    3810             : }
    3811             : /* M square invertible QabM, return [M',d], M*M' = d*Id */
    3812             : static GEN
    3813         574 : QabM_Minv(GEN M, GEN P, long n)
    3814             : {
    3815             :   GEN dW, W, dM;
    3816         574 :   M = Q_remove_denom(M, &dM);
    3817         574 :   W = P? ZabM_inv(liftpol_shallow(M), P, n, &dW): ZM_inv(M, &dW);
    3818         574 :   return mkMinv(W, dM, dW, P);
    3819             : }
    3820             : /* Simplified form of mfclean, after a QabM_indexrank: M a ZabM with full
    3821             :  * column rank and z = indexrank(M) is known */
    3822             : static GEN
    3823         833 : mfclean2(GEN M, GEN z, GEN P, long n)
    3824             : {
    3825         833 :   GEN d, Minv, y = gel(z,1), W = rowpermute(M, y);
    3826         833 :   W = P? ZabM_inv(liftpol_shallow(W), P, n, &d): ZM_inv(W, &d);
    3827         833 :   M = rowslice(M, 1, y[lg(y)-1]);
    3828         833 :   Minv = mkMinv(W, NULL, d, P);
    3829         833 :   return mkvec3(y, Minv, M);
    3830             : }
    3831             : /* M QabM, lg(M)>1 and [y,z] its rank profile. Let Minv be the inverse of the
    3832             :  * invertible square matrix in mkMinv format. Return [y,Minv, M[..y[#y],]]
    3833             :  * P cyclotomic polynomial of order n > 2 or NULL */
    3834             : static GEN
    3835        4935 : mfclean(GEN M, GEN P, long n, int ratlift)
    3836             : {
    3837        4935 :   GEN W, v, y, z, d, Minv, dM, MdM = Q_remove_denom(M, &dM);
    3838        4935 :   if (n <= 2)
    3839        3843 :     W = ZM_pseudoinv(MdM, &v, &d);
    3840             :   else
    3841        1092 :     W = ZabM_pseudoinv_i(liftpol_shallow(MdM), P, n, &v, &d, ratlift);
    3842        4935 :   y = gel(v,1);
    3843        4935 :   z = gel(v,2);
    3844        4935 :   if (lg(z) != lg(MdM)) M = vecpermute(M,z);
    3845        4935 :   M = rowslice(M, 1, y[lg(y)-1]);
    3846        4935 :   Minv = mkMinv(W, dM, d, P);
    3847        4935 :   return mkvec3(y, Minv, M);
    3848             : }
    3849             : /* call mfclean using only CHI */
    3850             : static GEN
    3851        3983 : mfcleanCHI(GEN M, GEN CHI, int ratlift)
    3852             : {
    3853        3983 :   long n = mfcharorder(CHI);
    3854        3983 :   GEN P = (n <= 2)? NULL: mfcharpol(CHI);
    3855        3983 :   return mfclean(M, P, n, ratlift);
    3856             : }
    3857             : 
    3858             : /* DATA component of a t_MF_NEWTRACE. Was it stripped to save memory ? */
    3859             : static int
    3860       31934 : newtrace_stripped(GEN DATA)
    3861       31934 : { return DATA && (lg(DATA) == 5 && typ(gel(DATA,3)) == t_INT); }
    3862             : /* f a t_MF_NEWTRACE */
    3863             : static GEN
    3864       31934 : newtrace_DATA(long N, GEN f)
    3865             : {
    3866       31934 :   GEN DATA = gel(f,2);
    3867       31934 :   return newtrace_stripped(DATA)? initnewtrace(N, DATA): DATA;
    3868             : }
    3869             : /* reset cachenew for new level incorporating new DATA, tf a t_MF_NEWTRACE
    3870             :  * (+ possibly initialize 'full' for new allowed levels) */
    3871             : static void
    3872       31934 : reset_cachenew(cachenew_t *cache, long N, GEN tf)
    3873             : {
    3874             :   long i, n, l;
    3875       31934 :   GEN v, DATA = newtrace_DATA(N,tf);
    3876       31934 :   cache->DATA = DATA;
    3877       31934 :   if (!DATA) return;
    3878       31829 :   n = cache->n;
    3879       31829 :   v = cache->vfull; l = N+1; /* = lg(DATA) */
    3880     2155909 :   for (i = 1; i < l; i++)
    3881     2124080 :     if (typ(gel(v,i)) == t_INT && lg(gel(DATA,i)) != 1)
    3882       48965 :       gel(v,i) = const_vec(n, NULL);
    3883       31829 :   cache->VCHIP = gel(gel(DATA,N),_VCHIP);
    3884             : }
    3885             : /* initialize a cache of newtrace / cusptrace up to index n and level | N;
    3886             :  * DATA may be NULL (<=> Tr^new = 0). tf a t_MF_NEWTRACE */
    3887             : static void
    3888       12173 : init_cachenew(cachenew_t *cache, long n, long N, GEN tf)
    3889             : {
    3890       12173 :   long i, l = N+1; /* = lg(tf.DATA) when DATA != NULL */
    3891             :   GEN v;
    3892       12173 :   cache->n = n;
    3893       12173 :   cache->vnew = v = cgetg(l, t_VEC);
    3894      914998 :   for (i = 1; i < l; i++) gel(v,i) = (N % i)? gen_0: const_vec(n, NULL);
    3895       12173 :   cache->newHIT = cache->newTOTAL = cache->cuspHIT = cache->cuspTOTAL = 0;
    3896       12173 :   cache->vfull = v = zerovec(N);
    3897       12173 :   reset_cachenew(cache, N, tf);
    3898       12173 : }
    3899             : static void
    3900       16415 : dbg_cachenew(cachenew_t *C)
    3901             : {
    3902       16415 :   if (DEBUGLEVEL >= 2 && C)
    3903           0 :     err_printf("newtrace cache hits: new = %ld/%ld, cusp = %ld/%ld\n",
    3904             :                     C->newHIT, C->newTOTAL, C->cuspHIT, C->cuspTOTAL);
    3905       16415 : }
    3906             : 
    3907             : /* newtrace_{N,k}(d*i), i = n0, ..., n */
    3908             : static GEN
    3909      177898 : colnewtrace(long n0, long n, long d, long N, long k, cachenew_t *cache)
    3910             : {
    3911      177898 :   GEN v = cgetg(n-n0+2, t_COL);
    3912             :   long i;
    3913     4657394 :   for (i = n0; i <= n; i++) gel(v, i-n0+1) = mfnewtracecache(N, k, i*d, cache);
    3914      177898 :   return v;
    3915             : }
    3916             : /* T_n(l*m0, l*(m0+1), ..., l*m) F, F = t_MF_NEWTRACE [N,k],DATA, cache
    3917             :  * contains DATA != NULL as well as cached values of F */
    3918             : static GEN
    3919       87801 : heckenewtrace(long m0, long m, long l, long N, long NBIG, long k, long n, cachenew_t *cache)
    3920             : {
    3921       87801 :   long lD, a, k1, nl = n*l;
    3922       87801 :   GEN D, V, v = colnewtrace(m0, m, nl, N, k, cache); /* d=1 */
    3923             :   GEN VCHIP;
    3924       87801 :   if (n == 1) return v;
    3925       60718 :   VCHIP = cache->VCHIP;
    3926       60718 :   D = mydivisorsu(u_ppo(n, NBIG)); lD = lg(D);
    3927       60718 :   k1 = k - 1;
    3928      149233 :   for (a = 2; a < lD; a++)
    3929             :   { /* d > 1, (d,NBIG) = 1 */
    3930       88515 :     long i, j, d = D[a], c = ugcd(l, d), dl = d/c, m0d = ceildivuu(m0, dl);
    3931       88515 :     GEN C = vchip_lift(VCHIP, d, powuu(d, k1));
    3932             :     /* m0=0: i = 1 => skip F(0) = 0 */
    3933       88515 :     if (!m0) { i = 1; j = dl; } else { i = 0; j = m0d*dl; }
    3934       88515 :     V = colnewtrace(m0d, m/dl, nl/(d*c), N, k, cache);
    3935             :     /* C = chi(d) d^(k-1) */
    3936     1075242 :     for (; j <= m; i++, j += dl)
    3937      986727 :       gel(v,j-m0+1) = gadd(gel(v,j-m0+1), vchip_mod(VCHIP, gmul(C,gel(V,i+1))));
    3938             :   }
    3939       60718 :   return v;
    3940             : }
    3941             : 
    3942             : /* Given v = an[i], return an[d*i], i=0..n */
    3943             : static GEN
    3944        2618 : anextract(GEN v, long n, long d)
    3945             : {
    3946        2618 :   long i, id, l = n + 2;
    3947        2618 :   GEN w = cgetg(l, t_VEC);
    3948        2618 :   if (d == 1)
    3949        7245 :     for (i = 1; i < l; i++) gel(w, i) = gel(v, i);
    3950             :   else
    3951       22036 :     for (i = id = 1; i < l; i++, id += d) gel(w, i) = gel(v, id);
    3952        2618 :   return w;
    3953             : }
    3954             : /* T_n(F)(0, l, ..., l*m) */
    3955             : static GEN
    3956        2471 : hecke_i(long m, long l, GEN V, GEN F, GEN DATA)
    3957             : {
    3958             :   long k, n, nNBIG, NBIG, lD, M, a, t, nl;
    3959             :   GEN D, v, CHI;
    3960        2471 :   if (typ(DATA) == t_VEC)
    3961             :   { /* 1/2-integral k */
    3962          98 :     if (!V) { GEN S = gel(DATA,2); V = mfcoefs_i(F, m*l*S[3], S[4]); }
    3963          98 :     return RgV_heckef2(m, l, V, F, DATA);
    3964             :   }
    3965        2373 :   k = mf_get_k(F);
    3966        2373 :   n = DATA[1]; nl = n*l;
    3967        2373 :   nNBIG = DATA[2];
    3968        2373 :   NBIG = DATA[3];
    3969        2373 :   if (nNBIG == 1) return V? V: mfcoefs_i(F,m,nl);
    3970        1631 :   if (!V && mf_get_type(F) == t_MF_NEWTRACE)
    3971             :   { /* inline F to allow cache, T_n at level NBIG acting on Tr^new(N,k,CHI) */
    3972             :     cachenew_t cache;
    3973         322 :     long N = mf_get_N(F);
    3974         322 :     init_cachenew(&cache, m*nl, N, F);
    3975         322 :     v = heckenewtrace(0, m, l, N, NBIG, k, n, &cache);
    3976         322 :     dbg_cachenew(&cache);
    3977         322 :     settyp(v, t_VEC); return v;
    3978             :   }
    3979        1309 :   CHI = mf_get_CHI(F);
    3980        1309 :   D = mydivisorsu(nNBIG); lD = lg(D);
    3981        1309 :   M = m + 1;
    3982        1309 :   t = nNBIG * ugcd(nNBIG, l);
    3983        1309 :   if (!V) V = mfcoefs_i(F, m * t, nl / t); /* usually nl = t */
    3984        1309 :   v = anextract(V, m, t); /* mfcoefs(F, m, nl); d = 1 */
    3985        2618 :   for (a = 2; a < lD; a++)
    3986             :   { /* d > 1, (d, NBIG) = 1 */
    3987        1309 :     long d = D[a], c = ugcd(l, d), dl = d/c, i, idl;
    3988        1309 :     GEN C = gmul(mfchareval(CHI, d), powuu(d, k-1));
    3989        1309 :     GEN w = anextract(V, m/dl, t/(d*c)); /* mfcoefs(F, m/dl, nl/(d*c)) */
    3990        7245 :     for (i = idl = 1; idl <= M; i++, idl += dl)
    3991        5936 :       gel(v,idl) = gadd(gel(v,idl), gmul(C, gel(w,i)));
    3992             :   }
    3993        1309 :   return v;
    3994             : }
    3995             : 
    3996             : static GEN
    3997       12159 : mkmf(GEN x1, GEN x2, GEN x3, GEN x4, GEN x5)
    3998             : {
    3999       12159 :   GEN MF = obj_init(5, MF_SPLITN);
    4000       12159 :   gel(MF,1) = x1;
    4001       12159 :   gel(MF,2) = x2;
    4002       12159 :   gel(MF,3) = x3;
    4003       12159 :   gel(MF,4) = x4;
    4004       12159 :   gel(MF,5) = x5; return MF;
    4005             : }
    4006             : 
    4007             : /* return an integer b such that p | b => T_p^k Tr^new = 0, for all k > 0 */
    4008             : static long
    4009        7483 : get_badj(long N, long FC)
    4010             : {
    4011        7483 :   GEN fa = myfactoru(N), P = gel(fa,1), E = gel(fa,2);
    4012        7483 :   long i, b = 1, l = lg(P);
    4013       19929 :   for (i = 1; i < l; i++)
    4014       12446 :     if (E[i] > 1 && u_lval(FC, P[i]) < E[i]) b *= P[i];
    4015        7483 :   return b;
    4016             : }
    4017             : /* in place, assume perm strictly increasing */
    4018             : static void
    4019        1330 : vecpermute_inplace(GEN v, GEN perm)
    4020             : {
    4021        1330 :   long i, l = lg(perm);
    4022       11522 :   for (i = 1; i < l; i++) gel(v,i) = gel(v,perm[i]);
    4023        1330 : }
    4024             : 
    4025             : /* Find basis of newspace using closures; assume k >= 2 and !badchar.
    4026             :  * Return NULL if space is empty, else
    4027             :  * [mf1, list of closures T(j)traceform, list of corresponding j, matrix] */
    4028             : static GEN
    4029       15330 : mfnewinit(long N, long k, GEN CHI, cachenew_t *cache, long init)
    4030             : {
    4031             :   GEN S, vj, M, CHIP, mf1, listj, P, tf;
    4032             :   long j, ct, ctlj, dim, jin, SB, sb, two, ord, FC, badj;
    4033             : 
    4034       15330 :   dim = mfnewdim(N, k, CHI);
    4035       15330 :   if (!dim && !init) return NULL;
    4036        7483 :   sb = mfsturmNk(N, k);
    4037        7483 :   CHIP = mfchartoprimitive(CHI, &FC);
    4038             :   /* remove newtrace data from S to save space in output: negligible slowdown */
    4039        7483 :   tf = tag(t_MF_NEWTRACE, mkNK(N,k,CHIP), CHIP);
    4040        7483 :   badj = get_badj(N, FC);
    4041             :   /* try sbsmall first: Sturm bound not sharp for new space */
    4042        7483 :   SB = ceilA1(N, k);
    4043        7483 :   listj = cgetg(2*sb + 3, t_VECSMALL);
    4044      369054 :   for (j = ctlj = 1; ctlj < 2*sb + 3; j++)
    4045      361571 :     if (ugcd(j, badj) == 1) listj[ctlj++] = j;
    4046        7483 :   if (init)
    4047             :   {
    4048        4060 :     init_cachenew(cache, (SB+1)*listj[dim+1], N, tf);
    4049        4060 :     if (init == -1 || !dim) return NULL; /* old space or dim = 0 */
    4050             :   }
    4051             :   else
    4052        3423 :     reset_cachenew(cache, N, tf);
    4053             :   /* cache.DATA is not NULL */
    4054        7028 :   ord = mfcharorder(CHIP);
    4055        7028 :   P = ord <= 2? NULL: mfcharpol(CHIP);
    4056        7028 :   vj = cgetg(dim+1, t_VECSMALL);
    4057        7028 :   M = cgetg(dim+1, t_MAT);
    4058        7035 :   for (two = 1, ct = 0, jin = 1; two <= 2; two++)
    4059             :   {
    4060        7035 :     long a, jlim = jin + sb;
    4061       21819 :     for (a = jin; a <= jlim; a++)
    4062             :     {
    4063             :       GEN z, vecz;
    4064       21812 :       ct++; vj[ct] = listj[a];
    4065       21812 :       gel(M, ct) = heckenewtrace(0, SB, 1, N, N, k, vj[ct], cache);
    4066       21812 :       if (ct < dim) continue;
    4067             : 
    4068        7693 :       z = QabM_indexrank(M, P, ord);
    4069        7693 :       vecz = gel(z, 2); ct = lg(vecz) - 1;
    4070        7693 :       if (ct == dim) { M = mkvec3(z, gen_0, M); break; } /*maximal rank, done*/
    4071         665 :       vecpermute_inplace(M, vecz);
    4072         665 :       vecpermute_inplace(vj, vecz);
    4073             :     }
    4074        7035 :     if (a <= jlim) break;
    4075             :     /* sbsmall was not sufficient, use Sturm bound: must extend M */
    4076          70 :     for (j = 1; j <= ct; j++)
    4077             :     {
    4078          63 :       GEN t = heckenewtrace(SB + 1, sb, 1, N, N, k, vj[j], cache);
    4079          63 :       gel(M,j) = shallowconcat(gel(M, j), t);
    4080             :     }
    4081           7 :     jin = jlim + 1; SB = sb;
    4082             :   }
    4083        7028 :   S = cgetg(dim + 1, t_VEC);
    4084       28133 :   for (j = 1; j <= dim; j++) gel(S, j) = mfhecke_i(vj[j], N, tf);
    4085        7028 :   dbg_cachenew(cache);
    4086        7028 :   mf1 = mkvec4(utoipos(N), utoipos(k), CHI, utoi(mf_NEW));
    4087        7028 :   return mkmf(mf1, cgetg(1,t_VEC), S, vj, M);
    4088             : }
    4089             : /* k > 1 integral, mf space is mf_CUSP or mf_FULL */
    4090             : static GEN
    4091          42 : mfinittonew(GEN mf)
    4092             : {
    4093          42 :   GEN CHI = MF_get_CHI(mf), S = MF_get_S(mf), vMjd = MFcusp_get_vMjd(mf);
    4094          42 :   GEN M = MF_get_M(mf), vj, mf1;
    4095          42 :   long i, j, l, l0 = lg(S), N0 = MF_get_N(mf);
    4096         203 :   for (i = l0-1; i > 0; i--)
    4097             :   {
    4098         189 :     long N = gel(vMjd,i)[1];
    4099         189 :     if (N != N0) break;
    4100             :   }
    4101          42 :   if (i == l0-1) return NULL;
    4102          35 :   S = vecslice(S, i+1, l0-1); /* forms of conductor N0 */
    4103          35 :   l = lg(S); vj = cgetg(l, t_VECSMALL);
    4104         196 :   for (j = 1; j < l; j++) vj[j] = gel(vMjd,j+i)[2];
    4105          35 :   M = vecslice(M, lg(M)-lg(S)+1, lg(M)-1); /* their coefficients */
    4106          35 :   M = mfcleanCHI(M, CHI, 0);
    4107          35 :   mf1 = mkvec4(utoipos(N0), MF_get_gk(mf), CHI, utoi(mf_NEW));
    4108          35 :   return mkmf(mf1, cgetg(1,t_VEC), S, vj, M);
    4109             : }
    4110             : 
    4111             : /* Bd(f)[m0..m], v = f[ceil(m0/d)..floor(m/d)], m0d = ceil(m0/d) */
    4112             : static GEN
    4113       81662 : RgC_Bd_expand(long m0, long m, GEN v, long d, long m0d)
    4114             : {
    4115             :   long i, j;
    4116             :   GEN w;
    4117       81662 :   if (d == 1) return v;
    4118       23492 :   w = zerocol(m-m0+1);
    4119       23492 :   if (!m0) { i = 1; j = d; } else { i = 0; j = m0d*d; }
    4120      467859 :   for (; j <= m; i++, j += d) gel(w,j-m0+1) = gel(v,i+1);
    4121       23492 :   return w;
    4122             : }
    4123             : /* S a nonempty vector of t_MF_BD(t_MF_HECKE(t_MF_NEWTRACE)); M the matrix
    4124             :  * of their coefficients r*0, r*1, ..., r*m0 (~ mfvectomat) or NULL (empty),
    4125             :  * extend it to coeffs up to m > m0. The forms B_d(T_j(tf_N))in S should be
    4126             :  * sorted by level N, then j, then increasing d. No reordering here. */
    4127             : static GEN
    4128        8414 : bhnmat_extend(GEN M, long m, long r, GEN S, cachenew_t *cache)
    4129             : {
    4130        8414 :   long i, mr, m0, m0r, Nold = 0, jold = 0, l = lg(S);
    4131        8414 :   GEN MAT = cgetg(l, t_MAT), v = NULL;
    4132        8414 :   if (M) { m0 = nbrows(M); m0r = m0 * r; } else m0 = m0r = 0;
    4133        8414 :   mr = m*r;
    4134       90076 :   for (i = 1; i < l; i++)
    4135             :   {
    4136             :     long d, j, md, N;
    4137       81662 :     GEN c, f = bhn_parse(gel(S,i), &d,&j); /* t_MF_NEWTRACE */
    4138       81662 :     N = mf_get_N(f);
    4139       81662 :     md = ceildivuu(m0r,d);
    4140       81662 :     if (N != Nold) { reset_cachenew(cache, N, f); Nold = N; jold = 0; }
    4141       81662 :     if (!cache->DATA) { gel(MAT,i) = zerocol(m+1); continue; }
    4142       81662 :     if (j != jold || md)
    4143       65604 :     { v = heckenewtrace(md, mr/d, 1, N, N, mf_get_k(f), j,cache); jold=j; }
    4144       81662 :     c = RgC_Bd_expand(m0r, mr, v, d, md);
    4145       81662 :     if (r > 1) c = c_deflate(m-m0, r, c);
    4146       81662 :     if (M) c = shallowconcat(gel(M,i), c);
    4147       81662 :     gel(MAT,i) = c;
    4148             :   }
    4149        8414 :   return MAT;
    4150             : }
    4151             : 
    4152             : /* k > 1 */
    4153             : static GEN
    4154        3157 : mfinitcusp(long N, long k, GEN CHI, cachenew_t *cache, long space)
    4155             : {
    4156             :   long L, l, lDN1, FC, N1, d1, i, init;
    4157        3157 :   GEN vS, vMjd, DN1, vmf, CHIP = mfchartoprimitive(CHI, &FC);
    4158             : 
    4159        3157 :   d1 = (space == mf_OLD)? mfolddim_i(N, k, CHIP, NULL): mfcuspdim(N, k, CHIP);
    4160        3157 :   if (!d1) return NULL;
    4161        2856 :   N1 = N/FC; DN1 = mydivisorsu(N1); lDN1 = lg(DN1);
    4162        2856 :   init = (space == mf_OLD)? -1: 1;
    4163        2856 :   vmf = cgetg(lDN1, t_VEC);
    4164       16982 :   for (i = lDN1 - 1, l = 1; i; i--)
    4165             :   { /* by decreasing level to allow cache */
    4166       14126 :     GEN mf = mfnewinit(FC*DN1[i], k, CHIP, cache, init);
    4167       14126 :     if (mf) gel(vmf, l++) = mf;
    4168       14126 :     init = 0;
    4169             :   }
    4170        2856 :   setlg(vmf,l); vmf = vecreverse(vmf); /* reorder by increasing level */
    4171             : 
    4172        2856 :   L = mfsturmNk(N, k)+1;
    4173        2856 :   vS = vectrunc_init(L);
    4174        2856 :   vMjd = vectrunc_init(L);
    4175        9051 :   for (i = 1; i < l; i++)
    4176             :   {
    4177        6195 :     GEN DNM, mf = gel(vmf,i), S = MF_get_S(mf), vj = MFnew_get_vj(mf);
    4178        6195 :     long a, lDNM, lS = lg(S), M = MF_get_N(mf);
    4179        6195 :     DNM = mydivisorsu(N / M); lDNM = lg(DNM);
    4180       25228 :     for (a = 1; a < lS; a++)
    4181             :     {
    4182       19033 :       GEN tf = gel(S,a);
    4183       19033 :       long b, j = vj[a];
    4184       47327 :       for (b = 1; b < lDNM; b++)
    4185             :       {
    4186       28294 :         long d = DNM[b];
    4187       28294 :         vectrunc_append(vS, mfbd_i(tf, d));
    4188       28294 :         vectrunc_append(vMjd, mkvecsmall3(M, j, d));
    4189             :       }
    4190             :     }
    4191             :   }
    4192        2856 :   return mkmf(NULL, cgetg(1, t_VEC), vS, vMjd, NULL);
    4193             : }
    4194             : 
    4195             : long
    4196        4340 : mfsturm_mf(GEN mf)
    4197             : {
    4198        4340 :   GEN Mindex = MF_get_Mindex(mf);
    4199        4340 :   long n = lg(Mindex)-1;
    4200        4340 :   return n? Mindex[n]-1: 0;
    4201             : }
    4202             : 
    4203             : long
    4204         623 : mfsturm(GEN T)
    4205             : {
    4206             :   long N, nk, dk;
    4207         623 :   GEN CHI, mf = checkMF_i(T);
    4208         623 :   if (mf) return mfsturm_mf(mf);
    4209           7 :   checkNK2(T, &N, &nk, &dk, &CHI, 0);
    4210           7 :   return dk == 1 ? mfsturmNk(N, nk) : mfsturmNk(N, (nk + 1) >> 1);
    4211             : }
    4212             : long
    4213           7 : mfisequal(GEN F, GEN G, long lim)
    4214             : {
    4215           7 :   pari_sp av = avma;
    4216             :   long b;
    4217           7 :   if (!checkmf_i(F)) pari_err_TYPE("mfisequal",F);
    4218           7 :   if (!checkmf_i(G)) pari_err_TYPE("mfisequal",G);
    4219           7 :   b = lim? lim: maxss(mfsturmmf(F), mfsturmmf(G));
    4220           7 :   return gc_long(av, gequal(mfcoefs_i(F, b, 1), mfcoefs_i(G, b, 1)));
    4221             : }
    4222             : 
    4223             : GEN
    4224          35 : mffields(GEN mf)
    4225             : {
    4226          35 :   if (checkmf_i(mf)) return gcopy(mf_get_field(mf));
    4227          35 :   mf = checkMF(mf); return gcopy(MF_get_fields(mf));
    4228             : }
    4229             : 
    4230             : GEN
    4231         336 : mfeigenbasis(GEN mf)
    4232             : {
    4233         336 :   pari_sp ltop = avma;
    4234             :   GEN F, S, v, vP;
    4235             :   long i, l, k, dS;
    4236             : 
    4237         336 :   mf = checkMF(mf);
    4238         336 :   k = MF_get_k(mf);
    4239         336 :   S = MF_get_S(mf); dS = lg(S)-1;
    4240         336 :   if (!dS) return cgetg(1, t_VEC);
    4241         329 :   F = MF_get_newforms(mf);
    4242         329 :   vP = MF_get_fields(mf);
    4243         329 :   if (k == 1)
    4244             :   {
    4245         210 :     if (MF_get_space(mf) == mf_FULL)
    4246             :     {
    4247          14 :       long dE = lg(MF_get_E(mf)) - 1;
    4248          14 :       if (dE) F = rowslice(F, dE+1, dE+dS);
    4249             :     }
    4250         210 :     v = vecmflineardiv_linear(S, F);
    4251         210 :     l = lg(v);
    4252             :   }
    4253             :   else
    4254             :   {
    4255         119 :     GEN (*L)(GEN, GEN) = (MF_get_space(mf) == mf_FULL)? mflinear: mflinear_bhn;
    4256         119 :     l = lg(F); v = cgetg(l, t_VEC);
    4257         413 :     for (i = 1; i < l; i++) gel(v,i) = L(mf, gel(F,i));
    4258             :   }
    4259         847 :   for (i = 1; i < l; i++) mf_setfield(gel(v,i), gel(vP,i));
    4260         329 :   return gerepilecopy(ltop, v);
    4261             : }
    4262             : 
    4263             : /* Minv = [M, d, A], v a t_COL; A a Zab, d a t_INT; return (A/d) * M*v */
    4264             : static GEN
    4265        7077 : Minv_RgC_mul(GEN Minv, GEN v)
    4266             : {
    4267        7077 :   GEN M = gel(Minv,1), d = gel(Minv,2), A = gel(Minv,3);
    4268        7077 :   v = RgM_RgC_mul(M, v);
    4269        7077 :   if (!equali1(A))
    4270             :   {
    4271        1764 :     if (typ(A) == t_POL && degpol(A) > 0) A = mkpolmod(A, gel(Minv,4));
    4272        1764 :     v = RgC_Rg_mul(v, A);
    4273             :   }
    4274        7077 :   if (!equali1(d)) v = RgC_Rg_div(v, d);
    4275        7077 :   return v;
    4276             : }
    4277             : static GEN
    4278        1267 : Minv_RgM_mul(GEN Minv, GEN B)
    4279             : {
    4280        1267 :   long j, l = lg(B);
    4281        1267 :   GEN M = cgetg(l, t_MAT);
    4282        5887 :   for (j = 1; j < l; j++) gel(M,j) = Minv_RgC_mul(Minv, gel(B,j));
    4283        1267 :   return M;
    4284             : }
    4285             : /* B * Minv; allow B = NULL for Id */
    4286             : static GEN
    4287        2436 : RgM_Minv_mul(GEN B, GEN Minv)
    4288             : {
    4289        2436 :   GEN M = gel(Minv,1), d = gel(Minv,2), A = gel(Minv,3);
    4290        2436 :   if (B) M = RgM_mul(B, M);
    4291        2436 :   if (!equali1(A))
    4292             :   {
    4293         980 :     if (typ(A) == t_POL) A = mkpolmod(A, gel(Minv,4));
    4294         980 :     M = RgM_Rg_mul(M, A);
    4295             :   }
    4296        2436 :   if (!equali1(d)) M = RgM_Rg_div(M,d);
    4297        2436 :   return M;
    4298             : }
    4299             : 
    4300             : /* perm vector of strictly increasing indices, v a vector or arbitrary length;
    4301             :  * the last r entries of perm fall beyond v.
    4302             :  * Return v o perm[1..(-r)], discarding the last r entries of v */
    4303             : static GEN
    4304        1176 : vecpermute_partial(GEN v, GEN perm, long *r)
    4305             : {
    4306        1176 :   long i, n = lg(v)-1, l = lg(perm);
    4307             :   GEN w;
    4308        1176 :   if (perm[l-1] <= n) { *r = 0; return vecpermute(v,perm); }
    4309          63 :   for (i = 1; i < l; i++)
    4310          63 :     if (perm[i] > n) break;
    4311          21 :   *r = l - i; l = i;
    4312          21 :   w = cgetg(l, typ(v));
    4313          63 :   for (i = 1; i < l; i++) gel(w,i) = gel(v,perm[i]);
    4314          21 :   return w;
    4315             : }
    4316             : 
    4317             : /* given form F, find coeffs of F on mfbasis(mf). If power series, not
    4318             :  * guaranteed correct if precision less than Sturm bound */
    4319             : static GEN
    4320        1197 : mftobasis_i(GEN mf, GEN F)
    4321             : {
    4322             :   GEN v, Mindex, Minv;
    4323        1197 :   if (!MF_get_dim(mf)) return cgetg(1, t_COL);
    4324        1197 :   Mindex = MF_get_Mindex(mf);
    4325        1197 :   Minv = MF_get_Minv(mf);
    4326        1197 :   if (checkmf_i(F))
    4327             :   {
    4328         259 :     long n = Mindex[lg(Mindex)-1];
    4329         259 :     v = vecpermute(mfcoefs_i(F, n, 1), Mindex);
    4330         259 :     return Minv_RgC_mul(Minv, v);
    4331             :   }
    4332             :   else
    4333             :   {
    4334         938 :     GEN A = gel(Minv,1), d = gel(Minv,2);
    4335             :     long r;
    4336         938 :     v = F;
    4337         938 :     switch(typ(F))
    4338             :     {
    4339           0 :       case t_SER: v = sertocol(v);
    4340         938 :       case t_VEC: case t_COL: break;
    4341           0 :       default: pari_err_TYPE("mftobasis", F);
    4342             :     }
    4343         938 :     if (lg(v) == 1) pari_err_TYPE("mftobasis",v);
    4344         938 :     v = vecpermute_partial(v, Mindex, &r);
    4345         938 :     if (!r) return Minv_RgC_mul(Minv, v); /* single solution */
    4346             :     /* affine space of dimension r */
    4347          21 :     v = RgM_RgC_mul(vecslice(A, 1, lg(v)-1), v);
    4348          21 :     if (!equali1(d)) v = RgC_Rg_div(v,d);
    4349          21 :     return mkvec2(v, vecslice(A, lg(A)-r, lg(A)-1));
    4350             :   }
    4351             : }
    4352             : 
    4353             : static GEN
    4354         546 : const_mat(long n, GEN x)
    4355             : {
    4356         546 :   long j, l = n+1;
    4357         546 :   GEN A = cgetg(l,t_MAT);
    4358        3990 :   for (j = 1; j < l; j++) gel(A,j) = const_col(n, x);
    4359         546 :   return A;
    4360             : }
    4361             : 
    4362             : /* L is the mftobasis of a form on CUSP space. We allow mf_FULL or mf_CUSP */
    4363             : static GEN
    4364         273 : mftonew_i(GEN mf, GEN L, long *plevel)
    4365             : {
    4366             :   GEN S, listMjd, CHI, res, Aclos, Acoef, D, perm;
    4367         273 :   long N1, LC, lD, i, l, t, level, N = MF_get_N(mf);
    4368             : 
    4369         273 :   if (MF_get_k(mf) == 1) pari_err_IMPL("mftonew in weight 1");
    4370         273 :   listMjd = MFcusp_get_vMjd(mf);
    4371         273 :   CHI = MF_get_CHI(mf); LC = mfcharconductor(CHI);
    4372         273 :   S = MF_get_S(mf);
    4373             : 
    4374         273 :   N1 = N/LC;
    4375         273 :   D = mydivisorsu(N1); lD = lg(D);
    4376         273 :   perm = cgetg(N1+1, t_VECSMALL);
    4377        1995 :   for (i = 1; i < lD; i++) perm[D[i]] = i;
    4378         273 :   Aclos = const_mat(lD-1, cgetg(1,t_VEC));
    4379         273 :   Acoef = const_mat(lD-1, cgetg(1,t_VEC));
    4380         273 :   l = lg(listMjd);
    4381        2863 :   for (i = 1; i < l; i++)
    4382             :   {
    4383             :     long M, d;
    4384             :     GEN v;
    4385        2590 :     if (gequal0(gel(L,i))) continue;
    4386         266 :     v = gel(listMjd, i);
    4387         266 :     M = perm[ v[1]/LC ];
    4388         266 :     d = perm[ v[3] ];
    4389         266 :     gcoeff(Aclos,M,d) = vec_append(gcoeff(Aclos,M,d), gel(S,i));
    4390         266 :     gcoeff(Acoef,M,d) = shallowconcat(gcoeff(Acoef,M,d), gel(L,i));
    4391             :   }
    4392         273 :   res = cgetg(l, t_VEC); level = 1;
    4393        1995 :   for (i = t = 1; i < lD; i++)
    4394             :   {
    4395        1722 :     long j, M = D[i]*LC;
    4396        1722 :     GEN gM = utoipos(M);
    4397       15120 :     for (j = 1; j < lD; j++)
    4398             :     {
    4399       13398 :       GEN f = gcoeff(Aclos,i,j), C, NK;
    4400             :       long d;
    4401       13398 :       if (lg(f) == 1) continue;
    4402         238 :       NK = mf_get_NK(gel(f,1));
    4403         238 :       d = D[j];
    4404         238 :       C = gcoeff(Acoef,i,j);
    4405         238 :       level = ulcm(level, M*d);
    4406         238 :       gel(res,t++) = mkvec3(gM, utoipos(d), mflinear_i(NK,f,C));
    4407             :     }
    4408             :   }
    4409         273 :   if (plevel) *plevel = level;
    4410         273 :   setlg(res, t); return res;
    4411             : }
    4412             : GEN
    4413          35 : mftonew(GEN mf, GEN F)
    4414             : {
    4415          35 :   pari_sp av = avma;
    4416             :   GEN ES;
    4417             :   long s;
    4418          35 :   mf = checkMF(mf);
    4419          35 :   s = MF_get_space(mf);
    4420          35 :   if (s != mf_FULL && s != mf_CUSP)
    4421           7 :     pari_err_TYPE("mftonew [not a full or cuspidal space]", mf);
    4422          28 :   ES = mftobasisES(mf,F);
    4423          21 :   if (!gequal0(gel(ES,1)))
    4424           0 :     pari_err_TYPE("mftonew [not a cuspidal form]", F);
    4425          21 :   F = gel(ES,2);
    4426          21 :   return gerepilecopy(av, mftonew_i(mf,F, NULL));
    4427             : }
    4428             : 
    4429             : static GEN mfeisenstein_i(long k, GEN CHI1, GEN CHI2);
    4430             : 
    4431             : /* mfinit(F * Theta) */
    4432             : static GEN
    4433          98 : mf2init(GEN mf)
    4434             : {
    4435          98 :   GEN CHI = MF_get_CHI(mf), gk = gadd(MF_get_gk(mf), ghalf);
    4436          98 :   long N = MF_get_N(mf);
    4437          98 :   return mfinit_Nkchi(N, itou(gk), mfchiadjust(CHI, gk, N), mf_FULL, 0);
    4438             : }
    4439             : 
    4440             : static long
    4441         623 : mfvec_first_cusp(GEN v)
    4442             : {
    4443         623 :   long i, l = lg(v);
    4444        1519 :   for (i = 1; i < l; i++)
    4445             :   {
    4446        1414 :     GEN F = gel(v,i);
    4447        1414 :     long t = mf_get_type(F);
    4448        1414 :     if (t == t_MF_BD) { F = gel(F,2); t = mf_get_type(F); }
    4449        1414 :     if (t == t_MF_HECKE) { F = gel(F,3); t = mf_get_type(F); }
    4450        1414 :     if (t == t_MF_NEWTRACE) break;
    4451             :   }
    4452         623 :   return i;
    4453             : }
    4454             : /* vF a vector of mf F of type DIV(LINEAR(BAS,L), f) in (lcm) level N,
    4455             :  * F[2]=LINEAR(BAS,L), F[2][2]=BAS=fixed basis (Eisenstein or bhn type),
    4456             :  * F[2][3]=L, F[3]=f; mfvectomat(vF, n) */
    4457             : static GEN
    4458         630 : mflineardivtomat(long N, GEN vF, long n)
    4459             : {
    4460         630 :   GEN F, M, f, fc, ME, dB, B, a0, V = NULL;
    4461         630 :   long lM, lF = lg(vF), j;
    4462             : 
    4463         630 :   if (lF == 1) return cgetg(1,t_MAT);
    4464         623 :   F = gel(vF,1);
    4465         623 :   if (lg(F) == 5)
    4466             :   { /* chicompat */
    4467         273 :     V = gmael(F,4,4);
    4468         273 :     if (typ(V) == t_INT) V = NULL;
    4469             :   }
    4470         623 :   M = gmael(F,2,2); /* BAS */
    4471         623 :   lM = lg(M);
    4472         623 :   j = mfvec_first_cusp(M);
    4473         623 :   if (j == 1) ME = NULL;
    4474             :   else
    4475             :   { /* BAS starts by Eisenstein */
    4476         161 :     ME = mfvectomat(vecslice(M,1,j-1), n, 1);
    4477         161 :     M = vecslice(M, j,lM-1);
    4478             :   }
    4479         623 :   M = bhnmat_extend_nocache(NULL, N, n, 1, M);
    4480         623 :   if (ME) M = shallowconcat(ME,M);
    4481             :   /* M = mfcoefs of BAS */
    4482         623 :   B = cgetg(lF, t_MAT);
    4483         623 :   dB= cgetg(lF, t_VEC);
    4484        2947 :   for (j = 1; j < lF; j++)
    4485             :   {
    4486        2324 :     GEN g = gel(vF, j); /* t_MF_DIV */
    4487        2324 :     gel(B,j) = RgM_RgC_mul(M, gmael(g,2,3));
    4488        2324 :     gel(dB,j)= gmael(g,2,4);
    4489             :   }
    4490         623 :   f = mfcoefsser(gel(F,3),n);
    4491         623 :   a0 = polcoef_i(f, 0, -1);
    4492         623 :   if (gequal0(a0) || gequal1(a0))
    4493         322 :     a0 = NULL;
    4494             :   else
    4495         301 :     f = gdiv(ser_unscale(f, a0), a0);
    4496         623 :   fc = ginv(f);
    4497        2947 :   for (j = 1; j < lF; j++)
    4498             :   {
    4499        2324 :     pari_sp av = avma;
    4500        2324 :     GEN LISer = RgV_to_ser_full(gel(B,j)), f;
    4501        2324 :     if (a0) LISer = gdiv(ser_unscale(LISer, a0), a0);
    4502        2324 :     f = gmul(LISer, fc);
    4503        2324 :     if (a0) f = ser_unscale(f, ginv(a0));
    4504        2324 :     f = sertocol(f); setlg(f, n+2);
    4505        2324 :     if (!gequal1(gel(dB,j))) f = RgC_Rg_div(f, gel(dB,j));
    4506        2324 :     gel(B,j) = gerepileupto(av,f);
    4507             :   }
    4508         623 :   if (V) B = gmodulo(QabM_tracerel(V, 0, B), gel(V,1));
    4509         623 :   return B;
    4510             : }
    4511             : 
    4512             : static GEN
    4513         350 : mfheckemat_mfcoefs(GEN mf, GEN B, GEN DATA)
    4514             : {
    4515         350 :   GEN Mindex = MF_get_Mindex(mf), Minv = MF_get_Minv(mf);
    4516         350 :   long j, l = lg(B), sb = mfsturm_mf(mf);
    4517         350 :   GEN b = MF_get_basis(mf), Q = cgetg(l, t_VEC);
    4518        1827 :   for (j = 1; j < l; j++)
    4519             :   {
    4520        1477 :     GEN v = hecke_i(sb, 1, gel(B,j), gel(b,j), DATA); /* Tn b[j] */
    4521        1477 :     settyp(v,t_COL); gel(Q,j) = vecpermute(v, Mindex);
    4522             :   }
    4523         350 :   return Minv_RgM_mul(Minv,Q);
    4524             : }
    4525             : /* T_p^2, p prime, 1/2-integral weight; B = mfcoefs(mf,sb*p^2,1) or (mf,sb,p^2)
    4526             :  * if p|N */
    4527             : static GEN
    4528           7 : mfheckemat_mfcoefs_p2(GEN mf, long p, GEN B)
    4529             : {
    4530           7 :   pari_sp av = avma;
    4531           7 :   GEN DATA = heckef2_data(MF_get_N(mf), p*p);
    4532           7 :   return gerepileupto(av, mfheckemat_mfcoefs(mf, B, DATA));
    4533             : }
    4534             : /* convert Mindex from row-index to mfcoef indexation: a(n) is stored in
    4535             :  * mfcoefs()[n+1], so subtract 1 from all indices */
    4536             : static GEN
    4537          49 : Mindex_as_coef(GEN mf)
    4538             : {
    4539          49 :   GEN v, Mindex = MF_get_Mindex(mf);
    4540          49 :   long i, l = lg(Mindex);
    4541          49 :   v = cgetg(l, t_VECSMALL);
    4542         210 :   for (i = 1; i < l; i++) v[i] = Mindex[i]-1;
    4543          49 :   return v;
    4544             : }
    4545             : /* T_p, p prime; B = mfcoefs(mf,sb*p,1) or (mf,sb,p) if p|N; integral weight */
    4546             : static GEN
    4547          35 : mfheckemat_mfcoefs_p(GEN mf, long p, GEN B)
    4548             : {
    4549          35 :   pari_sp av = avma;
    4550          35 :   GEN vm, Q, C, Minv = MF_get_Minv(mf);
    4551          35 :   long lm, k, i, j, l = lg(B), N = MF_get_N(mf);
    4552             : 
    4553          35 :   if (N % p == 0) return Minv_RgM_mul(Minv, rowpermute(B, MF_get_Mindex(mf)));
    4554          21 :   k = MF_get_k(mf);
    4555          21 :   C = gmul(mfchareval(MF_get_CHI(mf), p), powuu(p, k-1));
    4556          21 :   vm = Mindex_as_coef(mf); lm = lg(vm);
    4557          21 :   Q = cgetg(l, t_MAT);
    4558         147 :   for (j = 1; j < l; j++) gel(Q,j) = cgetg(lm, t_COL);
    4559         147 :   for (i = 1; i < lm; i++)
    4560             :   {
    4561         126 :     long m = vm[i], mp = m*p;
    4562         126 :     GEN Cm = (m % p) == 0? C : NULL;
    4563        1260 :     for (j = 1; j < l; j++)
    4564             :     {
    4565        1134 :       GEN S = gel(B,j), s = gel(S, mp + 1);
    4566        1134 :       if (Cm) s = gadd(s, gmul(C, gel(S, m/p + 1)));
    4567        1134 :       gcoeff(Q, i, j) = s;
    4568             :     }
    4569             :   }
    4570          21 :   return gerepileupto(av, Minv_RgM_mul(Minv,Q));
    4571             : }
    4572             : /* Matrix of T(p), p prime, dim(mf) > 0 and integral weight */
    4573             : static GEN
    4574         343 : mfheckemat_p(GEN mf, long p)
    4575             : {
    4576         343 :   pari_sp av = avma;
    4577         343 :   long N = MF_get_N(mf), sb = mfsturm_mf(mf);
    4578         343 :   GEN B = (N % p)? mfcoefs_mf(mf, sb * p, 1): mfcoefs_mf(mf, sb, p);
    4579         343 :   return gerepileupto(av, mfheckemat_mfcoefs(mf, B, hecke_data(N,p)));
    4580             : }
    4581             : 
    4582             : /* mf_NEW != (0), weight > 1, p prime. Use
    4583             :  * T(p) T(j) = T(j*p) + p^{k-1} \chi(p) 1_{p | j, p \nmid N} T(j/p) */
    4584             : static GEN
    4585         882 : mfnewmathecke_p(GEN mf, long p)
    4586             : {
    4587         882 :   pari_sp av = avma;
    4588         882 :   GEN tf, vj = MFnew_get_vj(mf), CHI = MF_get_CHI(mf);
    4589         882 :   GEN Mindex = MF_get_Mindex(mf), Minv = MF_get_Minv(mf);
    4590         882 :   long N = MF_get_N(mf), k = MF_get_k(mf);
    4591         882 :   long i, j, lvj = lg(vj), lim = vj[lvj-1] * p;
    4592         882 :   GEN M, perm, V, need = zero_zv(lim);
    4593         882 :   GEN C = (N % p)? gmul(mfchareval(CHI,p), powuu(p,k-1)): NULL;
    4594         882 :   tf = mftraceform_new(N, k, CHI);
    4595        3801 :   for (i = 1; i < lvj; i++)
    4596             :   {
    4597        2919 :     j = vj[i]; need[j*p] = 1;
    4598        2919 :     if (N % p && j % p == 0) need[j/p] = 1;
    4599             :   }
    4600         882 :   perm = zero_zv(lim);
    4601         882 :   V = cgetg(lim+1, t_VEC);
    4602       12243 :   for (i = j = 1; i <= lim; i++)
    4603       11361 :     if (need[i]) { gel(V,j) = mfhecke_i(i, N, tf); perm[i] = j; j++; }
    4604         882 :   setlg(V, j);
    4605         882 :   V = bhnmat_extend_nocache(NULL, N, mfsturm_mf(mf), 1, V);
    4606         882 :   V = rowpermute(V, Mindex); /* V[perm[i]] = coeffs(T_i newtrace) */
    4607         882 :   M = cgetg(lvj, t_MAT);
    4608        3801 :   for (i = 1; i < lvj; i++)
    4609             :   {
    4610             :     GEN t;
    4611        2919 :     j = vj[i]; t = gel(V, perm[j*p]);
    4612        2919 :     if (C && j % p == 0) t = RgC_add(t, RgC_Rg_mul(gel(V, perm[j/p]),C));
    4613        2919 :     gel(M,i) = t;
    4614             :   }
    4615         882 :   return gerepileupto(av, Minv_RgM_mul(Minv, M));
    4616             : }
    4617             : 
    4618             : GEN
    4619          77 : mfheckemat(GEN mf, GEN vn)
    4620             : {
    4621          77 :   pari_sp av = avma;
    4622          77 :   long lv, lvP, i, N, dim, nk, dk, p, sb, flint = (typ(vn)==t_INT);
    4623             :   GEN CHI, res, vT, FA, B, vP;
    4624             : 
    4625          77 :   mf = checkMF(mf);
    4626          77 :   if (typ(vn) != t_VECSMALL) vn = gtovecsmall(vn);
    4627          77 :   N = MF_get_N(mf); CHI = MF_get_CHI(mf); Qtoss(MF_get_gk(mf), &nk, &dk);
    4628          77 :   dim = MF_get_dim(mf);
    4629          77 :   lv = lg(vn);
    4630          77 :   res = cgetg(lv, t_VEC);
    4631          77 :   FA = cgetg(lv, t_VEC);
    4632          77 :   vP = cgetg(lv, t_VEC);
    4633          77 :   vT = const_vec(vecsmall_max(vn), NULL);
    4634         182 :   for (i = 1; i < lv; i++)
    4635             :   {
    4636         105 :     ulong n = (ulong)labs(vn[i]);
    4637             :     GEN fa;
    4638         105 :     if (!n) pari_err_TYPE("mfheckemat", vn);
    4639         105 :     if (dk == 1 || uissquareall(n, &n)) fa = myfactoru(n);
    4640           0 :     else { n = 0; fa = myfactoru(1); } /* dummy: T_{vn[i]} = 0 */
    4641         105 :     vn[i] = n;
    4642         105 :     gel(FA,i) = fa;
    4643         105 :     gel(vP,i) = gel(fa,1);
    4644             :   }
    4645          77 :   vP = shallowconcat1(vP); vecsmall_sort(vP);
    4646          77 :   vP = vecsmall_uniq_sorted(vP); /* all primes occurring in vn */
    4647          77 :   lvP = lg(vP); if (lvP == 1) goto END;
    4648          56 :   p = vP[lvP-1];
    4649          56 :   sb = mfsturm_mf(mf);
    4650          56 :   if (dk == 1 && nk != 1 && MF_get_space(mf) == mf_NEW)
    4651          21 :     B = NULL; /* special purpose mfnewmathecke_p is faster */
    4652          35 :   else if (lvP == 2 && N % p == 0)
    4653          21 :     B = mfcoefs_mf(mf, sb, dk==2? p*p: p); /* single prime | N, can optimize */
    4654             :   else
    4655          14 :     B = mfcoefs_mf(mf, sb * (dk==2? p*p: p), 1); /* general initialization */
    4656         126 :   for (i = 1; i < lvP; i++)
    4657             :   {
    4658          70 :     long j, l, q, e = 1;
    4659             :     GEN C, Tp, u1, u0;
    4660          70 :     p = vP[i];
    4661         189 :     for (j = 1; j < lv; j++) e = maxss(e, z_lval(vn[j], p));
    4662          70 :     if (!B)
    4663          28 :       Tp = mfnewmathecke_p(mf, p);
    4664          42 :     else if (dk == 2)
    4665           7 :       Tp = mfheckemat_mfcoefs_p2(mf,p, (lvP==2||N%p)? B: matdeflate(sb,p*p,B));
    4666             :     else
    4667          35 :       Tp = mfheckemat_mfcoefs_p(mf, p, (lvP==2||N%p)? B: matdeflate(sb,p,B));
    4668          70 :     gel(vT, p) = Tp;
    4669          70 :     if (e == 1) continue;
    4670          14 :     u0 = gen_1;
    4671          14 :     if (dk == 2)
    4672             :     {
    4673           0 :       C = N % p? gmul(mfchareval(CHI,p*p), powuu(p, nk-2)): NULL;
    4674           0 :       if (e == 2) u0 = uutoQ(p+1,p); /* special case T_{p^4} */
    4675             :     }
    4676             :     else
    4677          14 :       C = N % p? gmul(mfchareval(CHI,p),   powuu(p, nk-1)): NULL;
    4678          28 :     for (u1=Tp, q=p, l=2; l <= e; l++)
    4679             :     { /* u0 = T_{p^{l-2}}, u1 = T_{p^{l-1}} for l > 2 */
    4680          14 :       GEN v = gmul(Tp, u1);
    4681          14 :       if (C) v = gsub(v, gmul(C, u0));
    4682             :       /* q = p^l, vT[q] = T_q for k integer else T_{q^2} */
    4683          14 :       q *= p; u0 = u1; gel(vT, q) = u1 = v;
    4684             :     }
    4685             :   }
    4686          56 : END:
    4687             :   /* vT[p^e] = T_{p^e} for all p^e occurring below */
    4688         182 :   for (i = 1; i < lv; i++)
    4689             :   {
    4690         105 :     long n = vn[i], j, lP;
    4691             :     GEN fa, P, E, M;
    4692         105 :     if (n == 0) { gel(res,i) = zeromat(dim,dim); continue; }
    4693         105 :     if (n == 1) { gel(res,i) = matid(dim); continue; }
    4694          77 :     fa = gel(FA,i);
    4695          77 :     P = gel(fa,1); lP = lg(P);
    4696          77 :     E = gel(fa,2); M = gel(vT, upowuu(P[1], E[1]));
    4697          84 :     for (j = 2; j < lP; j++) M = RgM_mul(M, gel(vT, upowuu(P[j], E[j])));
    4698          77 :     gel(res,i) = M;
    4699             :   }
    4700          77 :   if (flint) res = gel(res,1);
    4701          77 :   return gerepilecopy(av, res);
    4702             : }
    4703             : 
    4704             : /* f = \sum_i v[i] T_listj[i] (Trace Form) attached to v; replace by f/a_1(f) */
    4705             : static GEN
    4706        1463 : mf_normalize(GEN mf, GEN v)
    4707             : {
    4708        1463 :   GEN c, dc = NULL, M = MF_get_M(mf), Mindex = MF_get_Mindex(mf);
    4709        1463 :   v = Q_primpart(v);
    4710        1463 :   c = RgMrow_RgC_mul(M, v, 2); /* a_1(f) */
    4711        1463 :   if (gequal1(c)) return v;
    4712         882 :   if (typ(c) == t_POL) c = gmodulo(c, mfcharpol(MF_get_CHI(mf)));
    4713         882 :   if (typ(c) == t_POLMOD && varn(gel(c,1)) == 1 && degpol(gel(c,1)) >= 40
    4714           7 :                          && Mindex[1] == 2
    4715           7 :                          && mfcharorder(MF_get_CHI(mf)) <= 2)
    4716           7 :   { /* normalize using expansion at infinity (small coefficients) */
    4717           7 :     GEN w, P = gel(c,1), a1 = gel(c,2);
    4718           7 :     long i, l = lg(Mindex);
    4719           7 :     w = cgetg(l, t_COL);
    4720           7 :     gel(w,1) = gen_1;
    4721         280 :     for (i = 2; i < l; i++)
    4722             :     {
    4723         273 :       c = liftpol_shallow(RgMrow_RgC_mul(M, v, Mindex[i]));
    4724         273 :       gel(w,i) = QXQ_div(c, a1, P);
    4725             :     }
    4726             :     /* w = expansion at oo of normalized form */
    4727           7 :     v = Minv_RgC_mul(MF_get_Minv(mf), Q_remove_denom(w, &dc));
    4728           7 :     v = gmodulo(v, P); /* back to mfbasis coefficients */
    4729             :   }
    4730             :   else
    4731             :   {
    4732         875 :     c = ginv(c);
    4733         875 :     if (typ(c) == t_POLMOD) c = Q_remove_denom(c, &dc);
    4734         875 :     v = RgC_Rg_mul(v, c);
    4735             :   }
    4736         882 :   if (dc) v = RgC_Rg_div(v, dc);
    4737         882 :   return v;
    4738             : }
    4739             : static void
    4740         427 : pol_red(GEN NF, GEN *pP, GEN *pa, long flag)
    4741             : {
    4742         427 :   GEN dP, a, P = *pP;
    4743         427 :   long d = degpol(P);
    4744             : 
    4745         427 :   *pa = a = pol_x(varn(P));
    4746         427 :   if (d * (NF ? nf_get_degree(NF): 1) > 30) return;
    4747             : 
    4748         420 :   dP = RgX_disc(P);
    4749         420 :   if (typ(dP) != t_INT)
    4750          98 :   { dP = gnorm(dP); if (typ(dP) != t_INT) pari_err_BUG("mfnewsplit"); }
    4751         420 :   if (d == 2 || expi(dP) < 62)
    4752             :   {
    4753         385 :     if (expi(dP) < 31)
    4754         385 :       P = NF? rnfpolredabs(NF, P,flag): polredabs0(P,flag);
    4755             :     else
    4756           0 :       P = NF? rnfpolredbest(NF,P,flag): polredbest(P,flag);
    4757         385 :     if (flag)
    4758             :     {
    4759         357 :       a = gel(P,2); if (typ(a) == t_POLMOD) a = gel(a,2);
    4760         357 :       P = gel(P,1);
    4761             :     }
    4762             :   }
    4763         420 :   *pP = P;
    4764         420 :   *pa = a;
    4765             : }
    4766             : 
    4767             : /* Diagonalize and normalize. See mfsplit for meaning of flag. */
    4768             : static GEN
    4769        1057 : mfspclean(GEN mf, GEN mf0, GEN NF, long ord, GEN simplesp, long flag)
    4770             : {
    4771        1057 :   const long vz = 1;
    4772        1057 :   long i, l = lg(simplesp), dim = MF_get_dim(mf);
    4773        1057 :   GEN res = cgetg(l, t_MAT), pols = cgetg(l, t_VEC);
    4774        1057 :   GEN zeros = (mf == mf0)? NULL: zerocol(dim - MF_get_dim(mf0));
    4775        2548 :   for (i = 1; i < l; i++)
    4776             :   {
    4777        1491 :     GEN ATP = gel(simplesp, i), A = gel(ATP,1), P = gel(ATP,3);
    4778        1491 :     long d = degpol(P);
    4779        1491 :     GEN a, v = (flag && d > flag)? NULL: gel(A,1);
    4780        1491 :     if (d == 1) P = pol_x(vz);
    4781             :     else
    4782             :     {
    4783         427 :       pol_red(NF, &P, &a, !!v);
    4784         427 :       if (v)
    4785             :       { /* Mod(a,P) root of charpoly(T), K*gpowers(a) = eigenvector of T */
    4786         399 :         GEN K, den, M = cgetg(d+1, t_MAT), T = gel(ATP,2);
    4787             :         long j;
    4788         399 :         T = shallowtrans(T);
    4789         399 :         gel(M,1) = vec_ei(d,1); /* basis of cyclic vectors */
    4790        1302 :         for (j = 2; j <= d; j++) gel(M,j) = RgM_RgC_mul(T, gel(M,j-1));
    4791         399 :         M = Q_primpart(M);
    4792         133 :         K = NF? ZabM_inv(liftpol_shallow(M), nf_get_pol(NF), ord, &den)
    4793         399 :               : ZM_inv(M,&den);
    4794         399 :         K = shallowtrans(K);
    4795         399 :         v = gequalX(a)? pol_x_powers(d, vz): RgXQ_powers(a, d-1, P);
    4796         399 :         v = gmodulo(RgM_RgC_mul(A, RgM_RgC_mul(K,v)), P);
    4797             :       }
    4798             :     }
    4799        1491 :     if (v)
    4800             :     {
    4801        1463 :       v = mf_normalize(mf0, v); if (zeros) v = shallowconcat(zeros,v);
    4802        1463 :       gel(res,i) = v; if (flag) setlg(res,i+1);
    4803             :     }
    4804             :     else
    4805          28 :       gel(res,i) = zerocol(dim);
    4806        1491 :     gel(pols,i) = P;
    4807             :   }
    4808        1057 :   return mkvec2(res, pols);
    4809             : }
    4810             : 
    4811             : /* return v = v_{X-r}(P), and set Z = P / (X-r)^v */
    4812             : static long
    4813          70 : RgX_valrem_root(GEN P, GEN r, GEN *Z)
    4814             : {
    4815             :   long v;
    4816         140 :   for (v = 0; degpol(P); v++)
    4817             :   {
    4818         140 :     GEN t, Q = RgX_div_by_X_x(P, r, &t);
    4819         140 :     if (!gequal0(t)) break;
    4820          70 :     P = Q;
    4821             :   }
    4822          70 :   *Z = P; return v;
    4823             : }
    4824             : static GEN
    4825        1484 : mynffactor(GEN NF, GEN P, long dimlim)
    4826             : {
    4827             :   long i, l, v;
    4828             :   GEN R, E;
    4829        1484 :   if (dimlim != 1)
    4830             :   {
    4831         924 :     R = NF? nffactor(NF, P): QX_factor(P);
    4832         924 :     if (!dimlim) return R;
    4833          21 :     E = gel(R,2);
    4834          21 :     R = gel(R,1); l = lg(R);
    4835          98 :     for (i = 1; i < l; i++)
    4836          91 :       if (degpol(gel(R,i)) > dimlim) break;
    4837          21 :     if (i == 1) return NULL;
    4838          21 :     setlg(E,i);
    4839          21 :     setlg(R,i); return mkmat2(R, E);
    4840             :   }
    4841             :   /* dimlim = 1 */
    4842         560 :   R = nfroots(NF, P); l = lg(R);
    4843         560 :   if (l == 1) return NULL;
    4844         497 :   v = varn(P);
    4845         497 :   settyp(R, t_COL);
    4846         497 :   if (degpol(P) == l-1)
    4847         441 :     E = const_col(l-1, gen_1);
    4848             :   else
    4849             :   {
    4850          56 :     E = cgetg(l, t_COL);
    4851         126 :     for (i = 1; i < l; i++) gel(E,i) = utoi(RgX_valrem_root(P, gel(R,i), &P));
    4852             :   }
    4853         497 :   R = deg1_from_roots(R, v);
    4854         497 :   return mkmat2(R, E);
    4855             : }
    4856             : 
    4857             : /* Let K be a number field attached to NF (Q if NF = NULL). A K-vector
    4858             :  * space of dimension d > 0 is given by a t_MAT A (n x d, full column rank)
    4859             :  * giving a K-basis, X a section (d x n: left pseudo-inverse of A). Return a
    4860             :  * pair (T, fa), where T is an element of the Hecke algebra (a sum of Tp taken
    4861             :  * from vector vTp) acting on A (a d x d t_MAT) and fa is the factorization of
    4862             :  * its characteristic polynomial, limited to factors of degree <= dimlim if
    4863             :  * dimlim != 0 (return NULL if there are no factors of degree <= dimlim) */
    4864             : static GEN
    4865        1309 : findbestsplit(GEN NF, GEN vTp, GEN A, GEN X, long dimlim, long vz)
    4866             : {
    4867        1309 :   GEN T = NULL, Tkeep = NULL, fakeep = NULL;
    4868        1309 :   long lmax = 0, i, lT = lg(vTp);
    4869        1729 :   for (i = 1; i < lT; i++)
    4870             :   {
    4871        1729 :     GEN D, P, E, fa, TpA = gel(vTp,i);
    4872             :     long l;
    4873        2730 :     if (typ(TpA) == t_INT) break;
    4874        1484 :     if (lg(TpA) > lg(A)) TpA = RgM_mul(X, RgM_mul(TpA, A)); /* Tp | A */
    4875        1484 :     T = T ? RgM_add(T, TpA) : TpA;
    4876        1484 :     if (!NF) { P = QM_charpoly_ZX(T); setvarn(P, vz); }
    4877             :     else
    4878             :     {
    4879         273 :       P = charpoly(Q_remove_denom(T, &D), vz);
    4880         273 :       if (D) P = gdiv(RgX_unscale(P, D), powiu(D, degpol(P)));
    4881             :     }
    4882        1484 :     fa = mynffactor(NF, P, dimlim);
    4883        1484 :     if (!fa) return NULL;
    4884        1421 :     E = gel(fa, 2);
    4885             :     /* characteristic polynomial is separable ? */
    4886        1421 :     if (isint1(vecmax(E))) { Tkeep = T; fakeep = fa; break; }
    4887         420 :     l = lg(E);
    4888             :     /* characteristic polynomial has more factors than before ? */
    4889         420 :     if (l > lmax) { lmax = l; Tkeep = T; fakeep = fa; }
    4890             :   }
    4891        1246 :   return mkvec2(Tkeep, fakeep);
    4892             : }
    4893             : 
    4894             : static GEN
    4895         210 : nfcontent(GEN nf, GEN v)
    4896             : {
    4897         210 :   long i, l = lg(v);
    4898         210 :   GEN c = gel(v,1);
    4899        1134 :   for (i = 2; i < l; i++) c = idealadd(nf, c, gel(v,i));
    4900         210 :   if (typ(c) == t_MAT && gequal1(gcoeff(c,1,1))) c = gen_1;
    4901         210 :   return c;
    4902             : }
    4903             : static GEN
    4904         329 : nf_primpart(GEN nf, GEN B)
    4905             : {
    4906         329 :   switch(typ(B))
    4907             :   {
    4908         210 :     case t_COL:
    4909             :     {
    4910         210 :       GEN A = matalgtobasis(nf, B), c = nfcontent(nf, A);
    4911         210 :       if (typ(c) == t_INT) return B;
    4912          21 :       c = idealred_elt(nf,c);
    4913          21 :       A = Q_primpart( nfC_nf_mul(nf, A, Q_primpart(nfinv(nf,c))) );
    4914          21 :       A = liftpol_shallow( matbasistoalg(nf, A) );
    4915          21 :       if (gexpo(A) > gexpo(B)) A = B;
    4916          21 :       return A;
    4917             :     }
    4918         119 :     case t_MAT:
    4919             :     {
    4920             :       long i, l;
    4921         119 :       GEN A = cgetg_copy(B, &l);
    4922         329 :       for (i = 1; i < l; i++) gel(A,i) = nf_primpart(nf, gel(B,i));
    4923         119 :       return A;
    4924             :     }
    4925           0 :     default:
    4926           0 :       pari_err_TYPE("nf_primpart", B);
    4927             :       return NULL; /*LCOV_EXCL_LINE*/
    4928             :   }
    4929             : }
    4930             : 
    4931             : /* rotate entries of v to accomodate new entry 'x' (push out oldest entry) */
    4932             : static void
    4933        1197 : vecpush(GEN v, GEN x)
    4934             : {
    4935             :   long i;
    4936        5985 :   for (i = lg(v)-1; i > 1; i--) gel(v,i) = gel(v,i-1);
    4937        1197 :   gel(v,1) = x;
    4938        1197 : }
    4939             : 
    4940             : /* sort t_VEC of vector spaces by increasing dimension */
    4941             : static GEN
    4942        1057 : sort_by_dim(GEN v)
    4943             : {
    4944        1057 :   long i, l = lg(v);
    4945        1057 :   GEN D = cgetg(l, t_VECSMALL);
    4946        2548 :   for (i = 1; i < l; i++) D[i] = lg(gmael(v,i,2));
    4947        1057 :   return vecpermute(v , vecsmall_indexsort(D));
    4948             : }
    4949             : static GEN
    4950        1057 : split_starting_space(GEN mf)
    4951             : {
    4952        1057 :   long d = MF_get_dim(mf), d2;
    4953        1057 :   GEN id = matid(d);
    4954        1057 :   switch(MF_get_space(mf))
    4955             :   {
    4956        1050 :     case mf_NEW:
    4957        1050 :     case mf_CUSP: return mkvec2(id, id);
    4958             :   }
    4959           7 :   d2 = lg(MF_get_S(mf))-1;
    4960           7 :   return mkvec2(vecslice(id, d-d2+1,d),
    4961             :                 shallowconcat(zeromat(d2,d-d2),matid(d2)));
    4962             : }
    4963             : /* If dimlim > 0, keep only the dimension <= dimlim eigenspaces.
    4964             :  * See mfsplit for the meaning of flag. */
    4965             : static GEN
    4966        1456 : split_ii(GEN mf, long dimlim, long flag, GEN vSP, long *pnewd)
    4967             : {
    4968             :   forprime_t iter;
    4969        1456 :   GEN CHI = MF_get_CHI(mf), empty = cgetg(1, t_VEC), mf0 = mf;
    4970             :   GEN NF, POLCYC, todosp, Tpbigvec, simplesp;
    4971        1456 :   long N = MF_get_N(mf), k = MF_get_k(mf);
    4972        1456 :   long ord, FC, NEWT, dimsimple = 0, newd = -1;
    4973        1456 :   const long NBH = 5, vz = 1;
    4974             :   ulong p;
    4975             : 
    4976        1456 :   switch(MF_get_space(mf))
    4977             :   {
    4978        1169 :     case mf_NEW: break;
    4979         280 :     case mf_CUSP:
    4980             :     case mf_FULL:
    4981             :     {
    4982             :       GEN CHIP;
    4983         280 :       if (k > 1) { mf0 = mfinittonew(mf); break; }
    4984         259 :       CHIP = mfchartoprimitive(CHI, NULL);
    4985         259 :       newd = lg(MF_get_S(mf))-1 - mfolddim_i(N, k, CHIP, vSP);
    4986         259 :       break;
    4987             :     }
    4988           7 :     default: pari_err_TYPE("mfsplit [space does not contain newspace]", mf);
    4989             :       return NULL; /*LCOV_EXCL_LINE*/
    4990             :   }
    4991        1449 :   if (newd < 0) newd = mf0? MF_get_dim(mf0): 0;
    4992        1449 :   *pnewd = newd;
    4993        1449 :   if (!newd) return mkvec2(cgetg(1, t_MAT), empty);
    4994             : 
    4995        1057 :   NEWT = (k > 1 && MF_get_space(mf0) == mf_NEW);
    4996        1057 :   todosp = mkvec( split_starting_space(mf0) );
    4997        1057 :   simplesp = empty;
    4998        1057 :   FC = mfcharconductor(CHI);
    4999        1057 :   ord = mfcharorder(CHI);
    5000        1057 :   if (ord <= 2) NF = POLCYC = NULL;
    5001             :   else
    5002             :   {
    5003         203 :     POLCYC = mfcharpol(CHI);
    5004         203 :     NF = nfinit(POLCYC,DEFAULTPREC);
    5005             :   }
    5006        1057 :   Tpbigvec = zerovec(NBH);
    5007        1057 :   u_forprime_init(&iter, 2, ULONG_MAX);
    5008        1484 :   while (dimsimple < newd && (p = u_forprime_next(&iter)))
    5009             :   {
    5010             :     GEN nextsp;
    5011             :     long ind;
    5012        1484 :     if (N % (p*p) == 0 && N/p % FC == 0) continue; /* T_p = 0 in this case */
    5013        1197 :     vecpush(Tpbigvec, NEWT? mfnewmathecke_p(mf0,p): mfheckemat_p(mf0,p));
    5014        1197 :     nextsp = empty;
    5015        1582 :     for (ind = 1; ind < lg(todosp); ind++)
    5016             :     {
    5017        1309 :       GEN tmp = gel(todosp, ind), fa, P, E, D, Tp, DTp;
    5018        1309 :       GEN A = gel(tmp, 1);
    5019        1309 :       GEN X = gel(tmp, 2);
    5020             :       long lP, i;
    5021        1309 :       tmp = findbestsplit(NF, Tpbigvec, A, X, dimlim, vz);
    5022        1428 :       if (!tmp) continue; /* nothing there */
    5023        1246 :       Tp = gel(tmp, 1);
    5024        1246 :       fa = gel(tmp, 2);
    5025        1246 :       P = gel(fa, 1);
    5026        1246 :       E = gel(fa, 2); lP = lg(P);
    5027             :       /* lP > 1 */
    5028        1246 :       if (DEBUGLEVEL) err_printf("Exponents = %Ps\n", E);
    5029        1246 :       if (lP == 2)
    5030             :       {
    5031         854 :         GEN P1 = gel(P,1);
    5032         854 :         long e1 = itos(gel(E,1)), d1 = degpol(P1);
    5033         854 :         if (e1 * d1 == lg(Tp)-1)
    5034             :         {
    5035         805 :           if (e1 > 1) nextsp = vec_append(nextsp, mkvec2(A,X));
    5036             :           else
    5037             :           { /* simple module */
    5038         707 :             simplesp = vec_append(simplesp, mkvec3(A,Tp,P1));
    5039         945 :             if ((dimsimple += d1) == newd) goto END;
    5040             :           }
    5041         119 :           continue;
    5042             :         }
    5043             :       }
    5044             :       /* Found splitting */
    5045         441 :       DTp = Q_remove_denom(Tp, &D);
    5046        1204 :       for (i = 1; i < lP; i++)
    5047             :       {
    5048        1001 :         GEN Ai, Xi, dXi, AAi, v, y, Pi = gel(P,i);
    5049        1001 :         Ai = RgX_RgM_eval(D? RgX_rescale(Pi,D): Pi, DTp);
    5050        1001 :         Ai = QabM_ker(Ai, POLCYC, ord);
    5051        1001 :         if (NF) Ai = nf_primpart(NF, Ai);
    5052             : 
    5053        1001 :         AAi = RgM_mul(A, Ai);
    5054             :         /* gives section, works on nonsquare matrices */
    5055        1001 :         Xi = QabM_pseudoinv(Ai, POLCYC, ord, &v, &dXi);
    5056        1001 :         Xi = RgM_Rg_div(Xi, dXi);
    5057        1001 :         y = gel(v,1);
    5058        1001 :         if (isint1(gel(E,i)))
    5059             :         {
    5060         784 :           GEN Tpi = RgM_mul(Xi, RgM_mul(rowpermute(Tp,y), Ai));
    5061         784 :           simplesp = vec_append(simplesp, mkvec3(AAi, Tpi, Pi));
    5062         784 :           if ((dimsimple += degpol(Pi)) == newd) goto END;
    5063             :         }
    5064             :         else
    5065             :         {
    5066         217 :           Xi = RgM_mul(Xi, rowpermute(X,y));
    5067         217 :           nextsp = vec_append(nextsp, mkvec2(AAi, Xi));
    5068             :         }
    5069             :       }
    5070             :     }
    5071         273 :     todosp = nextsp; if (lg(todosp) == 1) break;
    5072             :   }
    5073           0 : END:
    5074        1057 :   if (DEBUGLEVEL) err_printf("end split, need to clean\n");
    5075        1057 :   return mfspclean(mf, mf0, NF, ord, sort_by_dim(simplesp), flag);
    5076             : }
    5077             : static GEN
    5078          28 : dim_filter(GEN v, long dim)
    5079             : {
    5080          28 :   GEN P = gel(v,2);
    5081          28 :   long j, l = lg(P);
    5082         140 :   for (j = 1; j < l; j++)
    5083         126 :     if (degpol(gel(P,j)) > dim)
    5084             :     {
    5085          14 :       v = mkvec2(vecslice(gel(v,1),1,j-1), vecslice(P,1,j-1));
    5086          14 :       break;
    5087             :     }
    5088          28 :   return v;
    5089             : }
    5090             : static long
    5091         287 : dim_sum(GEN v)
    5092             : {
    5093         287 :   GEN P = gel(v,2);
    5094         287 :   long j, l = lg(P), d = 0;
    5095         707 :   for (j = 1; j < l; j++) d += degpol(gel(P,j));
    5096         287 :   return d;
    5097             : }
    5098             : static GEN
    5099        1134 : split_i(GEN mf, long dimlim, long flag)
    5100        1134 : { long junk; return split_ii(mf, dimlim, flag, NULL, &junk); }
    5101             : /* mf is either already split or output by mfinit. Splitting is done only for
    5102             :  * newspace except in weight 1. If flag = 0 (default) split completely.
    5103             :  * If flag = d > 0, only give the Galois polynomials in degree > d
    5104             :  * Flag is ignored if dimlim = 1. */
    5105             : GEN
    5106          98 : mfsplit(GEN mf0, long dimlim, long flag)
    5107             : {
    5108          98 :   pari_sp av = avma;
    5109          98 :   GEN v, mf = checkMF_i(mf0);
    5110          98 :   if (!mf) pari_err_TYPE("mfsplit", mf0);
    5111          98 :   if ((v = obj_check(mf, MF_SPLIT)))
    5112          28 :   { if (dimlim) v = dim_filter(v, dimlim); }
    5113          70 :   else if (dimlim && (v = obj_check(mf, MF_SPLITN)))
    5114          21 :   { v = (itos(gel(v,1)) >= dimlim)? dim_filter(gel(v,2), dimlim): NULL; }
    5115          98 :   if (!v)
    5116             :   {
    5117             :     long newd;
    5118          70 :     v = split_ii(mf, dimlim, flag, NULL, &newd);
    5119          70 :     if (lg(v) == 1) obj_insert(mf, MF_SPLITN, mkvec2(utoi(dimlim), v));
    5120          70 :     else if (!flag)
    5121             :     {
    5122          49 :       if (dim_sum(v) == newd) obj_insert(mf, MF_SPLIT,v);
    5123          21 :       else obj_insert(mf, MF_SPLITN, mkvec2(utoi(dimlim), v));
    5124             :     }
    5125             :   }
    5126          98 :   return gerepilecopy(av, v);
    5127             : }
    5128             : static GEN
    5129         224 : split(GEN mf) { return split_i(mf,0,0); }
    5130             : GEN
    5131         770 : MF_get_newforms(GEN mf) { return gel(obj_checkbuild(mf,MF_SPLIT,&split),1); }
    5132             : GEN
    5133         581 : MF_get_fields(GEN mf) { return gel(obj_checkbuild(mf,MF_SPLIT,&split),2); }
    5134             : 
    5135             : /*************************************************************************/
    5136             : /*                     Modular forms of Weight 1                         */
    5137             : /*************************************************************************/
    5138             : /* S_1(G_0(N)), small N. Return 1 if definitely empty; return 0 if maybe
    5139             :  * nonempty  */
    5140             : static int
    5141       16632 : wt1empty(long N)
    5142             : {
    5143       16632 :   if (N <= 100) switch (N)
    5144             :   { /* nonempty [32/100] */
    5145        5453 :     case 23: case 31: case 39: case 44: case 46:
    5146             :     case 47: case 52: case 55: case 56: case 57:
    5147             :     case 59: case 62: case 63: case 68: case 69:
    5148             :     case 71: case 72: case 76: case 77: case 78:
    5149             :     case 79: case 80: case 83: case 84: case 87:
    5150             :     case 88: case 92: case 93: case 94: case 95:
    5151        5453 :     case 99: case 100: return 0;
    5152        3549 :     default: return 1;
    5153             :   }
    5154        7630 :   if (N <= 600) switch(N)
    5155             :   { /* empty [111/500] */
    5156         336 :     case 101: case 102: case 105: case 106: case 109:
    5157             :     case 113: case 121: case 122: case 123: case 125:
    5158             :     case 130: case 134: case 137: case 146: case 149:
    5159             :     case 150: case 153: case 157: case 162: case 163:
    5160             :     case 169: case 170: case 173: case 178: case 181:
    5161             :     case 182: case 185: case 187: case 193: case 194:
    5162             :     case 197: case 202: case 205: case 210: case 218:
    5163             :     case 221: case 226: case 233: case 241: case 242:
    5164             :     case 245: case 246: case 250: case 257: case 265:
    5165             :     case 267: case 269: case 274: case 277: case 281:
    5166             :     case 289: case 293: case 298: case 305: case 306:
    5167             :     case 313: case 314: case 317: case 326: case 337:
    5168             :     case 338: case 346: case 349: case 353: case 361:
    5169             :     case 362: case 365: case 369: case 370: case 373:
    5170             :     case 374: case 377: case 386: case 389: case 394:
    5171             :     case 397: case 401: case 409: case 410: case 421:
    5172             :     case 425: case 427: case 433: case 442: case 449:
    5173             :     case 457: case 461: case 466: case 481: case 482:
    5174             :     case 485: case 490: case 493: case 509: case 514:
    5175             :     case 521: case 530: case 533: case 534: case 538:
    5176             :     case 541: case 545: case 554: case 557: case 562:
    5177             :     case 565: case 569: case 577: case 578: case 586:
    5178         336 :     case 593: return 1;
    5179        6979 :     default: return 0;
    5180             :   }
    5181         315 :   return 0;
    5182             : }
    5183             : 
    5184             : static GEN
    5185          28 : initwt1trace(GEN mf)
    5186             : {
    5187          28 :   GEN S = MF_get_S(mf), v, H;
    5188             :   long l, i;
    5189          28 :   if (lg(S) == 1) return mftrivial();
    5190          28 :   H = mfheckemat(mf, Mindex_as_coef(mf));
    5191          28 :   l = lg(H); v = cgetg(l, t_VEC);
    5192          63 :   for (i = 1; i < l; i++) gel(v,i) = gtrace(gel(H,i));
    5193          28 :   v = Minv_RgC_mul(MF_get_Minv(mf), v);
    5194          28 :   return mflineardiv_linear(S, v, 1);
    5195             : }
    5196             : static GEN
    5197          21 : initwt1newtrace(GEN mf)
    5198             : {
    5199          21 :   GEN v, D, S, Mindex, CHI = MF_get_CHI(mf);
    5200          21 :   long FC, lD, i, sb, N1, N2, lM, N = MF_get_N(mf);
    5201          21 :   CHI = mfchartoprimitive(CHI, &FC);
    5202          21 :   if (N % FC || mfcharparity(CHI) == 1) return mftrivial();
    5203          21 :   D = mydivisorsu(N/FC); lD = lg(D);
    5204          21 :   S = MF_get_S(mf);
    5205          21 :   if (lg(S) == 1) return mftrivial();
    5206          21 :   N2 = newd_params2(N);
    5207          21 :   N1 = N / N2;
    5208          21 :   Mindex = MF_get_Mindex(mf);
    5209          21 :   lM = lg(Mindex);
    5210          21 :   sb = Mindex[lM-1];
    5211          21 :   v = zerovec(sb+1);
    5212          42 :   for (i = 1; i < lD; i++)
    5213             :   {
    5214          21 :     long M = FC*D[i], j;
    5215          21 :     GEN tf = initwt1trace(M == N? mf: mfinit_Nkchi(M, 1, CHI, mf_CUSP, 0));
    5216             :     GEN listd, w;
    5217          21 :     if (mf_get_type(tf) == t_MF_CONST) continue;
    5218          21 :     w = mfcoefs_i(tf, sb, 1);
    5219          21 :     if (M == N) { v = gadd(v, w); continue; }
    5220           0 :     listd = mydivisorsu(u_ppo(ugcd(N/M, N1), FC));
    5221           0 :     for (j = 1; j < lg(listd); j++)
    5222             :     {
    5223           0 :       long d = listd[j], d2 = d*d; /* coprime to FC */
    5224           0 :       GEN dk = mfchareval(CHI, d);
    5225           0 :       long NMd = N/(M*d), m;
    5226           0 :       for (m = 1; m <= sb/d2; m++)
    5227             :       {
    5228           0 :         long be = mubeta2(NMd, m);
    5229           0 :         if (be)
    5230             :         {
    5231           0 :           GEN c = gmul(dk, gmulsg(be, gel(w, m+1)));
    5232           0 :           long n = m*d2;
    5233           0 :           gel(v, n+1) = gadd(gel(v, n+1), c);
    5234             :         }
    5235             :       }
    5236             :     }
    5237             :   }
    5238          21 :   if (gequal0(gel(v,2))) return mftrivial();
    5239          21 :   v = vecpermute(v,Mindex);
    5240          21 :   v = Minv_RgC_mul(MF_get_Minv(mf), v);
    5241          21 :   return mflineardiv_linear(S, v, 1);
    5242             : }
    5243             : 
    5244             : /* i*p + 1, i*p < lim corresponding to a_p(f_j), a_{2p}(f_j)...  */
    5245             : static GEN
    5246        1834 : pindices(long p, long lim)
    5247             : {
    5248        1834 :   GEN v = cgetg(lim, t_VECSMALL);
    5249             :   long i, ip;
    5250       22190 :   for (i = 1, ip = p + 1; ip < lim; i++, ip += p) v[i] = ip;
    5251        1834 :   setlg(v, i); return v;
    5252             : }
    5253             : 
    5254             : /* assume !wt1empty(N), in particular N>25 */
    5255             : /* Returns [[lim,p], mf (weight 2), p*lim x dim matrix] */
    5256             : static GEN
    5257        1834 : mf1_pre(long N)
    5258             : {
    5259             :   pari_timer tt;
    5260             :   GEN mf, v, L, I, M, Minv, den;
    5261             :   long B, lim, LIM, p;
    5262             : 
    5263        1834 :   if (DEBUGLEVEL) timer_start(&tt);
    5264        1834 :   mf = mfinit_Nkchi(N, 2, mfchartrivial(), mf_CUSP, 0);
    5265        1834 :   if (DEBUGLEVEL)
    5266           0 :     timer_printf(&tt, "mf1basis [pre]: S_2(%ld), dim = %ld",
    5267             :                  N, MF_get_dim(mf));
    5268        1834 :   M = MF_get_M(mf); Minv = MF_get_Minv(mf); den = gel(Minv,2);
    5269        1834 :   B = mfsturm_mf(mf);
    5270        1834 :   if (uisprime(N))
    5271             :   {
    5272         392 :     lim = 2 * MF_get_dim(mf); /* ensure mfstabiter's first kernel ~ square */
    5273         392 :     p = 2;
    5274             :   }
    5275             :   else
    5276             :   {
    5277             :     forprime_t S;
    5278        1442 :     u_forprime_init(&S, 2, N);
    5279        2576 :     while ((p = u_forprime_next(&S)))
    5280        2576 :       if (N % p) break;
    5281        1442 :     lim = B + 1;
    5282             :   }
    5283        1834 :   LIM = (N & (N - 1))? 2 * lim: 3 * lim; /* N power of 2 ? */
    5284        1834 :   L = mkvecsmall4(lim, LIM, mfsturmNk(N,1), p);
    5285        1834 :   M = bhnmat_extend_nocache(M, N, LIM-1, 1, MF_get_S(mf));
    5286        1834 :   if (DEBUGLEVEL) timer_printf(&tt, "mf1basis [pre]: bnfmat_extend");
    5287        1834 :   v = pindices(p, LIM);
    5288        1834 :   if (!LIM) return mkvec4(L, mf, M, v);
    5289        1834 :   I = RgM_Rg_div(ZM_mul(rowslice(M, B+2, LIM), gel(Minv,1)), den);
    5290        1834 :   I = Q_remove_denom(I, &den);
    5291        1834 :   if (DEBUGLEVEL) timer_printf(&tt, "mf1basis [prec]: Iden");
    5292        1834 :   return mkvec5(L, mf, M, v, mkvec2(I, den));
    5293             : }
    5294             : 
    5295             : /* lg(A) > 1, E a t_POL */
    5296             : static GEN
    5297         686 : mfmatsermul(GEN A, GEN E)
    5298             : {
    5299         686 :   long j, l = lg(A), r = nbrows(A);
    5300         686 :   GEN M = cgetg(l, t_MAT);
    5301         686 :   E = RgXn_red_shallow(E, r+1);
    5302        5866 :   for (j = 1; j < l; j++)
    5303             :   {
    5304        5180 :     GEN c = RgV_to_RgX(gel(A,j), 0);
    5305        5180 :     gel(M, j) = RgX_to_RgC(RgXn_mul(c, E, r+1), r);
    5306             :   }
    5307         686 :   return M;
    5308             : }
    5309             : /* lg(Ap) > 1, Ep an Flxn */
    5310             : static GEN
    5311        1141 : mfmatsermul_Fl(GEN Ap, GEN Ep, ulong p)
    5312             : {
    5313        1141 :   long j, l = lg(Ap), r = nbrows(Ap);
    5314        1141 :   GEN M = cgetg(l, t_MAT);
    5315       42630 :   for (j = 1; j < l; j++)
    5316             :   {
    5317       41489 :     GEN c = Flv_to_Flx(gel(Ap,j), 0);
    5318       41489 :     gel(M,j) = Flx_to_Flv(Flxn_mul(c, Ep, r+1, p), r);
    5319             :   }
    5320        1141 :   return M;
    5321             : }
    5322             : 
    5323             : /* CHI mod F | N, return mfchar of modulus N.
    5324             :  * FIXME: wasteful, G should be precomputed  */
    5325             : static GEN
    5326       13048 : mfcharinduce(GEN CHI, long N)
    5327             : {
    5328             :   GEN G, chi;
    5329       13048 :   if (mfcharmodulus(CHI) == N) return CHI;
    5330        1463 :   G = znstar0(utoipos(N), 1);
    5331        1463 :   chi = zncharinduce(gel(CHI,1), gel(CHI,2), G);
    5332        1463 :   CHI = leafcopy(CHI);
    5333        1463 :   gel(CHI,1) = G;
    5334        1463 :   gel(CHI,2) = chi; return CHI;
    5335             : }
    5336             : 
    5337             : static GEN
    5338        3983 : gmfcharno(GEN CHI)
    5339             : {
    5340        3983 :   GEN G = gel(CHI,1), chi = gel(CHI,2);
    5341        3983 :   return mkintmod(znconreyexp(G, chi), znstar_get_N(G));
    5342             : }
    5343             : static long
    5344       13664 : mfcharno(GEN CHI)
    5345             : {
    5346       13664 :   GEN n = znconreyexp(gel(CHI,1), gel(CHI,2));
    5347       13664 :   return itou(n);
    5348             : }
    5349             : 
    5350             : /* return k such that minimal mfcharacter in Galois orbit of CHI is CHI^k */
    5351             : static long
    5352       12138 : mfconreyminimize(GEN CHI)
    5353             : {
    5354       12138 :   GEN G = gel(CHI,1), cyc, chi;
    5355       12138 :   cyc = ZV_to_zv(znstar_get_cyc(G));
    5356       12138 :   chi = ZV_to_zv(znconreychar(G, gel(CHI,2)));
    5357       12138 :   return zv_cyc_minimize(cyc, chi, coprimes_zv(mfcharorder(CHI)));
    5358             : }
    5359             : 
    5360             : /* find scalar c such that first nonzero entry of c*v is 1; return c*v */
    5361             : static GEN
    5362        2065 : RgV_normalize(GEN v, GEN *pc)
    5363             : {
    5364        2065 :   long i, l = lg(v);
    5365        5313 :   for (i = 1; i < l; i++)
    5366             :   {
    5367        5313 :     GEN c = gel(v,i);
    5368        5313 :     if (!gequal0(c))
    5369             :     {
    5370        2065 :       if (gequal1(c)) break;
    5371         679 :       *pc = ginv(c); return RgV_Rg_mul(v, *pc);
    5372             :     }
    5373             :   }
    5374        1386 :   *pc = gen_1; return v;
    5375             : }
    5376             : /* pS != NULL; dim > 0 */
    5377             : static GEN
    5378         784 : mftreatdihedral(long N, GEN DIH, GEN POLCYC, long ordchi, GEN *pS)
    5379             : {
    5380         784 :   long l = lg(DIH), lim = mfsturmNk(N, 1), i;
    5381         784 :   GEN Minv, C = cgetg(l, t_VEC), M = cgetg(l, t_MAT);
    5382        2436 :   for (i = 1; i < l; i++)
    5383             :   {
    5384        1652 :     GEN c, v = mfcoefs_i(gel(DIH,i), lim, 1);
    5385        1652 :     gel(M,i) = RgV_normalize(v, &c);
    5386        1652 :     gel(C,i) = Rg_col_ei(c, l-1, i);
    5387             :   }
    5388         784 :   Minv = gel(mfclean(M,POLCYC,ordchi,0),2);
    5389         784 :   M = RgM_Minv_mul(M, Minv);
    5390         784 :   C = RgM_Minv_mul(C, Minv);
    5391         784 :   *pS = vecmflinear(DIH, C); return M;
    5392             : }
    5393             : 
    5394             : /* same mode a maximal ideal above q */
    5395             : static GEN
    5396        2408 : Tpmod(GEN Ap, GEN A, ulong chip, long p, ulong q)
    5397             : {
    5398        2408 :   GEN B = leafcopy(Ap);
    5399        2408 :   long i, ip, l = lg(B);
    5400       86345 :   for (i = 1, ip = p; ip < l; i++, ip += p)
    5401       83937 :     B[ip] = Fl_add(B[ip], Fl_mul(A[i], chip, q), q);
    5402        2408 :   return B;
    5403             : }
    5404             : /* Tp(f_1), ..., Tp(f_d) mod q */
    5405             : static GEN
    5406         301 : matTpmod(GEN Ap, GEN A, ulong chip, long p, ulong q)
    5407             : {
    5408             :   long i, l;
    5409         301 :   GEN B = cgetg_copy(A, &l);
    5410        2709 :   for (i = 1; i < l; i++) gel(B,i) = Tpmod(gel(Ap,i), gel(A,i), chip, p, q);
    5411         301 :   return B;
    5412             : }
    5413             : 
    5414             : /* Ap[i] = a_{p*i}(F), A[i] = a_i(F), i = 1..lim
    5415             :  * Tp(f)[n] = a_{p*n}(f) + chi(p) a_{n/p}(f) * 1_{p | n} */
    5416             : static GEN
    5417         469 : Tp(GEN Ap, GEN A, GEN chip, long p)
    5418             : {
    5419         469 :   GEN B = leafcopy(Ap);
    5420         469 :   long i, ip, l = lg(B);
    5421       12915 :   for (i = 1, ip = p; ip < l; i++, ip += p)
    5422       12446 :     gel(B,ip) = gadd(gel(B,ip), gmul(gel(A,i), chip));
    5423         469 :   return B;
    5424             : }
    5425             : /* Tp(f_1), ..., Tp(f_d) mod q */
    5426             : static GEN
    5427          56 : matTp(GEN Ap, GEN A, GEN chip, long p)
    5428             : {
    5429             :   long i, l;
    5430          56 :   GEN B = cgetg_copy(A, &l);
    5431         525 :   for (i = 1; i < l; i++) gel(B,i) = Tp(gel(Ap,i), gel(A,i), chip, p);
    5432          56 :   return B;
    5433             : }
    5434             : 
    5435             : static GEN
    5436         378 : _RgXQM_mul(GEN x, GEN y, GEN T)
    5437         378 : { return T? RgXQM_mul(x, y, T): RgM_mul(x, y); }
    5438             : /* largest T-stable Q(CHI)-subspace of Q(CHI)-vector space spanned by columns
    5439             :  * of A */
    5440             : static GEN
    5441          28 : mfstabiter(GEN *pC, GEN A0, GEN chip, GEN TMP, GEN P, long ordchi)
    5442             : {
    5443          28 :   GEN A, Ap, vp = gel(TMP,4), C = NULL;
    5444          28 :   long i, lA, lim1 = gel(TMP,1)[3], p = gel(TMP,1)[4];
    5445             :   pari_timer tt;
    5446             : 
    5447          28 :   Ap = rowpermute(A0, vp);
    5448          28 :   A = rowslice(A0, 2, nbrows(Ap)+1); /* remove a0 */
    5449             :   for(;;)
    5450          28 :   {
    5451          56 :     GEN R = shallowconcat(matTp(Ap, A, chip, p), A);
    5452          56 :     GEN B = QabM_ker(R, P, ordchi);
    5453          56 :     long lB = lg(B);
    5454          56 :     if (DEBUGLEVEL)
    5455           0 :       timer_printf(&tt, "mf1basis: Hecke intersection (dim %ld)", lB-1);
    5456          56 :     if (lB == 1) return NULL;
    5457          56 :     lA = lg(A); if (lB == lA) break;
    5458          28 :     B = rowslice(B, 1, lA-1);
    5459          28 :     Ap = _RgXQM_mul(Ap, B, P);
    5460          28 :     A = _RgXQM_mul(A, B, P);
    5461          28 :     C = C? _RgXQM_mul(C, B, P): B;
    5462             :   }
    5463          28 :   if (nbrows(A) < lim1)
    5464             :   {
    5465          14 :     A0 = rowslice(A0, 2, lim1);
    5466          14 :     A = C? _RgXQM_mul(A0, C, P): A0;
    5467             :   }
    5468             :   else /* all needed coefs computed */
    5469          14 :     A = rowslice(A, 1, lim1-1);
    5470          28 :   if (*pC) C = C? _RgXQM_mul(*pC, C, P): *pC;
    5471             :   /* put back a0 */
    5472         119 :   for (i = 1; i < lA; i++) gel(A,i) = vec_prepend(gel(A,i), gen_0);
    5473          28 :   *pC = C; return A;
    5474             : }
    5475             : 
    5476             : static long
    5477         252 : mfstabitermod(GEN A, GEN vp, ulong chip, long p, ulong q)
    5478             : {
    5479         252 :   GEN Ap, C = NULL;
    5480         252 :   Ap = rowpermute(A, vp);
    5481         252 :   A = rowslice(A, 2, nbrows(Ap)+1);
    5482             :   while (1)
    5483          49 :   {
    5484         301 :     GEN Rp = shallowconcat(matTpmod(Ap, A, chip, p, q), A);
    5485         301 :     GEN B = Flm_ker(Rp, q);
    5486         301 :     long lA = lg(A), lB = lg(B);
    5487         301 :     if (lB == 1) return 0;
    5488         266 :     if (lB == lA) return lA-1;
    5489          49 :     B = rowslice(B, 1, lA-1);
    5490          49 :     Ap = Flm_mul(Ap, B, q);
    5491          49 :     A = Flm_mul(A, B, q);
    5492          49 :     C = C? Flm_mul(C, B, q): B;
    5493             :   }
    5494             : }
    5495             : 
    5496             : static GEN
    5497         595 : mfcharinv_i(GEN CHI)
    5498             : {
    5499         595 :   GEN G = gel(CHI,1);
    5500         595 :   CHI = leafcopy(CHI); gel(CHI,2) =  zncharconj(G, gel(CHI,2)); return CHI;
    5501             : }
    5502             : 
    5503             : /* upper bound dim S_1(Gamma_0(N),chi) performing the linear algebra mod p */
    5504             : static long
    5505         595 : mf1dimmod(GEN E1, GEN E, GEN chip, long ordchi, long dih, GEN TMP)
    5506             : {
    5507         595 :   GEN E1i, A, vp, mf, C = NULL;
    5508         595 :   ulong q, r = QabM_init(ordchi, &q);
    5509             :   long lim, LIM, p;
    5510             : 
    5511         595 :   LIM = gel(TMP,1)[2]; lim = gel(TMP,1)[1];
    5512         595 :   mf= gel(TMP,2);
    5513         595 :   A = gel(TMP,3);
    5514         595 :   A = QabM_to_Flm(A, r, q);
    5515         595 :   E1 = QabX_to_Flx(E1, r, q);
    5516         595 :   E1i = Flxn_inv(E1, nbrows(A), q);
    5517         595 :   if (E)
    5518             :   {
    5519         574 :     GEN Iden = gel(TMP,5), I = gel(Iden,1), den = gel(Iden,2);
    5520         574 :     GEN Mindex = MF_get_Mindex(mf), F = rowslice(A, 1, LIM);
    5521         574 :     GEN E1ip = Flxn_red(E1i, LIM);
    5522         574 :     ulong d = den? umodiu(den, q): 1;
    5523         574 :     long i, nE = lg(E) - 1;
    5524             :     pari_sp av;
    5525             : 
    5526         574 :     I = ZM_to_Flm(I, q);
    5527         574 :     if (d != 1) I = Flm_Fl_mul(I, Fl_inv(d, q), q);
    5528         574 :     av = avma;
    5529        1120 :     for (i = 1; i <= nE; i++)
    5530             :     {
    5531         889 :       GEN e = Flxn_mul(E1ip, QabX_to_Flx(gel(E,i), r, q), LIM, q);
    5532         889 :       GEN B = mfmatsermul_Fl(F, e, q), z;
    5533         889 :       GEN B2 = Flm_mul(I, rowpermute(B, Mindex), q);
    5534         889 :       B = rowslice(B, lim+1,LIM);
    5535         889 :       z = Flm_ker(Flm_sub(B2, B, q), q);
    5536         889 :       if (lg(z)-1 == dih) return dih;
    5537         546 :       C = C? Flm_mul(C, z, q): z;
    5538         546 :       F = Flm_mul(F, z, q);
    5539         546 :       gerepileall(av, 2, &F,&C);
    5540             :     }
    5541         231 :     A = F;
    5542             :   }
    5543             :   /* use Schaeffer */
    5544         252 :   p = gel(TMP,1)[4]; vp = gel(TMP,4);
    5545         252 :   A = mfmatsermul_Fl(A, E1i, q);
    5546         252 :   return mfstabitermod(A, vp, Qab_to_Fl(chip, r, q), p, q);
    5547             : }
    5548             : 
    5549             : static GEN
    5550         224 : mf1intermat(GEN A, GEN Mindex, GEN e, GEN Iden, long lim, GEN POLCYC)
    5551             : {
    5552         224 :   long j, l = lg(A), LIM = nbrows(A);
    5553         224 :   GEN I = gel(Iden,1), den = gel(Iden,2), B = cgetg(l, t_MAT);
    5554             : 
    5555        5257 :   for (j = 1; j < l; j++)
    5556             :   {
    5557        5033 :     pari_sp av = avma;
    5558        5033 :     GEN c = RgV_to_RgX(gel(A,j), 0), c1, c2;
    5559        5033 :     c = RgX_to_RgC(RgXn_mul(c, e, LIM), LIM);
    5560        5033 :     if (POLCYC) c = liftpol_shallow(c);
    5561        5033 :     c1 = vecslice(c, lim+1, LIM);
    5562        5033 :     if (den) c1 = RgC_Rg_mul(c1, den);
    5563        5033 :     c2 = RgM_RgC_mul(I, vecpermute(c, Mindex));
    5564        5033 :     gel(B, j) = gerepileupto(av, RgC_sub(c2, c1));
    5565             :   }
    5566         224 :   return B;
    5567             : }
    5568             : /* Compute the full S_1(\G_0(N),\chi); return NULL if space is empty; else
    5569             :  * if pS is NULL, return stoi(dim), where dim is the dimension; else *pS is
    5570             :  * set to a vector of forms making up a basis, and return the matrix of their
    5571             :  * Fourier expansions. pdih gives the dimension of the subspace generated by
    5572             :  * dihedral forms; TMP is from mf1_pre or NULL. */
    5573             : static GEN
    5574       11284 : mf1basis(long N, GEN CHI, GEN TMP, GEN vSP, GEN *pS, long *pdih)
    5575             : {
    5576       11284 :   GEN E = NULL, EB, E1, E1i, dE1i, mf, A, C, POLCYC, DIH, Minv, chip;
    5577       11284 :   long nE = 0, p, LIM, lim, lim1, i, lA, dimp, ordchi, dih;
    5578             :   pari_timer tt;
    5579             :   pari_sp av;
    5580             : 
    5581       11284 :   if (pdih) *pdih = 0;
    5582       11284 :   if (pS) *pS = NULL;
    5583       11284 :   if (wt1empty(N) || mfcharparity(CHI) != -1) return NULL;
    5584       10990 :   ordchi = mfcharorder(CHI);
    5585       10990 :   if (uisprime(N) && ordchi > 4) return NULL;
    5586       10962 :   if (pS)
    5587             :   {
    5588        3857 :     DIH = mfdihedralcusp(N, CHI, vSP);
    5589        3857 :     dih = lg(DIH) - 1;
    5590             :   }
    5591             :   else
    5592             :   {
    5593        7105 :     DIH = NULL;
    5594        7105 :     dih = mfdihedralcuspdim(N, CHI, vSP);
    5595             :   }
    5596       10962 :   POLCYC = (ordchi <= 2)? NULL: mfcharpol(CHI);
    5597       10962 :   if (pdih) *pdih = dih;
    5598       10962 :   if (N <= 600) switch(N)
    5599             :   {
    5600             :     long m;
    5601         126 :     case 219: case 273: case 283: case 331: case 333: case 344: case 416:
    5602             :     case 438: case 468: case 491: case 504: case 546: case 553: case 563:
    5603             :     case 566: case 581: case 592:
    5604         126 :       break; /* one chi with both exotic and dihedral forms */
    5605        9499 :     default: /* only dihedral forms */
    5606        9499 :       if (!dih) return NULL;
    5607             :       /* fall through */
    5608             :     case 124: case 133: case 148: case 171: case 201: case 209: case 224:
    5609             :     case 229: case 248: case 261: case 266: case 288: case 296: case 301:
    5610             :     case 309: case 325: case 342: case 371: case 372: case 380: case 399:
    5611             :     case 402: case 403: case 404: case 408: case 418: case 432: case 444:
    5612             :     case 448: case 451: case 453: case 458: case 496: case 497: case 513:
    5613             :     case 522: case 527: case 532: case 576: case 579:
    5614             :       /* no chi with both exotic and dihedral; one chi with exotic forms */
    5615        3248 :       if (dih)
    5616             :       {
    5617        2338 :         if (!pS) return utoipos(dih);
    5618         728 :         return mftreatdihedral(N, DIH, POLCYC, ordchi, pS) ;
    5619             :       }
    5620         910 :       m = mfcharno(mfcharinduce(CHI,N));
    5621         910 :       if (N == 124 && (m != 67 && m != 87)) return NULL;
    5622         784 :       if (N == 133 && (m != 83 && m !=125)) return NULL;
    5623         490 :       if (N == 148 && (m !=105 && m !=117)) return NULL;
    5624         364 :       if (N == 171 && (m != 94 && m !=151)) return NULL;
    5625         364 :       if (N == 201 && (m != 29 && m !=104)) return NULL;
    5626         364 :       if (N == 209 && (m != 87 && m !=197)) return NULL;
    5627         364 :       if (N == 224 && (m != 95 && m !=191)) return NULL;
    5628         364 :       if (N == 229 && (m !=107 && m !=122)) return NULL;
    5629         364 :       if (N == 248 && (m != 87 && m !=191)) return NULL;
    5630         273 :       if (N == 261 && (m != 46 && m !=244)) return NULL;
    5631         273 :       if (N == 266 && (m != 83 && m !=125)) return NULL;
    5632         273 :       if (N == 288 && (m != 31 && m !=223)) return NULL;
    5633         273 :       if (N == 296 && (m !=105 && m !=265)) return NULL;
    5634             :   }
    5635         595 :   if (DEBUGLEVEL)
    5636           0 :     err_printf("mf1basis: start character %Ps, conductor = %ld, order = %ld\n",
    5637             :                gmfcharno(CHI), mfcharconductor(CHI), ordchi);
    5638         595 :   if (!TMP) TMP = mf1_pre(N);
    5639         595 :   lim = gel(TMP,1)[1]; LIM = gel(TMP,1)[2]; lim1 = gel(TMP,1)[3];
    5640         595 :   p = gel(TMP,1)[4];
    5641         595 :   mf  = gel(TMP,2);
    5642         595 :   A   = gel(TMP,3);
    5643         595 :   EB = mfeisensteinbasis(N, 1, mfcharinv_i(CHI));
    5644         595 :   nE = lg(EB) - 1;
    5645         595 :   E1 = RgV_to_RgX(mftocol(gel(EB,1), LIM-1, 1), 0); /* + O(x^LIM) */
    5646         595 :   if (--nE)
    5647         574 :     E = RgM_to_RgXV(mfvectomat(vecslice(EB, 2, nE+1), LIM-1, 1), 0);
    5648         595 :   chip = mfchareval(CHI, p); /* != 0 */
    5649         595 :   if (DEBUGLEVEL) timer_start(&tt);
    5650         595 :   av = avma; dimp = mf1dimmod(E1, E, chip, ordchi, dih, TMP);
    5651         595 :   set_avma(av);
    5652         595 :   if (DEBUGLEVEL) timer_printf(&tt, "mf1basis: dim mod p is %ld", dimp);
    5653         595 :   if (!dimp) return NULL;
    5654         280 :   if (!pS) return utoi(dimp);
    5655         224 :   if (dimp == dih) return mftreatdihedral(N, DIH, POLCYC, ordchi, pS);
    5656         168 :   E1i = RgXn_inv(E1, LIM); /* E[1] does not vanish at oo */
    5657         168 :   if (POLCYC) E1i = liftpol_shallow(E1i);
    5658         168 :   E1i = Q_remove_denom(E1i, &dE1i);
    5659         168 :   if (DEBUGLEVEL)
    5660             :   {
    5661           0 :     GEN a0 = gel(E1,2);
    5662           0 :     if (typ(a0) == t_POLMOD) a0 = gnorm(a0);
    5663           0 :     a0 = Q_abs_shallow(a0);
    5664           0 :     timer_printf(&tt, "mf1basis: invert E; norm(a0(E)) = %Ps", a0);
    5665             :   }
    5666         168 :   C = NULL;
    5667         168 :   if (nE)
    5668             :   { /* mf attached to S2(N), fi = mfbasis(mf)
    5669             :      * M = coefs(f1,...,fd) up to LIM
    5670             :      * F = coefs(F1,...,FD) = M * C, for some matrix C over Q(chi),
    5671             :      * initially 1, eventually giving \cap_E S2 / E; D <= d.
    5672             :      * B = coefs(E/E1 F1, .., E/E1 FD); we want X in Q(CHI)^d and
    5673             :      * Y in Q(CHI)^D such that
    5674             :      *   B * X = M * Y, i.e. Minv * rowpermute(B, Mindex * X) = Y
    5675             :      *(B  - I * rowpermute(B, Mindex)) * X = 0.
    5676             :      * where I = M * Minv. Rows of (B - I * ...) are 0 up to lim so
    5677             :      * are not included */
    5678         154 :     GEN Mindex = MF_get_Mindex(mf), Iden  = gel(TMP,5);
    5679             :     pari_timer TT;
    5680         154 :     pari_sp av = avma;
    5681         154 :     if (DEBUGLEVEL) timer_start(&TT);
    5682         238 :     for (i = 1; i <= nE; i++)
    5683             :     {
    5684         224 :       pari_sp av2 = avma;
    5685             :       GEN e, z, B;
    5686             : 
    5687         224 :       e = Q_primpart(RgXn_mul(E1i, gel(E,i), LIM));
    5688         224 :       if (DEBUGLEVEL) timer_printf(&TT, "mf1basis: E[%ld] / E[1]", i+1);
    5689             :       /* the first time A is over Z and it is more efficient to lift than
    5690             :          * to let RgXn_mul use Kronecker's trick */
    5691         224 :       if (POLCYC && i == 1) e = liftpol_shallow(e);
    5692         224 :       B = mf1intermat(A, Mindex, e, Iden, lim, i == 1? NULL: POLCYC);
    5693         224 :       if (DEBUGLEVEL) timer_printf(&TT, "mf1basis: ... intermat");
    5694         224 :       z = gerepileupto(av2, QabM_ker(B, POLCYC, ordchi));
    5695         224 :       if (DEBUGLEVEL)
    5696           0 :         timer_printf(&TT, "mf1basis: ... kernel (dim %ld)",lg(z)-1);
    5697         224 :       if (lg(z) == 1) return NULL;
    5698         224 :       if (lg(z) == lg(A)) { set_avma(av2); continue; } /* no progress */
    5699         224 :       C = C? _RgXQM_mul(C, z, POLCYC): z;
    5700         224 :       A = _RgXQM_mul(A, z, POLCYC);
    5701         224 :       if (DEBUGLEVEL) timer_printf(&TT, "mf1basis: ... updates");
    5702         224 :       if (lg(z)-1 == dimp) break;
    5703          84 :       if (gc_needed(av, 1))
    5704             :       {
    5705           0 :         if (DEBUGMEM > 1) pari_warn(warnmem,"mf1basis i = %ld", i);
    5706           0 :         gerepileall(av, 2, &A, &C);
    5707             :       }
    5708             :     }
    5709         154 :     if (DEBUGLEVEL) timer_printf(&tt, "mf1basis: intersection [total]");
    5710             :   }
    5711         168 :   lA = lg(A);
    5712         168 :   if (lA-1 == dimp)
    5713             :   {
    5714         140 :     A = mfmatsermul(rowslice(A, 1, lim1), E1i);
    5715         140 :     if (POLCYC) A = RgXQM_red(A, POLCYC);
    5716         140 :     if (DEBUGLEVEL) timer_printf(&tt, "mf1basis: matsermul [1]");
    5717             :   }
    5718             :   else
    5719             :   {
    5720          28 :     A = mfmatsermul(A, E1i);
    5721          28 :     if (POLCYC) A = RgXQM_red(A, POLCYC);
    5722          28 :     if (DEBUGLEVEL) timer_printf(&tt, "mf1basis: matsermul [2]");
    5723          28 :     A = mfstabiter(&C, A, chip, TMP, POLCYC, ordchi);
    5724          28 :     if (DEBUGLEVEL) timer_printf(&tt, "mf1basis: Hecke stability");
    5725          28 :     if (!A) return NULL;
    5726             :   }
    5727         168 :   if (dE1i) C = RgM_Rg_mul(C, dE1i);
    5728         168 :   if (POLCYC)
    5729             :   {
    5730         147 :     A = QXQM_to_mod_shallow(A, POLCYC);
    5731         147 :     C = QXQM_to_mod_shallow(C, POLCYC);
    5732             :   }
    5733         168 :   lA = lg(A);
    5734         581 :   for (i = 1; i < lA; i++)
    5735             :   {
    5736         413 :     GEN c, v = gel(A,i);
    5737         413 :     gel(A,i) = RgV_normalize(v, &c);
    5738         413 :     gel(C,i) = RgC_Rg_mul(gel(C,i), c);
    5739             :   }
    5740         168 :   Minv = gel(mfclean(A, POLCYC, ordchi, 0), 2);
    5741         168 :   A = RgM_Minv_mul(A, Minv);
    5742         168 :   C = RgM_Minv_mul(C, Minv);
    5743         168 :   *pS = vecmflineardiv0(MF_get_S(mf), C, gel(EB,1));
    5744         168 :   return A;
    5745             : }
    5746             : 
    5747             : static void
    5748         406 : MF_set_space(GEN mf, long x) { gmael(mf,1,4) = utoi(x); }
    5749             : static GEN
    5750         252 : mf1_cusptonew(GEN mf, GEN vSP)
    5751             : {
    5752         252 :   const long vy = 1;
    5753             :   long i, lP, dSnew, ct;
    5754         252 :   GEN vP, F, S, Snew, vF, v = split_ii(mf, 0, 0, vSP, &i);
    5755             : 
    5756         252 :   F = gel(v,1);
    5757         252 :   vP= gel(v,2); lP = lg(vP);
    5758         252 :   if (lP == 1) { obj_insert(mf, MF_SPLIT, v); return NULL; }
    5759         238 :   MF_set_space(mf, mf_NEW);
    5760         238 :   S = MF_get_S(mf);
    5761         238 :   dSnew = dim_sum(v);
    5762         238 :   Snew = cgetg(dSnew + 1, t_VEC); ct = 0;
    5763         238 :   vF = cgetg(lP, t_MAT);
    5764         546 :   for (i = 1; i < lP; i++)
    5765             :   {
    5766         308 :     GEN V, P = gel(vP,i), f = liftpol_shallow(gel(F,i));
    5767         308 :     long j, d = degpol(P);
    5768         308 :     gel(vF,i) = V = zerocol(dSnew);
    5769         308 :     if (d == 1)
    5770             :     {
    5771         140 :       gel(Snew, ct+1) = mflineardiv_linear(S, f, 0);
    5772         140 :       gel(V, ct+1) = gen_1;
    5773             :     }
    5774             :     else
    5775             :     {
    5776         168 :       f = RgXV_to_RgM(f,d);
    5777         511 :       for (j = 1; j <= d; j++)
    5778             :       {
    5779         343 :         gel(Snew, ct+j) = mflineardiv_linear(S, row(f,j), 0);
    5780         343 :         gel(V, ct+j) = mkpolmod(pol_xn(j-1,vy), P);
    5781             :       }
    5782             :     }
    5783         308 :     ct += d;
    5784             :   }
    5785         238 :   obj_insert(mf, MF_SPLIT, mkvec2(vF, vP));
    5786         238 :   gel(mf,3) = Snew; return mf;
    5787             : }
    5788             : static GEN
    5789        3969 : mf1init(long N, GEN CHI, GEN TMP, GEN vSP, long space, long flraw)
    5790             : {
    5791        3969 :   GEN mf, mf1, S, M = mf1basis(N, CHI, TMP, vSP, &S, NULL);
    5792        3969 :   if (!M) return NULL;
    5793         952 :   mf1 = mkvec4(stoi(N), gen_1, CHI, utoi(mf_CUSP));
    5794         952 :   mf = mkmf(mf1, cgetg(1,t_VEC), S, gen_0, NULL);
    5795         952 :   if (space == mf_NEW)
    5796             :   {
    5797         252 :     gel(mf,5) = mfcleanCHI(M,CHI, 0);
    5798         252 :     mf = mf1_cusptonew(mf, vSP); if (!mf) return NULL;
    5799         238 :     if (!flraw) M = mfcoefs_mf(mf, mfsturmNk(N,1)+1, 1);
    5800             :   }
    5801         938 :   gel(mf,5) = flraw? zerovec(3): mfcleanCHI(M, CHI, 0);
    5802         938 :   return mf;
    5803             : }
    5804             : 
    5805             : static GEN
    5806        1022 : mfEMPTY(GEN mf1)
    5807             : {
    5808        1022 :   GEN Minv = mkMinv(cgetg(1,t_MAT), NULL,NULL,NULL);
    5809        1022 :   GEN M = mkvec3(cgetg(1,t_VECSMALL), Minv, cgetg(1,t_MAT));
    5810        1022 :   return mkmf(mf1, cgetg(1,t_VEC), cgetg(1,t_VEC), cgetg(1,t_VEC), M);
    5811             : }
    5812             : static GEN
    5813         616 : mfEMPTYall(long N, GEN gk, GEN vCHI, long space)
    5814             : {
    5815             :   long i, l;
    5816             :   GEN v, gN, gs;
    5817         616 :   if (!vCHI) return cgetg(1, t_VEC);
    5818          14 :   gN = utoipos(N); gs = utoi(space);
    5819          14 :   l = lg(vCHI); v = cgetg(l, t_VEC);
    5820          42 :   for (i = 1; i < l; i++) gel(v,i) = mfEMPTY(mkvec4(gN,gk,gel(vCHI,i),gs));
    5821          14 :   return v;
    5822             : }
    5823             : 
    5824             : static GEN
    5825        3983 : fmt_dim(GEN CHI, long d, long dih)
    5826        3983 : { return mkvec4(gmfcharorder(CHI), gmfcharno(CHI), utoi(d), stoi(dih)); }
    5827             : /* merge two vector of fmt_dim's for the same vector of characters. If CHI
    5828             :  * is not NULL, remove dim-0 spaces and add character from CHI */
    5829             : static GEN
    5830           7 : merge_dims(GEN V, GEN W, GEN CHI)
    5831             : {
    5832           7 :   long i, j, id, l = lg(V);
    5833           7 :   GEN A = cgetg(l, t_VEC);
    5834           7 :   if (l == 1) return A;
    5835           7 :   id = CHI? 1: 3;
    5836          21 :   for (i = j = 1; i < l; i++)
    5837             :   {
    5838          14 :     GEN v = gel(V,i), w = gel(W,i);
    5839          14 :     long dv = itou(gel(v,id)), dvh = itou(gel(v,id+1)), d;
    5840          14 :     long dw = itou(gel(w,id)), dwh = itou(gel(w,id+1));
    5841          14 :     d = dv + dw;
    5842          14 :     if (d || CHI)
    5843          14 :       gel(A,j++) = CHI? fmt_dim(gel(CHI,i),d, dvh+dwh)
    5844          14 :                       : mkvec2s(d,dvh+dwh);
    5845             :   }
    5846           7 :   setlg(A, j); return A;
    5847             : }
    5848             : static GEN
    5849        3010 : mfdim0all(GEN w)
    5850             : {
    5851        3038 :   if (w) retconst_vec(lg(w)-1, zerovec(2));
    5852        3003 :   return cgetg(1,t_VEC);
    5853             : }
    5854             : static long
    5855        7315 : mf1cuspdim_i(long N, GEN CHI, GEN TMP, GEN vSP, long *dih)
    5856             : {
    5857        7315 :   pari_sp av = avma;
    5858        7315 :   GEN b = mf1basis(N, CHI, TMP, vSP, NULL, dih);
    5859        7315 :   return gc_long(av, b? itou(b): 0);
    5860             : }
    5861             : 
    5862             : static long
    5863         476 : mf1cuspdim(long N, GEN CHI, GEN vSP)
    5864             : {
    5865         476 :   if (!vSP) vSP = get_vDIH(N, divisorsNF(N, mfcharconductor(CHI)));
    5866         476 :   return mf1cuspdim_i(N, CHI, NULL, vSP, NULL);
    5867             : }
    5868             : static GEN
    5869        4144 : mf1cuspdimall(long N, GEN vCHI)
    5870             : {
    5871             :   GEN z, TMP, w, vSP;
    5872             :   long i, j, l;
    5873        4144 :   if (wt1empty(N)) return mfdim0all(vCHI);
    5874        1141 :   w = mf1chars(N,vCHI);
    5875        1141 :   l = lg(w); if (l == 1) return cgetg(1,t_VEC);
    5876        1141 :   z = cgetg(l, t_VEC);
    5877        1141 :   TMP = mf1_pre(N); vSP = get_vDIH(N, NULL);
    5878        7861 :   for (i = j = 1; i < l; i++)
    5879             :   {
    5880        6720 :     GEN CHI = gel(w,i);
    5881        6720 :     long dih, d = mf1cuspdim_i(N, CHI, TMP, vSP, &dih);
    5882        6720 :     if (vCHI)
    5883          42 :       gel(z,j++) = mkvec2s(d, dih);
    5884        6678 :     else if (d)
    5885        1428 :       gel(z,j++) = fmt_dim(CHI, d, dih);
    5886             :   }
    5887        1141 :   setlg(z,j); return z;
    5888             : }
    5889             : 
    5890             : /* dimension of S_1(Gamma_1(N)) */
    5891             : static long
    5892        4123 : mf1cuspdimsum(long N)
    5893             : {
    5894        4123 :   pari_sp av = avma;
    5895        4123 :   GEN v = mf1cuspdimall(N, NULL);
    5896        4123 :   long i, ct = 0, l = lg(v);
    5897        5544 :   for (i = 1; i < l; i++)
    5898             :   {
    5899        1421 :     GEN w = gel(v,i); /* [ord(CHI),*,dim,*] */
    5900        1421 :     ct += itou(gel(w,3))*myeulerphiu(itou(gel(w,1)));
    5901             :   }
    5902        4123 :   return gc_long(av,ct);
    5903             : }
    5904             : 
    5905             : static GEN
    5906          56 : mf1newdimall(long N, GEN vCHI)
    5907             : {
    5908             :   GEN z, w, vTMP, vSP, fa, P, E;
    5909             :   long i, c, l, lw, P1;
    5910          56 :   if (wt1empty(N)) return mfdim0all(vCHI);
    5911          56 :   w = mf1chars(N,vCHI);
    5912          56 :   lw = lg(w); if (lw == 1) return cgetg(1,t_VEC);
    5913          56 :   vTMP = const_vec(N, NULL);
    5914          56 :   vSP = get_vDIH(N, NULL);
    5915          56 :   gel(vTMP,N) = mf1_pre(N);
    5916             :   /* if p || N and p \nmid F(CHI), S_1^new(G0(N),chi) = 0 */
    5917          56 :   fa = znstar_get_faN(gmael(w,1,1));
    5918          56 :   P = gel(fa,1); l = lg(P);
    5919          56 :   E = gel(fa,2);
    5920         154 :   for (i = P1 = 1; i < l; i++)
    5921          98 :     if (E[i] == 1) P1 *= itou(gel(P,i));
    5922             :   /* P1 = \prod_{v_p(N) = 1} p */
    5923          56 :   z = cgetg(lw, t_VEC);
    5924         182 :   for (i = c = 1; i < lw; i++)
    5925             :   {
    5926             :     long S, j, l, F, dihnew;
    5927         126 :     GEN D, CHI = gel(w,i), CHIP = mfchartoprimitive(CHI,&F);
    5928             : 
    5929         126 :     S = F % P1? 0: mf1cuspdim_i(N, CHI, gel(vTMP,N), vSP, &dihnew);
    5930         126 :     if (!S)
    5931             :     {
    5932          56 :       if (vCHI) gel(z, c++) = zerovec(2);
    5933          56 :       continue;
    5934             :     }
    5935          70 :     D = mydivisorsu(N/F); l = lg(D);
    5936          77 :     for (j = l-2; j > 0; j--) /* skip last M = N */
    5937             :     {
    5938           7 :       long M = D[j]*F, m, s, dih;
    5939           7 :       GEN TMP = gel(vTMP,M);
    5940           7 :       if (wt1empty(M) || !(m = mubeta(D[l-j]))) continue; /*m = mubeta(N/M)*/
    5941           7 :       if (!TMP) gel(vTMP,M) = TMP = mf1_pre(M);
    5942           7 :       s = mf1cuspdim_i(M, CHIP, TMP, vSP, &dih);
    5943           7 :       if (s) { S += m * s; dihnew += m * dih; }
    5944             :     }
    5945          70 :     if (vCHI)
    5946          63 :       gel(z,c++) = mkvec2s(S, dihnew);
    5947           7 :     else if (S)
    5948           7 :       gel(z, c++) = fmt_dim(CHI, S, dihnew);
    5949             :   }
    5950          56 :   setlg(z,c); return z;
    5951             : }
    5952             : 
    5953             : static GEN
    5954          28 : mf1olddimall(long N, GEN vCHI)
    5955             : {
    5956             :   long i, j, l;
    5957             :   GEN z, w;
    5958          28 :   if (wt1empty(N)) return mfdim0all(vCHI);
    5959          28 :   w = mf1chars(N,vCHI);
    5960          28 :   l = lg(w); z = cgetg(l, t_VEC);
    5961          84 :   for (i = j = 1; i < l; i++)
    5962             :   {
    5963          56 :     GEN CHI = gel(w,i);
    5964          56 :     long d = mfolddim(N, 1, CHI);
    5965          56 :     if (vCHI)
    5966          28 :       gel(z,j++) = mkvec2s(d,d?-1:0);
    5967          28 :     else if (d)
    5968           7 :       gel(z, j++) = fmt_dim(CHI, d, -1);
    5969             :   }
    5970          28 :   setlg(z,j); return z;
    5971             : }
    5972             : 
    5973             : static long
    5974         469 : mf1olddimsum(long N)
    5975             : {
    5976             :   GEN D;
    5977         469 :   long N2, i, l, S = 0;
    5978         469 :   newd_params(N, &N2); /* will ensure mubeta != 0 */
    5979         469 :   D = mydivisorsu(N/N2); l = lg(D);
    5980        2485 :   for (i = 2; i < l; i++)
    5981             :   {
    5982        2016 :     long M = D[l-i]*N2, d = mf1cuspdimsum(M);
    5983        2016 :     if (d) S -= mubeta(D[i]) * d;
    5984             :   }
    5985         469 :   return S;
    5986             : }
    5987             : static long
    5988        1050 : mf1newdimsum(long N)
    5989             : {
    5990        1050 :   long S = mf1cuspdimsum(N);
    5991        1050 :   return S? S - mf1olddimsum(N): 0;
    5992             : }
    5993             : 
    5994             : /* return the automorphism of a degree-2 nf */
    5995             : static GEN
    5996        5768 : nf2_get_conj(GEN nf)
    5997             : {
    5998        5768 :   GEN pol = nf_get_pol(nf);
    5999        5768 :   return deg1pol_shallow(gen_m1, negi(gel(pol,3)), varn(pol));
    6000             : }
    6001             : static int
    6002          42 : foo_stable(GEN foo)
    6003          42 : { return lg(foo) != 3 || equalii(gel(foo,1), gel(foo,2)); }
    6004             : 
    6005             : static long
    6006         224 : mfisdihedral(GEN vF, GEN DIH)
    6007             : {
    6008         224 :   GEN vG = gel(DIH,1), M = gel(DIH,2), v, G, bnr, w, gen, D, f, nf, tau;
    6009         224 :   GEN bnr0 = NULL, f0, f0b, xin, foo;
    6010             :   long i, l, e, j, L, n;
    6011         224 :   if (lg(M) == 1) return 0;
    6012          42 :   v = RgM_RgC_invimage(M, vF);
    6013          42 :   if (!v) return 0;
    6014          42 :   l = lg(v);
    6015          42 :   for (i = 1; i < l; i++)
    6016          42 :     if (!gequal0(gel(v,i))) break;
    6017          42 :   if (i == l) return 0;
    6018          42 :   G = gel(vG,i);
    6019          42 :   bnr = gel(G,2); D = cyc_get_expo(bnr_get_cyc(bnr));
    6020          42 :   w = gel(G,3);
    6021          42 :   f = bnr_get_mod(bnr);
    6022          42 :   nf = bnr_get_nf(bnr);
    6023          42 :   tau = nf2_get_conj(nf);
    6024          42 :   f0 = gel(f,1); foo = gel(f,2);
    6025          42 :   f0b = galoisapply(nf, tau, f0);
    6026          42 :   xin = zv_to_ZV(gel(w,2)); /* xi(bnr.gen[i]) = e(xin[i] / D) */
    6027          42 :   if (!foo_stable(foo)) { foo = mkvec2(gen_1, gen_1); bnr0 = bnr; }
    6028          42 :   if (!gequal(f0, f0b))
    6029             :   {
    6030          21 :     f0 = idealmul(nf, f0, idealdivexact(nf, f0b, idealadd(nf, f0, f0b)));
    6031          21 :     bnr0 = bnr;
    6032             :   }
    6033          42 :   if (bnr0)
    6034             :   { /* conductor not ambiguous */
    6035             :     GEN S;
    6036          28 :     bnr = Buchray(bnr_get_bnf(bnr), mkvec2(f0, foo), nf_INIT | nf_GEN);
    6037          28 :     S = bnrsurjection(bnr, bnr0);
    6038          28 :     xin = FpV_red(RgV_RgM_mul(xin, gel(S,1)), D);
    6039             :     /* still xi(gen[i]) = e(xin[i] / D), for the new generators; D stays
    6040             :      * the same, not exponent(bnr.cyc) ! */
    6041             :   }
    6042          42 :   gen = bnr_get_gen(bnr); L = lg(gen);
    6043          77 :   for (j = 1, e = itou(D); j < L; j++)
    6044             :   {
    6045          63 :     GEN Ng = idealnorm(nf, gel(gen,j));
    6046          63 :     GEN a = shifti(gel(xin,j), 1); /* xi(g_j^2) = e(a/D) */
    6047          63 :     GEN b = FpV_dotproduct(xin, isprincipalray(bnr,Ng), D);
    6048          63 :     GEN m = Fp_sub(a, b, D); /* xi(g_j/g_j^\tau) = e(m/D) */
    6049          63 :     e = ugcd(e, itou(m)); if (e == 1) break;
    6050             :   }
    6051          42 :   n = itou(D) / e;
    6052          42 :   return n == 1? 4: 2*n;
    6053             : }
    6054             : 
    6055             : static ulong
    6056         119 : myradicalu(ulong n) { return zv_prod(gel(myfactoru(n),1)); }
    6057             : 
    6058             : /* list of fundamental discriminants unramified outside N, with sign s
    6059             :  * [s = 0 => no sign condition] */
    6060             : static GEN
    6061         119 : mfunram(long N, long s)
    6062             : {
    6063         119 :   long cN = myradicalu(N >> vals(N)), p = 1, m = 1, l, c, i;
    6064         119 :   GEN D = mydivisorsu(cN), res;
    6065         119 :   l = lg(D);
    6066         119 :   if (s == 1) m = 0; else if (s == -1) p = 0;
    6067         119 :   res = cgetg(6*l - 5, t_VECSMALL);
    6068         119 :   c = 1;
    6069         119 :   if (!odd(N))
    6070             :   { /* d = 1 */
    6071          56 :     if (p) res[c++] = 8;
    6072          56 :     if (m) { res[c++] =-8; res[c++] =-4; }
    6073             :   }
    6074         364 :   for (i = 2; i < l; i++)
    6075             :   { /* skip d = 1, done above */
    6076         245 :     long d = D[i], d4 = d & 3L; /* d odd, squarefree, d4 = 1 or 3 */
    6077         245 :     if (d4 == 1) { if (p) res[c++] = d; }
    6078         182 :     else         { if (m) res[c++] =-d; }
    6079         245 :     if (!odd(N))
    6080             :     {
    6081          56 :       if (p) { res[c++] = 8*d; if (d4 == 3) res[c++] = 4*d; }
    6082          56 :       if (m) { res[c++] =-8*d; if (d4 == 1) res[c++] =-4*d; }
    6083             :     }
    6084             :   }
    6085         119 :   setlg(res, c); return res;
    6086             : }
    6087             : 
    6088             : /* Return 1 if F is definitely not S4 type; return 0 on failure. */
    6089             : static long
    6090         105 : mfisnotS4(long N, GEN w)
    6091             : {
    6092         105 :   GEN D = mfunram(N, 0);
    6093         105 :   long i, lD = lg(D), lw = lg(w);
    6094         616 :   for (i = 1; i < lD; i++)
    6095             :   {
    6096         511 :     long p, d = D[i], ok = 0;
    6097        1442 :     for (p = 2; p < lw; p++)
    6098        1442 :       if (w[p] && kross(d,p) == -1) { ok = 1; break; }
    6099         511 :     if (!ok) return 0;
    6100             :   }
    6101         105 :   return 1;
    6102             : }
    6103             : 
    6104             : /* Return 1 if Q(sqrt(5)) \not\subset Q(F), i.e. F is definitely not A5 type;
    6105             :  * return 0 on failure. */
    6106             : static long
    6107         105 : mfisnotA5(GEN F)
    6108             : {
    6109         105 :   GEN CHI = mf_get_CHI(F), P = mfcharpol(CHI), T, Q;
    6110             : 
    6111         105 :   if (mfcharorder(CHI) % 5 == 0) return 0;
    6112         105 :   T = mf_get_field(F); if (degpol(T) == 1) return 1;
    6113         105 :   if (degpol(P) > 1) T = rnfequation(P,T);
    6114         105 :   Q = gsubgs(pol_xn(2,varn(T)), 5);
    6115         105 :   return (typ(nfisincl(Q, T)) == t_INT);
    6116             : }
    6117             : 
    6118             : /* v[p+1]^2 / chi(p) - 2 = z + 1/z with z primitive root of unity of order n,
    6119             :  * return n */
    6120             : static long
    6121        6741 : mffindrootof1(GEN v, long p, GEN CHI)
    6122             : {
    6123        6741 :   GEN ap = gel(v,p+1), u0, u1, u1k, u2;
    6124        6741 :   long c = 1;
    6125        6741 :   if (gequal0(ap)) return 2;
    6126        5033 :   u0 = gen_2; u1k = u1 = gsubgs(gdiv(gsqr(ap), mfchareval(CHI, p)), 2);
    6127       14812 :   while (!gequalsg(2, liftpol_shallow(u1))) /* u1 = z^c + z^-c */
    6128             :   {
    6129        9779 :     u2 = gsub(gmul(u1k, u1), u0);
    6130        9779 :     u0 = u1; u1 = u2; c++;
    6131             :   }
    6132        5033 :   return c;
    6133             : }
    6134             : 
    6135             : /* we known that F is not dihedral */
    6136             : static long
    6137         182 : mfgaloistype_i(long N, GEN CHI, GEN F, GEN v)
    6138             : {
    6139             :   forprime_t iter;
    6140         182 :   long lim = lg(v)-2;
    6141         182 :   GEN w = zero_zv(lim);
    6142             :   pari_sp av;
    6143             :   ulong p;
    6144         182 :   u_forprime_init(&iter, 2, lim);
    6145         182 :   av = avma;
    6146        5292 :   while((p = u_forprime_next(&iter))) if (N%p) switch(mffindrootof1(v, p, CHI))
    6147             :   {
    6148        1400 :     case 1: case 2: continue;
    6149        3451 :     case 3: w[p] = 1; break;
    6150          70 :     case 4: return -24; /* S4 */
    6151           0 :     case 5: return -60; /* A5 */
    6152           7 :     default: pari_err_DOMAIN("mfgaloistype", "form", "not a",
    6153             :                              strtoGENstr("cuspidal eigenform"), F);
    6154           0 :     set_avma(av);
    6155             :   }
    6156         364 :   if (mfisnotS4(N,w) && mfisnotA5(F)) return -12; /* A4 */
    6157           0 :   return 0; /* FAILURE */
    6158             : }
    6159             : 
    6160             : static GEN
    6161         224 : mfgaloistype0(long N, GEN CHI, GEN F, GEN DIH, long lim)
    6162             : {
    6163         224 :   pari_sp av = avma;
    6164         224 :   GEN vF = mftocol(F, lim, 1);
    6165         224 :   long t = mfisdihedral(vF, DIH), bound;
    6166         224 :   if (t) return gc_stoi(av,t);
    6167         182 :   bound = maxss(200, 5*expu(N)*expu(N));
    6168             :   for(;;)
    6169             :   {
    6170         182 :     t = mfgaloistype_i(N, CHI, F, vF);
    6171         175 :     set_avma(av); if (t) return stoi(t);
    6172           0 :     if (lim > bound) return gen_0;
    6173           0 :     lim += lim >> 1;
    6174           0 :     vF = mfcoefs_i(F,lim,1);
    6175             :   }
    6176             : }
    6177             : 
    6178             : /* If f is NULL, give all the galoistypes, otherwise just for f */
    6179             : /* Return 0 to indicate failure; in this case the type is either -12 or -60,
    6180             :  * most likely -12. FIXME using the Galois representation. */
    6181             : GEN
    6182         231 : mfgaloistype(GEN NK, GEN f)
    6183             : {
    6184         231 :   pari_sp av = avma;
    6185         231 :   GEN CHI, T, F, DIH, SP, mf = checkMF_i(NK);
    6186             :   long N, k, lL, i, lim, SB;
    6187             : 
    6188         231 :   if (f && !checkmf_i(f)) pari_err_TYPE("mfgaloistype", f);
    6189         224 :   if (mf)
    6190             :   {
    6191         189 :     N = MF_get_N(mf);
    6192         189 :     k = MF_get_k(mf);
    6193         189 :     CHI = MF_get_CHI(mf);
    6194             :   }
    6195             :   else
    6196             :   {
    6197          35 :     checkNK(NK, &N, &k, &CHI, 0);
    6198          35 :     mf = f? NULL: mfinit_i(NK, mf_NEW);
    6199             :   }
    6200         224 :   if (k != 1) pari_err_DOMAIN("mfgaloistype", "k", "!=", gen_1, stoi(k));
    6201         224 :   SB = mf? mfsturm_mf(mf): mfsturmNk(N,1);
    6202         224 :   SP = get_DIH(N);
    6203         224 :   DIH = mfdihedralnew(N, CHI, SP);
    6204         224 :   lim = lg(DIH) == 1? 200: SB;
    6205         224 :   DIH = mkvec2(DIH, mfvectomat(DIH,SB,1));
    6206         224 :   if (f) return gerepileuptoint(av, mfgaloistype0(N,CHI, f, DIH, lim));
    6207         126 :   F = mfeigenbasis(mf); lL = lg(F);
    6208         126 :   T = cgetg(lL, t_VEC);
    6209         252 :   for (i=1; i < lL; i++) gel(T,i) = mfgaloistype0(N, CHI, gel(F,i), DIH, lim);
    6210         126 :   return gerepileupto(av, T);
    6211             : }
    6212             : 
    6213             : /******************************************************************/
    6214             : /*                   Find all dihedral forms.                     */
    6215             : /******************************************************************/
    6216             : /* lim >= 2 */
    6217             : static void
    6218          14 : consttabdihedral(long lim) { cache_set(cache_DIH, mfdihedralall(lim)); }
    6219             : 
    6220             : /* a ideal coprime to bnr modulus */
    6221             : static long
    6222      107611 : mfdiheval(GEN bnr, GEN w, GEN a)
    6223             : {
    6224      107611 :   GEN L, cycn = gel(w,1), chin = gel(w,2);
    6225      107611 :   long ordmax = cycn[1];
    6226      107611 :   L = ZV_to_Flv(isprincipalray(bnr,a), ordmax);
    6227      107611 :   return Flv_dotproduct(chin, L, ordmax);
    6228             : }
    6229             : 
    6230             : /* A(x^k) mod T = polcyclo(m), 0 <= k < m */
    6231             : static GEN
    6232       30247 : Galois(GEN A, long k, GEN T, long m)
    6233             : {
    6234             :   GEN B;
    6235             :   long i, ik, d;
    6236       30247 :   if (typ(A) != t_POL) return A;
    6237        7413 :   if (varn(A) != varn(T))
    6238             :   {
    6239          14 :     B = cgetg_copy(A, &d); B[1] = A[1];
    6240          35 :     for (i = 2; i < d; i++) gel(B, i) = Galois(gel(A, i), k, T, m);
    6241          14 :     return B;
    6242             :   }
    6243        7399 :   if ((d = degpol(A)) <= 0) return A;
    6244        7042 :   B = cgetg(m + 2, t_POL); B[1] = A[1]; gel(B,2) = gel(A,2);
    6245       61313 :   for (i = 1; i < m; i++) gel(B, i+2) = gen_0;
    6246       23877 :   for (i = 1, ik = k; i <= d; i++, ik = Fl_add(ik, k, m))
    6247       16835 :     gel(B, ik + 2) = gel(A, i+2);
    6248        7042 :   return QX_ZX_rem(normalizepol(B), T);
    6249             : }
    6250             : static GEN
    6251        1001 : vecGalois(GEN v, long k, GEN T, long m)
    6252             : {
    6253             :   long i, l;
    6254        1001 :   GEN w = cgetg_copy(v,&l);
    6255       31227 :   for (i = 1; i < l; i++) gel(w,i) = Galois(gel(v,i), k, T, m);
    6256        1001 :   return w;
    6257             : }
    6258             : 
    6259             : static GEN
    6260      234178 : fix_pol(GEN S, GEN Pn, int *trace)
    6261             : {
    6262      234178 :   if (typ(S) != t_POL) return S;
    6263      118069 :   S = RgX_rem(S, Pn);
    6264      118069 :   if (typ(S) == t_POL)
    6265             :   {
    6266      118069 :     switch(lg(S))
    6267             :     {
    6268       45108 :       case 2: return gen_0;
    6269       20517 :       case 3: return gel(S,2);
    6270             :     }
    6271       52444 :     *trace = 1;
    6272             :   }
    6273       52444 :   return S;
    6274             : }
    6275             : 
    6276             : static GEN
    6277       13573 : dihan(GEN bnr, GEN w, GEN k0j, long m, ulong lim)
    6278             : {
    6279       13573 :   GEN nf = bnr_get_nf(bnr), f = bid_get_ideal(bnr_get_bid(bnr));
    6280       13573 :   GEN v = zerovec(lim+1), cycn = gel(w,1), Tinit = gel(w,3);
    6281       13573 :   GEN Pn = gel(Tinit,lg(Tinit)==4? 2: 1);
    6282       13573 :   long j, ordmax = cycn[1];
    6283       13573 :   long D = itos(nf_get_disc(nf)), vt = varn(Pn);
    6284       13573 :   int trace = 0;
    6285             :   ulong p, n;
    6286             :   forprime_t T;
    6287             : 
    6288       13573 :   if (!lim) return v;
    6289       13363 :   gel(v,2) = gen_1;
    6290       13363 :   u_forprime_init(&T, 2, lim);
    6291             :   /* fill in prime powers first */
    6292      116207 :   while ((p = u_forprime_next(&T)))
    6293             :   {
    6294             :     GEN vP, vchiP, S;
    6295             :     long k, lP;
    6296             :     ulong q, qk;
    6297      102844 :     if (kross(D,p) >= 0) q = p;
    6298       45192 :     else if (!(q = umuluu_le(p,p,lim))) continue;
    6299             :     /* q = Norm P */
    6300       65856 :     vP = idealprimedec(nf, utoipos(p));
    6301       65856 :     lP = lg(vP);
    6302       65856 :     vchiP = cgetg(lP, t_VECSMALL);
    6303      179081 :     for (j = k = 1; j < lP; j++)
    6304             :     {
    6305      113225 :       GEN P = gel(vP,j);
    6306      113225 :       if (!idealval(nf, f, P)) vchiP[k++] = mfdiheval(bnr,w,P);
    6307             :     }
    6308       65856 :     if (k == 1) continue;
    6309       62188 :     setlg(vchiP, k); lP = k;
    6310       62188 :     if (lP == 2)
    6311             :     { /* one prime above p not dividing f */
    6312       16765 :       long s, s0 = vchiP[1];
    6313       27069 :       for (qk=q, s = s0;; s = Fl_add(s,s0,ordmax))
    6314             :       {
    6315       27069 :         S = Qab_zeta(s, ordmax, vt);
    6316       27069 :         gel(v, qk+1) = fix_pol(S, Pn, &trace);
    6317       27069 :         if (!(qk = umuluu_le(qk,q,lim))) break;
    6318             :       }
    6319             :     }
    6320             :     else /* two primes above p not dividing f */
    6321             :     {
    6322       45423 :       long s, s0 = vchiP[1], s1 = vchiP[2];
    6323       45423 :       for (qk=q, k = 1;; k++)
    6324       18424 :       { /* sum over a,b s.t. Norm( P1^a P2^b ) = q^k, i.e. a+b = k */
    6325             :         long a;
    6326       63847 :         GEN S = gen_0;
    6327      220752 :         for (a = 0; a <= k; a++)
    6328             :         {
    6329      156905 :           s = Fl_add(Fl_mul(a, s0, ordmax), Fl_mul(k-a, s1, ordmax), ordmax);
    6330      156905 :           S = gadd(S, Qab_zeta(s, ordmax, vt));
    6331             :         }
    6332       63847 :         gel(v, qk+1) = fix_pol(S, Pn, &trace);
    6333       63847 :         if (!(qk = umuluu_le(qk,q,lim))) break;
    6334             :       }
    6335             :     }
    6336             :   }
    6337             :   /* complete with nonprime powers */
    6338      308098 :   for (n = 2; n <= lim; n++)
    6339             :   {
    6340      294735 :     GEN S, fa = myfactoru(n), P = gel(fa, 1), E = gel(fa, 2);
    6341             :     long q;
    6342      294735 :     if (lg(P) == 2) continue;
    6343             :     /* not a prime power */
    6344      143262 :     q = upowuu(P[1],E[1]);
    6345      143262 :     S = gmul(gel(v, q + 1), gel(v, n/q + 1));
    6346      143262 :     gel(v, n+1) = fix_pol(S, Pn, &trace);
    6347             :   }
    6348       13363 :   if (trace)
    6349             :   {
    6350        7154 :     long k0 = k0j[1], jdeg = k0j[2];
    6351        7154 :     v = QabV_tracerel(Tinit, jdeg, v); /* Apply Galois Mod(k0, ordw) */
    6352        7154 :     if (k0 > 1) v = vecGalois(v, k0, gel(Tinit,1), m);
    6353             :   }
    6354       13363 :   return v;
    6355             : }
    6356             : 
    6357             : /* as cyc_normalize for t_VECSMALL cyc */
    6358             : static GEN
    6359       26810 : cyc_normalize_zv(GEN cyc)
    6360             : {
    6361       26810 :   long i, o = cyc[1], l = lg(cyc); /* > 1 */
    6362       26810 :   GEN D = cgetg(l, t_VECSMALL);
    6363       31185 :   D[1] = o; for (i = 2; i < l; i++) D[i] = o / cyc[i];
    6364       26810 :   return D;
    6365             : }
    6366             : /* as char_normalize for t_VECSMALLs */
    6367             : static GEN
    6368      118517 : char_normalize_zv(GEN chi, GEN ncyc)
    6369             : {
    6370      118517 :   long i, l = lg(chi);
    6371      118517 :   GEN c = cgetg(l, t_VECSMALL);
    6372      118517 :   if (l > 1) {
    6373      118517 :     c[1] = chi[1];
    6374      160454 :     for (i = 2; i < l; i++) c[i] = chi[i] * ncyc[i];
    6375             :   }
    6376      118517 :   return c;
    6377             : }
    6378             : 
    6379             : static GEN
    6380        9331 : dihan_bnf(long D)
    6381             : {
    6382        9331 :   GEN c = getrand(), bnf;
    6383        9331 :   setrand(gen_1);
    6384        9331 :   bnf = Buchall(quadpoly_i(stoi(D)), nf_FORCE, LOWDEFAULTPREC);
    6385        9331 :   setrand(c);
    6386        9331 :   return bnf;
    6387             : }
    6388             : static GEN
    6389       37758 : dihan_bnr(GEN bnf, GEN A)
    6390             : {
    6391       37758 :   GEN c = getrand(), bnr;
    6392       37758 :   setrand(gen_1);
    6393       37758 :   bnr = Buchray(bnf, A, nf_INIT|nf_GEN);
    6394       37758 :   setrand(c);
    6395       37758 :   return bnr;
    6396             : }
    6397             : /* Hecke xi * (D/.) = Dirichlet chi, return v in Q^r st chi(g_i) = e(v[i]).
    6398             :  * cycn = cyc_normalize_zv(bnr.cyc), chin = char_normalize_zv(chi,cyc) */
    6399             : static GEN
    6400       34489 : bnrchartwist2conrey(GEN chin, GEN cycn, GEN bnrconreyN, GEN kroconreyN)
    6401             : {
    6402       34489 :   long l = lg(bnrconreyN), c1 = cycn[1], i;
    6403       34489 :   GEN v = cgetg(l, t_COL);
    6404      125363 :   for (i = 1; i < l; i++)
    6405             :   {
    6406       90874 :     GEN d = sstoQ(zv_dotproduct(chin, gel(bnrconreyN,i)), c1);
    6407       90874 :     if (kroconreyN[i] < 0) d = gadd(d, ghalf);
    6408       90874 :     gel(v,i) = d;
    6409             :   }
    6410       34489 :   return v;
    6411             : }
    6412             : 
    6413             : /* chi(g_i) = e(v[i]) denormalize wrt Conrey generators orders */
    6414             : static GEN
    6415       34489 : conreydenormalize(GEN znN, GEN v)
    6416             : {
    6417       34489 :   GEN gcyc = znstar_get_conreycyc(znN), w;
    6418       34489 :   long l = lg(v), i;
    6419       34489 :   w = cgetg(l, t_COL);
    6420      125363 :   for (i = 1; i < l; i++)
    6421       90874 :     gel(w,i) = modii(gmul(gel(v,i), gel(gcyc,i)), gel(gcyc,i));
    6422       34489 :   return w;
    6423             : }
    6424             : 
    6425             : static long
    6426       84028 : Miyake(GEN vchi, GEN gb, GEN cycn)
    6427             : {
    6428       84028 :   long i, e = cycn[1], lb = lg(gb);
    6429       84028 :   GEN v = char_normalize_zv(vchi, cycn);
    6430      124992 :   for (i = 1; i < lb; i++)
    6431      100268 :     if ((zv_dotproduct(v, gel(gb,i)) -  v[i]) % e) return 1;
    6432       24724 :   return 0;
    6433             : }
    6434             : 
    6435             : /* list of Hecke characters not induced by a Dirichlet character up to Galois
    6436             :  * conjugation, whose conductor is bnr.cond; cycn = cyc_normalize(bnr.cyc)*/
    6437             : static GEN
    6438       26810 : mklvchi(GEN bnr, GEN cycn, GEN gb)
    6439             : {
    6440       26810 :   GEN cyc = bnr_get_cyc(bnr), cycsmall = ZV_to_zv(cyc);
    6441       26810 :   GEN vchi = cyc2elts(cycsmall);
    6442       26810 :   long ordmax = cycsmall[1], c, i, l;
    6443       26810 :   l = lg(vchi);
    6444      304024 :   for (i = c = 1; i < l; i++)
    6445             :   {
    6446      277214 :     GEN chi = gel(vchi,i);
    6447      277214 :     if (!gb || Miyake(chi, gb, cycn)) gel(vchi, c++) = Flv_to_ZV(chi);
    6448             :   }
    6449       26810 :   setlg(vchi, c); l = c;
    6450      279300 :   for (i = 1; i < l; i++)
    6451             :   {
    6452      252490 :     GEN chi = gel(vchi,i);
    6453             :     long n;
    6454      252490 :     if (!chi) continue;
    6455     1055754 :     for (n = 2; n < ordmax; n++)
    6456      966476 :       if (ugcd(n, ordmax) == 1)
    6457             :       {
    6458      397670 :         GEN tmp = ZV_ZV_mod(gmulsg(n, chi), cyc);
    6459             :         long j;
    6460     7623539 :         for (j = i+1; j < l; j++)
    6461     7225869 :           if (gel(vchi,j) && gequal(gel(vchi,j), tmp)) gel(vchi,j) = NULL;
    6462             :       }
    6463             :   }
    6464      279300 :   for (i = c = 1; i < l; i++)
    6465             :   {
    6466      252490 :     GEN chi = gel(vchi,i);
    6467      252490 :     if (chi && bnrisconductor(bnr, chi)) gel(vchi, c++) = chi;
    6468             :   }
    6469       26810 :   setlg(vchi, c); return vchi;
    6470             : }
    6471             : 
    6472             : static GEN
    6473        7805 : get_gb(GEN bnr, GEN con)
    6474             : {
    6475        7805 :   GEN gb, g = bnr_get_gen(bnr), nf = bnr_get_nf(bnr);
    6476        7805 :   long i, l = lg(g);
    6477        7805 :   gb = cgetg(l, t_VEC);
    6478       18326 :   for (i = 1; i < l; i++)
    6479       10521 :     gel(gb,i) = ZV_to_zv(isprincipalray(bnr, galoisapply(nf, con, gel(g,i))));
    6480        7805 :   return gb;
    6481             : }
    6482             : static GEN
    6483       15862 : get_bnrconreyN(GEN bnr, GEN znN)
    6484             : {
    6485       15862 :   GEN z, g = znstar_get_conreygen(znN);
    6486       15862 :   long i, l = lg(g);
    6487       15862 :   z = cgetg(l, t_VEC);
    6488       57134 :   for (i = 1; i < l; i++) gel(z,i) = ZV_to_zv(isprincipalray(bnr,gel(g,i)));
    6489       15862 :   return z;
    6490             : }
    6491             : /* con = NULL if D > 0 or if D < 0 and id != idcon. */
    6492             : static GEN
    6493       33698 : mfdihedralcommon(GEN bnf, GEN id, GEN znN, GEN kroconreyN, long N, long D, GEN con)
    6494             : {
    6495       33698 :   GEN bnr = dihan_bnr(bnf, id), cyc = ZV_to_zv( bnr_get_cyc(bnr) );
    6496             :   GEN bnrconreyN, cycn, cycN, Lvchi, res, P, vT;
    6497             :   long j, ordmax, l, lc, deghecke, vt;
    6498             : 
    6499       33698 :   lc = lg(cyc); if (lc == 1) return NULL;
    6500       26810 :   cycn = cyc_normalize_zv(cyc);
    6501       26810 :   Lvchi = mklvchi(bnr, cycn, con? get_gb(bnr, con): NULL);
    6502       26810 :   l = lg(Lvchi);
    6503       26810 :   if (l == 1) return NULL;
    6504             : 
    6505       15862 :   bnrconreyN = get_bnrconreyN(bnr, znN);
    6506       15862 :   cycN = ZV_to_zv(znstar_get_cyc(znN));
    6507       15862 :   ordmax = cyc[1];
    6508       15862 :   vT = const_vec(odd(ordmax)? ordmax << 1: ordmax, NULL);
    6509       15862 :   vt = fetch_user_var("t");
    6510       15862 :   P = polcyclo(ordmax, vt);
    6511       15862 :   gel(vT,ordmax) = Qab_trace_init(ordmax, ordmax, P, P);
    6512       15862 :   deghecke = myeulerphiu(ordmax);
    6513       15862 :   res = cgetg(l, t_VEC);
    6514       50351 :   for (j = 1; j < l; j++)
    6515             :   {
    6516       34489 :     GEN T, v, vchi = ZV_to_zv(gel(Lvchi,j));
    6517       34489 :     GEN chi, chin = char_normalize_zv(vchi, cycn);
    6518             :     long o, vnum, k0, degrel;
    6519       34489 :     v = bnrchartwist2conrey(chin, cycn, bnrconreyN, kroconreyN);
    6520       34489 :     o = itou(Q_denom(v));
    6521       34489 :     T = gel(vT, o);
    6522       34489 :     if (!T) gel(vT,o) = T = Qab_trace_init(ordmax, o, P, polcyclo(o,vt));
    6523       34489 :     chi = conreydenormalize(znN, v);
    6524       34489 :     vnum = itou(znconreyexp(znN, chi));
    6525       34489 :     chi = ZV_to_zv(znconreychar(znN,chi));
    6526       34489 :     degrel = deghecke / degpol(gel(T,1));
    6527       34489 :     k0 = zv_cyc_minimize(cycN, chi, coprimes_zv(o));
    6528       34489 :     vnum = Fl_powu(vnum, k0, N);
    6529             :     /* encodes degrel forms: jdeg = 0..degrel-1 */
    6530       34489 :     gel(res,j) = mkvec3(mkvecsmalln(5, N, k0 % o, vnum, D, degrel),
    6531             :                         id, mkvec3(cycn,chin,T));
    6532             :   }
    6533       15862 :   return res;
    6534             : }
    6535             : 
    6536             : static long
    6537       49364 : is_cond(long D, long n)
    6538             : {
    6539       49364 :   if (D > 0) return n != 4 || (D&7L) == 1;
    6540       30114 :   return n != 2 && n != 3 && (n != 4 || (D&7L)!=1);
    6541             : }
    6542             : /* Append to v all dihedral weight 1 forms coming from D, if fundamental.
    6543             :  * level in [l1, l2] */
    6544             : static void
    6545       18718 : append_dihedral(GEN v, long D, long l1, long l2)
    6546             : {
    6547       18718 :   long Da = labs(D), no, i, numi, ct, min, max;
    6548             :   GEN bnf, con, vI, resall, arch1, arch2;
    6549             :   pari_sp av;
    6550             : 
    6551             :   /* min <= Nf <= max */
    6552       18718 :   max = l2 / Da;
    6553       18718 :   if (l1 == l2)
    6554             :   { /* assume Da | l2 */
    6555         140 :     min = max;
    6556         140 :     if (D > 0 && min < 3) return;
    6557             :   }
    6558             :   else /* assume l1 < l2 */
    6559       18578 :     min = (l1 + Da-1)/Da;
    6560       18718 :   if (!sisfundamental(D)) return;
    6561             : 
    6562        5726 :   av = avma;
    6563        5726 :   bnf = dihan_bnf(D);
    6564        5726 :   con = nf2_get_conj(bnf_get_nf(bnf));
    6565        5726 :   vI = ideallist(bnf, max);
    6566       55090 :   numi = 0; for (i = min; i <= max; i++) numi += lg(gel(vI, i)) - 1;
    6567        5726 :   if (D > 0)
    6568             :   {
    6569        1428 :     numi <<= 1;
    6570        1428 :     arch1 = mkvec2(gen_1,gen_0);
    6571        1428 :     arch2 = mkvec2(gen_0,gen_1);
    6572             :   }
    6573             :   else
    6574        4298 :     arch1 = arch2 = NULL;
    6575        5726 :   resall = cgetg(numi+1, t_VEC); ct = 1;
    6576       55090 :   for (no = min; no <= max; no++) if (is_cond(D, no))
    6577             :   {
    6578       44646 :     long N = Da*no, lc, lI;
    6579       44646 :     GEN I = gel(vI, no), znN = znstar0(utoipos(N), 1), conreyN, kroconreyN;
    6580             : 
    6581       44646 :     conreyN = znstar_get_conreygen(znN); lc = lg(conreyN);
    6582       44646 :     kroconreyN = cgetg(lc, t_VECSMALL);
    6583      166054 :     for (i = 1; i < lc; i++) kroconreyN[i] = krosi(D, gel(conreyN, i));
    6584       44646 :     lI = lg(I);
    6585       87822 :     for (i = 1; i < lI; i++)
    6586             :     {
    6587       43176 :       GEN id = gel(I, i), idcon, z;
    6588             :       long j;
    6589       43176 :       if (typ(id) == t_INT) continue;
    6590       28182 :       idcon = galoisapply(bnf, con, id);
    6591       51408 :       for (j = i; j < lI; j++)
    6592       51408 :         if (gequal(idcon, gel(I, j))) { gel(I, j) = gen_0; break; }
    6593       28182 :       if (D < 0)
    6594             :       {
    6595       17479 :         GEN conk = i == j ? con : NULL;
    6596       17479 :         z = mfdihedralcommon(bnf, id, znN, kroconreyN, N, D, conk);
    6597       17479 :         if (z) gel(resall, ct++) = z;
    6598             :       }
    6599             :       else
    6600             :       {
    6601             :         GEN ide;
    6602       10703 :         ide = mkvec2(id, arch1);
    6603       10703 :         z = mfdihedralcommon(bnf, ide, znN, kroconreyN, N, D, NULL);
    6604       10703 :         if (z) gel(resall, ct++) = z;
    6605       10703 :         if (gequal(idcon,id)) continue;
    6606        5516 :         ide = mkvec2(id, arch2);
    6607        5516 :         z = mfdihedralcommon(bnf, ide, znN, kroconreyN, N, D, NULL);
    6608        5516 :         if (z) gel(resall, ct++) = z;
    6609             :       }
    6610             :     }
    6611             :   }
    6612        5726 :   if (ct == 1) set_avma(av);
    6613             :   else
    6614             :   {
    6615        4816 :     setlg(resall, ct);
    6616        4816 :     vectrunc_append(v, gerepilecopy(av, shallowconcat1(resall)));
    6617             :   }
    6618             : }
    6619             : 
    6620             : static long
    6621       42042 : di_N(GEN a) { return gel(a,1)[1]; }
    6622             : static GEN
    6623          14 : mfdihedral(long N)
    6624             : {
    6625          14 :   GEN D = mydivisorsu(N), res = vectrunc_init(2*N);
    6626          14 :   long j, l = lg(D);
    6627         105 :   for (j = 2; j < l; j++)
    6628             :   { /* skip d = 1 */
    6629          91 :     long d = D[j];
    6630          91 :     if (d == 2) continue;
    6631          84 :     append_dihedral(res, -d, N,N);
    6632          84 :     if (d >= 5 && D[l-j] >= 3) append_dihedral(res, d, N,N); /* Nf >= 3 */
    6633             :   }
    6634          14 :   if (lg(res) > 1) res = shallowconcat1(res);
    6635          14 :   return res;
    6636             : }
    6637             : /* All primitive dihedral weight 1 forms of leven in [1, N], N > 1 */
    6638             : static GEN
    6639          14 : mfdihedralall(long N)
    6640             : {
    6641          14 :   GEN res = vectrunc_init(2*N), z;
    6642             :   long D, ct, i;
    6643             : 
    6644       13986 :   for (D = -3; D >= -N; D--) append_dihedral(res, D, 1,N);
    6645             :   /* Nf >= 3 (GTM 193, prop 3.3.18) */
    6646        4620 :   for (D = N / 3; D >= 5; D--) append_dihedral(res, D, 1,N);
    6647          14 :   ct = lg(res);
    6648          14 :   if (ct > 1)
    6649             :   { /* sort wrt N */
    6650          14 :     res = shallowconcat1(res);
    6651          14 :     res = vecpermute(res, indexvecsort(res, mkvecsmall(1)));
    6652          14 :     ct = lg(res);
    6653             :   }
    6654          14 :   z = const_vec(N, cgetg(1,t_VEC));
    6655        7658 :   for (i = 1; i < ct;)
    6656             :   { /* regroup result sharing the same N */
    6657        7644 :     long n = di_N(gel(res,i)), j = i+1, k;
    6658             :     GEN v;
    6659       34412 :     while (j < ct && di_N(gel(res,j)) == n) j++;
    6660        7644 :     gel(z, n) = v = cgetg(j-i+1, t_VEC);
    6661       42056 :     for (k = 1; i < j; k++,i++) gel(v,k) = gel(res,i);
    6662             :   }
    6663          14 :   return z;
    6664             : }
    6665             : 
    6666             : /* return [vF, index], where vecpermute(vF,index) generates dihedral forms
    6667             :  * for character CHI */
    6668             : static GEN
    6669       24969 : mfdihedralnew_i(long N, GEN CHI, GEN SP)
    6670             : {
    6671             :   GEN bnf, Tinit, Pm, vf, M, V, NK;
    6672             :   long Dold, d, ordw, i, SB, c, l, k0, k1, chino, chinoorig, lv;
    6673             : 
    6674       24969 :   lv = lg(SP); if (lv == 1) return NULL;
    6675       12138 :   CHI = mfcharinduce(CHI,N);
    6676       12138 :   ordw = mfcharorder(CHI);
    6677       12138 :   chinoorig = mfcharno(CHI);
    6678       12138 :   k0 = mfconreyminimize(CHI);
    6679       12138 :   chino = Fl_powu(chinoorig, k0, N);
    6680       12138 :   k1 = Fl_inv(k0 % ordw, ordw);
    6681       12138 :   V = cgetg(lv, t_VEC);
    6682       12138 :   d = 0;
    6683       39039 :   for (i = l = 1; i < lv; i++)
    6684             :   {
    6685       26901 :     GEN sp = gel(SP,i), T = gel(sp,1);
    6686       26901 :     if (T[3] != chino) continue;
    6687        4060 :     d += T[5];
    6688        4060 :     if (k1 != 1)
    6689             :     {
    6690          77 :       GEN t = leafcopy(T);
    6691          77 :       t[3] = chinoorig;
    6692          77 :       t[2] = (t[2]*k1) % ordw;
    6693          77 :       sp = mkvec4(t, gel(sp,2), gel(sp,3), gel(sp,4));
    6694             :     }
    6695        4060 :     gel(V, l++) = sp;
    6696             :   }
    6697       12138 :   setlg(V, l); /* dihedral forms of level N and character CHI */
    6698       12138 :   if (l == 1) return NULL;
    6699             : 
    6700        2555 :   SB = mfsturmNk(N,1) + 1;
    6701        2555 :   M = cgetg(d+1, t_MAT);
    6702        2555 :   vf = cgetg(d+1, t_VEC);
    6703        2555 :   NK = mkNK(N, 1, CHI);
    6704        2555 :   bnf = NULL; Dold = 0;
    6705        6615 :   for (i = c = 1; i < l; i++)
    6706             :   { /* T = [N, k0, conreyno, D, degrel] */
    6707        4060 :     GEN bnr, Vi = gel(V,i), T = gel(Vi,1), id = gel(Vi,2), w = gel(Vi,3);
    6708        4060 :     long jdeg, k0i = T[2], D = T[4], degrel = T[5];
    6709             : 
    6710        4060 :     if (D != Dold) { Dold = D; bnf = dihan_bnf(D); }
    6711        4060 :     bnr = dihan_bnr(bnf, id);
    6712       12054 :     for (jdeg = 0; jdeg < degrel; jdeg++,c++)
    6713             :     {
    6714        7994 :       GEN k0j = mkvecsmall2(k0i, jdeg), an = dihan(bnr, w, k0j, ordw, SB);
    6715        7994 :       settyp(an, t_COL); gel(M,c) = an;
    6716        7994 :       gel(vf,c) = tag3(t_MF_DIHEDRAL, NK, bnr, w, k0j);
    6717             :     }
    6718             :   }
    6719        2555 :   Tinit = gmael3(V,1,3,3); Pm = gel(Tinit,1);
    6720        2555 :   V = QabM_indexrank(M, degpol(Pm)==1? NULL: Pm, ordw);
    6721        2555 :   return mkvec2(vf,gel(V,2));
    6722             : }
    6723             : static long
    6724       16149 : mfdihedralnewdim(long N, GEN CHI, GEN SP)
    6725             : {
    6726       16149 :   pari_sp av = avma;
    6727       16149 :   GEN S = mfdihedralnew_i(N, CHI, SP);
    6728       16149 :   return gc_long(av, S? lg(gel(S,2))-1: 0);
    6729             : }
    6730             : static GEN
    6731        8820 : mfdihedralnew(long N, GEN CHI, GEN SP)
    6732             : {
    6733        8820 :   pari_sp av = avma;
    6734        8820 :   GEN S = mfdihedralnew_i(N, CHI, SP);
    6735        8820 :   if (!S) { set_avma(av); return cgetg(1, t_VEC); }
    6736         917 :   return vecpermute(gel(S,1), gel(S,2));
    6737             : }
    6738             : 
    6739             : static long
    6740        7105 : mfdihedralcuspdim(long N, GEN CHI, GEN vSP)
    6741             : {
    6742        7105 :   pari_sp av = avma;
    6743             :   GEN D, CHIP;
    6744             :   long F, i, lD, dim;
    6745             : 
    6746        7105 :   CHIP = mfchartoprimitive(CHI, &F);
    6747        7105 :   D = mydivisorsu(N/F); lD = lg(D);
    6748        7105 :   dim = mfdihedralnewdim(N, CHI, gel(vSP,N)); /* d = 1 */
    6749       16149 :   for (i = 2; i < lD; i++)
    6750             :   {
    6751        9044 :     long d = D[i], a = mfdihedralnewdim(N/d, CHIP, gel(vSP, N/d));
    6752        9044 :     if (a) dim += a * mynumdivu(d);
    6753             :   }
    6754        7105 :   return gc_long(av,dim);
    6755             : }
    6756             : 
    6757             : static GEN
    6758        7343 : mfbdall(GEN E, long N)
    6759             : {
    6760        7343 :   GEN v, D = mydivisorsu(N);
    6761        7343 :   long i, j, nD = lg(D) - 1, nE = lg(E) - 1;
    6762        7343 :   v = cgetg(nD*nE + 1, t_VEC);
    6763       10416 :   for (j = 1; j <= nE; j++)
    6764             :   {
    6765        3073 :     GEN Ej = gel(E, j);
    6766        9415 :     for (i = 0; i < nD; i++) gel(v, i*nE + j) = mfbd_i(Ej, D[i+1]);
    6767             :   }
    6768        7343 :   return v;
    6769             : }
    6770             : static GEN
    6771        3857 : mfdihedralcusp(long N, GEN CHI, GEN vSP)
    6772             : {
    6773        3857 :   pari_sp av = avma;
    6774             :   GEN D, CHIP, z;
    6775             :   long F, i, lD;
    6776             : 
    6777        3857 :   CHIP = mfchartoprimitive(CHI, &F);
    6778        3857 :   D = mydivisorsu(N/F); lD = lg(D);
    6779        3857 :   z = cgetg(lD, t_VEC);
    6780        3857 :   gel(z,1) = mfdihedralnew(N, CHI, gel(vSP,N));
    6781        8596 :   for (i = 2; i < lD; i++) /* skip 1 */
    6782             :   {
    6783        4739 :     GEN LF = mfdihedralnew(N / D[i], CHIP, gel(vSP, N / D[i]));
    6784        4739 :     gel(z,i) = mfbdall(LF, D[i]);
    6785             :   }
    6786        3857 :   return gerepilecopy(av, shallowconcat1(z));
    6787             : }
    6788             : 
    6789             : /* used to decide between ratlift and comatrix for ZM_inv; ratlift is better
    6790             :  * when N has many divisors */
    6791             : static int
    6792        2506 : abundant(ulong N) { return mynumdivu(N) >= 8; }
    6793             : 
    6794             : /* CHI an mfchar */
    6795             : static int
    6796         371 : cmp_ord(void *E, GEN a, GEN b)
    6797             : {
    6798         371 :   GEN chia = MF_get_CHI(a), chib = MF_get_CHI(b);
    6799         371 :   (void)E; return cmpii(gmfcharorder(chia), gmfcharorder(chib));
    6800             : }
    6801             : /* mfinit structure.
    6802             : -- mf[1] contains [N,k,CHI,space],
    6803             : -- mf[2] contains vector of closures of Eisenstein series, empty if not
    6804             :    full space.
    6805             : -- mf[3] contains vector of closures, so #mf[3] = dimension of cusp/new space.
    6806             : -- mf[4] contains the corresponding indices: either j for T(j)tf if newspace,
    6807             :    or [M,j,d] for B(d)T(j)tf_M if cuspspace or oldspace.
    6808             : -- mf[5] contains the matrix M of first coefficients of basis, never cleaned.
    6809             :  * NK is either [N,k] or [N,k,CHI].
    6810             :  * mfinit does not do the splitting, only the basis generation. */
    6811             : 
    6812             : /* Set flraw to 1 if do not need mf[5]: no mftobasis etc..., only the
    6813             :    expansions of the basis elements are needed. */
    6814             : 
    6815             : static GEN
    6816        4928 : mfinit_Nkchi(long N, long k, GEN CHI, long space, long flraw)
    6817             : {
    6818        4928 :   GEN M = NULL, mf = NULL, mf1 = mkvec4(utoi(N), stoi(k), CHI, utoi(space));
    6819        4928 :   long sb = mfsturmNk(N, k);
    6820        4928 :   if (k < 0 || badchar(N, k, CHI)) return mfEMPTY(mf1);
    6821        4893 :   if (k == 0 || space == mf_EISEN) /*nothing*/;
    6822        4732 :   else if (k == 1)
    6823             :   {
    6824         364 :     switch (space)
    6825             :     {
    6826         350 :       case mf_NEW:
    6827             :       case mf_FULL:
    6828         350 :       case mf_CUSP: mf = mf1init(N, CHI, NULL, get_vDIH(N,NULL), space, flraw);
    6829         350 :                     break;
    6830           7 :       case mf_OLD: pari_err_IMPL("mfinit in weight 1 for old space");
    6831           7 :       default: pari_err_FLAG("mfinit");
    6832             :     }
    6833             :   }
    6834             :   else /* k >= 2 */
    6835             :   {
    6836        4368 :     long ord = mfcharorder(CHI);
    6837        4368 :     GEN z = NULL, P = (ord <= 2)? NULL: mfcharpol(CHI);
    6838             :     cachenew_t cache;
    6839        4368 :     switch(space)
    6840             :     {
    6841        1204 :       case mf_NEW:
    6842        1204 :         mf = mfnewinit(N, k, CHI, &cache, 1);
    6843        1204 :         if (mf && !flraw) { M = MF_get_M(mf); z = MF_get_Mindex(mf); }
    6844        1204 :         break;
    6845        3157 :       case mf_OLD:
    6846             :       case mf_CUSP:
    6847             :       case mf_FULL:
    6848        3157 :         if (!(mf = mfinitcusp(N, k, CHI, &cache, space))) break;
    6849        2856 :         if (!flraw)
    6850             :         {
    6851        2205 :           M = bhnmat_extend(M, sb+1, 1, MF_get_S(mf), &cache);
    6852        2205 :           if (space != mf_FULL) gel(mf,5) = mfcleanCHI(M, CHI, abundant(N));
    6853             :         }
    6854        2856 :         dbg_cachenew(&cache); break;
    6855           7 :       default: pari_err_FLAG("mfinit");
    6856             :     }
    6857        4361 :     if (z) gel(mf,5) = mfclean2(M, z, P, ord);
    6858             :   }
    6859        4872 :   if (!mf) mf = mfEMPTY(mf1);
    6860             :   else
    6861             :   {
    6862        3913 :     gel(mf,1) = mf1;
    6863        3913 :     if (flraw) gel(mf,5) = zerovec(3);
    6864             :   }
    6865        4872 :   if (!space_is_cusp(space))
    6866             :   {
    6867         819 :     GEN E = mfeisensteinbasis(N, k, CHI);
    6868         819 :     gel(mf,2) = E;
    6869         819 :     if (!flraw)
    6870             :     {
    6871         497 :       if (M)
    6872         196 :         M = shallowconcat(mfvectomat(E, sb+1, 1), M);
    6873             :       else
    6874         301 :         M = mfcoefs_mf(mf, sb+1, 1);
    6875         497 :       gel(mf,5) = mfcleanCHI(M, CHI, abundant(N));
    6876             :     }
    6877             :   }
    6878        4872 :   return mf;
    6879             : }
    6880             : 
    6881             : /* mfinit for k = nk/dk */
    6882             : static GEN
    6883        2639 : mfinit_Nndkchi(long N, long nk, long dk, GEN CHI, long space, long flraw)
    6884         266 : { return (dk == 2)? mf2init_Nkchi(N, nk >> 1, CHI, space, flraw)
    6885        2905 :                   : mfinit_Nkchi(N, nk, CHI, space, flraw); }
    6886             : static GEN
    6887        3304 : mfinit_i(GEN NK, long space)
    6888             : {
    6889             :   GEN CHI, mf;
    6890             :   long N, k, dk, joker;
    6891        3304 :   if (checkmf_i(NK))
    6892             :   {
    6893         147 :     N = mf_get_N(NK);
    6894         147 :     Qtoss(mf_get_gk(NK), &k, &dk);
    6895         147 :     CHI = mf_get_CHI(NK);
    6896             :   }
    6897        3157 :   else if ((mf = checkMF_i(NK)))
    6898             :   {
    6899          21 :     long s = MF_get_space(mf);
    6900          21 :     if (s == space) return mf;
    6901          21 :     Qtoss(MF_get_gk(mf), &k, &dk);
    6902          21 :     if (dk == 1 && k > 1 && space == mf_NEW && (s == mf_CUSP || s == mf_FULL))
    6903          21 :       return mfinittonew(mf);
    6904           0 :     N = MF_get_N(mf);
    6905           0 :     CHI = MF_get_CHI(mf);
    6906             :   }
    6907             :   else
    6908        3136 :     checkNK2(NK, &N, &k, &dk, &CHI, 1);
    6909        3262 :   joker = !CHI || typ(CHI) == t_COL;
    6910        3262 :   if (joker)
    6911             :   {
    6912        1162 :     GEN mf, vCHI = CHI;
    6913             :     long i, j, l;
    6914        1162 :     if (CHI && lg(CHI) == 1) return cgetg(1,t_VEC);
    6915        1155 :     if (k < 0) return mfEMPTYall(N, uutoQ(k,dk), CHI, space);
    6916        1141 :     if (k == 1 && dk == 1 && space != mf_EISEN)
    6917         504 :     {
    6918             :       GEN TMP, vSP, gN, gs;
    6919             :       pari_timer tt;
    6920        1106 :       if (space != mf_CUSP && space != mf_NEW)
    6921           0 :         pari_err_IMPL("mfinit([N,1,wildcard], space != cusp or new space)");
    6922        1106 :       if (wt1empty(N)) return mfEMPTYall(N, gen_1, CHI, space);
    6923         504 :       vCHI = mf1chars(N,vCHI);
    6924         504 :       l = lg(vCHI); mf = cgetg(l, t_VEC); if (l == 1) return mf;
    6925         504 :       TMP = mf1_pre(N); vSP = get_vDIH(N, NULL);
    6926         504 :       gN = utoipos(N); gs = utoi(space);
    6927         504 :       if (DEBUGLEVEL) timer_start(&tt);
    6928        4123 :       for (i = j = 1; i < l; i++)
    6929             :       {
    6930        3619 :         pari_sp av = avma;
    6931        3619 :         GEN c = gel(vCHI,i), z = mf1init(N, c, TMP, vSP, space, 0);
    6932        3619 :         if (z) z = gerepilecopy(av, z);
    6933             :         else
    6934             :         {
    6935        2905 :           set_avma(av);
    6936        2905 :           if (CHI) z = mfEMPTY(mkvec4(gN,gen_1,c,gs));
    6937             :         }
    6938        3619 :         if (z) gel(mf, j++) = z;
    6939        3619 :         if (DEBUGLEVEL)
    6940           0 :           timer_printf(&tt, "mf1basis: character %ld / %ld (order = %ld)",
    6941             :                        i, l-1, mfcharorder(c));
    6942             :       }
    6943             :     }
    6944             :     else
    6945             :     {
    6946          35 :       vCHI = mfchars(N,k,dk,vCHI);
    6947          35 :       l = lg(vCHI); mf = cgetg(l, t_VEC);
    6948         119 :       for (i = j = 1; i < l; i++)
    6949             :       {
    6950          84 :         pari_sp av = avma;
    6951          84 :         GEN v = mfinit_Nndkchi(N, k, dk, gel(vCHI,i), space, 0);
    6952          84 :         if (MF_get_dim(v) || CHI) gel(mf, j++) = v; else set_avma(av);
    6953             :       }
    6954             :     }
    6955         539 :     setlg(mf,j);
    6956         539 :     if (!CHI) gen_sort_inplace(mf, NULL, &cmp_ord, NULL);
    6957         539 :     return mf;
    6958             :   }
    6959        2100 :   return mfinit_Nndkchi(N, k, dk, CHI, space, 0);
    6960             : }
    6961             : GEN
    6962        2345 : mfinit(GEN NK, long space)
    6963             : {
    6964        2345 :   pari_sp av = avma;
    6965        2345 :   return gerepilecopy(av, mfinit_i(NK, space));
    6966             : }
    6967             : 
    6968             : /* UTILITY FUNCTIONS */
    6969             : static void
    6970         364 : cusp_canon(GEN cusp, long N, long *pA, long *pC)
    6971             : {
    6972         364 :   pari_sp av = avma;
    6973             :   long A, C, tc, cg;
    6974         364 :   if (N <= 0) pari_err_DOMAIN("mfcuspwidth","N","<=",gen_0,stoi(N));
    6975         357 :   if (!cusp || (tc = typ(cusp)) == t_INFINITY) { *pA = 1; *pC = N; return; }
    6976         350 :   if (tc != t_INT && tc != t_FRAC) pari_err_TYPE("checkcusp", cusp);
    6977         350 :   Qtoss(cusp, &A,&C);
    6978         350 :   if (N % C)
    6979             :   {
    6980             :     ulong uC;
    6981          14 :     long u = Fl_invgen((C-1)%N + 1, N, &uC);
    6982          14 :     A = Fl_mul(A, u, N);
    6983          14 :     C = (long)uC;
    6984             :   }
    6985         350 :   cg = ugcd(C, N/C);
    6986         420 :   while (ugcd(A, N) > 1) A += cg;
    6987         350 :   *pA = A % N; *pC = C; set_avma(av);
    6988             : }
    6989             : static long
    6990         945 : mfcuspcanon_width(long N, long C)
    6991         945 : { return (!C || C == N)? 1 : N / ugcd(N, Fl_sqr(umodsu(C,N),N)); }
    6992             : /* v = [a,c] a ZC, width of cusp (a:c) */
    6993             : static long
    6994        8806 : mfZC_width(long N, GEN v)
    6995             : {
    6996        8806 :   ulong C = umodiu(gel(v,2), N);
    6997        8806 :   return (C == 0)? 1: N / ugcd(N, Fl_sqr(C,N));
    6998             : }
    6999             : long
    7000         161 : mfcuspwidth(GEN gN, GEN cusp)
    7001             : {
    7002         161 :   long N = 0, A, C;
    7003             :   GEN mf;
    7004         161 :   if (typ(gN) == t_INT) N = itos(gN);
    7005          42 :   else if ((mf = checkMF_i(gN))) N = MF_get_N(mf);
    7006           0 :   else pari_err_TYPE("mfcuspwidth", gN);
    7007         161 :   cusp_canon(cusp, N, &A, &C);
    7008         154 :   return mfcuspcanon_width(N, C);
    7009             : }
    7010             : 
    7011             : /* Q a t_INT */
    7012             : static GEN
    7013          14 : findq(GEN al, GEN Q)
    7014             : {
    7015             :   long n;
    7016          14 :   if (typ(al) == t_FRAC && cmpii(gel(al,2), Q) <= 0)
    7017           0 :     return mkvec(mkvec2(gel(al,1), gel(al,2)));
    7018          14 :   n = 1 + (long)ceil(2.0781*gtodouble(glog(Q, LOWDEFAULTPREC)));
    7019          14 :   return contfracpnqn(gboundcf(al,n), n);
    7020             : }
    7021             : static GEN
    7022          91 : findqga(long N, GEN z)
    7023             : {
    7024          91 :   GEN Q, LDC, CK = NULL, DK = NULL, ma, x, y = imag_i(z);
    7025             :   long j, l;
    7026          91 :   if (gcmpgs(gmulsg(2*N, y), 1) >= 0) return NULL;
    7027          14 :   x = real_i(z);
    7028          14 :   Q = ground(ginv(gsqrt(gmulsg(N, y), LOWDEFAULTPREC)));
    7029          14 :   LDC = findq(gmulsg(-N,x), Q);
    7030          14 :   ma = gen_1; l = lg(LDC);
    7031          35 :   for (j = 1; j < l; j++)
    7032             :   {
    7033          21 :     GEN D, DC = gel(LDC,j), C1 = gel(DC,2);
    7034          21 :     if (cmpii(C1,Q) > 0) break;
    7035          21 :     D = gel(DC,1);
    7036          21 :     if (ugcdiu(D,N) == 1)
    7037             :     {
    7038           7 :       GEN C = mului(N, C1), den;
    7039           7 :       den = gadd(gsqr(gmul(C,y)), gsqr(gadd(D, gmul(C,x))));
    7040           7 :       if (gcmp(den, ma) < 0) { ma = den; CK = C; DK = D; }
    7041             :     }
    7042             :   }
    7043          14 :   return DK? mkvec2(CK, DK): NULL;
    7044             : }
    7045             : 
    7046             : static long
    7047         168 : valNC2(GEN P, GEN E, long e)
    7048             : {
    7049         168 :   long i, d = 1, l = lg(P);
    7050         504 :   for (i = 1; i < l; i++)
    7051             :   {
    7052         336 :     long v = u_lval(e, P[i]) << 1;
    7053         336 :     if (v == E[i] + 1) v--;
    7054         336 :     d *= upowuu(P[i], v);
    7055             :   }
    7056         168 :   return d;
    7057             : }
    7058             : 
    7059             : static GEN
    7060          49 : findqganew(long N, GEN z)
    7061             : {
    7062          49 :   GEN MI, DI, x = real_i(z), y = imag_i(z), Ck = gen_0, Dk = gen_1, fa, P, E;
    7063             :   long i;
    7064          49 :   MI = uutoQ(1,N);
    7065          49 :   DI = mydivisorsu(mysqrtu(N));
    7066          49 :   fa = myfactoru(N); P = gel(fa,1); E = gel(fa,2);
    7067         217 :   for (i = 1; i < lg(DI); i++)
    7068             :   {
    7069         168 :     long e = DI[i], g;
    7070             :     GEN U, C, D, m;
    7071         168 :     (void)cxredsl2(gmulsg(e, z), &U);
    7072         168 :     C = gcoeff(U,2,1); if (!signe(C)) continue;
    7073         168 :     D = gcoeff(U,2,2);
    7074         168 :     g = ugcdiu(D,e);
    7075         168 :     if (g > 1) { C = muliu(C,e/g); D = diviuexact(D,g); } else C = muliu(C,e);
    7076         168 :     m = gadd(gsqr(gadd(gmul(C, x), D)), gsqr(gmul(C, y)));
    7077         168 :     m = gdivgu(m, valNC2(P, E, e));
    7078         168 :     if (gcmp(m, MI) < 0) { MI = m; Ck = C; Dk = D; }
    7079             :   }
    7080          49 :   return signe(Ck)? mkvec2(Ck, Dk): NULL;
    7081             : }
    7082             : 
    7083             : /* Return z' and U = [a,b;c,d] \in SL_2(Z), z' = U*z,
    7084             :  * Im(z')/width(U.oo) > sqrt(3)/(2N). Set *pczd = c*z+d */
    7085             : static GEN
    7086         175 : cxredga0N(long N, GEN z, GEN *pU, GEN *pczd, long flag)
    7087             : {
    7088         175 :   GEN v = NULL, A, B, C, D;
    7089             :   long e;
    7090         175 :   if (N == 1) return cxredsl2_i(z, pU, pczd);
    7091         140 :   e = gexpo(gel(z,2));
    7092         140 :   if (e < 0) z = gprec_wensure(z, precision(z) + nbits2extraprec(-e));
    7093         140 :   v = flag? findqganew(N,z): findqga(N,z);
    7094         140 :   if (!v) { *pU = matid(2); *pczd = gen_1; return z; }
    7095          56 :   C = gel(v,1);
    7096          56 :   D = gel(v,2);
    7097          56 :   if (!is_pm1(bezout(C,D, &B,&A))) pari_err_BUG("cxredga0N [gcd > 1]");
    7098          56 :   B = negi(B);
    7099          56 :   *pU = mkmat2(mkcol2(A,C), mkcol2(B,D));
    7100          56 :   *pczd = gadd(gmul(C,z), D);
    7101          56 :   return gdiv(gadd(gmul(A,z), B), *pczd);
    7102             : }
    7103             : 
    7104             : static GEN
    7105         154 : lfunthetaall(GEN b, GEN vL, GEN t, long bitprec)
    7106             : {
    7107         154 :   long i, l = lg(vL);
    7108         154 :   GEN v = cgetg(l, t_VEC);
    7109         336 :   for (i = 1; i < l; i++)
    7110             :   {
    7111         182 :     GEN T, L = gel(vL,i), a0 = gel(L,1), ldata = gel(L,2);
    7112         182 :     GEN van = gel(ldata_get_an(ldata),2);
    7113         182 :     if (lg(van) == 1)
    7114             :     {
    7115           0 :       T = gmul(b, a0);
    7116           0 :       if (isexactzero(T)) { GEN z = real_0_bit(-bitprec); T = mkcomplex(z,z); }
    7117             :     }
    7118             :     else
    7119             :     {
    7120         182 :       T = gmul2n(lfuntheta(ldata, t, 0, bitprec), -1);
    7121         182 :       T = gmul(b, gadd(a0, T));
    7122             :     }
    7123         182 :     gel(v,i) = T;
    7124             :   }
    7125         154 :   return l == 2? gel(v,1): v;
    7126             : }
    7127             : 
    7128             : /* P in ZX, irreducible */
    7129             : static GEN
    7130         182 : ZX_roots(GEN P, long prec)
    7131             : {
    7132         182 :   long d = degpol(P);
    7133         182 :   if (d == 1) return mkvec(gen_0);
    7134         182 :   if (d == 2 && isint1(gel(P,2)) && isintzero(gel(P,3)) && isint1(gel(P,4)))
    7135           7 :     return mkvec2(powIs(3), gen_I()); /* order as polroots */
    7136         294 :   return (ZX_sturm_irred(P) == d)? ZX_realroots_irred(P, prec)
    7137         294 :                                  : QX_complex_roots(P, prec);
    7138             : }
    7139             : /* initializations for RgX_RgV_eval / RgC_embed */
    7140             : static GEN
    7141         217 : rootspowers(GEN v)
    7142             : {
    7143         217 :   long i, l = lg(v);
    7144         217 :   GEN w = cgetg(l, t_VEC);
    7145         868 :   for (i = 1; i < l; i++) gel(w,i) = gpowers(gel(v,i), l-2);
    7146         217 :   return w;
    7147             : }
    7148             : /* mf embeddings attached to Q(chi)/(T), chi attached to cyclotomic P */
    7149             : static GEN
    7150         889 : getembed(GEN P, GEN T, GEN zcyclo, long prec)
    7151             : {
    7152             :   long i, l;
    7153             :   GEN v;
    7154         889 :   if (degpol(P) == 1) P = NULL; /* mfcharpol for quadratic char */
    7155         889 :   if (degpol(T) == 1) T = NULL; /* dim 1 orbit */
    7156         889 :   if (T && P)
    7157          35 :   { /* K(y) / (T(y)), K = Q(t)/(P) cyclotomic */
    7158          35 :     GEN vr = RgX_is_ZX(T)? ZX_roots(T,prec): roots(RgX_embed1(T,zcyclo), prec);
    7159          35 :     v = rootspowers(vr); l = lg(v);
    7160         105 :     for (i = 1; i < l; i++) gel(v,i) = mkcol3(P,zcyclo,gel(v,i));
    7161             :   }
    7162         854 :   else if (T)
    7163             :   { /* Q(y) / (T(y)), T noncyclotomic */
    7164         182 :     GEN vr = ZX_roots(T, prec);
    7165         182 :     v = rootspowers(vr); l = lg(v);
    7166         763 :     for (i = 1; i < l; i++) gel(v,i) = mkcol2(T, gel(v,i));
    7167             :   }
    7168             :   else /* cyclotomic or rational */
    7169         672 :     v = mkvec(P? mkvec2(P, zcyclo): cgetg(1,t_VEC));
    7170         889 :   return v;
    7171             : }
    7172             : static GEN
    7173         742 : grootsof1_CHI(GEN CHI, long prec)
    7174         742 : { return grootsof1(mfcharorder(CHI), prec); }
    7175             : /* return the [Q(F):Q(chi)] embeddings of F */
    7176             : static GEN
    7177         581 : mfgetembed(GEN F, long prec)
    7178             : {
    7179         581 :   GEN T = mf_get_field(F), CHI = mf_get_CHI(F), P = mfcharpol(CHI);
    7180         581 :   return getembed(P, T, grootsof1_CHI(CHI, prec), prec);
    7181             : }
    7182             : static GEN
    7183           7 : mfchiembed(GEN mf, long prec)
    7184             : {
    7185           7 :   GEN CHI = MF_get_CHI(mf), P = mfcharpol(CHI);
    7186           7 :   return getembed(P, pol_x(0), grootsof1_CHI(CHI, prec), prec);
    7187             : }
    7188             : /* mfgetembed for the successive eigenforms in MF_get_newforms */
    7189             : static GEN
    7190         154 : mfeigenembed(GEN mf, long prec)
    7191             : {
    7192         154 :   GEN vP = MF_get_fields(mf), vF = MF_get_newforms(mf);
    7193         154 :   GEN zcyclo, vE, CHI = MF_get_CHI(mf), P = mfcharpol(CHI);
    7194         154 :   long i, l = lg(vP);
    7195         154 :   vF = Q_remove_denom(liftpol_shallow(vF), NULL);
    7196         154 :   prec += nbits2extraprec(gexpo(vF));
    7197         154 :   zcyclo = grootsof1_CHI(CHI, prec);
    7198         154 :   vE = cgetg(l, t_VEC);
    7199         455 :   for (i = 1; i < l; i++) gel(vE,i) = getembed(P, gel(vP,i), zcyclo, prec);
    7200         154 :   return vE;
    7201             : }
    7202             : 
    7203             : static int
    7204          28 : checkPv(GEN P, GEN v)
    7205          28 : { return typ(P) == t_POL && is_vec_t(typ(v)) && lg(v)-1 >= degpol(P); }
    7206             : static int
    7207          28 : checkemb_i(GEN E)
    7208             : {
    7209          28 :   long t = typ(E), l = lg(E);
    7210          28 :   if (t == t_VEC) return l == 1 || (l == 3 && checkPv(gel(E,1), gel(E,2)));
    7211          21 :   if (t != t_COL) return 0;
    7212          21 :   if (l == 3) return checkPv(gel(E,1), gel(E,2));
    7213          21 :   return l == 4 && is_vec_t(typ(gel(E,2))) && checkPv(gel(E,1), gel(E,3));
    7214             : }
    7215             : static GEN
    7216          28 : anyembed(GEN v, GEN E)
    7217             : {
    7218          28 :   switch(typ(v))
    7219             :   {
    7220          21 :     case t_VEC: case t_COL: return mfvecembed(E, v);
    7221           7 :     case t_MAT: return mfmatembed(E, v);
    7222             :   }
    7223           0 :   return mfembed(E, v);
    7224             : }
    7225             : GEN
    7226          49 : mfembed0(GEN E, GEN v, long prec)
    7227             : {
    7228          49 :   pari_sp av = avma;
    7229          49 :   GEN mf, vE = NULL;
    7230          49 :   if (checkmf_i(E)) vE = mfgetembed(E, prec);
    7231          35 :   else if ((mf = checkMF_i(E))) vE = mfchiembed(mf, prec);
    7232          49 :   if (vE)
    7233             :   {
    7234          21 :     long i, l = lg(vE);
    7235             :     GEN w;
    7236          21 :     if (!v) return gerepilecopy(av, l == 2? gel(vE,1): vE);
    7237           0 :     w = cgetg(l, t_VEC);
    7238           0 :     for (i = 1; i < l; i++) gel(w,i) = anyembed(v, gel(vE,i));
    7239           0 :     return gerepilecopy(av, l == 2? gel(w,1): w);
    7240             :   }
    7241          28 :   if (!checkemb_i(E) || !v) pari_err_TYPE("mfembed", E);
    7242          28 :   return gerepilecopy(av, anyembed(v,E));
    7243             : }
    7244             : 
    7245             : /* dummy lfun create for theta evaluation */
    7246             : static GEN
    7247         924 : mfthetaancreate(GEN van, GEN N, GEN k)
    7248             : {
    7249         924 :   GEN L = zerovec(6);
    7250         924 :   gel(L,1) = lfuntag(t_LFUN_GENERIC, van);
    7251         924 :   gel(L,3) = mkvec2(gen_0, gen_1);
    7252         924 :   gel(L,4) = k;
    7253         924 :   gel(L,5) = N; return L;
    7254             : }
    7255             : /* destroy van and prepare to evaluate theta(sigma(van)), for all sigma in
    7256             :  * embeddings vector vE */
    7257             : static GEN
    7258         329 : van_embedall(GEN van, GEN vE, GEN gN, GEN gk)
    7259             : {
    7260         329 :   GEN a0 = gel(van,1), vL;
    7261         329 :   long i, lE = lg(vE), l = lg(van);
    7262         329 :   van++; van[0] = evaltyp(t_VEC) | evallg(l-1); /* remove a0 */
    7263         329 :   vL = cgetg(lE, t_VEC);
    7264         889 :   for (i = 1; i < lE; i++)
    7265             :   {
    7266         560 :     GEN E = gel(vE,i), v = mfvecembed(E, van);
    7267         560 :     gel(vL,i) = mkvec2(mfembed(E,a0), mfthetaancreate(v, gN, gk));
    7268             :   }
    7269         329 :   return vL;
    7270             : }
    7271             : 
    7272             : static int
    7273        1064 : cusp_AC(GEN cusp, long *A, long *C)
    7274             : {
    7275        1064 :   switch(typ(cusp))
    7276             :   {
    7277         119 :     case t_INFINITY: *A = 1; *C = 0; break;
    7278         273 :     case t_INT:  *A = itos(cusp); *C = 1; break;
    7279         448 :     case t_FRAC: *A = itos(gel(cusp, 1)); *C = itos(gel(cusp, 2)); break;
    7280         224 :     case t_REAL: case t_COMPLEX:
    7281         224 :       *A = 0; *C = 0;
    7282         224 :       if (gsigne(imag_i(cusp)) <= 0)
    7283           7 :         pari_err_DOMAIN("mfeval","imag(tau)","<=",gen_0,cusp);
    7284         217 :       return 0;
    7285           0 :     default: pari_err_TYPE("cusp_AC", cusp);
    7286             :   }
    7287         840 :   return 1;
    7288             : }
    7289             : static GEN
    7290         518 : cusp2mat(long A, long C)
    7291             : { long B, D;
    7292         518 :   cbezout(A, C, &D, &B);
    7293         518 :   return mkmat22s(A, -B, C, D);
    7294             : }
    7295             : static GEN
    7296          21 : mkS(void) { return mkmat22s(0,-1,1,0); }
    7297             : 
    7298             : /* if t is a cusp, return F(t), else NULL */
    7299             : static GEN
    7300         350 : evalcusp(GEN mf, GEN F, GEN t, long prec)
    7301             : {
    7302             :   long A, C;
    7303             :   GEN R;
    7304         350 :   if (!cusp_AC(t, &A,&C)) return NULL;
    7305         189 :   if (C % mf_get_N(F) == 0) return gel(mfcoefs_i(F, 0, 1), 1);
    7306         175 :   R = mfgaexpansion(mf, F, cusp2mat(A,C), 0, prec);
    7307         175 :   return gequal0(gel(R,1))? gmael(R,3,1): gen_0;
    7308             : }
    7309             : /* Evaluate an mf closure numerically, i.e., in the usual sense, either for a
    7310             :  * single tau or a vector of tau; for each, return a vector of results
    7311             :  * corresponding to all complex embeddings of F. If flag is nonzero, allow
    7312             :  * replacing F by F | gamma to increase imag(gamma^(-1).tau) [ expensive if
    7313             :  * MF_EISENSPACE not present ] */
    7314             : static GEN
    7315         161 : mfeval_i(GEN mf, GEN F, GEN vtau, long flag, long bitprec)
    7316             : {
    7317             :   GEN L0, vL, vb, sqN, vczd, vTAU, vs, van, vE;
    7318         161 :   long N = MF_get_N(mf), N0, ta, lv, i, prec = nbits2prec(bitprec);
    7319         161 :   GEN gN = utoipos(N), gk = mf_get_gk(F), gk1 = gsubgs(gk,1), vgk;
    7320         161 :   long flscal = 0;
    7321             : 
    7322             :   /* gen_0 is ignored, second component assumes Ramanujan-Petersson in
    7323             :    * 1/2-integer weight */
    7324         161 :   vgk = mkvec2(gen_0, mfiscuspidal(mf,F)? gmul2n(gk1,-1): gk1);
    7325         161 :   ta = typ(vtau);
    7326         161 :   if (!is_vec_t(ta)) { flscal = 1; vtau = mkvec(vtau); ta = t_VEC; }
    7327         161 :   lv = lg(vtau);
    7328         161 :   sqN = sqrtr_abs(utor(N, prec));
    7329         161 :   vs = const_vec(lv-1, NULL);
    7330         161 :   vb = const_vec(lv-1, NULL);
    7331         161 :   vL = cgetg(lv, t_VEC);
    7332         161 :   vTAU = cgetg(lv, t_VEC);
    7333         161 :   vczd = cgetg(lv, t_VEC);
    7334         161 :   L0 = mfthetaancreate(NULL, gN, vgk); /* only for thetacost */
    7335         161 :   vE = mfgetembed(F, prec);
    7336         161 :   N0 = 0;
    7337         343 :   for (i = 1; i < lv; i++)
    7338             :   {
    7339         189 :     GEN z = gel(vtau,i), tau, U;
    7340             :     long w, n;
    7341             : 
    7342         189 :     gel(vs,i) = evalcusp(mf, F, z, prec);
    7343         182 :     if (gel(vs,i)) continue;
    7344         154 :     tau = cxredga0N(N, z, &U, &gel(vczd,i), flag);
    7345         154 :     if (!flag) w = 0; else { w = mfZC_width(N, gel(U,1)); tau = gdivgu(tau,w); }
    7346         154 :     gel(vTAU,i) = mulcxmI(gmul(tau, sqN));
    7347         154 :     n = lfunthetacost(L0, real_i(gel(vTAU,i)), 0, bitprec);
    7348         154 :     if (N0 < n) N0 = n;
    7349         154 :     if (flag)
    7350             :     {
    7351          42 :       GEN A, al, v = mfslashexpansion(mf, F, ZM_inv(U,NULL), n, 0, &A, prec);
    7352          42 :       gel(vL,i) = van_embedall(v, vE, gN, vgk);
    7353          42 :       al = gel(A,1);
    7354          42 :       if (!gequal0(al))
    7355           7 :         gel(vb,i) = gexp(gmul(gmul(gmulsg(w,al),PiI2(prec)), tau), prec);
    7356             :     }
    7357             :   }
    7358         154 :   if (!flag)
    7359             :   {
    7360         112 :     van = mfcoefs_i(F, N0, 1);
    7361         112 :     vL = const_vec(lv-1, van_embedall(van, vE, gN, vgk));
    7362             :   }
    7363         336 :   for (i = 1; i < lv; i++)
    7364             :   {
    7365             :     GEN T;
    7366         182 :     if (gel(vs,i)) continue;
    7367         154 :     T = gpow(gel(vczd,i), gneg(gk), prec);
    7368         154 :     if (flag && gel(vb,i)) T = gmul(T, gel(vb,i));
    7369         154 :     gel(vs,i) = lfunthetaall(T, gel(vL,i), gel(vTAU,i), bitprec);
    7370             :   }
    7371         154 :   return flscal? gel(vs,1): vs;
    7372             : }
    7373             : 
    7374             : static long
    7375        1141 : mfistrivial(GEN F)
    7376             : {
    7377        1141 :   switch(mf_get_type(F))
    7378             :   {
    7379           7 :     case t_MF_CONST: return lg(gel(F,2)) == 1;
    7380         259 :     case t_MF_LINEAR: case t_MF_LINEAR_BHN: return gequal0(gel(F,3));
    7381         875 :     default: return 0;
    7382             :   }
    7383             : }
    7384             : 
    7385             : static long
    7386         959 : mf_same_k(GEN mf, GEN f) { return gequal(MF_get_gk(mf), mf_get_gk(f)); }
    7387             : static long
    7388         917 : mf_same_CHI(GEN mf, GEN f)
    7389             : {
    7390         917 :   GEN F1, F2, chi1, chi2, CHI1 = MF_get_CHI(mf), CHI2 = mf_get_CHI(f);
    7391             :   /* are the primitive chars attached to CHI1 and CHI2 equal ? */
    7392         917 :   F1 = znconreyconductor(gel(CHI1,1), gel(CHI1,2), &chi1);
    7393         917 :   if (typ(F1) == t_VEC) F1 = gel(F1,1);
    7394         917 :   F2 = znconreyconductor(gel(CHI2,1), gel(CHI2,2), &chi2);
    7395         917 :   if (typ(F2) == t_VEC) F2 = gel(F2,1);
    7396         917 :   return equalii(F1,F2) && ZV_equal(chi1,chi2);
    7397             : }
    7398             : /* check k and CHI rigorously, but not coefficients nor N */
    7399             : static long
    7400         238 : mfisinspace_i(GEN mf, GEN F)
    7401             : {
    7402         238 :   return mfistrivial(F) || (mf_same_k(mf,F) && mf_same_CHI(mf,F));
    7403             : }
    7404             : static void
    7405           7 : err_space(GEN F)
    7406           7 : { pari_err_DOMAIN("mftobasis", "form", "does not belong to",
    7407           0 :                   strtoGENstr("space"), F); }
    7408             : 
    7409             : static long
    7410         147 : mfcheapeisen(GEN mf)
    7411             : {
    7412         147 :   long k, L, N = MF_get_N(mf);
    7413             :   GEN P;
    7414         147 :   if (N <= 70) return 1;
    7415          84 :   k = itos(gceil(MF_get_gk(mf)));
    7416          84 :   if (odd(k)) k--;
    7417          84 :   switch (k)
    7418             :   {
    7419           0 :     case 2:  L = 190; break;
    7420          14 :     case 4:  L = 162; break;
    7421          70 :     case 6:
    7422          70 :     case 8:  L = 88; break;
    7423           0 :     case 10: L = 78; break;
    7424           0 :     default: L = 66; break;
    7425             :   }
    7426          84 :   P = gel(myfactoru(N), 1);
    7427          84 :   return P[lg(P)-1] <= L;
    7428             : }
    7429             : 
    7430             : static GEN
    7431         182 : myimag_i(GEN tau)
    7432             : {
    7433         182 :   long tc = typ(tau);
    7434         182 :   if (tc == t_INFINITY || tc == t_INT || tc == t_FRAC)
    7435          28 :     return gen_1;
    7436         154 :   if (tc == t_VEC)
    7437             :   {
    7438             :     long ltau, i;
    7439           7 :     GEN z = cgetg_copy(tau, &ltau);
    7440          42 :     for (i=1; i<ltau; i++) gel(z,i) = myimag_i(gel(tau,i));
    7441           7 :     return z;
    7442             :   }
    7443         147 :   return imag_i(tau);
    7444             : }
    7445             : 
    7446             : static GEN
    7447         147 : mintau(GEN vtau)
    7448             : {
    7449         147 :   if (!is_vec_t(typ(vtau))) return myimag_i(vtau);
    7450           7 :   return (lg(vtau) == 1)? gen_1: vecmin(myimag_i(vtau));
    7451             : }
    7452             : 
    7453             : /* initialization for mfgaexpansion: what does not depend on cusp */
    7454             : static GEN
    7455         987 : mf_eisendec(GEN mf, GEN F, long prec)
    7456             : {
    7457         987 :   GEN B = liftpol_shallow(mfeisensteindec(mf, F)), v = variables_vecsmall(B);
    7458         987 :   GEN Mvecj = obj_check(mf, MF_EISENSPACE);
    7459         987 :   long l = lg(v), i, ord;
    7460         987 :   if (lg(Mvecj) < 5) Mvecj = gel(Mvecj,1);
    7461         987 :   ord = itou(gel(Mvecj,4));
    7462        1043 :   for (i = 1; i < l; i++)
    7463         714 :     if (v[i] != 1)
    7464             :     {
    7465             :       GEN d;
    7466             :       long e;
    7467         658 :       B = Q_remove_denom(B, &d);
    7468         658 :       e = gexpo(B);
    7469         658 :       if (e > 0) prec += nbits2prec(e);
    7470         658 :       B = gsubst(B, v[i], rootsof1u_cx(ord, prec));
    7471         658 :       if (d) B = gdiv(B, d);
    7472         658 :       break;
    7473             :     }
    7474         987 :   return B;
    7475             : }
    7476             : 
    7477             : GEN
    7478         161 : mfeval(GEN mf0, GEN F, GEN vtau, long bitprec)
    7479             : {
    7480         161 :   pari_sp av = avma;
    7481         161 :   long flnew = 1;
    7482         161 :   GEN mf = checkMF_i(mf0);
    7483         161 :   if (!mf) pari_err_TYPE("mfeval", mf0);
    7484         161 :   if (!checkmf_i(F)) pari_err_TYPE("mfeval", F);
    7485         161 :   if (!mfisinspace_i(mf, F)) err_space(F);
    7486         161 :   if (!obj_check(mf, MF_EISENSPACE)) flnew = mfcheapeisen(mf);
    7487         161 :   if (flnew && gcmpgs(gmulsg(2*MF_get_N(mf), mintau(vtau)), 1) >= 0) flnew = 0;
    7488         161 :   return gerepilecopy(av, mfeval_i(mf, F, vtau, flnew, bitprec));
    7489             : }
    7490             : 
    7491             : static long
    7492         189 : val(GEN v, long bit)
    7493             : {
    7494         189 :   long c, l = lg(v);
    7495         392 :   for (c = 1; c < l; c++)
    7496         378 :     if (gexpo(gel(v,c)) > -bit) return c-1;
    7497          14 :   return -1;
    7498             : }
    7499             : GEN
    7500         203 : mfcuspval(GEN mf, GEN F, GEN cusp, long bitprec)
    7501             : {
    7502         203 :   pari_sp av = avma;
    7503         203 :   long lvE, w, N, sb, n, A, C, prec = nbits2prec(bitprec);
    7504             :   GEN ga, gk, vE;
    7505         203 :   mf = checkMF(mf);
    7506         203 :   if (!checkmf_i(F)) pari_err_TYPE("mfcuspval",F);
    7507         203 :   N = MF_get_N(mf);
    7508         203 :   cusp_canon(cusp, N, &A, &C);
    7509         203 :   gk = mf_get_gk(F);
    7510         203 :   if (typ(gk) != t_INT)
    7511             :   {
    7512          42 :     GEN FT = mfmultheta(F), mf2 = obj_checkbuild(mf, MF_MF2INIT, &mf2init);
    7513          42 :     GEN r = mfcuspval(mf2, FT, cusp, bitprec);
    7514          42 :     if ((C & 3L) == 2)
    7515             :     {
    7516          14 :       GEN z = uutoQ(1,4);
    7517          14 :       r = gsub(r, typ(r) == t_VEC? const_vec(lg(r)-1, z): z);
    7518             :     }
    7519          42 :     return gerepileupto(av, r);
    7520             :   }
    7521         161 :   vE = mfgetembed(F, prec);
    7522         161 :   lvE = lg(vE);
    7523         161 :   w = mfcuspcanon_width(N, C);
    7524         161 :   sb = w * mfsturmNk(N, itos(gk));
    7525         161 :   ga = cusp2mat(A,C);
    7526         168 :   for (n = 8;; n = minss(sb, n << 1))
    7527           7 :   {
    7528         168 :     GEN R = mfgaexpansion(mf, F, ga, n, prec), res = liftpol_shallow(gel(R,3));
    7529         168 :     GEN v = cgetg(lvE-1, t_VECSMALL);
    7530         168 :     long j, ok = 1;
    7531         168 :     res = RgC_embedall(res, vE);
    7532         357 :     for (j = 1; j < lvE; j++)
    7533             :     {
    7534         189 :       v[j] = val(gel(res,j), bitprec/2);
    7535         189 :       if (v[j] < 0) ok = 0;
    7536             :     }
    7537         168 :     if (ok)
    7538             :     {
    7539         154 :       res = cgetg(lvE, t_VEC);
    7540         329 :       for (j = 1; j < lvE; j++) gel(res,j) = gadd(gel(R,1), uutoQ(v[j], w));
    7541         154 :       return gerepilecopy(av, lvE==2? gel(res,1): res);
    7542             :     }
    7543          14 :     if (n == sb) return lvE==2? mkoo(): const_vec(lvE-1, mkoo()); /* 0 */
    7544             :   }
    7545             : }
    7546             : 
    7547             : long
    7548         224 : mfiscuspidal(GEN mf, GEN F)
    7549             : {
    7550         224 :   pari_sp av = avma;
    7551             :   GEN mf2;
    7552         224 :   if (space_is_cusp(MF_get_space(mf))) return 1;
    7553          98 :   if (typ(mf_get_gk(F)) == t_INT)
    7554             :   {
    7555          56 :     GEN v = mftobasis(mf,F,0), vE = vecslice(v, 1, lg(MF_get_E(mf))-1);
    7556          56 :     return gc_long(av, gequal0(vE));
    7557             :   }
    7558          42 :   if (!gequal0(mfak_i(F, 0))) return 0;
    7559          21 :   mf2 = obj_checkbuild(mf, MF_MF2INIT, &mf2init);
    7560          21 :   return mfiscuspidal(mf2, mfmultheta(F));
    7561             : }
    7562             : 
    7563             : /* F = vector of newforms in mftobasis format */
    7564             : static GEN
    7565          98 : mffrickeeigen_i(GEN mf, GEN F, GEN vE, long prec)
    7566             : {
    7567          98 :   GEN M, Z, L0, gN = MF_get_gN(mf), gk = MF_get_gk(mf);
    7568          98 :   long N0, i, lM, bit = prec2nbits(prec), k = itou(gk);
    7569          98 :   long LIM = 5; /* Sturm bound is enough */
    7570             : 
    7571          98 :   L0 = mfthetaancreate(NULL, gN, gk); /* only for thetacost */
    7572          98 : START:
    7573          98 :   N0 = lfunthetacost(L0, gen_1, LIM, bit);
    7574          98 :   M = mfcoefs_mf(mf, N0, 1);
    7575          98 :   lM = lg(F);
    7576          98 :   Z = cgetg(lM, t_VEC);
    7577         273 :   for (i = 1; i < lM; i++)
    7578             :   { /* expansion of D * F[i] */
    7579         175 :     GEN D, z, van = RgM_RgC_mul(M, Q_remove_denom(gel(F,i), &D));
    7580         175 :     GEN L = van_embedall(van, gel(vE,i), gN, gk);
    7581         175 :     long l = lg(L), j, bit_add = D? expi(D): 0;
    7582         175 :     gel(Z,i) = z = cgetg(l, t_VEC);
    7583         553 :     for (j = 1; j < l; j++)
    7584             :     {
    7585             :       GEN v, C, C0;
    7586             :       long m, e;
    7587         511 :       for (m = 0; m <= LIM; m++)
    7588             :       {
    7589         511 :         v = lfuntheta(gmael(L,j,2), gen_1, m, bit);
    7590         511 :         if (gexpo(v) > bit_add - bit/2) break;
    7591             :       }
    7592         378 :       if (m > LIM) { LIM <<= 1; goto START; }
    7593         378 :       C = mulcxpowIs(gdiv(v,conj_i(v)), 2*m - k);
    7594         378 :       C0 = grndtoi(C, &e); if (e < 5-bit_accuracy(precision(C))) C = C0;
    7595         378 :       gel(z,j) = C;
    7596             :     }
    7597             :   }
    7598          98 :   return Z;
    7599             : }
    7600             : static GEN
    7601          77 : mffrickeeigen(GEN mf, GEN vE, long prec)
    7602             : {
    7603          77 :   GEN D = obj_check(mf, MF_FRICKE);
    7604          77 :   if (D) { long p = gprecision(D); if (!p || p >= prec) return D; }
    7605          70 :   D = mffrickeeigen_i(mf, MF_get_newforms(mf), vE, prec);
    7606          70 :   return obj_insert(mf, MF_FRICKE, D);
    7607             : }
    7608             : 
    7609             : /* integral weight, new space for primitive quadratic character CHIP;
    7610             :  * MF = vector of embedded eigenforms coefs on mfbasis, by orbit.
    7611             :  * Assume N > Q > 1 and (Q,f(CHIP)) = 1 */
    7612             : static GEN
    7613          56 : mfatkineigenquad(GEN mf, GEN CHIP, long Q, GEN MF, long bitprec)
    7614             : {
    7615             :   GEN L0, la2, S, F, vP, tau, wtau, Z, va, vb, den, coe, sqrtQ, sqrtN;
    7616          56 :   GEN M, gN, gk = MF_get_gk(mf);
    7617          56 :   long N0, x, yq, i, j, lF, dim, muQ, prec = nbits2prec(bitprec);
    7618          56 :   long N = MF_get_N(mf), k = itos(gk), NQ = N / Q;
    7619             : 
    7620             :   /* Q coprime to FC */
    7621          56 :   F = MF_get_newforms(mf);
    7622          56 :   vP = MF_get_fields(mf);
    7623          56 :   lF = lg(F);
    7624          56 :   Z = cgetg(lF, t_VEC);
    7625          56 :   S = MF_get_S(mf); dim = lg(S) - 1;
    7626          56 :   muQ = mymoebiusu(Q);
    7627          56 :   if (muQ)
    7628             :   {
    7629          42 :     GEN SQ = cgetg(dim+1,t_VEC), Qk = gpow(stoi(Q), sstoQ(k-2, 2), prec);
    7630          42 :     long i, bit2 = bitprec >> 1;
    7631         154 :     for (j = 1; j <= dim; j++) gel(SQ,j) = mfak_i(gel(S,j), Q);
    7632          84 :     for (i = 1; i < lF; i++)
    7633             :     {
    7634          42 :       GEN S = RgV_dotproduct(gel(F,i), SQ), T = gel(vP,i);
    7635             :       long e;
    7636          42 :       if (degpol(T) > 1 && typ(S) != t_POLMOD) S = gmodulo(S, T);
    7637          42 :       S = grndtoi(gdiv(conjvec(S, prec), Qk), &e);
    7638          42 :       if (e > -bit2) pari_err_PREC("mfatkineigenquad");
    7639          42 :       if (muQ == -1) S = gneg(S);
    7640          42 :       gel(Z,i) = S;
    7641             :     }
    7642          42 :     return Z;
    7643             :   }
    7644          14 :   la2 = mfchareval(CHIP, Q); /* 1 or -1 */
    7645          14 :   (void)cbezout(Q, NQ, &x, &yq);
    7646          14 :   sqrtQ = sqrtr_abs(utor(Q,prec));
    7647          14 :   tau = mkcomplex(gadd(sstoQ(-1, NQ), uutoQ(1, 1000)),
    7648             :                   divru(sqrtQ, N));
    7649          14 :   den = gaddgs(gmulsg(NQ, tau), 1);
    7650          14 :   wtau = gdiv(gsub(gmulsg(x, tau), sstoQ(yq, Q)), den);
    7651          14 :   coe = gpowgs(gmul(sqrtQ, den), k);
    7652             : 
    7653          14 :   sqrtN = sqrtr_abs(utor(N,prec));
    7654          14 :   tau  = mulcxmI(gmul(tau,  sqrtN));
    7655          14 :   wtau = mulcxmI(gmul(wtau, sqrtN));
    7656          14 :   gN = utoipos(N);
    7657          14 :   L0 = mfthetaancreate(NULL, gN, gk); /* only for thetacost */
    7658          14 :   N0 = maxss(lfunthetacost(L0,real_i(tau), 0,bitprec),
    7659             :              lfunthetacost(L0,real_i(wtau),0,bitprec));
    7660          14 :   M = mfcoefs_mf(mf, N0, 1);
    7661          14 :   va = cgetg(dim+1, t_VEC);
    7662          14 :   vb = cgetg(dim+1, t_VEC);
    7663         105 :   for (j = 1; j <= dim; j++)
    7664             :   {
    7665          91 :     GEN L, v = vecslice(gel(M,j), 2, N0+1); /* remove a0 */
    7666          91 :     settyp(v, t_VEC); L = mfthetaancreate(v, gN, gk);
    7667          91 :     gel(va,j) = lfuntheta(L, tau,0,bitprec);
    7668          91 :     gel(vb,j) = lfuntheta(L,wtau,0,bitprec);
    7669             :   }
    7670          84 :   for (i = 1; i < lF; i++)
    7671             :   {
    7672          70 :     GEN z, FE = gel(MF,i);
    7673          70 :     long l = lg(FE);
    7674          70 :     z = cgetg(l, t_VEC);
    7675          70 :     for (j = 1; j < l; j++)
    7676             :     {
    7677          70 :       GEN f = gel(FE,j), a = RgV_dotproduct(va,f), b = RgV_dotproduct(vb,f);
    7678          70 :       GEN la = ground( gdiv(b, gmul(a,coe)) );
    7679          70 :       if (!gequal(gsqr(la), la2)) pari_err_PREC("mfatkineigenquad");
    7680          70 :       if (typ(la) == t_INT)
    7681             :       {
    7682          70 :         if (j != 1) pari_err_BUG("mfatkineigenquad");
    7683          70 :         z = const_vec(l-1, la); break;
    7684             :       }
    7685           0 :       gel(z,j) = la;
    7686             :     }
    7687          70 :     gel(Z,i) = z;
    7688             :   }
    7689          14 :   return Z;
    7690             : }
    7691             : 
    7692             : static GEN
    7693          84 : myusqrt(ulong a, long prec)
    7694             : {
    7695          84 :   if (a == 1UL) return gen_1;
    7696          70 :   if (uissquareall(a, &a)) return utoipos(a);
    7697          49 :   return sqrtr_abs(utor(a, prec));
    7698             : }
    7699             : /* Assume mf is a nontrivial new space, rational primitive character CHIP
    7700             :  * and (Q,FC) = 1 */
    7701             : static GEN
    7702         105 : mfatkinmatnewquad(GEN mf, GEN CHIP, long Q, long flag, long PREC)
    7703             : {
    7704         105 :   GEN cM, M, D, MF, den, vE, F = MF_get_newforms(mf);
    7705         105 :   long i, c, e, prec, bitprec, lF = lg(F), N = MF_get_N(mf), k = MF_get_k(mf);
    7706             : 
    7707         105 :   if (Q == 1) return mkvec4(gen_0, matid(MF_get_dim(mf)), gen_1, mf);
    7708         105 :   den = gel(MF_get_Minv(mf), 2);
    7709         105 :   bitprec = expi(den) + 64;
    7710         105 :   if (!flag) bitprec = maxss(bitprec, prec2nbits(PREC));
    7711             : 
    7712          35 : START:
    7713         105 :   prec = nbits2prec(bitprec);
    7714         105 :   vE = mfeigenembed(mf, prec);
    7715         105 :   M = cgetg(lF, t_VEC);
    7716         280 :   for (i = 1; i < lF; i++) gel(M,i) = RgC_embedall(gel(F,i), gel(vE,i));
    7717         105 :   if (Q != N)
    7718             :   {
    7719          56 :     D = mfatkineigenquad(mf, CHIP, Q, M, bitprec);
    7720          56 :     c = odd(k)? Q: 1;
    7721             :   }
    7722             :   else
    7723             :   {
    7724          49 :     D = mffrickeeigen(mf, vE, prec);
    7725          49 :     c = mfcharmodulus(CHIP); if (odd(k)) c = -Q/c;
    7726             :   }
    7727         105 :   D = shallowconcat1(D);
    7728         105 :   if (vec_isconst(D)) { MF = diagonal_shallow(D); flag = 0; }
    7729             :   else
    7730             :   {
    7731          63 :     M = shallowconcat1(M);
    7732          63 :     MF = RgM_mul(matmuldiagonal(M,D), ginv(M));
    7733             :   }
    7734         105 :   if (!flag) return mkvec4(gen_0, MF, gen_1, mf);
    7735             : 
    7736          21 :   if (c > 0)
    7737          21 :     cM = myusqrt(c, PREC);
    7738             :   else
    7739             :   {
    7740           0 :     MF = imag_i(MF); c = -c;
    7741           0 :     cM = mkcomplex(gen_0, myusqrt(c,PREC));
    7742             :   }
    7743          21 :   if (c != 1) MF = RgM_Rg_mul(MF, myusqrt(c,prec));
    7744          21 :   MF = grndtoi(RgM_Rg_mul(MF,den), &e);
    7745          21 :   if (e > -32) { bitprec <<= 1; goto START; }
    7746          21 :   MF = RgM_Rg_div(MF, den);
    7747          21 :   if (is_rational_t(typ(cM)) && !isint1(cM))
    7748           0 :   { MF = RgM_Rg_div(MF, cM); cM = gen_1; }
    7749          21 :   return mkvec4(gen_0, MF, cM, mf);
    7750             : }
    7751             : 
    7752             : /* let CHI mod N, Q || N, return \bar{CHI_Q} * CHI_{N/Q} */
    7753             : static GEN
    7754         105 : mfcharAL(GEN CHI, long Q)
    7755             : {
    7756         105 :   GEN G = gel(CHI,1), c = gel(CHI,2), cycc, d, P, E, F;
    7757         105 :   long l = lg(c), N = mfcharmodulus(CHI), i;
    7758         105 :   if (N == Q) return mfcharconj(CHI);
    7759          49 :   if (N == 1) return CHI;
    7760          42 :   CHI = leafcopy(CHI);
    7761          42 :   gel(CHI,2) = d = leafcopy(c);
    7762          42 :   F = znstar_get_faN(G);
    7763          42 :   P = gel(F,1);
    7764          42 :   E = gel(F,2);
    7765          42 :   cycc = znstar_get_conreycyc(G);
    7766          42 :   if (!odd(Q) && equaliu(gel(P,1), 2) && E[1] >= 3)
    7767          14 :     gel(d,2) = Fp_neg(gel(d,2), gel(cycc,2));
    7768          56 :   else for (i = 1; i < l; i++)
    7769          28 :     if (!umodui(Q, gel(P,i))) gel(d,i) = Fp_neg(gel(d,i), gel(cycc,i));
    7770          42 :   return CHI;
    7771             : }
    7772             : static long
    7773         231 : atkin_get_NQ(long N, long Q, const char *f)
    7774             : {
    7775         231 :   long NQ = N / Q;
    7776         231 :   if (N % Q) pari_err_DOMAIN(f,"N % Q","!=",gen_0,utoi(Q));
    7777         231 :   if (ugcd(NQ, Q) > 1) pari_err_DOMAIN(f,"gcd(Q,N/Q)","!=",gen_1,utoi(Q));
    7778         231 :   return NQ;
    7779             : }
    7780             : 
    7781             : /* transform mf to new_NEW if possible */
    7782             : static GEN
    7783        1330 : MF_set_new(GEN mf)
    7784             : {
    7785        1330 :   GEN vMjd, vj, gk = MF_get_gk(mf);
    7786             :   long l, j;
    7787        1330 :   if (MF_get_space(mf) != mf_CUSP
    7788        1330 :       || typ(gk) != t_INT || itou(gk) == 1) return mf;
    7789         175 :   vMjd = MFcusp_get_vMjd(mf); l = lg(vMjd);
    7790         175 :   if (l > 1 && gel(vMjd,1)[1] != MF_get_N(mf)) return mf; /* oldspace != 0 */
    7791         168 :   mf = shallowcopy(mf);
    7792         168 :   gel(mf,1) = shallowcopy(gel(mf,1));
    7793         168 :   MF_set_space(mf, mf_NEW);
    7794         168 :   vj = cgetg(l, t_VECSMALL);
    7795         917 :   for (j = 1; j < l; j++) vj[j] = gel(vMjd, j)[2];
    7796         168 :   gel(mf,4) = vj; return mf;
    7797             : }
    7798             : 
    7799             : /* if flag = 1, rationalize, else don't */
    7800             : static GEN
    7801         210 : mfatkininit_i(GEN mf, long Q, long flag, long prec)
    7802             : {
    7803             :   GEN M, B, C, CHI, CHIAL, G, chi, P, z, g, mfB, s, Mindex, Minv;
    7804         210 :   long j, l, lim, ord, FC, NQ, cQ, nk, dk, N = MF_get_N(mf);
    7805             : 
    7806         210 :   B = MF_get_basis(mf); l = lg(B);
    7807         210 :   M = cgetg(l, t_MAT); if (l == 1) return mkvec4(gen_0,M,gen_1,mf);
    7808         210 :   Qtoss(MF_get_gk(mf), &nk,&dk);
    7809         210 :   Q = labs(Q);
    7810         210 :   NQ = atkin_get_NQ(N, Q, "mfatkininit");
    7811         210 :   CHI = MF_get_CHI(mf);
    7812         210 :   CHI = mfchartoprimitive(CHI, &FC);
    7813         210 :   ord = mfcharorder(CHI);
    7814         210 :   mf = MF_set_new(mf);
    7815         210 :   if (MF_get_space(mf) == mf_NEW && ord <= 2 && NQ % FC == 0 && dk == 1)
    7816         105 :     return mfatkinmatnewquad(mf, CHI, Q, flag, prec);
    7817             :   /* now flag != 0 */
    7818         105 :   G   = gel(CHI,1);
    7819         105 :   chi = gel(CHI,2);
    7820         105 :   if (Q == N) { g = mkmat22s(0, -1, N, 0); cQ = NQ; } /* Fricke */
    7821             :   else
    7822             :   {
    7823          28 :     GEN F, gQP = utoi(ugcd(Q, FC));
    7824             :     long t, v;
    7825          28 :     chi = znchardecompose(G, chi, gQP);
    7826          28 :     F = znconreyconductor(G, chi, &chi);
    7827          28 :     G = znstar0(F,1);
    7828          28 :     (void)cbezout(Q, NQ, &t, &v);
    7829          28 :     g = mkmat22s(Q*t, 1, -N*v, Q);
    7830          28 :     cQ = -NQ*v;
    7831             :   }
    7832         105 :   C = s = gen_1;
    7833             :   /* N.B. G,chi are G_Q,chi_Q [primitive] at this point */
    7834         105 :   if (lg(chi) != 1) C = ginv( znchargauss(G, chi, gen_1, prec2nbits(prec)) );
    7835         105 :   if (dk == 1)
    7836          84 :   { if (odd(nk)) s = myusqrt(Q,prec); }
    7837             :   else
    7838             :   {
    7839          21 :     long r = nk >> 1; /* k-1/2 */
    7840          21 :     s = gpow(utoipos(Q), mkfracss(odd(r)? 1: 3, 4), prec);
    7841          21 :     if (odd(cQ))
    7842             :     {
    7843          21 :       long t = r + ((cQ-1) >> 1);
    7844          21 :       s = mkcomplex(s, odd(t)? gneg(s): s);
    7845             :     }
    7846             :   }
    7847         105 :   if (!isint1(s)) C = gmul(C, s);
    7848         105 :   CHIAL = mfcharAL(CHI, Q);
    7849         105 :   if (dk == 2)
    7850             :   {
    7851          21 :     ulong q = odd(Q)? Q << 2: Q, Nq = ulcm(q, mfcharmodulus(CHIAL));
    7852          21 :     CHIAL = induceN(Nq, CHIAL);
    7853          21 :     CHIAL = mfcharmul(CHIAL, induce(gel(CHIAL,1), utoipos(q)));
    7854             :   }
    7855         105 :   CHIAL = mfchartoprimitive(CHIAL,NULL);
    7856         105 :   mfB = gequal(CHIAL,CHI)? mf: mfinit_Nndkchi(N,nk,dk,CHIAL,MF_get_space(mf),0);
    7857         105 :   Mindex = MF_get_Mindex(mfB);
    7858         105 :   Minv = MF_get_Minv(mfB);
    7859         105 :   P = z = NULL;
    7860         105 :   if (ord > 2) { P = mfcharpol(CHI); z = rootsof1u_cx(ord, prec); }
    7861         105 :   lim = maxss(mfsturm(mfB), mfsturm(mf)) + 1;
    7862         343 :   for (j = 1; j < l; j++)
    7863             :   {
    7864         238 :     GEN v = mfslashexpansion(mf, gel(B,j), g, lim, 0, NULL, prec+EXTRAPREC64);
    7865             :     long junk;
    7866         238 :     if (!isint1(C)) v = RgV_Rg_mul(v, C);
    7867         238 :     v = bestapprnf(v, P, z, prec);
    7868         238 :     v = vecpermute_partial(v, Mindex, &junk);
    7869         238 :     v = Minv_RgC_mul(Minv, v); /* cf mftobasis_i */
    7870         238 :     gel(M, j) = v;
    7871             :   }
    7872         105 :   if (is_rational_t(typ(C)) && !gequal1(C)) { M = gdiv(M, C); C = gen_1; }
    7873         105 :   if (mfB == mf) mfB = gen_0;
    7874         105 :   return mkvec4(mfB, M, C, mf);
    7875             : }
    7876             : GEN
    7877          91 : mfatkininit(GEN mf, long Q, long prec)
    7878             : {
    7879          91 :   pari_sp av = avma;
    7880          91 :   mf = checkMF(mf); return gerepilecopy(av, mfatkininit_i(mf, Q, 1, prec));
    7881             : }
    7882             : static void
    7883          56 : checkmfa(GEN z)
    7884             : {
    7885          56 :   if (typ(z) != t_VEC || lg(z) != 5 || typ(gel(z,2)) != t_MAT
    7886          56 :       || !checkMF_i(gel(z,4))
    7887          56 :       || (!isintzero(gel(z,1)) && !checkMF_i(gel(z,1))))
    7888           0 :     pari_err_TYPE("mfatkin [please apply mfatkininit()]",z);
    7889          56 : }
    7890             : 
    7891             : /* Apply atkin Q to closure F */
    7892             : GEN
    7893          56 : mfatkin(GEN mfa, GEN F)
    7894             : {
    7895          56 :   pari_sp av = avma;
    7896             :   GEN z, mfB, MQ, mf;
    7897          56 :   checkmfa(mfa);
    7898          56 :   mfB= gel(mfa,1);
    7899          56 :   MQ = gel(mfa,2);
    7900          56 :   mf = gel(mfa,4);
    7901          56 :   if (typ(mfB) == t_INT) mfB = mf;
    7902          56 :   z = RgM_RgC_mul(MQ, mftobasis_i(mf,F));
    7903          56 :   return gerepileupto(av, mflinear(mfB, z));
    7904             : }
    7905             : 
    7906             : GEN
    7907          49 : mfatkineigenvalues(GEN mf, long Q, long prec)
    7908             : {
    7909          49 :   pari_sp av = avma;
    7910             :   GEN vF, L, CHI, M, mfatk, C, MQ, vE, mfB;
    7911             :   long N, NQ, l, i;
    7912             : 
    7913          49 :   mf = checkMF(mf); N = MF_get_N(mf);
    7914          49 :   vF = MF_get_newforms(mf); l = lg(vF);
    7915             :   /* N.B. k is integral */
    7916          49 :   if (l == 1) { set_avma(av); return cgetg(1, t_VEC); }
    7917          49 :   L = cgetg(l, t_VEC);
    7918          49 :   if (Q == 1)
    7919             :   {
    7920           7 :     GEN vP = MF_get_fields(mf);
    7921          21 :     for (i = 1; i < l; i++) gel(L,i) = const_vec(degpol(gel(vP,i)), gen_1);
    7922           7 :     return L;
    7923             :   }
    7924          42 :   vE = mfeigenembed(mf,prec);
    7925          42 :   if (Q == N) return gerepileupto(av, mffrickeeigen(mf, vE, prec));
    7926          21 :   Q = labs(Q);
    7927          21 :   NQ = atkin_get_NQ(N, Q, "mfatkineigenvalues"); /* != 1 */
    7928          21 :   mfatk = mfatkininit(mf, Q, prec);
    7929          21 :   mfB= gel(mfatk,1); if (typ(mfB) != t_VEC) mfB = mf;
    7930          21 :   MQ = gel(mfatk,2);
    7931          21 :   C  = gel(mfatk,3);
    7932          21 :   M = row(mfcoefs_mf(mfB,1,1), 2); /* vec of a_1(b_i) for mfbasis functions */
    7933          56 :   for (i = 1; i < l; i++)
    7934             :   {
    7935          35 :     GEN c = RgV_dotproduct(RgM_RgC_mul(MQ,gel(vF,i)), M); /* C * eigen_i */
    7936          35 :     gel(L,i) = Rg_embedall_i(c, gel(vE,i));
    7937             :   }
    7938          21 :   if (!gequal1(C)) L = gdiv(L, C);
    7939          21 :   CHI = MF_get_CHI(mf);
    7940          21 :   if (mfcharorder(CHI) <= 2 && NQ % mfcharconductor(CHI) == 0) L = ground(L);
    7941          21 :   return gerepilecopy(av, L);
    7942             : }
    7943             : 
    7944             : /* expand B_d V, keeping same length */
    7945             : static GEN
    7946        6083 : bdexpand(GEN V, long d)
    7947             : {
    7948             :   GEN W;
    7949             :   long N, n;
    7950        6083 :   if (d == 1) return V;
    7951        2226 :   N = lg(V)-1; W = zerovec(N);
    7952       43043 :   for (n = 0; n <= (N-1)/d; n++) gel(W, n*d+1) = gel(V, n+1);
    7953        2226 :   return W;
    7954             : }
    7955             : /* expand B_d V, increasing length up to lim */
    7956             : static GEN
    7957         287 : bdexpandall(GEN V, long d, long lim)
    7958             : {
    7959             :   GEN W;
    7960             :   long N, n;
    7961         287 :   if (d == 1) return V;
    7962          35 :   N = lg(V)-1; W = zerovec(lim);
    7963         259 :   for (n = 0; n <= N-1 && n*d <= lim; n++) gel(W, n*d+1) = gel(V, n+1);
    7964          35 :   return W;
    7965             : }
    7966             : 
    7967             : static void
    7968        9086 : parse_vecj(GEN T, GEN *E1, GEN *E2)
    7969             : {
    7970        9086 :   if (lg(T)==3) { *E1 = gel(T,1); *E2 = gel(T,2); }
    7971        4963 :   else { *E1 = T; *E2 = NULL; }
    7972        9086 : }
    7973             : 
    7974             : /* g in M_2(Z) ? */
    7975             : static int
    7976        2877 : check_M2Z(GEN g)
    7977        2877 : {  return typ(g) == t_MAT && lg(g) == 3 && lgcols(g) == 3 && RgM_is_ZM(g); }
    7978             : /* g in SL_2(Z) ? */
    7979             : static int
    7980        1757 : check_SL2Z(GEN g) { return check_M2Z(g) && equali1(ZM_det(g)); }
    7981             : 
    7982             : static GEN
    7983        9065 : mfcharcxeval(GEN CHI, long n, long prec)
    7984             : {
    7985        9065 :   ulong ord, N = mfcharmodulus(CHI);
    7986             :   GEN ordg;
    7987        9065 :   if (N == 1) return gen_1;
    7988        3696 :   if (ugcd(N, labs(n)) > 1) return gen_0;
    7989        3696 :   ordg = gmfcharorder(CHI);
    7990        3696 :   ord = itou(ordg);
    7991        3696 :   return rootsof1q_cx(znchareval_i(CHI,n,ordg), ord, prec);
    7992             : }
    7993             : 
    7994             : static GEN
    7995        4963 : RgV_shift(GEN V, GEN gn)
    7996             : {
    7997             :   long i, n, l;
    7998             :   GEN W;
    7999        4963 :   if (typ(gn) != t_INT) pari_err_BUG("RgV_shift [n not integral]");
    8000        4963 :   n = itos(gn);
    8001        4963 :   if (n < 0) pari_err_BUG("RgV_shift [n negative]");
    8002        4963 :   if (!n) return V;
    8003         112 :   W = cgetg_copy(V, &l); if (n > l-1) n = l-1;
    8004         308 :   for (i=1; i <= n; i++) gel(W,i) = gen_0;
    8005        4900 :   for (    ; i < l; i++) gel(W,i) = gel(V, i-n);
    8006         112 :   return W;
    8007             : }
    8008             : static GEN
    8009        7630 : hash_eisengacx(hashtable *H, void *E, long w, GEN ga, long n, long prec)
    8010             : {
    8011        7630 :   ulong h = H->hash(E);
    8012        7630 :   hashentry *e = hash_search2(H, E, h);
    8013             :   GEN v;
    8014        7630 :   if (e) v = (GEN)e->val;
    8015             :   else
    8016             :   {
    8017        5159 :     v = mfeisensteingacx((GEN)E, w, ga, n, prec);
    8018        5159 :     hash_insert2(H, E, (void*)v, h);
    8019             :   }
    8020        7630 :   return v;
    8021             : }
    8022             : static GEN
    8023        4963 : vecj_expand(GEN B, hashtable *H, long w, GEN ga, long n, long prec)
    8024             : {
    8025             :   GEN E1, E2, v;
    8026        4963 :   parse_vecj(B, &E1, &E2);
    8027        4963 :   v = hash_eisengacx(H, (void*)E1, w, ga, n, prec);
    8028        4963 :   if (E2)
    8029             :   {
    8030        2611 :     GEN u = hash_eisengacx(H, (void*)E2, w, ga, n, prec);
    8031        2611 :     GEN a = gadd(gel(v,1), gel(u,1));
    8032        2611 :     GEN b = RgV_mul_RgXn(gel(v,2), gel(u,2));
    8033        2611 :     v = mkvec2(a,b);
    8034             :   }
    8035        4963 :   return v;
    8036             : }
    8037             : static GEN
    8038        1050 : shift_M(GEN M, GEN Valpha, long w)
    8039             : {
    8040        1050 :   long i, l = lg(Valpha);
    8041        1050 :   GEN almin = vecmin(Valpha);
    8042        6013 :   for (i = 1; i < l; i++)
    8043             :   {
    8044        4963 :     GEN alpha = gel(Valpha, i), gsh = gmulsg(w, gsub(alpha,almin));
    8045        4963 :     gel(M,i) = RgV_shift(gel(M,i), gsh);
    8046             :   }
    8047        1050 :   return almin;
    8048             : }
    8049             : static GEN mfeisensteinspaceinit(GEN NK);
    8050             : #if 0
    8051             : /* ga in M_2^+(Z)), n >= 0 */
    8052             : static GEN
    8053             : mfgaexpansion_init(GEN mf, GEN ga, long n, long prec)
    8054             : {
    8055             :   GEN M, Mvecj, vecj, almin, Valpha;
    8056             :   long i, w, l, N = MF_get_N(mf), c = itos(gcoeff(ga,2,1));
    8057             :   hashtable *H;
    8058             : 
    8059             :   if (c % N == 0)
    8060             :   { /* ga in G_0(N), trivial case; w = 1 */
    8061             :     GEN chid = mfcharcxeval(MF_get_CHI(mf), itos(gcoeff(ga,2,2)), prec);
    8062             :     return mkvec2(chid, utoi(n));
    8063             :   }
    8064             : 
    8065             :   Mvecj = obj_checkbuild(mf, MF_EISENSPACE, &mfeisensteinspaceinit);
    8066             :   if (lg(Mvecj) < 5) pari_err_IMPL("mfgaexpansion_init in this case");
    8067             :   w = mfcuspcanon_width(N, c);
    8068             :   vecj = gel(Mvecj, 3);
    8069             :   l = lg(vecj);
    8070             :   M = cgetg(l, t_VEC);
    8071             :   Valpha = cgetg(l, t_VEC);
    8072             :   H = hash_create(l, (ulong(*)(void*))&hash_GEN,
    8073             :                      (int(*)(void*,void*))&gidentical, 1);
    8074             :   for (i = 1; i < l; i++)
    8075             :   {
    8076             :     GEN v = vecj_expand(gel(vecj,i), H, w, ga, n, prec);
    8077             :     gel(Valpha,i) = gel(v,1);
    8078             :     gel(M,i) = gel(v,2);
    8079             :   }
    8080             :   almin = shift_M(M, Valpha, w);
    8081             :   return mkvec3(almin, utoi(w), M);
    8082             : }
    8083             : /* half-integer weight not supported; vF = [F,eisendec(F)].
    8084             :  * Minit = mfgaexpansion_init(mf, ga, n, prec) */
    8085             : static GEN
    8086             : mfgaexpansion_with_init(GEN Minit, GEN vF)
    8087             : {
    8088             :   GEN v;
    8089             :   if (lg(Minit) == 3)
    8090             :   { /* ga in G_0(N) */
    8091             :     GEN chid = gel(Minit,1), gn = gel(Minit,2);
    8092             :     v = mfcoefs_i(gel(vF,1), itou(gn), 1);
    8093             :     v = mkvec3(gen_0, gen_1, RgV_Rg_mul(v,chid));
    8094             :   }
    8095             :   else
    8096             :   {
    8097             :     GEN V = RgM_RgC_mul(gel(Minit,3), gel(vF,2));
    8098             :     v = mkvec3(gel(Minit,1), gel(Minit,2), V);
    8099             :   }
    8100             :   return v;
    8101             : }
    8102             : #endif
    8103             : 
    8104             : /* B = mfeisensteindec(F) already embedded, ga in M_2^+(Z)), n >= 0 */
    8105             : static GEN
    8106        1050 : mfgaexpansion_i(GEN mf, GEN B0, GEN ga, long n, long prec)
    8107             : {
    8108        1050 :   GEN M, Mvecj, vecj, almin, Valpha, B, E = NULL;
    8109        1050 :   long i, j, w, nw, l, N = MF_get_N(mf), bit = prec2nbits(prec) / 2;
    8110             :   hashtable *H;
    8111             : 
    8112        1050 :   Mvecj = obj_check(mf, MF_EISENSPACE);
    8113        1050 :   if (lg(Mvecj) < 5) { E = gel(Mvecj, 2); Mvecj = gel(Mvecj, 1); }
    8114        1050 :   vecj = gel(Mvecj, 3);
    8115        1050 :   l = lg(vecj);
    8116        1050 :   B = cgetg(l, t_COL);
    8117        1050 :   M = cgetg(l, t_VEC);
    8118        1050 :   Valpha = cgetg(l, t_VEC);
    8119        1050 :   w = mfZC_width(N, gel(ga,1));
    8120        1050 :   nw = E ? n + w : n;
    8121        1050 :   H = hash_create(l, (ulong(*)(void*))&hash_GEN,
    8122             :                      (int(*)(void*,void*))&gidentical, 1);
    8123        8932 :   for (i = j = 1; i < l; i++)
    8124             :   {
    8125             :     GEN v;
    8126        7882 :     if (gequal0(gel(B0,i))) continue;
    8127        4963 :     v = vecj_expand(gel(vecj,i), H, w, ga, nw, prec);
    8128        4963 :     gel(B,j) = gel(B0,i);
    8129        4963 :     gel(Valpha,j) = gel(v,1);
    8130        4963 :     gel(M,j) = gel(v,2); j++;
    8131             :   }
    8132        1050 :   setlg(Valpha, j);
    8133        1050 :   setlg(B, j);
    8134        1050 :   setlg(M, j); l = j;
    8135        1050 :   if (l == 1) return mkvec3(gen_0, utoi(w), zerovec(n+1));
    8136        1050 :   almin = shift_M(M, Valpha, w);
    8137        1050 :   B = RgM_RgC_mul(M, B); l = lg(B);
    8138      147812 :   for (i = 1; i < l; i++)
    8139      146762 :     if (gexpo(gel(B,i)) < -bit) gel(B,i) = gen_0;
    8140        1050 :   settyp(B, t_VEC);
    8141        1050 :   if (E)
    8142             :   {
    8143             :     GEN v, e;
    8144          56 :     long ell = 0, vB, ve;
    8145         126 :     for (i = 1; i < l; i++)
    8146         126 :       if (!gequal0(gel(B,i))) break;
    8147          56 :     vB = i-1;
    8148          56 :     v = hash_eisengacx(H, (void*)E, w, ga, n + vB, prec);
    8149          56 :     e = gel(v,2); l = lg(e);
    8150          56 :     for (i = 1; i < l; i++)
    8151          56 :       if (!gequal0(gel(e,i))) break;
    8152          56 :     ve = i-1;
    8153          56 :     almin = gsub(almin, gel(v,1));
    8154          56 :     if (gsigne(almin) < 0)
    8155             :     {
    8156           0 :       GEN gell = gceil(gmulsg(-w, almin));
    8157           0 :       ell = itos(gell);
    8158           0 :       almin = gadd(almin, gdivgu(gell, w));
    8159           0 :       if (nw < ell) pari_err_IMPL("alpha < 0 in mfgaexpansion");
    8160             :     }
    8161          56 :     if (ve) { ell += ve; e = vecslice(e, ve+1, l-1); }
    8162          56 :     B = vecslice(B, ell + 1, minss(n + ell + 1, lg(B)-1));
    8163          56 :     B = RgV_div_RgXn(B, e);
    8164             :   }
    8165        1050 :   return mkvec3(almin, utoi(w), B);
    8166             : }
    8167             : 
    8168             : /* Theta multiplier: assume 4 | C, (C,D)=1 */
    8169             : static GEN
    8170         343 : mfthetamultiplier(GEN C, GEN D)
    8171             : {
    8172         343 :   long s = kronecker(C, D);
    8173         343 :   if (Mod4(D) == 1) return s > 0 ? gen_1: gen_m1;
    8174          84 :   return s > 0? powIs(3): gen_I();
    8175             : }
    8176             : /* theta | [*,*;C,D] defined over Q(i) [else over Q] */
    8177             : static int
    8178          56 : mfthetaI(long C, long D) { return odd(C) || (D & 3) == 3; }
    8179             : /* (theta | M) [0..n], assume (C,D) = 1 */
    8180             : static GEN
    8181         343 : mfthetaexpansion(GEN M, long n)
    8182             : {
    8183         343 :   GEN w, s, al, sla, E, V = zerovec(n+1), C = gcoeff(M,2,1), D = gcoeff(M,2,2);
    8184         343 :   long lim, la, f, C4 = Mod4(C);
    8185         343 :   switch (C4)
    8186             :   {
    8187          70 :     case 0: al = gen_0; w = gen_1;
    8188          70 :       s = mfthetamultiplier(C,D);
    8189          70 :       lim = usqrt(n); gel(V, 1) = s;
    8190          70 :       s = gmul2n(s, 1);
    8191         756 :       for (f = 1; f <= lim; f++) gel(V, f*f + 1) = s;
    8192          70 :       break;
    8193         105 :     case 2: al = uutoQ(1,4); w = gen_1;
    8194         105 :       E = subii(C, shifti(D,1)); /* (E, D) = 1 */
    8195         105 :       s = gmul2n(mfthetamultiplier(E, D), 1);
    8196         105 :       if ((!signe(E) && equalim1(D)) || (signe(E) > 0 && signe(C) < 0))
    8197          14 :         s = gneg(s);
    8198         105 :       lim = (usqrt(n << 2) - 1) >> 1;
    8199         966 :       for (f = 0; f <= lim; f++) gel(V, f*(f+1) + 1) = s;
    8200         105 :       break;
    8201         168 :     default: al = gen_0; w = utoipos(4);
    8202         168 :       la = (-Mod4(D)*C4) & 3L;
    8203         168 :       E = negi(addii(D, mului(la, C)));
    8204         168 :       s = mfthetamultiplier(E, C); /* (E,C) = 1 */
    8205         168 :       if (signe(C) < 0 && signe(E) >= 0) s = gneg(s);
    8206         168 :       s = gsub(s, mulcxI(s));
    8207         168 :       sla = gmul(s, powIs(-la));
    8208         168 :       lim = usqrt(n); gel(V, 1) = gmul2n(s, -1);
    8209        1708 :       for (f = 1; f <= lim; f++) gel(V, f*f + 1) = odd(f) ? sla : s;
    8210         168 :       break;
    8211             :   }
    8212         343 :   return mkvec3(al, w, V);
    8213             : }
    8214             : 
    8215             : /* F 1/2 integral weight */
    8216             : static GEN
    8217         343 : mf2gaexpansion(GEN mf2, GEN F, GEN ga, long n, long prec)
    8218             : {
    8219         343 :   GEN FT = mfmultheta(F), mf = obj_checkbuild(mf2, MF_MF2INIT, &mf2init);
    8220         343 :   GEN res, V1, Tres, V2, al, V, gsh, C = gcoeff(ga,2,1);
    8221         343 :   long w2, N = MF_get_N(mf), w = mfcuspcanon_width(N, umodiu(C,N));
    8222         343 :   long ext = (Mod4(C) != 2)? 0: (w+3) >> 2;
    8223         343 :   long prec2 = prec + nbits2extraprec((long)M_PI/(2*M_LN2)*sqrt(n + ext));
    8224         343 :   res = mfgaexpansion(mf, FT, ga, n + ext, prec2);
    8225         343 :   Tres = mfthetaexpansion(ga, n + ext);
    8226         343 :   V1 = gel(res,3);
    8227         343 :   V2 = gel(Tres,3);
    8228         343 :   al = gsub(gel(res,1), gel(Tres,1));
    8229         343 :   w2 = itos(gel(Tres,2));
    8230         343 :   if (w != itos(gel(res,2)) || w % w2)
    8231           0 :     pari_err_BUG("mf2gaexpansion [incorrect w2 or w]");
    8232         343 :   if (w2 != w) V2 = bdexpand(V2, w/w2);
    8233         343 :   V = RgV_div_RgXn(V1, V2);
    8234         343 :   gsh = gfloor(gmulsg(w, al));
    8235         343 :   if (!gequal0(gsh))
    8236             :   {
    8237          35 :     al = gsub(al, gdivgu(gsh, w));
    8238          35 :     if (gsigne(gsh) > 0)
    8239             :     {
    8240           0 :       V = RgV_shift(V, gsh);
    8241           0 :       V = vecslice(V, 1, n + 1);
    8242             :     }
    8243             :     else
    8244             :     {
    8245          35 :       long sh = -itos(gsh), i;
    8246          35 :       if (sh > ext) pari_err_BUG("mf2gaexpansion [incorrect sh]");
    8247         154 :       for (i = 1; i <= sh; i++)
    8248         119 :         if (!gequal0(gel(V,i))) pari_err_BUG("mf2gaexpansion [sh too large]");
    8249          35 :       V = vecslice(V, sh+1, n + sh+1);
    8250             :     }
    8251             :   }
    8252         343 :   obj_free(mf); return mkvec3(al, stoi(w), gprec_wtrunc(V, prec));
    8253             : }
    8254             : 
    8255             : static GEN
    8256          70 : mfgaexpansionatkin(GEN mf, GEN F, GEN C, GEN D, long Q, long n, long prec)
    8257             : {
    8258          70 :   GEN mfa = mfatkininit_i(mf, Q, 0, prec), MQ = gel(mfa,2);
    8259          70 :   long i, FC, k = MF_get_k(mf);
    8260          70 :   GEN x, v, V, z, s, CHI = mfchartoprimitive(MF_get_CHI(mf), &FC);
    8261             : 
    8262             :   /* V = mfcoefs(F | w_Q, n), can't use mfatkin because MQ nonrational */
    8263          70 :   V = RgM_RgC_mul(mfcoefs_mf(mf,n,1), RgM_RgC_mul(MQ, mftobasis_i(mf,F)));
    8264          70 :   (void)bezout(utoipos(Q), C, &x, &v);
    8265          70 :   s = mfchareval(CHI, (umodiu(x, FC) * umodiu(D, FC)) % FC);
    8266          70 :   s = gdiv(s, gpow(utoipos(Q), uutoQ(k,2), prec));
    8267          70 :   V = RgV_Rg_mul(V, s);
    8268          70 :   z = rootsof1powinit(umodiu(D,Q)*umodiu(v,Q) % Q, Q, prec);
    8269        8253 :   for (i = 1; i <= n+1; i++) gel(V,i) = gmul(gel(V,i), rootsof1pow(z, i-1));
    8270          70 :   return mkvec3(gen_0, utoipos(Q), V);
    8271             : }
    8272             : 
    8273             : static long
    8274          70 : inveis_extraprec(long N, GEN ga, GEN Mvecj, long n)
    8275             : {
    8276          70 :   long e, w = mfZC_width(N, gel(ga,1));
    8277          70 :   GEN f, E = gel(Mvecj,2), v = mfeisensteingacx(E, w, ga, n, DEFAULTPREC);
    8278          70 :   v = gel(v,2);
    8279          70 :   f = RgV_to_RgX(v,0); n -= RgX_valrem(f, &f);
    8280          70 :   e = gexpo(RgXn_inv(f, n+1));
    8281          70 :   return (e > 0)? nbits2extraprec(e): 0;
    8282             : }
    8283             : /* allow F of the form [F, mf_eisendec(F)]~ */
    8284             : static GEN
    8285        1750 : mfgaexpansion(GEN mf, GEN F, GEN ga, long n, long prec)
    8286             : {
    8287        1750 :   GEN v, EF = NULL, res, Mvecj, c, d;
    8288             :   long precnew, N;
    8289             : 
    8290        1750 :   if (n < 0) pari_err_DOMAIN("mfgaexpansion", "n", "<", gen_0, stoi(n));
    8291        1750 :   if (typ(F) == t_COL && lg(F) == 3) { EF = gel(F,2); F = gel(F,1); }
    8292        1750 :   if (!checkmf_i(F)) pari_err_TYPE("mfgaexpansion", F);
    8293        1750 :   if (!check_SL2Z(ga)) pari_err_TYPE("mfgaexpansion",ga);
    8294        1750 :   if (typ(mf_get_gk(F)) != t_INT) return mf2gaexpansion(mf, F, ga, n, prec);
    8295        1407 :   c = gcoeff(ga,2,1);
    8296        1407 :   d = gcoeff(ga,2,2);
    8297        1407 :   N = MF_get_N(mf);
    8298        1407 :   if (!umodiu(c, mf_get_N(F)))
    8299             :   { /* trivial case: ga in Gamma_0(N) */
    8300         287 :     long w = mfcuspcanon_width(N, umodiu(c,N));
    8301         287 :     GEN CHI = mf_get_CHI(F);
    8302         287 :     GEN chid = mfcharcxeval(CHI, umodiu(d,mfcharmodulus(CHI)), prec);
    8303         287 :     v = mfcoefs_i(F, n/w, 1); if (!isint1(chid)) v = RgV_Rg_mul(v,chid);
    8304         287 :     return mkvec3(gen_0, stoi(w), bdexpandall(v,w,n+1));
    8305             :   }
    8306        1120 :   mf = MF_set_new(mf);
    8307        1120 :   if (MF_get_space(mf) == mf_NEW)
    8308             :   {
    8309         441 :     long cN = umodiu(c,N), g = ugcd(cN,N), Q = N/g;
    8310         441 :     GEN CHI = MF_get_CHI(mf);
    8311         441 :     if (ugcd(cN, Q)==1 && mfcharorder(CHI) <= 2
    8312         217 :                        && g % mfcharconductor(CHI) == 0
    8313         112 :                        && degpol(mf_get_field(F)) == 1)
    8314          70 :       return mfgaexpansionatkin(mf, F, c, d, Q, n, prec);
    8315             :   }
    8316        1050 :   Mvecj = obj_checkbuild(mf, MF_EISENSPACE, &mfeisensteinspaceinit);
    8317        1050 :   precnew = prec;
    8318        1050 :   if (lg(Mvecj) < 5) precnew += inveis_extraprec(N, ga, Mvecj, n);
    8319        1050 :   if (!EF) EF = mf_eisendec(mf, F, precnew);
    8320        1050 :   res = mfgaexpansion_i(mf, EF, ga, n, precnew);
    8321        1050 :   return precnew == prec ? res : gprec_wtrunc(res, prec);
    8322             : }
    8323             : 
    8324             : /* parity = -1 or +1 */
    8325             : static GEN
    8326         217 : findd(long N, long parity)
    8327             : {
    8328         217 :   GEN L, D = mydivisorsu(N);
    8329         217 :   long i, j, l = lg(D);
    8330         217 :   L = cgetg(l, t_VEC);
    8331        1218 :   for (i = j = 1; i < l; i++)
    8332             :   {
    8333        1001 :     long d = D[i];
    8334        1001 :     if (parity == -1) d = -d;
    8335        1001 :     if (sisfundamental(d)) gel(L,j++) = stoi(d);
    8336             :   }
    8337         217 :   setlg(L,j); return L;
    8338             : }
    8339             : /* does ND contain a divisor of N ? */
    8340             : static int
    8341         413 : seenD(long N, GEN ND)
    8342             : {
    8343         413 :   long j, l = lg(ND);
    8344         427 :   for (j = 1; j < l; j++)
    8345          14 :     if (N % ND[j] == 0) return 1;
    8346         413 :   return 0;
    8347             : }
    8348             : static GEN
    8349          56 : search_levels(GEN vN, const char *f)
    8350             : {
    8351          56 :   switch(typ(vN))
    8352             :   {
    8353          21 :     case t_INT: vN = mkvecsmall(itos(vN)); break;
    8354          35 :     case t_VEC: case t_COL: vN = ZV_to_zv(vN); break;
    8355           0 :     case t_VECSMALL: vN = leafcopy(vN); break;
    8356           0 :     default: pari_err_TYPE(f, vN);
    8357             :   }
    8358          56 :   vecsmall_sort(vN); return vN;
    8359             : }
    8360             : GEN
    8361          28 : mfsearch(GEN NK, GEN V, long space)
    8362             : {
    8363          28 :   pari_sp av = avma;
    8364             :   GEN F, gk, NbyD, vN;
    8365             :   long n, nk, dk, parity, nV, i, lvN;
    8366             : 
    8367          28 :   if (typ(NK) != t_VEC || lg(NK) != 3) pari_err_TYPE("mfsearch", NK);
    8368          28 :   gk = gel(NK,2);
    8369          28 :   if (typ(gmul2n(gk, 1)) != t_INT) pari_err_TYPE("mfsearch [k]", gk);
    8370          28 :   switch(typ(V))
    8371             :   {
    8372          28 :     case t_VEC: V = shallowtrans(V);
    8373          28 :     case t_COL: break;
    8374           0 :     default: pari_err_TYPE("mfsearch [V]", V);
    8375             :   }
    8376          28 :   vN = search_levels(gel(NK,1), "mfsearch [N]");
    8377          28 :   if (gequal0(V)) { set_avma(av); retmkvec(mftrivial()); }
    8378          14 :   lvN = lg(vN);
    8379             : 
    8380          14 :   Qtoss(gk, &nk,&dk);
    8381          14 :   parity = (dk == 1 && odd(nk)) ? -1 : 1;
    8382          14 :   nV = lg(V)-2;
    8383          14 :   F = cgetg(1, t_VEC);
    8384          14 :   NbyD = const_vec(vN[lvN-1], cgetg(1,t_VECSMALL));
    8385         231 :   for (n = 1; n < lvN; n++)
    8386             :   {
    8387         217 :     long N = vN[n];
    8388             :     GEN L;
    8389         217 :     if (N <= 0 || (dk == 2 && (N & 3))) continue;
    8390         217 :     L = findd(N, parity);
    8391         630 :     for (i = 1; i < lg(L); i++)
    8392             :     {
    8393         413 :       GEN mf, M, CO, gD = gel(L,i);
    8394         413 :       GEN *ND = (GEN*)NbyD + itou(gD); /* points to NbyD[|D|] */
    8395             : 
    8396         413 :       if (seenD(N, *ND)) continue;
    8397         413 :       mf = mfinit_Nndkchi(N, nk, dk, get_mfchar(gD), space, 1);
    8398         413 :       M = mfcoefs_mf(mf, nV, 1);
    8399         413 :       CO = inverseimage(M, V); if (lg(CO) == 1) continue;
    8400             : 
    8401          42 :       F = vec_append(F, mflinear(mf,CO));
    8402          42 :       *ND = vecsmall_append(*ND, N); /* add to NbyD[|D|] */
    8403             :     }
    8404             :   }
    8405          14 :   return gerepilecopy(av, F);
    8406             : }
    8407             : 
    8408             : static GEN
    8409         882 : search_from_split(GEN mf, GEN vap, GEN vlp)
    8410             : {
    8411         882 :   pari_sp av = avma;
    8412         882 :   long lvlp = lg(vlp), j, jv, l1;
    8413         882 :   GEN v, NK, S1, S, M = NULL;
    8414             : 
    8415         882 :   S1 = gel(split_i(mf, 1, 0), 1); /* rational newforms */
    8416         882 :   l1 = lg(S1);
    8417         882 :   if (l1 == 1) return gc_NULL(av);
    8418         448 :   v = cgetg(l1, t_VEC);
    8419         448 :   S = MF_get_S(mf);
    8420         448 :   NK = mf_get_NK(gel(S,1));
    8421         448 :   if (lvlp > 1) M = rowpermute(mfcoefs_mf(mf, vlp[lvlp-1], 1), vlp);
    8422         966 :   for (j = jv = 1; j < l1; j++)
    8423             :   {
    8424         518 :     GEN vF = gel(S1,j);
    8425             :     long t;
    8426         651 :     for (t = lvlp-1; t > 0; t--)
    8427             :     { /* lhs = vlp[j]-th coefficient of eigenform */
    8428         595 :       GEN rhs = gel(vap,t), lhs = RgMrow_RgC_mul(M, vF, t);
    8429         595 :       if (!gequal(lhs, rhs)) break;
    8430             :     }
    8431         518 :     if (!t) gel(v,jv++) = mflinear_i(NK,S,vF);
    8432             :   }
    8433         448 :   if (jv == 1) return gc_NULL(av);
    8434          56 :   setlg(v,jv); return v;
    8435             : }
    8436             : GEN
    8437          28 : mfeigensearch(GEN NK, GEN AP)
    8438             : {
    8439          28 :   pari_sp av = avma;
    8440          28 :   GEN k, vN, vap, vlp, vres = cgetg(1, t_VEC), D;
    8441             :   long n, lvN, i, l, even;
    8442             : 
    8443          28 :   if (!AP) l = 1;
    8444             :   else
    8445             :   {
    8446          28 :     l = lg(AP);
    8447          28 :     if (typ(AP) != t_VEC) pari_err_TYPE("mfeigensearch",AP);
    8448             :   }
    8449          28 :   vap = cgetg(l, t_VEC);
    8450          28 :   vlp = cgetg(l, t_VECSMALL);
    8451          28 :   if (l > 1)
    8452             :   {
    8453          28 :     GEN perm = indexvecsort(AP, mkvecsmall(1));
    8454          77 :     for (i = 1; i < l; i++)
    8455             :     {
    8456          49 :       GEN v = gel(AP,perm[i]), gp, ap;
    8457          49 :       if (typ(v) != t_VEC || lg(v) != 3) pari_err_TYPE("mfeigensearch", AP);
    8458          49 :       gp = gel(v,1);
    8459          49 :       ap = gel(v,2);
    8460          49 :       if (typ(gp) != t_INT || (typ(ap) != t_INT && typ(ap) != t_INTMOD))
    8461           0 :         pari_err_TYPE("mfeigensearch", AP);
    8462          49 :       gel(vap,i) = ap;
    8463          49 :       vlp[i] = itos(gp)+1; if (vlp[i] < 0) pari_err_TYPE("mfeigensearch", AP);
    8464             :     }
    8465             :   }
    8466          28 :   l = lg(NK);
    8467          28 :   if (typ(NK) != t_VEC || l != 3) pari_err_TYPE("mfeigensearch",NK);
    8468          28 :   k = gel(NK,2);
    8469          28 :   vN = search_levels(gel(NK,1), "mfeigensearch [N]");
    8470          28 :   lvN = lg(vN);
    8471          28 :   vecsmall_sort(vlp);
    8472          28 :   even = !mpodd(k);
    8473         966 :   for (n = 1; n < lvN; n++)
    8474             :   {
    8475         938 :     pari_sp av2 = avma;
    8476             :     GEN mf, L;
    8477         938 :     long N = vN[n];
    8478         938 :     if (even) D = gen_1;
    8479             :     else
    8480             :     {
    8481         112 :       long r = (N&3L);
    8482         112 :       if (r == 1 || r == 2) continue;
    8483          56 :       D = stoi( corediscs(-N, NULL) ); /* < 0 */
    8484             :     }
    8485         882 :     mf = mfinit_i(mkvec3(utoipos(N), k, D), mf_NEW);
    8486         882 :     L = search_from_split(mf, vap, vlp);
    8487         882 :     if (L) vres = shallowconcat(vres, L); else set_avma(av2);
    8488             :   }
    8489          28 :   return gerepilecopy(av, vres);
    8490             : }
    8491             : 
    8492             : /* tf_{N,k}(n) */
    8493             : static GEN
    8494     4479496 : mfnewtracecache(long N, long k, long n, cachenew_t *cache)
    8495             : {
    8496     4479496 :   GEN C = NULL, S;
    8497             :   long lcache;
    8498     4479496 :   if (!n) return gen_0;
    8499     4342807 :   S = gel(cache->vnew,N);
    8500     4342807 :   lcache = lg(S);
    8501     4342807 :   if (n < lcache) C = gel(S, n);
    8502     4342807 :   if (C) cache->newHIT++;
    8503     2580436 :   else C = mfnewtrace_i(N,k,n,cache);
    8504     4342807 :   cache->newTOTAL++;
    8505     4342807 :   if (n < lcache) gel(S,n) = C;
    8506     4342807 :   return C;
    8507             : }
    8508             : 
    8509             : static long
    8510        1393 : mfdim_Nkchi(long N, long k, GEN CHI, long space)
    8511             : {
    8512        1393 :   if (k < 0 || badchar(N,k,CHI)) return 0;
    8513        1092 :   if (k == 0)
    8514          35 :     return mfcharistrivial(CHI) && !space_is_cusp(space)? 1: 0;
    8515        1057 :   switch(space)
    8516             :   {
    8517         245 :     case mf_NEW: return mfnewdim(N,k,CHI);
    8518         196 :     case mf_CUSP:return mfcuspdim(N,k,CHI);
    8519         168 :     case mf_OLD: return mfolddim(N,k,CHI);
    8520         217 :     case mf_FULL:return mffulldim(N,k,CHI);
    8521         231 :     case mf_EISEN: return mfeisensteindim(N,k,CHI);
    8522           0 :     default: pari_err_FLAG("mfdim");
    8523             :   }
    8524             :   return 0;/*LCOV_EXCL_LINE*/
    8525             : }
    8526             : static long
    8527        2114 : mf1dimsum(long N, long space)
    8528             : {
    8529        2114 :   switch(space)
    8530             :   {
    8531        1050 :     case mf_NEW:  return mf1newdimsum(N);
    8532        1057 :     case mf_CUSP: return mf1cuspdimsum(N);
    8533           7 :     case mf_OLD:  return mf1olddimsum(N);
    8534             :   }
    8535           0 :   pari_err_FLAG("mfdim");
    8536             :   return 0; /*LCOV_EXCL_LINE*/
    8537             : }
    8538             : /* mfdim for k = nk/dk */
    8539             : static long
    8540       44744 : mfdim_Nndkchi(long N, long nk, long dk, GEN CHI, long space)
    8541       43463 : { return (dk == 2)? mf2dim_Nkchi(N, nk >> 1, CHI, space)
    8542       88186 :                   : mfdim_Nkchi(N, nk, CHI, space); }
    8543             : /* FIXME: use direct dim Gamma1(N) formula, don't compute individual spaces */
    8544             : static long
    8545         252 : mfkdimsum(long N, long k, long dk, long space)
    8546             : {
    8547         252 :   GEN w = mfchars(N, k, dk, NULL);
    8548         252 :   long i, j, D = 0, l = lg(w);
    8549        1239 :   for (i = j = 1; i < l; i++)
    8550             :   {
    8551         987 :     GEN CHI = gel(w,i);
    8552         987 :     long d = mfdim_Nndkchi(N,k,dk,CHI,space);
    8553         987 :     if (d) D += d * myeulerphiu(mfcharorder(CHI));
    8554             :   }
    8555         252 :   return D;
    8556             : }
    8557             : static GEN
    8558         105 : mf1dims(long N, GEN vCHI, long space)
    8559             : {
    8560         105 :   GEN D = NULL;
    8561         105 :   switch(space)
    8562             :   {
    8563          56 :     case mf_NEW: D = mf1newdimall(N, vCHI); break;
    8564          21 :     case mf_CUSP:D = mf1cuspdimall(N, vCHI); break;
    8565          28 :     case mf_OLD: D = mf1olddimall(N, vCHI); break;
    8566           0 :     default: pari_err_FLAG("mfdim");
    8567             :   }
    8568         105 :   return D;
    8569             : }
    8570             : static GEN
    8571        2961 : mfkdims(long N, long k, long dk, GEN vCHI, long space)
    8572             : {
    8573        2961 :   GEN D, w = mfchars(N, k, dk, vCHI);
    8574        2961 :   long i, j, l = lg(w);
    8575        2961 :   D = cgetg(l, t_VEC);
    8576       46592 :   for (i = j = 1; i < l; i++)
    8577             :   {
    8578       43631 :     GEN CHI = gel(w,i);
    8579       43631 :     long d = mfdim_Nndkchi(N,k,dk,CHI,space);
    8580       43631 :     if (vCHI)
    8581         574 :       gel(D, j++) = mkvec2s(d, 0);
    8582       43057 :     else if (d)
    8583        2520 :       gel(D, j++) = fmt_dim(CHI, d, 0);
    8584             :   }
    8585        2961 :   setlg(D,j); return D;
    8586             : }
    8587             : GEN
    8588        5719 : mfdim(GEN NK, long space)
    8589             : {
    8590        5719 :   pari_sp av = avma;
    8591             :   long N, k, dk, joker;
    8592             :   GEN CHI, mf;
    8593        5719 :   if ((mf = checkMF_i(NK))) return utoi(MF_get_dim(mf));
    8594        5586 :   checkNK2(NK, &N, &k, &dk, &CHI, 2);
    8595        5586 :   if (!CHI) joker = 1;
    8596             :   else
    8597        2611 :     switch(typ(CHI))
    8598             :     {
    8599        2373 :       case t_INT: joker = 2; break;
    8600         112 :       case t_COL: joker = 3; break;
    8601         126 :       default: joker = 0; break;
    8602             :     }
    8603        5586 :   if (joker)
    8604             :   {
    8605             :     long d;
    8606             :     GEN D;
    8607        5460 :     if (k < 0) switch(joker)
    8608             :     {
    8609           0 :       case 1: return cgetg(1,t_VEC);
    8610           7 :       case 2: return gen_0;
    8611           0 :       case 3: return mfdim0all(CHI);
    8612             :     }
    8613        5453 :     if (k == 0)
    8614             :     {
    8615          28 :       if (space_is_cusp(space)) switch(joker)
    8616             :       {
    8617           7 :         case 1: return cgetg(1,t_VEC);
    8618           0 :         case 2: return gen_0;
    8619           7 :         case 3: return mfdim0all(CHI);
    8620             :       }
    8621          14 :       switch(joker)
    8622             :       {
    8623             :         long i, l;
    8624           7 :         case 1: retmkvec(fmt_dim(mfchartrivial(),0,0));
    8625           0 :         case 2: return gen_1;
    8626           7 :         case 3: l = lg(CHI); D = cgetg(l,t_VEC);
    8627          35 :                 for (i = 1; i < l; i++)
    8628             :                 {
    8629          28 :                   long t = mfcharistrivial(gel(CHI,i));
    8630          28 :                   gel(D,i) = mkvec2(t? gen_1: gen_0, gen_0);
    8631             :                 }
    8632           7 :                 return D;
    8633             :       }
    8634             :     }
    8635        5425 :     if (dk == 1 && k == 1 && space != mf_EISEN)
    8636         105 :     {
    8637        2219 :       long fix = 0, space0 = space;
    8638        2219 :       if (space == mf_FULL) space = mf_CUSP; /* remove Eisenstein part */
    8639        2219 :       if (joker == 2)
    8640             :       {
    8641        2114 :         d = mf1dimsum(N, space);
    8642        2114 :         if (space0 == mf_FULL) d += mfkdimsum(N,k,dk,mf_EISEN);/*add it back*/
    8643        2114 :         return gc_utoi(av, d);
    8644             :       }
    8645             :       /* must initialize explicitly: trivial spaces for E_k/S_k differ */
    8646         105 :       if (space0 == mf_FULL)
    8647             :       {
    8648           7 :         if (!CHI) fix = 1; /* must remove 0 spaces */
    8649           7 :         CHI = mfchars(N, k, dk, CHI);
    8650             :       }
    8651         105 :       D = mf1dims(N, CHI, space);
    8652         105 :       if (space0 == mf_FULL)
    8653             :       {
    8654           7 :         GEN D2 = mfkdims(N, k, dk, CHI, mf_EISEN);
    8655           7 :         D = merge_dims(D, D2, fix? CHI: NULL);
    8656             :       }
    8657             :     }
    8658             :     else
    8659             :     {
    8660        3206 :       if (joker==2) { d = mfkdimsum(N,k,dk,space); return gc_utoi(av,d); }
    8661        2954 :       D = mfkdims(N, k, dk, CHI, space);
    8662             :     }
    8663        3059 :     if (!CHI) return gerepileupto(av, vecsort(D, mkvecsmall(1)));
    8664         105 :     return gerepilecopy(av, D);
    8665             :   }
    8666         126 :   return utoi( mfdim_Nndkchi(N, k, dk, CHI, space) );
    8667             : }
    8668             : 
    8669             : GEN
    8670         315 : mfbasis(GEN NK, long space)
    8671             : {
    8672         315 :   pari_sp av = avma;
    8673             :   long N, k, dk;
    8674             :   GEN mf, CHI;
    8675         315 :   if ((mf = checkMF_i(NK))) return gconcat(gel(mf,2), gel(mf,3));
    8676           7 :   checkNK2(NK, &N, &k, &dk, &CHI, 0);
    8677           7 :   if (dk == 2) return gerepilecopy(av, mf2basis(N, k>>1, CHI, NULL, space));
    8678           7 :   mf = mfinit_Nkchi(N, k, CHI, space, 1);
    8679           7 :   return gerepilecopy(av, MF_get_basis(mf));
    8680             : }
    8681             : 
    8682             : static GEN
    8683          49 : deg1ser_shallow(GEN a1, GEN a0, long v, long e)
    8684          49 : { return RgX_to_ser(deg1pol_shallow(a1, a0, v), e+2); }
    8685             : /* r / x + O(1) */
    8686             : static GEN
    8687          49 : simple_pole(GEN r)
    8688             : {
    8689          49 :   GEN S = deg1ser_shallow(gen_0, r, 0, 1);
    8690          49 :   setvalser(S, -1); return S;
    8691             : }
    8692             : 
    8693             : /* F form, E embedding; mfa = mfatkininit or root number (eigenform case) */
    8694             : static GEN
    8695         161 : mflfuncreate(GEN mfa, GEN F, GEN E, GEN N, GEN gk)
    8696             : {
    8697         161 :   GEN LF = cgetg(8,t_VEC), polar = cgetg(1,t_COL), eps;
    8698         161 :   long k = itou(gk);
    8699         161 :   gel(LF,1) = lfuntag(t_LFUN_MFCLOS, mkvec3(F,E,gen_1));
    8700         161 :   if (typ(mfa) != t_VEC)
    8701          98 :     eps = mfa; /* cuspidal eigenform: root number; no poles */
    8702             :   else
    8703             :   { /* mfatkininit */
    8704          63 :     GEN a0, b0, vF, vG, G = NULL;
    8705          63 :     GEN M = gel(mfa,2), C = gel(mfa,3), mf = gel(mfa,4);
    8706          63 :     M = gdiv(mfmatembed(E, M), C);
    8707          63 :     vF = mfvecembed(E, mftobasis_i(mf, F));
    8708          63 :     vG = RgM_RgC_mul(M, vF);
    8709          63 :     if (gequal(vF,vG)) eps = gen_1;
    8710          49 :     else if (gequal(vF,gneg(vG))) eps = gen_m1;
    8711             :     else
    8712             :     { /* not self-dual */
    8713          42 :       eps = NULL;
    8714          42 :       G = mfatkin(mfa, F);
    8715          42 :       gel(LF,2) = lfuntag(t_LFUN_MFCLOS, mkvec3(G,E,ginv(C)));
    8716          42 :       gel(LF,6) = powIs(k);
    8717             :     }
    8718             :     /* polar part */
    8719          63 :     a0 = mfembed(E, mfcoef(F,0));
    8720          63 :     b0 = eps? gmul(eps,a0): gdiv(mfembed(E, mfcoef(G,0)), C);
    8721          63 :     if (!gequal0(b0))
    8722             :     {
    8723          28 :       b0 = mulcxpowIs(gmul2n(b0,1), k);
    8724          28 :       polar = vec_append(polar, mkvec2(gk, simple_pole(b0)));
    8725             :     }
    8726          63 :     if (!gequal0(a0))
    8727             :     {
    8728          21 :       a0 = gneg(gmul2n(a0,1));
    8729          21 :       polar = vec_append(polar, mkvec2(gen_0, simple_pole(a0)));
    8730             :     }
    8731             :   }
    8732         161 :   if (eps) /* self-dual */
    8733             :   {
    8734         119 :     gel(LF,2) = mfcharorder(mf_get_CHI(F)) <= 2? gen_0: gen_1;
    8735         119 :     gel(LF,6) = mulcxpowIs(eps,k);
    8736             :   }
    8737         161 :   gel(LF,3) = mkvec2(gen_0, gen_1);
    8738         161 :   gel(LF,4) = gk;
    8739         161 :   gel(LF,5) = N;
    8740         161 :   if (lg(polar) == 1) setlg(LF,7); else gel(LF,7) = polar;
    8741         161 :   return LF;
    8742             : }
    8743             : static GEN
    8744         133 : mflfuncreateall(long sd, GEN mfa, GEN F, GEN vE, GEN gN, GEN gk)
    8745             : {
    8746         133 :   long i, l = lg(vE);
    8747         133 :   GEN L = cgetg(l, t_VEC);
    8748         294 :   for (i = 1; i < l; i++)
    8749         161 :     gel(L,i) = mflfuncreate(sd? gel(mfa,i): mfa, F, gel(vE,i), gN, gk);
    8750         133 :   return L;
    8751             : }
    8752             : GEN
    8753          84 : lfunmf(GEN mf, GEN F, long bitprec)
    8754             : {
    8755          84 :   pari_sp av = avma;
    8756          84 :   long i, l, prec = nbits2prec(bitprec);
    8757             :   GEN L, gk, gN;
    8758          84 :   mf = checkMF(mf);
    8759          84 :   gk = MF_get_gk(mf);
    8760          84 :   gN = MF_get_gN(mf);
    8761          84 :   if (typ(gk)!=t_INT) pari_err_IMPL("half-integral weight");
    8762          84 :   if (F)
    8763             :   {
    8764             :     GEN v;
    8765          77 :     long s = MF_get_space(mf);
    8766          77 :     if (!checkmf_i(F)) pari_err_TYPE("lfunmf", F);
    8767          77 :     if (!mfisinspace_i(mf, F)) err_space(F);
    8768          77 :     L = NULL;
    8769          77 :     if ((s == mf_NEW || s == mf_CUSP || s == mf_FULL)
    8770          63 :         && gequal(mfcoefs_i(F,1,1), mkvec2(gen_0,gen_1)))
    8771             :     { /* check if eigenform */
    8772          35 :       GEN vP, vF, b = mftobasis_i(mf, F);
    8773          35 :       long lF, d = degpol(mf_get_field(F));
    8774          35 :       v = mfsplit(mf, d, 0);
    8775          35 :       vF = gel(v,1);
    8776          35 :       vP = gel(v,2); lF = lg(vF);
    8777          35 :       for (i = 1; i < lF; i++)
    8778          28 :         if (degpol(gel(vP,i)) == d && gequal(gel(vF,i), b))
    8779             :         {
    8780          28 :           GEN vE = mfgetembed(F, prec);
    8781          28 :           GEN Z = mffrickeeigen_i(mf, mkvec(b), mkvec(vE), prec);
    8782          28 :           L = mflfuncreateall(1, gel(Z,1), F, vE, gN, gk);
    8783          28 :           break;
    8784             :         }
    8785             :     }
    8786          77 :     if (!L)
    8787             :     { /* not an eigenform: costly general case */
    8788          49 :       GEN mfa = mfatkininit_i(mf, itou(gN), 1, prec);
    8789          49 :       L = mflfuncreateall(0,mfa, F, mfgetembed(F,prec), gN, gk);
    8790             :     }
    8791          77 :     if (lg(L) == 2) L = gel(L,1);
    8792             :   }
    8793             :   else
    8794             :   {
    8795           7 :     GEN M = mfeigenbasis(mf), vE = mfeigenembed(mf, prec);
    8796           7 :     GEN v = mffrickeeigen(mf, vE, prec);
    8797           7 :     l = lg(vE); L = cgetg(l, t_VEC);
    8798          63 :     for (i = 1; i < l; i++)
    8799          56 :       gel(L,i) = mflfuncreateall(1,gel(v,i), gel(M,i), gel(vE,i), gN, gk);
    8800             :   }
    8801          84 :   return gerepilecopy(av, L);
    8802             : }
    8803             : 
    8804             : GEN
    8805          28 : mffromell(GEN E)
    8806             : {
    8807          28 :   pari_sp av = avma;
    8808             :   GEN mf, F, z, v, S;
    8809             :   long N, i, l;
    8810             : 
    8811          28 :   checkell(E);
    8812          28 :   if (ell_get_type(E) != t_ELL_Q) pari_err_TYPE("mfffromell [E not over Q]", E);
    8813          28 :   N = itos(ellQ_get_N(E));
    8814          28 :   mf = mfinit_i(mkvec2(utoi(N), gen_2), mf_NEW);
    8815          28 :   v = split_i(mf, 1, 0);
    8816          28 :   S = gel(v,1); l = lg(S); /* rational newforms */
    8817          28 :   F = tag(t_MF_ELL, mkNK(N,2,mfchartrivial()), E);
    8818          28 :   z = mftobasis_i(mf, F);
    8819          28 :   for(i = 1; i < l; i++)
    8820          28 :     if (gequal(z, gel(S,i))) break;
    8821          28 :   if (i == l) pari_err_BUG("mffromell [E is not modular]");
    8822          28 :   return gerepilecopy(av, mkvec3(mf, F, z));
    8823             : }
    8824             : 
    8825             : /* returns -1 if not, degree otherwise */
    8826             : long
    8827         140 : polishomogeneous(GEN P)
    8828             : {
    8829             :   long i, D, l;
    8830         140 :   if (typ(P) != t_POL) return 0;
    8831          77 :   D = -1; l = lg(P);
    8832         322 :   for (i = 2; i < l; i++)
    8833             :   {
    8834         245 :     GEN c = gel(P,i);
    8835             :     long d;
    8836         245 :     if (gequal0(c)) continue;
    8837         112 :     d = polishomogeneous(c);
    8838         112 :     if (d < 0) return -1;
    8839         112 :     if (D < 0) D = d + i-2; else if (D != d + i-2) return -1;
    8840             :   }
    8841          77 :   return D;
    8842             : }
    8843             : 
    8844             : /* M a pp((Gram q)^(-1)) ZM; P a homogeneous t_POL, is P spherical ? */
    8845             : static int
    8846          28 : RgX_isspherical(GEN M, GEN P)
    8847             : {
    8848          28 :   pari_sp av = avma;
    8849          28 :   GEN S, v = variables_vecsmall(P);
    8850          28 :   long i, j, l = lg(v);
    8851          28 :   if (l > lg(M)) pari_err(e_MISC, "too many variables in mffromqf");
    8852          21 :   S = gen_0;
    8853          63 :   for (j = 1; j < l; j++)
    8854             :   {
    8855          42 :     GEN Mj = gel(M, j), Pj = deriv(P, v[j]);
    8856         105 :     for (i = 1; i <= j; i++)
    8857             :     {
    8858          63 :       GEN c = gel(Mj, i);
    8859          63 :       if (!signe(c)) continue;
    8860          42 :       if (i != j) c = shifti(c, 1);
    8861          42 :       S = gadd(S, gmul(c, deriv(Pj, v[i])));
    8862             :     }
    8863             :   }
    8864          21 :   return gc_bool(av, gequal0(S));
    8865             : }
    8866             : 
    8867             : static GEN
    8868          49 : c_QFsimple_i(long n, GEN Q, GEN P)
    8869             : {
    8870          49 :   GEN V, v = qfrep0(Q, utoi(n), 1);
    8871          49 :   long i, l = lg(v);
    8872          49 :   V = cgetg(l+1, t_VEC);
    8873          49 :   if (!P || equali1(P))
    8874             :   {
    8875          42 :     gel(V,1) = gen_1;
    8876         420 :     for (i = 2; i <= l; i++) gel(V,i) = utoi(v[i-1] << 1);
    8877             :   }
    8878             :   else
    8879             :   {
    8880           7 :     gel(V,1) = gcopy(P);
    8881           7 :     for (i = 2; i <= l; i++) gel(V,i) = gmulgu(P, v[i-1] << 1);
    8882             :   }
    8883          49 :   return V;
    8884             : }
    8885             : 
    8886             : /* v a t_VECSMALL of variable numbers, lg(r) >= lg(v), r is a vector of
    8887             :  * scalars [not involving any variable in v] */
    8888             : static GEN
    8889          14 : gsubstvec_i(GEN e, GEN v, GEN r)
    8890             : {
    8891          14 :   long i, l = lg(v);
    8892          42 :   for(i = 1; i < l; i++) e = gsubst(e, v[i], gel(r,i));
    8893          14 :   return e;
    8894             : }
    8895             : static GEN
    8896          56 : c_QF_i(long n, GEN Q, GEN P)
    8897             : {
    8898          56 :   pari_sp av = avma;
    8899             :   GEN V, v, va;
    8900             :   long i, l;
    8901          56 :   if (!P || typ(P) != t_POL) return gerepileupto(av, c_QFsimple_i(n, Q, P));
    8902           7 :   v = gel(minim(Q, utoi(2*n), NULL), 3);
    8903           7 :   va = variables_vecsmall(P);
    8904           7 :   V = zerovec(n + 1); l = lg(v);
    8905          21 :   for (i = 1; i < l; i++)
    8906             :   {
    8907          14 :     pari_sp av = avma;
    8908          14 :     GEN X = gel(v,i);
    8909          14 :     long c = (itos(qfeval(Q, X)) >> 1) + 1;
    8910          14 :     gel(V, c) = gerepileupto(av, gadd(gel(V, c), gsubstvec_i(P, va, X)));
    8911             :   }
    8912           7 :   return gmul2n(V, 1);
    8913             : }
    8914             : 
    8915             : GEN
    8916          77 : mffromqf(GEN Q, GEN P)
    8917             : {
    8918          77 :   pari_sp av = avma;
    8919             :   GEN G, Qi, F, D, N, mf, v, gk, chi;
    8920             :   long m, d, space;
    8921          77 :   if (typ(Q) != t_MAT) pari_err_TYPE("mffromqf", Q);
    8922          77 :   if (!RgM_is_ZM(Q) || !qfiseven(Q))
    8923           0 :     pari_err_TYPE("mffromqf [not integral or even]", Q);
    8924          77 :   m = lg(Q)-1;
    8925          77 :   Qi = ZM_inv(Q, &N);
    8926          77 :   if (!qfiseven(Qi)) N = shifti(N, 1);
    8927          77 :   d = 0;
    8928          77 :   if (!P || gequal1(P)) P = NULL;
    8929             :   else
    8930             :   {
    8931          35 :     P = simplify_shallow(P);
    8932          35 :     if (typ(P) == t_POL)
    8933             :     {
    8934          28 :       d = polishomogeneous(P);
    8935          28 :       if (d < 0) pari_err_TYPE("mffromqf [not homogeneous t_POL]", P);
    8936          28 :       if (!RgX_isspherical(Qi, P))
    8937           7 :         pari_err_TYPE("mffromqf [not a spherical t_POL]", P);
    8938             :     }
    8939             :   }
    8940          63 :   gk = uutoQ(m + 2*d, 2);
    8941          63 :   D = ZM_det(Q);
    8942          63 :   if (!odd(m)) { if ((m & 3) == 2) D = negi(D); } else D = shifti(D, 1);
    8943          63 :   space = d > 0 ? mf_CUSP : mf_FULL;
    8944          63 :   G = znstar0(N,1);
    8945          63 :   chi = mkvec2(G, znchar_quad(G,D));
    8946          63 :   mf = mfinit(mkvec3(N, gk, chi), space);
    8947          63 :   if (odd(d))
    8948             :   {
    8949           7 :     F = mftrivial();
    8950           7 :     v = zerocol(MF_get_dim(mf));
    8951             :   }
    8952             :   else
    8953             :   {
    8954          56 :     F = c_QF_i(mfsturm(mf), Q, P);
    8955          56 :     v = mftobasis_i(mf, F);
    8956          56 :     F = mflinear(mf, v);
    8957             :   }
    8958          63 :   return gerepilecopy(av, mkvec3(mf, F, v));
    8959             : }
    8960             : 
    8961             : /***********************************************************************/
    8962             : /*                          Eisenstein Series                          */
    8963             : /***********************************************************************/
    8964             : /* \sigma_{k-1}(\chi,n) */
    8965             : static GEN
    8966       24192 : sigchi(long k, GEN CHI, long n)
    8967             : {
    8968       24192 :   pari_sp av = avma;
    8969       24192 :   GEN S = gen_1, D = mydivisorsu(u_ppo(n,mfcharmodulus(CHI)));
    8970       24192 :   long i, l = lg(D), ord = mfcharorder(CHI), vt = varn(mfcharpol(CHI));
    8971       83671 :   for (i = 2; i < l; i++) /* skip D[1] = 1 */
    8972             :   {
    8973       59479 :     long d = D[i], a = mfcharevalord(CHI, d, ord);
    8974