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.2 lcov report (development 29115-f22e516b23) Lines: 7539 7750 97.3 %
Date: 2024-03-29 08:06:26 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       36932 : mkgNK(GEN N, GEN k, GEN CHI, GEN P) { return mkvec4(N, k, CHI, P); }
      82             : static GEN
      83       14994 : mkNK(long N, long k, GEN CHI) { return mkgNK(stoi(N), stoi(k), CHI, pol_x(1)); }
      84             : GEN
      85        8400 : MF_get_CHI(GEN mf) { return gmael(mf,1,3); }
      86             : GEN
      87       19992 : MF_get_gN(GEN mf) { return gmael(mf,1,1); }
      88             : long
      89       18928 : MF_get_N(GEN mf) { return itou(MF_get_gN(mf)); }
      90             : GEN
      91       14273 : MF_get_gk(GEN mf) { return gmael(mf,1,2); }
      92             : long
      93        6874 : MF_get_k(GEN mf)
      94             : {
      95        6874 :   GEN gk = MF_get_gk(mf);
      96        6874 :   if (typ(gk)!=t_INT) pari_err_IMPL("half-integral weight");
      97        6874 :   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       14490 : MF_get_space(GEN mf) { return itos(gmael(mf,1,4)); }
     108             : GEN
     109        4368 : MF_get_E(GEN mf) { return gel(mf,2); }
     110             : GEN
     111       20993 : MF_get_S(GEN mf) { return gel(mf,3); }
     112             : GEN
     113        1841 : MF_get_basis(GEN mf) { return shallowconcat(gel(mf,2), gel(mf,3)); }
     114             : long
     115        5467 : MF_get_dim(GEN mf)
     116             : {
     117        5467 :   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        4634 :     default: /* mf_NEW, mf_CUSP, mf_OLD */
     124        4634 :       return lg(MF_get_S(mf)) - 1;
     125             :   }
     126             : }
     127             : GEN
     128        7161 : MFnew_get_vj(GEN mf) { return gel(mf,4); }
     129             : GEN
     130         665 : MFcusp_get_vMjd(GEN mf) { return gel(mf,4); }
     131             : GEN
     132        6762 : MF_get_M(GEN mf) { return gmael(mf,5,3); }
     133             : GEN
     134        4746 : MF_get_Minv(GEN mf) { return gmael(mf,5,2); }
     135             : GEN
     136       10360 : 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       10374 : QabM_indexrank(GEN M, GEN P, long n)
     240             : {
     241             :   GEN z;
     242       10374 :   if (n <= 2)
     243             :   {
     244        9219 :     M = vec_Q_primpart(M);
     245        9219 :     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       10374 :   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      109200 : myeulerphiu(ulong n)
     262             : {
     263             :   pari_sp av;
     264      109200 :   if (n == 1) return 1;
     265       90580 :   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        2968 : mynumdivu(long N)
     277             : {
     278             :   pari_sp av;
     279        2968 :   if (N == 1) return 1;
     280        2863 :   av = avma; return gc_long(av, numdivu_fact(myfactoru(N)));
     281             : }
     282             : 
     283             : /* N\prod_{p|N} (1+1/p) */
     284             : static long
     285      393029 : mypsiu(ulong N)
     286             : {
     287             :   pari_sp av;
     288             :   GEN P;
     289             :   long j, l, a;
     290      393029 :   if (N == 1) return 1;
     291      309505 :   av = avma; P = gel(myfactoru(N), 1); l = lg(P);
     292      737520 :   for (a = N, j = 1; j < l; j++) a += a / P[j];
     293      309505 :   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     6427121 : corediscs_fact(GEN fa)
     314             : {
     315     6427121 :   GEN P = gel(fa,1), E = gel(fa,2);
     316     6427121 :   long i, l = lg(P), m = 1;
     317    21324943 :   for (i = 1; i < l; i++)
     318             :   {
     319    14897822 :     long p = P[i], e = E[i];
     320    14897822 :     if (e & 1) m *= p;
     321             :   }
     322     6427121 :   if ((m&3L) != 3) m <<= 2;
     323     6427121 :   return m;
     324             : }
     325             : static long
     326        6993 : mubeta(long n)
     327             : {
     328        6993 :   pari_sp av = avma;
     329        6993 :   GEN E = gel(myfactoru(n), 2);
     330        6993 :   long i, s = 1, l = lg(E);
     331       14511 :   for (i = 1; i < l; i++)
     332             :   {
     333        7518 :     long e = E[i];
     334        7518 :     if (e >= 3) return gc_long(av,0);
     335        7518 :     if (e == 1) s *= -2;
     336             :   }
     337        6993 :   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     7645125 : mubeta2(long n, long m)
     344             : {
     345     7645125 :   pari_sp av = avma;
     346     7645125 :   GEN fa = myfactoru(n), P = gel(fa,1), E = gel(fa,2);
     347     7645125 :   long i, s = 1, l = lg(P);
     348    15372510 :   for (i = 1; i < l; i++)
     349             :   {
     350     7727385 :     long p = P[i], e = E[i];
     351     7727385 :     if (m % p)
     352             :     { /* p^e in n1 */
     353     6562032 :       if (e >= 3) return gc_long(av,0);
     354     6562032 :       if (e == 1) s *= -2;
     355             :     }
     356             :     else
     357             :     { /* in n2 */
     358     1165353 :       if (e >= 2) return gc_long(av,0);
     359     1165353 :       s = -s;
     360             :     }
     361             :   }
     362     7645125 :   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     1872945 : newt_params(long N, long n, long FC, long *pg, long *pN2)
     370             : {
     371     1872945 :   GEN fa = myfactoru(N), P = gel(fa,1), E = gel(fa,2);
     372     1872945 :   long i, g = 1, N2 = 1, l = lg(P);
     373     5000843 :   for (i = 1; i < l; i++)
     374             :   {
     375     3127898 :     long p = P[i], e = E[i];
     376     3127898 :     if (e == 1)
     377     2732828 :     { if (FC % p && n % (p*p) == 0) g *= p; }
     378             :     else
     379      395070 :       N2 *= upowuu(p,(n % p)? e-2: e-1);
     380             :   }
     381     1872945 :   *pg = g; *pN2 = N2;
     382     1872945 : }
     383             : /* simplified version of newt_params for n = 1 (newdim) */
     384             : static void
     385       41363 : newd_params(long N, long *pN2)
     386             : {
     387       41363 :   GEN fa = myfactoru(N), P = gel(fa,1), E = gel(fa,2);
     388       41363 :   long i, N2 = 1, l = lg(P);
     389      103705 :   for (i = 1; i < l; i++)
     390             :   {
     391       62342 :     long p = P[i], e = E[i];
     392       62342 :     if (e > 2) N2 *= upowuu(p, e-2);
     393             :   }
     394       41363 :   *pN2 = N2;
     395       41363 : }
     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     3719233 : gmfcharorder(GEN CHI) { return gel(CHI, 3); }
     577             : long
     578     3681552 : mfcharorder(GEN CHI) { return itou(gmfcharorder(CHI)); }
     579             : static long
     580        2632 : mfcharistrivial(GEN CHI) { return !CHI || mfcharorder(CHI) == 1; }
     581             : static GEN
     582     1556982 : gmfcharmodulus(GEN CHI) { return gmael3(CHI, 1, 1, 1); }
     583             : long
     584     1556982 : 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       14203 : mfchareval(GEN CHI, long n)
     606             : {
     607       14203 :   GEN Pn, C, go = gmfcharorder(CHI);
     608       14203 :   long k, o = go[2];
     609       14203 :   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      373667 : mfcharGL(GEN G, GEN L)
     628             : {
     629      373667 :   GEN o = zncharorder(G,L);
     630      373667 :   long ord = itou(o), vt = fetch_user_var("t");
     631      373667 :   return mkvec4(G, L, o, polcyclo(ord,vt));
     632             : }
     633             : static GEN
     634        5768 : mfchartrivial()
     635        5768 : { return mfcharGL(znstar0(gen_1,1), cgetg(1,t_COL)); }
     636             : /* convert a generic character into an 'mfchar' */
     637             : static GEN
     638        4032 : get_mfchar(GEN CHI)
     639             : {
     640             :   GEN G, L;
     641        4032 :   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        3962 :   G = gel(CHI,1);
     650        3962 :   L = gel(CHI,2); if (typ(L) != t_COL) L = znconreylog(G,L);
     651        3962 :   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        9177 : checkCHI(GEN NK, long N, int joker)
     657             : {
     658             :   GEN CHI;
     659        9177 :   if (lg(NK) == 3)
     660         686 :     CHI = mfchartrivial();
     661             :   else
     662             :   {
     663             :     long i, l;
     664        8491 :     CHI = gel(NK,3); l = lg(CHI);
     665        8491 :     if (isintzero(CHI) && joker)
     666        4116 :       CHI = NULL; /* all character orbits */
     667        4375 :     else if (isintm1(CHI) && joker > 1)
     668        2373 :       CHI = gen_m1; /* sum over all character orbits */
     669        2002 :     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        1869 :       CHI = get_mfchar(CHI); /* single char */
     678        1869 :       if (N % mfcharmodulus(CHI)) pari_err_TYPE("checkNF [chi]", NK);
     679             :     }
     680             :   }
     681        9163 :   return CHI;
     682             : }
     683             : /* support half-integral weight */
     684             : static void
     685        9184 : checkNK2(GEN NK, long *N, long *nk, long *dk, GEN *CHI, int joker)
     686             : {
     687        9184 :   long l = lg(NK);
     688             :   GEN T;
     689        9184 :   if (typ(NK) != t_VEC || l < 3 || l > 4) pari_err_TYPE("checkNK", NK);
     690        9184 :   T = gel(NK,1); if (typ(T) != t_INT) pari_err_TYPE("checkNF [N]", NK);
     691        9184 :   *N = itos(T); if (*N <= 0) pari_err_TYPE("checkNF [N <= 0]", NK);
     692        9184 :   T = gel(NK,2);
     693        9184 :   switch(typ(T))
     694             :   {
     695        5803 :     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        9177 :   *CHI = checkCHI(NK, *N, joker);
     702        9163 : }
     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       68355 : mfcharparity(GEN CHI)
     739             : {
     740       68355 :   if (!CHI) return 1;
     741       68355 :   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       75922 : mfchartoprimitive(GEN CHI, long *pF)
     746             : {
     747             :   pari_sp av;
     748             :   GEN chi, F;
     749       75922 :   if (!CHI) { if (pF) *pF = 1; return mfchartrivial(); }
     750       75922 :   av = avma; F = znconreyconductor(gel(CHI,1), gel(CHI,2), &chi);
     751       75922 :   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       75922 :   if (pF) *pF = mfcharmodulus(CHI);
     759       75922 :   return CHI;
     760             : }
     761             : static long
     762      397222 : mfcharconductor(GEN CHI)
     763             : {
     764      397222 :   pari_sp av = avma;
     765      397222 :   GEN res = znconreyconductor(gel(CHI,1), gel(CHI,2), NULL);
     766      397222 :   if (typ(res) == t_VEC) res = gel(res, 1);
     767      397222 :   return gc_long(av, itos(res));
     768             : }
     769             : 
     770             : /*                      Operations on mf closures                    */
     771             : static GEN
     772       62566 : 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       10199 : tag(long t, GEN NK, GEN x) { retmkvec2(tagparams(t,NK), x); }
     779             : static GEN
     780       36113 : tag2(long t, GEN NK, GEN x, GEN y) { retmkvec3(tagparams(t,NK), x,y); }
     781             : static GEN
     782       16072 : 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       18515 : checkmf_i(GEN F)
     789       18515 : { return typ(F) == t_VEC
     790       17703 :     && lg(F) > 1 && typ(gel(F,1)) == t_VEC
     791       13027 :     && lg(gel(F,1)) == 3
     792       12866 :     && typ(gmael(F,1,1)) == t_VECSMALL
     793       36218 :     && typ(gmael(F,1,2)) == t_VEC; }
     794      231392 : long mf_get_type(GEN F) { return gmael(F,1,1)[1]; }
     795      183792 : GEN mf_get_gN(GEN F) { return gmael3(F,1,2,1); }
     796      138810 : GEN mf_get_gk(GEN F) { return gmael3(F,1,2,2); }
     797             : /* k - 1/2, assume k in 1/2 + Z */
     798         441 : long mf_get_r(GEN F) { return itou(gel(mf_get_gk(F),1)) >> 1; }
     799      118692 : long mf_get_N(GEN F) { return itou(mf_get_gN(F)); }
     800       71617 : long mf_get_k(GEN F)
     801             : {
     802       71617 :   GEN gk = mf_get_gk(F);
     803       71617 :   if (typ(gk)!=t_INT) pari_err_IMPL("half-integral weight");
     804       71617 :   return itou(gk);
     805             : }
     806       61817 : GEN mf_get_CHI(GEN F) { return gmael3(F,1,2,3); }
     807       24206 : GEN mf_get_field(GEN F) { return gmael3(F,1,2,4); }
     808       18753 : 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        8778 : c_deflate(long n, long d, GEN v)
     879             : {
     880        8778 :   long i, id, l = n+2;
     881             :   GEN w;
     882        8778 :   if (d == 1) return lg(v) == l ? v: vecslice(v, 1, l-1);
     883         574 :   w = cgetg(l, typ(v));
     884       11123 :   for (i = id = 1; i < l; i++, id += d) gel(w, i) = gel(v, id);
     885         574 :   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        2975 : c_linear(long n, long d, GEN F, GEN L, GEN dL)
    1041             : {
    1042        2975 :   pari_sp av = avma;
    1043        2975 :   long j, l = lg(L);
    1044        2975 :   GEN S = NULL;
    1045       10640 :   for (j = 1; j < l; j++)
    1046             :   {
    1047        7665 :     GEN c = gel(L,j);
    1048        7665 :     if (gequal0(c)) continue;
    1049        6909 :     c = gmul(c, mfcoefs_i(gel(F,j), n, d));
    1050        6909 :     S = S? gadd(S,c): c;
    1051             :   }
    1052        2975 :   if (!S) return zerovec(n+1);
    1053        2975 :   if (!is_pm1(dL)) S = gdiv(S, dL);
    1054        2975 :   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       82411 : bhn_parse(GEN f, long *d, long *j)
    1062             : {
    1063       82411 :   long t = mf_get_type(f);
    1064       82411 :   *d = *j = 1;
    1065       82411 :   if (t == t_MF_BD) { *d = itos(gel(f,3)); f = gel(f,2); t = mf_get_type(f); }
    1066       82411 :   if (t == t_MF_HECKE) { *j = gel(f,2)[1]; f = gel(f,3); }
    1067       82411 :   return f;
    1068             : }
    1069             : /* f as above, return the t_MF_NEWTRACE component */
    1070             : static GEN
    1071       32438 : bhn_newtrace(GEN f)
    1072             : {
    1073       32438 :   long t = mf_get_type(f);
    1074       32438 :   if (t == t_MF_BD) { f = gel(f,2); t = mf_get_type(f); }
    1075       32438 :   if (t == t_MF_HECKE) f = gel(f,3);
    1076       32438 :   return f;
    1077             : }
    1078             : static int
    1079        3976 : ok_bhn_linear(GEN vf)
    1080             : {
    1081        3976 :   long i, N0 = 0, l = lg(vf);
    1082             :   GEN CHI, gk;
    1083        3976 :   if (l == 1) return 1;
    1084        3976 :   gk = mf_get_gk(gel(vf,1));
    1085        3976 :   CHI = mf_get_CHI(gel(vf,1));
    1086       27321 :   for (i = 1; i < l; i++)
    1087             :   {
    1088       25676 :     GEN f = bhn_newtrace(gel(vf,i));
    1089       25676 :     long N = mf_get_N(f);
    1090       25676 :     if (mf_get_type(f) != t_MF_NEWTRACE) return 0;
    1091       23345 :     if (N < N0) return 0; /* largest level must come last */
    1092       23345 :     N0 = N;
    1093       23345 :     if (!gequal(gk,mf_get_gk(f))) return 0; /* same k */
    1094       23345 :     if (!gequal(gel(mf_get_CHI(f),2), gel(CHI,2))) return 0; /* same CHI */
    1095             :   }
    1096        1645 :   return 1;
    1097             : }
    1098             : 
    1099             : /* vF not empty, same hypotheses as bhnmat_extend */
    1100             : static GEN
    1101        6867 : bhnmat_extend_nocache(GEN M, long N, long n, long d, GEN vF)
    1102             : {
    1103             :   cachenew_t cache;
    1104        6867 :   long l = lg(vF);
    1105             :   GEN f;
    1106        6867 :   if (l == 1) return M? M: cgetg(1, t_MAT);
    1107        6762 :   f = bhn_newtrace(gel(vF,1)); /* N.B. mf_get_N(f) divides N */
    1108        6762 :   init_cachenew(&cache, n*d, N, f);
    1109        6762 :   M = bhnmat_extend(M, n, d, vF, &cache);
    1110        6762 :   dbg_cachenew(&cache); return M;
    1111             : }
    1112             : /* c_linear of "bhn" mf closures, same hypotheses as bhnmat_extend */
    1113             : static GEN
    1114        2198 : c_linear_bhn(long n, long d, GEN F)
    1115             : {
    1116             :   pari_sp av;
    1117        2198 :   GEN M, v, vF = gel(F,2), L = gel(F,3), dL = gel(F,4);
    1118        2198 :   if (lg(L) == 1) return zerovec(n+1);
    1119        2198 :   av = avma;
    1120        2198 :   M = bhnmat_extend_nocache(NULL, mf_get_N(F), n, d, vF);
    1121        2198 :   v = RgM_RgC_mul(M,L); settyp(v, t_VEC);
    1122        2198 :   if (!is_pm1(dL)) v = gdiv(v, dL);
    1123        2198 :   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         175 : c_deriv(long n, long d, GEN F, GEN gm)
    1331             : {
    1332         175 :   pari_sp av = avma;
    1333         175 :   GEN V = mfcoefs_i(F, n, d), res;
    1334         175 :   long i, m = itos(gm);
    1335         175 :   if (!m) return V;
    1336         175 :   res = cgetg(n+2, t_VEC); gel(res,1) = gen_0;
    1337         175 :   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        2457 :   { for (i=1; i <= n; i++) gel(res, i+1) = gmul(gel(V,i+1), powuu(i,m)); }
    1341         175 :   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         161 : c_twist(long n, long d, GEN F, GEN D)
    1377             : {
    1378         161 :   pari_sp av = avma;
    1379         161 :   GEN v = mfcoefs_i(F, n, d), z = cgetg(n+2, t_VEC);
    1380             :   long i;
    1381         707 :   for (i = 0; i <= n; i++)
    1382             :   {
    1383             :     long s;
    1384         546 :     GEN a = gel(v, i+1);
    1385         546 :     if (d == 1) s = krois(D, i);
    1386             :     else
    1387             :     {
    1388         266 :       pari_sp av2 = avma;
    1389         266 :       s = kronecker(D, muluu(i, d)); set_avma(av2);
    1390             :     }
    1391         546 :     switch(s)
    1392             :     {
    1393         147 :       case 1: a = gcopy(a); break;
    1394         140 :       case -1: a = gneg(a); break;
    1395         259 :       default: a = gen_0; break;
    1396             :     }
    1397         546 :     gel(z, i+1) = a;
    1398             :   }
    1399         161 :   return gerepileupto(av, z);
    1400             : }
    1401             : 
    1402             : /* form F given by closure, compute T(n)(F) as closure */
    1403             : static GEN
    1404        1050 : c_hecke(long m, long l, GEN DATA, GEN F)
    1405             : {
    1406        1050 :   pari_sp av = avma;
    1407        1050 :   return gerepilecopy(av, hecke_i(m, l, NULL, F, DATA));
    1408             : }
    1409             : static GEN
    1410         140 : c_const(long n, long d, GEN C)
    1411             : {
    1412         140 :   GEN V = zerovec(n+1);
    1413         140 :   long i, j, l = lg(C);
    1414         140 :   if (l > d*n+2) l = d*n+2;
    1415         189 :   for (i = j = 1; i < l; i+=d, j++) gel(V, j) = gcopy(gel(C,i));
    1416         140 :   return V;
    1417             : }
    1418             : 
    1419             : /* m > 0 */
    1420             : static GEN
    1421         469 : eta3_ZXn(long m)
    1422             : {
    1423         469 :   long l = m+2, n, k;
    1424         469 :   GEN P = cgetg(l,t_POL);
    1425         469 :   P[1] = evalsigne(1)|evalvarn(0);
    1426        6489 :   for (n = 2; n < l; n++) gel(P,n) = gen_0;
    1427         469 :   for (n = k = 0;; n++)
    1428             :   {
    1429        2611 :     if (k + n >= m) { setlg(P, k+3); return P; }
    1430        2142 :     k += n;
    1431             :     /* now k = n(n+1) / 2 */
    1432        2142 :     gel(P, k+2) = odd(n)? utoineg(2*n+1): utoipos(2*n+1);
    1433             :   }
    1434             : }
    1435             : 
    1436             : static GEN
    1437         476 : c_delta(long n, long d)
    1438             : {
    1439         476 :   pari_sp ltop = avma;
    1440         476 :   long N = n*d;
    1441             :   GEN e;
    1442         476 :   if (!N) return mkvec(gen_0);
    1443         469 :   e = eta3_ZXn(N);
    1444         469 :   e = ZXn_sqr(e,N);
    1445         469 :   e = ZXn_sqr(e,N);
    1446         469 :   e = ZXn_sqr(e,N); /* eta(x)^24 */
    1447         469 :   settyp(e, t_VEC);
    1448         469 :   gel(e,1) = gen_0; /* Delta(x) = x*eta(x)^24 as a t_VEC */
    1449         469 :   return gerepilecopy(ltop, c_deflate(n, d, e));
    1450             : }
    1451             : 
    1452             : /* return s(d) such that s|f <=> d | f^2 */
    1453             : static long
    1454          56 : mysqrtu(ulong d)
    1455             : {
    1456          56 :   GEN fa = myfactoru(d), P = gel(fa,1), E = gel(fa,2);
    1457          56 :   long l = lg(P), i, s = 1;
    1458         140 :   for (i = 1; i < l; i++) s *= upowuu(P[i], (E[i]+1)>>1);
    1459          56 :   return s;
    1460             : }
    1461             : static GEN
    1462        1911 : c_theta(long n, long d, GEN psi)
    1463             : {
    1464        1911 :   long lim = usqrt(n*d), F = mfcharmodulus(psi), par = mfcharparity(psi);
    1465        1911 :   long f, d2 = d == 1? 1: mysqrtu(d);
    1466        1911 :   GEN V = zerovec(n + 1);
    1467        8414 :   for (f = d2; f <= lim; f += d2)
    1468        6503 :     if (ugcd(F, f) == 1)
    1469             :     {
    1470        6496 :       pari_sp av = avma;
    1471        6496 :       GEN c = mfchareval(psi, f);
    1472        6496 :       gel(V, f*f/d + 1) = gerepileupto(av, par < 0? gmulgu(c,2*f): gmul2n(c,1));
    1473             :     }
    1474        1911 :   if (F == 1) gel(V, 1) = gen_1;
    1475        1911 :   return V; /* no gerepile needed */
    1476             : }
    1477             : 
    1478             : static GEN
    1479         203 : c_etaquo(long n, long d, GEN eta, GEN gs)
    1480             : {
    1481         203 :   pari_sp av = avma;
    1482         203 :   long s = itos(gs), nd = n*d, nds = nd - s + 1;
    1483             :   GEN c;
    1484         203 :   if (nds <= 0) return zerovec(n+1);
    1485         182 :   c = RgX_to_RgC(eta_product_ZXn(eta, nds), nds); settyp(c, t_VEC);
    1486         182 :   if (s > 0) c = shallowconcat(zerovec(s), c);
    1487         182 :   return gerepilecopy(av, c_deflate(n, d, c));
    1488             : }
    1489             : 
    1490             : static GEN
    1491          77 : c_ell(long n, long d, GEN E)
    1492             : {
    1493          77 :   pari_sp av = avma;
    1494             :   GEN v;
    1495          77 :   if (d == 1) return gconcat(gen_0, ellan(E, n));
    1496           7 :   v = vec_prepend(ellan(E, n*d), gen_0);
    1497           7 :   return gerepilecopy(av, c_deflate(n, d, v));
    1498             : }
    1499             : 
    1500             : static GEN
    1501          21 : c_cusptrace(long n, long d, GEN F)
    1502             : {
    1503          21 :   pari_sp av = avma;
    1504          21 :   GEN D = gel(F,2), res = cgetg(n+2, t_VEC);
    1505          21 :   long i, N = mf_get_N(F), k = mf_get_k(F);
    1506          21 :   gel(res, 1) = gen_0;
    1507         140 :   for (i = 1; i <= n; i++)
    1508         119 :     gel(res, i+1) = mfcusptrace_i(N, k, i*d, mydivisorsu(i*d), D);
    1509          21 :   return gerepilecopy(av, res);
    1510             : }
    1511             : 
    1512             : static GEN
    1513        1890 : c_newtrace(long n, long d, GEN F)
    1514             : {
    1515        1890 :   pari_sp av = avma;
    1516             :   cachenew_t cache;
    1517        1890 :   long N = mf_get_N(F);
    1518             :   GEN v;
    1519        1890 :   init_cachenew(&cache, n == 1? 1: n*d, N, F);
    1520        1890 :   v = colnewtrace(0, n, d, N, mf_get_k(F), &cache);
    1521        1890 :   settyp(v, t_VEC); return gerepilecopy(av, v);
    1522             : }
    1523             : 
    1524             : static GEN
    1525        7462 : c_Bd(long n, long d, GEN F, GEN A)
    1526             : {
    1527        7462 :   pari_sp av = avma;
    1528        7462 :   long a = itou(A), ad = ugcd(a,d), aad = a/ad, i, j;
    1529        7462 :   GEN w, v = mfcoefs_i(F, n/aad, d/ad);
    1530        7462 :   if (a == 1) return v;
    1531        7462 :   n++; w = zerovec(n);
    1532      213087 :   for (i = j = 1; j <= n; i++, j += aad) gel(w,j) = gcopy(gel(v,i));
    1533        7462 :   return gerepileupto(av, w);
    1534             : }
    1535             : 
    1536             : static GEN
    1537        5579 : c_dihedral(long n, long d, GEN F)
    1538             : {
    1539        5579 :   pari_sp av = avma;
    1540        5579 :   GEN CHI = mf_get_CHI(F);
    1541        5579 :   GEN w = gel(F,3), V = dihan(gel(F,2), w, gel(F,4), mfcharorder(CHI), n*d);
    1542        5579 :   GEN Tinit = gel(w,3), Pm = gel(Tinit,1);
    1543        5579 :   GEN A = c_deflate(n, d, V);
    1544        5579 :   if (degpol(Pm) == 1 || RgV_is_ZV(A)) return gerepilecopy(av, A);
    1545        1043 :   return gerepileupto(av, gmodulo(A, Pm));
    1546             : }
    1547             : 
    1548             : static GEN
    1549         343 : c_mfEH(long n, long d, GEN F)
    1550             : {
    1551         343 :   pari_sp av = avma;
    1552             :   GEN v, M, A;
    1553         343 :   long i, r = mf_get_r(F);
    1554         343 :   if (n == 1)
    1555          14 :     return gerepilecopy(av, mkvec2(mfEHcoef(r,0),mfEHcoef(r,d)));
    1556             :   /* speedup mfcoef */
    1557         329 :   if (r == 1)
    1558             :   {
    1559          70 :     v = cgetg(n+2, t_VEC);
    1560          70 :     gel(v,1) = sstoQ(-1,12);
    1561       83258 :     for (i = 1; i <= n; i++)
    1562             :     {
    1563       83188 :       long id = i*d, a = id & 3;
    1564       83188 :       gel(v,i+1) = (a==1 || a==2)? gen_0: uutoQ(hclassno6u(id), 6);
    1565             :     }
    1566          70 :     return v; /* no gerepile needed */
    1567             :   }
    1568         259 :   M = mfEHmat(n*d+1,r);
    1569         259 :   if (d > 1)
    1570             :   {
    1571          35 :     long l = lg(M);
    1572         119 :     for (i = 1; i < l; i++) gel(M,i) = c_deflate(n, d, gel(M,i));
    1573             :   }
    1574         259 :   A = gel(F,2); /* [num(B), den(B)] */
    1575         259 :   v = RgC_Rg_div(RgM_RgC_mul(M, gel(A,1)), gel(A,2));
    1576         259 :   settyp(v,t_VEC); return gerepileupto(av, v);
    1577             : }
    1578             : 
    1579             : static GEN
    1580       11256 : c_mfeisen(long n, long d, GEN F)
    1581             : {
    1582       11256 :   pari_sp av = avma;
    1583       11256 :   GEN v, vchi, E0, P, T, CHI, gk = mf_get_gk(F);
    1584             :   long i, k;
    1585       11256 :   if (typ(gk) != t_INT) return c_mfEH(n, d, F);
    1586       10913 :   k = itou(gk);
    1587       10913 :   vchi = gel(F,2);
    1588       10913 :   E0 = gel(vchi,1);
    1589       10913 :   T = gel(vchi,2);
    1590       10913 :   P = gel(T,1);
    1591       10913 :   CHI = gel(vchi,3);
    1592       10913 :   v = cgetg(n+2, t_VEC);
    1593       10913 :   gel(v, 1) = gcopy(E0); /* E(0) */
    1594       10913 :   if (lg(vchi) == 5)
    1595             :   { /* E_k(chi1,chi2) */
    1596        8820 :     GEN CHI2 = gel(vchi,4), F3 = gel(F,3);
    1597        8820 :     long ord = F3[1], j = F3[2];
    1598      508634 :     for (i = 1; i <= n; i++) gel(v, i+1) = sigchi2(k, CHI, CHI2, i*d, ord);
    1599        8820 :     v = QabV_tracerel(T, j, v);
    1600             :   }
    1601             :   else
    1602             :   { /* E_k(chi) */
    1603       26285 :     for (i = 1; i <= n; i++) gel(v, i+1) = sigchi(k, CHI, i*d);
    1604             :   }
    1605       10913 :   if (degpol(P) != 1 && !RgV_is_QV(v)) return gerepileupto(av, gmodulo(v, P));
    1606        7980 :   return gerepilecopy(av, v);
    1607             : }
    1608             : 
    1609             : /* N^k * (D * B_k)(x/N), set D = denom(B_k) */
    1610             : static GEN
    1611        1561 : bern_init(long N, long k, GEN *pD)
    1612        1561 : { return ZX_rescale(Q_remove_denom(bernpol(k, 0), pD), utoi(N)); }
    1613             : 
    1614             : /* L(chi_D, 1-k) */
    1615             : static GEN
    1616          28 : lfunquadneg_naive(long D, long k)
    1617             : {
    1618             :   GEN B, dS, S;
    1619          28 :   long r, N = labs(D);
    1620             :   pari_sp av;
    1621          28 :   if (k == 1 && N == 1) return gneg(ghalf);
    1622          28 :   B = bern_init(N, k, &dS);
    1623          28 :   dS = mul_denom(dS, stoi(-N*k));
    1624          28 :   av = avma;
    1625        7175 :   for (r = 0, S = gen_0; r < N; r++)
    1626             :   {
    1627        7147 :     long c = kross(D, r);
    1628        7147 :     if (c)
    1629             :     {
    1630        5152 :       GEN t = ZX_Z_eval(B, utoi(r));
    1631        5152 :       S = c > 0 ? addii(S, t) : subii(S, t);
    1632        5152 :       S = gerepileuptoint(av, S);
    1633             :     }
    1634             :   }
    1635          28 :   return gdiv(S, dS);
    1636             : }
    1637             : 
    1638             : /* Returns vector of coeffs from F[0], F[d], ..., F[d*n] */
    1639             : static GEN
    1640       37821 : mfcoefs_i(GEN F, long n, long d)
    1641             : {
    1642       37821 :   if (n < 0) return gen_0;
    1643       37821 :   switch(mf_get_type(F))
    1644             :   {
    1645         140 :     case t_MF_CONST: return c_const(n, d, gel(F,2));
    1646       11256 :     case t_MF_EISEN: return c_mfeisen(n, d, F);
    1647         840 :     case t_MF_Ek: return c_Ek(n, d, F);
    1648         476 :     case t_MF_DELTA: return c_delta(n, d);
    1649        1645 :     case t_MF_THETA: return c_theta(n, d, gel(F,2));
    1650         203 :     case t_MF_ETAQUO: return c_etaquo(n, d, gel(F,2), gel(F,3));
    1651          77 :     case t_MF_ELL: return c_ell(n, d, gel(F,2));
    1652         637 :     case t_MF_MUL: return c_mul(n, d, F);
    1653         112 :     case t_MF_POW: return c_pow(n, d, F);
    1654          42 :     case t_MF_BRACKET: return c_bracket(n, d, F);
    1655        2975 :     case t_MF_LINEAR: return c_linear(n, d, gel(F,2), gel(F,3), gel(F,4));
    1656        2198 :     case t_MF_LINEAR_BHN: return c_linear_bhn(n, d, F);
    1657         833 :     case t_MF_DIV: return c_div(n, d, F);
    1658          35 :     case t_MF_SHIFT: return c_shift(n, d, gel(F,2), gel(F,3));
    1659         175 :     case t_MF_DERIV: return c_deriv(n, d, gel(F,2), gel(F,3));
    1660          14 :     case t_MF_DERIVE2: return c_derivE2(n, d, gel(F,2), gel(F,3));
    1661         161 :     case t_MF_TWIST: return c_twist(n, d, gel(F,2), gel(F,3));
    1662        1050 :     case t_MF_HECKE: return c_hecke(n, d, gel(F,2), gel(F,3));
    1663        7462 :     case t_MF_BD: return c_Bd(n, d, gel(F,2), gel(F,3));
    1664          21 :     case t_MF_TRACE: return c_cusptrace(n, d, F);
    1665        1890 :     case t_MF_NEWTRACE: return c_newtrace(n, d, F);
    1666        5579 :     case t_MF_DIHEDRAL: return c_dihedral(n, d, F);
    1667             :     default: pari_err_TYPE("mfcoefs",F); return NULL;/*LCOV_EXCL_LINE*/
    1668             :   }
    1669             : }
    1670             : 
    1671             : static GEN
    1672         385 : matdeflate(long n, long d, GEN M)
    1673             : {
    1674             :   long i, l;
    1675             :   GEN A;
    1676             :   /*  if (d == 1) return M; */
    1677         385 :   A = cgetg_copy(M,&l);
    1678        1575 :   for (i = 1; i < l; i++) gel(A,i) = c_deflate(n,d,gel(M,i));
    1679         385 :   return A;
    1680             : }
    1681             : static int
    1682        5971 : space_is_cusp(long space) { return space != mf_FULL && space != mf_EISEN; }
    1683             : /* safe with flraw mf */
    1684             : static GEN
    1685        2576 : mfcoefs_mf(GEN mf, long n, long d)
    1686             : {
    1687        2576 :   GEN MS, ME, E = MF_get_E(mf), S = MF_get_S(mf), M = MF_get_M(mf);
    1688        2576 :   long lE = lg(E), lS = lg(S), l = lE+lS-1;
    1689             : 
    1690        2576 :   if (l == 1) return cgetg(1, t_MAT);
    1691        2464 :   if (typ(M) == t_MAT && lg(M) != 1 && (n+1)*d < nbrows(M))
    1692          21 :     return matdeflate(n, d, M); /*cached; lg = 1 is possible from mfinit */
    1693        2443 :   ME = (lE == 1)? cgetg(1, t_MAT): mfvectomat(E, n, d);
    1694        2443 :   if (lS == 1)
    1695         448 :     MS = cgetg(1, t_MAT);
    1696        1995 :   else if (mf_get_type(gel(S,1)) == t_MF_DIV) /*k 1/2-integer or k=1 (exotic)*/
    1697         364 :     MS = matdeflate(n,d, mflineardivtomat(MF_get_N(mf), S, n*d));
    1698        1631 :   else if (MF_get_k(mf) == 1) /* k = 1 (dihedral) */
    1699             :   {
    1700         308 :     GEN M = mfvectomat(gmael(S,1,2), n, d);
    1701             :     long i;
    1702         308 :     MS = cgetg(lS, t_MAT);
    1703        1589 :     for (i = 1; i < lS; i++)
    1704             :     {
    1705        1281 :       GEN f = gel(S,i), dc = gel(f,4), c = RgM_RgC_mul(M, gel(f,3));
    1706        1281 :       if (!equali1(dc)) c = RgC_Rg_div(c,dc);
    1707        1281 :       gel(MS,i) = c;
    1708             :     }
    1709             :   }
    1710             :   else /* k >= 2 integer */
    1711        1323 :     MS = bhnmat_extend_nocache(NULL, MF_get_N(mf), n, d, S);
    1712        2443 :   return shallowconcat(ME,MS);
    1713             : }
    1714             : GEN
    1715        3850 : mfcoefs(GEN F, long n, long d)
    1716             : {
    1717        3850 :   if (!checkmf_i(F))
    1718             :   {
    1719          42 :     pari_sp av = avma;
    1720          42 :     GEN mf = checkMF_i(F); if (!mf) pari_err_TYPE("mfcoefs", F);
    1721          42 :     return gerepilecopy(av, mfcoefs_mf(mf,n,d));
    1722             :   }
    1723        3808 :   if (d <= 0) pari_err_DOMAIN("mfcoefs", "d", "<=", gen_0, stoi(d));
    1724        3808 :   if (n < 0) return cgetg(1, t_VEC);
    1725        3808 :   return mfcoefs_i(F, n, d);
    1726             : }
    1727             : 
    1728             : /* assume k >= 0 */
    1729             : static GEN
    1730         455 : mfak_i(GEN F, long k)
    1731             : {
    1732         455 :   if (!k) return gel(mfcoefs_i(F,0,1), 1);
    1733         294 :   return gel(mfcoefs_i(F,1,k), 2);
    1734             : }
    1735             : GEN
    1736         301 : mfcoef(GEN F, long n)
    1737             : {
    1738         301 :   pari_sp av = avma;
    1739         301 :   if (!checkmf_i(F)) pari_err_TYPE("mfcoef",F);
    1740         301 :   return n < 0? gen_0: gerepilecopy(av, mfak_i(F, n));
    1741             : }
    1742             : 
    1743             : static GEN
    1744         126 : paramconst() { return tagparams(t_MF_CONST, mkNK(1,0,mfchartrivial())); }
    1745             : static GEN
    1746          84 : mftrivial(void) { retmkvec2(paramconst(), cgetg(1,t_VEC)); }
    1747             : static GEN
    1748          42 : mf1(void) { retmkvec2(paramconst(), mkvec(gen_1)); }
    1749             : 
    1750             : /* induce mfchar CHI to G */
    1751             : static GEN
    1752      307811 : induce(GEN G, GEN CHI)
    1753             : {
    1754             :   GEN o, chi;
    1755      307811 :   if (typ(CHI) == t_INT) /* Kronecker */
    1756             :   {
    1757      300776 :     chi = znchar_quad(G, CHI);
    1758      300776 :     o = ZV_equal0(chi)? gen_1: gen_2;
    1759      300776 :     CHI = mkvec4(G,chi,o,cgetg(1,t_VEC));
    1760             :   }
    1761             :   else
    1762             :   {
    1763        7035 :     if (mfcharmodulus(CHI) == itos(znstar_get_N(G))) return CHI;
    1764        6419 :     CHI = leafcopy(CHI);
    1765        6419 :     chi = zncharinduce(gel(CHI,1), gel(CHI,2), G);
    1766        6419 :     gel(CHI,1) = G;
    1767        6419 :     gel(CHI,2) = chi;
    1768             :   }
    1769      307195 :   return CHI;
    1770             : }
    1771             : /* induce mfchar CHI to znstar(N) */
    1772             : static GEN
    1773       42364 : induceN(long N, GEN CHI)
    1774             : {
    1775       42364 :   if (mfcharmodulus(CHI) != N) CHI = induce(znstar0(utoipos(N),1), CHI);
    1776       42364 :   return CHI;
    1777             : }
    1778             : /* *pCHI1 and *pCHI2 are mfchar, induce to common modulus */
    1779             : static void
    1780        6419 : char2(GEN *pCHI1, GEN *pCHI2)
    1781             : {
    1782        6419 :   GEN CHI1 = *pCHI1, G1 = gel(CHI1,1), N1 = znstar_get_N(G1);
    1783        6419 :   GEN CHI2 = *pCHI2, G2 = gel(CHI2,1), N2 = znstar_get_N(G2);
    1784        6419 :   if (!equalii(N1,N2))
    1785             :   {
    1786        4851 :     GEN G, d = gcdii(N1,N2);
    1787        4851 :     if      (equalii(N2,d)) *pCHI2 = induce(G1, CHI2);
    1788        1540 :     else if (equalii(N1,d)) *pCHI1 = induce(G2, CHI1);
    1789             :     else
    1790             :     {
    1791         154 :       if (!equali1(d)) N2 = diviiexact(N2,d);
    1792         154 :       G = znstar0(mulii(N1,N2), 1);
    1793         154 :       *pCHI1 = induce(G, CHI1);
    1794         154 :       *pCHI2 = induce(G, CHI2);
    1795             :     }
    1796             :   }
    1797        6419 : }
    1798             : /* mfchar or charinit wrt same modulus; outputs a mfchar */
    1799             : static GEN
    1800      301861 : mfcharmul_i(GEN CHI1, GEN CHI2)
    1801             : {
    1802      301861 :   GEN G = gel(CHI1,1), chi3 = zncharmul(G, gel(CHI1,2), gel(CHI2,2));
    1803      301861 :   return mfcharGL(G, chi3);
    1804             : }
    1805             : /* mfchar or charinit; outputs a mfchar */
    1806             : static GEN
    1807        1106 : mfcharmul(GEN CHI1, GEN CHI2)
    1808             : {
    1809        1106 :   char2(&CHI1, &CHI2); return mfcharmul_i(CHI1,CHI2);
    1810             : }
    1811             : /* mfchar or charinit; outputs a mfchar */
    1812             : static GEN
    1813         147 : mfcharpow(GEN CHI, GEN n)
    1814             : {
    1815             :   GEN G, chi;
    1816         147 :   G = gel(CHI,1); chi = zncharpow(G, gel(CHI,2), n);
    1817         147 :   return mfchartoprimitive(mfcharGL(G, chi), NULL);
    1818             : }
    1819             : /* mfchar or charinit wrt same modulus; outputs a mfchar */
    1820             : static GEN
    1821        5313 : mfchardiv_i(GEN CHI1, GEN CHI2)
    1822             : {
    1823        5313 :   GEN G = gel(CHI1,1), chi3 = znchardiv(G, gel(CHI1,2), gel(CHI2,2));
    1824        5313 :   return mfcharGL(G, chi3);
    1825             : }
    1826             : /* mfchar or charinit; outputs a mfchar */
    1827             : static GEN
    1828        5313 : mfchardiv(GEN CHI1, GEN CHI2)
    1829             : {
    1830        5313 :   char2(&CHI1, &CHI2); return mfchardiv_i(CHI1,CHI2);
    1831             : }
    1832             : static GEN
    1833          56 : mfcharconj(GEN CHI)
    1834             : {
    1835          56 :   CHI = leafcopy(CHI);
    1836          56 :   gel(CHI,2) = zncharconj(gel(CHI,1), gel(CHI,2));
    1837          56 :   return CHI;
    1838             : }
    1839             : 
    1840             : /* CHI mfchar, assume 4 | N. Multiply CHI by \chi_{-4} */
    1841             : static GEN
    1842         980 : mfchilift(GEN CHI, long N)
    1843             : {
    1844         980 :   CHI = induceN(N, CHI);
    1845         980 :   return mfcharmul_i(CHI, induce(gel(CHI,1), stoi(-4)));
    1846             : }
    1847             : /* CHI defined mod N, N4 = N/4;
    1848             :  * if CHI is defined mod N4 return CHI;
    1849             :  * else if CHI' = CHI*(-4,.) is defined mod N4, return CHI' (primitive)
    1850             :  * else error */
    1851             : static GEN
    1852          35 : mfcharchiliftprim(GEN CHI, long N4)
    1853             : {
    1854          35 :   long FC = mfcharconductor(CHI);
    1855             :   GEN CHIP;
    1856          35 :   if (N4 % FC == 0) return CHI;
    1857          14 :   CHIP = mfchartoprimitive(mfchilift(CHI, N4 << 2), &FC);
    1858          14 :   if (N4 % FC) pari_err_TYPE("mfkohnenbasis [incorrect CHI]", CHI);
    1859          14 :   return CHIP;
    1860             : }
    1861             : /* ensure CHI(-1) = (-1)^k [k integer] or 1 [half-integer], by multiplying
    1862             :  * by (-4/.) if needed */
    1863             : static GEN
    1864        2821 : mfchiadjust(GEN CHI, GEN gk, long N)
    1865             : {
    1866        2821 :   long par = mfcharparity(CHI);
    1867        2821 :   if (typ(gk) == t_INT &&  mpodd(gk)) par = -par;
    1868        2821 :   return par == 1 ? CHI : mfchilift(CHI, N);
    1869             : }
    1870             : 
    1871             : static GEN
    1872        3906 : mfsamefield(GEN T, GEN P, GEN Q)
    1873             : {
    1874        3906 :   if (degpol(P) == 1) return Q;
    1875         602 :   if (degpol(Q) == 1) return P;
    1876         511 :   if (!gequal(P,Q)) pari_err_TYPE("mfsamefield [different fields]",mkvec2(P,Q));
    1877         504 :   if (T) err_cyclo();
    1878         504 :   return P;
    1879             : }
    1880             : 
    1881             : GEN
    1882         455 : mfmul(GEN f, GEN g)
    1883             : {
    1884         455 :   pari_sp av = avma;
    1885             :   GEN T, N, K, NK, CHI, CHIf, CHIg;
    1886         455 :   if (!checkmf_i(f)) pari_err_TYPE("mfmul",f);
    1887         455 :   if (!checkmf_i(g)) pari_err_TYPE("mfmul",g);
    1888         455 :   N = lcmii(mf_get_gN(f), mf_get_gN(g));
    1889         455 :   K = gadd(mf_get_gk(f), mf_get_gk(g));
    1890         455 :   CHIf = mf_get_CHI(f);
    1891         455 :   CHIg = mf_get_CHI(g);
    1892         455 :   CHI = mfchiadjust(mfcharmul(CHIf,CHIg), K, itos(N));
    1893         455 :   T = chicompat(CHI, CHIf, CHIg);
    1894         455 :   NK = mkgNK(N, K, CHI, mfsamefield(T, mf_get_field(f), mf_get_field(g)));
    1895         448 :   return gerepilecopy(av, T? tag3(t_MF_MUL,NK,f,g,T): tag2(t_MF_MUL,NK,f,g));
    1896             : }
    1897             : GEN
    1898          77 : mfpow(GEN f, long n)
    1899             : {
    1900          77 :   pari_sp av = avma;
    1901             :   GEN T, KK, NK, gn, CHI, CHIf;
    1902          77 :   if (!checkmf_i(f)) pari_err_TYPE("mfpow",f);
    1903          77 :   if (!n) return mf1();
    1904          77 :   if (n == 1) return gcopy(f);
    1905          77 :   KK = gmulsg(n,mf_get_gk(f));
    1906          77 :   gn = stoi(n);
    1907          77 :   CHIf = mf_get_CHI(f);
    1908          77 :   CHI = mfchiadjust(mfcharpow(CHIf,gn), KK, mf_get_N(f));
    1909          77 :   T = chicompat(CHI, CHIf, CHIf);
    1910          70 :   NK = mkgNK(mf_get_gN(f), KK, CHI, mf_get_field(f));
    1911          70 :   return gerepilecopy(av, T? tag3(t_MF_POW,NK,f,gn,T): tag2(t_MF_POW,NK,f,gn));
    1912             : }
    1913             : GEN
    1914          28 : mfbracket(GEN f, GEN g, long m)
    1915             : {
    1916          28 :   pari_sp av = avma;
    1917             :   GEN T, N, K, NK, CHI, CHIf, CHIg;
    1918          28 :   if (!checkmf_i(f)) pari_err_TYPE("mfbracket",f);
    1919          28 :   if (!checkmf_i(g)) pari_err_TYPE("mfbracket",g);
    1920          28 :   if (m < 0) pari_err_TYPE("mfbracket [m<0]",stoi(m));
    1921          28 :   K = gaddgs(gadd(mf_get_gk(f), mf_get_gk(g)), 2*m);
    1922          28 :   if (gsigne(K) < 0) pari_err_IMPL("mfbracket for this form");
    1923          28 :   N = lcmii(mf_get_gN(f), mf_get_gN(g));
    1924          28 :   CHIf = mf_get_CHI(f);
    1925          28 :   CHIg = mf_get_CHI(g);
    1926          28 :   CHI = mfcharmul(CHIf, CHIg);
    1927          28 :   CHI = mfchiadjust(CHI, K, itou(N));
    1928          28 :   T = chicompat(CHI, CHIf, CHIg);
    1929          28 :   NK = mkgNK(N, K, CHI, mfsamefield(T, mf_get_field(f), mf_get_field(g)));
    1930          56 :   return gerepilecopy(av, T? tag4(t_MF_BRACKET, NK, f, g, utoi(m), T)
    1931          28 :                            : tag3(t_MF_BRACKET, NK, f, g, utoi(m)));
    1932             : }
    1933             : 
    1934             : /* remove 0 entries in L */
    1935             : static int
    1936        1806 : mflinear_strip(GEN *pF, GEN *pL)
    1937             : {
    1938        1806 :   pari_sp av = avma;
    1939        1806 :   GEN F = *pF, L = *pL;
    1940        1806 :   long i, j, l = lg(L);
    1941        1806 :   GEN F2 = cgetg(l, t_VEC), L2 = cgetg(l, t_VEC);
    1942       10080 :   for (i = j = 1; i < l; i++)
    1943             :   {
    1944        8274 :     if (gequal0(gel(L,i))) continue;
    1945        4193 :     gel(F2,j) = gel(F,i);
    1946        4193 :     gel(L2,j) = gel(L,i); j++;
    1947             :   }
    1948        1806 :   if (j == l) set_avma(av);
    1949             :   else
    1950             :   {
    1951         546 :     setlg(F2,j); *pF = F2;
    1952         546 :     setlg(L2,j); *pL = L2;
    1953             :   }
    1954        1806 :   return (j > 1);
    1955             : }
    1956             : static GEN
    1957        6727 : taglinear_i(long t, GEN NK, GEN F, GEN L)
    1958             : {
    1959             :   GEN dL;
    1960        6727 :   L = Q_remove_denom(L, &dL); if (!dL) dL = gen_1;
    1961        6727 :   return tag3(t, NK, F, L, dL);
    1962             : }
    1963             : static GEN
    1964        2765 : taglinear(GEN NK, GEN F, GEN L)
    1965             : {
    1966        2765 :   long t = ok_bhn_linear(F)? t_MF_LINEAR_BHN: t_MF_LINEAR;
    1967        2765 :    return taglinear_i(t, NK, F, L);
    1968             : }
    1969             : /* assume F has parameters NK = [N,K,CHI] */
    1970             : static GEN
    1971         476 : mflinear_i(GEN NK, GEN F, GEN L)
    1972             : {
    1973         476 :   if (!mflinear_strip(&F,&L)) return mftrivial();
    1974         476 :   return taglinear(NK, F,L);
    1975             : }
    1976             : static GEN
    1977         686 : mflinear_bhn(GEN mf, GEN L)
    1978             : {
    1979             :   long i, l;
    1980         686 :   GEN P, NK, F = MF_get_S(mf);
    1981         686 :   if (!mflinear_strip(&F,&L)) return mftrivial();
    1982         679 :   l = lg(L); P = pol_x(1);
    1983        3003 :   for (i = 1; i < l; i++)
    1984             :   {
    1985        2324 :     GEN c = gel(L,i);
    1986        2324 :     if (typ(c) == t_POLMOD && varn(gel(c,1)) == 1)
    1987         518 :       P = mfsamefield(NULL, P, gel(c,1));
    1988             :   }
    1989         679 :   NK = mkgNK(MF_get_gN(mf), MF_get_gk(mf), MF_get_CHI(mf), P);
    1990         679 :   return taglinear_i(t_MF_LINEAR_BHN,  NK, F,L);
    1991             : }
    1992             : 
    1993             : /* F vector of forms with same weight and character but varying level, return
    1994             :  * global [N,k,chi,P] */
    1995             : static GEN
    1996        3227 : vecmfNK(GEN F)
    1997             : {
    1998        3227 :   long i, l = lg(F);
    1999             :   GEN N, f;
    2000        3227 :   if (l == 1) return mkNK(1, 0, mfchartrivial());
    2001        3227 :   f = gel(F,1); N = mf_get_gN(f);
    2002       45255 :   for (i = 2; i < l; i++) N = lcmii(N, mf_get_gN(gel(F,i)));
    2003        3227 :   return mkgNK(N, mf_get_gk(f), mf_get_CHI(f), mf_get_field(f));
    2004             : }
    2005             : /* do not use mflinear: mflineardivtomat rely on F being constant across the
    2006             :  * basis where mflinear strips the ones matched by 0 coeffs. Assume k and CHI
    2007             :  * constant, N is allowed to vary. */
    2008             : static GEN
    2009        1211 : vecmflinear(GEN F, GEN C)
    2010             : {
    2011        1211 :   long i, t, l = lg(C);
    2012        1211 :   GEN NK, v = cgetg(l, t_VEC);
    2013        1211 :   if (l == 1) return v;
    2014        1211 :   t = ok_bhn_linear(F)? t_MF_LINEAR_BHN: t_MF_LINEAR;
    2015        1211 :   NK = vecmfNK(F);
    2016        4494 :   for (i = 1; i < l; i++) gel(v,i) = taglinear_i(t, NK, F, gel(C,i));
    2017        1211 :   return v;
    2018             : }
    2019             : /* vecmflinear(F,C), then divide everything by E, which has valuation 0 */
    2020             : static GEN
    2021         427 : vecmflineardiv0(GEN F, GEN C, GEN E)
    2022             : {
    2023         427 :   GEN v = vecmflinear(F, C);
    2024         427 :   long i, l = lg(v);
    2025         427 :   if (l == 1) return v;
    2026         427 :   gel(v,1) = mfdiv_val(gel(v,1), E, 0);
    2027        1631 :   for (i = 2; i < l; i++)
    2028             :   { /* v[i] /= E */
    2029        1204 :     GEN f = shallowcopy(gel(v,1));
    2030        1204 :     gel(f,2) = gel(v,i);
    2031        1204 :     gel(v,i) = f;
    2032             :   }
    2033         427 :   return v;
    2034             : }
    2035             : 
    2036             : /* Non empty linear combination of linear combinations of same
    2037             :  * F_j=\sum_i \mu_{i,j}G_i so R = \sum_i (\sum_j(\la_j\mu_{i,j})) G_i */
    2038             : static GEN
    2039        2016 : mflinear_linear(GEN F, GEN L, int strip)
    2040             : {
    2041        2016 :   long l = lg(F), j;
    2042        2016 :   GEN vF, M = cgetg(l, t_MAT);
    2043        2016 :   L = shallowcopy(L);
    2044       18522 :   for (j = 1; j < l; j++)
    2045             :   {
    2046       16506 :     GEN f = gel(F,j), c = gel(f,3), d = gel(f,4);
    2047       16506 :     if (typ(c) == t_VEC) c = shallowtrans(c);
    2048       16506 :     if (!isint1(d)) gel(L,j) = gdiv(gel(L,j),d);
    2049       16506 :     gel(M,j) = c;
    2050             :   }
    2051        2016 :   vF = gmael(F,1,2); L = RgM_RgC_mul(M,L);
    2052        2016 :   if (strip && !mflinear_strip(&vF,&L)) return mftrivial();
    2053        2016 :   return taglinear(vecmfNK(vF), vF, L);
    2054             : }
    2055             : /* F nonempty vector of forms of the form mfdiv(mflinear(B,v), E) where E
    2056             :  * does not vanish at oo, or mflinear(B,v). Apply mflinear(F, L) */
    2057             : static GEN
    2058        2016 : mflineardiv_linear(GEN F, GEN L, int strip)
    2059             : {
    2060        2016 :   long l = lg(F), j;
    2061             :   GEN v, E, f;
    2062        2016 :   if (lg(L) != l) pari_err_DIM("mflineardiv_linear");
    2063        2016 :   f = gel(F,1); /* l > 1 */
    2064        2016 :   if (mf_get_type(f) != t_MF_DIV) return mflinear_linear(F,L,strip);
    2065        1708 :   E = gel(f,3);
    2066        1708 :   v = cgetg(l, t_VEC);
    2067       17059 :   for (j = 1; j < l; j++) { GEN f = gel(F,j); gel(v,j) = gel(f,2); }
    2068        1708 :   return mfdiv_val(mflinear_linear(v,L,strip), E, 0);
    2069             : }
    2070             : static GEN
    2071         476 : vecmflineardiv_linear(GEN F, GEN M)
    2072             : {
    2073         476 :   long i, l = lg(M);
    2074         476 :   GEN v = cgetg(l, t_VEC);
    2075        1918 :   for (i = 1; i < l; i++) gel(v,i) = mflineardiv_linear(F, gel(M,i), 0);
    2076         476 :   return v;
    2077             : }
    2078             : 
    2079             : static GEN
    2080         994 : tobasis(GEN mf, GEN F, GEN L)
    2081             : {
    2082         994 :   if (checkmf_i(L) && mf) return mftobasis(mf, L, 0);
    2083         987 :   if (typ(F) != t_VEC) pari_err_TYPE("mflinear",F);
    2084         987 :   if (!is_vec_t(typ(L))) pari_err_TYPE("mflinear",L);
    2085         987 :   if (lg(L) != lg(F)) pari_err_DIM("mflinear");
    2086         987 :   return L;
    2087             : }
    2088             : GEN
    2089        1036 : mflinear(GEN F, GEN L)
    2090             : {
    2091        1036 :   pari_sp av = avma;
    2092        1036 :   GEN G, NK, P, mf = checkMF_i(F), N = NULL, K = NULL, CHI = NULL;
    2093             :   long i, l;
    2094        1036 :   if (mf)
    2095             :   {
    2096         700 :     GEN gk = MF_get_gk(mf);
    2097         700 :     F = MF_get_basis(F);
    2098         700 :     if (typ(gk) != t_INT)
    2099          42 :       return gerepilecopy(av, mflineardiv_linear(F, L, 1));
    2100         658 :     if (itou(gk) > 1 && space_is_cusp(MF_get_space(mf)))
    2101             :     {
    2102         441 :       L = tobasis(mf, F, L);
    2103         441 :       return gerepilecopy(av, mflinear_bhn(mf, L));
    2104             :     }
    2105             :   }
    2106         553 :   L = tobasis(mf, F, L);
    2107         553 :   if (!mflinear_strip(&F,&L)) return mftrivial();
    2108             : 
    2109         546 :   l = lg(F);
    2110         546 :   if (l == 2 && gequal1(gel(L,1))) return gerepilecopy(av, gel(F,1));
    2111         287 :   P = pol_x(1);
    2112         910 :   for (i = 1; i < l; i++)
    2113             :   {
    2114         630 :     GEN f = gel(F,i), c = gel(L,i), Ni, Ki;
    2115         630 :     if (!checkmf_i(f)) pari_err_TYPE("mflinear", f);
    2116         630 :     Ni = mf_get_gN(f); N = N? lcmii(N, Ni): Ni;
    2117         630 :     Ki = mf_get_gk(f);
    2118         630 :     if (!K) K = Ki;
    2119         343 :     else if (!gequal(K, Ki))
    2120           7 :       pari_err_TYPE("mflinear [different weights]", mkvec2(K,Ki));
    2121         623 :     P = mfsamefield(NULL, P, mf_get_field(f));
    2122         623 :     if (typ(c) == t_POLMOD && varn(gel(c,1)) == 1)
    2123         126 :       P = mfsamefield(NULL, P, gel(c,1));
    2124             :   }
    2125         280 :   G = znstar0(N,1);
    2126         889 :   for (i = 1; i < l; i++)
    2127             :   {
    2128         616 :     GEN CHI2 = mf_get_CHI(gel(F,i));
    2129         616 :     CHI2 = induce(G, CHI2);
    2130         616 :     if (!CHI) CHI = CHI2;
    2131         336 :     else if (!gequal(CHI, CHI2))
    2132           7 :       pari_err_TYPE("mflinear [different characters]", mkvec2(CHI,CHI2));
    2133             :   }
    2134         273 :   NK = mkgNK(N, K, CHI, P);
    2135         273 :   return gerepilecopy(av, taglinear(NK,F,L));
    2136             : }
    2137             : 
    2138             : GEN
    2139          42 : mfshift(GEN F, long sh)
    2140             : {
    2141          42 :   pari_sp av = avma;
    2142          42 :   if (!checkmf_i(F)) pari_err_TYPE("mfshift",F);
    2143          42 :   return gerepilecopy(av, tag2(t_MF_SHIFT, mf_get_NK(F), F, stoi(sh)));
    2144             : }
    2145             : static long
    2146          49 : mfval(GEN F)
    2147             : {
    2148          49 :   pari_sp av = avma;
    2149          49 :   long i = 0, n, sb;
    2150             :   GEN gk, gN;
    2151          49 :   if (!checkmf_i(F)) pari_err_TYPE("mfval", F);
    2152          49 :   gN = mf_get_gN(F);
    2153          49 :   gk = mf_get_gk(F);
    2154          49 :   sb = mfsturmNgk(itou(gN), gk);
    2155          70 :   for (n = 1; n <= sb;)
    2156             :   {
    2157             :     GEN v;
    2158          63 :     if (n > 0.5*sb) n = sb+1;
    2159          63 :     v = mfcoefs_i(F, n, 1);
    2160         119 :     for (; i <= n; i++)
    2161          98 :       if (!gequal0(gel(v, i+1))) return gc_long(av,i);
    2162          21 :     n <<= 1;
    2163             :   }
    2164           7 :   return gc_long(av,-1);
    2165             : }
    2166             : 
    2167             : GEN
    2168        2163 : mfdiv_val(GEN f, GEN g, long vg)
    2169             : {
    2170             :   GEN T, N, K, NK, CHI, CHIf, CHIg;
    2171        2163 :   if (vg) { f = mfshift(f,vg); g = mfshift(g,vg); }
    2172        2163 :   N = lcmii(mf_get_gN(f), mf_get_gN(g));
    2173        2163 :   K = gsub(mf_get_gk(f), mf_get_gk(g));
    2174        2163 :   CHIf = mf_get_CHI(f);
    2175        2163 :   CHIg = mf_get_CHI(g);
    2176        2163 :   CHI = mfchiadjust(mfchardiv(CHIf, CHIg), K, itos(N));
    2177        2163 :   T = chicompat(CHI, CHIf, CHIg);
    2178        2156 :   NK = mkgNK(N, K, CHI, mfsamefield(T, mf_get_field(f), mf_get_field(g)));
    2179        2156 :   return T? tag3(t_MF_DIV, NK, f, g, T): tag2(t_MF_DIV, NK, f, g);
    2180             : }
    2181             : GEN
    2182          49 : mfdiv(GEN F, GEN G)
    2183             : {
    2184          49 :   pari_sp av = avma;
    2185          49 :   long v = mfval(G);
    2186          49 :   if (!checkmf_i(F)) pari_err_TYPE("mfdiv", F);
    2187          42 :   if (v < 0 || (v && !gequal0(mfcoefs(F, v-1, 1))))
    2188          14 :     pari_err_DOMAIN("mfdiv", "ord(G)", ">", strtoGENstr("ord(F)"),
    2189             :                     mkvec2(F, G));
    2190          28 :   return gerepilecopy(av, mfdiv_val(F, G, v));
    2191             : }
    2192             : GEN
    2193         182 : mfderiv(GEN F, long m)
    2194             : {
    2195         182 :   pari_sp av = avma;
    2196             :   GEN NK, gk;
    2197         182 :   if (!checkmf_i(F)) pari_err_TYPE("mfderiv",F);
    2198         182 :   gk = gaddgs(mf_get_gk(F), 2*m);
    2199         182 :   NK = mkgNK(mf_get_gN(F), gk, mf_get_CHI(F), mf_get_field(F));
    2200         182 :   return gerepilecopy(av, tag2(t_MF_DERIV, NK, F, stoi(m)));
    2201             : }
    2202             : GEN
    2203          21 : mfderivE2(GEN F, long m)
    2204             : {
    2205          21 :   pari_sp av = avma;
    2206             :   GEN NK, gk;
    2207          21 :   if (!checkmf_i(F)) pari_err_TYPE("mfderivE2",F);
    2208          21 :   if (m < 0) pari_err_DOMAIN("mfderivE2","m","<",gen_0,stoi(m));
    2209          21 :   gk = gaddgs(mf_get_gk(F), 2*m);
    2210          21 :   NK = mkgNK(mf_get_gN(F), gk, mf_get_CHI(F), mf_get_field(F));
    2211          21 :   return gerepilecopy(av, tag2(t_MF_DERIVE2, NK, F, stoi(m)));
    2212             : }
    2213             : 
    2214             : GEN
    2215          21 : mftwist(GEN F, GEN D)
    2216             : {
    2217          21 :   pari_sp av = avma;
    2218             :   GEN NK, CHI, NT, Da;
    2219             :   long q;
    2220          21 :   if (!checkmf_i(F)) pari_err_TYPE("mftwist", F);
    2221          21 :   if (typ(D) != t_INT) pari_err_TYPE("mftwist", D);
    2222          21 :   Da = mpabs_shallow(D);
    2223          21 :   CHI = mf_get_CHI(F); q = mfcharconductor(CHI);
    2224          21 :   NT = glcm(glcm(mf_get_gN(F), mulsi(q, Da)), sqri(Da));
    2225          21 :   NK = mkgNK(NT, mf_get_gk(F), CHI, mf_get_field(F));
    2226          21 :   return gerepilecopy(av, tag2(t_MF_TWIST, NK, F, D));
    2227             : }
    2228             : 
    2229             : /***************************************************************/
    2230             : /*                 Generic cache handling                      */
    2231             : /***************************************************************/
    2232             : enum { cache_FACT, cache_DIV, cache_H, cache_D, cache_DIH };
    2233             : typedef struct {
    2234             :   const char *name;
    2235             :   GEN cache;
    2236             :   ulong minself, maxself;
    2237             :   void (*init)(long);
    2238             :   ulong miss, maxmiss;
    2239             :   long compressed;
    2240             : } cache;
    2241             : 
    2242             : static void constfact(long lim);
    2243             : static void constdiv(long lim);
    2244             : static void consttabh(long lim);
    2245             : static void consttabdihedral(long lim);
    2246             : static void constcoredisc(long lim);
    2247             : static THREAD cache caches[] = {
    2248             : { "Factors",  NULL,  50000,    50000, &constfact, 0, 0, 0 },
    2249             : { "Divisors", NULL,  50000,    50000, &constdiv, 0, 0, 0 },
    2250             : { "H",        NULL, 100000, 10000000, &consttabh, 0, 0, 1 },
    2251             : { "CorediscF",NULL, 100000, 10000000, &constcoredisc, 0, 0, 0 },
    2252             : { "Dihedral", NULL,   1000,     3000, &consttabdihedral, 0, 0, 0 },
    2253             : };
    2254             : 
    2255             : static void
    2256         484 : cache_reset(long id) { caches[id].miss = caches[id].maxmiss = 0; }
    2257             : static void
    2258        9100 : cache_delete(long id) { guncloneNULL(caches[id].cache); }
    2259             : static void
    2260         498 : cache_set(long id, GEN S)
    2261             : {
    2262         498 :   GEN old = caches[id].cache;
    2263         498 :   caches[id].cache = gclone(S);
    2264         498 :   guncloneNULL(old);
    2265         498 : }
    2266             : 
    2267             : /* handle a cache miss: store stats, possibly reset table; return value
    2268             :  * if (now) cached; return NULL on failure. HACK: some caches contain an
    2269             :  * ulong where the 0 value is impossible, and return it (typecast to GEN) */
    2270             : static GEN
    2271   448444669 : cache_get(long id, ulong D)
    2272             : {
    2273   448444669 :   cache *S = &caches[id];
    2274   448444669 :   const ulong d = S->compressed? D>>1: D;
    2275             :   ulong max, l;
    2276             : 
    2277   448444669 :   if (!S->cache)
    2278             :   {
    2279         366 :     max = maxuu(minuu(D, S->maxself), S->minself);
    2280         366 :     S->init(max);
    2281         366 :     l = lg(S->cache);
    2282             :   }
    2283             :   else
    2284             :   {
    2285   448444303 :     l = lg(S->cache);
    2286   448444303 :     if (l <= d)
    2287             :     {
    2288         349 :       if (D > S->maxmiss) S->maxmiss = D;
    2289         349 :       if (DEBUGLEVEL >= 3)
    2290           0 :         err_printf("miss in cache %s: %lu, max = %lu\n",
    2291             :                    S->name, D, S->maxmiss);
    2292         349 :       if (S->miss++ >= 5 && D < S->maxself)
    2293             :       {
    2294          15 :         max = minuu(S->maxself, (long)(S->maxmiss * 1.2));
    2295          15 :         if (max <= S->maxself)
    2296             :         {
    2297          15 :           if (DEBUGLEVEL >= 3)
    2298           0 :             err_printf("resetting cache %s to %lu\n", S->name, max);
    2299          15 :           S->init(max); l = lg(S->cache);
    2300             :         }
    2301             :       }
    2302             :     }
    2303             :   }
    2304   448444669 :   return (l <= d)? NULL: gel(S->cache, d);
    2305             : }
    2306             : static GEN
    2307          70 : cache_report(long id)
    2308             : {
    2309          70 :   cache *S = &caches[id];
    2310          70 :   GEN v = zerocol(5);
    2311          70 :   gel(v,1) = strtoGENstr(S->name);
    2312          70 :   if (S->cache)
    2313             :   {
    2314          35 :     gel(v,2) = utoi(lg(S->cache)-1);
    2315          35 :     gel(v,3) = utoi(S->miss);
    2316          35 :     gel(v,4) = utoi(S->maxmiss);
    2317          35 :     gel(v,5) = utoi(gsizebyte(S->cache));
    2318             :   }
    2319          70 :   return v;
    2320             : }
    2321             : GEN
    2322          14 : getcache(void)
    2323             : {
    2324          14 :   pari_sp av = avma;
    2325          14 :   GEN M = cgetg(6, t_MAT);
    2326          14 :   gel(M,1) = cache_report(cache_FACT);
    2327          14 :   gel(M,2) = cache_report(cache_DIV);
    2328          14 :   gel(M,3) = cache_report(cache_H);
    2329          14 :   gel(M,4) = cache_report(cache_D);
    2330          14 :   gel(M,5) = cache_report(cache_DIH);
    2331          14 :   return gerepilecopy(av, shallowtrans(M));
    2332             : }
    2333             : 
    2334             : void
    2335        1820 : pari_close_mf(void)
    2336             : {
    2337        1820 :   cache_delete(cache_FACT);
    2338        1820 :   cache_delete(cache_DIV);
    2339        1820 :   cache_delete(cache_H);
    2340        1820 :   cache_delete(cache_D);
    2341        1820 :   cache_delete(cache_DIH);
    2342        1820 : }
    2343             : 
    2344             : /*************************************************************************/
    2345             : /* a odd, update local cache (recycle memory) */
    2346             : static GEN
    2347        2308 : update_factor_cache(long a, long lim, long *pb)
    2348             : {
    2349        2308 :   const long step = 16000; /* even; don't increase this: RAM cache thrashing */
    2350        2308 :   if (a + 2*step > lim)
    2351         201 :     *pb = lim; /* fuse last 2 chunks */
    2352             :   else
    2353        2107 :     *pb = a + step;
    2354        2308 :   return vecfactoroddu_i(a, *pb);
    2355             : }
    2356             : /* assume lim < MAX_LONG/8 */
    2357             : static void
    2358          55 : constcoredisc(long lim)
    2359             : {
    2360          55 :   pari_sp av2, av = avma;
    2361          55 :   GEN D = caches[cache_D].cache, CACHE = NULL;
    2362          55 :   long cachea, cacheb, N, LIM = !D ? 4 : lg(D)-1;
    2363          55 :   if (lim <= 0) lim = 5;
    2364          55 :   if (lim <= LIM) return;
    2365          55 :   cache_reset(cache_D);
    2366          55 :   D = zero_zv(lim);
    2367          36 :   av2 = avma;
    2368          36 :   cachea = cacheb = 0;
    2369     6428159 :   for (N = 1; N <= lim; N+=2)
    2370             :   { /* N odd */
    2371             :     long i, d, d2;
    2372             :     GEN F;
    2373     6428104 :     if (N > cacheb)
    2374             :     {
    2375         789 :       set_avma(av2); cachea = N;
    2376         789 :       CACHE = update_factor_cache(N, lim, &cacheb);
    2377             :     }
    2378     6428104 :     F = gel(CACHE, ((N-cachea)>>1)+1); /* factoru(N) */
    2379     6428104 :     D[N] = d = corediscs_fact(F); /* = 3 mod 4 or 4 mod 16 */
    2380     6428438 :     d2 = odd(d)? d<<3: d<<1;
    2381     6433875 :     for (i = 1;;)
    2382             :     {
    2383     8575176 :       if ((N << i) > lim) break;
    2384     4285556 :       D[N<<i] = d2; i++;
    2385     4285556 :       if ((N << i) > lim) break;
    2386     2141301 :       D[N<<i] = d; i++;
    2387             :     }
    2388             :   }
    2389          55 :   cache_set(cache_D, D);
    2390          55 :   set_avma(av);
    2391             : }
    2392             : 
    2393             : static void
    2394         166 : constfact(long lim)
    2395             : {
    2396             :   pari_sp av;
    2397         166 :   GEN VFACT = caches[cache_FACT].cache;
    2398         166 :   long LIM = VFACT? lg(VFACT)-1: 4;
    2399         166 :   if (lim <= 0) lim = 5;
    2400         166 :   if (lim <= LIM) return;
    2401         145 :   cache_reset(cache_FACT); av = avma;
    2402         145 :   cache_set(cache_FACT, vecfactoru_i(1,lim)); set_avma(av);
    2403             : }
    2404             : static void
    2405         138 : constdiv(long lim)
    2406             : {
    2407             :   pari_sp av;
    2408         138 :   GEN VFACT, VDIV = caches[cache_DIV].cache;
    2409         138 :   long N, LIM = VDIV? lg(VDIV)-1: 4;
    2410         138 :   if (lim <= 0) lim = 5;
    2411         138 :   if (lim <= LIM) return;
    2412         138 :   constfact(lim);
    2413         138 :   VFACT = caches[cache_FACT].cache;
    2414         138 :   cache_reset(cache_DIV); av = avma;
    2415         138 :   VDIV  = cgetg(lim+1, t_VEC);
    2416     6705174 :   for (N = 1; N <= lim; N++) gel(VDIV,N) = divisorsu_fact(gel(VFACT,N));
    2417         138 :   cache_set(cache_DIV, VDIV); set_avma(av);
    2418             : }
    2419             : 
    2420             : /* n > 1, D = divisors(n); sets L = 2*lambda(n), S = sigma(n) */
    2421             : static void
    2422    14071084 : lamsig(GEN D, long *pL, long *pS)
    2423             : {
    2424    14071084 :   pari_sp av = avma;
    2425    14071084 :   long i, l = lg(D), L = 1, S = D[l-1]+1;
    2426    50576794 :   for (i = 2; i < l; i++) /* skip d = 1 */
    2427             :   {
    2428    51093600 :     long d = D[i], nd = D[l-i]; /* nd = n/d */
    2429    51093600 :     if (d < nd) { L += d; S += d + nd; }
    2430             :     else
    2431             :     {
    2432    14587890 :       L <<= 1; if (d == nd) { L += d; S += d; }
    2433    14587890 :       break;
    2434             :     }
    2435             :   }
    2436    14071084 :   set_avma(av); *pL = L; *pS = S;
    2437    14709728 : }
    2438             : /* table of 6 * Hurwitz class numbers D <= lim */
    2439             : static void
    2440         146 : consttabh(long lim)
    2441             : {
    2442         146 :   pari_sp av = avma, av2;
    2443         146 :   GEN VHDH0, VDIV, CACHE = NULL;
    2444         146 :   GEN VHDH = caches[cache_H].cache;
    2445         146 :   long r, N, cachea, cacheb, lim0 = VHDH? lg(VHDH)-1: 2, LIM = lim0 << 1;
    2446             : 
    2447         146 :   if (lim <= 0) lim = 5;
    2448         146 :   if (lim <= LIM) return;
    2449         146 :   cache_reset(cache_H);
    2450         146 :   r = lim&3L; if (r) lim += 4-r;
    2451         146 :   cache_get(cache_DIV, lim);
    2452         146 :   VDIV = caches[cache_DIV].cache;
    2453         146 :   VHDH0 = cgetg(lim/2 + 1, t_VECSMALL);
    2454         146 :   VHDH0[1] = 2;
    2455         146 :   VHDH0[2] = 3;
    2456      701712 :   for (N = 3; N <= lim0; N++) VHDH0[N] = VHDH[N];
    2457         146 :   av2 = avma;
    2458         146 :   cachea = cacheb = 0;
    2459     7450779 :   for (N = LIM + 3; N <= lim; N += 4)
    2460             :   {
    2461     7470387 :     long s = 0, limt = usqrt(N>>2), flsq = 0, ind, t, L, S;
    2462             :     GEN DN, DN2;
    2463     7438539 :     if (N + 2 >= lg(VDIV))
    2464             :     { /* use local cache */
    2465             :       GEN F;
    2466     5747593 :       if (N + 2 > cacheb)
    2467             :       {
    2468        1519 :         set_avma(av2); cachea = N;
    2469        1519 :         CACHE = update_factor_cache(N, lim+2, &cacheb);
    2470             :       }
    2471     5747593 :       F = gel(CACHE, ((N-cachea)>>1)+1); /* factoru(N) */
    2472     5747593 :       DN = divisorsu_fact(F);
    2473     5989404 :       F = gel(CACHE, ((N-cachea)>>1)+2); /* factoru(N+2) */
    2474     5989404 :       DN2 = divisorsu_fact(F);
    2475             :     }
    2476             :     else
    2477             :     { /* use global cache */
    2478     1690946 :       DN = gel(VDIV,N);
    2479     1690946 :       DN2 = gel(VDIV,N+2);
    2480             :     }
    2481     7634158 :     ind = N >> 1;
    2482   945806862 :     for (t = 1; t <= limt; t++)
    2483             :     {
    2484   938172704 :       ind -= (t<<2)-2; /* N/2 - 2t^2 */
    2485   938172704 :       if (ind) s += VHDH0[ind]; else flsq = 1;
    2486             :     }
    2487     7634158 :     lamsig(DN, &L,&S);
    2488     7414751 :     VHDH0[N >> 1] = 2*S - 3*L - 2*s + flsq;
    2489     7414751 :     s = 0; flsq = 0; limt = (usqrt(N+2) - 1) >> 1;
    2490     7484881 :     ind = (N+1) >> 1;
    2491   947128584 :     for (t = 1; t <= limt; t++)
    2492             :     {
    2493   939643703 :       ind -= t<<2; /* (N+1)/2 - 2t(t+1) */
    2494   939643703 :       if (ind) s += VHDH0[ind]; else flsq = 1;
    2495             :     }
    2496     7484881 :     lamsig(DN2, &L,&S);
    2497     7450633 :     VHDH0[(N+1) >> 1] = S - 3*(L >> 1) - s - flsq;
    2498             :   }
    2499          83 :   cache_set(cache_H, VHDH0); set_avma(av);
    2500             : }
    2501             : 
    2502             : /*************************************************************************/
    2503             : /* Core functions using factorizations, divisors of class numbers caches */
    2504             : /* TODO: myfactoru and factorization cache should be exported */
    2505             : static GEN
    2506    33625277 : myfactoru(long N)
    2507             : {
    2508    33625277 :   GEN z = cache_get(cache_FACT, N);
    2509    33625277 :   return z? gcopy(z): factoru(N);
    2510             : }
    2511             : static GEN
    2512    68966612 : mydivisorsu(long N)
    2513             : {
    2514    68966612 :   GEN z = cache_get(cache_DIV, N);
    2515    68966612 :   return z? leafcopy(z): divisorsu(N);
    2516             : }
    2517             : /* write -n = Df^2, D < 0 fundamental discriminant. Return D, set f. */
    2518             : static long
    2519   176418424 : mycoredisc2neg(ulong n, long *pf)
    2520             : {
    2521   176418424 :   ulong m, D = (ulong)cache_get(cache_D, n);
    2522   176418424 :   if (D) { *pf = usqrt(n/D); return -(long)D; }
    2523          56 :   m = mycore(n, pf);
    2524          56 :   if ((m&3) != 3) { m <<= 2; *pf >>= 1; }
    2525          56 :   return (long)-m;
    2526             : }
    2527             : /* write n = Df^2, D > 0 fundamental discriminant. Return D, set f. */
    2528             : static long
    2529          14 : mycoredisc2pos(ulong n, long *pf)
    2530             : {
    2531          14 :   ulong m = mycore(n, pf);
    2532          14 :   if ((m&3) != 1) { m <<= 2; *pf >>= 1; }
    2533          14 :   return (long)m;
    2534             : }
    2535             : 
    2536             : /* D < 0 fundamental. Return 6*hclassno(-D); faster than quadclassunit up
    2537             :  * to 5*10^5 or so */
    2538             : static ulong
    2539          57 : hclassno6_count(long D)
    2540             : {
    2541          57 :   ulong a, b, b2, h = 0, d = -D;
    2542          57 :   int f = 0;
    2543             : 
    2544          57 :   if (d > 500000) return 6 * quadclassnos(D);
    2545             :   /* this part would work with -d non fundamental */
    2546          50 :   b = d&1; b2 = (1+d)>>2;
    2547          50 :   if (!b)
    2548             :   {
    2549         888 :     for (a=1; a*a<b2; a++)
    2550         885 :       if (b2%a == 0) h++;
    2551           3 :     f = (a*a==b2); b=2; b2=(4+d)>>2;
    2552             :   }
    2553        9848 :   while (b2*3 < d)
    2554             :   {
    2555        9798 :     if (b2%b == 0) h++;
    2556     1594640 :     for (a=b+1; a*a < b2; a++)
    2557     1584842 :       if (b2%a == 0) h += 2;
    2558        9798 :     if (a*a == b2) h++;
    2559        9798 :     b += 2; b2 = (b*b+d)>>2;
    2560             :   }
    2561          50 :   if (b2*3 == d) return 6*h+2;
    2562          50 :   if (f) return 6*h+3;
    2563          50 :   return 6*h;
    2564             : }
    2565             : /* D0 < 0; 6 * hclassno(-D), using D = D0*F^2 */
    2566             : static long
    2567          81 : hclassno6u_2(long D0, long F)
    2568             : {
    2569             :   long h;
    2570          81 :   if (F == 1) h = hclassno6_count(D0);
    2571             :   else
    2572             :   { /* second chance */
    2573          24 :     h = (ulong)cache_get(cache_H, -D0);
    2574          24 :     if (!h) h = hclassno6_count(D0);
    2575          24 :     h *= uhclassnoF_fact(myfactoru(F), D0);
    2576             :   }
    2577          81 :   return h;
    2578             : }
    2579             : /* D > 0; 6 * hclassno(D) (6*Hurwitz). Beware, cached value for D (=0,3 mod 4)
    2580             :  * is stored at D>>1 */
    2581             : ulong
    2582     2371949 : hclassno6u(ulong D)
    2583             : {
    2584     2371949 :   ulong z = (ulong)cache_get(cache_H, D);
    2585             :   long D0, F;
    2586     2371949 :   if (z) return z;
    2587          81 :   D0 = mycoredisc2neg(D, &F);
    2588          81 :   return hclassno6u_2(D0,F);
    2589             : }
    2590             : /* same as hclassno6u without creating caches */
    2591             : ulong
    2592       86913 : hclassno6u_no_cache(ulong D)
    2593             : {
    2594       86913 :   cache *S = &caches[cache_H];
    2595             :   long D0, F;
    2596       86913 :   if (S->cache)
    2597             :   {
    2598       79903 :     const ulong d = D>>1; /* compressed */
    2599       79903 :     if ((ulong)lg(S->cache) > d) return S->cache[d];
    2600             :   }
    2601       86643 :   S = &caches[cache_D];
    2602       86643 :   if (!S->cache || (ulong)lg(S->cache) <= D) return 0;
    2603           0 :   D0 = mycoredisc2neg(D, &F);
    2604           0 :   return hclassno6u_2(D0,F);
    2605             : }
    2606             : /* same, where the decomposition D = D0*F^2 is already known */
    2607             : static ulong
    2608   156422153 : hclassno6u_i(ulong D, long D0, long F)
    2609             : {
    2610   156422153 :   ulong z = (ulong)cache_get(cache_H, D);
    2611   156422153 :   if (z) return z;
    2612           0 :   return hclassno6u_2(D0,F);
    2613             : }
    2614             : 
    2615             : /* D < -4 fundamental, h(D), ordinary class number */
    2616             : static long
    2617    10627729 : myh(long D)
    2618             : {
    2619    10627729 :   ulong z = (ulong)cache_get(cache_H, -D);
    2620    10627729 :   return z? z / 6: quadclassnos(D);
    2621             : }
    2622             : 
    2623             : /*************************************************************************/
    2624             : /*                          TRACE FORMULAS                               */
    2625             : /* CHIP primitive, initialize for t_POLMOD output */
    2626             : static GEN
    2627       32557 : mfcharinit(GEN CHIP)
    2628             : {
    2629       32557 :   long n, o, l, vt, N = mfcharmodulus(CHIP);
    2630             :   GEN c, v, V, G, Pn;
    2631       32557 :   if (N == 1) return mkvec2(mkvec(gen_1), pol_x(0));
    2632        5460 :   G = gel(CHIP,1);
    2633        5460 :   v = ncharvecexpo(G, znconrey_normalized(G, gel(CHIP,2)));
    2634        5460 :   l = lg(v); V = cgetg(l, t_VEC);
    2635        5460 :   o = mfcharorder(CHIP);
    2636        5460 :   Pn = mfcharpol(CHIP); vt = varn(Pn);
    2637        5460 :   if (o <= 2)
    2638             :   {
    2639       59143 :     for (n = 1; n < l; n++)
    2640             :     {
    2641       54635 :       if (v[n] < 0) c = gen_0; else c = v[n]? gen_m1: gen_1;
    2642       54635 :       gel(V,n) = c;
    2643             :     }
    2644             :   }
    2645             :   else
    2646             :   {
    2647       16835 :     for (n = 1; n < l; n++)
    2648             :     {
    2649       15883 :       if (v[n] < 0) c = gen_0;
    2650             :       else
    2651             :       {
    2652        8890 :         c = Qab_zeta(v[n], o, vt);
    2653        8890 :         if (typ(c) == t_POL && lg(c) >= lg(Pn)) c = RgX_rem(c, Pn);
    2654             :       }
    2655       15883 :       gel(V,n) = c;
    2656             :     }
    2657             :   }
    2658        5460 :   return mkvec2(V, Pn);
    2659             : }
    2660             : static GEN
    2661      410711 : vchip_lift(GEN VCHI, long x, GEN C)
    2662             : {
    2663      410711 :   GEN V = gel(VCHI,1);
    2664      410711 :   long F = lg(V)-1;
    2665      410711 :   if (F == 1) return C;
    2666       18368 :   x %= F;
    2667       18368 :   if (!x) return C;
    2668       18368 :   if (x <= 0) x += F;
    2669       18368 :   return gmul(C, gel(V, x));
    2670             : }
    2671             : static long
    2672   279391751 : vchip_FC(GEN VCHI) { return lg(gel(VCHI,1))-1; }
    2673             : static GEN
    2674     6437432 : vchip_mod(GEN VCHI, GEN S)
    2675     6437432 : { return (typ(S) == t_POL)? RgX_rem(S, gel(VCHI,2)): S; }
    2676             : static GEN
    2677     1911620 : vchip_polmod(GEN VCHI, GEN S)
    2678     1911620 : { return (typ(S) == t_POL)? mkpolmod(S, gel(VCHI,2)): S; }
    2679             : 
    2680             : /* contribution of scalar matrices in dimension formula */
    2681             : static GEN
    2682      358519 : A1(long N, long k) { return uutoQ(mypsiu(N)*(k-1), 12); }
    2683             : static long
    2684        7588 : ceilA1(long N, long k) { return ceildivuu(mypsiu(N) * (k-1), 12); }
    2685             : 
    2686             : /* sturm bound, slightly larger than dimension */
    2687             : long
    2688       21665 : mfsturmNk(long N, long k) { return (mypsiu(N) * k) / 12; }
    2689             : long
    2690        3248 : mfsturmNgk(long N, GEN k)
    2691             : {
    2692        3248 :   long n,d; Qtoss(k,&n,&d);
    2693        3248 :   return 1 + (mypsiu(N)*n)/(d == 1? 12: 24);
    2694             : }
    2695             : static long
    2696         427 : mfsturmmf(GEN F) { return mfsturmNgk(mf_get_N(F), mf_get_gk(F)); }
    2697             : 
    2698             : /* List of all solutions of x^2 + x + 1 = 0 modulo N, x modulo N */
    2699             : static GEN
    2700         539 : sqrtm3modN(long N)
    2701             : {
    2702             :   pari_sp av;
    2703             :   GEN fa, P, E, B, mB, A, Q, T, R, v, gen_m3;
    2704         539 :   long l, i, n, ct, fl3 = 0, Ninit;
    2705         539 :   if (!odd(N) || (N%9) == 0) return cgetg(1,t_VECSMALL);
    2706         511 :   Ninit = N;
    2707         511 :   if ((N%3) == 0) { N /= 3; fl3 = 1; }
    2708         511 :   fa = myfactoru(N); P = gel(fa, 1); E = gel(fa, 2);
    2709         511 :   l = lg(P);
    2710         707 :   for (i = 1; i < l; i++)
    2711         518 :     if ((P[i]%3) == 2) return cgetg(1,t_VECSMALL);
    2712         189 :   A = cgetg(l, t_VECSMALL);
    2713         189 :   B = cgetg(l, t_VECSMALL);
    2714         189 :   mB= cgetg(l, t_VECSMALL);
    2715         189 :   Q = cgetg(l, t_VECSMALL); gen_m3 = utoineg(3);
    2716         385 :   for (i = 1; i < l; i++)
    2717             :   {
    2718         196 :     long p = P[i], e = E[i];
    2719         196 :     Q[i] = upowuu(p,e);
    2720         196 :     B[i] = itou( Zp_sqrt(gen_m3, utoipos(p), e) );
    2721         196 :     mB[i]= Q[i] - B[i];
    2722             :   }
    2723         189 :   ct = 1 << (l-1);
    2724         189 :   T = ZV_producttree(Q);
    2725         189 :   R = ZV_chinesetree(Q,T);
    2726         189 :   v = cgetg(ct+1, t_VECSMALL);
    2727         189 :   av = avma;
    2728         581 :   for (n = 1; n <= ct; n++)
    2729             :   {
    2730         392 :     long m = n-1, r;
    2731         812 :     for (i = 1; i < l; i++)
    2732             :     {
    2733         420 :       A[i] = (m&1L)? mB[i]: B[i];
    2734         420 :       m >>= 1;
    2735             :     }
    2736         392 :     r = itou( ZV_chinese_tree(A, Q, T, R) );
    2737         462 :     if (fl3) while (r%3) r += N;
    2738         392 :     set_avma(av); v[n] = odd(r) ? (r-1) >> 1 : (r+Ninit-1) >> 1;
    2739             :   }
    2740         189 :   return v;
    2741             : }
    2742             : 
    2743             : /* number of elliptic points of order 3 in X0(N) */
    2744             : static long
    2745       10157 : nu3(long N)
    2746             : {
    2747             :   long i, l;
    2748             :   GEN P;
    2749       10157 :   if (!odd(N) || (N%9) == 0) return 0;
    2750        8953 :   if ((N%3) == 0) N /= 3;
    2751        8953 :   P = gel(myfactoru(N), 1); l = lg(P);
    2752       13118 :   for (i = 1; i < l; i++) if ((P[i]%3) == 2) return 0;
    2753        3983 :   return 1L<<(l-1);
    2754             : }
    2755             : /* number of elliptic points of order 2 in X0(N) */
    2756             : static long
    2757       17521 : nu2(long N)
    2758             : {
    2759             :   long i, l;
    2760             :   GEN P;
    2761       17521 :   if ((N&3L) == 0) return 0;
    2762       17521 :   if (!odd(N)) N >>= 1;
    2763       17521 :   P = gel(myfactoru(N), 1); l = lg(P);
    2764       21924 :   for (i = 1; i < l; i++) if ((P[i]&3L) == 3) return 0;
    2765        3941 :   return 1L<<(l-1);
    2766             : }
    2767             : 
    2768             : /* contribution of elliptic matrices of order 3 in dimension formula
    2769             :  * Only depends on CHIP the primitive char attached to CHI */
    2770             : static GEN
    2771       43638 : A21(long N, long k, GEN CHI)
    2772             : {
    2773             :   GEN res, G, chi, o;
    2774             :   long a21, i, limx, S;
    2775       43638 :   if ((N&1L) == 0) return gen_0;
    2776       21077 :   a21 = k%3 - 1;
    2777       21077 :   if (!a21) return gen_0;
    2778       20328 :   if (N <= 3) return sstoQ(a21, 3);
    2779       10696 :   if (!CHI) return sstoQ(nu3(N) * a21, 3);
    2780         539 :   res = sqrtm3modN(N); limx = (N - 1) >> 1;
    2781         539 :   G = gel(CHI,1); chi = gel(CHI,2);
    2782         539 :   o = gmfcharorder(CHI);
    2783         931 :   for (S = 0, i = 1; i < lg(res); i++)
    2784             :   { /* (x,N) = 1; S += chi(x) + chi(x^2) */
    2785         392 :     long x = res[i];
    2786         392 :     if (x <= limx)
    2787             :     { /* CHI(x)=e(c/o), 3rd-root of 1 */
    2788         196 :       GEN c = znchareval(G, chi, utoi(x), o);
    2789         196 :       if (!signe(c)) S += 2; else S--;
    2790             :     }
    2791             :   }
    2792         539 :   return sstoQ(a21 * S, 3);
    2793             : }
    2794             : 
    2795             : /* List of all square roots of -1 modulo N */
    2796             : static GEN
    2797         595 : sqrtm1modN(long N)
    2798             : {
    2799             :   pari_sp av;
    2800             :   GEN fa, P, E, B, mB, A, Q, T, R, v;
    2801         595 :   long l, i, n, ct, fleven = 0;
    2802         595 :   if ((N&3L) == 0) return cgetg(1,t_VECSMALL);
    2803         595 :   if ((N&1L) == 0) { N >>= 1; fleven = 1; }
    2804         595 :   fa = myfactoru(N); P = gel(fa,1); E = gel(fa,2);
    2805         595 :   l = lg(P);
    2806         945 :   for (i = 1; i < l; i++)
    2807         665 :     if ((P[i]&3L) == 3) return cgetg(1,t_VECSMALL);
    2808         280 :   A = cgetg(l, t_VECSMALL);
    2809         280 :   B = cgetg(l, t_VECSMALL);
    2810         280 :   mB= cgetg(l, t_VECSMALL);
    2811         280 :   Q = cgetg(l, t_VECSMALL);
    2812         574 :   for (i = 1; i < l; i++)
    2813             :   {
    2814         294 :     long p = P[i], e = E[i];
    2815         294 :     Q[i] = upowuu(p,e);
    2816         294 :     B[i] = itou( Zp_sqrt(gen_m1, utoipos(p), e) );
    2817         294 :     mB[i]= Q[i] - B[i];
    2818             :   }
    2819         280 :   ct = 1 << (l-1);
    2820         280 :   T = ZV_producttree(Q);
    2821         280 :   R = ZV_chinesetree(Q,T);
    2822         280 :   v = cgetg(ct+1, t_VECSMALL);
    2823         280 :   av = avma;
    2824         868 :   for (n = 1; n <= ct; n++)
    2825             :   {
    2826         588 :     long m = n-1, r;
    2827        1232 :     for (i = 1; i < l; i++)
    2828             :     {
    2829         644 :       A[i] = (m&1L)? mB[i]: B[i];
    2830         644 :       m >>= 1;
    2831             :     }
    2832         588 :     r = itou( ZV_chinese_tree(A, Q, T, R) );
    2833         588 :     if (fleven && !odd(r)) r += N;
    2834         588 :     set_avma(av); v[n] = r;
    2835             :   }
    2836         280 :   return v;
    2837             : }
    2838             : 
    2839             : /* contribution of elliptic matrices of order 4 in dimension formula.
    2840             :  * Only depends on CHIP the primitive char attached to CHI */
    2841             : static GEN
    2842       43638 : A22(long N, long k, GEN CHI)
    2843             : {
    2844             :   GEN G, chi, o, res;
    2845             :   long S, a22, i, limx, o2;
    2846       43638 :   if ((N&3L) == 0) return gen_0;
    2847       30058 :   a22 = (k & 3L) - 1; /* (k % 4) - 1 */
    2848       30058 :   if (!a22) return gen_0;
    2849       30058 :   if (N <= 2) return sstoQ(a22, 4);
    2850       18326 :   if (!CHI) return sstoQ(nu2(N)*a22, 4);
    2851         805 :   if (mfcharparity(CHI) == -1) return gen_0;
    2852         595 :   res = sqrtm1modN(N); limx = (N - 1) >> 1;
    2853         595 :   G = gel(CHI,1); chi = gel(CHI,2);
    2854         595 :   o = gmfcharorder(CHI);
    2855         595 :   o2 = itou(o)>>1;
    2856        1183 :   for (S = 0, i = 1; i < lg(res); i++)
    2857             :   { /* (x,N) = 1, S += real(chi(x)) */
    2858         588 :     long x = res[i];
    2859         588 :     if (x <= limx)
    2860             :     { /* CHI(x)=e(c/o), 4th-root of 1 */
    2861         294 :       long c = itou( znchareval(G, chi, utoi(x), o) );
    2862         294 :       if (!c) S++; else if (c == o2) S--;
    2863             :     }
    2864             :   }
    2865         595 :   return sstoQ(a22 * S, 2);
    2866             : }
    2867             : 
    2868             : /* sumdiv(N,d,eulerphi(gcd(d,N/d))) */
    2869             : static long
    2870       38864 : nuinf(long N)
    2871             : {
    2872       38864 :   GEN fa = myfactoru(N), P = gel(fa,1), E = gel(fa,2);
    2873       38864 :   long i, t = 1, l = lg(P);
    2874       82600 :   for (i=1; i<l; i++)
    2875             :   {
    2876       43736 :     long p = P[i], e = E[i];
    2877       43736 :     if (odd(e))
    2878       34951 :       t *= upowuu(p,e>>1) << 1;
    2879             :     else
    2880        8785 :       t *= upowuu(p,(e>>1)-1) * (p+1);
    2881             :   }
    2882       38864 :   return t;
    2883             : }
    2884             : 
    2885             : /* contribution of hyperbolic matrices in dimension formula */
    2886             : static GEN
    2887       44086 : A3(long N, long FC)
    2888             : {
    2889             :   long i, S, NF, l;
    2890             :   GEN D;
    2891       44086 :   if (FC == 1) return uutoQ(nuinf(N),2);
    2892        5222 :   D = mydivisorsu(N); l = lg(D);
    2893        5222 :   S = 0; NF = N/FC;
    2894       41209 :   for (i = 1; i < l; i++)
    2895             :   {
    2896       35987 :     long g = ugcd(D[i], D[l-i]);
    2897       35987 :     if (NF%g == 0) S += myeulerphiu(g);
    2898             :   }
    2899        5222 :   return uutoQ(S, 2);
    2900             : }
    2901             : 
    2902             : /* special contribution in weight 2 in dimension formula */
    2903             : static long
    2904       43204 : A4(long k, long FC)
    2905       43204 : { return (k==2 && FC==1)? 1: 0; }
    2906             : /* gcd(x,N) */
    2907             : static long
    2908   283117583 : myugcd(GEN GCD, ulong x)
    2909             : {
    2910   283117583 :   ulong N = lg(GCD)-1;
    2911   283117583 :   if (x >= N) x %= N;
    2912   283117583 :   return GCD[x+1];
    2913             : }
    2914             : /* 1_{gcd(x,N) = 1} * chi(x), return NULL if 0 */
    2915             : static GEN
    2916   402266903 : mychicgcd(GEN GCD, GEN VCHI, long x)
    2917             : {
    2918   402266903 :   long N = lg(GCD)-1;
    2919   402266903 :   if (N == 1) return gen_1;
    2920   327829472 :   x = umodsu(x, N);
    2921   327829472 :   if (GCD[x+1] != 1) return NULL;
    2922   271744758 :   x %= vchip_FC(VCHI); if (!x) return gen_1;
    2923     4468548 :   return gel(gel(VCHI,1), x);
    2924             : }
    2925             : 
    2926             : /* contribution of scalar matrices to trace formula */
    2927             : static GEN
    2928     6385475 : TA1(long N, long k, GEN VCHI, GEN GCD, long n)
    2929             : {
    2930             :   GEN S;
    2931             :   ulong m;
    2932     6385475 :   if (!uissquareall(n, &m)) return gen_0;
    2933      385091 :   if (m == 1) return A1(N,k); /* common */
    2934      345478 :   S = mychicgcd(GCD, VCHI, m);
    2935      345478 :   return S? gmul(gmul(powuu(m, k-2), A1(N,k)), S): gen_0;
    2936             : }
    2937             : 
    2938             : /* All square roots modulo 4N, x modulo 2N, precomputed to accelerate TA2 */
    2939             : static GEN
    2940      126791 : mksqr(long N)
    2941             : {
    2942      126791 :   pari_sp av = avma;
    2943      126791 :   long x, N2 = N << 1, N4 = N << 2;
    2944      126791 :   GEN v = const_vec(N2, cgetg(1, t_VECSMALL));
    2945      126791 :   gel(v, N2) = mkvecsmall(0); /* x = 0 */
    2946     3485545 :   for (x = 1; x <= N; x++)
    2947             :   {
    2948     3358754 :     long r = (((x*x - 1)%N4) >> 1) + 1;
    2949     3358754 :     gel(v,r) = vecsmall_append(gel(v,r), x);
    2950             :   }
    2951      126791 :   return gerepilecopy(av, v);
    2952             : }
    2953             : 
    2954             : static GEN
    2955      126791 : mkgcd(long N)
    2956             : {
    2957             :   GEN GCD, d;
    2958             :   long i, N2;
    2959      126791 :   if (N == 1) return mkvecsmall(N);
    2960      104377 :   GCD = cgetg(N + 1, t_VECSMALL);
    2961      104377 :   d = GCD+1; /* GCD[i+1] = d[i] = gcd(i,N) = gcd(N-i,N), i = 0..N-1 */
    2962      104377 :   d[0] = N; d[1] = d[N-1] = 1; N2 = N>>1;
    2963     1647625 :   for (i = 2; i <= N2; i++) d[i] = d[N-i] = ugcd(N, i);
    2964      104377 :   return GCD;
    2965             : }
    2966             : 
    2967             : /* Table of \sum_{x^2-tx+n=0 mod Ng}chi(x) for all g dividing gcd(N,F),
    2968             :  * F^2 largest such that (t^2-4n)/F^2=0 or 1 mod 4; t >= 0 */
    2969             : static GEN
    2970    15192160 : mutglistall(long t, long N, long NF, GEN VCHI, long n, GEN MUP, GEN li, GEN GCD)
    2971             : {
    2972    15192160 :   long i, lx = lg(li);
    2973    15192160 :   GEN DNF = mydivisorsu(NF), v = zerovec(NF);
    2974    15192160 :   long j, g, lDNF = lg(DNF);
    2975    42388049 :   for (i = 1; i < lx; i++)
    2976             :   {
    2977    27195889 :     long x = (li[i] + t) >> 1, y, lD;
    2978    27195889 :     GEN D, c = mychicgcd(GCD, VCHI, x);
    2979    27195889 :     if (li[i] && li[i] != N)
    2980             :     {
    2981    18074097 :       GEN c2 = mychicgcd(GCD, VCHI, t - x);
    2982    18074097 :       if (c2) c = c? gadd(c, c2): c2;
    2983             :     }
    2984    27195889 :     if (!c) continue;
    2985    22055362 :     y = (x*(x - t) + n) / N; /* exact division */
    2986    22055362 :     D = mydivisorsu(ugcd(labs(y), NF)); lD = lg(D);
    2987    59429050 :     for (j=1; j < lD; j++) { g = D[j]; gel(v,g) = gadd(gel(v,g), c); }
    2988             :   }
    2989             :   /* j = 1 corresponds to g = 1, and MUP[1] = 1 */
    2990    35096493 :   for (j=2; j < lDNF; j++) { g = DNF[j]; gel(v,g) = gmulsg(MUP[g], gel(v,g)); }
    2991    15192160 :   return v;
    2992             : }
    2993             : 
    2994             : /* special case (N,F) = 1: easier */
    2995             : static GEN
    2996   161226169 : mutg1(long t, long N, GEN VCHI, GEN li, GEN GCD)
    2997             : { /* (N,F) = 1 */
    2998   161226169 :   GEN S = NULL;
    2999   161226169 :   long i, lx = lg(li);
    3000   338327141 :   for (i = 1; i < lx; i++)
    3001             :   {
    3002   177100972 :     long x = (li[i] + t) >> 1;
    3003   177100972 :     GEN c = mychicgcd(GCD, VCHI, x);
    3004   177100972 :     if (c) S = S? gadd(S, c): c;
    3005   177100972 :     if (li[i] && li[i] != N)
    3006             :     {
    3007    97946674 :       c = mychicgcd(GCD, VCHI, t - x);
    3008    97946674 :       if (c) S = S? gadd(S, c): c;
    3009             :     }
    3010   177100972 :     if (S && !signe(S)) S = NULL; /* strive hard to add gen_0 */
    3011             :   }
    3012   161226169 :   return S; /* single value */
    3013             : }
    3014             : 
    3015             : /* Gegenbauer pol; n > 2, P = \sum_{0<=j<=n/2} (-1)^j (n-j)!/j!(n-2*j)! X^j */
    3016             : GEN
    3017      361541 : mfrhopol(long n)
    3018             : {
    3019             : #ifdef LONG_IS_64BIT
    3020      309936 :   const long M = 2642249;
    3021             : #else
    3022       51605 :   const long M = 1629;
    3023             : #endif
    3024      361541 :   long j, d = n >> 1; /* >= 1 */
    3025      361541 :   GEN P = cgetg(d + 3, t_POL);
    3026             : 
    3027      361541 :   if (n > M) pari_err_IMPL("mfrhopol for large weight"); /* avoid overflow */
    3028      361541 :   P[1] = evalvarn(0)|evalsigne(1);
    3029      361541 :   gel(P,2) = gen_1;
    3030      361541 :   gel(P,3) = utoineg(n-1); /* j = 1 */
    3031      361541 :   if (d > 1) gel(P,4) = utoipos(((n-3)*(n-2)) >> 1); /* j = 2 */
    3032      361541 :   if (d > 2) gel(P,5) = utoineg(((n-5)*(n-4)*(n-3)) / 6); /* j = 3 */
    3033     1516390 :   for (j = 4; j <= d; j++)
    3034     1154849 :     gel(P,j+2) = divis(mulis(gel(P,j+1), (n-2*j+1)*(n-2*j+2)), (n-j+1)*(-j));
    3035      361541 :   return P;
    3036             : }
    3037             : 
    3038             : /* polrecip(Q)(t2), assume Q(0) = 1 */
    3039             : GEN
    3040     3251066 : mfrhopol_u_eval(GEN Q, ulong t2)
    3041             : {
    3042     3251066 :   GEN T = addiu(gel(Q,3), t2);
    3043     3251065 :   long l = lg(Q), j;
    3044    37887353 :   for (j = 4; j < l; j++) T = addii(gel(Q,j), mului(t2, T));
    3045     3251064 :   return T;
    3046             : }
    3047             : GEN
    3048       56619 : mfrhopol_eval(GEN Q, GEN t2)
    3049             : {
    3050             :   long l, j;
    3051             :   GEN T;
    3052       56619 :   if (lgefint(t2) == 3) return mfrhopol_u_eval(Q, t2[2]);
    3053           0 :   l = lg(Q); T = addii(gel(Q,3), t2);
    3054           0 :   for (j = 4; j < l; j++) T = addii(gel(Q,j), mulii(t2, T));
    3055           0 :   return T;
    3056             : }
    3057             : /* return sh * sqrt(n)^nu * G_nu(t/(2*sqrt(n))) for t != 0
    3058             :  * else (sh/2) * sqrt(n)^nu * G_nu(0) [ implies nu is even ]
    3059             :  * G_nu(z) = \sum_{0<=j<=nu/2} (-1)^j (nu-j)!/j!(nu-2*j)! * (2z)^(nu-2*j)) */
    3060             : static GEN
    3061   168009103 : mfrhopowsimp(GEN Q, GEN sh, long nu, long t, long t2, long n)
    3062             : {
    3063             :   GEN T;
    3064   168009103 :   switch (nu)
    3065             :   {
    3066   162066107 :     case 0: return t? sh: gmul2n(sh,-1);
    3067     1125222 :     case 1: return gmulsg(t, sh);
    3068     1576750 :     case 2: return t? gmulsg(t2 - n, sh): gmul(gmul2n(stoi(-n), -1), sh);
    3069         427 :     case 3: return gmul(mulss(t, t2 - 2*n), sh);
    3070     3240597 :     default:
    3071     3240597 :       if (!t) return gmul(gmul2n(gel(Q, lg(Q) - 1), -1), sh);
    3072     3194448 :       T = mfrhopol_u_eval(Q, t2); if (odd(nu)) T = mulsi(t, T);
    3073     3194448 :       return gmul(T, sh);
    3074             :   }
    3075             : }
    3076             : 
    3077             : /* contribution of elliptic matrices to trace formula */
    3078             : static GEN
    3079     6385475 : TA2(long N, long k, GEN VCHI, long n, GEN SQRTS, GEN MUP, GEN GCD)
    3080             : {
    3081     6385475 :   const long n4 = n << 2, N4 = N << 2, nu = k - 2;
    3082     6385475 :   const long st = (!odd(N) && odd(n)) ? 2 : 1;
    3083             :   long limt, t;
    3084             :   GEN S, Q;
    3085             : 
    3086     6385475 :   limt = usqrt(n4);
    3087     6385475 :   if (limt*limt == n4) limt--;
    3088     6385475 :   Q = nu > 3 ? ZX_z_unscale(mfrhopol(nu), n) : NULL;
    3089     6385475 :   S = gen_0;
    3090   325714519 :   for (t = odd(k)? st: 0; t <= limt; t += st) /* t^2 < 4n */
    3091             :   {
    3092   319329044 :     pari_sp av = avma;
    3093   319329044 :     long t2 = t*t, D = n4 - t2, F, D0, NF;
    3094             :     GEN sh, li;
    3095             : 
    3096   319329044 :     li = gel(SQRTS, (umodsu(-D - 1, N4) >> 1) + 1);
    3097   327738270 :     if (lg(li) == 1) continue;
    3098   176418329 :     D0 = mycoredisc2neg(D, &F);
    3099   176418329 :     NF = myugcd(GCD, F);
    3100   176418329 :     if (NF == 1)
    3101             :     { /* (N,F) = 1 => single value in mutglistall */
    3102   161226169 :       GEN mut = mutg1(t, N, VCHI, li, GCD);
    3103   161226169 :       if (!mut) { set_avma(av); continue; }
    3104   156422153 :       sh = gmul(uutoQ(hclassno6u_i(D,D0,F),6), mut);
    3105             :     }
    3106             :     else
    3107             :     {
    3108    15192160 :       GEN v = mutglistall(t, N, NF, VCHI, n, MUP, li, GCD);
    3109    15192160 :       GEN DF = mydivisorsu(F);
    3110    15192160 :       long i, lDF = lg(DF);
    3111    15192160 :       sh = gen_0;
    3112    61247852 :       for (i = 1; i < lDF; i++)
    3113             :       {
    3114    46055692 :         long Ff, f = DF[i], g = myugcd(GCD, f);
    3115    46055692 :         GEN mut = gel(v, g);
    3116    46055692 :         if (gequal0(mut)) continue;
    3117    31140557 :         Ff = DF[lDF-i]; /* F/f */
    3118    31140557 :         if (Ff == 1) sh = gadd(sh, mut);
    3119             :         else
    3120             :         {
    3121    22318249 :           GEN P = gel(myfactoru(Ff), 1);
    3122    22318249 :           long j, lP = lg(P);
    3123    49222605 :           for (j = 1; j < lP; j++) { long p = P[j]; Ff -= kross(D0, p)*Ff/p; }
    3124    22318249 :           sh = gadd(sh, gmulsg(Ff, mut));
    3125             :         }
    3126             :       }
    3127    15192160 :       if (gequal0(sh)) { set_avma(av); continue; }
    3128    11586950 :       if (D0 == -3) sh = gdivgu(sh, 3);
    3129    11097191 :       else if (D0 == -4) sh = gdivgu(sh, 2);
    3130    10627729 :       else sh = gmulgu(sh, myh(D0));
    3131             :     }
    3132   168009103 :     S = gerepileupto(av, gadd(S, mfrhopowsimp(Q,sh,nu,t,t2,n)));
    3133             :   }
    3134     6385475 :   return S;
    3135             : }
    3136             : 
    3137             : /* compute global auxiliary data for TA3 */
    3138             : static GEN
    3139      126791 : mkbez(long N, long FC)
    3140             : {
    3141      126791 :   long ct, i, NF = N/FC;
    3142      126791 :   GEN w, D = mydivisorsu(N);
    3143      126791 :   long l = lg(D);
    3144             : 
    3145      126791 :   w = cgetg(l, t_VEC);
    3146      367745 :   for (i = ct = 1; i < l; i++)
    3147             :   {
    3148      345331 :     long u, v, h, c = D[i], Nc = D[l-i];
    3149      345331 :     if (c > Nc) break;
    3150      240954 :     h = cbezout(c, Nc, &u, &v);
    3151      240954 :     if (h == 1) /* shortcut */
    3152      173852 :       gel(w, ct++) = mkvecsmall4(1,u*c,1,i);
    3153       67102 :     else if (!(NF%h))
    3154       57232 :       gel(w, ct++) = mkvecsmall4(h,u*(c/h),myeulerphiu(h),i);
    3155             :   }
    3156      126791 :   setlg(w,ct); stackdummy((pari_sp)(w+ct),(pari_sp)(w+l));
    3157      126791 :   return w;
    3158             : }
    3159             : 
    3160             : /* contribution of hyperbolic matrices to trace formula, d * nd = n,
    3161             :  * DN = divisorsu(N) */
    3162             : static GEN
    3163    33164921 : auxsum(GEN VCHI, GEN GCD, long d, long nd, GEN DN, GEN BEZ)
    3164             : {
    3165    33164921 :   GEN S = gen_0;
    3166    33164921 :   long ct, g = nd - d, lDN = lg(DN), lBEZ = lg(BEZ);
    3167    85165185 :   for (ct = 1; ct < lBEZ; ct++)
    3168             :   {
    3169    52000264 :     GEN y, B = gel(BEZ, ct);
    3170    52000264 :     long ic, c, Nc, uch, h = B[1];
    3171    52000264 :     if (g%h) continue;
    3172    50793212 :     uch = B[2];
    3173    50793212 :     ic  = B[4];
    3174    50793212 :     c = DN[ic];
    3175    50793212 :     Nc= DN[lDN - ic]; /* Nc = N/c */
    3176    50793212 :     if (ugcd(Nc, nd) == 1)
    3177    43359331 :       y = mychicgcd(GCD, VCHI, d + uch*g); /* 0 if (c,d) > 1 */
    3178             :     else
    3179     7433881 :       y = NULL;
    3180    50793212 :     if (c != Nc && ugcd(Nc, d) == 1)
    3181             :     {
    3182    38244462 :       GEN y2 = mychicgcd(GCD, VCHI, nd - uch*g); /* 0 if (c,nd) > 1 */
    3183    38244462 :       if (y2) y = y? gadd(y, y2): y2;
    3184             :     }
    3185    50793212 :     if (y) S = gadd(S, gmulsg(B[3], y));
    3186             :   }
    3187    33164921 :   return S;
    3188             : }
    3189             : 
    3190             : static GEN
    3191     6385475 : TA3(long N, long k, GEN VCHI, GEN GCD, GEN Dn, GEN BEZ)
    3192             : {
    3193     6385475 :   GEN S = gen_0, DN = mydivisorsu(N);
    3194     6385475 :   long i, l = lg(Dn);
    3195    39550396 :   for (i = 1; i < l; i++)
    3196             :   {
    3197    39510783 :     long d = Dn[i], nd = Dn[l-i]; /* = n/d */
    3198             :     GEN t, u;
    3199    39510783 :     if (d > nd) break;
    3200    33164921 :     t = auxsum(VCHI, GCD, d, nd, DN, BEZ);
    3201    33164921 :     if (isintzero(t)) continue;
    3202    32047245 :     u = powuu(d,k-1); if (d == nd) u = gmul2n(u,-1);
    3203    32047245 :     S = gadd(S, gmul(u,t));
    3204             :   }
    3205     6385475 :   return S;
    3206             : }
    3207             : 
    3208             : /* special contribution in weight 2 in trace formula */
    3209             : static long
    3210     6385475 : TA4(long k, GEN VCHIP, GEN Dn, GEN GCD)
    3211             : {
    3212             :   long i, l, S;
    3213     6385475 :   if (k != 2 || vchip_FC(VCHIP) != 1) return 0;
    3214     5682229 :   l = lg(Dn); S = 0;
    3215    66325791 :   for (i = 1; i < l; i++)
    3216             :   {
    3217    60643562 :     long d = Dn[i]; /* gcd(N,n/d) == 1? */
    3218    60643562 :     if (myugcd(GCD, Dn[l-i]) == 1) S += d;
    3219             :   }
    3220     5682229 :   return S;
    3221             : }
    3222             : 
    3223             : /* precomputation of products occurring im mutg, again to accelerate TA2 */
    3224             : static GEN
    3225      126791 : mkmup(long N)
    3226             : {
    3227      126791 :   GEN fa = myfactoru(N), P = gel(fa,1), D = divisorsu_fact(fa);
    3228      126791 :   long i, lP = lg(P), lD = lg(D);
    3229      126791 :   GEN MUP = zero_zv(N);
    3230      126791 :   MUP[1] = 1;
    3231      444416 :   for (i = 2; i < lD; i++)
    3232             :   {
    3233      317625 :     long j, g = D[i], Ng = D[lD-i]; /*  N/g */
    3234      869988 :     for (j = 1; j < lP; j++) { long p = P[j]; if (Ng%p) g += g/p; }
    3235      317625 :     MUP[D[i]] = g;
    3236             :   }
    3237      126791 :   return MUP;
    3238             : }
    3239             : 
    3240             : /* quadratic nonresidues mod p; p odd prime, p^2 fits in a long */
    3241             : static GEN
    3242        2702 : non_residues(long p)
    3243             : {
    3244        2702 :   long i, j, p2 = p >> 1;
    3245        2702 :   GEN v = cgetg(p2+1, t_VECSMALL), w = const_vecsmall(p-1, 1);
    3246        4459 :   for (i = 2; i <= p2; i++) w[(i*i) % p] = 0; /* no need to check 1 */
    3247        8918 :   for (i = 2, j = 1; i < p; i++) if (w[i]) v[j++] = i;
    3248        2702 :   return v;
    3249             : }
    3250             : 
    3251             : /* CHIP primitive. Return t_VECSMALL v of length q such that
    3252             :  * Tr^new_{N,CHIP}(n) = 0 whenever v[(n%q) + 1] is nonzero */
    3253             : static GEN
    3254       32655 : mfnewzerodata(long N, GEN CHIP)
    3255             : {
    3256       32655 :   GEN V, M, L, faN = myfactoru(N), PN = gel(faN,1), EN = gel(faN,2);
    3257       32655 :   GEN G = gel(CHIP,1), chi = gel(CHIP,2);
    3258       32655 :   GEN fa = znstar_get_faN(G), P = ZV_to_zv(gel(fa,1)), E = gel(fa,2);
    3259       32655 :   long i, mod, j = 1, l = lg(PN);
    3260             : 
    3261       32655 :   M = cgetg(l, t_VECSMALL); M[1] = 0;
    3262       32655 :   V = cgetg(l, t_VEC);
    3263             :   /* Tr^new(n) = 0 if (n mod M[i]) in V[i]  */
    3264       32655 :   if ((N & 3) == 0)
    3265             :   {
    3266       12908 :     long e = EN[1];
    3267       12908 :     long c = (lg(P) > 1 && P[1] == 2)? E[1]: 0; /* c = v_2(FC) */
    3268             :     /* e >= 2 */
    3269       12908 :     if (c == e-1) return NULL; /* Tr^new = 0 */
    3270       12803 :     if (c == e)
    3271             :     {
    3272        3696 :       if (e == 2)
    3273             :       { /* sc: -4 */
    3274        1764 :         gel(V,1) = mkvecsmall(3);
    3275        1764 :         M[1] = 4;
    3276             :       }
    3277        1932 :       else if (e == 3)
    3278             :       { /* sc: -8 (CHI_2(-1)=-1<=>chi[1]=1) and 8 (CHI_2(-1)=1 <=> chi[1]=0) */
    3279        1932 :         long t = signe(gel(chi,1))? 7: 3;
    3280        1932 :         gel(V,1) = mkvecsmall2(5, t);
    3281        1932 :         M[1] = 8;
    3282             :       }
    3283             :     }
    3284        9107 :     else if (e == 5 && c == 3)
    3285         154 :     { /* sc: -8 (CHI_2(-1)=-1<=>chi[1]=1) and 8 (CHI_2(-1)=1 <=> chi[1]=0) */
    3286         154 :       long t = signe(gel(chi,1))? 7: 3;
    3287         154 :       gel(V,1) = mkvecsmalln(6, 2L,4L,5L,6L,8L,t);
    3288         154 :       M[1] = 8;
    3289             :     }
    3290        8953 :     else if ((e == 4 && c == 2) || (e == 5 && c <= 2) || (e == 6 && c <= 2)
    3291        7378 :          || (e >= 7 && c == e - 3))
    3292             :     { /* sc: 4 */
    3293        1575 :       gel(V,1) = mkvecsmall3(0,2,3);
    3294        1575 :       M[1] = 4;
    3295             :     }
    3296        7378 :     else if ((e <= 4 && c == 0) || (e >= 5 && c == e - 2))
    3297             :     { /* sc: 2 */
    3298        7021 :       gel(V,1) = mkvecsmall(0);
    3299        7021 :       M[1] = 2;
    3300             :     }
    3301         357 :     else if ((e == 6 && c == 3) || (e >= 7 && c <= e - 4))
    3302             :     { /* sc: -2 */
    3303         357 :       gel(V,1) = mkvecsmalln(7, 0L,2L,3L,4L,5L,6L,7L);
    3304         357 :       M[1] = 8;
    3305             :     }
    3306             :   }
    3307       32550 :   j = M[1]? 2: 1;
    3308       69496 :   for (i = odd(N)? 1: 2; i < l; i++) /* skip p=2, done above */
    3309             :   {
    3310       36946 :     long p = PN[i], e = EN[i];
    3311       36946 :     long z = zv_search(P, p), c = z? E[z]: 0; /* c = v_p(FC) */
    3312       36946 :     if ((e <= 2 && c == 1 && itos(gel(chi,z)) == (p>>1)) /* ord(CHI_p)=2 */
    3313       34755 :         || (e >= 3 && c <= e - 2))
    3314        2702 :     { /* sc: -p */
    3315        2702 :       GEN v = non_residues(p);
    3316        2702 :       if (e != 1) v = vecsmall_prepend(v, 0);
    3317        2702 :       gel(V,j) = v;
    3318        2702 :       M[j] = p; j++;
    3319             :     }
    3320       34244 :     else if (e >= 2 && c < e)
    3321             :     { /* sc: p */
    3322        2590 :       gel(V,j) = mkvecsmall(0);
    3323        2590 :       M[j] = p; j++;
    3324             :     }
    3325             :   }
    3326       32550 :   if (j == 1) return cgetg(1, t_VECSMALL);
    3327       15176 :   setlg(V,j); setlg(M,j); mod = zv_prod(M);
    3328       15176 :   L = zero_zv(mod);
    3329       33271 :   for (i = 1; i < j; i++)
    3330             :   {
    3331       18095 :     GEN v = gel(V,i);
    3332       18095 :     long s, m = M[i], lv = lg(v);
    3333       47103 :     for (s = 1; s < lv; s++)
    3334             :     {
    3335       29008 :       long a = v[s] + 1;
    3336       56077 :       do { L[a] = 1; a += m; } while (a <= mod);
    3337             :     }
    3338             :   }
    3339       15176 :   return L;
    3340             : }
    3341             : /* v=mfnewzerodata(N,CHI); returns TRUE if newtrace(n) must be zero,
    3342             :  * (but newtrace(n) may still be zero if we return FALSE) */
    3343             : static long
    3344     2594331 : mfnewchkzero(GEN v, long n) { long q = lg(v)-1; return q && v[(n%q) + 1]; }
    3345             : 
    3346             : /* if (!VCHIP): from mftraceform_cusp;
    3347             :  * else from initnewtrace and CHI is known to be primitive */
    3348             : static GEN
    3349      126791 : inittrace(long N, GEN CHI, GEN VCHIP)
    3350             : {
    3351             :   long FC;
    3352      126791 :   if (VCHIP)
    3353      126784 :     FC = mfcharmodulus(CHI);
    3354             :   else
    3355           7 :     VCHIP = mfcharinit(mfchartoprimitive(CHI, &FC));
    3356      126791 :   return mkvecn(5, mksqr(N), mkmup(N), mkgcd(N), VCHIP, mkbez(N, FC));
    3357             : }
    3358             : 
    3359             : /* p > 2 prime; return a sorted t_VECSMALL of primes s.t Tr^new(p) = 0 for all
    3360             :  * weights > 2 */
    3361             : static GEN
    3362       32550 : inittrconj(long N, long FC)
    3363             : {
    3364             :   GEN fa, P, E, v;
    3365             :   long i, k, l;
    3366             : 
    3367       32550 :   if (FC != 1) return cgetg(1,t_VECSMALL);
    3368             : 
    3369       27090 :   fa = myfactoru(N >> vals(N));
    3370       27090 :   P = gel(fa,1); l = lg(P);
    3371       27090 :   E = gel(fa,2);
    3372       27090 :   v = cgetg(l, t_VECSMALL);
    3373       59094 :   for (i = k = 1; i < l; i++)
    3374             :   {
    3375       32004 :     long j, p = P[i]; /* > 2 */
    3376       77364 :     for (j = 1; j < l; j++)
    3377       45360 :       if (j != i && E[j] == 1 && kross(-p, P[j]) == 1) v[k++] = p;
    3378             :   }
    3379       27090 :   setlg(v,k); return v;
    3380             : }
    3381             : 
    3382             : /* assume CHIP primitive, f(CHIP) | N; NZ = mfnewzerodata(N,CHIP) */
    3383             : static GEN
    3384       32550 : initnewtrace_i(long N, GEN CHIP, GEN NZ)
    3385             : {
    3386       32550 :   GEN T = const_vec(N, cgetg(1,t_VEC)), D, VCHIP;
    3387       32550 :   long FC = mfcharmodulus(CHIP), N1, N2, i, l;
    3388             : 
    3389       32550 :   if (!NZ) NZ = mkvecsmall(1); /*Tr^new = 0; initialize data nevertheless*/
    3390       32550 :   VCHIP = mfcharinit(CHIP);
    3391       32550 :   N1 = N/FC; newd_params(N1, &N2);
    3392       32550 :   D = mydivisorsu(N1/N2); l = lg(D);
    3393       32550 :   N2 *= FC;
    3394      159334 :   for (i = 1; i < l; i++)
    3395             :   {
    3396      126784 :     long M = D[i]*N2;
    3397      126784 :     gel(T,M) = inittrace(M, CHIP, VCHIP);
    3398             :   }
    3399       32550 :   gel(T,N) = shallowconcat(gel(T,N), mkvec2(NZ, inittrconj(N,FC)));
    3400       32550 :   return T;
    3401             : }
    3402             : /* don't initialize if Tr^new = 0, return NULL */
    3403             : static GEN
    3404       32655 : initnewtrace(long N, GEN CHI)
    3405             : {
    3406       32655 :   GEN CHIP = mfchartoprimitive(CHI, NULL), NZ = mfnewzerodata(N,CHIP);
    3407       32655 :   return NZ? initnewtrace_i(N, CHIP, NZ): NULL;
    3408             : }
    3409             : 
    3410             : /* (-1)^k */
    3411             : static long
    3412        8141 : m1pk(long k) { return odd(k)? -1 : 1; }
    3413             : static long
    3414        7784 : badchar(long N, long k, GEN CHI)
    3415        7784 : { return mfcharparity(CHI) != m1pk(k) || (CHI && N % mfcharconductor(CHI)); }
    3416             : 
    3417             : 
    3418             : static long
    3419       43281 : mfcuspdim_i(long N, long k, GEN CHI, GEN vSP)
    3420             : {
    3421       43281 :   pari_sp av = avma;
    3422             :   long FC;
    3423             :   GEN s;
    3424       43281 :   if (k <= 0) return 0;
    3425       43281 :   if (k == 1) return CHI? mf1cuspdim(N, CHI, vSP): 0;
    3426       43022 :   FC = CHI? mfcharconductor(CHI): 1;
    3427       43022 :   if (FC == 1) CHI = NULL;
    3428       43022 :   s = gsub(A1(N, k), gadd(A21(N, k, CHI), A22(N, k, CHI)));
    3429       43022 :   s = gadd(s, gsubsg(A4(k, FC), A3(N, FC)));
    3430       43022 :   return gc_long(av, itos(s));
    3431             : }
    3432             : /* dimension of space of cusp forms S_k(\G_0(N),CHI)
    3433             :  * Only depends on CHIP the primitive char attached to CHI */
    3434             : long
    3435        3374 : mfcuspdim(long N, long k, GEN CHI) { return mfcuspdim_i(N, k, CHI, NULL); }
    3436             : 
    3437             : /* dimension of whole space M_k(\G_0(N),CHI)
    3438             :  * Only depends on CHIP the primitive char attached to CHI; assumes !badchar */
    3439             : long
    3440         833 : mffulldim(long N, long k, GEN CHI)
    3441             : {
    3442         833 :   pari_sp av = avma;
    3443         833 :   long FC = CHI? mfcharconductor(CHI): 1;
    3444             :   GEN s;
    3445         833 :   if (k <= 0) return (k == 0 && FC == 1)? 1: 0;
    3446         833 :   if (k == 1) return gc_long(av, itos(A3(N, FC)) + mf1cuspdim(N, CHI, NULL));
    3447         616 :   if (FC == 1) CHI = NULL;
    3448         616 :   s = gsub(A1(N, k), gadd(A21(N, k, CHI), A22(N, k, CHI)));
    3449         616 :   s = gadd(s, A3(N, FC));
    3450         616 :   return gc_long(av, itos(s));
    3451             : }
    3452             : 
    3453             : /* Dimension of the space of Eisenstein series */
    3454             : long
    3455         231 : mfeisensteindim(long N, long k, GEN CHI)
    3456             : {
    3457         231 :   pari_sp av = avma;
    3458         231 :   long s, FC = CHI? mfcharconductor(CHI): 1;
    3459         231 :   if (k <= 0) return (k == 0 && FC == 1)? 1: 0;
    3460         231 :   s = itos(gmul2n(A3(N, FC), 1));
    3461         231 :   if (k > 1) s -= A4(k, FC); else s >>= 1;
    3462         231 :   return gc_long(av,s);
    3463             : }
    3464             : 
    3465             : enum { _SQRTS = 1, _MUP, _GCD, _VCHIP, _BEZ, _NEWLZ, _TRCONJ };
    3466             : /* Trace of T(n) on space of cuspforms; only depends on CHIP the primitive char
    3467             :  * attached to CHI */
    3468             : static GEN
    3469     6385475 : mfcusptrace_i(long N, long k, long n, GEN Dn, GEN S)
    3470             : {
    3471     6385475 :   pari_sp av = avma;
    3472             :   GEN a, b, VCHIP, GCD;
    3473             :   long t;
    3474     6385475 :   if (!n) return gen_0;
    3475     6385475 :   VCHIP = gel(S,_VCHIP);
    3476     6385475 :   GCD = gel(S,_GCD);
    3477     6385475 :   t = TA4(k, VCHIP, Dn, GCD);
    3478     6385475 :   a = TA1(N, k, VCHIP, GCD, n); if (t) a = gaddgs(a,t);
    3479     6385475 :   b = TA2(N, k, VCHIP, n, gel(S,_SQRTS), gel(S,_MUP), GCD);
    3480     6385475 :   b = gadd(b, TA3(N, k, VCHIP, GCD, Dn, gel(S,_BEZ)));
    3481     6385475 :   b = gsub(a,b);
    3482     6385475 :   if (typ(b) != t_POL) return gerepileupto(av, b);
    3483       38675 :   return gerepilecopy(av, vchip_polmod(VCHIP, b));
    3484             : }
    3485             : 
    3486             : static GEN
    3487     7645125 : mfcusptracecache(long N, long k, long n, GEN Dn, GEN S, cachenew_t *cache)
    3488             : {
    3489     7645125 :   GEN C = NULL, T = gel(cache->vfull,N);
    3490     7645125 :   long lcache = lg(T);
    3491     7645125 :   if (n < lcache) C = gel(T, n);
    3492     7645125 :   if (C) cache->cuspHIT++; else C = mfcusptrace_i(N, k, n, Dn, S);
    3493     7645125 :   cache->cuspTOTAL++;
    3494     7645125 :   if (n < lcache) gel(T,n) = C;
    3495     7645125 :   return C;
    3496             : }
    3497             : 
    3498             : /* return the divisors of n, known to be among the elements of D */
    3499             : static GEN
    3500      322077 : div_restrict(GEN D, ulong n)
    3501             : {
    3502             :   long i, j, l;
    3503      322077 :   GEN v, VDIV = caches[cache_DIV].cache;
    3504      322077 :   if (lg(VDIV) > n) return gel(VDIV,n);
    3505           0 :   l = lg(D);
    3506           0 :   v = cgetg(l, t_VECSMALL);
    3507           0 :   for (i = j = 1; i < l; i++)
    3508             :   {
    3509           0 :     ulong d = D[i];
    3510           0 :     if (n % d == 0) v[j++] = d;
    3511             :   }
    3512           0 :   setlg(v,j); return v;
    3513             : }
    3514             : 
    3515             : /* for some prime divisors of N, Tr^new(p) = 0 */
    3516             : static int
    3517      203970 : trconj(GEN T, long N, long n)
    3518      203970 : { return (lg(T) > 1 && N % n == 0 && zv_search(T, n)); }
    3519             : 
    3520             : /* n > 0; trace formula on new space */
    3521             : static GEN
    3522     2594331 : mfnewtrace_i(long N, long k, long n, cachenew_t *cache)
    3523             : {
    3524     2594331 :   GEN VCHIP, s, Dn, DN1, SN, S = cache->DATA;
    3525             :   long FC, N1, N2, N1N2, g, i, j, lDN1;
    3526             : 
    3527     2594331 :   if (!S) return gen_0;
    3528     2594331 :   SN = gel(S,N);
    3529     2594331 :   if (mfnewchkzero(gel(SN,_NEWLZ), n)) return gen_0;
    3530     1872973 :   if (k > 2 && trconj(gel(SN,_TRCONJ), N, n)) return gen_0;
    3531     1872945 :   VCHIP = gel(SN, _VCHIP); FC = vchip_FC(VCHIP);
    3532     1872945 :   N1 = N/FC; newt_params(N1, n, FC, &g, &N2);
    3533     1872945 :   N1N2 = N1/N2;
    3534     1872945 :   DN1 = mydivisorsu(N1N2); lDN1 = lg(DN1);
    3535     1872945 :   N2 *= FC;
    3536     1872945 :   Dn = mydivisorsu(n); /* this one is probably out of cache */
    3537     1872945 :   s = gmulsg(mubeta2(N1N2,n), mfcusptracecache(N2, k, n, Dn, gel(S,N2), cache));
    3538     7323048 :   for (i = 2; i < lDN1; i++)
    3539             :   { /* skip M1 = 1, done above */
    3540     5450103 :     long M1 = DN1[i], N1M1 = DN1[lDN1-i];
    3541     5450103 :     GEN Dg = mydivisorsu(ugcd(M1, g));
    3542     5450103 :     M1 *= N2;
    3543     5450103 :     s = gadd(s, gmulsg(mubeta2(N1M1,n),
    3544     5450103 :                        mfcusptracecache(M1, k, n, Dn, gel(S,M1), cache)));
    3545     5772180 :     for (j = 2; j < lg(Dg); j++) /* skip d = 1, done above */
    3546             :     {
    3547      322077 :       long d = Dg[j], ndd = n/(d*d), M = M1/d;
    3548      322077 :       GEN z = mulsi(mubeta2(N1M1,ndd), powuu(d,k-1)), C = vchip_lift(VCHIP,d,z);
    3549      322077 :       GEN Dndd = div_restrict(Dn, ndd);
    3550      322077 :       s = gadd(s, gmul(C, mfcusptracecache(M, k, ndd, Dndd, gel(S,M), cache)));
    3551             :     }
    3552     5450103 :     s = vchip_mod(VCHIP, s);
    3553             :   }
    3554     1872945 :   return vchip_polmod(VCHIP, s);
    3555             : }
    3556             : 
    3557             : static GEN
    3558       12355 : get_DIH(long N)
    3559             : {
    3560       12355 :   GEN x = cache_get(cache_DIH, N);
    3561       12355 :   return x? gcopy(x): mfdihedral(N);
    3562             : }
    3563             : static GEN
    3564        2373 : get_vDIH(long N, GEN D)
    3565             : {
    3566        2373 :   GEN x = const_vec(N, NULL);
    3567             :   long i, l;
    3568        2373 :   if (!D) D = mydivisorsu(N);
    3569        2373 :   l = lg(D);
    3570       14504 :   for (i = 1; i < l; i++) { long d = D[i]; gel(x, d) = get_DIH(d); }
    3571        2373 :   return x;
    3572             : }
    3573             : 
    3574             : /* divisors of N which are multiple of F */
    3575             : static GEN
    3576         322 : divisorsNF(long N, long F)
    3577             : {
    3578         322 :   GEN D = mydivisorsu(N / F);
    3579         322 :   long l = lg(D), i;
    3580         833 :   for (i = 1; i < l; i++) D[i] = N / D[i];
    3581         322 :   return D;
    3582             : }
    3583             : /* mfcuspdim(N,k,CHI) - mfnewdim(N,k,CHI); CHIP primitive (for efficiency) */
    3584             : static long
    3585        8344 : mfolddim_i(long N, long k, GEN CHIP, GEN vSP)
    3586             : {
    3587        8344 :   long S, i, l, F = mfcharmodulus(CHIP), N1 = N / F, N2;
    3588             :   GEN D;
    3589        8344 :   newd_params(N1, &N2); /* will ensure mubeta != 0 */
    3590        8344 :   D = mydivisorsu(N1/N2); l = lg(D); S = 0;
    3591        8344 :   if (k == 1 && !vSP) vSP = get_vDIH(N, divisorsNF(N, F));
    3592       32445 :   for (i = 2; i < l; i++)
    3593             :   {
    3594       24101 :     long d = mfcuspdim_i(N / D[i], k, CHIP, vSP);
    3595       24101 :     if (d) S -= mubeta(D[i]) * d;
    3596             :   }
    3597        8344 :   return S;
    3598             : }
    3599             : long
    3600         224 : mfolddim(long N, long k, GEN CHI)
    3601             : {
    3602         224 :   pari_sp av = avma;
    3603         224 :   GEN CHIP = mfchartoprimitive(CHI, NULL);
    3604         224 :   return gc_long(av, mfolddim_i(N, k, CHIP, NULL));
    3605             : }
    3606             : /* Only depends on CHIP the primitive char attached to CHI; assumes !badchar */
    3607             : long
    3608       15806 : mfnewdim(long N, long k, GEN CHI)
    3609             : {
    3610             :   pari_sp av;
    3611             :   long S, F;
    3612       15806 :   GEN vSP, CHIP = mfchartoprimitive(CHI, &F);
    3613       15806 :   vSP = (k == 1)? get_vDIH(N, divisorsNF(N, F)): NULL;
    3614       15806 :   S = mfcuspdim_i(N, k, CHIP, vSP); if (!S) return 0;
    3615        7847 :   av = avma; return gc_long(av, S - mfolddim_i(N, k, CHIP, vSP));
    3616             : }
    3617             : 
    3618             : /* trace form, given as closure */
    3619             : static GEN
    3620         945 : mftraceform_new(long N, long k, GEN CHI)
    3621             : {
    3622             :   GEN T;
    3623         945 :   if (k == 1) return initwt1newtrace(mfinit_Nkchi(N, 1, CHI, mf_CUSP, 0));
    3624         924 :   T = initnewtrace(N,CHI); if (!T) return mftrivial();
    3625         924 :   return tag(t_MF_NEWTRACE, mkNK(N,k,CHI), T);
    3626             : }
    3627             : static GEN
    3628          14 : mftraceform_cusp(long N, long k, GEN CHI)
    3629             : {
    3630          14 :   if (k == 1) return initwt1trace(mfinit_Nkchi(N, 1, CHI, mf_CUSP, 0));
    3631           7 :   return tag(t_MF_TRACE, mkNK(N,k,CHI), inittrace(N,CHI,NULL));
    3632             : }
    3633             : static GEN
    3634          98 : mftraceform_i(GEN NK, long space)
    3635             : {
    3636             :   GEN CHI;
    3637             :   long N, k;
    3638          98 :   checkNK(NK, &N, &k, &CHI, 0);
    3639          98 :   if (!mfdim_Nkchi(N, k, CHI, space)) return mftrivial();
    3640          77 :   switch(space)
    3641             :   {
    3642          56 :     case mf_NEW: return mftraceform_new(N, k, CHI);
    3643          14 :     case mf_CUSP:return mftraceform_cusp(N, k, CHI);
    3644             :   }
    3645           7 :   pari_err_DOMAIN("mftraceform", "space", "=", utoi(space), NK);
    3646             :   return NULL;/*LCOV_EXCL_LINE*/
    3647             : }
    3648             : GEN
    3649          98 : mftraceform(GEN NK, long space)
    3650          98 : { pari_sp av = avma; return gerepilecopy(av, mftraceform_i(NK,space)); }
    3651             : 
    3652             : static GEN
    3653       17528 : hecke_data(long N, long n)
    3654       17528 : { return mkvecsmall3(n, u_ppo(n, N), N); }
    3655             : /* 1/2-integral weight */
    3656             : static GEN
    3657          84 : heckef2_data(long N, long n)
    3658             : {
    3659             :   ulong f, fN, fN2;
    3660          84 :   if (!uissquareall(n, &f)) return NULL;
    3661          77 :   fN = u_ppo(f, N); fN2 = fN*fN;
    3662          77 :   return mkvec2(myfactoru(fN), mkvecsmall4(n, N, fN2, n/fN2));
    3663             : }
    3664             : /* N = mf_get_N(F) or a multiple */
    3665             : static GEN
    3666       24591 : mfhecke_i(long n, long N, GEN F)
    3667             : {
    3668       24591 :   if (n == 1) return F;
    3669       17157 :   return tag2(t_MF_HECKE, mf_get_NK(F), hecke_data(N,n), F);
    3670             : }
    3671             : 
    3672             : GEN
    3673         105 : mfhecke(GEN mf, GEN F, long n)
    3674             : {
    3675         105 :   pari_sp av = avma;
    3676             :   GEN NK, CHI, gk, DATA;
    3677             :   long N, nk, dk;
    3678         105 :   mf = checkMF(mf);
    3679         105 :   if (!checkmf_i(F)) pari_err_TYPE("mfhecke",F);
    3680         105 :   if (n <= 0) pari_err_TYPE("mfhecke [n <= 0]", stoi(n));
    3681         105 :   if (n == 1) return gcopy(F);
    3682         105 :   gk = mf_get_gk(F);
    3683         105 :   Qtoss(gk,&nk,&dk);
    3684         105 :   CHI = mf_get_CHI(F);
    3685         105 :   N = MF_get_N(mf);
    3686         105 :   if (dk == 2)
    3687             :   {
    3688          77 :     DATA = heckef2_data(N,n);
    3689          77 :     if (!DATA) return mftrivial();
    3690             :   }
    3691             :   else
    3692          28 :     DATA = hecke_data(N,n);
    3693          98 :   NK = mkgNK(lcmii(stoi(N), mf_get_gN(F)), gk, CHI, mf_get_field(F));
    3694          98 :   return gerepilecopy(av, tag2(t_MF_HECKE, NK, DATA, F));
    3695             : }
    3696             : 
    3697             : /* form F given by closure, compute B(d)(F) as closure (q -> q^d) */
    3698             : static GEN
    3699       35791 : mfbd_i(GEN F, long d)
    3700             : {
    3701             :   GEN D, NK, gk, CHI;
    3702       35791 :   if (d == 1) return F;
    3703       13482 :   if (d <= 0) pari_err_TYPE("mfbd [d <= 0]", stoi(d));
    3704       13482 :   if (mf_get_type(F) != t_MF_BD) D = utoi(d);
    3705           7 :   else { D = mului(d, gel(F,3)); F = gel(F,2); }
    3706       13482 :   gk = mf_get_gk(F); CHI = mf_get_CHI(F);
    3707       13482 :   if (typ(gk) != t_INT) CHI = mfcharmul(CHI, get_mfchar(utoi(d << 2)));
    3708       13482 :   NK = mkgNK(muliu(mf_get_gN(F), d), gk, CHI, mf_get_field(F));
    3709       13482 :   return tag2(t_MF_BD, NK, F, D);
    3710             : }
    3711             : GEN
    3712         252 : mfbd(GEN F, long d)
    3713             : {
    3714         252 :   pari_sp av = avma;
    3715         252 :   if (!checkmf_i(F)) pari_err_TYPE("mfbd",F);
    3716         252 :   return gerepilecopy(av, mfbd_i(F, d));
    3717             : }
    3718             : 
    3719             : /* A[i+1] = a(t*i^2) */
    3720             : static GEN
    3721         105 : RgV_shimura(GEN A, long n, long t, long N, long r, GEN CHI)
    3722             : {
    3723         105 :   GEN R, a0, Pn = mfcharpol(CHI);
    3724         105 :   long m, st, ord = mfcharorder(CHI), vt = varn(Pn), Nt = t == 1? N: ulcm(N,t);
    3725             : 
    3726         105 :   R = cgetg(n + 2, t_VEC);
    3727         105 :   st = odd(r)? -t: t;
    3728         105 :   a0 = gel(A, 1);
    3729         105 :   if (!gequal0(a0))
    3730             :   {
    3731          14 :     long o = mfcharorder(CHI);
    3732          14 :     if (st != 1 && odd(o)) o <<= 1;
    3733          14 :     a0 = gmul(a0, charLFwtk(Nt, r, CHI, o, st));
    3734             :   }
    3735         105 :   gel(R, 1) = a0;
    3736         637 :   for (m = 1; m <= n; m++)
    3737             :   {
    3738         532 :     GEN Dm = mydivisorsu(u_ppo(m, Nt)), S = gel(A, m*m + 1);
    3739         532 :     long i, l = lg(Dm);
    3740         805 :     for (i = 2; i < l; i++)
    3741             :     { /* (e,Nt) = 1; skip i = 1: e = 1, done above */
    3742         273 :       long e = Dm[i], me = m / e, a = mfcharevalord(CHI, e, ord);
    3743         273 :       GEN c, C = powuu(e, r - 1);
    3744         273 :       if (kross(st, e) == -1) C = negi(C);
    3745         273 :       c = Qab_Czeta(a, ord, C, vt);
    3746         273 :       S = gadd(S, gmul(c, gel(A, me*me + 1)));
    3747             :     }
    3748         532 :     gel(R, m+1) = S;
    3749             :   }
    3750         105 :   return degpol(Pn) > 1? gmodulo(R, Pn): R;
    3751             : }
    3752             : 
    3753             : static long
    3754          28 : mfisinkohnen(GEN mf, GEN F)
    3755             : {
    3756          28 :   GEN v, gk = MF_get_gk(mf), CHI = MF_get_CHI(mf);
    3757          28 :   long i, eps, N4 = MF_get_N(mf) >> 2, sb = mfsturmNgk(N4 << 4, gk) + 1;
    3758          28 :   eps = N4 % mfcharconductor(CHI)? -1 : 1;
    3759          28 :   if (odd(MF_get_r(mf))) eps = -eps;
    3760          28 :   v = mfcoefs(F, sb, 1);
    3761         686 :   for (i = 2;     i <= sb; i+=4) if (!gequal0(gel(v,i+1))) return 0;
    3762         245 :   for (i = 2+eps; i <= sb; i+=4) if (!gequal0(gel(v,i+1))) return 0;
    3763          14 :   return 1;
    3764             : }
    3765             : 
    3766             : static long
    3767          42 : mfshimura_space_cusp(GEN mf)
    3768             : {
    3769             :   long N4;
    3770          42 :   if (MF_get_r(mf) == 1 && (N4 = MF_get_N(mf) >> 2) >= 4)
    3771             :   {
    3772          21 :     GEN E = gel(myfactoru(N4), 2);
    3773          21 :     long ma = vecsmall_max(E);
    3774          21 :     if (ma > 2 || (ma == 2 && !mfcharistrivial(MF_get_CHI(mf)))) return 0;
    3775             :   }
    3776          28 :   return 1;
    3777             : }
    3778             : 
    3779             : /* D is either a discriminant (not necessarily fundamental) with
    3780             :    sign(D)=(-1)^{k-1/2}*eps, or a positive squarefree integer t, which is then
    3781             :    transformed into a fundamental discriminant of the correct sign. */
    3782             : GEN
    3783          49 : mfshimura(GEN mf, GEN F, long t)
    3784             : {
    3785          49 :   pari_sp av = avma;
    3786             :   GEN G, res, mf2, CHI;
    3787          49 :   long sb, M, r, N, space = mf_FULL;
    3788             : 
    3789          49 :   if (!checkmf_i(F)) pari_err_TYPE("mfshimura",F);
    3790          49 :   mf = checkMF(mf);
    3791          49 :   r = MF_get_r(mf);
    3792          49 :   if (r <= 0) pari_err_DOMAIN("mfshimura", "weight", "<=", ghalf, mf_get_gk(F));
    3793          49 :   if (t <= 0 || !uissquarefree(t)) pari_err_TYPE("mfshimura [t]", stoi(t));
    3794          42 :   N = MF_get_N(mf); M = N >> 1;
    3795          42 :   if (mfiscuspidal(mf,F))
    3796             :   {
    3797          28 :     if (mfshimura_space_cusp(mf)) space = mf_CUSP;
    3798          28 :     if (mfisinkohnen(mf,F)) M = N >> 2;
    3799             :   }
    3800          42 :   CHI = MF_get_CHI(mf);
    3801          42 :   mf2 = mfinit_Nkchi(M, r << 1, mfcharpow(CHI, gen_2), space, 0);
    3802          42 :   sb = mfsturm(mf2);
    3803          42 :   G = RgV_shimura(mfcoefs_i(F, sb*sb, t), sb, t, N, r, CHI);
    3804          42 :   res = mftobasis_i(mf2, G);
    3805             :   /* not mflinear(mf2,): we want lowest possible level */
    3806          42 :   G = mflinear(MF_get_basis(mf2), res);
    3807          42 :   return gerepilecopy(av, mkvec3(mf2, G, res));
    3808             : }
    3809             : 
    3810             : /* W ZabM (ZM if n = 1), a t_INT or NULL, b t_INT, ZXQ mod P or NULL.
    3811             :  * Write a/b = A/d with d t_INT and A Zab return [W,d,A,P] */
    3812             : static GEN
    3813        7672 : mkMinv(GEN W, GEN a, GEN b, GEN P)
    3814             : {
    3815        7672 :   GEN A = (b && typ(b) == t_POL)? Q_remove_denom(QXQ_inv(b,P), &b): NULL;
    3816        7672 :   if (a && b)
    3817             :   {
    3818        1281 :     a = Qdivii(a,b);
    3819        1281 :     if (typ(a) == t_INT) b = gen_1; else { b = gel(a,2); a = gel(a,1); }
    3820        1281 :     if (is_pm1(a)) a = NULL;
    3821             :   }
    3822        7672 :   if (a) A = A? ZX_Z_mul(A,a): a; else if (!A) A = gen_1;
    3823        7672 :   if (!b) b = gen_1;
    3824        7672 :   if (!P) P = gen_0;
    3825        7672 :   return mkvec4(W,b,A,P);
    3826             : }
    3827             : /* M square invertible QabM, return [M',d], M*M' = d*Id */
    3828             : static GEN
    3829         574 : QabM_Minv(GEN M, GEN P, long n)
    3830             : {
    3831             :   GEN dW, W, dM;
    3832         574 :   M = Q_remove_denom(M, &dM);
    3833         574 :   W = P? ZabM_inv(liftpol_shallow(M), P, n, &dW): ZM_inv(M, &dW);
    3834         574 :   return mkMinv(W, dM, dW, P);
    3835             : }
    3836             : /* Simplified form of mfclean, after a QabM_indexrank: M a ZabM with full
    3837             :  * column rank and z = indexrank(M) is known */
    3838             : static GEN
    3839         840 : mfclean2(GEN M, GEN z, GEN P, long n)
    3840             : {
    3841         840 :   GEN d, Minv, y = gel(z,1), W = rowpermute(M, y);
    3842         840 :   W = P? ZabM_inv(liftpol_shallow(W), P, n, &d): ZM_inv(W, &d);
    3843         840 :   M = rowslice(M, 1, y[lg(y)-1]);
    3844         840 :   Minv = mkMinv(W, NULL, d, P);
    3845         840 :   return mkvec3(y, Minv, M);
    3846             : }
    3847             : /* M QabM, lg(M)>1 and [y,z] its rank profile. Let Minv be the inverse of the
    3848             :  * invertible square matrix in mkMinv format. Return [y,Minv, M[..y[#y],]]
    3849             :  * P cyclotomic polynomial of order n > 2 or NULL */
    3850             : static GEN
    3851        4970 : mfclean(GEN M, GEN P, long n, int ratlift)
    3852             : {
    3853        4970 :   GEN W, v, y, z, d, Minv, dM, MdM = Q_remove_denom(M, &dM);
    3854        4970 :   if (n <= 2)
    3855        3878 :     W = ZM_pseudoinv(MdM, &v, &d);
    3856             :   else
    3857        1092 :     W = ZabM_pseudoinv_i(liftpol_shallow(MdM), P, n, &v, &d, ratlift);
    3858        4970 :   y = gel(v,1);
    3859        4970 :   z = gel(v,2);
    3860        4970 :   if (lg(z) != lg(MdM)) M = vecpermute(M,z);
    3861        4970 :   M = rowslice(M, 1, y[lg(y)-1]);
    3862        4970 :   Minv = mkMinv(W, dM, d, P);
    3863        4970 :   return mkvec3(y, Minv, M);
    3864             : }
    3865             : /* call mfclean using only CHI */
    3866             : static GEN
    3867        4018 : mfcleanCHI(GEN M, GEN CHI, int ratlift)
    3868             : {
    3869        4018 :   long n = mfcharorder(CHI);
    3870        4018 :   GEN P = (n <= 2)? NULL: mfcharpol(CHI);
    3871        4018 :   return mfclean(M, P, n, ratlift);
    3872             : }
    3873             : 
    3874             : /* DATA component of a t_MF_NEWTRACE. Was it stripped to save memory ? */
    3875             : static int
    3876       33572 : newtrace_stripped(GEN DATA)
    3877       33572 : { return DATA && (lg(DATA) == 5 && typ(gel(DATA,3)) == t_INT); }
    3878             : /* f a t_MF_NEWTRACE */
    3879             : static GEN
    3880       33572 : newtrace_DATA(long N, GEN f)
    3881             : {
    3882       33572 :   GEN DATA = gel(f,2);
    3883       33572 :   return newtrace_stripped(DATA)? initnewtrace(N, DATA): DATA;
    3884             : }
    3885             : /* reset cachenew for new level incorporating new DATA, tf a t_MF_NEWTRACE
    3886             :  * (+ possibly initialize 'full' for new allowed levels) */
    3887             : static void
    3888       33572 : reset_cachenew(cachenew_t *cache, long N, GEN tf)
    3889             : {
    3890             :   long i, n, l;
    3891       33572 :   GEN v, DATA = newtrace_DATA(N,tf);
    3892       33572 :   cache->DATA = DATA;
    3893       33572 :   if (!DATA) return;
    3894       33467 :   n = cache->n;
    3895       33467 :   v = cache->vfull; l = N+1; /* = lg(DATA) */
    3896     2195375 :   for (i = 1; i < l; i++)
    3897     2161908 :     if (typ(gel(v,i)) == t_INT && lg(gel(DATA,i)) != 1)
    3898       53235 :       gel(v,i) = const_vec(n, NULL);
    3899       33467 :   cache->VCHIP = gel(gel(DATA,N),_VCHIP);
    3900             : }
    3901             : /* initialize a cache of newtrace / cusptrace up to index n and level | N;
    3902             :  * DATA may be NULL (<=> Tr^new = 0). tf a t_MF_NEWTRACE */
    3903             : static void
    3904       13125 : init_cachenew(cachenew_t *cache, long n, long N, GEN tf)
    3905             : {
    3906       13125 :   long i, l = N+1; /* = lg(tf.DATA) when DATA != NULL */
    3907             :   GEN v;
    3908       13125 :   cache->n = n;
    3909       13125 :   cache->vnew = v = cgetg(l, t_VEC);
    3910      940926 :   for (i = 1; i < l; i++) gel(v,i) = (N % i)? gen_0: const_vec(n, NULL);
    3911       13125 :   cache->newHIT = cache->newTOTAL = cache->cuspHIT = cache->cuspTOTAL = 0;
    3912       13125 :   cache->vfull = v = zerovec(N);
    3913       13125 :   reset_cachenew(cache, N, tf);
    3914       13125 : }
    3915             : static void
    3916       17136 : dbg_cachenew(cachenew_t *C)
    3917             : {
    3918       17136 :   if (DEBUGLEVEL >= 2 && C)
    3919           0 :     err_printf("newtrace cache hits: new = %ld/%ld, cusp = %ld/%ld\n",
    3920             :                     C->newHIT, C->newTOTAL, C->cuspHIT, C->cuspTOTAL);
    3921       17136 : }
    3922             : 
    3923             : /* newtrace_{N,k}(d*i), i = n0, ..., n */
    3924             : static GEN
    3925      179130 : colnewtrace(long n0, long n, long d, long N, long k, cachenew_t *cache)
    3926             : {
    3927      179130 :   GEN v = cgetg(n-n0+2, t_COL);
    3928             :   long i;
    3929     4674810 :   for (i = n0; i <= n; i++) gel(v, i-n0+1) = mfnewtracecache(N, k, i*d, cache);
    3930      179130 :   return v;
    3931             : }
    3932             : /* T_n(l*m0, l*(m0+1), ..., l*m) F, F = t_MF_NEWTRACE [N,k],DATA, cache
    3933             :  * contains DATA != NULL as well as cached values of F */
    3934             : static GEN
    3935       88606 : heckenewtrace(long m0, long m, long l, long N, long NBIG, long k, long n, cachenew_t *cache)
    3936             : {
    3937       88606 :   long lD, a, k1, nl = n*l;
    3938       88606 :   GEN D, V, v = colnewtrace(m0, m, nl, N, k, cache); /* d=1 */
    3939             :   GEN VCHIP;
    3940       88606 :   if (n == 1) return v;
    3941       60865 :   VCHIP = cache->VCHIP;
    3942       60865 :   D = mydivisorsu(u_ppo(n, NBIG)); lD = lg(D);
    3943       60865 :   k1 = k - 1;
    3944      149499 :   for (a = 2; a < lD; a++)
    3945             :   { /* d > 1, (d,NBIG) = 1 */
    3946       88634 :     long i, j, d = D[a], c = ugcd(l, d), dl = d/c, m0d = ceildivuu(m0, dl);
    3947       88634 :     GEN C = vchip_lift(VCHIP, d, powuu(d, k1));
    3948             :     /* m0=0: i = 1 => skip F(0) = 0 */
    3949       88634 :     if (!m0) { i = 1; j = dl; } else { i = 0; j = m0d*dl; }
    3950       88634 :     V = colnewtrace(m0d, m/dl, nl/(d*c), N, k, cache);
    3951             :     /* C = chi(d) d^(k-1) */
    3952     1075963 :     for (; j <= m; i++, j += dl)
    3953      987329 :       gel(v,j-m0+1) = gadd(gel(v,j-m0+1), vchip_mod(VCHIP, gmul(C,gel(V,i+1))));
    3954             :   }
    3955       60865 :   return v;
    3956             : }
    3957             : 
    3958             : /* Given v = an[i], return an[d*i], i=0..n */
    3959             : static GEN
    3960        2618 : anextract(GEN v, long n, long d)
    3961             : {
    3962        2618 :   long i, id, l = n + 2;
    3963        2618 :   GEN w = cgetg(l, t_VEC);
    3964        2618 :   if (d == 1)
    3965        7245 :     for (i = 1; i < l; i++) gel(w, i) = gel(v, i);
    3966             :   else
    3967       22036 :     for (i = id = 1; i < l; i++, id += d) gel(w, i) = gel(v, id);
    3968        2618 :   return w;
    3969             : }
    3970             : /* T_n(F)(0, l, ..., l*m) */
    3971             : static GEN
    3972        2527 : hecke_i(long m, long l, GEN V, GEN F, GEN DATA)
    3973             : {
    3974             :   long k, n, nNBIG, NBIG, lD, M, a, t, nl;
    3975             :   GEN D, v, CHI;
    3976        2527 :   if (typ(DATA) == t_VEC)
    3977             :   { /* 1/2-integral k */
    3978          98 :     if (!V) { GEN S = gel(DATA,2); V = mfcoefs_i(F, m*l*S[3], S[4]); }
    3979          98 :     return RgV_heckef2(m, l, V, F, DATA);
    3980             :   }
    3981        2429 :   k = mf_get_k(F);
    3982        2429 :   n = DATA[1]; nl = n*l;
    3983        2429 :   nNBIG = DATA[2];
    3984        2429 :   NBIG = DATA[3];
    3985        2429 :   if (nNBIG == 1) return V? V: mfcoefs_i(F,m,nl);
    3986        1673 :   if (!V && mf_get_type(F) == t_MF_NEWTRACE)
    3987             :   { /* inline F to allow cache, T_n at level NBIG acting on Tr^new(N,k,CHI) */
    3988             :     cachenew_t cache;
    3989         364 :     long N = mf_get_N(F);
    3990         364 :     init_cachenew(&cache, m*nl, N, F);
    3991         364 :     v = heckenewtrace(0, m, l, N, NBIG, k, n, &cache);
    3992         364 :     dbg_cachenew(&cache);
    3993         364 :     settyp(v, t_VEC); return v;
    3994             :   }
    3995        1309 :   CHI = mf_get_CHI(F);
    3996        1309 :   D = mydivisorsu(nNBIG); lD = lg(D);
    3997        1309 :   M = m + 1;
    3998        1309 :   t = nNBIG * ugcd(nNBIG, l);
    3999        1309 :   if (!V) V = mfcoefs_i(F, m * t, nl / t); /* usually nl = t */
    4000        1309 :   v = anextract(V, m, t); /* mfcoefs(F, m, nl); d = 1 */
    4001        2618 :   for (a = 2; a < lD; a++)
    4002             :   { /* d > 1, (d, NBIG) = 1 */
    4003        1309 :     long d = D[a], c = ugcd(l, d), dl = d/c, i, idl;
    4004        1309 :     GEN C = gmul(mfchareval(CHI, d), powuu(d, k-1));
    4005        1309 :     GEN w = anextract(V, m/dl, t/(d*c)); /* mfcoefs(F, m/dl, nl/(d*c)) */
    4006        7245 :     for (i = idl = 1; idl <= M; i++, idl += dl)
    4007        5936 :       gel(v,idl) = gadd(gel(v,idl), gmul(C, gel(w,i)));
    4008             :   }
    4009        1309 :   return v;
    4010             : }
    4011             : 
    4012             : static GEN
    4013       12285 : mkmf(GEN x1, GEN x2, GEN x3, GEN x4, GEN x5)
    4014             : {
    4015       12285 :   GEN MF = obj_init(5, MF_SPLITN);
    4016       12285 :   gel(MF,1) = x1;
    4017       12285 :   gel(MF,2) = x2;
    4018       12285 :   gel(MF,3) = x3;
    4019       12285 :   gel(MF,4) = x4;
    4020       12285 :   gel(MF,5) = x5; return MF;
    4021             : }
    4022             : 
    4023             : /* return an integer b such that p | b => T_p^k Tr^new = 0, for all k > 0 */
    4024             : static long
    4025        7588 : get_badj(long N, long FC)
    4026             : {
    4027        7588 :   GEN fa = myfactoru(N), P = gel(fa,1), E = gel(fa,2);
    4028        7588 :   long i, b = 1, l = lg(P);
    4029       20202 :   for (i = 1; i < l; i++)
    4030       12614 :     if (E[i] > 1 && u_lval(FC, P[i]) < E[i]) b *= P[i];
    4031        7588 :   return b;
    4032             : }
    4033             : /* in place, assume perm strictly increasing */
    4034             : static void
    4035        1330 : vecpermute_inplace(GEN v, GEN perm)
    4036             : {
    4037        1330 :   long i, l = lg(perm);
    4038       11522 :   for (i = 1; i < l; i++) gel(v,i) = gel(v,perm[i]);
    4039        1330 : }
    4040             : 
    4041             : /* Find basis of newspace using closures; assume k >= 2 and !badchar.
    4042             :  * Return NULL if space is empty, else
    4043             :  * [mf1, list of closures T(j)traceform, list of corresponding j, matrix] */
    4044             : static GEN
    4045       15561 : mfnewinit(long N, long k, GEN CHI, cachenew_t *cache, long init)
    4046             : {
    4047             :   GEN S, vj, M, CHIP, mf1, listj, P, tf;
    4048             :   long j, ct, ctlj, dim, jin, SB, sb, two, ord, FC, badj;
    4049             : 
    4050       15561 :   dim = mfnewdim(N, k, CHI);
    4051       15561 :   if (!dim && !init) return NULL;
    4052        7588 :   sb = mfsturmNk(N, k);
    4053        7588 :   CHIP = mfchartoprimitive(CHI, &FC);
    4054             :   /* remove newtrace data from S to save space in output: negligible slowdown */
    4055        7588 :   tf = tag(t_MF_NEWTRACE, mkNK(N,k,CHIP), CHIP);
    4056        7588 :   badj = get_badj(N, FC);
    4057             :   /* try sbsmall first: Sturm bound not sharp for new space */
    4058        7588 :   SB = ceilA1(N, k);
    4059        7588 :   listj = cgetg(2*sb + 3, t_VECSMALL);
    4060      372281 :   for (j = ctlj = 1; ctlj < 2*sb + 3; j++)
    4061      364693 :     if (ugcd(j, badj) == 1) listj[ctlj++] = j;
    4062        7588 :   if (init)
    4063             :   {
    4064        4109 :     init_cachenew(cache, (SB+1)*listj[dim+1], N, tf);
    4065        4109 :     if (init == -1 || !dim) return NULL; /* old space or dim = 0 */
    4066             :   }
    4067             :   else
    4068        3479 :     reset_cachenew(cache, N, tf);
    4069             :   /* cache.DATA is not NULL */
    4070        7119 :   ord = mfcharorder(CHIP);
    4071        7119 :   P = ord <= 2? NULL: mfcharpol(CHIP);
    4072        7119 :   vj = cgetg(dim+1, t_VECSMALL);
    4073        7119 :   M = cgetg(dim+1, t_MAT);
    4074        7126 :   for (two = 1, ct = 0, jin = 1; two <= 2; two++)
    4075             :   {
    4076        7126 :     long a, jlim = jin + sb;
    4077       21931 :     for (a = jin; a <= jlim; a++)
    4078             :     {
    4079             :       GEN z, vecz;
    4080       21924 :       ct++; vj[ct] = listj[a];
    4081       21924 :       gel(M, ct) = heckenewtrace(0, SB, 1, N, N, k, vj[ct], cache);
    4082       21924 :       if (ct < dim) continue;
    4083             : 
    4084        7784 :       z = QabM_indexrank(M, P, ord);
    4085        7784 :       vecz = gel(z, 2); ct = lg(vecz) - 1;
    4086        7784 :       if (ct == dim) { M = mkvec3(z, gen_0, M); break; } /*maximal rank, done*/
    4087         665 :       vecpermute_inplace(M, vecz);
    4088         665 :       vecpermute_inplace(vj, vecz);
    4089             :     }
    4090        7126 :     if (a <= jlim) break;
    4091             :     /* sbsmall was not sufficient, use Sturm bound: must extend M */
    4092          70 :     for (j = 1; j <= ct; j++)
    4093             :     {
    4094          63 :       GEN t = heckenewtrace(SB + 1, sb, 1, N, N, k, vj[j], cache);
    4095          63 :       gel(M,j) = shallowconcat(gel(M, j), t);
    4096             :     }
    4097           7 :     jin = jlim + 1; SB = sb;
    4098             :   }
    4099        7119 :   S = cgetg(dim + 1, t_VEC);
    4100       28336 :   for (j = 1; j <= dim; j++) gel(S, j) = mfhecke_i(vj[j], N, tf);
    4101        7119 :   dbg_cachenew(cache);
    4102        7119 :   mf1 = mkvec4(utoipos(N), utoipos(k), CHI, utoi(mf_NEW));
    4103        7119 :   return mkmf(mf1, cgetg(1,t_VEC), S, vj, M);
    4104             : }
    4105             : /* k > 1 integral, mf space is mf_CUSP or mf_FULL */
    4106             : static GEN
    4107          42 : mfinittonew(GEN mf)
    4108             : {
    4109          42 :   GEN CHI = MF_get_CHI(mf), S = MF_get_S(mf), vMjd = MFcusp_get_vMjd(mf);
    4110          42 :   GEN M = MF_get_M(mf), vj, mf1;
    4111          42 :   long i, j, l, l0 = lg(S), N0 = MF_get_N(mf);
    4112         203 :   for (i = l0-1; i > 0; i--)
    4113             :   {
    4114         189 :     long N = gel(vMjd,i)[1];
    4115         189 :     if (N != N0) break;
    4116             :   }
    4117          42 :   if (i == l0-1) return NULL;
    4118          35 :   S = vecslice(S, i+1, l0-1); /* forms of conductor N0 */
    4119          35 :   l = lg(S); vj = cgetg(l, t_VECSMALL);
    4120         196 :   for (j = 1; j < l; j++) vj[j] = gel(vMjd,j+i)[2];
    4121          35 :   M = vecslice(M, lg(M)-lg(S)+1, lg(M)-1); /* their coefficients */
    4122          35 :   M = mfcleanCHI(M, CHI, 0);
    4123          35 :   mf1 = mkvec4(utoipos(N0), MF_get_gk(mf), CHI, utoi(mf_NEW));
    4124          35 :   return mkmf(mf1, cgetg(1,t_VEC), S, vj, M);
    4125             : }
    4126             : 
    4127             : /* Bd(f)[m0..m], v = f[ceil(m0/d)..floor(m/d)], m0d = ceil(m0/d) */
    4128             : static GEN
    4129       82411 : RgC_Bd_expand(long m0, long m, GEN v, long d, long m0d)
    4130             : {
    4131             :   long i, j;
    4132             :   GEN w;
    4133       82411 :   if (d == 1) return v;
    4134       23660 :   w = zerocol(m-m0+1);
    4135       23660 :   if (!m0) { i = 1; j = d; } else { i = 0; j = m0d*d; }
    4136      469399 :   for (; j <= m; i++, j += d) gel(w,j-m0+1) = gel(v,i+1);
    4137       23660 :   return w;
    4138             : }
    4139             : /* S a nonempty vector of t_MF_BD(t_MF_HECKE(t_MF_NEWTRACE)); M the matrix
    4140             :  * of their coefficients r*0, r*1, ..., r*m0 (~ mfvectomat) or NULL (empty),
    4141             :  * extend it to coeffs up to m > m0. The forms B_d(T_j(tf_N))in S should be
    4142             :  * sorted by level N, then j, then increasing d. No reordering here. */
    4143             : static GEN
    4144        9002 : bhnmat_extend(GEN M, long m, long r, GEN S, cachenew_t *cache)
    4145             : {
    4146        9002 :   long i, mr, m0, m0r, Nold = 0, jold = 0, l = lg(S);
    4147        9002 :   GEN MAT = cgetg(l, t_MAT), v = NULL;
    4148        9002 :   if (M) { m0 = nbrows(M); m0r = m0 * r; } else m0 = m0r = 0;
    4149        9002 :   mr = m*r;
    4150       91413 :   for (i = 1; i < l; i++)
    4151             :   {
    4152             :     long d, j, md, N;
    4153       82411 :     GEN c, f = bhn_parse(gel(S,i), &d,&j); /* t_MF_NEWTRACE */
    4154       82411 :     N = mf_get_N(f);
    4155       82411 :     md = ceildivuu(m0r,d);
    4156       82411 :     if (N != Nold) { reset_cachenew(cache, N, f); Nold = N; jold = 0; }
    4157       82411 :     if (!cache->DATA) { gel(MAT,i) = zerocol(m+1); continue; }
    4158       82411 :     if (j != jold || md)
    4159       66255 :     { v = heckenewtrace(md, mr/d, 1, N, N, mf_get_k(f), j,cache); jold=j; }
    4160       82411 :     c = RgC_Bd_expand(m0r, mr, v, d, md);
    4161       82411 :     if (r > 1) c = c_deflate(m-m0, r, c);
    4162       82411 :     if (M) c = shallowconcat(gel(M,i), c);
    4163       82411 :     gel(MAT,i) = c;
    4164             :   }
    4165        9002 :   return MAT;
    4166             : }
    4167             : 
    4168             : /* k > 1 */
    4169             : static GEN
    4170        3192 : mfinitcusp(long N, long k, GEN CHI, cachenew_t *cache, long space)
    4171             : {
    4172             :   long L, l, lDN1, FC, N1, d1, i, init;
    4173        3192 :   GEN vS, vMjd, DN1, vmf, CHIP = mfchartoprimitive(CHI, &FC);
    4174             : 
    4175        3192 :   d1 = (space == mf_OLD)? mfolddim_i(N, k, CHIP, NULL): mfcuspdim(N, k, CHIP);
    4176        3192 :   if (!d1) return NULL;
    4177        2891 :   N1 = N/FC; DN1 = mydivisorsu(N1); lDN1 = lg(DN1);
    4178        2891 :   init = (space == mf_OLD)? -1: 1;
    4179        2891 :   vmf = cgetg(lDN1, t_VEC);
    4180       17234 :   for (i = lDN1 - 1, l = 1; i; i--)
    4181             :   { /* by decreasing level to allow cache */
    4182       14343 :     GEN mf = mfnewinit(FC*DN1[i], k, CHIP, cache, init);
    4183       14343 :     if (mf) gel(vmf, l++) = mf;
    4184       14343 :     init = 0;
    4185             :   }
    4186        2891 :   setlg(vmf,l); vmf = vecreverse(vmf); /* reorder by increasing level */
    4187             : 
    4188        2891 :   L = mfsturmNk(N, k)+1;
    4189        2891 :   vS = vectrunc_init(L);
    4190        2891 :   vMjd = vectrunc_init(L);
    4191        9163 :   for (i = 1; i < l; i++)
    4192             :   {
    4193        6272 :     GEN DNM, mf = gel(vmf,i), S = MF_get_S(mf), vj = MFnew_get_vj(mf);
    4194        6272 :     long a, lDNM, lS = lg(S), M = MF_get_N(mf);
    4195        6272 :     DNM = mydivisorsu(N / M); lDNM = lg(DNM);
    4196       25403 :     for (a = 1; a < lS; a++)
    4197             :     {
    4198       19131 :       GEN tf = gel(S,a);
    4199       19131 :       long b, j = vj[a];
    4200       47607 :       for (b = 1; b < lDNM; b++)
    4201             :       {
    4202       28476 :         long d = DNM[b];
    4203       28476 :         vectrunc_append(vS, mfbd_i(tf, d));
    4204       28476 :         vectrunc_append(vMjd, mkvecsmall3(M, j, d));
    4205             :       }
    4206             :     }
    4207             :   }
    4208        2891 :   return mkmf(NULL, cgetg(1, t_VEC), vS, vMjd, NULL);
    4209             : }
    4210             : 
    4211             : long
    4212        4522 : mfsturm_mf(GEN mf)
    4213             : {
    4214        4522 :   GEN Mindex = MF_get_Mindex(mf);
    4215        4522 :   long n = lg(Mindex)-1;
    4216        4522 :   return n? Mindex[n]-1: 0;
    4217             : }
    4218             : 
    4219             : long
    4220         798 : mfsturm(GEN T)
    4221             : {
    4222             :   long N, nk, dk;
    4223         798 :   GEN CHI, mf = checkMF_i(T);
    4224         798 :   if (mf) return mfsturm_mf(mf);
    4225           7 :   checkNK2(T, &N, &nk, &dk, &CHI, 0);
    4226           7 :   return dk == 1 ? mfsturmNk(N, nk) : mfsturmNk(N, (nk + 1) >> 1);
    4227             : }
    4228             : long
    4229         196 : mfisequal(GEN F, GEN G, long lim)
    4230             : {
    4231         196 :   pari_sp av = avma;
    4232             :   long b;
    4233         196 :   if (!checkmf_i(F)) pari_err_TYPE("mfisequal",F);
    4234         196 :   if (!checkmf_i(G)) pari_err_TYPE("mfisequal",G);
    4235         196 :   b = lim? lim: maxss(mfsturmmf(F), mfsturmmf(G));
    4236         196 :   return gc_long(av, gequal(mfcoefs_i(F, b, 1), mfcoefs_i(G, b, 1)));
    4237             : }
    4238             : 
    4239             : GEN
    4240          35 : mffields(GEN mf)
    4241             : {
    4242          35 :   if (checkmf_i(mf)) return gcopy(mf_get_field(mf));
    4243          35 :   mf = checkMF(mf); return gcopy(MF_get_fields(mf));
    4244             : }
    4245             : 
    4246             : GEN
    4247         336 : mfeigenbasis(GEN mf)
    4248             : {
    4249         336 :   pari_sp ltop = avma;
    4250             :   GEN F, S, v, vP;
    4251             :   long i, l, k, dS;
    4252             : 
    4253         336 :   mf = checkMF(mf);
    4254         336 :   k = MF_get_k(mf);
    4255         336 :   S = MF_get_S(mf); dS = lg(S)-1;
    4256         336 :   if (!dS) return cgetg(1, t_VEC);
    4257         329 :   F = MF_get_newforms(mf);
    4258         329 :   vP = MF_get_fields(mf);
    4259         329 :   if (k == 1)
    4260             :   {
    4261         210 :     if (MF_get_space(mf) == mf_FULL)
    4262             :     {
    4263          14 :       long dE = lg(MF_get_E(mf)) - 1;
    4264          14 :       if (dE) F = rowslice(F, dE+1, dE+dS);
    4265             :     }
    4266         210 :     v = vecmflineardiv_linear(S, F);
    4267         210 :     l = lg(v);
    4268             :   }
    4269             :   else
    4270             :   {
    4271         119 :     GEN (*L)(GEN, GEN) = (MF_get_space(mf) == mf_FULL)? mflinear: mflinear_bhn;
    4272         119 :     l = lg(F); v = cgetg(l, t_VEC);
    4273         413 :     for (i = 1; i < l; i++) gel(v,i) = L(mf, gel(F,i));
    4274             :   }
    4275         847 :   for (i = 1; i < l; i++) mf_setfield(gel(v,i), gel(vP,i));
    4276         329 :   return gerepilecopy(ltop, v);
    4277             : }
    4278             : 
    4279             : /* Minv = [M, d, A], v a t_COL; A a Zab, d a t_INT; return (A/d) * M*v */
    4280             : static GEN
    4281        7259 : Minv_RgC_mul(GEN Minv, GEN v)
    4282             : {
    4283        7259 :   GEN M = gel(Minv,1), d = gel(Minv,2), A = gel(Minv,3);
    4284        7259 :   v = RgM_RgC_mul(M, v);
    4285        7259 :   if (!equali1(A))
    4286             :   {
    4287        1764 :     if (typ(A) == t_POL && degpol(A) > 0) A = mkpolmod(A, gel(Minv,4));
    4288        1764 :     v = RgC_Rg_mul(v, A);
    4289             :   }
    4290        7259 :   if (!equali1(d)) v = RgC_Rg_div(v, d);
    4291        7259 :   return v;
    4292             : }
    4293             : static GEN
    4294        1274 : Minv_RgM_mul(GEN Minv, GEN B)
    4295             : {
    4296        1274 :   long j, l = lg(B);
    4297        1274 :   GEN M = cgetg(l, t_MAT);
    4298        5901 :   for (j = 1; j < l; j++) gel(M,j) = Minv_RgC_mul(Minv, gel(B,j));
    4299        1274 :   return M;
    4300             : }
    4301             : /* B * Minv; allow B = NULL for Id */
    4302             : static GEN
    4303        2436 : RgM_Minv_mul(GEN B, GEN Minv)
    4304             : {
    4305        2436 :   GEN M = gel(Minv,1), d = gel(Minv,2), A = gel(Minv,3);
    4306        2436 :   if (B) M = RgM_mul(B, M);
    4307        2436 :   if (!equali1(A))
    4308             :   {
    4309         980 :     if (typ(A) == t_POL) A = mkpolmod(A, gel(Minv,4));
    4310         980 :     M = RgM_Rg_mul(M, A);
    4311             :   }
    4312        2436 :   if (!equali1(d)) M = RgM_Rg_div(M,d);
    4313        2436 :   return M;
    4314             : }
    4315             : 
    4316             : /* perm vector of strictly increasing indices, v a vector or arbitrary length;
    4317             :  * the last r entries of perm fall beyond v.
    4318             :  * Return v o perm[1..(-r)], discarding the last r entries of v */
    4319             : static GEN
    4320        1351 : vecpermute_partial(GEN v, GEN perm, long *r)
    4321             : {
    4322        1351 :   long i, n = lg(v)-1, l = lg(perm);
    4323             :   GEN w;
    4324        1351 :   if (perm[l-1] <= n) { *r = 0; return vecpermute(v,perm); }
    4325          63 :   for (i = 1; i < l; i++)
    4326          63 :     if (perm[i] > n) break;
    4327          21 :   *r = l - i; l = i;
    4328          21 :   w = cgetg(l, typ(v));
    4329          63 :   for (i = 1; i < l; i++) gel(w,i) = gel(v,perm[i]);
    4330          21 :   return w;
    4331             : }
    4332             : 
    4333             : /* given form F, find coeffs of F on mfbasis(mf). If power series, not
    4334             :  * guaranteed correct if precision less than Sturm bound */
    4335             : static GEN
    4336        1372 : mftobasis_i(GEN mf, GEN F)
    4337             : {
    4338             :   GEN v, Mindex, Minv;
    4339        1372 :   if (!MF_get_dim(mf)) return cgetg(1, t_COL);
    4340        1372 :   Mindex = MF_get_Mindex(mf);
    4341        1372 :   Minv = MF_get_Minv(mf);
    4342        1372 :   if (checkmf_i(F))
    4343             :   {
    4344         259 :     long n = Mindex[lg(Mindex)-1];
    4345         259 :     v = vecpermute(mfcoefs_i(F, n, 1), Mindex);
    4346         259 :     return Minv_RgC_mul(Minv, v);
    4347             :   }
    4348             :   else
    4349             :   {
    4350        1113 :     GEN A = gel(Minv,1), d = gel(Minv,2);
    4351             :     long r;
    4352        1113 :     v = F;
    4353        1113 :     switch(typ(F))
    4354             :     {
    4355           0 :       case t_SER: v = sertocol(v);
    4356        1113 :       case t_VEC: case t_COL: break;
    4357           0 :       default: pari_err_TYPE("mftobasis", F);
    4358             :     }
    4359        1113 :     if (lg(v) == 1) pari_err_TYPE("mftobasis",v);
    4360        1113 :     v = vecpermute_partial(v, Mindex, &r);
    4361        1113 :     if (!r) return Minv_RgC_mul(Minv, v); /* single solution */
    4362             :     /* affine space of dimension r */
    4363          21 :     v = RgM_RgC_mul(vecslice(A, 1, lg(v)-1), v);
    4364          21 :     if (!equali1(d)) v = RgC_Rg_div(v,d);
    4365          21 :     return mkvec2(v, vecslice(A, lg(A)-r, lg(A)-1));
    4366             :   }
    4367             : }
    4368             : 
    4369             : static GEN
    4370         896 : const_mat(long n, GEN x)
    4371             : {
    4372         896 :   long j, l = n+1;
    4373         896 :   GEN A = cgetg(l,t_MAT);
    4374        6832 :   for (j = 1; j < l; j++) gel(A,j) = const_col(n, x);
    4375         896 :   return A;
    4376             : }
    4377             : 
    4378             : /* L is the mftobasis of a form on CUSP space. We allow mf_FULL or mf_CUSP */
    4379             : static GEN
    4380         448 : mftonew_i(GEN mf, GEN L, long *plevel)
    4381             : {
    4382             :   GEN S, listMjd, CHI, res, Aclos, Acoef, D, perm;
    4383         448 :   long N1, LC, lD, i, l, t, level, N = MF_get_N(mf);
    4384             : 
    4385         448 :   if (MF_get_k(mf) == 1) pari_err_IMPL("mftonew in weight 1");
    4386         448 :   listMjd = MFcusp_get_vMjd(mf);
    4387         448 :   CHI = MF_get_CHI(mf); LC = mfcharconductor(CHI);
    4388         448 :   S = MF_get_S(mf);
    4389             : 
    4390         448 :   N1 = N/LC;
    4391         448 :   D = mydivisorsu(N1); lD = lg(D);
    4392         448 :   perm = cgetg(N1+1, t_VECSMALL);
    4393        3416 :   for (i = 1; i < lD; i++) perm[D[i]] = i;
    4394         448 :   Aclos = const_mat(lD-1, cgetg(1,t_VEC));
    4395         448 :   Acoef = const_mat(lD-1, cgetg(1,t_VEC));
    4396         448 :   l = lg(listMjd);
    4397        4494 :   for (i = 1; i < l; i++)
    4398             :   {
    4399             :     long M, d;
    4400             :     GEN v;
    4401        4046 :     if (gequal0(gel(L,i))) continue;
    4402         441 :     v = gel(listMjd, i);
    4403         441 :     M = perm[ v[1]/LC ];
    4404         441 :     d = perm[ v[3] ];
    4405         441 :     gcoeff(Aclos,M,d) = vec_append(gcoeff(Aclos,M,d), gel(S,i));
    4406         441 :     gcoeff(Acoef,M,d) = shallowconcat(gcoeff(Acoef,M,d), gel(L,i));
    4407             :   }
    4408         448 :   res = cgetg(l, t_VEC); level = 1;
    4409        3416 :   for (i = t = 1; i < lD; i++)
    4410             :   {
    4411        2968 :     long j, M = D[i]*LC;
    4412        2968 :     GEN gM = utoipos(M);
    4413       26390 :     for (j = 1; j < lD; j++)
    4414             :     {
    4415       23422 :       GEN f = gcoeff(Aclos,i,j), C, NK;
    4416             :       long d;
    4417       23422 :       if (lg(f) == 1) continue;
    4418         413 :       d = D[j];
    4419         413 :       C = gcoeff(Acoef,i,j);
    4420         413 :       NK = mf_get_NK(gel(f, 1));
    4421         413 :       if (d > 1)
    4422             :       {
    4423         168 :           if (lg(f) > 2) pari_err_BUG("should be only one form");
    4424         168 :           f = gel(f, 1);
    4425         168 :           if (mf_get_type(f) == t_MF_BD)
    4426             :           {
    4427         168 :             if (!equaliu(gel(f,3), d))
    4428           0 :               pari_err_BUG("inconsistent multiplier");
    4429         168 :             f = gel(f, 2);
    4430             :           }
    4431         168 :           f = mkvec(f);
    4432             :       }
    4433         413 :       level = ulcm(level, M*d);
    4434         413 :       gel(res,t++) = mkvec3(gM, utoipos(d), mflinear_i(NK,f,C));
    4435             :     }
    4436             :   }
    4437         448 :   if (plevel) *plevel = level;
    4438         448 :   setlg(res, t); return res;
    4439             : }
    4440             : GEN
    4441         210 : mftonew(GEN mf, GEN F)
    4442             : {
    4443         210 :   pari_sp av = avma;
    4444             :   GEN ES;
    4445             :   long s;
    4446         210 :   mf = checkMF(mf);
    4447         210 :   s = MF_get_space(mf);
    4448         210 :   if (s != mf_FULL && s != mf_CUSP)
    4449           7 :     pari_err_TYPE("mftonew [not a full or cuspidal space]", mf);
    4450         203 :   ES = mftobasisES(mf,F);
    4451         196 :   if (!gequal0(gel(ES,1)))
    4452           0 :     pari_err_TYPE("mftonew [not a cuspidal form]", F);
    4453         196 :   F = gel(ES,2);
    4454         196 :   return gerepilecopy(av, mftonew_i(mf,F, NULL));
    4455             : }
    4456             : 
    4457             : static GEN mfeisenstein_i(long k, GEN CHI1, GEN CHI2);
    4458             : 
    4459             : /* mfinit(F * Theta) */
    4460             : static GEN
    4461          98 : mf2init(GEN mf)
    4462             : {
    4463          98 :   GEN CHI = MF_get_CHI(mf), gk = gadd(MF_get_gk(mf), ghalf);
    4464          98 :   long N = MF_get_N(mf);
    4465          98 :   return mfinit_Nkchi(N, itou(gk), mfchiadjust(CHI, gk, N), mf_FULL, 0);
    4466             : }
    4467             : 
    4468             : static long
    4469         623 : mfvec_first_cusp(GEN v)
    4470             : {
    4471         623 :   long i, l = lg(v);
    4472        1519 :   for (i = 1; i < l; i++)
    4473             :   {
    4474        1414 :     GEN F = gel(v,i);
    4475        1414 :     long t = mf_get_type(F);
    4476        1414 :     if (t == t_MF_BD) { F = gel(F,2); t = mf_get_type(F); }
    4477        1414 :     if (t == t_MF_HECKE) { F = gel(F,3); t = mf_get_type(F); }
    4478        1414 :     if (t == t_MF_NEWTRACE) break;
    4479             :   }
    4480         623 :   return i;
    4481             : }
    4482             : /* vF a vector of mf F of type DIV(LINEAR(BAS,L), f) in (lcm) level N,
    4483             :  * F[2]=LINEAR(BAS,L), F[2][2]=BAS=fixed basis (Eisenstein or bhn type),
    4484             :  * F[2][3]=L, F[3]=f; mfvectomat(vF, n) */
    4485             : static GEN
    4486         630 : mflineardivtomat(long N, GEN vF, long n)
    4487             : {
    4488         630 :   GEN F, M, f, fc, ME, dB, B, a0, V = NULL;
    4489         630 :   long lM, lF = lg(vF), j;
    4490             : 
    4491         630 :   if (lF == 1) return cgetg(1,t_MAT);
    4492         623 :   F = gel(vF,1);
    4493         623 :   if (lg(F) == 5)
    4494             :   { /* chicompat */
    4495         273 :     V = gmael(F,4,4);
    4496         273 :     if (typ(V) == t_INT) V = NULL;
    4497             :   }
    4498         623 :   M = gmael(F,2,2); /* BAS */
    4499         623 :   lM = lg(M);
    4500         623 :   j = mfvec_first_cusp(M);
    4501         623 :   if (j == 1) ME = NULL;
    4502             :   else
    4503             :   { /* BAS starts by Eisenstein */
    4504         161 :     ME = mfvectomat(vecslice(M,1,j-1), n, 1);
    4505         161 :     M = vecslice(M, j,lM-1);
    4506             :   }
    4507         623 :   M = bhnmat_extend_nocache(NULL, N, n, 1, M);
    4508         623 :   if (ME) M = shallowconcat(ME,M);
    4509             :   /* M = mfcoefs of BAS */
    4510         623 :   B = cgetg(lF, t_MAT);
    4511         623 :   dB= cgetg(lF, t_VEC);
    4512        2947 :   for (j = 1; j < lF; j++)
    4513             :   {
    4514        2324 :     GEN g = gel(vF, j); /* t_MF_DIV */
    4515        2324 :     gel(B,j) = RgM_RgC_mul(M, gmael(g,2,3));
    4516        2324 :     gel(dB,j)= gmael(g,2,4);
    4517             :   }
    4518         623 :   f = mfcoefsser(gel(F,3),n);
    4519         623 :   a0 = polcoef_i(f, 0, -1);
    4520         623 :   if (gequal0(a0) || gequal1(a0))
    4521         322 :     a0 = NULL;
    4522             :   else
    4523         301 :     f = gdiv(ser_unscale(f, a0), a0);
    4524         623 :   fc = ginv(f);
    4525        2947 :   for (j = 1; j < lF; j++)
    4526             :   {
    4527        2324 :     pari_sp av = avma;
    4528        2324 :     GEN LISer = RgV_to_ser_full(gel(B,j)), f;
    4529        2324 :     if (a0) LISer = gdiv(ser_unscale(LISer, a0), a0);
    4530        2324 :     f = gmul(LISer, fc);
    4531        2324 :     if (a0) f = ser_unscale(f, ginv(a0));
    4532        2324 :     f = sertocol(f); setlg(f, n+2);
    4533        2324 :     if (!gequal1(gel(dB,j))) f = RgC_Rg_div(f, gel(dB,j));
    4534        2324 :     gel(B,j) = gerepileupto(av,f);
    4535             :   }
    4536         623 :   if (V) B = gmodulo(QabM_tracerel(V, 0, B), gel(V,1));
    4537         623 :   return B;
    4538             : }
    4539             : 
    4540             : static GEN
    4541         350 : mfheckemat_mfcoefs(GEN mf, GEN B, GEN DATA)
    4542             : {
    4543         350 :   GEN Mindex = MF_get_Mindex(mf), Minv = MF_get_Minv(mf);
    4544         350 :   long j, l = lg(B), sb = mfsturm_mf(mf);
    4545         350 :   GEN b = MF_get_basis(mf), Q = cgetg(l, t_VEC);
    4546        1827 :   for (j = 1; j < l; j++)
    4547             :   {
    4548        1477 :     GEN v = hecke_i(sb, 1, gel(B,j), gel(b,j), DATA); /* Tn b[j] */
    4549        1477 :     settyp(v,t_COL); gel(Q,j) = vecpermute(v, Mindex);
    4550             :   }
    4551         350 :   return Minv_RgM_mul(Minv,Q);
    4552             : }
    4553             : /* T_p^2, p prime, 1/2-integral weight; B = mfcoefs(mf,sb*p^2,1) or (mf,sb,p^2)
    4554             :  * if p|N */
    4555             : static GEN
    4556           7 : mfheckemat_mfcoefs_p2(GEN mf, long p, GEN B)
    4557             : {
    4558           7 :   pari_sp av = avma;
    4559           7 :   GEN DATA = heckef2_data(MF_get_N(mf), p*p);
    4560           7 :   return gerepileupto(av, mfheckemat_mfcoefs(mf, B, DATA));
    4561             : }
    4562             : /* convert Mindex from row-index to mfcoef indexation: a(n) is stored in
    4563             :  * mfcoefs()[n+1], so subtract 1 from all indices */
    4564             : static GEN
    4565          49 : Mindex_as_coef(GEN mf)
    4566             : {
    4567          49 :   GEN v, Mindex = MF_get_Mindex(mf);
    4568          49 :   long i, l = lg(Mindex);
    4569          49 :   v = cgetg(l, t_VECSMALL);
    4570         210 :   for (i = 1; i < l; i++) v[i] = Mindex[i]-1;
    4571          49 :   return v;
    4572             : }
    4573             : /* T_p, p prime; B = mfcoefs(mf,sb*p,1) or (mf,sb,p) if p|N; integral weight */
    4574             : static GEN
    4575          35 : mfheckemat_mfcoefs_p(GEN mf, long p, GEN B)
    4576             : {
    4577          35 :   pari_sp av = avma;
    4578          35 :   GEN vm, Q, C, Minv = MF_get_Minv(mf);
    4579          35 :   long lm, k, i, j, l = lg(B), N = MF_get_N(mf);
    4580             : 
    4581          35 :   if (N % p == 0) return Minv_RgM_mul(Minv, rowpermute(B, MF_get_Mindex(mf)));
    4582          21 :   k = MF_get_k(mf);
    4583          21 :   C = gmul(mfchareval(MF_get_CHI(mf), p), powuu(p, k-1));
    4584          21 :   vm = Mindex_as_coef(mf); lm = lg(vm);
    4585          21 :   Q = cgetg(l, t_MAT);
    4586         147 :   for (j = 1; j < l; j++) gel(Q,j) = cgetg(lm, t_COL);
    4587         147 :   for (i = 1; i < lm; i++)
    4588             :   {
    4589         126 :     long m = vm[i], mp = m*p;
    4590         126 :     GEN Cm = (m % p) == 0? C : NULL;
    4591        1260 :     for (j = 1; j < l; j++)
    4592             :     {
    4593        1134 :       GEN S = gel(B,j), s = gel(S, mp + 1);
    4594        1134 :       if (Cm) s = gadd(s, gmul(C, gel(S, m/p + 1)));
    4595        1134 :       gcoeff(Q, i, j) = s;
    4596             :     }
    4597             :   }
    4598          21 :   return gerepileupto(av, Minv_RgM_mul(Minv,Q));
    4599             : }
    4600             : /* Matrix of T(p), p prime, dim(mf) > 0 and integral weight */
    4601             : static GEN
    4602         343 : mfheckemat_p(GEN mf, long p)
    4603             : {
    4604         343 :   pari_sp av = avma;
    4605         343 :   long N = MF_get_N(mf), sb = mfsturm_mf(mf);
    4606         343 :   GEN B = (N % p)? mfcoefs_mf(mf, sb * p, 1): mfcoefs_mf(mf, sb, p);
    4607         343 :   return gerepileupto(av, mfheckemat_mfcoefs(mf, B, hecke_data(N,p)));
    4608             : }
    4609             : 
    4610             : /* mf_NEW != (0), weight > 1, p prime. Use
    4611             :  * T(p) T(j) = T(j*p) + p^{k-1} \chi(p) 1_{p | j, p \nmid N} T(j/p) */
    4612             : static GEN
    4613         889 : mfnewmathecke_p(GEN mf, long p)
    4614             : {
    4615         889 :   pari_sp av = avma;
    4616         889 :   GEN tf, vj = MFnew_get_vj(mf), CHI = MF_get_CHI(mf);
    4617         889 :   GEN Mindex = MF_get_Mindex(mf), Minv = MF_get_Minv(mf);
    4618         889 :   long N = MF_get_N(mf), k = MF_get_k(mf);
    4619         889 :   long i, j, lvj = lg(vj), lim = vj[lvj-1] * p;
    4620         889 :   GEN M, perm, V, need = zero_zv(lim);
    4621         889 :   GEN C = (N % p)? gmul(mfchareval(CHI,p), powuu(p,k-1)): NULL;
    4622         889 :   tf = mftraceform_new(N, k, CHI);
    4623        3815 :   for (i = 1; i < lvj; i++)
    4624             :   {
    4625        2926 :     j = vj[i]; need[j*p] = 1;
    4626        2926 :     if (N % p && j % p == 0) need[j/p] = 1;
    4627             :   }
    4628         889 :   perm = zero_zv(lim);
    4629         889 :   V = cgetg(lim+1, t_VEC);
    4630       12264 :   for (i = j = 1; i <= lim; i++)
    4631       11375 :     if (need[i]) { gel(V,j) = mfhecke_i(i, N, tf); perm[i] = j; j++; }
    4632         889 :   setlg(V, j);
    4633         889 :   V = bhnmat_extend_nocache(NULL, N, mfsturm_mf(mf), 1, V);
    4634         889 :   V = rowpermute(V, Mindex); /* V[perm[i]] = coeffs(T_i newtrace) */
    4635         889 :   M = cgetg(lvj, t_MAT);
    4636        3815 :   for (i = 1; i < lvj; i++)
    4637             :   {
    4638             :     GEN t;
    4639        2926 :     j = vj[i]; t = gel(V, perm[j*p]);
    4640        2926 :     if (C && j % p == 0) t = RgC_add(t, RgC_Rg_mul(gel(V, perm[j/p]),C));
    4641        2926 :     gel(M,i) = t;
    4642             :   }
    4643         889 :   return gerepileupto(av, Minv_RgM_mul(Minv, M));
    4644             : }
    4645             : 
    4646             : GEN
    4647          77 : mfheckemat(GEN mf, GEN vn)
    4648             : {
    4649          77 :   pari_sp av = avma;
    4650          77 :   long lv, lvP, i, N, dim, nk, dk, p, sb, flint = (typ(vn)==t_INT);
    4651             :   GEN CHI, res, vT, FA, B, vP;
    4652             : 
    4653          77 :   mf = checkMF(mf);
    4654          77 :   if (typ(vn) != t_VECSMALL) vn = gtovecsmall(vn);
    4655          77 :   N = MF_get_N(mf); CHI = MF_get_CHI(mf); Qtoss(MF_get_gk(mf), &nk, &dk);
    4656          77 :   dim = MF_get_dim(mf);
    4657          77 :   lv = lg(vn);
    4658          77 :   res = cgetg(lv, t_VEC);
    4659          77 :   FA = cgetg(lv, t_VEC);
    4660          77 :   vP = cgetg(lv, t_VEC);
    4661          77 :   vT = const_vec(vecsmall_max(vn), NULL);
    4662         182 :   for (i = 1; i < lv; i++)
    4663             :   {
    4664         105 :     ulong n = (ulong)labs(vn[i]);
    4665             :     GEN fa;
    4666         105 :     if (!n) pari_err_TYPE("mfheckemat", vn);
    4667         105 :     if (dk == 1 || uissquareall(n, &n)) fa = myfactoru(n);
    4668           0 :     else { n = 0; fa = myfactoru(1); } /* dummy: T_{vn[i]} = 0 */
    4669         105 :     vn[i] = n;
    4670         105 :     gel(FA,i) = fa;
    4671         105 :     gel(vP,i) = gel(fa,1);
    4672             :   }
    4673          77 :   vP = shallowconcat1(vP); vecsmall_sort(vP);
    4674          77 :   vP = vecsmall_uniq_sorted(vP); /* all primes occurring in vn */
    4675          77 :   lvP = lg(vP); if (lvP == 1) goto END;
    4676          56 :   p = vP[lvP-1];
    4677          56 :   sb = mfsturm_mf(mf);
    4678          56 :   if (dk == 1 && nk != 1 && MF_get_space(mf) == mf_NEW)
    4679          21 :     B = NULL; /* special purpose mfnewmathecke_p is faster */
    4680          35 :   else if (lvP == 2 && N % p == 0)
    4681          21 :     B = mfcoefs_mf(mf, sb, dk==2? p*p: p); /* single prime | N, can optimize */
    4682             :   else
    4683          14 :     B = mfcoefs_mf(mf, sb * (dk==2? p*p: p), 1); /* general initialization */
    4684         126 :   for (i = 1; i < lvP; i++)
    4685             :   {
    4686          70 :     long j, l, q, e = 1;
    4687             :     GEN C, Tp, u1, u0;
    4688          70 :     p = vP[i];
    4689         189 :     for (j = 1; j < lv; j++) e = maxss(e, z_lval(vn[j], p));
    4690          70 :     if (!B)
    4691          28 :       Tp = mfnewmathecke_p(mf, p);
    4692          42 :     else if (dk == 2)
    4693           7 :       Tp = mfheckemat_mfcoefs_p2(mf,p, (lvP==2||N%p)? B: matdeflate(sb,p*p,B));
    4694             :     else
    4695          35 :       Tp = mfheckemat_mfcoefs_p(mf, p, (lvP==2||N%p)? B: matdeflate(sb,p,B));
    4696          70 :     gel(vT, p) = Tp;
    4697          70 :     if (e == 1) continue;
    4698          14 :     u0 = gen_1;
    4699          14 :     if (dk == 2)
    4700             :     {
    4701           0 :       C = N % p? gmul(mfchareval(CHI,p*p), powuu(p, nk-2)): NULL;
    4702           0 :       if (e == 2) u0 = uutoQ(p+1,p); /* special case T_{p^4} */
    4703             :     }
    4704             :     else
    4705          14 :       C = N % p? gmul(mfchareval(CHI,p),   powuu(p, nk-1)): NULL;
    4706          28 :     for (u1=Tp, q=p, l=2; l <= e; l++)
    4707             :     { /* u0 = T_{p^{l-2}}, u1 = T_{p^{l-1}} for l > 2 */
    4708          14 :       GEN v = gmul(Tp, u1);
    4709          14 :       if (C) v = gsub(v, gmul(C, u0));
    4710             :       /* q = p^l, vT[q] = T_q for k integer else T_{q^2} */
    4711          14 :       q *= p; u0 = u1; gel(vT, q) = u1 = v;
    4712             :     }
    4713             :   }
    4714          56 : END:
    4715             :   /* vT[p^e] = T_{p^e} for all p^e occurring below */
    4716         182 :   for (i = 1; i < lv; i++)
    4717             :   {
    4718         105 :     long n = vn[i], j, lP;
    4719             :     GEN fa, P, E, M;
    4720         105 :     if (n == 0) { gel(res,i) = zeromat(dim,dim); continue; }
    4721         105 :     if (n == 1) { gel(res,i) = matid(dim); continue; }
    4722          77 :     fa = gel(FA,i);
    4723          77 :     P = gel(fa,1); lP = lg(P);
    4724          77 :     E = gel(fa,2); M = gel(vT, upowuu(P[1], E[1]));
    4725          84 :     for (j = 2; j < lP; j++) M = RgM_mul(M, gel(vT, upowuu(P[j], E[j])));
    4726          77 :     gel(res,i) = M;
    4727             :   }
    4728          77 :   if (flint) res = gel(res,1);
    4729          77 :   return gerepilecopy(av, res);
    4730             : }
    4731             : 
    4732             : /* f = \sum_i v[i] T_listj[i] (Trace Form) attached to v; replace by f/a_1(f) */
    4733             : static GEN
    4734        1470 : mf_normalize(GEN mf, GEN v)
    4735             : {
    4736        1470 :   GEN c, dc = NULL, M = MF_get_M(mf), Mindex = MF_get_Mindex(mf);
    4737        1470 :   v = Q_primpart(v);
    4738        1470 :   c = RgMrow_RgC_mul(M, v, 2); /* a_1(f) */
    4739        1470 :   if (gequal1(c)) return v;
    4740         882 :   if (typ(c) == t_POL) c = gmodulo(c, mfcharpol(MF_get_CHI(mf)));
    4741         882 :   if (typ(c) == t_POLMOD && varn(gel(c,1)) == 1 && degpol(gel(c,1)) >= 40
    4742           7 :                          && Mindex[1] == 2
    4743           7 :                          && mfcharorder(MF_get_CHI(mf)) <= 2)
    4744           7 :   { /* normalize using expansion at infinity (small coefficients) */
    4745           7 :     GEN w, P = gel(c,1), a1 = gel(c,2);
    4746           7 :     long i, l = lg(Mindex);
    4747           7 :     w = cgetg(l, t_COL);
    4748           7 :     gel(w,1) = gen_1;
    4749         280 :     for (i = 2; i < l; i++)
    4750             :     {
    4751         273 :       c = liftpol_shallow(RgMrow_RgC_mul(M, v, Mindex[i]));
    4752         273 :       gel(w,i) = QXQ_div(c, a1, P);
    4753             :     }
    4754             :     /* w = expansion at oo of normalized form */
    4755           7 :     v = Minv_RgC_mul(MF_get_Minv(mf), Q_remove_denom(w, &dc));
    4756           7 :     v = gmodulo(v, P); /* back to mfbasis coefficients */
    4757             :   }
    4758             :   else
    4759             :   {
    4760         875 :     c = ginv(c);
    4761         875 :     if (typ(c) == t_POLMOD) c = Q_remove_denom(c, &dc);
    4762         875 :     v = RgC_Rg_mul(v, c);
    4763             :   }
    4764         882 :   if (dc) v = RgC_Rg_div(v, dc);
    4765         882 :   return v;
    4766             : }
    4767             : static void
    4768         427 : pol_red(GEN NF, GEN *pP, GEN *pa, long flag)
    4769             : {
    4770         427 :   GEN dP, a, P = *pP;
    4771         427 :   long d = degpol(P);
    4772             : 
    4773         427 :   *pa = a = pol_x(varn(P));
    4774         427 :   if (d * (NF ? nf_get_degree(NF): 1) > 30) return;
    4775             : 
    4776         420 :   dP = RgX_disc(P);
    4777         420 :   if (typ(dP) != t_INT)
    4778          98 :   { dP = gnorm(dP); if (typ(dP) != t_INT) pari_err_BUG("mfnewsplit"); }
    4779         420 :   if (d == 2 || expi(dP) < 62)
    4780             :   {
    4781         385 :     if (expi(dP) < 31)
    4782         385 :       P = NF? rnfpolredabs(NF, P,flag): polredabs0(P,flag);
    4783             :     else
    4784           0 :       P = NF? rnfpolredbest(NF,P,flag): polredbest(P,flag);
    4785         385 :     if (flag)
    4786             :     {
    4787         357 :       a = gel(P,2); if (typ(a) == t_POLMOD) a = gel(a,2);
    4788         357 :       P = gel(P,1);
    4789             :     }
    4790             :   }
    4791         420 :   *pP = P;
    4792         420 :   *pa = a;
    4793             : }
    4794             : 
    4795             : /* Diagonalize and normalize. See mfsplit for meaning of flag. */
    4796             : static GEN
    4797        1064 : mfspclean(GEN mf, GEN mf0, GEN NF, long ord, GEN simplesp, long flag)
    4798             : {
    4799        1064 :   const long vz = 1;
    4800        1064 :   long i, l = lg(simplesp), dim = MF_get_dim(mf);
    4801        1064 :   GEN res = cgetg(l, t_MAT), pols = cgetg(l, t_VEC);
    4802        1064 :   GEN zeros = (mf == mf0)? NULL: zerocol(dim - MF_get_dim(mf0));
    4803        2562 :   for (i = 1; i < l; i++)
    4804             :   {
    4805        1498 :     GEN ATP = gel(simplesp, i), A = gel(ATP,1), P = gel(ATP,3);
    4806        1498 :     long d = degpol(P);
    4807        1498 :     GEN a, v = (flag && d > flag)? NULL: gel(A,1);
    4808        1498 :     if (d == 1) P = pol_x(vz);
    4809             :     else
    4810             :     {
    4811         427 :       pol_red(NF, &P, &a, !!v);
    4812         427 :       if (v)
    4813             :       { /* Mod(a,P) root of charpoly(T), K*gpowers(a) = eigenvector of T */
    4814         399 :         GEN K, den, M = cgetg(d+1, t_MAT), T = gel(ATP,2);
    4815             :         long j;
    4816         399 :         T = shallowtrans(T);
    4817         399 :         gel(M,1) = vec_ei(d,1); /* basis of cyclic vectors */
    4818        1302 :         for (j = 2; j <= d; j++) gel(M,j) = RgM_RgC_mul(T, gel(M,j-1));
    4819         399 :         M = Q_primpart(M);
    4820         133 :         K = NF? ZabM_inv(liftpol_shallow(M), nf_get_pol(NF), ord, &den)
    4821         399 :               : ZM_inv(M,&den);
    4822         399 :         K = shallowtrans(K);
    4823         399 :         v = gequalX(a)? pol_x_powers(d, vz): RgXQ_powers(a, d-1, P);
    4824         399 :         v = gmodulo(RgM_RgC_mul(A, RgM_RgC_mul(K,v)), P);
    4825             :       }
    4826             :     }
    4827        1498 :     if (v)
    4828             :     {
    4829        1470 :       v = mf_normalize(mf0, v); if (zeros) v = shallowconcat(zeros,v);
    4830        1470 :       gel(res,i) = v; if (flag) setlg(res,i+1);
    4831             :     }
    4832             :     else
    4833          28 :       gel(res,i) = zerocol(dim);
    4834        1498 :     gel(pols,i) = P;
    4835             :   }
    4836        1064 :   return mkvec2(res, pols);
    4837             : }
    4838             : 
    4839             : /* return v = v_{X-r}(P), and set Z = P / (X-r)^v */
    4840             : static long
    4841          70 : RgX_valrem_root(GEN P, GEN r, GEN *Z)
    4842             : {
    4843             :   long v;
    4844         140 :   for (v = 0; degpol(P); v++)
    4845             :   {
    4846         140 :     GEN t, Q = RgX_div_by_X_x(P, r, &t);
    4847         140 :     if (!gequal0(t)) break;
    4848          70 :     P = Q;
    4849             :   }
    4850          70 :   *Z = P; return v;
    4851             : }
    4852             : static GEN
    4853        1491 : mynffactor(GEN NF, GEN P, long dimlim)
    4854             : {
    4855             :   long i, l, v;
    4856             :   GEN R, E;
    4857        1491 :   if (dimlim != 1)
    4858             :   {
    4859         924 :     R = NF? nffactor(NF, P): QX_factor(P);
    4860         924 :     if (!dimlim) return R;
    4861          21 :     E = gel(R,2);
    4862          21 :     R = gel(R,1); l = lg(R);
    4863          98 :     for (i = 1; i < l; i++)
    4864          91 :       if (degpol(gel(R,i)) > dimlim) break;
    4865          21 :     if (i == 1) return NULL;
    4866          21 :     setlg(E,i);
    4867          21 :     setlg(R,i); return mkmat2(R, E);
    4868             :   }
    4869             :   /* dimlim = 1 */
    4870         567 :   R = nfroots(NF, P); l = lg(R);
    4871         567 :   if (l == 1) return NULL;
    4872         504 :   v = varn(P);
    4873         504 :   settyp(R, t_COL);
    4874         504 :   if (degpol(P) == l-1)
    4875         448 :     E = const_col(l-1, gen_1);
    4876             :   else
    4877             :   {
    4878          56 :     E = cgetg(l, t_COL);
    4879         126 :     for (i = 1; i < l; i++) gel(E,i) = utoi(RgX_valrem_root(P, gel(R,i), &P));
    4880             :   }
    4881         504 :   R = deg1_from_roots(R, v);
    4882         504 :   return mkmat2(R, E);
    4883             : }
    4884             : 
    4885             : /* Let K be a number field attached to NF (Q if NF = NULL). A K-vector
    4886             :  * space of dimension d > 0 is given by a t_MAT A (n x d, full column rank)
    4887             :  * giving a K-basis, X a section (d x n: left pseudo-inverse of A). Return a
    4888             :  * pair (T, fa), where T is an element of the Hecke algebra (a sum of Tp taken
    4889             :  * from vector vTp) acting on A (a d x d t_MAT) and fa is the factorization of
    4890             :  * its characteristic polynomial, limited to factors of degree <= dimlim if
    4891             :  * dimlim != 0 (return NULL if there are no factors of degree <= dimlim) */
    4892             : static GEN
    4893        1316 : findbestsplit(GEN NF, GEN vTp, GEN A, GEN X, long dimlim, long vz)
    4894             : {
    4895        1316 :   GEN T = NULL, Tkeep = NULL, fakeep = NULL;
    4896        1316 :   long lmax = 0, i, lT = lg(vTp);
    4897        1736 :   for (i = 1; i < lT; i++)
    4898             :   {
    4899        1736 :     GEN D, P, E, fa, TpA = gel(vTp,i);
    4900             :     long l;
    4901        2744 :     if (typ(TpA) == t_INT) break;
    4902        1491 :     if (lg(TpA) > lg(A)) TpA = RgM_mul(X, RgM_mul(TpA, A)); /* Tp | A */
    4903        1491 :     T = T ? RgM_add(T, TpA) : TpA;
    4904        1491 :     if (!NF) { P = QM_charpoly_ZX(T); setvarn(P, vz); }
    4905             :     else
    4906             :     {
    4907         273 :       P = charpoly(Q_remove_denom(T, &D), vz);
    4908         273 :       if (D) P = gdiv(RgX_unscale(P, D), powiu(D, degpol(P)));
    4909             :     }
    4910        1491 :     fa = mynffactor(NF, P, dimlim);
    4911        1491 :     if (!fa) return NULL;
    4912        1428 :     E = gel(fa, 2);
    4913             :     /* characteristic polynomial is separable ? */
    4914        1428 :     if (isint1(vecmax(E))) { Tkeep = T; fakeep = fa; break; }
    4915         420 :     l = lg(E);
    4916             :     /* characteristic polynomial has more factors than before ? */
    4917         420 :     if (l > lmax) { lmax = l; Tkeep = T; fakeep = fa; }
    4918             :   }
    4919        1253 :   return mkvec2(Tkeep, fakeep);
    4920             : }
    4921             : 
    4922             : static GEN
    4923         210 : nfcontent(GEN nf, GEN v)
    4924             : {
    4925         210 :   long i, l = lg(v);
    4926         210 :   GEN c = gel(v,1);
    4927        1134 :   for (i = 2; i < l; i++) c = idealadd(nf, c, gel(v,i));
    4928         210 :   if (typ(c) == t_MAT && gequal1(gcoeff(c,1,1))) c = gen_1;
    4929         210 :   return c;
    4930             : }
    4931             : static GEN
    4932         329 : nf_primpart(GEN nf, GEN B)
    4933             : {
    4934         329 :   switch(typ(B))
    4935             :   {
    4936         210 :     case t_COL:
    4937             :     {
    4938         210 :       GEN A = matalgtobasis(nf, B), c = nfcontent(nf, A);
    4939         210 :       if (typ(c) == t_INT) return B;
    4940          21 :       c = idealred_elt(nf,c);
    4941          21 :       A = Q_primpart( nfC_nf_mul(nf, A, Q_primpart(nfinv(nf,c))) );
    4942          21 :       A = liftpol_shallow( matbasistoalg(nf, A) );
    4943          21 :       if (gexpo(A) > gexpo(B)) A = B;
    4944          21 :       return A;
    4945             :     }
    4946         119 :     case t_MAT:
    4947             :     {
    4948             :       long i, l;
    4949         119 :       GEN A = cgetg_copy(B, &l);
    4950         329 :       for (i = 1; i < l; i++) gel(A,i) = nf_primpart(nf, gel(B,i));
    4951         119 :       return A;
    4952             :     }
    4953           0 :     default:
    4954           0 :       pari_err_TYPE("nf_primpart", B);
    4955             :       return NULL; /*LCOV_EXCL_LINE*/
    4956             :   }
    4957             : }
    4958             : 
    4959             : /* rotate entries of v to accomodate new entry 'x' (push out oldest entry) */
    4960             : static void
    4961        1204 : vecpush(GEN v, GEN x)
    4962             : {
    4963             :   long i;
    4964        6020 :   for (i = lg(v)-1; i > 1; i--) gel(v,i) = gel(v,i-1);
    4965        1204 :   gel(v,1) = x;
    4966        1204 : }
    4967             : 
    4968             : /* sort t_VEC of vector spaces by increasing dimension */
    4969             : static GEN
    4970        1064 : sort_by_dim(GEN v)
    4971             : {
    4972        1064 :   long i, l = lg(v);
    4973        1064 :   GEN D = cgetg(l, t_VECSMALL);
    4974        2562 :   for (i = 1; i < l; i++) D[i] = lg(gmael(v,i,2));
    4975        1064 :   return vecpermute(v , vecsmall_indexsort(D));
    4976             : }
    4977             : static GEN
    4978        1064 : split_starting_space(GEN mf)
    4979             : {
    4980        1064 :   long d = MF_get_dim(mf), d2;
    4981        1064 :   GEN id = matid(d);
    4982        1064 :   switch(MF_get_space(mf))
    4983             :   {
    4984        1057 :     case mf_NEW:
    4985        1057 :     case mf_CUSP: return mkvec2(id, id);
    4986             :   }
    4987           7 :   d2 = lg(MF_get_S(mf))-1;
    4988           7 :   return mkvec2(vecslice(id, d-d2+1,d),
    4989             :                 shallowconcat(zeromat(d2,d-d2),matid(d2)));
    4990             : }
    4991             : /* If dimlim > 0, keep only the dimension <= dimlim eigenspaces.
    4992             :  * See mfsplit for the meaning of flag. */
    4993             : static GEN
    4994        1463 : split_ii(GEN mf, long dimlim, long flag, GEN vSP, long *pnewd)
    4995             : {
    4996             :   forprime_t iter;
    4997        1463 :   GEN CHI = MF_get_CHI(mf), empty = cgetg(1, t_VEC), mf0 = mf;
    4998             :   GEN NF, POLCYC, todosp, Tpbigvec, simplesp;
    4999        1463 :   long N = MF_get_N(mf), k = MF_get_k(mf);
    5000        1463 :   long ord, FC, NEWT, dimsimple = 0, newd = -1;
    5001        1463 :   const long NBH = 5, vz = 1;
    5002             :   ulong p;
    5003             : 
    5004        1463 :   switch(MF_get_space(mf))
    5005             :   {
    5006        1176 :     case mf_NEW: break;
    5007         280 :     case mf_CUSP:
    5008             :     case mf_FULL:
    5009             :     {
    5010             :       GEN CHIP;
    5011         280 :       if (k > 1) { mf0 = mfinittonew(mf); break; }
    5012         259 :       CHIP = mfchartoprimitive(CHI, NULL);
    5013         259 :       newd = lg(MF_get_S(mf))-1 - mfolddim_i(N, k, CHIP, vSP);
    5014         259 :       break;
    5015             :     }
    5016           7 :     default: pari_err_TYPE("mfsplit [space does not contain newspace]", mf);
    5017             :       return NULL; /*LCOV_EXCL_LINE*/
    5018             :   }
    5019        1456 :   if (newd < 0) newd = mf0? MF_get_dim(mf0): 0;
    5020        1456 :   *pnewd = newd;
    5021        1456 :   if (!newd) return mkvec2(cgetg(1, t_MAT), empty);
    5022             : 
    5023        1064 :   NEWT = (k > 1 && MF_get_space(mf0) == mf_NEW);
    5024        1064 :   todosp = mkvec( split_starting_space(mf0) );
    5025        1064 :   simplesp = empty;
    5026        1064 :   FC = mfcharconductor(CHI);
    5027        1064 :   ord = mfcharorder(CHI);
    5028        1064 :   if (ord <= 2) NF = POLCYC = NULL;
    5029             :   else
    5030             :   {
    5031         203 :     POLCYC = mfcharpol(CHI);
    5032         203 :     NF = nfinit(POLCYC,DEFAULTPREC);
    5033             :   }
    5034        1064 :   Tpbigvec = zerovec(NBH);
    5035        1064 :   u_forprime_init(&iter, 2, ULONG_MAX);
    5036        1491 :   while (dimsimple < newd && (p = u_forprime_next(&iter)))
    5037             :   {
    5038             :     GEN nextsp;
    5039             :     long ind;
    5040        1491 :     if (N % (p*p) == 0 && N/p % FC == 0) continue; /* T_p = 0 in this case */
    5041        1204 :     vecpush(Tpbigvec, NEWT? mfnewmathecke_p(mf0,p): mfheckemat_p(mf0,p));
    5042        1204 :     nextsp = empty;
    5043        1589 :     for (ind = 1; ind < lg(todosp); ind++)
    5044             :     {
    5045        1316 :       GEN tmp = gel(todosp, ind), fa, P, E, D, Tp, DTp;
    5046        1316 :       GEN A = gel(tmp, 1);
    5047        1316 :       GEN X = gel(tmp, 2);
    5048             :       long lP, i;
    5049        1316 :       tmp = findbestsplit(NF, Tpbigvec, A, X, dimlim, vz);
    5050        1435 :       if (!tmp) continue; /* nothing there */
    5051        1253 :       Tp = gel(tmp, 1);
    5052        1253 :       fa = gel(tmp, 2);
    5053        1253 :       P = gel(fa, 1);
    5054        1253 :       E = gel(fa, 2); lP = lg(P);
    5055             :       /* lP > 1 */
    5056        1253 :       if (DEBUGLEVEL) err_printf("Exponents = %Ps\n", E);
    5057        1253 :       if (lP == 2)
    5058             :       {
    5059         861 :         GEN P1 = gel(P,1);
    5060         861 :         long e1 = itos(gel(E,1)), d1 = degpol(P1);
    5061         861 :         if (e1 * d1 == lg(Tp)-1)
    5062             :         {
    5063         812 :           if (e1 > 1) nextsp = vec_append(nextsp, mkvec2(A,X));
    5064             :           else
    5065             :           { /* simple module */
    5066         714 :             simplesp = vec_append(simplesp, mkvec3(A,Tp,P1));
    5067         952 :             if ((dimsimple += d1) == newd) goto END;
    5068             :           }
    5069         119 :           continue;
    5070             :         }
    5071             :       }
    5072             :       /* Found splitting */
    5073         441 :       DTp = Q_remove_denom(Tp, &D);
    5074        1204 :       for (i = 1; i < lP; i++)
    5075             :       {
    5076        1001 :         GEN Ai, Xi, dXi, AAi, v, y, Pi = gel(P,i);
    5077        1001 :         Ai = RgX_RgM_eval(D? RgX_rescale(Pi,D): Pi, DTp);
    5078        1001 :         Ai = QabM_ker(Ai, POLCYC, ord);
    5079        1001 :         if (NF) Ai = nf_primpart(NF, Ai);
    5080             : 
    5081        1001 :         AAi = RgM_mul(A, Ai);
    5082             :         /* gives section, works on nonsquare matrices */
    5083        1001 :         Xi = QabM_pseudoinv(Ai, POLCYC, ord, &v, &dXi);
    5084        1001 :         Xi = RgM_Rg_div(Xi, dXi);
    5085        1001 :         y = gel(v,1);
    5086        1001 :         if (isint1(gel(E,i)))
    5087             :         {
    5088         784 :           GEN Tpi = RgM_mul(Xi, RgM_mul(rowpermute(Tp,y), Ai));
    5089         784 :           simplesp = vec_append(simplesp, mkvec3(AAi, Tpi, Pi));
    5090         784 :           if ((dimsimple += degpol(Pi)) == newd) goto END;
    5091             :         }
    5092             :         else
    5093             :         {
    5094         217 :           Xi = RgM_mul(Xi, rowpermute(X,y));
    5095         217 :           nextsp = vec_append(nextsp, mkvec2(AAi, Xi));
    5096             :         }
    5097             :       }
    5098             :     }
    5099         273 :     todosp = nextsp; if (lg(todosp) == 1) break;
    5100             :   }
    5101           0 : END:
    5102        1064 :   if (DEBUGLEVEL) err_printf("end split, need to clean\n");
    5103        1064 :   return mfspclean(mf, mf0, NF, ord, sort_by_dim(simplesp), flag);
    5104             : }
    5105             : static GEN
    5106          28 : dim_filter(GEN v, long dim)
    5107             : {
    5108          28 :   GEN P = gel(v,2);
    5109          28 :   long j, l = lg(P);
    5110         140 :   for (j = 1; j < l; j++)
    5111         126 :     if (degpol(gel(P,j)) > dim)
    5112             :     {
    5113          14 :       v = mkvec2(vecslice(gel(v,1),1,j-1), vecslice(P,1,j-1));
    5114          14 :       break;
    5115             :     }
    5116          28 :   return v;
    5117             : }
    5118             : static long
    5119         287 : dim_sum(GEN v)
    5120             : {
    5121         287 :   GEN P = gel(v,2);
    5122         287 :   long j, l = lg(P), d = 0;
    5123         707 :   for (j = 1; j < l; j++) d += degpol(gel(P,j));
    5124         287 :   return d;
    5125             : }
    5126             : static GEN
    5127        1141 : split_i(GEN mf, long dimlim, long flag)
    5128        1141 : { long junk; return split_ii(mf, dimlim, flag, NULL, &junk); }
    5129             : /* mf is either already split or output by mfinit. Splitting is done only for
    5130             :  * newspace except in weight 1. If flag = 0 (default) split completely.
    5131             :  * If flag = d > 0, only give the Galois polynomials in degree > d
    5132             :  * Flag is ignored if dimlim = 1. */
    5133             : GEN
    5134          98 : mfsplit(GEN mf0, long dimlim, long flag)
    5135             : {
    5136          98 :   pari_sp av = avma;
    5137          98 :   GEN v, mf = checkMF_i(mf0);
    5138          98 :   if (!mf) pari_err_TYPE("mfsplit", mf0);
    5139          98 :   if ((v = obj_check(mf, MF_SPLIT)))
    5140          28 :   { if (dimlim) v = dim_filter(v, dimlim); }
    5141          70 :   else if (dimlim && (v = obj_check(mf, MF_SPLITN)))
    5142          21 :   { v = (itos(gel(v,1)) >= dimlim)? dim_filter(gel(v,2), dimlim): NULL; }
    5143          98 :   if (!v)
    5144             :   {
    5145             :     long newd;
    5146          70 :     v = split_ii(mf, dimlim, flag, NULL, &newd);
    5147          70 :     if (lg(v) == 1) obj_insert(mf, MF_SPLITN, mkvec2(utoi(dimlim), v));
    5148          70 :     else if (!flag)
    5149             :     {
    5150          49 :       if (dim_sum(v) == newd) obj_insert(mf, MF_SPLIT,v);
    5151          21 :       else obj_insert(mf, MF_SPLITN, mkvec2(utoi(dimlim), v));
    5152             :     }
    5153             :   }
    5154          98 :   return gerepilecopy(av, v);
    5155             : }
    5156             : static GEN
    5157         224 : split(GEN mf) { return split_i(mf,0,0); }
    5158             : GEN
    5159         770 : MF_get_newforms(GEN mf) { return gel(obj_checkbuild(mf,MF_SPLIT,&split),1); }
    5160             : GEN
    5161         581 : MF_get_fields(GEN mf) { return gel(obj_checkbuild(mf,MF_SPLIT,&split),2); }
    5162             : 
    5163             : /*************************************************************************/
    5164             : /*                     Modular forms of Weight 1                         */
    5165             : /*************************************************************************/
    5166             : /* S_1(G_0(N)), small N. Return 1 if definitely empty; return 0 if maybe
    5167             :  * nonempty  */
    5168             : static int
    5169       16632 : wt1empty(long N)
    5170             : {
    5171       16632 :   if (N <= 100) switch (N)
    5172             :   { /* nonempty [32/100] */
    5173        5453 :     case 23: case 31: case 39: case 44: case 46:
    5174             :     case 47: case 52: case 55: case 56: case 57:
    5175             :     case 59: case 62: case 63: case 68: case 69:
    5176             :     case 71: case 72: case 76: case 77: case 78:
    5177             :     case 79: case 80: case 83: case 84: case 87:
    5178             :     case 88: case 92: case 93: case 94: case 95:
    5179        5453 :     case 99: case 100: return 0;
    5180        3549 :     default: return 1;
    5181             :   }
    5182        7630 :   if (N <= 600) switch(N)
    5183             :   { /* empty [111/500] */
    5184         336 :     case 101: case 102: case 105: case 106: case 109:
    5185             :     case 113: case 121: case 122: case 123: case 125:
    5186             :     case 130: case 134: case 137: case 146: case 149:
    5187             :     case 150: case 153: case 157: case 162: case 163:
    5188             :     case 169: case 170: case 173: case 178: case 181:
    5189             :     case 182: case 185: case 187: case 193: case 194:
    5190             :     case 197: case 202: case 205: case 210: case 218:
    5191             :     case 221: case 226: case 233: case 241: case 242:
    5192             :     case 245: case 246: case 250: case 257: case 265:
    5193             :     case 267: case 269: case 274: case 277: case 281:
    5194             :     case 289: case 293: case 298: case 305: case 306:
    5195             :     case 313: case 314: case 317: case 326: case 337:
    5196             :     case 338: case 346: case 349: case 353: case 361:
    5197             :     case 362: case 365: case 369: case 370: case 373:
    5198             :     case 374: case 377: case 386: case 389: case 394:
    5199             :     case 397: case 401: case 409: case 410: case 421:
    5200             :     case 425: case 427: case 433: case 442: case 449:
    5201             :     case 457: case 461: case 466: case 481: case 482:
    5202             :     case 485: case 490: case 493: case 509: case 514:
    5203             :     case 521: case 530: case 533: case 534: case 538:
    5204             :     case 541: case 545: case 554: case 557: case 562:
    5205             :     case 565: case 569: case 577: case 578: case 586:
    5206         336 :     case 593: return 1;
    5207        6979 :     default: return 0;
    5208             :   }
    5209         315 :   return 0;
    5210             : }
    5211             : 
    5212             : static GEN
    5213          28 : initwt1trace(GEN mf)
    5214             : {
    5215          28 :   GEN S = MF_get_S(mf), v, H;
    5216             :   long l, i;
    5217          28 :   if (lg(S) == 1) return mftrivial();
    5218          28 :   H = mfheckemat(mf, Mindex_as_coef(mf));
    5219          28 :   l = lg(H); v = cgetg(l, t_VEC);
    5220          63 :   for (i = 1; i < l; i++) gel(v,i) = gtrace(gel(H,i));
    5221          28 :   v = Minv_RgC_mul(MF_get_Minv(mf), v);
    5222          28 :   return mflineardiv_linear(S, v, 1);
    5223             : }
    5224             : static GEN
    5225          21 : initwt1newtrace(GEN mf)
    5226             : {
    5227          21 :   GEN v, D, S, Mindex, CHI = MF_get_CHI(mf);
    5228          21 :   long FC, lD, i, sb, N1, N2, lM, N = MF_get_N(mf);
    5229          21 :   CHI = mfchartoprimitive(CHI, &FC);
    5230          21 :   if (N % FC || mfcharparity(CHI) == 1) return mftrivial();
    5231          21 :   D = mydivisorsu(N/FC); lD = lg(D);
    5232          21 :   S = MF_get_S(mf);
    5233          21 :   if (lg(S) == 1) return mftrivial();
    5234          21 :   N2 = newd_params2(N);
    5235          21 :   N1 = N / N2;
    5236          21 :   Mindex = MF_get_Mindex(mf);
    5237          21 :   lM = lg(Mindex);
    5238          21 :   sb = Mindex[lM-1];
    5239          21 :   v = zerovec(sb+1);
    5240          42 :   for (i = 1; i < lD; i++)
    5241             :   {
    5242          21 :     long M = FC*D[i], j;
    5243          21 :     GEN tf = initwt1trace(M == N? mf: mfinit_Nkchi(M, 1, CHI, mf_CUSP, 0));
    5244             :     GEN listd, w;
    5245          21 :     if (mf_get_type(tf) == t_MF_CONST) continue;
    5246          21 :     w = mfcoefs_i(tf, sb, 1);
    5247          21 :     if (M == N) { v = gadd(v, w); continue; }
    5248           0 :     listd = mydivisorsu(u_ppo(ugcd(N/M, N1), FC));
    5249           0 :     for (j = 1; j < lg(listd); j++)
    5250             :     {
    5251           0 :       long d = listd[j], d2 = d*d; /* coprime to FC */
    5252           0 :       GEN dk = mfchareval(CHI, d);
    5253           0 :       long NMd = N/(M*d), m;
    5254           0 :       for (m = 1; m <= sb/d2; m++)
    5255             :       {
    5256           0 :         long be = mubeta2(NMd, m);
    5257           0 :         if (be)
    5258             :         {
    5259           0 :           GEN c = gmul(dk, gmulsg(be, gel(w, m+1)));
    5260           0 :           long n = m*d2;
    5261           0 :           gel(v, n+1) = gadd(gel(v, n+1), c);
    5262             :         }
    5263             :       }
    5264             :     }
    5265             :   }
    5266          21 :   if (gequal0(gel(v,2))) return mftrivial();
    5267          21 :   v = vecpermute(v,Mindex);
    5268          21 :   v = Minv_RgC_mul(MF_get_Minv(mf), v);
    5269          21 :   return mflineardiv_linear(S, v, 1);
    5270             : }
    5271             : 
    5272             : /* i*p + 1, i*p < lim corresponding to a_p(f_j), a_{2p}(f_j)...  */
    5273             : static GEN
    5274        1834 : pindices(long p, long lim)
    5275             : {
    5276        1834 :   GEN v = cgetg(lim, t_VECSMALL);
    5277             :   long i, ip;
    5278       22190 :   for (i = 1, ip = p + 1; ip < lim; i++, ip += p) v[i] = ip;
    5279        1834 :   setlg(v, i); return v;
    5280             : }
    5281             : 
    5282             : /* assume !wt1empty(N), in particular N>25 */
    5283             : /* Returns [[lim,p], mf (weight 2), p*lim x dim matrix] */
    5284             : static GEN
    5285        1834 : mf1_pre(long N)
    5286             : {
    5287             :   pari_timer tt;
    5288             :   GEN mf, v, L, I, M, Minv, den;
    5289             :   long B, lim, LIM, p;
    5290             : 
    5291        1834 :   if (DEBUGLEVEL) timer_start(&tt);
    5292        1834 :   mf = mfinit_Nkchi(N, 2, mfchartrivial(), mf_CUSP, 0);
    5293        1834 :   if (DEBUGLEVEL)
    5294           0 :     timer_printf(&tt, "mf1basis [pre]: S_2(%ld), dim = %ld",
    5295             :                  N, MF_get_dim(mf));
    5296        1834 :   M = MF_get_M(mf); Minv = MF_get_Minv(mf); den = gel(Minv,2);
    5297        1834 :   B = mfsturm_mf(mf);
    5298        1834 :   if (uisprime(N))
    5299             :   {
    5300         392 :     lim = 2 * MF_get_dim(mf); /* ensure mfstabiter's first kernel ~ square */
    5301         392 :     p = 2;
    5302             :   }
    5303             :   else
    5304             :   {
    5305             :     forprime_t S;
    5306        1442 :     u_forprime_init(&S, 2, N);
    5307        2576 :     while ((p = u_forprime_next(&S)))
    5308        2576 :       if (N % p) break;
    5309        1442 :     lim = B + 1;
    5310             :   }
    5311        1834 :   LIM = (N & (N - 1))? 2 * lim: 3 * lim; /* N power of 2 ? */
    5312        1834 :   L = mkvecsmall4(lim, LIM, mfsturmNk(N,1), p);
    5313        1834 :   M = bhnmat_extend_nocache(M, N, LIM-1, 1, MF_get_S(mf));
    5314        1834 :   if (DEBUGLEVEL) timer_printf(&tt, "mf1basis [pre]: bnfmat_extend");
    5315        1834 :   v = pindices(p, LIM);
    5316        1834 :   if (!LIM) return mkvec4(L, mf, M, v);
    5317        1834 :   I = RgM_Rg_div(ZM_mul(rowslice(M, B+2, LIM), gel(Minv,1)), den);
    5318        1834 :   I = Q_remove_denom(I, &den);
    5319        1834 :   if (DEBUGLEVEL) timer_printf(&tt, "mf1basis [prec]: Iden");
    5320        1834 :   return mkvec5(L, mf, M, v, mkvec2(I, den));
    5321             : }
    5322             : 
    5323             : /* lg(A) > 1, E a t_POL */
    5324             : static GEN
    5325         686 : mfmatsermul(GEN A, GEN E)
    5326             : {
    5327         686 :   long j, l = lg(A), r = nbrows(A);
    5328         686 :   GEN M = cgetg(l, t_MAT);
    5329         686 :   E = RgXn_red_shallow(E, r+1);
    5330        5866 :   for (j = 1; j < l; j++)
    5331             :   {
    5332        5180 :     GEN c = RgV_to_RgX(gel(A,j), 0);
    5333        5180 :     gel(M, j) = RgX_to_RgC(RgXn_mul(c, E, r+1), r);
    5334             :   }
    5335         686 :   return M;
    5336             : }
    5337             : /* lg(Ap) > 1, Ep an Flxn */
    5338             : static GEN
    5339        1141 : mfmatsermul_Fl(GEN Ap, GEN Ep, ulong p)
    5340             : {
    5341        1141 :   long j, l = lg(Ap), r = nbrows(Ap);
    5342        1141 :   GEN M = cgetg(l, t_MAT);
    5343       42630 :   for (j = 1; j < l; j++)
    5344             :   {
    5345       41489 :     GEN c = Flv_to_Flx(gel(Ap,j), 0);
    5346       41489 :     gel(M,j) = Flx_to_Flv(Flxn_mul(c, Ep, r+1, p), r);
    5347             :   }
    5348        1141 :   return M;
    5349             : }
    5350             : 
    5351             : /* CHI mod F | N, return mfchar of modulus N.
    5352             :  * FIXME: wasteful, G should be precomputed  */
    5353             : static GEN
    5354       13048 : mfcharinduce(GEN CHI, long N)
    5355             : {
    5356             :   GEN G, chi;
    5357       13048 :   if (mfcharmodulus(CHI) == N) return CHI;
    5358        1463 :   G = znstar0(utoipos(N), 1);
    5359        1463 :   chi = zncharinduce(gel(CHI,1), gel(CHI,2), G);
    5360        1463 :   CHI = leafcopy(CHI);
    5361        1463 :   gel(CHI,1) = G;
    5362        1463 :   gel(CHI,2) = chi; return CHI;
    5363             : }
    5364             : 
    5365             : static GEN
    5366        3983 : gmfcharno(GEN CHI)
    5367             : {
    5368        3983 :   GEN G = gel(CHI,1), chi = gel(CHI,2);
    5369        3983 :   return mkintmod(znconreyexp(G, chi), znstar_get_N(G));
    5370             : }
    5371             : static long
    5372       13664 : mfcharno(GEN CHI)
    5373             : {
    5374       13664 :   GEN n = znconreyexp(gel(CHI,1), gel(CHI,2));
    5375       13664 :   return itou(n);
    5376             : }
    5377             : 
    5378             : /* return k such that minimal mfcharacter in Galois orbit of CHI is CHI^k */
    5379             : static long
    5380       12138 : mfconreyminimize(GEN CHI)
    5381             : {
    5382       12138 :   GEN G = gel(CHI,1), cyc, chi;
    5383       12138 :   cyc = ZV_to_zv(znstar_get_cyc(G));
    5384       12138 :   chi = ZV_to_zv(znconreychar(G, gel(CHI,2)));
    5385       12138 :   return zv_cyc_minimize(cyc, chi, coprimes_zv(mfcharorder(CHI)));
    5386             : }
    5387             : 
    5388             : /* find scalar c such that first nonzero entry of c*v is 1; return c*v */
    5389             : static GEN
    5390        2065 : RgV_normalize(GEN v, GEN *pc)
    5391             : {
    5392        2065 :   long i, l = lg(v);
    5393        5313 :   for (i = 1; i < l; i++)
    5394             :   {
    5395        5313 :     GEN c = gel(v,i);
    5396        5313 :     if (!gequal0(c))
    5397             :     {
    5398        2065 :       if (gequal1(c)) break;
    5399         679 :       *pc = ginv(c); return RgV_Rg_mul(v, *pc);
    5400             :     }
    5401             :   }
    5402        1386 :   *pc = gen_1; return v;
    5403             : }
    5404             : /* pS != NULL; dim > 0 */
    5405             : static GEN
    5406         784 : mftreatdihedral(long N, GEN DIH, GEN POLCYC, long ordchi, GEN *pS)
    5407             : {
    5408         784 :   long l = lg(DIH), lim = mfsturmNk(N, 1), i;
    5409         784 :   GEN Minv, C = cgetg(l, t_VEC), M = cgetg(l, t_MAT);
    5410        2436 :   for (i = 1; i < l; i++)
    5411             :   {
    5412        1652 :     GEN c, v = mfcoefs_i(gel(DIH,i), lim, 1);
    5413        1652 :     gel(M,i) = RgV_normalize(v, &c);
    5414        1652 :     gel(C,i) = Rg_col_ei(c, l-1, i);
    5415             :   }
    5416         784 :   Minv = gel(mfclean(M,POLCYC,ordchi,0),2);
    5417         784 :   M = RgM_Minv_mul(M, Minv);
    5418         784 :   C = RgM_Minv_mul(C, Minv);
    5419         784 :   *pS = vecmflinear(DIH, C); return M;
    5420             : }
    5421             : 
    5422             : /* same mode a maximal ideal above q */
    5423             : static GEN
    5424        2408 : Tpmod(GEN Ap, GEN A, ulong chip, long p, ulong q)
    5425             : {
    5426        2408 :   GEN B = leafcopy(Ap);
    5427        2408 :   long i, ip, l = lg(B);
    5428       86345 :   for (i = 1, ip = p; ip < l; i++, ip += p)
    5429       83937 :     B[ip] = Fl_add(B[ip], Fl_mul(A[i], chip, q), q);
    5430        2408 :   return B;
    5431             : }
    5432             : /* Tp(f_1), ..., Tp(f_d) mod q */
    5433             : static GEN
    5434         301 : matTpmod(GEN Ap, GEN A, ulong chip, long p, ulong q)
    5435             : {
    5436             :   long i, l;
    5437         301 :   GEN B = cgetg_copy(A, &l);
    5438        2709 :   for (i = 1; i < l; i++) gel(B,i) = Tpmod(gel(Ap,i), gel(A,i), chip, p, q);
    5439         301 :   return B;
    5440             : }
    5441             : 
    5442             : /* Ap[i] = a_{p*i}(F), A[i] = a_i(F), i = 1..lim
    5443             :  * Tp(f)[n] = a_{p*n}(f) + chi(p) a_{n/p}(f) * 1_{p | n} */
    5444             : static GEN
    5445         469 : Tp(GEN Ap, GEN A, GEN chip, long p)
    5446             : {
    5447         469 :   GEN B = leafcopy(Ap);
    5448         469 :   long i, ip, l = lg(B);
    5449       12915 :   for (i = 1, ip = p; ip < l; i++, ip += p)
    5450       12446 :     gel(B,ip) = gadd(gel(B,ip), gmul(gel(A,i), chip));
    5451         469 :   return B;
    5452             : }
    5453             : /* Tp(f_1), ..., Tp(f_d) mod q */
    5454             : static GEN
    5455          56 : matTp(GEN Ap, GEN A, GEN chip, long p)
    5456             : {
    5457             :   long i, l;
    5458          56 :   GEN B = cgetg_copy(A, &l);
    5459         525 :   for (i = 1; i < l; i++) gel(B,i) = Tp(gel(Ap,i), gel(A,i), chip, p);
    5460          56 :   return B;
    5461             : }
    5462             : 
    5463             : static GEN
    5464         378 : _RgXQM_mul(GEN x, GEN y, GEN T)
    5465         378 : { return T? RgXQM_mul(x, y, T): RgM_mul(x, y); }
    5466             : /* largest T-stable Q(CHI)-subspace of Q(CHI)-vector space spanned by columns
    5467             :  * of A */
    5468             : static GEN
    5469          28 : mfstabiter(GEN *pC, GEN A0, GEN chip, GEN TMP, GEN P, long ordchi)
    5470             : {
    5471          28 :   GEN A, Ap, vp = gel(TMP,4), C = NULL;
    5472          28 :   long i, lA, lim1 = gel(TMP,1)[3], p = gel(TMP,1)[4];
    5473             :   pari_timer tt;
    5474             : 
    5475          28 :   Ap = rowpermute(A0, vp);
    5476          28 :   A = rowslice(A0, 2, nbrows(Ap)+1); /* remove a0 */
    5477             :   for(;;)
    5478          28 :   {
    5479          56 :     GEN R = shallowconcat(matTp(Ap, A, chip, p), A);
    5480          56 :     GEN B = QabM_ker(R, P, ordchi);
    5481          56 :     long lB = lg(B);
    5482          56 :     if (DEBUGLEVEL)
    5483           0 :       timer_printf(&tt, "mf1basis: Hecke intersection (dim %ld)", lB-1);
    5484          56 :     if (lB == 1) return NULL;
    5485          56 :     lA = lg(A); if (lB == lA) break;
    5486          28 :     B = rowslice(B, 1, lA-1);
    5487          28 :     Ap = _RgXQM_mul(Ap, B, P);
    5488          28 :     A = _RgXQM_mul(A, B, P);
    5489          28 :     C = C? _RgXQM_mul(C, B, P): B;
    5490             :   }
    5491          28 :   if (nbrows(A) < lim1)
    5492             :   {
    5493          14 :     A0 = rowslice(A0, 2, lim1);
    5494          14 :     A = C? _RgXQM_mul(A0, C, P): A0;
    5495             :   }
    5496             :   else /* all needed coefs computed */
    5497          14 :     A = rowslice(A, 1, lim1-1);
    5498          28 :   if (*pC) C = C? _RgXQM_mul(*pC, C, P): *pC;
    5499             :   /* put back a0 */
    5500         119 :   for (i = 1; i < lA; i++) gel(A,i) = vec_prepend(gel(A,i), gen_0);
    5501          28 :   *pC = C; return A;
    5502             : }
    5503             : 
    5504             : static long
    5505         252 : mfstabitermod(GEN A, GEN vp, ulong chip, long p, ulong q)
    5506             : {
    5507         252 :   GEN Ap, C = NULL;
    5508         252 :   Ap = rowpermute(A, vp);
    5509         252 :   A = rowslice(A, 2, nbrows(Ap)+1);
    5510             :   while (1)
    5511          49 :   {
    5512         301 :     GEN Rp = shallowconcat(matTpmod(Ap, A, chip, p, q), A);
    5513         301 :     GEN B = Flm_ker(Rp, q);
    5514         301 :     long lA = lg(A), lB = lg(B);
    5515         301 :     if (lB == 1) return 0;
    5516         266 :     if (lB == lA) return lA-1;
    5517          49 :     B = rowslice(B, 1, lA-1);
    5518          49 :     Ap = Flm_mul(Ap, B, q);
    5519          49 :     A = Flm_mul(A, B, q);
    5520          49 :     C = C? Flm_mul(C, B, q): B;
    5521             :   }
    5522             : }
    5523             : 
    5524             : static GEN
    5525         595 : mfcharinv_i(GEN CHI)
    5526             : {
    5527         595 :   GEN G = gel(CHI,1);
    5528         595 :   CHI = leafcopy(CHI); gel(CHI,2) =  zncharconj(G, gel(CHI,2)); return CHI;
    5529             : }
    5530             : 
    5531             : /* upper bound dim S_1(Gamma_0(N),chi) performing the linear algebra mod p */
    5532             : static long
    5533         595 : mf1dimmod(GEN E1, GEN E, GEN chip, long ordchi, long dih, GEN TMP)
    5534             : {
    5535         595 :   GEN E1i, A, vp, mf, C = NULL;
    5536         595 :   ulong q, r = QabM_init(ordchi, &q);
    5537             :   long lim, LIM, p;
    5538             : 
    5539         595 :   LIM = gel(TMP,1)[2]; lim = gel(TMP,1)[1];
    5540         595 :   mf= gel(TMP,2);
    5541         595 :   A = gel(TMP,3);
    5542         595 :   A = QabM_to_Flm(A, r, q);
    5543         595 :   E1 = QabX_to_Flx(E1, r, q);
    5544         595 :   E1i = Flxn_inv(E1, nbrows(A), q);
    5545         595 :   if (E)
    5546             :   {
    5547         574 :     GEN Iden = gel(TMP,5), I = gel(Iden,1), den = gel(Iden,2);
    5548         574 :     GEN Mindex = MF_get_Mindex(mf), F = rowslice(A, 1, LIM);
    5549         574 :     GEN E1ip = Flxn_red(E1i, LIM);
    5550         574 :     ulong d = den? umodiu(den, q): 1;
    5551         574 :     long i, nE = lg(E) - 1;
    5552             :     pari_sp av;
    5553             : 
    5554         574 :     I = ZM_to_Flm(I, q);
    5555         574 :     if (d != 1) I = Flm_Fl_mul(I, Fl_inv(d, q), q);
    5556         574 :     av = avma;
    5557        1120 :     for (i = 1; i <= nE; i++)
    5558             :     {
    5559         889 :       GEN e = Flxn_mul(E1ip, QabX_to_Flx(gel(E,i), r, q), LIM, q);
    5560         889 :       GEN B = mfmatsermul_Fl(F, e, q), z;
    5561         889 :       GEN B2 = Flm_mul(I, rowpermute(B, Mindex), q);
    5562         889 :       B = rowslice(B, lim+1,LIM);
    5563         889 :       z = Flm_ker(Flm_sub(B2, B, q), q);
    5564         889 :       if (lg(z)-1 == dih) return dih;
    5565         546 :       C = C? Flm_mul(C, z, q): z;
    5566         546 :       F = Flm_mul(F, z, q);
    5567         546 :       gerepileall(av, 2, &F,&C);
    5568             :     }
    5569         231 :     A = F;
    5570             :   }
    5571             :   /* use Schaeffer */
    5572         252 :   p = gel(TMP,1)[4]; vp = gel(TMP,4);
    5573         252 :   A = mfmatsermul_Fl(A, E1i, q);
    5574         252 :   return mfstabitermod(A, vp, Qab_to_Fl(chip, r, q), p, q);
    5575             : }
    5576             : 
    5577             : static GEN
    5578         224 : mf1intermat(GEN A, GEN Mindex, GEN e, GEN Iden, long lim, GEN POLCYC)
    5579             : {
    5580         224 :   long j, l = lg(A), LIM = nbrows(A);
    5581         224 :   GEN I = gel(Iden,1), den = gel(Iden,2), B = cgetg(l, t_MAT);
    5582             : 
    5583        5257 :   for (j = 1; j < l; j++)
    5584             :   {
    5585        5033 :     pari_sp av = avma;
    5586        5033 :     GEN c = RgV_to_RgX(gel(A,j), 0), c1, c2;
    5587        5033 :     c = RgX_to_RgC(RgXn_mul(c, e, LIM), LIM);
    5588        5033 :     if (POLCYC) c = liftpol_shallow(c);
    5589        5033 :     c1 = vecslice(c, lim+1, LIM);
    5590        5033 :     if (den) c1 = RgC_Rg_mul(c1, den);
    5591        5033 :     c2 = RgM_RgC_mul(I, vecpermute(c, Mindex));
    5592        5033 :     gel(B, j) = gerepileupto(av, RgC_sub(c2, c1));
    5593             :   }
    5594         224 :   return B;
    5595             : }
    5596             : /* Compute the full S_1(\G_0(N),\chi); return NULL if space is empty; else
    5597             :  * if pS is NULL, return stoi(dim), where dim is the dimension; else *pS is
    5598             :  * set to a vector of forms making up a basis, and return the matrix of their
    5599             :  * Fourier expansions. pdih gives the dimension of the subspace generated by
    5600             :  * dihedral forms; TMP is from mf1_pre or NULL. */
    5601             : static GEN
    5602       11284 : mf1basis(long N, GEN CHI, GEN TMP, GEN vSP, GEN *pS, long *pdih)
    5603             : {
    5604       11284 :   GEN E = NULL, EB, E1, E1i, dE1i, mf, A, C, POLCYC, DIH, Minv, chip;
    5605       11284 :   long nE = 0, p, LIM, lim, lim1, i, lA, dimp, ordchi, dih;
    5606             :   pari_timer tt;
    5607             :   pari_sp av;
    5608             : 
    5609       11284 :   if (pdih) *pdih = 0;
    5610       11284 :   if (pS) *pS = NULL;
    5611       11284 :   if (wt1empty(N) || mfcharparity(CHI) != -1) return NULL;
    5612       10990 :   ordchi = mfcharorder(CHI);
    5613       10990 :   if (uisprime(N) && ordchi > 4) return NULL;
    5614       10962 :   if (pS)
    5615             :   {
    5616        3857 :     DIH = mfdihedralcusp(N, CHI, vSP);
    5617        3857 :     dih = lg(DIH) - 1;
    5618             :   }
    5619             :   else
    5620             :   {
    5621        7105 :     DIH = NULL;
    5622        7105 :     dih = mfdihedralcuspdim(N, CHI, vSP);
    5623             :   }
    5624       10962 :   POLCYC = (ordchi <= 2)? NULL: mfcharpol(CHI);
    5625       10962 :   if (pdih) *pdih = dih;
    5626       10962 :   if (N <= 600) switch(N)
    5627             :   {
    5628             :     long m;
    5629         126 :     case 219: case 273: case 283: case 331: case 333: case 344: case 416:
    5630             :     case 438: case 468: case 491: case 504: case 546: case 553: case 563:
    5631             :     case 566: case 581: case 592:
    5632         126 :       break; /* one chi with both exotic and dihedral forms */
    5633        9499 :     default: /* only dihedral forms */
    5634        9499 :       if (!dih) return NULL;
    5635             :       /* fall through */
    5636             :     case 124: case 133: case 148: case 171: case 201: case 209: case 224:
    5637             :     case 229: case 248: case 261: case 266: case 288: case 296: case 301:
    5638             :     case 309: case 325: case 342: case 371: case 372: case 380: case 399:
    5639             :     case 402: case 403: case 404: case 408: case 418: case 432: case 444:
    5640             :     case 448: case 451: case 453: case 458: case 496: case 497: case 513:
    5641             :     case 522: case 527: case 532: case 576: case 579:
    5642             :       /* no chi with both exotic and dihedral; one chi with exotic forms */
    5643        3248 :       if (dih)
    5644             :       {
    5645        2338 :         if (!pS) return utoipos(dih);
    5646         728 :         return mftreatdihedral(N, DIH, POLCYC, ordchi, pS) ;
    5647             :       }
    5648         910 :       m = mfcharno(mfcharinduce(CHI,N));
    5649         910 :       if (N == 124 && (m != 67 && m != 87)) return NULL;
    5650         784 :       if (N == 133 && (m != 83 && m !=125)) return NULL;
    5651         490 :       if (N == 148 && (m !=105 && m !=117)) return NULL;
    5652         364 :       if (N == 171 && (m != 94 && m !=151)) return NULL;
    5653         364 :       if (N == 201 && (m != 29 && m !=104)) return NULL;
    5654         364 :       if (N == 209 && (m != 87 && m !=197)) return NULL;
    5655         364 :       if (N == 224 && (m != 95 && m !=191)) return NULL;
    5656         364 :       if (N == 229 && (m !=107 && m !=122)) return NULL;
    5657         364 :       if (N == 248 && (m != 87 && m !=191)) return NULL;
    5658         273 :       if (N == 261 && (m != 46 && m !=244)) return NULL;
    5659         273 :       if (N == 266 && (m != 83 && m !=125)) return NULL;
    5660         273 :       if (N == 288 && (m != 31 && m !=223)) return NULL;
    5661         273 :       if (N == 296 && (m !=105 && m !=265)) return NULL;
    5662             :   }
    5663         595 :   if (DEBUGLEVEL)
    5664           0 :     err_printf("mf1basis: start character %Ps, conductor = %ld, order = %ld\n",
    5665             :                gmfcharno(CHI), mfcharconductor(CHI), ordchi);
    5666         595 :   if (!TMP) TMP = mf1_pre(N);
    5667         595 :   lim = gel(TMP,1)[1]; LIM = gel(TMP,1)[2]; lim1 = gel(TMP,1)[3];
    5668         595 :   p = gel(TMP,1)[4];
    5669         595 :   mf  = gel(TMP,2);
    5670         595 :   A   = gel(TMP,3);
    5671         595 :   EB = mfeisensteinbasis(N, 1, mfcharinv_i(CHI));
    5672         595 :   nE = lg(EB) - 1;
    5673         595 :   E1 = RgV_to_RgX(mftocol(gel(EB,1), LIM-1, 1), 0); /* + O(x^LIM) */
    5674         595 :   if (--nE)
    5675         574 :     E = RgM_to_RgXV(mfvectomat(vecslice(EB, 2, nE+1), LIM-1, 1), 0);
    5676         595 :   chip = mfchareval(CHI, p); /* != 0 */
    5677         595 :   if (DEBUGLEVEL) timer_start(&tt);
    5678         595 :   av = avma; dimp = mf1dimmod(E1, E, chip, ordchi, dih, TMP);
    5679         595 :   set_avma(av);
    5680         595 :   if (DEBUGLEVEL) timer_printf(&tt, "mf1basis: dim mod p is %ld", dimp);
    5681         595 :   if (!dimp) return NULL;
    5682         280 :   if (!pS) return utoi(dimp);
    5683         224 :   if (dimp == dih) return mftreatdihedral(N, DIH, POLCYC, ordchi, pS);
    5684         168 :   E1i = RgXn_inv(E1, LIM); /* E[1] does not vanish at oo */
    5685         168 :   if (POLCYC) E1i = liftpol_shallow(E1i);
    5686         168 :   E1i = Q_remove_denom(E1i, &dE1i);
    5687         168 :   if (DEBUGLEVEL)
    5688             :   {
    5689           0 :     GEN a0 = gel(E1,2);
    5690           0 :     if (typ(a0) == t_POLMOD) a0 = gnorm(a0);
    5691           0 :     a0 = Q_abs_shallow(a0);
    5692           0 :     timer_printf(&tt, "mf1basis: invert E; norm(a0(E)) = %Ps", a0);
    5693             :   }
    5694         168 :   C = NULL;
    5695         168 :   if (nE)
    5696             :   { /* mf attached to S2(N), fi = mfbasis(mf)
    5697             :      * M = coefs(f1,...,fd) up to LIM
    5698             :      * F = coefs(F1,...,FD) = M * C, for some matrix C over Q(chi),
    5699             :      * initially 1, eventually giving \cap_E S2 / E; D <= d.
    5700             :      * B = coefs(E/E1 F1, .., E/E1 FD); we want X in Q(CHI)^d and
    5701             :      * Y in Q(CHI)^D such that
    5702             :      *   B * X = M * Y, i.e. Minv * rowpermute(B, Mindex * X) = Y
    5703             :      *(B  - I * rowpermute(B, Mindex)) * X = 0.
    5704             :      * where I = M * Minv. Rows of (B - I * ...) are 0 up to lim so
    5705             :      * are not included */
    5706         154 :     GEN Mindex = MF_get_Mindex(mf), Iden  = gel(TMP,5);
    5707             :     pari_timer TT;
    5708         154 :     pari_sp av = avma;
    5709         154 :     if (DEBUGLEVEL) timer_start(&TT);
    5710         238 :     for (i = 1; i <= nE; i++)
    5711             :     {
    5712         224 :       pari_sp av2 = avma;
    5713             :       GEN e, z, B;
    5714             : 
    5715         224 :       e = Q_primpart(RgXn_mul(E1i, gel(E,i), LIM));
    5716         224 :       if (DEBUGLEVEL) timer_printf(&TT, "mf1basis: E[%ld] / E[1]", i+1);
    5717             :       /* the first time A is over Z and it is more efficient to lift than
    5718             :          * to let RgXn_mul use Kronecker's trick */
    5719         224 :       if (POLCYC && i == 1) e = liftpol_shallow(e);
    5720         224 :       B = mf1intermat(A, Mindex, e, Iden, lim, i == 1? NULL: POLCYC);
    5721         224 :       if (DEBUGLEVEL) timer_printf(&TT, "mf1basis: ... intermat");
    5722         224 :       z = gerepileupto(av2, QabM_ker(B, POLCYC, ordchi));
    5723         224 :       if (DEBUGLEVEL)
    5724           0 :         timer_printf(&TT, "mf1basis: ... kernel (dim %ld)",lg(z)-1);
    5725         224 :       if (lg(z) == 1) return NULL;
    5726         224 :       if (lg(z) == lg(A)) { set_avma(av2); continue; } /* no progress */
    5727         224 :       C = C? _RgXQM_mul(C, z, POLCYC): z;
    5728         224 :       A = _RgXQM_mul(A, z, POLCYC);
    5729         224 :       if (DEBUGLEVEL) timer_printf(&TT, "mf1basis: ... updates");
    5730         224 :       if (lg(z)-1 == dimp) break;
    5731          84 :       if (gc_needed(av, 1))
    5732             :       {
    5733           0 :         if (DEBUGMEM > 1) pari_warn(warnmem,"mf1basis i = %ld", i);
    5734           0 :         gerepileall(av, 2, &A, &C);
    5735             :       }
    5736             :     }
    5737         154 :     if (DEBUGLEVEL) timer_printf(&tt, "mf1basis: intersection [total]");
    5738             :   }
    5739         168 :   lA = lg(A);
    5740         168 :   if (lA-1 == dimp)
    5741             :   {
    5742         140 :     A = mfmatsermul(rowslice(A, 1, lim1), E1i);
    5743         140 :     if (POLCYC) A = RgXQM_red(A, POLCYC);
    5744         140 :     if (DEBUGLEVEL) timer_printf(&tt, "mf1basis: matsermul [1]");
    5745             :   }
    5746             :   else
    5747             :   {
    5748          28 :     A = mfmatsermul(A, E1i);
    5749          28 :     if (POLCYC) A = RgXQM_red(A, POLCYC);
    5750          28 :     if (DEBUGLEVEL) timer_printf(&tt, "mf1basis: matsermul [2]");
    5751          28 :     A = mfstabiter(&C, A, chip, TMP, POLCYC, ordchi);
    5752          28 :     if (DEBUGLEVEL) timer_printf(&tt, "mf1basis: Hecke stability");
    5753          28 :     if (!A) return NULL;
    5754             :   }
    5755         168 :   if (dE1i) C = RgM_Rg_mul(C, dE1i);
    5756         168 :   if (POLCYC)
    5757             :   {
    5758         147 :     A = QXQM_to_mod_shallow(A, POLCYC);
    5759         147 :     C = QXQM_to_mod_shallow(C, POLCYC);
    5760             :   }
    5761         168 :   lA = lg(A);
    5762         581 :   for (i = 1; i < lA; i++)
    5763             :   {
    5764         413 :     GEN c, v = gel(A,i);
    5765         413 :     gel(A,i) = RgV_normalize(v, &c);
    5766         413 :     gel(C,i) = RgC_Rg_mul(gel(C,i), c);
    5767             :   }
    5768         168 :   Minv = gel(mfclean(A, POLCYC, ordchi, 0), 2);
    5769         168 :   A = RgM_Minv_mul(A, Minv);
    5770         168 :   C = RgM_Minv_mul(C, Minv);
    5771         168 :   *pS = vecmflineardiv0(MF_get_S(mf), C, gel(EB,1));
    5772         168 :   return A;
    5773             : }
    5774             : 
    5775             : static void
    5776         406 : MF_set_space(GEN mf, long x) { gmael(mf,1,4) = utoi(x); }
    5777             : static GEN
    5778         252 : mf1_cusptonew(GEN mf, GEN vSP)
    5779             : {
    5780         252 :   const long vy = 1;
    5781             :   long i, lP, dSnew, ct;
    5782         252 :   GEN vP, F, S, Snew, vF, v = split_ii(mf, 0, 0, vSP, &i);
    5783             : 
    5784         252 :   F = gel(v,1);
    5785         252 :   vP= gel(v,2); lP = lg(vP);
    5786         252 :   if (lP == 1) { obj_insert(mf, MF_SPLIT, v); return NULL; }
    5787         238 :   MF_set_space(mf, mf_NEW);
    5788         238 :   S = MF_get_S(mf);
    5789         238 :   dSnew = dim_sum(v);
    5790         238 :   Snew = cgetg(dSnew + 1, t_VEC); ct = 0;
    5791         238 :   vF = cgetg(lP, t_MAT);
    5792         546 :   for (i = 1; i < lP; i++)
    5793             :   {
    5794         308 :     GEN V, P = gel(vP,i), f = liftpol_shallow(gel(F,i));
    5795         308 :     long j, d = degpol(P);
    5796         308 :     gel(vF,i) = V = zerocol(dSnew);
    5797         308 :     if (d == 1)
    5798             :     {
    5799         140 :       gel(Snew, ct+1) = mflineardiv_linear(S, f, 0);
    5800         140 :       gel(V, ct+1) = gen_1;
    5801             :     }
    5802             :     else
    5803             :     {
    5804         168 :       f = RgXV_to_RgM(f,d);
    5805         511 :       for (j = 1; j <= d; j++)
    5806             :       {
    5807         343 :         gel(Snew, ct+j) = mflineardiv_linear(S, row(f,j), 0);
    5808         343 :         gel(V, ct+j) = mkpolmod(pol_xn(j-1,vy), P);
    5809             :       }
    5810             :     }
    5811         308 :     ct += d;
    5812             :   }
    5813         238 :   obj_insert(mf, MF_SPLIT, mkvec2(vF, vP));
    5814         238 :   gel(mf,3) = Snew; return mf;
    5815             : }
    5816             : static GEN
    5817        3969 : mf1init(long N, GEN CHI, GEN TMP, GEN vSP, long space, long flraw)
    5818             : {
    5819        3969 :   GEN mf, mf1, S, M = mf1basis(N, CHI, TMP, vSP, &S, NULL);
    5820        3969 :   if (!M) return NULL;
    5821         952 :   mf1 = mkvec4(stoi(N), gen_1, CHI, utoi(mf_CUSP));
    5822         952 :   mf = mkmf(mf1, cgetg(1,t_VEC), S, gen_0, NULL);
    5823         952 :   if (space == mf_NEW)
    5824             :   {
    5825         252 :     gel(mf,5) = mfcleanCHI(M,CHI, 0);
    5826         252 :     mf = mf1_cusptonew(mf, vSP); if (!mf) return NULL;
    5827         238 :     if (!flraw) M = mfcoefs_mf(mf, mfsturmNk(N,1)+1, 1);
    5828             :   }
    5829         938 :   gel(mf,5) = flraw? zerovec(3): mfcleanCHI(M, CHI, 0);
    5830         938 :   return mf;
    5831             : }
    5832             : 
    5833             : static GEN
    5834        1022 : mfEMPTY(GEN mf1)
    5835             : {
    5836        1022 :   GEN Minv = mkMinv(cgetg(1,t_MAT), NULL,NULL,NULL);
    5837        1022 :   GEN M = mkvec3(cgetg(1,t_VECSMALL), Minv, cgetg(1,t_MAT));
    5838        1022 :   return mkmf(mf1, cgetg(1,t_VEC), cgetg(1,t_VEC), cgetg(1,t_VEC), M);
    5839             : }
    5840             : static GEN
    5841         616 : mfEMPTYall(long N, GEN gk, GEN vCHI, long space)
    5842             : {
    5843             :   long i, l;
    5844             :   GEN v, gN, gs;
    5845         616 :   if (!vCHI) return cgetg(1, t_VEC);
    5846          14 :   gN = utoipos(N); gs = utoi(space);
    5847          14 :   l = lg(vCHI); v = cgetg(l, t_VEC);
    5848          42 :   for (i = 1; i < l; i++) gel(v,i) = mfEMPTY(mkvec4(gN,gk,gel(vCHI,i),gs));
    5849          14 :   return v;
    5850             : }
    5851             : 
    5852             : static GEN
    5853        3983 : fmt_dim(GEN CHI, long d, long dih)
    5854        3983 : { return mkvec4(gmfcharorder(CHI), gmfcharno(CHI), utoi(d), stoi(dih)); }
    5855             : /* merge two vector of fmt_dim's for the same vector of characters. If CHI
    5856             :  * is not NULL, remove dim-0 spaces and add character from CHI */
    5857             : static GEN
    5858           7 : merge_dims(GEN V, GEN W, GEN CHI)
    5859             : {
    5860           7 :   long i, j, id, l = lg(V);
    5861           7 :   GEN A = cgetg(l, t_VEC);
    5862           7 :   if (l == 1) return A;
    5863           7 :   id = CHI? 1: 3;
    5864          21 :   for (i = j = 1; i < l; i++)
    5865             :   {
    5866          14 :     GEN v = gel(V,i), w = gel(W,i);
    5867          14 :     long dv = itou(gel(v,id)), dvh = itou(gel(v,id+1)), d;
    5868          14 :     long dw = itou(gel(w,id)), dwh = itou(gel(w,id+1));
    5869          14 :     d = dv + dw;
    5870          14 :     if (d || CHI)
    5871          14 :       gel(A,j++) = CHI? fmt_dim(gel(CHI,i),d, dvh+dwh)
    5872          14 :                       : mkvec2s(d,dvh+dwh);
    5873             :   }
    5874           7 :   setlg(A, j); return A;
    5875             : }
    5876             : static GEN
    5877        3010 : mfdim0all(GEN w)
    5878             : {
    5879        3038 :   if (w) retconst_vec(lg(w)-1, zerovec(2));
    5880        3003 :   return cgetg(1,t_VEC);
    5881             : }
    5882             : static long
    5883        7315 : mf1cuspdim_i(long N, GEN CHI, GEN TMP, GEN vSP, long *dih)
    5884             : {
    5885        7315 :   pari_sp av = avma;
    5886        7315 :   GEN b = mf1basis(N, CHI, TMP, vSP, NULL, dih);
    5887        7315 :   return gc_long(av, b? itou(b): 0);
    5888             : }
    5889             : 
    5890             : static long
    5891         476 : mf1cuspdim(long N, GEN CHI, GEN vSP)
    5892             : {
    5893         476 :   if (!vSP) vSP = get_vDIH(N, divisorsNF(N, mfcharconductor(CHI)));
    5894         476 :   return mf1cuspdim_i(N, CHI, NULL, vSP, NULL);
    5895             : }
    5896             : static GEN
    5897        4144 : mf1cuspdimall(long N, GEN vCHI)
    5898             : {
    5899             :   GEN z, TMP, w, vSP;
    5900             :   long i, j, l;
    5901        4144 :   if (wt1empty(N)) return mfdim0all(vCHI);
    5902        1141 :   w = mf1chars(N,vCHI);
    5903        1141 :   l = lg(w); if (l == 1) return cgetg(1,t_VEC);
    5904        1141 :   z = cgetg(l, t_VEC);
    5905        1141 :   TMP = mf1_pre(N); vSP = get_vDIH(N, NULL);
    5906        7861 :   for (i = j = 1; i < l; i++)
    5907             :   {
    5908        6720 :     GEN CHI = gel(w,i);
    5909        6720 :     long dih, d = mf1cuspdim_i(N, CHI, TMP, vSP, &dih);
    5910        6720 :     if (vCHI)
    5911          42 :       gel(z,j++) = mkvec2s(d, dih);
    5912        6678 :     else if (d)
    5913        1428 :       gel(z,j++) = fmt_dim(CHI, d, dih);
    5914             :   }
    5915        1141 :   setlg(z,j); return z;
    5916             : }
    5917             : 
    5918             : /* dimension of S_1(Gamma_1(N)) */
    5919             : static long
    5920        4123 : mf1cuspdimsum(long N)
    5921             : {
    5922        4123 :   pari_sp av = avma;
    5923        4123 :   GEN v = mf1cuspdimall(N, NULL);
    5924        4123 :   long i, ct = 0, l = lg(v);
    5925        5544 :   for (i = 1; i < l; i++)
    5926             :   {
    5927        1421 :     GEN w = gel(v,i); /* [ord(CHI),*,dim,*] */
    5928        1421 :     ct += itou(gel(w,3))*myeulerphiu(itou(gel(w,1)));
    5929             :   }
    5930        4123 :   return gc_long(av,ct);
    5931             : }
    5932             : 
    5933             : static GEN
    5934          56 : mf1newdimall(long N, GEN vCHI)
    5935             : {
    5936             :   GEN z, w, vTMP, vSP, fa, P, E;
    5937             :   long i, c, l, lw, P1;
    5938          56 :   if (wt1empty(N)) return mfdim0all(vCHI);
    5939          56 :   w = mf1chars(N,vCHI);
    5940          56 :   lw = lg(w); if (lw == 1) return cgetg(1,t_VEC);
    5941          56 :   vTMP = const_vec(N, NULL);
    5942          56 :   vSP = get_vDIH(N, NULL);
    5943          56 :   gel(vTMP,N) = mf1_pre(N);
    5944             :   /* if p || N and p \nmid F(CHI), S_1^new(G0(N),chi) = 0 */
    5945          56 :   fa = znstar_get_faN(gmael(w,1,1));
    5946          56 :   P = gel(fa,1); l = lg(P);
    5947          56 :   E = gel(fa,2);
    5948         154 :   for (i = P1 = 1; i < l; i++)
    5949          98 :     if (E[i] == 1) P1 *= itou(gel(P,i));
    5950             :   /* P1 = \prod_{v_p(N) = 1} p */
    5951          56 :   z = cgetg(lw, t_VEC);
    5952         182 :   for (i = c = 1; i < lw; i++)
    5953             :   {
    5954             :     long S, j, l, F, dihnew;
    5955         126 :     GEN D, CHI = gel(w,i), CHIP = mfchartoprimitive(CHI,&F);
    5956             : 
    5957         126 :     S = F % P1? 0: mf1cuspdim_i(N, CHI, gel(vTMP,N), vSP, &dihnew);
    5958         126 :     if (!S)
    5959             :     {
    5960          56 :       if (vCHI) gel(z, c++) = zerovec(2);
    5961          56 :       continue;
    5962             :     }
    5963          70 :     D = mydivisorsu(N/F); l = lg(D);
    5964          77 :     for (j = l-2; j > 0; j--) /* skip last M = N */
    5965             :     {
    5966           7 :       long M = D[j]*F, m, s, dih;
    5967           7 :       GEN TMP = gel(vTMP,M);
    5968           7 :       if (wt1empty(M) || !(m = mubeta(D[l-j]))) continue; /*m = mubeta(N/M)*/
    5969           7 :       if (!TMP) gel(vTMP,M) = TMP = mf1_pre(M);
    5970           7 :       s = mf1cuspdim_i(M, CHIP, TMP, vSP, &dih);
    5971           7 :       if (s) { S += m * s; dihnew += m * dih; }
    5972             :     }
    5973          70 :     if (vCHI)
    5974          63 :       gel(z,c++) = mkvec2s(S, dihnew);
    5975           7 :     else if (S)
    5976           7 :       gel(z, c++) = fmt_dim(CHI, S, dihnew);
    5977             :   }
    5978          56 :   setlg(z,c); return z;
    5979             : }
    5980             : 
    5981             : static GEN
    5982          28 : mf1olddimall(long N, GEN vCHI)
    5983             : {
    5984             :   long i, j, l;
    5985             :   GEN z, w;
    5986          28 :   if (wt1empty(N)) return mfdim0all(vCHI);
    5987          28 :   w = mf1chars(N,vCHI);
    5988          28 :   l = lg(w); z = cgetg(l, t_VEC);
    5989          84 :   for (i = j = 1; i < l; i++)
    5990             :   {
    5991          56 :     GEN CHI = gel(w,i);
    5992          56 :     long d = mfolddim(N, 1, CHI);
    5993          56 :     if (vCHI)
    5994          28 :       gel(z,j++) = mkvec2s(d,d?-1:0);
    5995          28 :     else if (d)
    5996           7 :       gel(z, j++) = fmt_dim(CHI, d, -1);
    5997             :   }
    5998          28 :   setlg(z,j); return z;
    5999             : }
    6000             : 
    6001             : static long
    6002         469 : mf1olddimsum(long N)
    6003             : {
    6004             :   GEN D;
    6005         469 :   long N2, i, l, S = 0;
    6006         469 :   newd_params(N, &N2); /* will ensure mubeta != 0 */
    6007         469 :   D = mydivisorsu(N/N2); l = lg(D);
    6008        2485 :   for (i = 2; i < l; i++)
    6009             :   {
    6010        2016 :     long M = D[l-i]*N2, d = mf1cuspdimsum(M);
    6011        2016 :     if (d) S -= mubeta(D[i]) * d;
    6012             :   }
    6013         469 :   return S;
    6014             : }
    6015             : static long
    6016        1050 : mf1newdimsum(long N)
    6017             : {
    6018        1050 :   long S = mf1cuspdimsum(N);
    6019        1050 :   return S? S - mf1olddimsum(N): 0;
    6020             : }
    6021             : 
    6022             : /* return the automorphism of a degree-2 nf */
    6023             : static GEN
    6024        5768 : nf2_get_conj(GEN nf)
    6025             : {
    6026        5768 :   GEN pol = nf_get_pol(nf);
    6027        5768 :   return deg1pol_shallow(gen_m1, negi(gel(pol,3)), varn(pol));
    6028             : }
    6029             : static int
    6030          42 : foo_stable(GEN foo)
    6031          42 : { return lg(foo) != 3 || equalii(gel(foo,1), gel(foo,2)); }
    6032             : 
    6033             : static long
    6034         224 : mfisdihedral(GEN vF, GEN DIH)
    6035             : {
    6036         224 :   GEN vG = gel(DIH,1), M = gel(DIH,2), v, G, bnr, w, gen, D, f, nf, tau;
    6037         224 :   GEN bnr0 = NULL, f0, f0b, xin, foo;
    6038             :   long i, l, e, j, L, n;
    6039         224 :   if (lg(M) == 1) return 0;
    6040          42 :   v = RgM_RgC_invimage(M, vF);
    6041          42 :   if (!v) return 0;
    6042          42 :   l = lg(v);
    6043          42 :   for (i = 1; i < l; i++)
    6044          42 :     if (!gequal0(gel(v,i))) break;
    6045          42 :   if (i == l) return 0;
    6046          42 :   G = gel(vG,i);
    6047          42 :   bnr = gel(G,2); D = cyc_get_expo(bnr_get_cyc(bnr));
    6048          42 :   w = gel(G,3);
    6049          42 :   f = bnr_get_mod(bnr);
    6050          42 :   nf = bnr_get_nf(bnr);
    6051          42 :   tau = nf2_get_conj(nf);
    6052          42 :   f0 = gel(f,1); foo = gel(f,2);
    6053          42 :   f0b = galoisapply(nf, tau, f0);
    6054          42 :   xin = zv_to_ZV(gel(w,2)); /* xi(bnr.gen[i]) = e(xin[i] / D) */
    6055          42 :   if (!foo_stable(foo)) { foo = mkvec2(gen_1, gen_1); bnr0 = bnr; }
    6056          42 :   if (!gequal(f0, f0b))
    6057             :   {
    6058          21 :     f0 = idealmul(nf, f0, idealdivexact(nf, f0b, idealadd(nf, f0, f0b)));
    6059          21 :     bnr0 = bnr;
    6060             :   }
    6061          42 :   if (bnr0)
    6062             :   { /* conductor not ambiguous */
    6063             :     GEN S;
    6064          28 :     bnr = Buchray(bnr_get_bnf(bnr), mkvec2(f0, foo), nf_INIT | nf_GEN);
    6065          28 :     S = bnrsurjection(bnr, bnr0);
    6066          28 :     xin = FpV_red(RgV_RgM_mul(xin, gel(S,1)), D);
    6067             :     /* still xi(gen[i]) = e(xin[i] / D), for the new generators; D stays
    6068             :      * the same, not exponent(bnr.cyc) ! */
    6069             :   }
    6070          42 :   gen = bnr_get_gen(bnr); L = lg(gen);
    6071          77 :   for (j = 1, e = itou(D); j < L; j++)
    6072             :   {
    6073          63 :     GEN Ng = idealnorm(nf, gel(gen,j));
    6074          63 :     GEN a = shifti(gel(xin,j), 1); /* xi(g_j^2) = e(a/D) */
    6075          63 :     GEN b = FpV_dotproduct(xin, isprincipalray(bnr,Ng), D);
    6076          63 :     GEN m = Fp_sub(a, b, D); /* xi(g_j/g_j^\tau) = e(m/D) */
    6077          63 :     e = ugcd(e, itou(m)); if (e == 1) break;
    6078             :   }
    6079          42 :   n = itou(D) / e;
    6080          42 :   return n == 1? 4: 2*n;
    6081             : }
    6082             : 
    6083             : static ulong
    6084         119 : myradicalu(ulong n) { return zv_prod(gel(myfactoru(n),1)); }
    6085             : 
    6086             : /* list of fundamental discriminants unramified outside N, with sign s
    6087             :  * [s = 0 => no sign condition] */
    6088             : static GEN
    6089         119 : mfunram(long N, long s)
    6090             : {
    6091         119 :   long cN = myradicalu(N >> vals(N)), p = 1, m = 1, l, c, i;
    6092         119 :   GEN D = mydivisorsu(cN), res;
    6093         119 :   l = lg(D);
    6094         119 :   if (s == 1) m = 0; else if (s == -1) p = 0;
    6095         119 :   res = cgetg(6*l - 5, t_VECSMALL);
    6096         119 :   c = 1;
    6097         119 :   if (!odd(N))
    6098             :   { /* d = 1 */
    6099          56 :     if (p) res[c++] = 8;
    6100          56 :     if (m) { res[c++] =-8; res[c++] =-4; }
    6101             :   }
    6102         364 :   for (i = 2; i < l; i++)
    6103             :   { /* skip d = 1, done above */
    6104         245 :     long d = D[i], d4 = d & 3L; /* d odd, squarefree, d4 = 1 or 3 */
    6105         245 :     if (d4 == 1) { if (p) res[c++] = d; }
    6106         182 :     else         { if (m) res[c++] =-d; }
    6107         245 :     if (!odd(N))
    6108             :     {
    6109          56 :       if (p) { res[c++] = 8*d; if (d4 == 3) res[c++] = 4*d; }
    6110          56 :       if (m) { res[c++] =-8*d; if (d4 == 1) res[c++] =-4*d; }
    6111             :     }
    6112             :   }
    6113         119 :   setlg(res, c); return res;
    6114             : }
    6115             : 
    6116             : /* Return 1 if F is definitely not S4 type; return 0 on failure. */
    6117             : static long
    6118         105 : mfisnotS4(long N, GEN w)
    6119             : {
    6120         105 :   GEN D = mfunram(N, 0);
    6121         105 :   long i, lD = lg(D), lw = lg(w);
    6122         616 :   for (i = 1; i < lD; i++)
    6123             :   {
    6124         511 :     long p, d = D[i], ok = 0;
    6125        1442 :     for (p = 2; p < lw; p++)
    6126        1442 :       if (w[p] && kross(d,p) == -1) { ok = 1; break; }
    6127         511 :     if (!ok) return 0;
    6128             :   }
    6129         105 :   return 1;
    6130             : }
    6131             : 
    6132             : /* Return 1 if Q(sqrt(5)) \not\subset Q(F), i.e. F is definitely not A5 type;
    6133             :  * return 0 on failure. */
    6134             : static long
    6135         105 : mfisnotA5(GEN F)
    6136             : {
    6137         105 :   GEN CHI = mf_get_CHI(F), P = mfcharpol(CHI), T, Q;
    6138             : 
    6139         105 :   if (mfcharorder(CHI) % 5 == 0) return 0;
    6140         105 :   T = mf_get_field(F); if (degpol(T) == 1) return 1;
    6141         105 :   if (degpol(P) > 1) T = rnfequation(P,T);
    6142         105 :   Q = gsubgs(pol_xn(2,varn(T)), 5);
    6143         105 :   return (typ(nfisincl(Q, T)) == t_INT);
    6144             : }
    6145             : 
    6146             : /* v[p+1]^2 / chi(p) - 2 = z + 1/z with z primitive root of unity of order n,
    6147             :  * return n */
    6148             : static long
    6149        6741 : mffindrootof1(GEN v, long p, GEN CHI)
    6150             : {
    6151        6741 :   GEN ap = gel(v,p+1), u0, u1, u1k, u2;
    6152        6741 :   long c = 1;
    6153        6741 :   if (gequal0(ap)) return 2;
    6154        5033 :   u0 = gen_2; u1k = u1 = gsubgs(gdiv(gsqr(ap), mfchareval(CHI, p)), 2);
    6155       14812 :   while (!gequalsg(2, liftpol_shallow(u1))) /* u1 = z^c + z^-c */
    6156             :   {
    6157        9779 :     u2 = gsub(gmul(u1k, u1), u0);
    6158        9779 :     u0 = u1; u1 = u2; c++;
    6159             :   }
    6160        5033 :   return c;
    6161             : }
    6162             : 
    6163             : /* we known that F is not dihedral */
    6164             : static long
    6165         182 : mfgaloistype_i(long N, GEN CHI, GEN F, GEN v)
    6166             : {
    6167             :   forprime_t iter;
    6168         182 :   long lim = lg(v)-2;
    6169         182 :   GEN w = zero_zv(lim);
    6170             :   pari_sp av;
    6171             :   ulong p;
    6172         182 :   u_forprime_init(&iter, 2, lim);
    6173         182 :   av = avma;
    6174        5292 :   while((p = u_forprime_next(&iter))) if (N%p) switch(mffindrootof1(v, p, CHI))
    6175             :   {
    6176        1400 :     case 1: case 2: continue;
    6177        3451 :     case 3: w[p] = 1; break;
    6178          70 :     case 4: return -24; /* S4 */
    6179           0 :     case 5: return -60; /* A5 */
    6180           7 :     default: pari_err_DOMAIN("mfgaloistype", "form", "not a",
    6181             :                              strtoGENstr("cuspidal eigenform"), F);
    6182           0 :     set_avma(av);
    6183             :   }
    6184         364 :   if (mfisnotS4(N,w) && mfisnotA5(F)) return -12; /* A4 */
    6185           0 :   return 0; /* FAILURE */
    6186             : }
    6187             : 
    6188             : static GEN
    6189         224 : mfgaloistype0(long N, GEN CHI, GEN F, GEN DIH, long lim)
    6190             : {
    6191         224 :   pari_sp av = avma;
    6192         224 :   GEN vF = mftocol(F, lim, 1);
    6193         224 :   long t = mfisdihedral(vF, DIH), bound;
    6194         224 :   if (t) return gc_stoi(av,t);
    6195         182 :   bound = maxss(200, 5*expu(N)*expu(N));
    6196             :   for(;;)
    6197             :   {
    6198         182 :     t = mfgaloistype_i(N, CHI, F, vF);
    6199         175 :     set_avma(av); if (t) return stoi(t);
    6200           0 :     if (lim > bound) return gen_0;
    6201           0 :     lim += lim >> 1;
    6202           0 :     vF = mfcoefs_i(F,lim,1);
    6203             :   }
    6204             : }
    6205             : 
    6206             : /* If f is NULL, give all the galoistypes, otherwise just for f */
    6207             : /* Return 0 to indicate failure; in this case the type is either -12 or -60,
    6208             :  * most likely -12. FIXME using the Galois representation. */
    6209             : GEN
    6210         231 : mfgaloistype(GEN NK, GEN f)
    6211             : {
    6212         231 :   pari_sp av = avma;
    6213         231 :   GEN CHI, T, F, DIH, SP, mf = checkMF_i(NK);
    6214             :   long N, k, lL, i, lim, SB;
    6215             : 
    6216         231 :   if (f && !checkmf_i(f)) pari_err_TYPE("mfgaloistype", f);
    6217         224 :   if (mf)
    6218             :   {
    6219         189 :     N = MF_get_N(mf);
    6220         189 :     k = MF_get_k(mf);
    6221         189 :     CHI = MF_get_CHI(mf);
    6222             :   }
    6223             :   else
    6224             :   {
    6225          35 :     checkNK(NK, &N, &k, &CHI, 0);
    6226          35 :     mf = f? NULL: mfinit_i(NK, mf_NEW);
    6227             :   }
    6228         224 :   if (k != 1) pari_err_DOMAIN("mfgaloistype", "k", "!=", gen_1, stoi(k));
    6229         224 :   SB = mf? mfsturm_mf(mf): mfsturmNk(N,1);
    6230         224 :   SP = get_DIH(N);
    6231         224 :   DIH = mfdihedralnew(N, CHI, SP);
    6232         224 :   lim = lg(DIH) == 1? 200: SB;
    6233         224 :   DIH = mkvec2(DIH, mfvectomat(DIH,SB,1));
    6234         224 :   if (f) return gerepileuptoint(av, mfgaloistype0(N,CHI, f, DIH, lim));
    6235         126 :   F = mfeigenbasis(mf); lL = lg(F);
    6236         126 :   T = cgetg(lL, t_VEC);
    6237         252 :   for (i=1; i < lL; i++) gel(T,i) = mfgaloistype0(N, CHI, gel(F,i), DIH, lim);
    6238         126 :   return gerepileupto(av, T);
    6239             : }
    6240             : 
    6241             : /******************************************************************/
    6242             : /*                   Find all dihedral forms.                     */
    6243             : /******************************************************************/
    6244             : /* lim >= 2 */
    6245             : static void
    6246          14 : consttabdihedral(long lim) { cache_set(cache_DIH, mfdihedralall(lim)); }
    6247             : 
    6248             : /* a ideal coprime to bnr modulus */
    6249             : static long
    6250      107611 : mfdiheval(GEN bnr, GEN w, GEN a)
    6251             : {
    6252      107611 :   GEN L, cycn = gel(w,1), chin = gel(w,2);
    6253      107611 :   long ordmax = cycn[1];
    6254      107611 :   L = ZV_to_Flv(isprincipalray(bnr,a), ordmax);
    6255      107611 :   return Flv_dotproduct(chin, L, ordmax);
    6256             : }
    6257             : 
    6258             : /* A(x^k) mod T = polcyclo(m), 0 <= k < m */
    6259             : static GEN
    6260       30247 : Galois(GEN A, long k, GEN T, long m)
    6261             : {
    6262             :   GEN B;
    6263             :   long i, ik, d;
    6264       30247 :   if (typ(A) != t_POL) return A;
    6265        7413 :   if (varn(A) != varn(T))
    6266             :   {
    6267          14 :     B = cgetg_copy(A, &d); B[1] = A[1];
    6268          35 :     for (i = 2; i < d; i++) gel(B, i) = Galois(gel(A, i), k, T, m);
    6269          14 :     return B;
    6270             :   }
    6271        7399 :   if ((d = degpol(A)) <= 0) return A;
    6272        7042 :   B = cgetg(m + 2, t_POL); B[1] = A[1]; gel(B,2) = gel(A,2);
    6273       61313 :   for (i = 1; i < m; i++) gel(B, i+2) = gen_0;
    6274       23877 :   for (i = 1, ik = k; i <= d; i++, ik = Fl_add(ik, k, m))
    6275       16835 :     gel(B, ik + 2) = gel(A, i+2);
    6276        7042 :   return QX_ZX_rem(normalizepol(B), T);
    6277             : }
    6278             : static GEN
    6279        1001 : vecGalois(GEN v, long k, GEN T, long m)
    6280             : {
    6281             :   long i, l;
    6282        1001 :   GEN w = cgetg_copy(v,&l);
    6283       31227 :   for (i = 1; i < l; i++) gel(w,i) = Galois(gel(v,i), k, T, m);
    6284        1001 :   return w;
    6285             : }
    6286             : 
    6287             : static GEN
    6288      234178 : fix_pol(GEN S, GEN Pn, int *trace)
    6289             : {
    6290      234178 :   if (typ(S) != t_POL) return S;
    6291      118069 :   S = RgX_rem(S, Pn);
    6292      118069 :   if (typ(S) == t_POL)
    6293             :   {
    6294      118069 :     switch(lg(S))
    6295             :     {
    6296       45108 :       case 2: return gen_0;
    6297       20517 :       case 3: return gel(S,2);
    6298             :     }
    6299       52444 :     *trace = 1;
    6300             :   }
    6301       52444 :   return S;
    6302             : }
    6303             : 
    6304             : static GEN
    6305       13573 : dihan(GEN bnr, GEN w, GEN k0j, long m, ulong lim)
    6306             : {
    6307       13573 :   GEN nf = bnr_get_nf(bnr), f = bid_get_ideal(bnr_get_bid(bnr));
    6308       13573 :   GEN v = zerovec(lim+1), cycn = gel(w,1), Tinit = gel(w,3);
    6309       13573 :   GEN Pn = gel(Tinit,lg(Tinit)==4? 2: 1);
    6310       13573 :   long j, ordmax = cycn[1];
    6311       13573 :   long D = itos(nf_get_disc(nf)), vt = varn(Pn);
    6312       13573 :   int trace = 0;
    6313             :   ulong p, n;
    6314             :   forprime_t T;
    6315             : 
    6316       13573 :   if (!lim) return v;
    6317       13363 :   gel(v,2) = gen_1;
    6318       13363 :   u_forprime_init(&T, 2, lim);
    6319             :   /* fill in prime powers first */
    6320      116207 :   while ((p = u_forprime_next(&T)))
    6321             :   {
    6322             :     GEN vP, vchiP, S;
    6323             :     long k, lP;
    6324             :     ulong q, qk;
    6325      102844 :     if (kross(D,p) >= 0) q = p;
    6326       45192 :     else if (!(q = umuluu_le(p,p,lim))) continue;
    6327             :     /* q = Norm P */
    6328       65856 :     vP = idealprimedec(nf, utoipos(p));
    6329       65856 :     lP = lg(vP);
    6330       65856 :     vchiP = cgetg(lP, t_VECSMALL);
    6331      179081 :     for (j = k = 1; j < lP; j++)
    6332             :     {
    6333      113225 :       GEN P = gel(vP,j);
    6334      113225 :       if (!idealval(nf, f, P)) vchiP[k++] = mfdiheval(bnr,w,P);
    6335             :     }
    6336       65856 :     if (k == 1) continue;
    6337       62188 :     setlg(vchiP, k); lP = k;
    6338       62188 :     if (lP == 2)
    6339             :     { /* one prime above p not dividing f */
    6340       16765 :       long s, s0 = vchiP[1];
    6341       27069 :       for (qk=q, s = s0;; s = Fl_add(s,s0,ordmax))
    6342             :       {
    6343       27069 :         S = Qab_zeta(s, ordmax, vt);
    6344       27069 :         gel(v, qk+1) = fix_pol(S, Pn, &trace);
    6345       27069 :         if (!(qk = umuluu_le(qk,q,lim))) break;
    6346             :       }
    6347             :     }
    6348             :     else /* two primes above p not dividing f */
    6349             :     {
    6350       45423 :       long s, s0 = vchiP[1], s1 = vchiP[2];
    6351       45423 :       for (qk=q, k = 1;; k++)
    6352       18424 :       { /* sum over a,b s.t. Norm( P1^a P2^b ) = q^k, i.e. a+b = k */
    6353             :         long a;
    6354       63847 :         GEN S = gen_0;
    6355      220752 :         for (a = 0; a <= k; a++)
    6356             :         {
    6357      156905 :           s = Fl_add(Fl_mul(a, s0, ordmax), Fl_mul(k-a, s1, ordmax), ordmax);
    6358      156905 :           S = gadd(S, Qab_zeta(s, ordmax, vt));
    6359             :         }
    6360       63847 :         gel(v, qk+1) = fix_pol(S, Pn, &trace);
    6361       63847 :         if (!(qk = umuluu_le(qk,q,lim))) break;
    6362             :       }
    6363             :     }
    6364             :   }
    6365             :   /* complete with nonprime powers */
    6366      308098 :   for (n = 2; n <= lim; n++)
    6367             :   {
    6368      294735 :     GEN S, fa = myfactoru(n), P = gel(fa, 1), E = gel(fa, 2);
    6369             :     long q;
    6370      294735 :     if (lg(P) == 2) continue;
    6371             :     /* not a prime power */
    6372      143262 :     q = upowuu(P[1],E[1]);
    6373      143262 :     S = gmul(gel(v, q + 1), gel(v, n/q + 1));
    6374      143262 :     gel(v, n+1) = fix_pol(S, Pn, &trace);
    6375             :   }
    6376       13363 :   if (trace)
    6377             :   {
    6378        7154 :     long k0 = k0j[1], jdeg = k0j[2];
    6379        7154 :     v = QabV_tracerel(Tinit, jdeg, v); /* Apply Galois Mod(k0, ordw) */
    6380        7154 :     if (k0 > 1) v = vecGalois(v, k0, gel(Tinit,1), m);
    6381             :   }
    6382       13363 :   return v;
    6383             : }
    6384             : 
    6385             : /* as cyc_normalize for t_VECSMALL cyc */
    6386             : static GEN
    6387       26810 : cyc_normalize_zv(GEN cyc)
    6388             : {
    6389       26810 :   long i, o = cyc[1], l = lg(cyc); /* > 1 */
    6390       26810 :   GEN D = cgetg(l, t_VECSMALL);
    6391       31185 :   D[1] = o; for (i = 2; i < l; i++) D[i] = o / cyc[i];
    6392       26810 :   return D;
    6393             : }
    6394             : /* as char_normalize for t_VECSMALLs */
    6395             : static GEN
    6396      118517 : char_normalize_zv(GEN chi, GEN ncyc)
    6397             : {
    6398      118517 :   long i, l = lg(chi);
    6399      118517 :   GEN c = cgetg(l, t_VECSMALL);
    6400      118517 :   if (l > 1) {
    6401      118517 :     c[1] = chi[1];
    6402      160454 :     for (i = 2; i < l; i++) c[i] = chi[i] * ncyc[i];
    6403             :   }
    6404      118517 :   return c;
    6405             : }
    6406             : 
    6407             : static GEN
    6408        9331 : dihan_bnf(long D)
    6409             : {
    6410        9331 :   GEN c = getrand(), bnf;
    6411        9331 :   setrand(gen_1);
    6412        9331 :   bnf = Buchall(quadpoly_i(stoi(D)), nf_FORCE, LOWDEFAULTPREC);
    6413        9331 :   setrand(c);
    6414        9331 :   return bnf;
    6415             : }
    6416             : static GEN
    6417       37758 : dihan_bnr(GEN bnf, GEN A)
    6418             : {
    6419       37758 :   GEN c = getrand(), bnr;
    6420       37758 :   setrand(gen_1);
    6421       37758 :   bnr = Buchray(bnf, A, nf_INIT|nf_GEN);
    6422       37758 :   setrand(c);
    6423       37758 :   return bnr;
    6424             : }
    6425             : /* Hecke xi * (D/.) = Dirichlet chi, return v in Q^r st chi(g_i) = e(v[i]).
    6426             :  * cycn = cyc_normalize_zv(bnr.cyc), chin = char_normalize_zv(chi,cyc) */
    6427             : static GEN
    6428       34489 : bnrchartwist2conrey(GEN chin, GEN cycn, GEN bnrconreyN, GEN kroconreyN)
    6429             : {
    6430       34489 :   long l = lg(bnrconreyN), c1 = cycn[1], i;
    6431       34489 :   GEN v = cgetg(l, t_COL);
    6432      125363 :   for (i = 1; i < l; i++)
    6433             :   {
    6434       90874 :     GEN d = sstoQ(zv_dotproduct(chin, gel(bnrconreyN,i)), c1);
    6435       90874 :     if (kroconreyN[i] < 0) d = gadd(d, ghalf);
    6436       90874 :     gel(v,i) = d;
    6437             :   }
    6438       34489 :   return v;
    6439             : }
    6440             : 
    6441             : /* chi(g_i) = e(v[i]) denormalize wrt Conrey generators orders */
    6442             : static GEN
    6443       34489 : conreydenormalize(GEN znN, GEN v)
    6444             : {
    6445       34489 :   GEN gcyc = znstar_get_conreycyc(znN), w;
    6446       34489 :   long l = lg(v), i;
    6447       34489 :   w = cgetg(l, t_COL);
    6448      125363 :   for (i = 1; i < l; i++)
    6449       90874 :     gel(w,i) = modii(gmul(gel(v,i), gel(gcyc,i)), gel(gcyc,i));
    6450       34489 :   return w;
    6451             : }
    6452             : 
    6453             : static long
    6454       84028 : Miyake(GEN vchi, GEN gb, GEN cycn)
    6455             : {
    6456       84028 :   long i, e = cycn[1], lb = lg(gb);
    6457       84028 :   GEN v = char_normalize_zv(vchi, cycn);
    6458      124992 :   for (i = 1; i < lb; i++)
    6459      100268 :     if ((zv_dotproduct(v, gel(gb,i)) -  v[i]) % e) return 1;
    6460       24724 :   return 0;
    6461             : }
    6462             : 
    6463             : /* list of Hecke characters not induced by a Dirichlet character up to Galois
    6464             :  * conjugation, whose conductor is bnr.cond; cycn = cyc_normalize(bnr.cyc)*/
    6465             : static GEN
    6466       26810 : mklvchi(GEN bnr, GEN cycn, GEN gb)
    6467             : {
    6468       26810 :   GEN cyc = bnr_get_cyc(bnr), cycsmall = ZV_to_zv(cyc);
    6469       26810 :   GEN vchi = cyc2elts(cycsmall);
    6470       26810 :   long ordmax = cycsmall[1], c, i, l;
    6471       26810 :   l = lg(vchi);
    6472      304024 :   for (i = c = 1; i < l; i++)
    6473             :   {
    6474      277214 :     GEN chi = gel(vchi,i);
    6475      277214 :     if (!gb || Miyake(chi, gb, cycn)) gel(vchi, c++) = Flv_to_ZV(chi);
    6476             :   }
    6477       26810 :   setlg(vchi, c); l = c;
    6478      279300 :   for (i = 1; i < l; i++)
    6479             :   {
    6480      252490 :     GEN chi = gel(vchi,i);
    6481             :     long n;
    6482      252490 :     if (!chi) continue;
    6483     1055754 :     for (n = 2; n < ordmax; n++)
    6484      966476 :       if (ugcd(n, ordmax) == 1)
    6485             :       {
    6486      397670 :         GEN tmp = ZV_ZV_mod(gmulsg(n, chi), cyc);
    6487             :         long j;
    6488     7623539 :         for (j = i+1; j < l; j++)
    6489     7225869 :           if (gel(vchi,j) && gequal(gel(vchi,j), tmp)) gel(vchi,j) = NULL;
    6490             :       }
    6491             :   }
    6492      279300 :   for (i = c = 1; i < l; i++)
    6493             :   {
    6494      252490 :     GEN chi = gel(vchi,i);
    6495      252490 :     if (chi && bnrisconductor(bnr, chi)) gel(vchi, c++) = chi;
    6496             :   }
    6497       26810 :   setlg(vchi, c); return vchi;
    6498             : }
    6499             : 
    6500             : static GEN
    6501        7805 : get_gb(GEN bnr, GEN con)
    6502             : {
    6503        7805 :   GEN gb, g = bnr_get_gen(bnr), nf = bnr_get_nf(bnr);
    6504        7805 :   long i, l = lg(g);
    6505        7805 :   gb = cgetg(l, t_VEC);
    6506       18326 :   for (i = 1; i < l; i++)
    6507       10521 :     gel(gb,i) = ZV_to_zv(isprincipalray(bnr, galoisapply(nf, con, gel(g,i))));
    6508        7805 :   return gb;
    6509             : }
    6510             : static GEN
    6511       15862 : get_bnrconreyN(GEN bnr, GEN znN)
    6512             : {
    6513       15862 :   GEN z, g = znstar_get_conreygen(znN);
    6514       15862 :   long i, l = lg(g);
    6515       15862 :   z = cgetg(l, t_VEC);
    6516       57134 :   for (i = 1; i < l; i++) gel(z,i) = ZV_to_zv(isprincipalray(bnr,gel(g,i)));
    6517       15862 :   return z;
    6518             : }
    6519             : /* con = NULL if D > 0 or if D < 0 and id != idcon. */
    6520             : static GEN
    6521       33698 : mfdihedralcommon(GEN bnf, GEN id, GEN znN, GEN kroconreyN, long vt,
    6522             :                  long N, long D, GEN con)
    6523             : {
    6524       33698 :   GEN bnr = dihan_bnr(bnf, id), cyc = ZV_to_zv( bnr_get_cyc(bnr) );
    6525             :   GEN bnrconreyN, cycn, cycN, Lvchi, res, P, vT;
    6526             :   long j, ordmax, l, lc, deghecke;
    6527             : 
    6528       33698 :   lc = lg(cyc); if (lc == 1) return NULL;
    6529       26810 :   cycn = cyc_normalize_zv(cyc);
    6530       26810 :   Lvchi = mklvchi(bnr, cycn, con? get_gb(bnr, con): NULL);
    6531       26810 :   l = lg(Lvchi);
    6532       26810 :   if (l == 1) return NULL;
    6533             : 
    6534       15862 :   bnrconreyN = get_bnrconreyN(bnr, znN);
    6535       15862 :   cycN = ZV_to_zv(znstar_get_cyc(znN));
    6536       15862 :   ordmax = cyc[1];
    6537       15862 :   vT = const_vec(odd(ordmax)? ordmax << 1: ordmax, NULL);
    6538       15862 :   P = polcyclo(ordmax, vt);
    6539       15862 :   gel(vT,ordmax) = Qab_trace_init(ordmax, ordmax, P, P);
    6540       15862 :   deghecke = myeulerphiu(ordmax);
    6541       15862 :   res = cgetg(l, t_VEC);
    6542       50351 :   for (j = 1; j < l; j++)
    6543             :   {
    6544       34489 :     GEN T, v, vchi = ZV_to_zv(gel(Lvchi,j));
    6545       34489 :     GEN chi, chin = char_normalize_zv(vchi, cycn);
    6546             :     long o, vnum, k0, degrel;
    6547       34489 :     v = bnrchartwist2conrey(chin, cycn, bnrconreyN, kroconreyN);
    6548       34489 :     o = itou(Q_denom(v));
    6549       34489 :     T = gel(vT, o);
    6550       34489 :     if (!T) gel(vT,o) = T = Qab_trace_init(ordmax, o, P, polcyclo(o,vt));
    6551       34489 :     chi = conreydenormalize(znN, v);
    6552       34489 :     vnum = itou(znconreyexp(znN, chi));
    6553       34489 :     chi = ZV_to_zv(znconreychar(znN,chi));
    6554       34489 :     degrel = deghecke / degpol(gel(T,1));
    6555       34489 :     k0 = zv_cyc_minimize(cycN, chi, coprimes_zv(o));
    6556       34489 :     vnum = Fl_powu(vnum, k0, N);
    6557             :     /* encodes degrel forms: jdeg = 0..degrel-1 */
    6558       34489 :     gel(res,j) = mkvec3(mkvecsmalln(5, N, k0 % o, vnum, D, degrel),
    6559             :                         id, mkvec3(cycn,chin,T));
    6560             :   }
    6561       15862 :   return res;
    6562             : }
    6563             : 
    6564             : static long
    6565       49364 : is_cond(long D, long n)
    6566             : {
    6567       49364 :   if (D > 0) return n != 4 || (D&7L) == 1;
    6568       30114 :   return n != 2 && n != 3 && (n != 4 || (D&7L)!=1);
    6569             : }
    6570             : /* Append to v all dihedral weight 1 forms coming from D, if fundamental.
    6571             :  * level in [l1, l2] */
    6572             : static void
    6573       18718 : append_dihedral(GEN v, long D, long l1, long l2, long vt)
    6574             : {
    6575       18718 :   long Da = labs(D), no, i, numi, ct, min, max;
    6576             :   GEN bnf, con, vI, resall, arch1, arch2;
    6577             :   pari_sp av;
    6578             : 
    6579             :   /* min <= Nf <= max */
    6580       18718 :   max = l2 / Da;
    6581       18718 :   if (l1 == l2)
    6582             :   { /* assume Da | l2 */
    6583         140 :     min = max;
    6584         140 :     if (D > 0 && min < 3) return;
    6585             :   }
    6586             :   else /* assume l1 < l2 */
    6587       18578 :     min = (l1 + Da-1)/Da;
    6588       18718 :   if (!sisfundamental(D)) return;
    6589             : 
    6590        5726 :   av = avma;
    6591        5726 :   bnf = dihan_bnf(D);
    6592        5726 :   con = nf2_get_conj(bnf_get_nf(bnf));
    6593        5726 :   vI = ideallist(bnf, max);
    6594       55090 :   numi = 0; for (i = min; i <= max; i++) numi += lg(gel(vI, i)) - 1;
    6595        5726 :   if (D > 0)
    6596             :   {
    6597        1428 :     numi <<= 1;
    6598        1428 :     arch1 = mkvec2(gen_1,gen_0);
    6599        1428 :     arch2 = mkvec2(gen_0,gen_1);
    6600             :   }
    6601             :   else
    6602        4298 :     arch1 = arch2 = NULL;
    6603        5726 :   resall = cgetg(numi+1, t_VEC); ct = 1;
    6604       55090 :   for (no = min; no <= max; no++) if (is_cond(D, no))
    6605             :   {
    6606       44646 :     long N = Da*no, lc, lI;
    6607       44646 :     GEN I = gel(vI, no), znN = znstar0(utoipos(N), 1), conreyN, kroconreyN;
    6608             : 
    6609       44646 :     conreyN = znstar_get_conreygen(znN); lc = lg(conreyN);
    6610       44646 :     kroconreyN = cgetg(lc, t_VECSMALL);
    6611      166054 :     for (i = 1; i < lc; i++) kroconreyN[i] = krosi(D, gel(conreyN, i));
    6612       44646 :     lI = lg(I);
    6613       87822 :     for (i = 1; i < lI; i++)
    6614             :     {
    6615       43176 :       GEN id = gel(I, i), idcon, z;
    6616             :       long j;
    6617       43176 :       if (typ(id) == t_INT) continue;
    6618       28182 :       idcon = galoisapply(bnf, con, id);
    6619       51408 :       for (j = i; j < lI; j++)
    6620       51408 :         if (gequal(idcon, gel(I, j))) { gel(I, j) = gen_0; break; }
    6621       28182 :       if (D < 0)
    6622             :       {
    6623       17479 :         GEN conk = i == j ? con : NULL;
    6624       17479 :         z = mfdihedralcommon(bnf, id, znN, kroconreyN, vt, N, D, conk);
    6625       17479 :         if (z) gel(resall, ct++) = z;
    6626             :       }
    6627             :       else
    6628             :       {
    6629             :         GEN ide;
    6630       10703 :         ide = mkvec2(id, arch1);
    6631       10703 :         z = mfdihedralcommon(bnf, ide, znN, kroconreyN, vt, N, D, NULL);
    6632       10703 :         if (z) gel(resall, ct++) = z;
    6633       10703 :         if (gequal(idcon,id)) continue;
    6634        5516 :         ide = mkvec2(id, arch2);
    6635        5516 :         z = mfdihedralcommon(bnf, ide, znN, kroconreyN, vt, N, D, NULL);
    6636        5516 :         if (z) gel(resall, ct++) = z;
    6637             :       }
    6638             :     }
    6639             :   }
    6640        5726 :   if (ct == 1) set_avma(av);
    6641             :   else
    6642             :   {
    6643        4816 :     setlg(resall, ct);
    6644        4816 :     vectrunc_append(v, gerepilecopy(av, shallowconcat1(resall)));
    6645             :   }
    6646             : }
    6647             : 
    6648             : static long
    6649       42042 : di_N(GEN a) { return gel(a,1)[1]; }
    6650             : static GEN
    6651          14 : mfdihedral(long N)
    6652             : {
    6653          14 :   GEN D = mydivisorsu(N), res = vectrunc_init(2*N);
    6654          14 :   long j, l = lg(D), vt = fetch_user_var("t");
    6655         105 :   for (j = 2; j < l; j++)
    6656             :   { /* skip d = 1 */
    6657          91 :     long d = D[j];
    6658          91 :     if (d == 2) continue;
    6659          84 :     append_dihedral(res, -d, N,N, vt);
    6660          84 :     if (d >= 5 && D[l-j] >= 3) append_dihedral(res, d, N,N, vt);/* Nf >= 3 */
    6661             :   }
    6662          14 :   if (lg(res) > 1) res = shallowconcat1(res);
    6663          14 :   return res;
    6664             : }
    6665             : /* All primitive dihedral weight 1 forms of leven in [1, N], N > 1 */
    6666             : static GEN
    6667          14 : mfdihedralall(long N)
    6668             : {
    6669          14 :   GEN res = vectrunc_init(2*N), z;
    6670          14 :   long D, ct, i, vt = fetch_user_var("t");
    6671             : 
    6672       13986 :   for (D = -3; D >= -N; D--) append_dihedral(res, D, 1,N, vt);
    6673             :   /* Nf >= 3 (GTM 193, prop 3.3.18) */
    6674        4620 :   for (D = N / 3; D >= 5; D--) append_dihedral(res, D, 1,N, vt);
    6675          14 :   ct = lg(res);
    6676          14 :   if (ct > 1)
    6677             :   { /* sort wrt N */
    6678          14 :     res = shallowconcat1(res);
    6679          14 :     res = vecpermute(res, indexvecsort(res, mkvecsmall(1)));
    6680          14 :     ct = lg(res);
    6681             :   }
    6682          14 :   z = const_vec(N, cgetg(1,t_VEC));
    6683        7658 :   for (i = 1; i < ct;)
    6684             :   { /* regroup result sharing the same N */
    6685        7644 :     long n = di_N(gel(res,i)), j = i+1, k;
    6686             :     GEN v;
    6687       34412 :     while (j < ct && di_N(gel(res,j)) == n) j++;
    6688        7644 :     gel(z, n) = v = cgetg(j-i+1, t_VEC);
    6689       42056 :     for (k = 1; i < j; k++,i++) gel(v,k) = gel(res,i);
    6690             :   }
    6691          14 :   return z;
    6692             : }
    6693             : 
    6694             : /* return [vF, index], where vecpermute(vF,index) generates dihedral forms
    6695             :  * for character CHI */
    6696             : static GEN
    6697       24969 : mfdihedralnew_i(long N, GEN CHI, GEN SP)
    6698             : {
    6699             :   GEN bnf, Tinit, Pm, vf, M, V, NK;
    6700             :   long Dold, d, ordw, i, SB, c, l, k0, k1, chino, chinoorig, lv;
    6701             : 
    6702       24969 :   lv = lg(SP); if (lv == 1) return NULL;
    6703       12138 :   CHI = mfcharinduce(CHI,N);
    6704       12138 :   ordw = mfcharorder(CHI);
    6705       12138 :   chinoorig = mfcharno(CHI);
    6706       12138 :   k0 = mfconreyminimize(CHI);
    6707       12138 :   chino = Fl_powu(chinoorig, k0, N);
    6708       12138 :   k1 = Fl_inv(k0 % ordw, ordw);
    6709       12138 :   V = cgetg(lv, t_VEC);
    6710       12138 :   d = 0;
    6711       39039 :   for (i = l = 1; i < lv; i++)
    6712             :   {
    6713       26901 :     GEN sp = gel(SP,i), T = gel(sp,1);
    6714       26901 :     if (T[3] != chino) continue;
    6715        4060 :     d += T[5];
    6716        4060 :     if (k1 != 1)
    6717             :     {
    6718          77 :       GEN t = leafcopy(T);
    6719          77 :       t[3] = chinoorig;
    6720          77 :       t[2] = (t[2]*k1) % ordw;
    6721          77 :       sp = mkvec4(t, gel(sp,2), gel(sp,3), gel(sp,4));
    6722             :     }
    6723        4060 :     gel(V, l++) = sp;
    6724             :   }
    6725       12138 :   setlg(V, l); /* dihedral forms of level N and character CHI */
    6726       12138 :   if (l == 1) return NULL;
    6727             : 
    6728        2555 :   SB = mfsturmNk(N,1) + 1;
    6729        2555 :   M = cgetg(d+1, t_MAT);
    6730        2555 :   vf = cgetg(d+1, t_VEC);
    6731        2555 :   NK = mkNK(N, 1, CHI);
    6732        2555 :   bnf = NULL; Dold = 0;
    6733        6615 :   for (i = c = 1; i < l; i++)
    6734             :   { /* T = [N, k0, conreyno, D, degrel] */
    6735        4060 :     GEN bnr, Vi = gel(V,i), T = gel(Vi,1), id = gel(Vi,2), w = gel(Vi,3);
    6736        4060 :     long jdeg, k0i = T[2], D = T[4], degrel = T[5];
    6737             : 
    6738        4060 :     if (D != Dold) { Dold = D; bnf = dihan_bnf(D); }
    6739        4060 :     bnr = dihan_bnr(bnf, id);
    6740       12054 :     for (jdeg = 0; jdeg < degrel; jdeg++,c++)
    6741             :     {
    6742        7994 :       GEN k0j = mkvecsmall2(k0i, jdeg), an = dihan(bnr, w, k0j, ordw, SB);
    6743        7994 :       settyp(an, t_COL); gel(M,c) = an;
    6744        7994 :       gel(vf,c) = tag3(t_MF_DIHEDRAL, NK, bnr, w, k0j);
    6745             :     }
    6746             :   }
    6747        2555 :   Tinit = gmael3(V,1,3,3); Pm = gel(Tinit,1);
    6748        2555 :   V = QabM_indexrank(M, degpol(Pm)==1? NULL: Pm, ordw);
    6749        2555 :   return mkvec2(vf,gel(V,2));
    6750             : }
    6751             : static long
    6752       16149 : mfdihedralnewdim(long N, GEN CHI, GEN SP)
    6753             : {
    6754       16149 :   pari_sp av = avma;
    6755       16149 :   GEN S = mfdihedralnew_i(N, CHI, SP);
    6756       16149 :   return gc_long(av, S? lg(gel(S,2))-1: 0);
    6757             : }
    6758             : static GEN
    6759        8820 : mfdihedralnew(long N, GEN CHI, GEN SP)
    6760             : {
    6761        8820 :   pari_sp av = avma;
    6762        8820 :   GEN S = mfdihedralnew_i(N, CHI, SP);
    6763        8820 :   if (!S) { set_avma(av); return cgetg(1, t_VEC); }
    6764         917 :   return vecpermute(gel(S,1), gel(S,2));
    6765             : }
    6766             : 
    6767             : static long
    6768        7105 : mfdihedralcuspdim(long N, GEN CHI, GEN vSP)
    6769             : {
    6770        7105 :   pari_sp av = avma;
    6771             :   GEN D, CHIP;
    6772             :   long F, i, lD, dim;
    6773             : 
    6774        7105 :   CHIP = mfchartoprimitive(CHI, &F);
    6775        7105 :   D = mydivisorsu(N/F); lD = lg(D);
    6776        7105 :   dim = mfdihedralnewdim(N, CHI, gel(vSP,N)); /* d = 1 */
    6777       16149 :   for (i = 2; i < lD; i++)
    6778             :   {
    6779        9044 :     long d = D[i], a = mfdihedralnewdim(N/d, CHIP, gel(vSP, N/d));
    6780        9044 :     if (a) dim += a * mynumdivu(d);
    6781             :   }
    6782        7105 :   return gc_long(av,dim);
    6783             : }
    6784             : 
    6785             : static GEN
    6786        7343 : mfbdall(GEN E, long N)
    6787             : {
    6788        7343 :   GEN v, D = mydivisorsu(N);
    6789        7343 :   long i, j, nD = lg(D) - 1, nE = lg(E) - 1;
    6790        7343 :   v = cgetg(nD*nE + 1, t_VEC);
    6791       10416 :   for (j = 1; j <= nE; j++)
    6792             :   {
    6793        3073 :     GEN Ej = gel(E, j);
    6794        9415 :     for (i = 0; i < nD; i++) gel(v, i*nE + j) = mfbd_i(Ej, D[i+1]);
    6795             :   }
    6796        7343 :   return v;
    6797             : }
    6798             : static GEN
    6799        3857 : mfdihedralcusp(long N, GEN CHI, GEN vSP)
    6800             : {
    6801        3857 :   pari_sp av = avma;
    6802             :   GEN D, CHIP, z;
    6803             :   long F, i, lD;
    6804             : 
    6805        3857 :   CHIP = mfchartoprimitive(CHI, &F);
    6806        3857 :   D = mydivisorsu(N/F); lD = lg(D);
    6807        3857 :   z = cgetg(lD, t_VEC);
    6808        3857 :   gel(z,1) = mfdihedralnew(N, CHI, gel(vSP,N));
    6809        8596 :   for (i = 2; i < lD; i++) /* skip 1 */
    6810             :   {
    6811        4739 :     GEN LF = mfdihedralnew(N / D[i], CHIP, gel(vSP, N / D[i]));
    6812        4739 :     gel(z,i) = mfbdall(LF, D[i]);
    6813             :   }
    6814        3857 :   return gerepilecopy(av, shallowconcat1(z));
    6815             : }
    6816             : 
    6817             : /* used to decide between ratlift and comatrix for ZM_inv; ratlift is better
    6818             :  * when N has many divisors */
    6819             : static int
    6820        2541 : abundant(ulong N) { return mynumdivu(N) >= 8; }
    6821             : 
    6822             : /* CHI an mfchar */
    6823             : static int
    6824         371 : cmp_ord(void *E, GEN a, GEN b)
    6825             : {
    6826         371 :   GEN chia = MF_get_CHI(a), chib = MF_get_CHI(b);
    6827         371 :   (void)E; return cmpii(gmfcharorder(chia), gmfcharorder(chib));
    6828             : }
    6829             : /* mfinit structure.
    6830             : -- mf[1] contains [N,k,CHI,space],
    6831             : -- mf[2] contains vector of closures of Eisenstein series, empty if not
    6832             :    full space.
    6833             : -- mf[3] contains vector of closures, so #mf[3] = dimension of cusp/new space.
    6834             : -- mf[4] contains the corresponding indices: either j for T(j)tf if newspace,
    6835             :    or [M,j,d] for B(d)T(j)tf_M if cuspspace or oldspace.
    6836             : -- mf[5] contains the matrix M of first coefficients of basis, never cleaned.
    6837             :  * NK is either [N,k] or [N,k,CHI].
    6838             :  * mfinit does not do the splitting, only the basis generation. */
    6839             : 
    6840             : /* Set flraw to 1 if do not need mf[5]: no mftobasis etc..., only the
    6841             :    expansions of the basis elements are needed. */
    6842             : 
    6843             : static GEN
    6844        4977 : mfinit_Nkchi(long N, long k, GEN CHI, long space, long flraw)
    6845             : {
    6846        4977 :   GEN M = NULL, mf = NULL, mf1 = mkvec4(utoi(N), stoi(k), CHI, utoi(space));
    6847        4977 :   long sb = mfsturmNk(N, k);
    6848        4977 :   if (k < 0 || badchar(N, k, CHI)) return mfEMPTY(mf1);
    6849        4942 :   if (k == 0 || space == mf_EISEN) /*nothing*/;
    6850        4781 :   else if (k == 1)
    6851             :   {
    6852         364 :     switch (space)
    6853             :     {
    6854         350 :       case mf_NEW:
    6855             :       case mf_FULL:
    6856         350 :       case mf_CUSP: mf = mf1init(N, CHI, NULL, get_vDIH(N,NULL), space, flraw);
    6857         350 :                     break;
    6858           7 :       case mf_OLD: pari_err_IMPL("mfinit in weight 1 for old space");
    6859           7 :       default: pari_err_FLAG("mfinit");
    6860             :     }
    6861             :   }
    6862             :   else /* k >= 2 */
    6863             :   {
    6864        4417 :     long ord = mfcharorder(CHI);
    6865        4417 :     GEN z = NULL, P = (ord <= 2)? NULL: mfcharpol(CHI);
    6866             :     cachenew_t cache;
    6867        4417 :     switch(space)
    6868             :     {
    6869        1218 :       case mf_NEW:
    6870        1218 :         mf = mfnewinit(N, k, CHI, &cache, 1);
    6871        1218 :         if (mf && !flraw) { M = MF_get_M(mf); z = MF_get_Mindex(mf); }
    6872        1218 :         break;
    6873        3192 :       case mf_OLD:
    6874             :       case mf_CUSP:
    6875             :       case mf_FULL:
    6876        3192 :         if (!(mf = mfinitcusp(N, k, CHI, &cache, space))) break;
    6877        2891 :         if (!flraw)
    6878             :         {
    6879        2240 :           M = bhnmat_extend(M, sb+1, 1, MF_get_S(mf), &cache);
    6880        2240 :           if (space != mf_FULL) gel(mf,5) = mfcleanCHI(M, CHI, abundant(N));
    6881             :         }
    6882        2891 :         dbg_cachenew(&cache); break;
    6883           7 :       default: pari_err_FLAG("mfinit");
    6884             :     }
    6885        4410 :     if (z) gel(mf,5) = mfclean2(M, z, P, ord);
    6886             :   }
    6887        4921 :   if (!mf) mf = mfEMPTY(mf1);
    6888             :   else
    6889             :   {
    6890        3962 :     gel(mf,1) = mf1;
    6891        3962 :     if (flraw) gel(mf,5) = zerovec(3);
    6892             :   }
    6893        4921 :   if (!space_is_cusp(space))
    6894             :   {
    6895         819 :     GEN E = mfeisensteinbasis(N, k, CHI);
    6896         819 :     gel(mf,2) = E;
    6897         819 :     if (!flraw)
    6898             :     {
    6899         497 :       if (M)
    6900         196 :         M = shallowconcat(mfvectomat(E, sb+1, 1), M);
    6901             :       else
    6902         301 :         M = mfcoefs_mf(mf, sb+1, 1);
    6903         497 :       gel(mf,5) = mfcleanCHI(M, CHI, abundant(N));
    6904             :     }
    6905             :   }
    6906        4921 :   return mf;
    6907             : }
    6908             : 
    6909             : /* mfinit for k = nk/dk */
    6910             : static GEN
    6911        2681 : mfinit_Nndkchi(long N, long nk, long dk, GEN CHI, long space, long flraw)
    6912         266 : { return (dk == 2)? mf2init_Nkchi(N, nk >> 1, CHI, space, flraw)
    6913        2947 :                   : mfinit_Nkchi(N, nk, CHI, space, flraw); }
    6914             : static GEN
    6915        3346 : mfinit_i(GEN NK, long space)
    6916             : {
    6917             :   GEN CHI, mf;
    6918             :   long N, k, dk, joker;
    6919        3346 :   if (checkmf_i(NK))
    6920             :   {
    6921         147 :     N = mf_get_N(NK);
    6922         147 :     Qtoss(mf_get_gk(NK), &k, &dk);
    6923         147 :     CHI = mf_get_CHI(NK);
    6924             :   }
    6925        3199 :   else if ((mf = checkMF_i(NK)))
    6926             :   {
    6927          21 :     long s = MF_get_space(mf);
    6928          21 :     if (s == space) return mf;
    6929          21 :     Qtoss(MF_get_gk(mf), &k, &dk);
    6930          21 :     if (dk == 1 && k > 1 && space == mf_NEW && (s == mf_CUSP || s == mf_FULL))
    6931          21 :       return mfinittonew(mf);
    6932           0 :     N = MF_get_N(mf);
    6933           0 :     CHI = MF_get_CHI(mf);
    6934             :   }
    6935             :   else
    6936        3178 :     checkNK2(NK, &N, &k, &dk, &CHI, 1);
    6937        3304 :   joker = !CHI || typ(CHI) == t_COL;
    6938        3304 :   if (joker)
    6939             :   {
    6940        1162 :     GEN mf, vCHI = CHI;
    6941             :     long i, j, l;
    6942        1162 :     if (CHI && lg(CHI) == 1) return cgetg(1,t_VEC);
    6943        1155 :     if (k < 0) return mfEMPTYall(N, uutoQ(k,dk), CHI, space);
    6944        1141 :     if (k == 1 && dk == 1 && space != mf_EISEN)
    6945         504 :     {
    6946             :       GEN TMP, vSP, gN, gs;
    6947             :       pari_timer tt;
    6948        1106 :       if (space != mf_CUSP && space != mf_NEW)
    6949           0 :         pari_err_IMPL("mfinit([N,1,wildcard], space != cusp or new space)");
    6950        1106 :       if (wt1empty(N)) return mfEMPTYall(N, gen_1, CHI, space);
    6951         504 :       vCHI = mf1chars(N,vCHI);
    6952         504 :       l = lg(vCHI); mf = cgetg(l, t_VEC); if (l == 1) return mf;
    6953         504 :       TMP = mf1_pre(N); vSP = get_vDIH(N, NULL);
    6954         504 :       gN = utoipos(N); gs = utoi(space);
    6955         504 :       if (DEBUGLEVEL) timer_start(&tt);
    6956        4123 :       for (i = j = 1; i < l; i++)
    6957             :       {
    6958        3619 :         pari_sp av = avma;
    6959        3619 :         GEN c = gel(vCHI,i), z = mf1init(N, c, TMP, vSP, space, 0);
    6960        3619 :         if (z) z = gerepilecopy(av, z);
    6961             :         else
    6962             :         {
    6963        2905 :           set_avma(av);
    6964        2905 :           if (CHI) z = mfEMPTY(mkvec4(gN,gen_1,c,gs));
    6965             :         }
    6966        3619 :         if (z) gel(mf, j++) = z;
    6967        3619 :         if (DEBUGLEVEL)
    6968           0 :           timer_printf(&tt, "mf1basis: character %ld / %ld (order = %ld)",
    6969             :                        i, l-1, mfcharorder(c));
    6970             :       }
    6971             :     }
    6972             :     else
    6973             :     {
    6974          35 :       vCHI = mfchars(N,k,dk,vCHI);
    6975          35 :       l = lg(vCHI); mf = cgetg(l, t_VEC);
    6976         119 :       for (i = j = 1; i < l; i++)
    6977             :       {
    6978          84 :         pari_sp av = avma;
    6979          84 :         GEN v = mfinit_Nndkchi(N, k, dk, gel(vCHI,i), space, 0);
    6980          84 :         if (MF_get_dim(v) || CHI) gel(mf, j++) = v; else set_avma(av);
    6981             :       }
    6982             :     }
    6983         539 :     setlg(mf,j);
    6984         539 :     if (!CHI) gen_sort_inplace(mf, NULL, &cmp_ord, NULL);
    6985         539 :     return mf;
    6986             :   }
    6987        2142 :   return mfinit_Nndkchi(N, k, dk, CHI, space, 0);
    6988             : }
    6989             : GEN
    6990        2380 : mfinit(GEN NK, long space)
    6991             : {
    6992        2380 :   pari_sp av = avma;
    6993        2380 :   return gerepilecopy(av, mfinit_i(NK, space));
    6994             : }
    6995             : 
    6996             : /* UTILITY FUNCTIONS */
    6997             : static void
    6998         364 : cusp_canon(GEN cusp, long N, long *pA, long *pC)
    6999             : {
    7000         364 :   pari_sp av = avma;
    7001             :   long A, C, tc, cg;
    7002         364 :   if (N <= 0) pari_err_DOMAIN("mfcuspwidth","N","<=",gen_0,stoi(N));
    7003         357 :   if (!cusp || (tc = typ(cusp)) == t_INFINITY) { *pA = 1; *pC = N; return; }
    7004         350 :   if (tc != t_INT && tc != t_FRAC) pari_err_TYPE("checkcusp", cusp);
    7005         350 :   Qtoss(cusp, &A,&C);
    7006         350 :   if (N % C)
    7007             :   {
    7008             :     ulong uC;
    7009          14 :     long u = Fl_invgen((C-1)%N + 1, N, &uC);
    7010          14 :     A = Fl_mul(A, u, N);
    7011          14 :     C = (long)uC;
    7012             :   }
    7013         350 :   cg = ugcd(C, N/C);
    7014         420 :   while (ugcd(A, N) > 1) A += cg;
    7015         350 :   *pA = A % N; *pC = C; set_avma(av);
    7016             : }
    7017             : static long
    7018         945 : mfcuspcanon_width(long N, long C)
    7019         945 : { return (!C || C == N)? 1 : N / ugcd(N, Fl_sqr(umodsu(C,N),N)); }
    7020             : /* v = [a,c] a ZC, width of cusp (a:c) */
    7021             : static long
    7022        8806 : mfZC_width(long N, GEN v)
    7023             : {
    7024        8806 :   ulong C = umodiu(gel(v,2), N);
    7025        8806 :   return (C == 0)? 1: N / ugcd(N, Fl_sqr(C,N));
    7026             : }
    7027             : long
    7028         161 : mfcuspwidth(GEN gN, GEN cusp)
    7029             : {
    7030         161 :   long N = 0, A, C;
    7031             :   GEN mf;
    7032         161 :   if (typ(gN) == t_INT) N = itos(gN);
    7033          42 :   else if ((mf = checkMF_i(gN))) N = MF_get_N(mf);
    7034           0 :   else pari_err_TYPE("mfcuspwidth", gN);
    7035         161 :   cusp_canon(cusp, N, &A, &C);
    7036         154 :   return mfcuspcanon_width(N, C);
    7037             : }
    7038             : 
    7039             : /* Q a t_INT */
    7040             : static GEN
    7041          14 : findq(GEN al, GEN Q)
    7042             : {
    7043             :   long n;
    7044          14 :   if (typ(al) == t_FRAC && cmpii(gel(al,2), Q) <= 0)
    7045           0 :     return mkvec(mkvec2(gel(al,1), gel(al,2)));
    7046          14 :   n = 1 + (long)ceil(2.0781*gtodouble(glog(Q, LOWDEFAULTPREC)));
    7047          14 :   return contfracpnqn(gboundcf(al,n), n);
    7048             : }
    7049             : static GEN
    7050          91 : findqga(long N, GEN z)
    7051             : {
    7052          91 :   GEN Q, LDC, CK = NULL, DK = NULL, ma, x, y = imag_i(z);
    7053             :   long j, l;
    7054          91 :   if (gcmpgs(gmulsg(2*N, y), 1) >= 0) return NULL;
    7055          14 :   x = real_i(z);
    7056          14 :   Q = ground(ginv(gsqrt(gmulsg(N, y), LOWDEFAULTPREC)));
    7057          14 :   LDC = findq(gmulsg(-N,x), Q);
    7058          14 :   ma = gen_1; l = lg(LDC);
    7059          35 :   for (j = 1; j < l; j++)
    7060             :   {
    7061          21 :     GEN D, DC = gel(LDC,j), C1 = gel(DC,2);
    7062          21 :     if (cmpii(C1,Q) > 0) break;
    7063          21 :     D = gel(DC,1);
    7064          21 :     if (ugcdiu(D,N) == 1)
    7065             :     {
    7066           7 :       GEN C = mului(N, C1), den;
    7067           7 :       den = gadd(gsqr(gmul(C,y)), gsqr(gadd(D, gmul(C,x))));
    7068           7 :       if (gcmp(den, ma) < 0) { ma = den; CK = C; DK = D; }
    7069             :     }
    7070             :   }
    7071          14 :   return DK? mkvec2(CK, DK): NULL;
    7072             : }
    7073             : 
    7074             : static long
    7075         168 : valNC2(GEN P, GEN E, long e)
    7076             : {
    7077         168 :   long i, d = 1, l = lg(P);
    7078         504 :   for (i = 1; i < l; i++)
    7079             :   {
    7080         336 :     long v = u_lval(e, P[i]) << 1;
    7081         336 :     if (v == E[i] + 1) v--;
    7082         336 :     d *= upowuu(P[i], v);
    7083             :   }
    7084         168 :   return d;
    7085             : }
    7086             : 
    7087             : static GEN
    7088          49 : findqganew(long N, GEN z)
    7089             : {
    7090          49 :   GEN MI, DI, x = real_i(z), y = imag_i(z), Ck = gen_0, Dk = gen_1, fa, P, E;
    7091             :   long i;
    7092          49 :   MI = uutoQ(1,N);
    7093          49 :   DI = mydivisorsu(mysqrtu(N));
    7094          49 :   fa = myfactoru(N); P = gel(fa,1); E = gel(fa,2);
    7095         217 :   for (i = 1; i < lg(DI); i++)
    7096             :   {
    7097         168 :     long e = DI[i], g;
    7098             :     GEN U, C, D, m;
    7099         168 :     (void)cxredsl2(gmulsg(e, z), &U);
    7100         168 :     C = gcoeff(U,2,1); if (!signe(C)) continue;
    7101         168 :     D = gcoeff(U,2,2);
    7102         168 :     g = ugcdiu(D,e);
    7103         168 :     if (g > 1) { C = muliu(C,e/g); D = diviuexact(D,g); } else C = muliu(C,e);
    7104         168 :     m = gadd(gsqr(gadd(gmul(C, x), D)), gsqr(gmul(C, y)));
    7105         168 :     m = gdivgu(m, valNC2(P, E, e));
    7106         168 :     if (gcmp(m, MI) < 0) { MI = m; Ck = C; Dk = D; }
    7107             :   }
    7108          49 :   return signe(Ck)? mkvec2(Ck, Dk): NULL;
    7109             : }
    7110             : 
    7111             : /* Return z' and U = [a,b;c,d] \in SL_2(Z), z' = U*z,
    7112             :  * Im(z')/width(U.oo) > sqrt(3)/(2N). Set *pczd = c*z+d */
    7113             : static GEN
    7114         175 : cxredga0N(long N, GEN z, GEN *pU, GEN *pczd, long flag)
    7115             : {
    7116         175 :   GEN v = NULL, A, B, C, D;
    7117             :   long e;
    7118         175 :   if (N == 1) return cxredsl2_i(z, pU, pczd);
    7119         140 :   e = gexpo(gel(z,2));
    7120         140 :   if (e < 0) z = gprec_wensure(z, precision(z) + nbits2extraprec(-e));
    7121         140 :   v = flag? findqganew(N,z): findqga(N,z);
    7122         140 :   if (!v) { *pU = matid(2); *pczd = gen_1; return z; }
    7123          56 :   C = gel(v,1);
    7124          56 :   D = gel(v,2);
    7125          56 :   if (!is_pm1(bezout(C,D, &B,&A))) pari_err_BUG("cxredga0N [gcd > 1]");
    7126          56 :   B = negi(B);
    7127          56 :   *pU = mkmat2(mkcol2(A,C), mkcol2(B,D));
    7128          56 :   *pczd = gadd(gmul(C,z), D);
    7129          56 :   return gdiv(gadd(gmul(A,z), B), *pczd);
    7130             : }
    7131             : 
    7132             : static GEN
    7133         154 : lfunthetaall(GEN b, GEN vL, GEN t, long bitprec)
    7134             : {
    7135         154 :   long i, l = lg(vL);
    7136         154 :   GEN v = cgetg(l, t_VEC);
    7137         336 :   for (i = 1; i < l; i++)
    7138             :   {
    7139         182 :     GEN T, L = gel(vL,i), a0 = gel(L,1), ldata = gel(L,2);
    7140         182 :     GEN van = gel(ldata_get_an(ldata),2);
    7141         182 :     if (lg(van) == 1)
    7142             :     {
    7143           0 :       T = gmul(b, a0);
    7144           0 :       if (isexactzero(T)) { GEN z = real_0_bit(-bitprec); T = mkcomplex(z,z); }
    7145             :     }
    7146             :     else
    7147             :     {
    7148         182 :       T = gmul2n(lfuntheta(ldata, t, 0, bitprec), -1);
    7149         182 :       T = gmul(b, gadd(a0, T));
    7150             :     }
    7151         182 :     gel(v,i) = T;
    7152             :   }
    7153         154 :   return l == 2? gel(v,1): v;
    7154             : }
    7155             : 
    7156             : /* P in ZX, irreducible */
    7157             : static GEN
    7158         182 : ZX_roots(GEN P, long prec)
    7159             : {
    7160         182 :   long d = degpol(P);
    7161         182 :   if (d == 1) return mkvec(gen_0);
    7162         182 :   if (d == 2 && isint1(gel(P,2)) && isintzero(gel(P,3)) && isint1(gel(P,4)))
    7163           7 :     return mkvec2(powIs(3), gen_I()); /* order as polroots */
    7164         294 :   return (ZX_sturm_irred(P) == d)? ZX_realroots_irred(P, prec)
    7165         294 :                                  : QX_complex_roots(P, prec);
    7166             : }
    7167             : /* initializations for RgX_RgV_eval / RgC_embed */
    7168             : static GEN
    7169         217 : rootspowers(GEN v)
    7170             : {
    7171         217 :   long i, l = lg(v);
    7172         217 :   GEN w = cgetg(l, t_VEC);
    7173         868 :   for (i = 1; i < l; i++) gel(w,i) = gpowers(gel(v,i), l-2);
    7174         217 :   return w;
    7175             : }
    7176             : /* mf embeddings attached to Q(chi)/(T), chi attached to cyclotomic P */
    7177             : static GEN
    7178         889 : getembed(GEN P, GEN T, GEN zcyclo, long prec)
    7179             : {
    7180             :   long i, l;
    7181             :   GEN v;
    7182         889 :   if (degpol(P) == 1) P = NULL; /* mfcharpol for quadratic char */
    7183         889 :   if (degpol(T) == 1) T = NULL; /* dim 1 orbit */
    7184         889 :   if (T && P)
    7185          35 :   { /* K(y) / (T(y)), K = Q(t)/(P) cyclotomic */
    7186          35 :     GEN vr = RgX_is_ZX(T)? ZX_roots(T,prec): roots(RgX_embed1(T,zcyclo), prec);
    7187          35 :     v = rootspowers(vr); l = lg(v);
    7188         105 :     for (i = 1; i < l; i++) gel(v,i) = mkcol3(P,zcyclo,gel(v,i));
    7189             :   }
    7190         854 :   else if (T)
    7191             :   { /* Q(y) / (T(y)), T noncyclotomic */
    7192         182 :     GEN vr = ZX_roots(T, prec);
    7193         182 :     v = rootspowers(vr); l = lg(v);
    7194         763 :     for (i = 1; i < l; i++) gel(v,i) = mkcol2(T, gel(v,i));
    7195             :   }
    7196             :   else /* cyclotomic or rational */
    7197         672 :     v = mkvec(P? mkvec2(P, zcyclo): cgetg(1,t_VEC));
    7198         889 :   return v;
    7199             : }
    7200             : static GEN
    7201         742 : grootsof1_CHI(GEN CHI, long prec)
    7202         742 : { return grootsof1(mfcharorder(CHI), prec); }
    7203             : /* return the [Q(F):Q(chi)] embeddings of F */
    7204             : static GEN
    7205         581 : mfgetembed(GEN F, long prec)
    7206             : {
    7207         581 :   GEN T = mf_get_field(F), CHI = mf_get_CHI(F), P = mfcharpol(CHI);
    7208         581 :   return getembed(P, T, grootsof1_CHI(CHI, prec), prec);
    7209             : }
    7210             : static GEN
    7211           7 : mfchiembed(GEN mf, long prec)
    7212             : {
    7213           7 :   GEN CHI = MF_get_CHI(mf), P = mfcharpol(CHI);
    7214           7 :   return getembed(P, pol_x(0), grootsof1_CHI(CHI, prec), prec);
    7215             : }
    7216             : /* mfgetembed for the successive eigenforms in MF_get_newforms */
    7217             : static GEN
    7218         154 : mfeigenembed(GEN mf, long prec)
    7219             : {
    7220         154 :   GEN vP = MF_get_fields(mf), vF = MF_get_newforms(mf);
    7221         154 :   GEN zcyclo, vE, CHI = MF_get_CHI(mf), P = mfcharpol(CHI);
    7222         154 :   long i, l = lg(vP);
    7223         154 :   vF = Q_remove_denom(liftpol_shallow(vF), NULL);
    7224         154 :   prec += nbits2extraprec(gexpo(vF));
    7225         154 :   zcyclo = grootsof1_CHI(CHI, prec);
    7226         154 :   vE = cgetg(l, t_VEC);
    7227         455 :   for (i = 1; i < l; i++) gel(vE,i) = getembed(P, gel(vP,i), zcyclo, prec);
    7228         154 :   return vE;
    7229             : }
    7230             : 
    7231             : static int
    7232          28 : checkPv(GEN P, GEN v)
    7233          28 : { return typ(P) == t_POL && is_vec_t(typ(v)) && lg(v)-1 >= degpol(P); }
    7234             : static int
    7235          28 : checkemb_i(GEN E)
    7236             : {
    7237          28 :   long t = typ(E), l = lg(E);
    7238          28 :   if (t == t_VEC) return l == 1 || (l == 3 && checkPv(gel(E,1), gel(E,2)));
    7239          21 :   if (t != t_COL) return 0;
    7240          21 :   if (l == 3) return checkPv(gel(E,1), gel(E,2));
    7241          21 :   return l == 4 && is_vec_t(typ(gel(E,2))) && checkPv(gel(E,1), gel(E,3));
    7242             : }
    7243             : static GEN
    7244          28 : anyembed(GEN v, GEN E)
    7245             : {
    7246          28 :   switch(typ(v))
    7247             :   {
    7248          21 :     case t_VEC: case t_COL: return mfvecembed(E, v);
    7249           7 :     case t_MAT: return mfmatembed(E, v);
    7250             :   }
    7251           0 :   return mfembed(E, v);
    7252             : }
    7253             : GEN
    7254          49 : mfembed0(GEN E, GEN v, long prec)
    7255             : {
    7256          49 :   pari_sp av = avma;
    7257          49 :   GEN mf, vE = NULL;
    7258          49 :   if (checkmf_i(E)) vE = mfgetembed(E, prec);
    7259          35 :   else if ((mf = checkMF_i(E))) vE = mfchiembed(mf, prec);
    7260          49 :   if (vE)
    7261             :   {
    7262          21 :     long i, l = lg(vE);
    7263             :     GEN w;
    7264          21 :     if (!v) return gerepilecopy(av, l == 2? gel(vE,1): vE);
    7265           0 :     w = cgetg(l, t_VEC);
    7266           0 :     for (i = 1; i < l; i++) gel(w,i) = anyembed(v, gel(vE,i));
    7267           0 :     return gerepilecopy(av, l == 2? gel(w,1): w);
    7268             :   }
    7269          28 :   if (!checkemb_i(E) || !v) pari_err_TYPE("mfembed", E);
    7270          28 :   return gerepilecopy(av, anyembed(v,E));
    7271             : }
    7272             : 
    7273             : /* dummy lfun create for theta evaluation */
    7274             : static GEN
    7275         924 : mfthetaancreate(GEN van, GEN N, GEN k)
    7276             : {
    7277         924 :   GEN L = zerovec(6);
    7278         924 :   gel(L,1) = lfuntag(t_LFUN_GENERIC, van);
    7279         924 :   gel(L,3) = mkvec2(gen_0, gen_1);
    7280         924 :   gel(L,4) = k;
    7281         924 :   gel(L,5) = N; return L;
    7282             : }
    7283             : /* destroy van and prepare to evaluate theta(sigma(van)), for all sigma in
    7284             :  * embeddings vector vE */
    7285             : static GEN
    7286         329 : van_embedall(GEN van, GEN vE, GEN gN, GEN gk)
    7287             : {
    7288         329 :   GEN a0 = gel(van,1), vL;
    7289         329 :   long i, lE = lg(vE), l = lg(van);
    7290         329 :   van++; van[0] = evaltyp(t_VEC) | _evallg(l-1); /* remove a0 */
    7291         329 :   vL = cgetg(lE, t_VEC);
    7292         889 :   for (i = 1; i < lE; i++)
    7293             :   {
    7294         560 :     GEN E = gel(vE,i), v = mfvecembed(E, van);
    7295         560 :     gel(vL,i) = mkvec2(mfembed(E,a0), mfthetaancreate(v, gN, gk));
    7296             :   }
    7297         329 :   return vL;
    7298             : }
    7299             : 
    7300             : static int
    7301        1064 : cusp_AC(GEN cusp, long *A, long *C)
    7302             : {
    7303        1064 :   switch(typ(cusp))
    7304             :   {
    7305         119 :     case t_INFINITY: *A = 1; *C = 0; break;
    7306         273 :     case t_INT:  *A = itos(cusp); *C = 1; break;
    7307         448 :     case t_FRAC: *A = itos(gel(cusp, 1)); *C = itos(gel(cusp, 2)); break;
    7308         224 :     case t_REAL: case t_COMPLEX:
    7309         224 :       *A = 0; *C = 0;
    7310         224 :       if (gsigne(imag_i(cusp)) <= 0)
    7311           7 :         pari_err_DOMAIN("mfeval","imag(tau)","<=",gen_0,cusp);
    7312         217 :       return 0;
    7313           0 :     default: pari_err_TYPE("cusp_AC", cusp);
    7314             :   }
    7315         840 :   return 1;
    7316             : }
    7317             : static GEN
    7318         518 : cusp2mat(long A, long C)
    7319             : { long B, D;
    7320         518 :   cbezout(A, C, &D, &B);
    7321         518 :   return mkmat22s(A, -B, C, D);
    7322             : }
    7323             : static GEN
    7324          21 : mkS(void) { return mkmat22s(0,-1,1,0); }
    7325             : 
    7326             : /* if t is a cusp, return F(t), else NULL */
    7327             : static GEN
    7328         350 : evalcusp(GEN mf, GEN F, GEN t, long prec)
    7329             : {
    7330             :   long A, C;
    7331             :   GEN R;
    7332         350 :   if (!cusp_AC(t, &A,&C)) return NULL;
    7333         189 :   if (C % mf_get_N(F) == 0) return gel(mfcoefs_i(F, 0, 1), 1);
    7334         175 :   R = mfgaexpansion(mf, F, cusp2mat(A,C), 0, prec);
    7335         175 :   return gequal0(gel(R,1))? gmael(R,3,1): gen_0;
    7336             : }
    7337             : /* Evaluate an mf closure numerically, i.e., in the usual sense, either for a
    7338             :  * single tau or a vector of tau; for each, return a vector of results
    7339             :  * corresponding to all complex embeddings of F. If flag is nonzero, allow
    7340             :  * replacing F by F | gamma to increase imag(gamma^(-1).tau) [ expensive if
    7341             :  * MF_EISENSPACE not present ] */
    7342             : static GEN
    7343         161 : mfeval_i(GEN mf, GEN F, GEN vtau, long flag, long bitprec)
    7344             : {
    7345             :   GEN L0, vL, vb, sqN, vczd, vTAU, vs, van, vE;
    7346         161 :   long N = MF_get_N(mf), N0, ta, lv, i, prec = nbits2prec(bitprec);
    7347         161 :   GEN gN = utoipos(N), gk = mf_get_gk(F), gk1 = gsubgs(gk,1), vgk;
    7348         161 :   long flscal = 0;
    7349             : 
    7350             :   /* gen_0 is ignored, second component assumes Ramanujan-Petersson in
    7351             :    * 1/2-integer weight */
    7352         161 :   vgk = mkvec2(gen_0, mfiscuspidal(mf,F)? gmul2n(gk1,-1): gk1);
    7353         161 :   ta = typ(vtau);
    7354         161 :   if (!is_vec_t(ta)) { flscal = 1; vtau = mkvec(vtau); ta = t_VEC; }
    7355         161 :   lv = lg(vtau);
    7356         161 :   sqN = sqrtr_abs(utor(N, prec));
    7357         161 :   vs = const_vec(lv-1, NULL);
    7358         161 :   vb = const_vec(lv-1, NULL);
    7359         161 :   vL = cgetg(lv, t_VEC);
    7360         161 :   vTAU = cgetg(lv, t_VEC);
    7361         161 :   vczd = cgetg(lv, t_VEC);
    7362         161 :   L0 = mfthetaancreate(NULL, gN, vgk); /* only for thetacost */
    7363         161 :   vE = mfgetembed(F, prec);
    7364         161 :   N0 = 0;
    7365         343 :   for (i = 1; i < lv; i++)
    7366             :   {
    7367         189 :     GEN z = gel(vtau,i), tau, U;
    7368             :     long w, n;
    7369             : 
    7370         189 :     gel(vs,i) = evalcusp(mf, F, z, prec);
    7371         182 :     if (gel(vs,i)) continue;
    7372         154 :     tau = cxredga0N(N, z, &U, &gel(vczd,i), flag);
    7373         154 :     if (!flag) w = 0; else { w = mfZC_width(N, gel(U,1)); tau = gdivgu(tau,w); }
    7374         154 :     gel(vTAU,i) = mulcxmI(gmul(tau, sqN));
    7375         154 :     n = lfunthetacost(L0, real_i(gel(vTAU,i)), 0, bitprec);
    7376         154 :     if (N0 < n) N0 = n;
    7377         154 :     if (flag)
    7378             :     {
    7379          42 :       GEN A, al, v = mfslashexpansion(mf, F, ZM_inv(U,NULL), n, 0, &A, prec);
    7380          42 :       gel(vL,i) = van_embedall(v, vE, gN, vgk);
    7381          42 :       al = gel(A,1);
    7382          42 :       if (!gequal0(al))
    7383           7 :         gel(vb,i) = gexp(gmul(gmul(gmulsg(w,al),PiI2(prec)), tau), prec);
    7384             :     }
    7385             :   }
    7386         154 :   if (!flag)
    7387             :   {
    7388         112 :     van = mfcoefs_i(F, N0, 1);
    7389         112 :     vL = const_vec(lv-1, van_embedall(van, vE, gN, vgk));
    7390             :   }
    7391         336 :   for (i = 1; i < lv; i++)
    7392             :   {
    7393             :     GEN T;
    7394         182 :     if (gel(vs,i)) continue;
    7395         154 :     T = gpow(gel(vczd,i), gneg(gk), prec);
    7396         154 :     if (flag && gel(vb,i)) T = gmul(T, gel(vb,i));
    7397         154 :     gel(vs,i) = lfunthetaall(T, gel(vL,i), gel(vTAU,i), bitprec);
    7398             :   }
    7399         154 :   return flscal? gel(vs,1): vs;
    7400             : }
    7401             : 
    7402             : static long
    7403        1316 : mfistrivial(GEN F)
    7404             : {
    7405        1316 :   switch(mf_get_type(F))
    7406             :   {
    7407           7 :     case t_MF_CONST: return lg(gel(F,2)) == 1;
    7408         259 :     case t_MF_LINEAR: case t_MF_LINEAR_BHN: return gequal0(gel(F,3));
    7409        1050 :     default: return 0;
    7410             :   }
    7411             : }
    7412             : 
    7413             : static long
    7414        1134 : mf_same_k(GEN mf, GEN f) { return gequal(MF_get_gk(mf), mf_get_gk(f)); }
    7415             : static long
    7416        1092 : mf_same_CHI(GEN mf, GEN f)
    7417             : {
    7418        1092 :   GEN F1, F2, chi1, chi2, CHI1 = MF_get_CHI(mf), CHI2 = mf_get_CHI(f);
    7419             :   /* are the primitive chars attached to CHI1 and CHI2 equal ? */
    7420        1092 :   F1 = znconreyconductor(gel(CHI1,1), gel(CHI1,2), &chi1);
    7421        1092 :   if (typ(F1) == t_VEC) F1 = gel(F1,1);
    7422        1092 :   F2 = znconreyconductor(gel(CHI2,1), gel(CHI2,2), &chi2);
    7423        1092 :   if (typ(F2) == t_VEC) F2 = gel(F2,1);
    7424        1092 :   return equalii(F1,F2) && ZV_equal(chi1,chi2);
    7425             : }
    7426             : /* check k and CHI rigorously, but not coefficients nor N */
    7427             : static long
    7428         238 : mfisinspace_i(GEN mf, GEN F)
    7429             : {
    7430         238 :   return mfistrivial(F) || (mf_same_k(mf,F) && mf_same_CHI(mf,F));
    7431             : }
    7432             : static void
    7433           7 : err_space(GEN F)
    7434           7 : { pari_err_DOMAIN("mftobasis", "form", "does not belong to",
    7435           0 :                   strtoGENstr("space"), F); }
    7436             : 
    7437             : static long
    7438         147 : mfcheapeisen(GEN mf)
    7439             : {
    7440         147 :   long k, L, N = MF_get_N(mf);
    7441             :   GEN P;
    7442         147 :   if (N <= 70) return 1;
    7443          84 :   k = itos(gceil(MF_get_gk(mf)));
    7444          84 :   if (odd(k)) k--;
    7445          84 :   switch (k)
    7446             :   {
    7447           0 :     case 2:  L = 190; break;
    7448          14 :     case 4:  L = 162; break;
    7449          70 :     case 6:
    7450          70 :     case 8:  L = 88; break;
    7451           0 :     case 10: L = 78; break;
    7452           0 :     default: L = 66; break;
    7453             :   }
    7454          84 :   P = gel(myfactoru(N), 1);
    7455          84 :   return P[lg(P)-1] <= L;
    7456             : }
    7457             : 
    7458             : static GEN
    7459         182 : myimag_i(GEN tau)
    7460             : {
    7461         182 :   long tc = typ(tau);
    7462         182 :   if (tc == t_INFINITY || tc == t_INT || tc == t_FRAC)
    7463          28 :     return gen_1;
    7464         154 :   if (tc == t_VEC)
    7465             :   {
    7466             :     long ltau, i;
    7467           7 :     GEN z = cgetg_copy(tau, &ltau);
    7468          42 :     for (i=1; i<ltau; i++) gel(z,i) = myimag_i(gel(tau,i));
    7469           7 :     return z;
    7470             :   }
    7471         147 :   return imag_i(tau);
    7472             : }
    7473             : 
    7474             : static GEN
    7475         147 : mintau(GEN vtau)
    7476             : {
    7477         147 :   if (!is_vec_t(typ(vtau))) return myimag_i(vtau);
    7478           7 :   return (lg(vtau) == 1)? gen_1: vecmin(myimag_i(vtau));
    7479             : }
    7480             : 
    7481             : /* initialization for mfgaexpansion: what does not depend on cusp */
    7482             : static GEN
    7483         987 : mf_eisendec(GEN mf, GEN F, long prec)
    7484             : {
    7485         987 :   GEN B = liftpol_shallow(mfeisensteindec(mf, F)), v = variables_vecsmall(B);
    7486         987 :   GEN Mvecj = obj_check(mf, MF_EISENSPACE);
    7487         987 :   long l = lg(v), i, ord;
    7488         987 :   if (lg(Mvecj) < 5) Mvecj = gel(Mvecj,1);
    7489         987 :   ord = itou(gel(Mvecj,4));
    7490        1043 :   for (i = 1; i < l; i++)
    7491         714 :     if (v[i] != 1)
    7492             :     {
    7493             :       GEN d;
    7494             :       long e;
    7495         658 :       B = Q_remove_denom(B, &d);
    7496         658 :       e = gexpo(B);
    7497         658 :       if (e > 0) prec += nbits2prec(e);
    7498         658 :       B = gsubst(B, v[i], rootsof1u_cx(ord, prec));
    7499         658 :       if (d) B = gdiv(B, d);
    7500         658 :       break;
    7501             :     }
    7502         987 :   return B;
    7503             : }
    7504             : 
    7505             : GEN
    7506         161 : mfeval(GEN mf0, GEN F, GEN vtau, long bitprec)
    7507             : {
    7508         161 :   pari_sp av = avma;
    7509         161 :   long flnew = 1;
    7510         161 :   GEN mf = checkMF_i(mf0);
    7511         161 :   if (!mf) pari_err_TYPE("mfeval", mf0);
    7512         161 :   if (!checkmf_i(F)) pari_err_TYPE("mfeval", F);
    7513         161 :   if (!mfisinspace_i(mf, F)) err_space(F);
    7514         161 :   if (!obj_check(mf, MF_EISENSPACE)) flnew = mfcheapeisen(mf);
    7515         161 :   if (flnew && gcmpgs(gmulsg(2*MF_get_N(mf), mintau(vtau)), 1) >= 0) flnew = 0;
    7516         161 :   return gerepilecopy(av, mfeval_i(mf, F, vtau, flnew, bitprec));
    7517             : }
    7518             : 
    7519             : static long
    7520         189 : val(GEN v, long bit)
    7521             : {
    7522         189 :   long c, l = lg(v);
    7523         392 :   for (c = 1; c < l; c++)
    7524         378 :     if (gexpo(gel(v,c)) > -bit) return c-1;
    7525          14 :   return -1;
    7526             : }
    7527             : GEN
    7528         203 : mfcuspval(GEN mf, GEN F, GEN cusp, long bitprec)
    7529             : {
    7530         203 :   pari_sp av = avma;
    7531         203 :   long lvE, w, N, sb, n, A, C, prec = nbits2prec(bitprec);
    7532             :   GEN ga, gk, vE;
    7533         203 :   mf = checkMF(mf);
    7534         203 :   if (!checkmf_i(F)) pari_err_TYPE("mfcuspval",F);
    7535         203 :   N = MF_get_N(mf);
    7536         203 :   cusp_canon(cusp, N, &A, &C);
    7537         203 :   gk = mf_get_gk(F);
    7538         203 :   if (typ(gk) != t_INT)
    7539             :   {
    7540          42 :     GEN FT = mfmultheta(F), mf2 = obj_checkbuild(mf, MF_MF2INIT, &mf2init);
    7541          42 :     GEN r = mfcuspval(mf2, FT, cusp, bitprec);
    7542          42 :     if ((C & 3L) == 2)
    7543             :     {
    7544          14 :       GEN z = uutoQ(1,4);
    7545          14 :       r = gsub(r, typ(r) == t_VEC? const_vec(lg(r)-1, z): z);
    7546             :     }
    7547          42 :     return gerepileupto(av, r);
    7548             :   }
    7549         161 :   vE = mfgetembed(F, prec);
    7550         161 :   lvE = lg(vE);
    7551         161 :   w = mfcuspcanon_width(N, C);
    7552         161 :   sb = w * mfsturmNk(N, itos(gk));
    7553         161 :   ga = cusp2mat(A,C);
    7554         168 :   for (n = 8;; n = minss(sb, n << 1))
    7555           7 :   {
    7556         168 :     GEN R = mfgaexpansion(mf, F, ga, n, prec), res = liftpol_shallow(gel(R,3));
    7557         168 :     GEN v = cgetg(lvE-1, t_VECSMALL);
    7558         168 :     long j, ok = 1;
    7559         168 :     res = RgC_embedall(res, vE);
    7560         357 :     for (j = 1; j < lvE; j++)
    7561             :     {
    7562         189 :       v[j] = val(gel(res,j), bitprec/2);
    7563         189 :       if (v[j] < 0) ok = 0;
    7564             :     }
    7565         168 :     if (ok)
    7566             :     {
    7567         154 :       res = cgetg(lvE, t_VEC);
    7568         329 :       for (j = 1; j < lvE; j++) gel(res,j) = gadd(gel(R,1), uutoQ(v[j], w));
    7569         154 :       return gerepilecopy(av, lvE==2? gel(res,1): res);
    7570             :     }
    7571          14 :     if (n == sb) return lvE==2? mkoo(): const_vec(lvE-1, mkoo()); /* 0 */
    7572             :   }
    7573             : }
    7574             : 
    7575             : long
    7576         224 : mfiscuspidal(GEN mf, GEN F)
    7577             : {
    7578         224 :   pari_sp av = avma;
    7579             :   GEN mf2;
    7580         224 :   if (space_is_cusp(MF_get_space(mf))) return 1;
    7581          98 :   if (typ(mf_get_gk(F)) == t_INT)
    7582             :   {
    7583          56 :     GEN v = mftobasis(mf,F,0), vE = vecslice(v, 1, lg(MF_get_E(mf))-1);
    7584          56 :     return gc_long(av, gequal0(vE));
    7585             :   }
    7586          42 :   if (!gequal0(mfak_i(F, 0))) return 0;
    7587          21 :   mf2 = obj_checkbuild(mf, MF_MF2INIT, &mf2init);
    7588          21 :   return mfiscuspidal(mf2, mfmultheta(F));
    7589             : }
    7590             : 
    7591             : /* F = vector of newforms in mftobasis format */
    7592             : static GEN
    7593          98 : mffrickeeigen_i(GEN mf, GEN F, GEN vE, long prec)
    7594             : {
    7595          98 :   GEN M, Z, L0, gN = MF_get_gN(mf), gk = MF_get_gk(mf);
    7596          98 :   long N0, i, lM, bit = prec2nbits(prec), k = itou(gk);
    7597          98 :   long LIM = 5; /* Sturm bound is enough */
    7598             : 
    7599          98 :   L0 = mfthetaancreate(NULL, gN, gk); /* only for thetacost */
    7600          98 : START:
    7601          98 :   N0 = lfunthetacost(L0, gen_1, LIM, bit);
    7602          98 :   M = mfcoefs_mf(mf, N0, 1);
    7603          98 :   lM = lg(F);
    7604          98 :   Z = cgetg(lM, t_VEC);
    7605         273 :   for (i = 1; i < lM; i++)
    7606             :   { /* expansion of D * F[i] */
    7607         175 :     GEN D, z, van = RgM_RgC_mul(M, Q_remove_denom(gel(F,i), &D));
    7608         175 :     GEN L = van_embedall(van, gel(vE,i), gN, gk);
    7609         175 :     long l = lg(L), j, bit_add = D? expi(D): 0;
    7610         175 :     gel(Z,i) = z = cgetg(l, t_VEC);
    7611         553 :     for (j = 1; j < l; j++)
    7612             :     {
    7613             :       GEN v, C, C0;
    7614             :       long m, e;
    7615         511 :       for (m = 0; m <= LIM; m++)
    7616             :       {
    7617         511 :         v = lfuntheta(gmael(L,j,2), gen_1, m, bit);
    7618         511 :         if (gexpo(v) > bit_add - bit/2) break;
    7619             :       }
    7620         378 :       if (m > LIM) { LIM <<= 1; goto START; }
    7621         378 :       C = mulcxpowIs(gdiv(v,conj_i(v)), 2*m - k);
    7622         378 :       C0 = grndtoi(C, &e); if (e < 5-prec2nbits(precision(C))) C = C0;
    7623         378 :       gel(z,j) = C;
    7624             :     }
    7625             :   }
    7626          98 :   return Z;
    7627             : }
    7628             : static GEN
    7629          77 : mffrickeeigen(GEN mf, GEN vE, long prec)
    7630             : {
    7631          77 :   GEN D = obj_check(mf, MF_FRICKE);
    7632          77 :   if (D) { long p = gprecision(D); if (!p || p >= prec) return D; }
    7633          70 :   D = mffrickeeigen_i(mf, MF_get_newforms(mf), vE, prec);
    7634          70 :   return obj_insert(mf, MF_FRICKE, D);
    7635             : }
    7636             : 
    7637             : /* integral weight, new space for primitive quadratic character CHIP;
    7638             :  * MF = vector of embedded eigenforms coefs on mfbasis, by orbit.
    7639             :  * Assume N > Q > 1 and (Q,f(CHIP)) = 1 */
    7640             : static GEN
    7641          56 : mfatkineigenquad(GEN mf, GEN CHIP, long Q, GEN MF, long bitprec)
    7642             : {
    7643             :   GEN L0, la2, S, F, vP, tau, wtau, Z, va, vb, den, coe, sqrtQ, sqrtN;
    7644          56 :   GEN M, gN, gk = MF_get_gk(mf);
    7645          56 :   long N0, x, yq, i, j, lF, dim, muQ, prec = nbits2prec(bitprec);
    7646          56 :   long N = MF_get_N(mf), k = itos(gk), NQ = N / Q;
    7647             : 
    7648             :   /* Q coprime to FC */
    7649          56 :   F = MF_get_newforms(mf);
    7650          56 :   vP = MF_get_fields(mf);
    7651          56 :   lF = lg(F);
    7652          56 :   Z = cgetg(lF, t_VEC);
    7653          56 :   S = MF_get_S(mf); dim = lg(S) - 1;
    7654          56 :   muQ = mymoebiusu(Q);
    7655          56 :   if (muQ)
    7656             :   {
    7657          42 :     GEN SQ = cgetg(dim+1,t_VEC), Qk = gpow(stoi(Q), sstoQ(k-2, 2), prec);
    7658          42 :     long i, bit2 = bitprec >> 1;
    7659         154 :     for (j = 1; j <= dim; j++) gel(SQ,j) = mfak_i(gel(S,j), Q);
    7660          84 :     for (i = 1; i < lF; i++)
    7661             :     {
    7662          42 :       GEN S = RgV_dotproduct(gel(F,i), SQ), T = gel(vP,i);
    7663             :       long e;
    7664          42 :       if (degpol(T) > 1 && typ(S) != t_POLMOD) S = gmodulo(S, T);
    7665          42 :       S = grndtoi(gdiv(conjvec(S, prec), Qk), &e);
    7666          42 :       if (e > -bit2) pari_err_PREC("mfatkineigenquad");
    7667          42 :       if (muQ == -1) S = gneg(S);
    7668          42 :       gel(Z,i) = S;
    7669             :     }
    7670          42 :     return Z;
    7671             :   }
    7672          14 :   la2 = mfchareval(CHIP, Q); /* 1 or -1 */
    7673          14 :   (void)cbezout(Q, NQ, &x, &yq);
    7674          14 :   sqrtQ = sqrtr_abs(utor(Q,prec));
    7675          14 :   tau = mkcomplex(gadd(sstoQ(-1, NQ), uutoQ(1, 1000)),
    7676             :                   divru(sqrtQ, N));
    7677          14 :   den = gaddgs(gmulsg(NQ, tau), 1);
    7678          14 :   wtau = gdiv(gsub(gmulsg(x, tau), sstoQ(yq, Q)), den);
    7679          14 :   coe = gpowgs(gmul(sqrtQ, den), k);
    7680             : 
    7681          14 :   sqrtN = sqrtr_abs(utor(N,prec));
    7682          14 :   tau  = mulcxmI(gmul(tau,  sqrtN));
    7683          14 :   wtau = mulcxmI(gmul(wtau, sqrtN));
    7684          14 :   gN = utoipos(N);
    7685          14 :   L0 = mfthetaancreate(NULL, gN, gk); /* only for thetacost */
    7686          14 :   N0 = maxss(lfunthetacost(L0,real_i(tau), 0,bitprec),
    7687             :              lfunthetacost(L0,real_i(wtau),0,bitprec));
    7688          14 :   M = mfcoefs_mf(mf, N0, 1);
    7689          14 :   va = cgetg(dim+1, t_VEC);
    7690          14 :   vb = cgetg(dim+1, t_VEC);
    7691         105 :   for (j = 1; j <= dim; j++)
    7692             :   {
    7693          91 :     GEN L, v = vecslice(gel(M,j), 2, N0+1); /* remove a0 */
    7694          91 :     settyp(v, t_VEC); L = mfthetaancreate(v, gN, gk);
    7695          91 :     gel(va,j) = lfuntheta(L, tau,0,bitprec);
    7696          91 :     gel(vb,j) = lfuntheta(L,wtau,0,bitprec);
    7697             :   }
    7698          84 :   for (i = 1; i < lF; i++)
    7699             :   {
    7700          70 :     GEN z, FE = gel(MF,i);
    7701          70 :     long l = lg(FE);
    7702          70 :     z = cgetg(l, t_VEC);
    7703          70 :     for (j = 1; j < l; j++)
    7704             :     {
    7705          70 :       GEN f = gel(FE,j), a = RgV_dotproduct(va,f), b = RgV_dotproduct(vb,f);
    7706          70 :       GEN la = ground( gdiv(b, gmul(a,coe)) );
    7707          70 :       if (!gequal(gsqr(la), la2)) pari_err_PREC("mfatkineigenquad");
    7708          70 :       if (typ(la) == t_INT)
    7709             :       {
    7710          70 :         if (j != 1) pari_err_BUG("mfatkineigenquad");
    7711          70 :         z = const_vec(l-1, la); break;
    7712             :       }
    7713           0 :       gel(z,j) = la;
    7714             :     }
    7715          70 :     gel(Z,i) = z;
    7716             :   }
    7717          14 :   return Z;
    7718             : }
    7719             : 
    7720             : static GEN
    7721          84 : myusqrt(ulong a, long prec)
    7722             : {
    7723          84 :   if (a == 1UL) return gen_1;
    7724          70 :   if (uissquareall(a, &a)) return utoipos(a);
    7725          49 :   return sqrtr_abs(utor(a, prec));
    7726             : }
    7727             : /* Assume mf is a nontrivial new space, rational primitive character CHIP
    7728             :  * and (Q,FC) = 1 */
    7729             : static GEN
    7730         105 : mfatkinmatnewquad(GEN mf, GEN CHIP, long Q, long flag, long PREC)
    7731             : {
    7732         105 :   GEN cM, M, D, MF, den, vE, F = MF_get_newforms(mf);
    7733         105 :   long i, c, e, prec, bitprec, lF = lg(F), N = MF_get_N(mf), k = MF_get_k(mf);
    7734             : 
    7735         105 :   if (Q == 1) return mkvec4(gen_0, matid(MF_get_dim(mf)), gen_1, mf);
    7736         105 :   den = gel(MF_get_Minv(mf), 2);
    7737         105 :   bitprec = expi(den) + 64;
    7738         105 :   if (!flag) bitprec = maxss(bitprec, prec2nbits(PREC));
    7739             : 
    7740          35 : START:
    7741         105 :   prec = nbits2prec(bitprec);
    7742         105 :   vE = mfeigenembed(mf, prec);
    7743         105 :   M = cgetg(lF, t_VEC);
    7744         280 :   for (i = 1; i < lF; i++) gel(M,i) = RgC_embedall(gel(F,i), gel(vE,i));
    7745         105 :   if (Q != N)
    7746             :   {
    7747          56 :     D = mfatkineigenquad(mf, CHIP, Q, M, bitprec);
    7748          56 :     c = odd(k)? Q: 1;
    7749             :   }
    7750             :   else
    7751             :   {
    7752          49 :     D = mffrickeeigen(mf, vE, prec);
    7753          49 :     c = mfcharmodulus(CHIP); if (odd(k)) c = -Q/c;
    7754             :   }
    7755         105 :   D = shallowconcat1(D);
    7756         105 :   if (vec_isconst(D)) { MF = diagonal_shallow(D); flag = 0; }
    7757             :   else
    7758             :   {
    7759          63 :     M = shallowconcat1(M);
    7760          63 :     MF = RgM_mul(matmuldiagonal(M,D), ginv(M));
    7761             :   }
    7762         105 :   if (!flag) return mkvec4(gen_0, MF, gen_1, mf);
    7763             : 
    7764          21 :   if (c > 0)
    7765          21 :     cM = myusqrt(c, PREC);
    7766             :   else
    7767             :   {
    7768           0 :     MF = imag_i(MF); c = -c;
    7769           0 :     cM = mkcomplex(gen_0, myusqrt(c,PREC));
    7770             :   }
    7771          21 :   if (c != 1) MF = RgM_Rg_mul(MF, myusqrt(c,prec));
    7772          21 :   MF = grndtoi(RgM_Rg_mul(MF,den), &e);
    7773          21 :   if (e > -32) { bitprec <<= 1; goto START; }
    7774          21 :   MF = RgM_Rg_div(MF, den);
    7775          21 :   if (is_rational_t(typ(cM)) && !isint1(cM))
    7776           0 :   { MF = RgM_Rg_div(MF, cM); cM = gen_1; }
    7777          21 :   return mkvec4(gen_0, MF, cM, mf);
    7778             : }
    7779             : 
    7780             : /* let CHI mod N, Q || N, return \bar{CHI_Q} * CHI_{N/Q} */
    7781             : static GEN
    7782         105 : mfcharAL(GEN CHI, long Q)
    7783             : {
    7784         105 :   GEN G = gel(CHI,1), c = gel(CHI,2), cycc, d, P, E, F;
    7785         105 :   long l = lg(c), N = mfcharmodulus(CHI), i;
    7786         105 :   if (N == Q) return mfcharconj(CHI);
    7787          49 :   if (N == 1) return CHI;
    7788          42 :   CHI = leafcopy(CHI);
    7789          42 :   gel(CHI,2) = d = leafcopy(c);
    7790          42 :   F = znstar_get_faN(G);
    7791          42 :   P = gel(F,1);
    7792          42 :   E = gel(F,2);
    7793          42 :   cycc = znstar_get_conreycyc(G);
    7794          42 :   if (!odd(Q) && equaliu(gel(P,1), 2) && E[1] >= 3)
    7795          14 :     gel(d,2) = Fp_neg(gel(d,2), gel(cycc,2));
    7796          56 :   else for (i = 1; i < l; i++)
    7797          28 :     if (!umodui(Q, gel(P,i))) gel(d,i) = Fp_neg(gel(d,i), gel(cycc,i));
    7798          42 :   return CHI;
    7799             : }
    7800             : static long
    7801         231 : atkin_get_NQ(long N, long Q, const char *f)
    7802             : {
    7803         231 :   long NQ = N / Q;
    7804         231 :   if (N % Q) pari_err_DOMAIN(f,"N % Q","!=",gen_0,utoi(Q));
    7805         231 :   if (ugcd(NQ, Q) > 1) pari_err_DOMAIN(f,"gcd(Q,N/Q)","!=",gen_1,utoi(Q));
    7806         231 :   return NQ;
    7807             : }
    7808             : 
    7809             : /* transform mf to new_NEW if possible */
    7810             : static GEN
    7811        1330 : MF_set_new(GEN mf)
    7812             : {
    7813        1330 :   GEN vMjd, vj, gk = MF_get_gk(mf);
    7814             :   long l, j;
    7815        1330 :   if (MF_get_space(mf) != mf_CUSP
    7816        1330 :       || typ(gk) != t_INT || itou(gk) == 1) return mf;
    7817         175 :   vMjd = MFcusp_get_vMjd(mf); l = lg(vMjd);
    7818         175 :   if (l > 1 && gel(vMjd,1)[1] != MF_get_N(mf)) return mf; /* oldspace != 0 */
    7819         168 :   mf = shallowcopy(mf);
    7820         168 :   gel(mf,1) = shallowcopy(gel(mf,1));
    7821         168 :   MF_set_space(mf, mf_NEW);
    7822         168 :   vj = cgetg(l, t_VECSMALL);
    7823         917 :   for (j = 1; j < l; j++) vj[j] = gel(vMjd, j)[2];
    7824         168 :   gel(mf,4) = vj; return mf;
    7825             : }
    7826             : 
    7827             : /* if flag = 1, rationalize, else don't */
    7828             : static GEN
    7829         210 : mfatkininit_i(GEN mf, long Q, long flag, long prec)
    7830             : {
    7831             :   GEN M, B, C, CHI, CHIAL, G, chi, P, z, g, mfB, s, Mindex, Minv;
    7832         210 :   long j, l, lim, ord, FC, NQ, cQ, nk, dk, N = MF_get_N(mf);
    7833             : 
    7834         210 :   B = MF_get_basis(mf); l = lg(B);
    7835         210 :   M = cgetg(l, t_MAT); if (l == 1) return mkvec4(gen_0,M,gen_1,mf);
    7836         210 :   Qtoss(MF_get_gk(mf), &nk,&dk);
    7837         210 :   Q = labs(Q);
    7838         210 :   NQ = atkin_get_NQ(N, Q, "mfatkininit");
    7839         210 :   CHI = MF_get_CHI(mf);
    7840         210 :   CHI = mfchartoprimitive(CHI, &FC);
    7841         210 :   ord = mfcharorder(CHI);
    7842         210 :   mf = MF_set_new(mf);
    7843         210 :   if (MF_get_space(mf) == mf_NEW && ord <= 2 && NQ % FC == 0 && dk == 1)
    7844         105 :     return mfatkinmatnewquad(mf, CHI, Q, flag, prec);
    7845             :   /* now flag != 0 */
    7846         105 :   G   = gel(CHI,1);
    7847         105 :   chi = gel(CHI,2);
    7848         105 :   if (Q == N) { g = mkmat22s(0, -1, N, 0); cQ = NQ; } /* Fricke */
    7849             :   else
    7850             :   {
    7851          28 :     GEN F, gQP = utoi(ugcd(Q, FC));
    7852             :     long t, v;
    7853          28 :     chi = znchardecompose(G, chi, gQP);
    7854          28 :     F = znconreyconductor(G, chi, &chi);
    7855          28 :     G = znstar0(F,1);
    7856          28 :     (void)cbezout(Q, NQ, &t, &v);
    7857          28 :     g = mkmat22s(Q*t, 1, -N*v, Q);
    7858          28 :     cQ = -NQ*v;
    7859             :   }
    7860         105 :   C = s = gen_1;
    7861             :   /* N.B. G,chi are G_Q,chi_Q [primitive] at this point */
    7862         105 :   if (lg(chi) != 1) C = ginv( znchargauss(G, chi, gen_1, prec2nbits(prec)) );
    7863         105 :   if (dk == 1)
    7864          84 :   { if (odd(nk)) s = myusqrt(Q,prec); }
    7865             :   else
    7866             :   {
    7867          21 :     long r = nk >> 1; /* k-1/2 */
    7868          21 :     s = gpow(utoipos(Q), mkfracss(odd(r)? 1: 3, 4), prec);
    7869          21 :     if (odd(cQ))
    7870             :     {
    7871          21 :       long t = r + ((cQ-1) >> 1);
    7872          21 :       s = mkcomplex(s, odd(t)? gneg(s): s);
    7873             :     }
    7874             :   }
    7875         105 :   if (!isint1(s)) C = gmul(C, s);
    7876         105 :   CHIAL = mfcharAL(CHI, Q);
    7877         105 :   if (dk == 2)
    7878             :   {
    7879          21 :     ulong q = odd(Q)? Q << 2: Q, Nq = ulcm(q, mfcharmodulus(CHIAL));
    7880          21 :     CHIAL = induceN(Nq, CHIAL);
    7881          21 :     CHIAL = mfcharmul(CHIAL, induce(gel(CHIAL,1), utoipos(q)));
    7882             :   }
    7883         105 :   CHIAL = mfchartoprimitive(CHIAL,NULL);
    7884         105 :   mfB = gequal(CHIAL,CHI)? mf: mfinit_Nndkchi(N,nk,dk,CHIAL,MF_get_space(mf),0);
    7885         105 :   Mindex = MF_get_Mindex(mfB);
    7886         105 :   Minv = MF_get_Minv(mfB);
    7887         105 :   P = z = NULL;
    7888         105 :   if (ord > 2) { P = mfcharpol(CHI); z = rootsof1u_cx(ord, prec); }
    7889         105 :   lim = maxss(mfsturm(mfB), mfsturm(mf)) + 1;
    7890         343 :   for (j = 1; j < l; j++)
    7891             :   {
    7892         238 :     GEN v = mfslashexpansion(mf, gel(B,j), g, lim, 0, NULL, prec+EXTRAPREC64);
    7893             :     long junk;
    7894         238 :     if (!isint1(C)) v = RgV_Rg_mul(v, C);
    7895         238 :     v = bestapprnf(v, P, z, prec);
    7896         238 :     v = vecpermute_partial(v, Mindex, &junk);
    7897         238 :     v = Minv_RgC_mul(Minv, v); /* cf mftobasis_i */
    7898         238 :     gel(M, j) = v;
    7899             :   }
    7900         105 :   if (is_rational_t(typ(C)) && !gequal1(C)) { M = gdiv(M, C); C = gen_1; }
    7901         105 :   if (mfB == mf) mfB = gen_0;
    7902         105 :   return mkvec4(mfB, M, C, mf);
    7903             : }
    7904             : GEN
    7905          91 : mfatkininit(GEN mf, long Q, long prec)
    7906             : {
    7907          91 :   pari_sp av = avma;
    7908          91 :   mf = checkMF(mf); return gerepilecopy(av, mfatkininit_i(mf, Q, 1, prec));
    7909             : }
    7910             : static void
    7911          56 : checkmfa(GEN z)
    7912             : {
    7913          56 :   if (typ(z) != t_VEC || lg(z) != 5 || typ(gel(z,2)) != t_MAT
    7914          56 :       || !checkMF_i(gel(z,4))
    7915          56 :       || (!isintzero(gel(z,1)) && !checkMF_i(gel(z,1))))
    7916           0 :     pari_err_TYPE("mfatkin [please apply mfatkininit()]",z);
    7917          56 : }
    7918             : 
    7919             : /* Apply atkin Q to closure F */
    7920             : GEN
    7921          56 : mfatkin(GEN mfa, GEN F)
    7922             : {
    7923          56 :   pari_sp av = avma;
    7924             :   GEN z, mfB, MQ, mf;
    7925          56 :   checkmfa(mfa);
    7926          56 :   mfB= gel(mfa,1);
    7927          56 :   MQ = gel(mfa,2);
    7928          56 :   mf = gel(mfa,4);
    7929          56 :   if (typ(mfB) == t_INT) mfB = mf;
    7930          56 :   z = RgM_RgC_mul(MQ, mftobasis_i(mf,F));
    7931          56 :   return gerepileupto(av, mflinear(mfB, z));
    7932             : }
    7933             : 
    7934             : GEN
    7935          49 : mfatkineigenvalues(GEN mf, long Q, long prec)
    7936             : {
    7937          49 :   pari_sp av = avma;
    7938             :   GEN vF, L, CHI, M, mfatk, C, MQ, vE, mfB;
    7939             :   long N, NQ, l, i;
    7940             : 
    7941          49 :   mf = checkMF(mf); N = MF_get_N(mf);
    7942          49 :   vF = MF_get_newforms(mf); l = lg(vF);
    7943             :   /* N.B. k is integral */
    7944          49 :   if (l == 1) { set_avma(av); return cgetg(1, t_VEC); }
    7945          49 :   L = cgetg(l, t_VEC);
    7946          49 :   if (Q == 1)
    7947             :   {
    7948           7 :     GEN vP = MF_get_fields(mf);
    7949          21 :     for (i = 1; i < l; i++) gel(L,i) = const_vec(degpol(gel(vP,i)), gen_1);
    7950           7 :     return L;
    7951             :   }
    7952          42 :   vE = mfeigenembed(mf,prec);
    7953          42 :   if (Q == N) return gerepileupto(av, mffrickeeigen(mf, vE, prec));
    7954          21 :   Q = labs(Q);
    7955          21 :   NQ = atkin_get_NQ(N, Q, "mfatkineigenvalues"); /* != 1 */
    7956          21 :   mfatk = mfatkininit(mf, Q, prec);
    7957          21 :   mfB= gel(mfatk,1); if (typ(mfB) != t_VEC) mfB = mf;
    7958          21 :   MQ = gel(mfatk,2);
    7959          21 :   C  = gel(mfatk,3);
    7960          21 :   M = row(mfcoefs_mf(mfB,1,1), 2); /* vec of a_1(b_i) for mfbasis functions */
    7961          56 :   for (i = 1; i < l; i++)
    7962             :   {
    7963          35 :     GEN c = RgV_dotproduct(RgM_RgC_mul(MQ,gel(vF,i)), M); /* C * eigen_i */
    7964          35 :     gel(L,i) = Rg_embedall_i(c, gel(vE,i));
    7965             :   }
    7966          21 :   if (!gequal1(C)) L = gdiv(L, C);
    7967          21 :   CHI = MF_get_CHI(mf);
    7968          21 :   if (mfcharorder(CHI) <= 2 && NQ % mfcharconductor(CHI) == 0) L = ground(L);
    7969          21 :   return gerepilecopy(av, L);
    7970             : }
    7971             : 
    7972             : /* expand B_d V, keeping same length */
    7973             : static GEN
    7974        6139 : bdexpand(GEN V, long d)
    7975             : {
    7976             :   GEN W;
    7977             :   long N, n;
    7978        6139 :   if (d == 1) return V;
    7979        2282 :   N = lg(V)-1; W = zerovec(N);
    7980       43519 :   for (n = 0; n <= (N-1)/d; n++) gel(W, n*d+1) = gel(V, n+1);
    7981        2282 :   return W;
    7982             : }
    7983             : /* expand B_d V, increasing length up to lim */
    7984             : static GEN
    7985         287 : bdexpandall(GEN V, long d, long lim)
    7986             : {
    7987             :   GEN W;
    7988             :   long N, n;
    7989         287 :   if (d == 1) return V;
    7990          35 :   N = lg(V)-1; W = zerovec(lim);
    7991         259 :   for (n = 0; n <= N-1 && n*d <= lim; n++) gel(W, n*d+1) = gel(V, n+1);
    7992          35 :   return W;
    7993             : }
    7994             : 
    7995             : static void
    7996        9086 : parse_vecj(GEN T, GEN *E1, GEN *E2)
    7997             : {
    7998        9086 :   if (lg(T)==3) { *E1 = gel(T,1); *E2 = gel(T,2); }
    7999        4963 :   else { *E1 = T; *E2 = NULL; }
    8000        9086 : }
    8001             : 
    8002             : /* g in M_2(Z) ? */
    8003             : static int
    8004        2877 : check_M2Z(GEN g)
    8005        2877 : {  return typ(g) == t_MAT && lg(g) == 3 && lgcols(g) == 3 && RgM_is_ZM(g); }
    8006             : /* g in SL_2(Z) ? */
    8007             : static int
    8008        1757 : check_SL2Z(GEN g) { return check_M2Z(g) && equali1(ZM_det(g)); }
    8009             : 
    8010             : static GEN
    8011        9065 : mfcharcxeval(GEN CHI, long n, long prec)
    8012             : {
    8013        9065 :   ulong ord, N = mfcharmodulus(CHI);
    8014             :   GEN ordg;
    8015        9065 :   if (N == 1) return gen_1;
    8016        3696 :   if (ugcd(N, labs(n)) > 1) return gen_0;
    8017        3696 :   ordg = gmfcharorder(CHI);
    8018        3696 :   ord = itou(ordg);
    8019        3696 :   return rootsof1q_cx(znchareval_i(CHI,n,ordg), ord, prec);
    8020             : }
    8021             : 
    8022             : static GEN
    8023        4963 : RgV_shift(GEN V, GEN gn)
    8024             : {
    8025             :   long i, n, l;
    8026             :   GEN W;
    8027        4963 :   if (typ(gn) != t_INT) pari_err_BUG("RgV_shift [n not integral]");
    8028        4963 :   n = itos(gn);
    8029        4963 :   if (n < 0) pari_err_BUG("RgV_shift [n negative]");
    8030        4963 :   if (!n) return V;
    8031         112 :   W = cgetg_copy(V, &l); if (n > l-1) n = l-1;
    8032         308 :   for (i=1; i <= n; i++) gel(W,i) = gen_0;
    8033        4900 :   for (    ; i < l; i++) gel(W,i) = gel(V, i-n);
    8034         112 :   return W;
    8035             : }
    8036             : static GEN
    8037        7630 : hash_eisengacx(hashtable *H, void *E, long w, GEN ga, long n, long prec)
    8038             : {
    8039        7630 :   ulong h = H->hash(E);
    8040        7630 :   hashentry *e = hash_search2(H, E, h);
    8041             :   GEN v;
    8042        7630 :   if (e) v = (GEN)e->val;
    8043             :   else
    8044             :   {
    8045        5159 :     v = mfeisensteingacx((GEN)E, w, ga, n, prec);
    8046        5159 :     hash_insert2(H, E, (void*)v, h);
    8047             :   }
    8048        7630 :   return v;
    8049             : }
    8050             : static GEN
    8051        4963 : vecj_expand(GEN B, hashtable *H, long w, GEN ga, long n, long prec)
    8052             : {
    8053             :   GEN E1, E2, v;
    8054        4963 :   parse_vecj(B, &E1, &E2);
    8055        4963 :   v = hash_eisengacx(H, (void*)E1, w, ga, n, prec);
    8056        4963 :   if (E2)
    8057             :   {
    8058        2611 :     GEN u = hash_eisengacx(H, (void*)E2, w, ga, n, prec);
    8059        2611 :     GEN a = gadd(gel(v,1), gel(u,1));
    8060        2611 :     GEN b = RgV_mul_RgXn(gel(v,2), gel(u,2));
    8061        2611 :     v = mkvec2(a,b);
    8062             :   }
    8063        4963 :   return v;
    8064             : }
    8065             : static GEN
    8066        1050 : shift_M(GEN M, GEN Valpha, long w)
    8067             : {
    8068        1050 :   long i, l = lg(Valpha);
    8069        1050 :   GEN almin = vecmin(Valpha);
    8070        6013 :   for (i = 1; i < l; i++)
    8071             :   {
    8072        4963 :     GEN alpha = gel(Valpha, i), gsh = gmulsg(w, gsub(alpha,almin));
    8073        4963 :     gel(M,i) = RgV_shift(gel(M,i), gsh);
    8074             :   }
    8075        1050 :   return almin;
    8076             : }
    8077             : static GEN mfeisensteinspaceinit(GEN NK);
    8078             : #if 0
    8079             : /* ga in M_2^+(Z)), n >= 0 */
    8080             : static GEN
    8081             : mfgaexpansion_init(GEN mf, GEN ga, long n, long prec)
    8082             : {
    8083             :   GEN M, Mvecj, vecj, almin, Valpha;
    8084             :   long i, w, l, N = MF_get_N(mf), c = itos(gcoeff(ga,2,1));
    8085             :   hashtable *H;
    8086             : 
    8087             :   if (c % N == 0)
    8088             :   { /* ga in G_0(N), trivial case; w = 1 */
    8089             :     GEN chid = mfcharcxeval(MF_get_CHI(mf), itos(gcoeff(ga,2,2)), prec);
    8090             :     return mkvec2(chid, utoi(n));
    8091             :   }
    8092             : 
    8093             :   Mvecj = obj_checkbuild(mf, MF_EISENSPACE, &mfeisensteinspaceinit);
    8094             :   if (lg(Mvecj) < 5) pari_err_IMPL("mfgaexpansion_init in this case");
    8095             :   w = mfcuspcanon_width(N, c);
    8096             :   vecj = gel(Mvecj, 3);
    8097             :   l = lg(vecj);
    8098             :   M = cgetg(l, t_VEC);
    8099             :   Valpha = cgetg(l, t_VEC);
    8100             :   H = hash_create(l, (ulong(*)(void*))&hash_GEN,
    8101             :                      (int(*)(void*,void*))&gidentical, 1);
    8102             :   for (i = 1; i < l; i++)
    8103             :   {
    8104             :     GEN v = vecj_expand(gel(vecj,i), H, w, ga, n, prec);
    8105             :     gel(Valpha,i) = gel(v,1);
    8106             :     gel(M,i) = gel(v,2);
    8107             :   }
    8108             :   almin = shift_M(M, Valpha, w);
    8109             :   return mkvec3(almin, utoi(w), M);
    8110             : }
    8111             : /* half-integer weight not supported; vF = [F,eisendec(F)].
    8112             :  * Minit = mfgaexpansion_init(mf, ga, n, prec) */
    8113             : static GEN
    8114             : mfgaexpansion_with_init(GEN Minit, GEN vF)
    8115             : {
    8116             :   GEN v;
    8117             :   if (lg(Minit) == 3)
    8118             :   { /* ga in G_0(N) */
    8119             :     GEN chid = gel(Minit,1), gn = gel(Minit,2);
    8120             :     v = mfcoefs_i(gel(vF,1), itou(gn), 1);
    8121             :     v = mkvec3(gen_0, gen_1, RgV_Rg_mul(v,chid));
    8122             :   }
    8123             :   else
    8124             :   {
    8125             :     GEN V = RgM_RgC_mul(gel(Minit,3), gel(vF,2));
    8126             :     v = mkvec3(gel(Minit,1), gel(Minit,2), V);
    8127             :   }
    8128             :   return v;
    8129             : }
    8130             : #endif
    8131             : 
    8132             : /* B = mfeisensteindec(F) already embedded, ga in M_2^+(Z)), n >= 0 */
    8133             : static GEN
    8134        1050 : mfgaexpansion_i(GEN mf, GEN B0, GEN ga, long n, long prec)
    8135             : {
    8136        1050 :   GEN M, Mvecj, vecj, almin, Valpha, B, E = NULL;
    8137        1050 :   long i, j, w, nw, l, N = MF_get_N(mf), bit = prec2nbits(prec) / 2;
    8138             :   hashtable *H;
    8139             : 
    8140        1050 :   Mvecj = obj_check(mf, MF_EISENSPACE);
    8141        1050 :   if (lg(Mvecj) < 5) { E = gel(Mvecj, 2); Mvecj = gel(Mvecj, 1); }
    8142        1050 :   vecj = gel(Mvecj, 3);
    8143        1050 :   l = lg(vecj);
    8144        1050 :   B = cgetg(l, t_COL);
    8145        1050 :   M = cgetg(l, t_VEC);
    8146        1050 :   Valpha = cgetg(l, t_VEC);
    8147        1050 :   w = mfZC_width(N, gel(ga,1));
    8148        1050 :   nw = E ? n + w : n;
    8149        1050 :   H = hash_create(l, (ulong(*)(void*))&hash_GEN,
    8150             :                      (int(*)(void*,void*))&gidentical, 1);
    8151        8932 :   for (i = j = 1; i < l; i++)
    8152             :   {
    8153             :     GEN v;
    8154        7882 :     if (gequal0(gel(B0,i))) continue;
    8155        4963 :     v = vecj_expand(gel(vecj,i), H, w, ga, nw, prec);
    8156        4963 :     gel(B,j) = gel(B0,i);
    8157        4963 :     gel(Valpha,j) = gel(v,1);
    8158        4963 :     gel(M,j) = gel(v,2); j++;
    8159             :   }
    8160        1050 :   setlg(Valpha, j);
    8161        1050 :   setlg(B, j);
    8162        1050 :   setlg(M, j); l = j;
    8163        1050 :   if (l == 1) return mkvec3(gen_0, utoi(w), zerovec(n+1));
    8164        1050 :   almin = shift_M(M, Valpha, w);
    8165        1050 :   B = RgM_RgC_mul(M, B); l = lg(B);
    8166      147812 :   for (i = 1; i < l; i++)
    8167      146762 :     if (gexpo(gel(B,i)) < -bit) gel(B,i) = gen_0;
    8168        1050 :   settyp(B, t_VEC);
    8169        1050 :   if (E)
    8170             :   {
    8171             :     GEN v, e;
    8172          56 :     long ell = 0, vB, ve;
    8173         126 :     for (i = 1; i < l; i++)
    8174         126 :       if (!gequal0(gel(B,i))) break;
    8175          56 :     vB = i-1;
    8176          56 :     v = hash_eisengacx(H, (void*)E, w, ga, n + vB, prec);
    8177          56 :     e = gel(v,2); l = lg(e);
    8178          56 :     for (i = 1; i < l; i++)
    8179          56 :       if (!gequal0(gel(e,i))) break;
    8180          56 :     ve = i-1;
    8181          56 :     almin = gsub(almin, gel(v,1));
    8182          56 :     if (gsigne(almin) < 0)
    8183             :     {
    8184           0 :       GEN gell = gceil(gmulsg(-w, almin));
    8185           0 :       ell = itos(gell);
    8186           0 :       almin = gadd(almin, gdivgu(gell, w));
    8187           0 :       if (nw < ell) pari_err_IMPL("alpha < 0 in mfgaexpansion");
    8188             :     }
    8189          56 :     if (ve) { ell += ve; e = vecslice(e, ve+1, l-1); }
    8190          56 :     B = vecslice(B, ell + 1, minss(n + ell + 1, lg(B)-1));
    8191          56 :     B = RgV_div_RgXn(B, e);
    8192             :   }
    8193        1050 :   return mkvec3(almin, utoi(w), B);
    8194             : }
    8195             : 
    8196             : /* Theta multiplier: assume 4 | C, (C,D)=1 */
    8197             : static GEN
    8198         343 : mfthetamultiplier(GEN C, GEN D)
    8199             : {
    8200         343 :   long s = kronecker(C, D);
    8201         343 :   if (Mod4(D) == 1) return s > 0 ? gen_1: gen_m1;
    8202          84 :   return s > 0? powIs(3): gen_I();
    8203             : }
    8204             : /* theta | [*,*;C,D] defined over Q(i) [else over Q] */
    8205             : static int
    8206          56 : mfthetaI(long C, long D) { return odd(C) || (D & 3) == 3; }
    8207             : /* (theta | M) [0..n], assume (C,D) = 1 */
    8208             : static GEN
    8209         343 : mfthetaexpansion(GEN M, long n)
    8210             : {
    8211         343 :   GEN w, s, al, sla, E, V = zerovec(n+1), C = gcoeff(M,2,1), D = gcoeff(M,2,2);
    8212         343 :   long lim, la, f, C4 = Mod4(C);
    8213         343 :   switch (C4)
    8214             :   {
    8215          70 :     case 0: al = gen_0; w = gen_1;
    8216          70 :       s = mfthetamultiplier(C,D);
    8217          70 :       lim = usqrt(n); gel(V, 1) = s;
    8218          70 :       s = gmul2n(s, 1);
    8219         756 :       for (f = 1; f <= lim; f++) gel(V, f*f + 1) = s;
    8220          70 :       break;
    8221         105 :     case 2: al = uutoQ(1,4); w = gen_1;
    8222         105 :       E = subii(C, shifti(D,1)); /* (E, D) = 1 */
    8223         105 :       s = gmul2n(mfthetamultiplier(E, D), 1);
    8224         105 :       if ((!signe(E) && equalim1(D)) || (signe(E) > 0 && signe(C) < 0))
    8225          14 :         s = gneg(s);
    8226         105 :       lim = (usqrt(n << 2) - 1) >> 1;
    8227         966 :       for (f = 0; f <= lim; f++) gel(V, f*(f+1) + 1) = s;
    8228         105 :       break;
    8229         168 :     default: al = gen_0; w = utoipos(4);
    8230         168 :       la = (-Mod4(D)*C4) & 3L;
    8231         168 :       E = negi(addii(D, mului(la, C)));
    8232         168 :       s = mfthetamultiplier(E, C); /* (E,C) = 1 */
    8233         168 :       if (signe(C) < 0 && signe(E) >= 0) s = gneg(s);
    8234         168 :       s = gsub(s, mulcxI(s));
    8235         168 :       sla = gmul(s, powIs(-la));
    8236         168 :       lim = usqrt(n); gel(V, 1) = gmul2n(s, -1);
    8237        1708 :       for (f = 1; f <= lim; f++) gel(V, f*f + 1) = odd(f) ? sla : s;
    8238         168 :       break;
    8239             :   }
    8240         343 :   return mkvec3(al, w, V);
    8241             : }
    8242             : 
    8243             : /* F 1/2 integral weight */
    8244             : static GEN
    8245         343 : mf2gaexpansion(GEN mf2, GEN F, GEN ga, long n, long prec)
    8246             : {
    8247         343 :   GEN FT = mfmultheta(F), mf = obj_checkbuild(mf2, MF_MF2INIT, &mf2init);
    8248         343 :   GEN res, V1, Tres, V2, al, V, gsh, C = gcoeff(ga,2,1);
    8249         343 :   long w2, N = MF_get_N(mf), w = mfcuspcanon_width(N, umodiu(C,N));
    8250         343 :   long ext = (Mod4(C) != 2)? 0: (w+3) >> 2;
    8251         343 :   long prec2 = prec + nbits2extraprec((long)M_PI/(2*M_LN2)*sqrt(n + ext));
    8252         343 :   res = mfgaexpansion(mf, FT, ga, n + ext, prec2);
    8253         343 :   Tres = mfthetaexpansion(ga, n + ext);
    8254         343 :   V1 = gel(res,3);
    8255         343 :   V2 = gel(Tres,3);
    8256         343 :   al = gsub(gel(res,1), gel(Tres,1));
    8257         343 :   w2 = itos(gel(Tres,2));
    8258         343 :   if (w != itos(gel(res,2)) || w % w2)
    8259           0 :     pari_err_BUG("mf2gaexpansion [incorrect w2 or w]");
    8260         343 :   if (w2 != w) V2 = bdexpand(V2, w/w2);
    8261         343 :   V = RgV_div_RgXn(V1, V2);
    8262         343 :   gsh = gfloor(gmulsg(w, al));
    8263         343 :   if (!gequal0(gsh))
    8264             :   {
    8265          35 :     al = gsub(al, gdivgu(gsh, w));
    8266          35 :     if (gsigne(gsh) > 0)
    8267             :     {
    8268           0 :       V = RgV_shift(V, gsh);
    8269           0 :       V = vecslice(V, 1, n + 1);
    8270             :     }
    8271             :     else
    8272             :     {
    8273          35 :       long sh = -itos(gsh), i;
    8274          35 :       if (sh > ext) pari_err_BUG("mf2gaexpansion [incorrect sh]");
    8275         154 :       for (i = 1; i <= sh; i++)
    8276         119 :         if (!gequal0(gel(V,i))) pari_err_BUG("mf2gaexpansion [sh too large]");
    8277          35 :       V = vecslice(V, sh+1, n + sh+1);
    8278             :     }
    8279             :   }
    8280         343 :   obj_free(mf); return mkvec3(al, stoi(w), gprec_wtrunc(V, prec));
    8281             : }
    8282             : 
    8283             : static GEN
    8284          70 : mfgaexpansionatkin(GEN mf, GEN F, GEN C, GEN D, long Q, long n, long prec)
    8285             : {
    8286          70 :   GEN mfa = mfatkininit_i(mf, Q, 0, prec), MQ = gel(mfa,2);
    8287          70 :   long i, FC, k = MF_get_k(mf);
    8288          70 :   GEN x, v, V, z, s, CHI = mfchartoprimitive(MF_get_CHI(mf), &FC);
    8289             : 
    8290             :   /* V = mfcoefs(F | w_Q, n), can't use mfatkin because MQ nonrational */
    8291          70 :   V = RgM_RgC_mul(mfcoefs_mf(mf,n,1), RgM_RgC_mul(MQ, mftobasis_i(mf,F)));
    8292          70 :   (void)bezout(utoipos(Q), C, &x, &v);
    8293          70 :   s = mfchareval(CHI, (umodiu(x, FC) * umodiu(D, FC)) % FC);
    8294          70 :   s = gdiv(s, gpow(utoipos(Q), uutoQ(k,2), prec));
    8295          70 :   V = RgV_Rg_mul(V, s);
    8296          70 :   z = rootsof1powinit(umodiu(D,Q)*umodiu(v,Q) % Q, Q, prec);
    8297        8253 :   for (i = 1; i <= n+1; i++) gel(V,i) = gmul(gel(V,i), rootsof1pow(z, i-1));
    8298          70 :   return mkvec3(gen_0, utoipos(Q), V);
    8299             : }
    8300             : 
    8301             : static long
    8302          70 : inveis_extraprec(long N, GEN ga, GEN Mvecj, long n)
    8303             : {
    8304          70 :   long e, w = mfZC_width(N, gel(ga,1));
    8305          70 :   GEN f, E = gel(Mvecj,2), v = mfeisensteingacx(E, w, ga, n, DEFAULTPREC);
    8306          70 :   v = gel(v,2);
    8307          70 :   f = RgV_to_RgX(v,0); n -= RgX_valrem(f, &f);
    8308          70 :   e = gexpo(RgXn_inv(f, n+1));
    8309          70 :   return (e > 0)? nbits2extraprec(e): 0;
    8310             : }
    8311             : /* allow F of the form [F, mf_eisendec(F)]~ */
    8312             : static GEN
    8313        1750 : mfgaexpansion(GEN mf, GEN F, GEN ga, long n, long prec)
    8314             : {
    8315        1750 :   GEN v, EF = NULL, res, Mvecj, c, d;
    8316             :   long precnew, N;
    8317             : 
    8318        1750 :   if (n < 0) pari_err_DOMAIN("mfgaexpansion", "n", "<", gen_0, stoi(n));
    8319        1750 :   if (typ(F) == t_COL && lg(F) == 3) { EF = gel(F,2); F = gel(F,1); }
    8320        1750 :   if (!checkmf_i(F)) pari_err_TYPE("mfgaexpansion", F);
    8321        1750 :   if (!check_SL2Z(ga)) pari_err_TYPE("mfgaexpansion",ga);
    8322        1750 :   if (typ(mf_get_gk(F)) != t_INT) return mf2gaexpansion(mf, F, ga, n, prec);
    8323        1407 :   c = gcoeff(ga,2,1);
    8324        1407 :   d = gcoeff(ga,2,2);
    8325        1407 :   N = MF_get_N(mf);
    8326        1407 :   if (!umodiu(c, mf_get_N(F)))
    8327             :   { /* trivial case: ga in Gamma_0(N) */
    8328         287 :     long w = mfcuspcanon_width(N, umodiu(c,N));
    8329         287 :     GEN CHI = mf_get_CHI(F);
    8330         287 :     GEN chid = mfcharcxeval(CHI, umodiu(d,mfcharmodulus(CHI)), prec);
    8331         287 :     v = mfcoefs_i(F, n/w, 1); if (!isint1(chid)) v = RgV_Rg_mul(v,chid);
    8332         287 :     return mkvec3(gen_0, stoi(w), bdexpandall(v,w,n+1));
    8333             :   }
    8334        1120 :   mf = MF_set_new(mf);
    8335        1120 :   if (MF_get_space(mf) == mf_NEW)
    8336             :   {
    8337         441 :     long cN = umodiu(c,N), g = ugcd(cN,N), Q = N/g;
    8338         441 :     GEN CHI = MF_get_CHI(mf);
    8339         441 :     if (ugcd(cN, Q)==1 && mfcharorder(CHI) <= 2
    8340         217 :                        && g % mfcharconductor(CHI) == 0
    8341         112 :                        && degpol(mf_get_field(F)) == 1)
    8342          70 :       return mfgaexpansionatkin(mf, F, c, d, Q, n, prec);
    8343             :   }
    8344        1050 :   Mvecj = obj_checkbuild(mf, MF_EISENSPACE, &mfeisensteinspaceinit);
    8345        1050 :   precnew = prec;
    8346        1050 :   if (lg(Mvecj) < 5) precnew += inveis_extraprec(N, ga, Mvecj, n);
    8347        1050 :   if (!EF) EF = mf_eisendec(mf, F, precnew);
    8348        1050 :   res = mfgaexpansion_i(mf, EF, ga, n, precnew);
    8349        1050 :   return precnew == prec ? res : gprec_wtrunc(res, prec);
    8350             : }
    8351             : 
    8352             : /* parity = -1 or +1 */
    8353             : static GEN
    8354         217 : findd(long N, long parity)
    8355             : {
    8356         217 :   GEN L, D = mydivisorsu(N);
    8357         217 :   long i, j, l = lg(D);
    8358         217 :   L = cgetg(l, t_VEC);
    8359        1218 :   for (i = j = 1; i < l; i++)
    8360             :   {
    8361        1001 :     long d = D[i];
    8362        1001 :     if (parity == -1) d = -d;
    8363        1001 :     if (sisfundamental(d)) gel(L,j++) = stoi(d);
    8364             :   }
    8365         217 :   setlg(L,j); return L;
    8366             : }
    8367             : /* does ND contain a divisor of N ? */
    8368             : static int
    8369         413 : seenD(long N, GEN ND)
    8370             : {
    8371         413 :   long j, l = lg(ND);
    8372         427 :   for (j = 1; j < l; j++)
    8373          14 :     if (N % ND[j] == 0) return 1;
    8374         413 :   return 0;
    8375             : }
    8376             : static GEN
    8377          63 : search_levels(GEN vN, const char *f)
    8378             : {
    8379          63 :   switch(typ(vN))
    8380             :   {
    8381          28 :     case t_INT: vN = mkvecsmall(itos(vN)); break;
    8382          35 :     case t_VEC: case t_COL: vN = ZV_to_zv(vN); break;
    8383           0 :     case t_VECSMALL: vN = leafcopy(vN); break;
    8384           0 :     default: pari_err_TYPE(f, vN);
    8385             :   }
    8386          63 :   vecsmall_sort(vN); return vN;
    8387             : }
    8388             : GEN
    8389          28 : mfsearch(GEN NK, GEN V, long space)
    8390             : {
    8391          28 :   pari_sp av = avma;
    8392             :   GEN F, gk, NbyD, vN;
    8393             :   long n, nk, dk, parity, nV, i, lvN;
    8394             : 
    8395          28 :   if (typ(NK) != t_VEC || lg(NK) != 3) pari_err_TYPE("mfsearch", NK);
    8396          28 :   gk = gel(NK,2);
    8397          28 :   if (typ(gmul2n(gk, 1)) != t_INT) pari_err_TYPE("mfsearch [k]", gk);
    8398          28 :   switch(typ(V))
    8399             :   {
    8400          28 :     case t_VEC: V = shallowtrans(V);
    8401          28 :     case t_COL: break;
    8402           0 :     default: pari_err_TYPE("mfsearch [V]", V);
    8403             :   }
    8404          28 :   vN = search_levels(gel(NK,1), "mfsearch [N]");
    8405          28 :   if (gequal0(V)) { set_avma(av); retmkvec(mftrivial()); }
    8406          14 :   lvN = lg(vN);
    8407             : 
    8408          14 :   Qtoss(gk, &nk,&dk);
    8409          14 :   parity = (dk == 1 && odd(nk)) ? -1 : 1;
    8410          14 :   nV = lg(V)-2;
    8411          14 :   F = cgetg(1, t_VEC);
    8412          14 :   NbyD = const_vec(vN[lvN-1], cgetg(1,t_VECSMALL));
    8413         231 :   for (n = 1; n < lvN; n++)
    8414             :   {
    8415         217 :     long N = vN[n];
    8416             :     GEN L;
    8417         217 :     if (N <= 0 || (dk == 2 && (N & 3))) continue;
    8418         217 :     L = findd(N, parity);
    8419         630 :     for (i = 1; i < lg(L); i++)
    8420             :     {
    8421         413 :       GEN mf, M, CO, gD = gel(L,i);
    8422         413 :       GEN *ND = (GEN*)NbyD + itou(gD); /* points to NbyD[|D|] */
    8423             : 
    8424         413 :       if (seenD(N, *ND)) continue;
    8425         413 :       mf = mfinit_Nndkchi(N, nk, dk, get_mfchar(gD), space, 1);
    8426         413 :       M = mfcoefs_mf(mf, nV, 1);
    8427         413 :       CO = inverseimage(M, V); if (lg(CO) == 1) continue;
    8428             : 
    8429          42 :       F = vec_append(F, mflinear(mf,CO));
    8430          42 :       *ND = vecsmall_append(*ND, N); /* add to NbyD[|D|] */
    8431             :     }
    8432             :   }
    8433          14 :   return gerepilecopy(av, F);
    8434             : }
    8435             : 
    8436             : static GEN
    8437         889 : search_from_split(GEN mf, GEN vap, GEN vlp)
    8438             : {
    8439         889 :   pari_sp av = avma;
    8440         889 :   long lvlp = lg(vlp), j, jv, l1;
    8441         889 :   GEN v, NK, S1, S, M = NULL;
    8442             : 
    8443         889 :   S1 = gel(split_i(mf, 1, 0), 1); /* rational newforms */
    8444         889 :   l1 = lg(S1);
    8445         889 :   if (l1 == 1) return gc_NULL(av);
    8446         455 :   v = cgetg(l1, t_VEC);
    8447         455 :   S = MF_get_S(mf);
    8448         455 :   NK = mf_get_NK(gel(S,1));
    8449         455 :   if (lvlp > 1) M = rowpermute(mfcoefs_mf(mf, vlp[lvlp-1], 1), vlp);
    8450         980 :   for (j = jv = 1; j < l1; j++)
    8451             :   {
    8452         525 :     GEN vF = gel(S1,j);
    8453             :     long t;
    8454         658 :     for (t = lvlp-1; t > 0; t--)
    8455             :     { /* lhs = vlp[j]-th coefficient of eigenform */
    8456         595 :       GEN rhs = gel(vap,t), lhs = RgMrow_RgC_mul(M, vF, t);
    8457         595 :       if (!gequal(lhs, rhs)) break;
    8458             :     }
    8459         525 :     if (!t) gel(v,jv++) = mflinear_i(NK,S,vF);
    8460             :   }
    8461         455 :   if (jv == 1) return gc_NULL(av);
    8462          63 :   setlg(v,jv); return v;
    8463             : }
    8464             : GEN
    8465          35 : mfeigensearch(GEN NK, GEN AP)
    8466             : {
    8467          35 :   pari_sp av = avma;
    8468          35 :   GEN k, vN, vap, vlp, vres = cgetg(1, t_VEC), D;
    8469             :   long n, lvN, i, l, even;
    8470             : 
    8471          35 :   if (!AP) l = 1;
    8472             :   else
    8473             :   {
    8474          28 :     l = lg(AP);
    8475          28 :     if (typ(AP) != t_VEC) pari_err_TYPE("mfeigensearch",AP);
    8476             :   }
    8477          35 :   vap = cgetg(l, t_VEC);
    8478          35 :   vlp = cgetg(l, t_VECSMALL);
    8479          35 :   if (l > 1)
    8480             :   {
    8481          28 :     GEN perm = indexvecsort(AP, mkvecsmall(1));
    8482          77 :     for (i = 1; i < l; i++)
    8483             :     {
    8484          49 :       GEN v = gel(AP,perm[i]), gp, ap;
    8485          49 :       if (typ(v) != t_VEC || lg(v) != 3) pari_err_TYPE("mfeigensearch", AP);
    8486          49 :       gp = gel(v,1);
    8487          49 :       ap = gel(v,2);
    8488          49 :       if (typ(gp) != t_INT || (typ(ap) != t_INT && typ(ap) != t_INTMOD))
    8489           0 :         pari_err_TYPE("mfeigensearch", AP);
    8490          49 :       gel(vap,i) = ap;
    8491          49 :       vlp[i] = itos(gp)+1; if (vlp[i] < 0) pari_err_TYPE("mfeigensearch", AP);
    8492             :     }
    8493             :   }
    8494          35 :   l = lg(NK);
    8495          35 :   if (typ(NK) != t_VEC || l != 3) pari_err_TYPE("mfeigensearch",NK);
    8496          35 :   k = gel(NK,2);
    8497          35 :   vN = search_levels(gel(NK,1), "mfeigensearch [N]");
    8498          35 :   lvN = lg(vN);
    8499          35 :   vecsmall_sort(vlp);
    8500          35 :   even = !mpodd(k);
    8501         980 :   for (n = 1; n < lvN; n++)
    8502             :   {
    8503         945 :     pari_sp av2 = avma;
    8504             :     GEN mf, L;
    8505         945 :     long N = vN[n];
    8506         945 :     if (even) D = gen_1;
    8507             :     else
    8508             :     {
    8509         112 :       long r = (N&3L);
    8510         112 :       if (r == 1 || r == 2) continue;
    8511          56 :       D = stoi( corediscs(-N, NULL) ); /* < 0 */
    8512             :     }
    8513         889 :     mf = mfinit_i(mkvec3(utoipos(N), k, D), mf_NEW);
    8514         889 :     L = search_from_split(mf, vap, vlp);
    8515         889 :     if (L) vres = shallowconcat(vres, L); else set_avma(av2);
    8516             :   }
    8517          35 :   return gerepilecopy(av, vres);
    8518             : }
    8519             : 
    8520             : /* tf_{N,k}(n) */
    8521             : static GEN
    8522     4495680 : mfnewtracecache(long N, long k, long n, cachenew_t *cache)
    8523             : {
    8524     4495680 :   GEN C = NULL, S;
    8525             :   long lcache;
    8526     4495680 :   if (!n) return gen_0;
    8527     4357759 :   S = gel(cache->vnew,N);
    8528     4357759 :   lcache = lg(S);
    8529     4357759 :   if (n < lcache) C = gel(S, n);
    8530     4357759 :   if (C) cache->newHIT++;
    8531     2594331 :   else C = mfnewtrace_i(N,k,n,cache);
    8532     4357759 :   cache->newTOTAL++;
    8533     4357759 :   if (n < lcache) gel(S,n) = C;
    8534     4357759 :   return C;
    8535             : }
    8536             : 
    8537             : static long
    8538        1393 : mfdim_Nkchi(long N, long k, GEN CHI, long space)
    8539             : {
    8540        1393 :   if (k < 0 || badchar(N,k,CHI)) return 0;
    8541        1092 :   if (k == 0)
    8542          35 :     return mfcharistrivial(CHI) && !space_is_cusp(space)? 1: 0;
    8543        1057 :   switch(space)
    8544             :   {
    8545         245 :     case mf_NEW: return mfnewdim(N,k,CHI);
    8546         196 :     case mf_CUSP:return mfcuspdim(N,k,CHI);
    8547         168 :     case mf_OLD: return mfolddim(N,k,CHI);
    8548         217 :     case mf_FULL:return mffulldim(N,k,CHI);
    8549         231 :     case mf_EISEN: return mfeisensteindim(N,k,CHI);
    8550           0 :     default: pari_err_FLAG("mfdim");
    8551             :   }
    8552             :   return 0;/*LCOV_EXCL_LINE*/
    8553             : }
    8554             : static long
    8555        2114 : mf1dimsum(long N, long space)
    8556             : {
    8557        2114 :   switch(space)
    8558             :   {
    8559        1050 :     case mf_NEW:  return mf1newdimsum(N);
    8560        1057 :     case mf_CUSP: return mf1cuspdimsum(N);
    8561           7 :     case mf_OLD:  return mf1olddimsum(N);
    8562             :   }
    8563           0 :   pari_err_FLAG("mfdim");
    8564             :   return 0; /*LCOV_EXCL_LINE*/
    8565             : }
    8566             : /* mfdim for k = nk/dk */
    8567             : static long
    8568       44744 : mfdim_Nndkchi(long N, long nk, long dk, GEN CHI, long space)
    8569       43463 : { return (dk == 2)? mf2dim_Nkchi(N, nk >> 1, CHI, space)
    8570       88186 :                   : mfdim_Nkchi(N, nk, CHI, space); }
    8571             : /* FIXME: use direct dim Gamma1(N) formula, don't compute individual spaces */
    8572             : static long
    8573         252 : mfkdimsum(long N, long k, long dk, long space)
    8574             : {
    8575         252 :   GEN w = mfchars(N, k, dk, NULL);
    8576         252 :   long i, j, D = 0, l = lg(w);
    8577        1239 :   for (i = j = 1; i < l; i++)
    8578             :   {
    8579         987 :     GEN CHI = gel(w,i);
    8580         987 :     long d = mfdim_Nndkchi(N,k,dk,CHI,space);
    8581         987 :     if (d) D += d * myeulerphiu(mfcharorder(CHI));
    8582             :   }
    8583         252 :   return D;
    8584             : }
    8585             : static GEN
    8586         105 : mf1dims(long N, GEN vCHI, long space)
    8587             : {
    8588         105 :   GEN D = NULL;
    8589         105 :   switch(space)
    8590             :   {
    8591          56 :     case mf_NEW: D = mf1newdimall(N, vCHI); break;
    8592          21 :     case mf_CUSP:D = mf1cuspdimall(N, vCHI); break;
    8593          28 :     case mf_OLD: D = mf1olddimall(N, vCHI); break;
    8594           0 :     default: pari_err_FLAG("mfdim");
    8595             :   }
    8596         105 :   return D;
    8597             : }
    8598             : static GEN
    8599        2961 : mfkdims(long N, long k, long dk, GEN vCHI, long space)
    8600             : {
    8601        2961 :   GEN D, w = mfchars(N, k, dk, vCHI);
    8602        2961 :   long i, j, l = lg(w);
    8603        2961 :   D = cgetg(l, t_VEC);
    8604       46592 :   for (i = j = 1; i < l; i++)
    8605             :   {
    8606       43631 :     GEN CHI = gel(w,i);
    8607       43631 :     long d = mfdim_Nndkchi(N,k,dk,CHI,space);
    8608       43631 :     if (vCHI)
    8609         574 :       gel(D, j++) = mkvec2s(d, 0);
    8610       43057 :     else if (d)
    8611        2520 :       gel(D, j++) = fmt_dim(CHI, d, 0);
    8612             :   }
    8613        2961 :   setlg(D,j); return D;
    8614             : }
    8615             : GEN
    8616        5719 : mfdim(GEN NK, long space)
    8617             : {
    8618        5719 :   pari_sp av = avma;
    8619             :   long N, k, dk, joker;
    8620             :   GEN CHI, mf;
    8621        5719 :   if ((mf = checkMF_i(NK))) return utoi(MF_get_dim(mf));
    8622        5586 :   checkNK2(NK, &N, &k, &dk, &CHI, 2);
    8623        5586 :   if (!CHI) joker = 1;
    8624             :   else
    8625        2611 :     switch(typ(CHI))
    8626             :     {
    8627        2373 :       case t_INT: joker = 2; break;
    8628         112 :       case t_COL: joker = 3; break;
    8629         126 :       default: joker = 0; break;
    8630             :     }
    8631        5586 :   if (joker)
    8632             :   {
    8633             :     long d;
    8634             :     GEN D;
    8635        5460 :     if (k < 0) switch(joker)
    8636             :     {
    8637           0 :       case 1: return cgetg(1,t_VEC);
    8638           7 :       case 2: return gen_0;
    8639           0 :       case 3: return mfdim0all(CHI);
    8640             :     }
    8641        5453 :     if (k == 0)
    8642             :     {
    8643          28 :       if (space_is_cusp(space)) switch(joker)
    8644             :       {
    8645           7 :         case 1: return cgetg(1,t_VEC);
    8646           0 :         case 2: return gen_0;
    8647           7 :         case 3: return mfdim0all(CHI);
    8648             :       }
    8649          14 :       switch(joker)
    8650             :       {
    8651             :         long i, l;
    8652           7 :         case 1: retmkvec(fmt_dim(mfchartrivial(),0,0));
    8653           0 :         case 2: return gen_1;
    8654           7 :         case 3: l = lg(CHI); D = cgetg(l,t_VEC);
    8655          35 :                 for (i = 1; i < l; i++)
    8656             :                 {
    8657          28 :                   long t = mfcharistrivial(gel(CHI,i));
    8658          28 :                   gel(D,i) = mkvec2(t? gen_1: gen_0, gen_0);
    8659             :                 }
    8660           7 :                 return D;
    8661             :       }
    8662             :     }
    8663        5425 :     if (dk == 1 && k == 1 && space != mf_EISEN)
    8664         105 :     {
    8665        2219 :       long fix = 0, space0 = space;
    8666        2219 :       if (space == mf_FULL) space = mf_CUSP; /* remove Eisenstein part */
    8667        2219 :       if (joker == 2)
    8668             :       {
    8669        2114 :         d = mf1dimsum(N, space);
    8670        2114 :         if (space0 == mf_FULL) d += mfkdimsum(N,k,dk,mf_EISEN);/*add it back*/
    8671        2114 :         return gc_utoi(av, d);
    8672             :       }
    8673             :       /* must initialize explicitly: trivial spaces for E_k/S_k differ */
    8674         105 :       if (space0 == mf_FULL)
    8675             :       {
    8676           7 :         if (!CHI) fix = 1; /* must remove 0 spaces */
    8677           7 :         CHI = mfchars(N, k, dk, CHI);
    8678             :       }
    8679         105 :       D = mf1dims(N, CHI, space);
    8680         105 :       if (space0 == mf_FULL)
    8681             :       {
    8682           7 :         GEN D2 = mfkdims(N, k, dk, CHI, mf_EISEN);
    8683           7 :         D = merge_dims(D, D2, fix? CHI: NULL);
    8684             :       }
    8685             :     }
    8686             :     else
    8687             :     {
    8688        3206 :       if (joker==2) { d = mfkdimsum(N,k,dk,space); return gc_utoi(av,d); }
    8689        2954 :       D = mfkdims(N, k, dk, CHI, space);
    8690             :     }
    8691        3059 :     if (!CHI) return gerepileupto(av, vecsort(D, mkvecsmall(1)));
    8692         105 :     return gerepilecopy(av, D);
    8693             :   }
    8694         126 :   return utoi( mfdim_Nndkchi(N, k, dk, CHI, space) );
    8695             : }
    8696             : 
    8697             : GEN
    8698         350 : mfbasis(GEN NK, long space)
    8699             : {
    8700         350 :   pari_sp av = avma;
    8701             :   long N, k, dk;
    8702             :   GEN mf, CHI;
    8703         350 :   if ((mf = checkMF_i(NK))) return gconcat(gel(mf,2), gel(mf,3));
    8704          14 :   checkNK2(NK, &N, &k, &dk, &CHI, 0);
    8705          14 :   if (dk == 2) return gerepilecopy(av, mf2basis(N, k>>1, CHI, NULL, space));
    8706          14 :   mf = mfinit_Nkchi(N, k, CHI, space, 1);
    8707          14 :   return gerepilecopy(av, MF_get_basis(mf));
    8708             : }
    8709             : 
    8710             : static GEN
    8711          49 : deg1ser_shallow(GEN a1, GEN a0, long v, long e)
    8712          49 : { return RgX_to_ser(deg1pol_shallow(a1, a0, v), e+2); }
    8713             : /* r / x + O(1) */
    8714             : static GEN
    8715          49 : simple_pole(GEN r)
    8716             : {
    8717          49 :   GEN S = deg1ser_shallow(gen_0, r, 0, 1);
    8718          49 :   setvalser(S, -1); return S;
    8719             : }
    8720             : 
    8721             : /* F form, E embedding; mfa = mfatkininit or root number (eigenform case) */
    8722             : static GEN
    8723         161 : mflfuncreate(GEN mfa, GEN F, GEN E, GEN N, GEN gk)
    8724             : {
    8725         161 :   GEN LF = cgetg(8,t_VEC), polar = cgetg(1,t_COL), eps;
    8726         161 :   long k = itou(gk);
    8727         161 :   gel(LF,1) = lfuntag(t_LFUN_MFCLOS, mkvec3(F,E,gen_1));
    8728         161 :   if (typ(mfa) != t_VEC)
    8729          98 :     eps = mfa; /* cuspidal eigenform: root number; no poles */
    8730             :   else
    8731             :   { /* mfatkininit */
    8732          63 :     GEN a0, b0, vF, vG, G = NULL;
    8733          63 :     GEN M = gel(mfa,2), C = gel(mfa,3), mf = gel(mfa,4);
    8734          63 :     M = gdiv(mfmatembed(E, M), C);
    8735          63 :     vF = mfvecembed(E, mftobasis_i(mf, F));
    8736          63 :     vG = RgM_RgC_mul(M, vF);
    8737          63 :     if (gequal(vF,vG)) eps = gen_1;
    8738          49 :     else if (gequal(vF,gneg(vG))) eps = gen_m1;
    8739             :     else
    8740             :     { /* not self-dual */
    8741          42 :       eps = NULL;
    8742          42 :       G = mfatkin(mfa, F);
    8743          42 :       gel(LF,2) = lfuntag(t_LFUN_MFCLOS, mkvec3(G,E,ginv(C)));
    8744          42 :       gel(LF,6) = powIs(k);
    8745             :     }
    8746             :     /* polar part */
    8747          63 :     a0 = mfembed(E, mfcoef(F,0));
    8748          63 :     b0 = eps? gmul(eps,a0): gdiv(mfembed(E, mfcoef(G,0)), C);
    8749          63 :     if (!gequal0(b0))
    8750             :     {
    8751          28 :       b0 = mulcxpowIs(gmul2n(b0,1), k);
    8752          28 :       polar = vec_append(polar, mkvec2(gk, simple_pole(b0)));
    8753             :     }
    8754          63 :     if (!gequal0(a0))
    8755             :     {
    8756          21 :       a0 = gneg(gmul2n(a0,1));
    8757          21 :       polar = vec_append(polar, mkvec2(gen_0, simple_pole(a0)));
    8758             :     }
    8759             :   }
    8760         161 :   if (eps) /* self-dual */
    8761             :   {
    8762         119 :     gel(LF,2) = mfcharorder(mf_get_CHI(F)) <= 2? gen_0: gen_1;
    8763         119 :     gel(LF,6) = mulcxpowIs(eps,k);
    8764             :   }
    8765         161 :   gel(LF,3) = mkvec2(gen_0, gen_1);
    8766         161 :   gel(LF,4) = gk;
    8767         161 :   gel(LF,5) = N;
    8768         161 :   if (lg(polar) == 1) setlg(LF,7); else gel(LF,7) = polar;
    8769         161 :   return LF;
    8770             : }
    8771             : static GEN
    8772         133 : mflfuncreateall(long sd, GEN mfa, GEN F, GEN vE, GEN gN, GEN gk)
    8773             : {
    8774         133 :   long i, l = lg(vE);
    8775         133 :   GEN L = cgetg(l, t_VEC);
    8776         294 :   for (i = 1; i < l; i++)
    8777         161 :     gel(L,i) = mflfuncreate(sd? gel(mfa,i): mfa, F, gel(vE,i), gN, gk);
    8778         133 :   return L;
    8779             : }
    8780             : GEN
    8781          84 : lfunmf(GEN mf, GEN F, long bitprec)
    8782             : {
    8783          84 :   pari_sp av = avma;
    8784          84 :   long i, l, prec = nbits2prec(bitprec);
    8785             :   GEN L, gk, gN;
    8786          84 :   mf = checkMF(mf);
    8787          84 :   gk = MF_get_gk(mf);
    8788          84 :   gN = MF_get_gN(mf);
    8789          84 :   if (typ(gk)!=t_INT) pari_err_IMPL("half-integral weight");
    8790          84 :   if (F)
    8791             :   {
    8792             :     GEN v;
    8793          77 :     long s = MF_get_space(mf);
    8794          77 :     if (!checkmf_i(F)) pari_err_TYPE("lfunmf", F);
    8795          77 :     if (!mfisinspace_i(mf, F)) err_space(F);
    8796          77 :     L = NULL;
    8797          77 :     if ((s == mf_NEW || s == mf_CUSP || s == mf_FULL)
    8798          63 :         && gequal(mfcoefs_i(F,1,1), mkvec2(gen_0,gen_1)))
    8799             :     { /* check if eigenform */
    8800          35 :       GEN vP, vF, b = mftobasis_i(mf, F);
    8801          35 :       long lF, d = degpol(mf_get_field(F));
    8802          35 :       v = mfsplit(mf, d, 0);
    8803          35 :       vF = gel(v,1);
    8804          35 :       vP = gel(v,2); lF = lg(vF);
    8805          35 :       for (i = 1; i < lF; i++)
    8806          28 :         if (degpol(gel(vP,i)) == d && gequal(gel(vF,i), b))
    8807             :         {
    8808          28 :           GEN vE = mfgetembed(F, prec);
    8809          28 :           GEN Z = mffrickeeigen_i(mf, mkvec(b), mkvec(vE), prec);
    8810          28 :           L = mflfuncreateall(1, gel(Z,1), F, vE, gN, gk);
    8811          28 :           break;
    8812             :         }
    8813             :     }
    8814          77 :     if (!L)
    8815             :     { /* not an eigenform: costly general case */
    8816          49 :       GEN mfa = mfatkininit_i(mf, itou(gN), 1, prec);
    8817          49 :       L = mflfuncreateall(0,mfa, F, mfgetembed(F,prec), gN, gk);
    8818             :     }
    8819          77 :     if (lg(L) == 2) L = gel(L,1);
    8820             :   }
    8821             :   else
    8822             :   {
    8823           7 :     GEN M = mfeigenbasis(mf), vE = mfeigenembed(mf, prec);
    8824           7 :     GEN v = mffrickeeigen(mf, vE, prec);
    8825           7 :     l = lg(vE); L = cgetg(l, t_VEC);
    8826          63 :     for (i = 1; i < l; i++)
    8827          56 :       gel(L,i) = mflfuncreateall(1,gel(v,i), gel(M,i), gel(vE,i), gN, gk);
    8828             :   }
    8829          84 :   return gerepilecopy(av, L);
    8830             : }
    8831             : 
    8832             : GEN
    8833          28 : mffromell(GEN E)
    8834             : {
    8835          28 :   pari_sp av = avma;
    8836             :   GEN mf, F, z, v, S;
    8837             :   long N, i, l;
    8838             : 
    8839          28 :   checkell(E);
    8840          28 :   if (ell_get_type(E) != t_ELL_Q) pari_err_TYPE("mfffromell [E not over Q]", E);
    8841          28 :   N = itos(ellQ_get_N(E));
    8842          28 :   mf = mfinit_i(mkvec2(utoi(N), gen_2), mf_NEW);
    8843          28 :   v = split_i(mf, 1, 0);
    8844          28 :   S = gel(v,1); l = lg(S); /* rational newforms */
    8845          28 :   F = tag(t_MF_ELL, mkNK(N,2,mfchartrivial()), E);
    8846          28 :   z = mftobasis_i(mf, F);
    8847          28 :   for(i = 1; i < l; i++)
    8848          28 :     if (gequal(z, gel(S,i))) break;
    8849          28 :   if (i == l) pari_err_BUG("mffromell [E is not modular]");
    8850          28 :   return gerepilecopy(av, mkvec3(mf, F, z));
    8851             : }
    8852             : 
    8853             : /* returns -1 if not, degree otherwise */
    8854             : long
    8855         140 : polishomogeneous(GEN P)
    8856             : {
    8857             :   long i, D, l;
    8858         140 :   if (typ(P) != t_POL) return 0;
    8859          77 :   D = -1; l = lg(P);
    8860         322 :   for (i = 2; i < l; i++)
    8861             :   {
    8862         245 :     GEN c = gel(P,i);
    8863             :     long d;
    8864         245 :     if (gequal0(c)) continue;
    8865         112 :     d = polishomogeneous(c);
    8866         112 :     if (d < 0) return -1;
    8867         112 :     if (D < 0) D = d + i-2; else if (D != d + i-2) return -1;
    8868             :   }
    8869          77 :   return D;
    8870             : }
    8871             : 
    8872             : /* M a pp((Gram q)^(-1)) ZM; P a homogeneous t_POL, is P spherical ? */
    8873             : static int
    8874          28 : RgX_isspherical(GEN M, GEN P)
    8875             : {
    8876          28 :   pari_sp av = avma;
    8877          28 :   GEN S, v = variables_vecsmall(P);
    8878          28 :   long i, j, l = lg(v);
    8879          28 :   if (l > lg(M)) pari_err(e_MISC, "too many variables in mffromqf");
    8880          21 :   S = gen_0;
    8881          63 :   for (j = 1; j < l; j++)
    8882             :   {
    8883          42 :     GEN Mj = gel(M, j), Pj = deriv(P, v[j]);
    8884         105 :     for (i = 1; i <= j; i++)
    8885             :     {
    8886          63 :       GEN c = gel(Mj, i);
    8887          63 :       if (!signe(c)) continue;
    8888          42 :       if (i != j) c = shifti(c, 1);
    8889          42 :       S = gadd(S, gmul(c, deriv(Pj, v[i])));
    8890             :     }
    8891             :   }
    8892          21 :   return gc_bool(av, gequal0(S));
    8893             : }
    8894             : 
    8895             : static GEN
    8896          49 : c_QFsimple_i(long n, GEN Q, GEN P)
    8897             : {
    8898          49 :   GEN V, v = qfrep0(Q, utoi(n), 1);
    8899          49 :   long i, l = lg(v);
    8900          49 :   V = cgetg(l+1, t_VEC);
    8901          49 :   if (!P || equali1(P))
    8902             :   {
    8903          42 :     gel(V,1) = gen_1;
    8904         420 :     for (i = 2; i <= l; i++) gel(V,i) = utoi(v[i-1] << 1);
    8905             :   }
    8906             :   else
    8907             :   {
    8908           7 :     gel(V,1) = gcopy(P);
    8909           7 :     for (i = 2; i <= l; i++) gel(V,i) = gmulgu(P, v[i-1] << 1);
    8910             :   }
    8911          49 :   return V;
    8912             : }
    8913             : 
    8914             : /* v a t_VECSMALL of variable numbers, lg(r) >= lg(v), r is a vector of
    8915             :  * scalars [not involving any variable in v] */
    8916             : static GEN
    8917          14 : gsubstvec_i(GEN e, GEN v, GEN r)
    8918             : {
    8919          14 :   long i, l = lg(v);
    8920          42 :   for(i = 1; i < l; i++) e = gsubst(e, v[i], gel(r,i));
    8921          14 :   return e;
    8922             : }
    8923             : static GEN
    8924          56 : c_QF_i(long n, GEN Q, GEN P)
    8925             : {
    8926          56 :   pari_sp av = avma;
    8927             :   GEN V, v, va;
    8928             :   long i, l;
    8929          56 :   if (!P || typ(P) != t_POL) return gerepileupto(av, c_QFsimple_i(n, Q, P));
    8930           7 :   v = gel(minim(Q, utoi(2*n), NULL), 3);
    8931           7 :   va = variables_vecsmall(P);
    8932           7 :   V = zerovec(n + 1); l = lg(v);
    8933          21 :   for (i = 1; i < l; i++)
    8934             :   {
    8935          14 :     pari_sp av = avma;
    8936          14 :     GEN X = gel(v,i);
    8937          14 :     long c = (itos(qfeval(Q, X)) >> 1) + 1;
    8938          14 :     gel(V, c) = gerepileupto(av, gadd(gel(V, c), gsubstvec_i(P, va, X)));
    8939             :   }
    8940           7 :   return gmul2n(V, 1);
    8941             : }
    8942             : 
    8943             : GEN
    8944          77 : mffromqf(GEN Q, GEN P)
    8945             : {
    8946          77 :   pari_sp av = avma;
    8947             :   GEN G, Qi, F, D, N, mf, v, gk, chi;
    8948             :   long m, d, space;
    8949          77 :   if (typ(Q) != t_MAT) pari_err_TYPE("mffromqf", Q);
    8950          77 :   if (!RgM_is_ZM(Q) || !qfiseven(Q))
    8951           0 :     pari_err_TYPE("mffromqf [not integral or even]", Q);
    8952          77 :   m = lg(Q)-1;
    8953          77 :   Qi = ZM_inv(Q, &N);
    8954          77 :   if (!qfiseven(Qi)) N = shifti(N, 1);
    8955          77 :   d = 0;
    8956          77 :   if (!P || gequal1(P)) P = NULL;
    8957             :   else
    8958             :   {
    8959          35 :     P = simplify_shallow(P);
    8960          35 :     if (typ(P) == t_POL)
    8961             :     {
    8962          28 :       d = polishomogeneous(P);
    8963          28 :       if (d < 0) pari_err_TYPE("mffromqf [not homogeneous t_POL]", P);
    8964          28 :       if (!RgX_isspherical(Qi, P))
    8965           7 :         pari_err_TYPE("mffromqf [not a spherical t_POL]", P);
    8966             :     }
    8967             :   }
    8968          63 :   gk = uutoQ(m + 2*d, 2);
    8969          63 :   D = ZM_det(Q);
    8970          63 :   if (!odd(m)) { if ((m & 3) == 2) D = negi(D); } else D = shifti(D, 1);
    8971          63 :   space = d > 0 ? mf_CUSP : mf_FULL;
    8972          63 :   G = znstar0(N,1);
    8973          63 :   chi = mkvec2(G, znchar_quad(G,D));
    8974          63 :   mf = mfinit(mkvec3(N, gk, chi), space);
    8975          63 :   if (odd(d))
    8976             :   {
    8977           7 :     F = mftrivial();
    8978           7 :     v = zerocol(MF_get_dim(mf));
    8979             :   }
    8980             :   else
    8981             :   {
    8982          56 :     F = c_QF_i(mfsturm(mf), Q, P);
    8983          56 :     v = mftobasis_i(mf, F);
    8984          56 :     F = mflinear(mf, v);
    8985             :   }
    8986          63 :   return gerepilecopy(av, mkvec3(mf, F, v));
    8987             : }
    8988             : 
    8989             : /***********************************************************************/
    8990             : /*                          Eisenstein Series                          */
    8991             : /***********************************************************************/
    8992             : /* \sigma_{k-1}(\chi,n) */
    8993             : static GEN
    8994       24192 : sigchi(long k, GEN CHI, long n)
    8995             : {
    8996       24192 :   pari_sp av = avma;
    8997       24192 :   GEN S = gen_1, D = mydivisorsu(u_ppo(n,mfcharmodulus(CHI)));
    8998       24192 :   long i, l = lg(D), ord = mfcharorder(CHI), vt = varn(mfcharpol(CHI));
    8999       83671 :   for (i = 2; i < l; i++) /* skip D[1] = 1 */
    9000             :   {
    9001       59479 :     long d = D[i], a = mfcharevalord(CHI, d, ord);
    9002       59479 :     S = gadd(S, Qab_Czeta(a, ord, powuu(d, k-1), vt));
    9003             :   }
    9004       24192 :   return gerepileupto(av,S);
    9005             : }
    9006             : 
    9007             : /* write n = n0*n1*n2, (n0,N1*N2) = 1, n1 | N1^oo, n2 | N2^oo;
    9008             :  * return NULL if (n,N1,N2) > 1, else return factoru(n0) */
    9009             : static GEN
    9010      648088 : sigchi2_dec(long n, long N1, long N2, long *pn1, long *pn2)
    9011             : {
    9012      648088 :   GEN P0, E0, P, E, fa = myfactoru(n);
    9013             :   long i, j, l;
    9014      648088 :   *pn1 = 1;
    9015      648088 :   *pn2 = 1;
    9016      648088 :   if (N1 == 1 && N2 == 1) return fa;
    9017      634515 :   P = gel(fa,1); l = lg(P);
    9018      634515 :   E = gel(fa,2);
    9019      634515 :   P0 = cgetg(l, t_VECSMALL);
    9020      634515 :   E0 = cgetg(l, t_VECSMALL);
    9021     1470259 :   for (i = j = 1; i < l; i++)
    9022             :   {
    9023      941010 :     long p = P[i], e = E[i];
    9024      941010 :     if (N1 % p == 0)
    9025             :     {
    9026      142331 :       if (N2 % p == 0) return NULL;
    9027       37065 :       *pn1 *= upowuu(p,e);
    9028             :     }
    9029      798679 :     else if (N2 % p == 0)
    9030      128772 :       *pn2 *= upowuu(p,e);
    9031      669907 :     else { P0[j] = p; E0[j] = e; j++; }
    9032             :   }
    9033      529249 :   setlg(P0, j);
    9034      529249 :   setlg(E0, j); return mkvec2(P0,E0);
    9035             : }
    9036             : 
    9037             : /* sigma_{k-1}(\chi_1,\chi_2,n), ord multiple of lcm(ord(CHI1),ord(CHI2)) */
    9038             : static GEN
    9039      593096 : sigchi2(long k, GEN CHI1, GEN CHI2, long n, long ord)
    9040             : {
    9041      593096 :   pari_sp av = avma;
    9042             :   GEN S, D;
    9043      593096 :   long i, l, n1, n2, vt, N1 = mfcharmodulus(CHI1), N2 = mfcharmodulus(CHI2);
    9044      593096 :   D = sigchi2_dec(n, N1, N2, &n1, &n2); if (!D) return gc_const(av, gen_0);
    9045      492499 :   D = divisorsu_fact(D); l = lg(D);
    9046      492499 :   vt = varn(mfcharpol(CHI1));
    9047     2121350 :   for (i = 1, S = gen_0; i < l; i++)
    9048             :   { /* S += d^(k-1)*chi1(d)*chi2(n/d) */
    9049     1628851 :     long a, d = n2*D[i], nd = n1*D[l-i]; /* (d,N1)=1; (n/d,N2) = 1 */
    9050     1628851 :     a = mfcharevalord(CHI1, d, ord) + mfcharevalord(CHI2, nd, ord);
    9051     1628851 :     if (a >= ord) a -= ord;
    9052     1628851 :     S = gadd(S, Qab_Czeta(a, ord, powuu(d, k-1), vt));
    9053             :   }
    9054      492499 :   return gerepileupto(av, S);
    9055             : }
    9056             : 
    9057             : /**************************************************************************/
    9058             : /**           Dirichlet characters with precomputed values               **/
    9059             : /**************************************************************************/
    9060             : /* CHI mfchar */
    9061             : static GEN
    9062       13608 : mfcharcxinit(GEN CHI, long prec)
    9063             : {
    9064       13608 :   GEN G = gel(CHI,1), chi = gel(CHI,2), z, V;
    9065       13608 :   GEN v = ncharvecexpo(G, znconrey_normalized(G,chi));
    9066       13608 :   long n, l = lg(v), o = mfcharorder(CHI);
    9067       13608 :   V = cgetg(l, t_VEC);
    9068       13608 :   z = grootsof1(o, prec); /* Mod(t, Phi_o(t)) -> e(1/o) */
    9069      121828 :   for (n = 1; n < l; n++) gel(V,n) = v[n] < 0? gen_0: gel(z, v[n]+1);
    9070       13608 :   return mkvecn(6, G, chi, gmfcharorder(CHI), v, V, mfcharpol(CHI));
    9071             : }
    9072             : /* v a "CHIvec" */
    9073             : static long
    9074    23977856 : CHIvec_N(GEN v) { return itou(znstar_get_N(gel(v,1))); }
    9075             : static GEN
    9076       14826 : CHIvec_CHI(GEN v)
    9077       14826 : { return mkvec4(gel(v,1), gel(v,2), gel(v,3), gel(v,6)); }
    9078             : /* character order */
    9079             : static long
    9080       34685 : CHIvec_ord(GEN v) { return itou(gel(v,3)); }
    9081             : /* character exponents, i.e. t such that chi(n) = e(t) */
    9082             : static GEN
    9083      419223 : CHIvec_expo(GEN v) { return gel(v,4); }
    9084             : /* character values chi(n) */
    9085             : static GEN
    9086    23337461 : CHIvec_val(GEN v) { return gel(v,5); }
    9087             : /* CHI(n) */
    9088             : static GEN
    9089    23327808 : mychareval(GEN v, long n)
    9090             : {
    9091    23327808 :   long N = CHIvec_N(v), ind = n%N;
    9092    23327808 :   if (ind <= 0) ind += N;
    9093    23327808 :   return gel(CHIvec_val(v), ind);
    9094             : }
    9095             : /* return c such that CHI(n) = e(c / ordz) or -1 if (n,N) > 1 */
    9096             : static long
    9097      419223 : mycharexpo(GEN v, long n)
    9098             : {
    9099      419223 :   long N = CHIvec_N(v), ind = n%N;
    9100      419223 :   if (ind <= 0) ind += N;
    9101      419223 :   return CHIvec_expo(v)[ind];
    9102             : }
    9103             : /* faster than mfcharparity */
    9104             : static long
    9105       53886 : CHIvec_parity(GEN v) { return mycharexpo(v,-1) ? -1: 1; }
    9106             : /**************************************************************************/
    9107             : 
    9108             : static ulong
    9109       54992 : sigchi2_Fl(long k, GEN CHI1vec, GEN CHI2vec, long n, GEN vz, ulong p)
    9110             : {
    9111       54992 :   pari_sp av = avma;
    9112       54992 :   long ordz = lg(vz)-2, i, l, n1, n2;
    9113       54992 :   ulong S = 0;
    9114       54992 :   GEN D = sigchi2_dec(n, CHIvec_N(CHI1vec), CHIvec_N(CHI2vec), &n1, &n2);
    9115       54992 :   if (!D) return gc_ulong(av,S);
    9116       50323 :   D = divisorsu_fact(D);
    9117       50323 :   l = lg(D);
    9118      170667 :   for (i = 1; i < l; i++)
    9119             :   { /* S += d^(k-1)*chi1(d)*chi2(n/d) */
    9120      120344 :     long a, d = n2*D[i], nd = n1*D[l-i]; /* (d,N1)=1, (n/d,N2)=1 */
    9121      120344 :     a = mycharexpo(CHI2vec, nd) + mycharexpo(CHI1vec, d);
    9122      120344 :     if (a >= ordz) a -= ordz;
    9123      120344 :     S = Fl_add(S, Qab_Czeta_Fl(a, vz, Fl_powu(d,k-1,p), p), p);
    9124             :   }
    9125       50323 :   return gc_ulong(av,S);
    9126             : }
    9127             : 
    9128             : /**********************************************************************/
    9129             : /* Fourier expansions of Eisenstein series                            */
    9130             : /**********************************************************************/
    9131             : /* L(CHI_t,0) / 2, CHI_t(n) = CHI(n)(t/n) as a character modulo N*t,
    9132             :  * order(CHI) | ord != 0 */
    9133             : static GEN
    9134        2590 : charLFwt1(long N, GEN CHI, long ord, long t)
    9135             : {
    9136             :   GEN S;
    9137             :   long r, vt;
    9138             : 
    9139        2590 :   if (N == 1 && t == 1) return mkfrac(gen_m1,stoi(4));
    9140        2590 :   S = gen_0; vt = varn(mfcharpol(CHI));
    9141      295351 :   for (r = 1; r < N; r++)
    9142             :   { /* S += r*chi(r) */
    9143             :     long a, c;
    9144      292761 :     if (ugcd(N,r) != 1) continue;
    9145      233254 :     a = mfcharevalord(CHI,r,ord);
    9146      233254 :     c = (t != 1 && kross(t, r) < 0)? -r: r;
    9147      233254 :     S = gadd(S, Qab_Czeta(a, ord, stoi(c), vt));
    9148             :   }
    9149        2590 :   return gdivgs(S, -2*N);
    9150             : }
    9151             : /* L(CHI,0) / 2, mod p */
    9152             : static ulong
    9153        1981 : charLFwt1_Fl(GEN CHIvec, GEN vz, ulong p)
    9154             : {
    9155        1981 :   long r, m = CHIvec_N(CHIvec);
    9156             :   ulong S;
    9157        1981 :   if (m == 1) return Rg_to_Fl(mkfrac(gen_m1,stoi(4)), p);
    9158        1981 :   S = 0;
    9159       95914 :   for (r = 1; r < m; r++)
    9160             :   { /* S += r*chi(r) */
    9161       93933 :     long a = mycharexpo(CHIvec,r);
    9162       93933 :     if (a < 0) continue;
    9163       91574 :     S = Fl_add(S, Qab_Czeta_Fl(a, vz, r, p), p);
    9164             :   }
    9165        1981 :   return Fl_div(Fl_neg(S,p), 2*m, p);
    9166             : }
    9167             : /* L(CHI_t,1-k) / 2, CHI_t(n) = CHI(n) * (t/n), order(CHI) | ord != 0;
    9168             :  * assume conductor of CHI_t divides N */
    9169             : static GEN
    9170        4256 : charLFwtk(long N, long k, GEN CHI, long ord, long t)
    9171             : {
    9172             :   GEN S, P, dS;
    9173             :   long r, vt;
    9174             : 
    9175        4256 :   if (k == 1) return charLFwt1(N, CHI, ord, t);
    9176        1666 :   if (N == 1 && t == 1) return gdivgs(bernfrac(k),-2*k);
    9177        1043 :   vt = varn(mfcharpol(CHI));
    9178        1043 :   P = bern_init(N, k, &dS);
    9179        1043 :   dS = mul_denom(dS, stoi(-2*N*k));
    9180       14070 :   for (r = 1, S = gen_0; r < N; r++)
    9181             :   { /* S += P(r)*chi(r) */
    9182             :     long a;
    9183             :     GEN C;
    9184       13027 :     if (ugcd(r,N) != 1) continue;
    9185       10444 :     a = mfcharevalord(CHI,r,ord);
    9186       10444 :     C = ZX_Z_eval(P, utoi(r));
    9187       10444 :     if (t != 1 && kross(t, r) < 0) C = gneg(C);
    9188       10444 :     S = gadd(S, Qab_Czeta(a, ord, C, vt));
    9189             :   }
    9190        1043 :   return gdiv(S, dS);
    9191             : }
    9192             : /* L(CHI,1-k) / 2, mod p */
    9193             : static ulong
    9194        2807 : charLFwtk_Fl(long k, GEN CHIvec, GEN vz, ulong p)
    9195             : {
    9196             :   GEN P, dS;
    9197             :   long r, m;
    9198             :   ulong S, d;
    9199        2807 :   if (k == 1) return charLFwt1_Fl(CHIvec, vz, p);
    9200         826 :   m = CHIvec_N(CHIvec);
    9201         826 :   if (m == 1) return Rg_to_Fl(gdivgs(bernfrac(k),-2*k), p);
    9202         490 :   P = ZX_to_Flx(bern_init(m, k, &dS), p);
    9203       10290 :   for (r = 1, S = 0; r < m; r++)
    9204             :   { /* S += P(r)*chi(r) */
    9205        9800 :     long a = mycharexpo(CHIvec,r);
    9206        9800 :     if (a < 0) continue;
    9207        8596 :     S = Fl_add(S, Qab_Czeta_Fl(a, vz, Flx_eval(P,r,p), p), p);
    9208             :   }
    9209         490 :   d = (2 * k * m) % p; if (dS) d = Fl_mul(d, umodiu(dS, p), p);
    9210         490 :   return Fl_div(Fl_neg(S,p), d, p);
    9211             : }
    9212             : 
    9213             : static GEN
    9214        7770 : mfeisenstein2_0(long k, GEN CHI1, GEN CHI2, long ord)
    9215             : {
    9216        7770 :   long N1 = mfcharmodulus(CHI1), N2 = mfcharmodulus(CHI2);
    9217        7770 :   if (k == 1 && N1 == 1) return charLFwtk(N2, 1, CHI2, ord, 1);
    9218        5187 :   if (N2 == 1) return charLFwtk(N1, k, CHI1, ord, 1);
    9219        3731 :   return gen_0;
    9220             : }
    9221             : static ulong
    9222        4263 : mfeisenstein2_0_Fl(long k, GEN CHI1vec, GEN CHI2vec, GEN vz, ulong p)
    9223             : {
    9224        4263 :   if (k == 1 && CHIvec_N(CHI1vec) == 1)
    9225        1981 :     return charLFwtk_Fl(k, CHI2vec, vz, p);
    9226        2282 :   else if (CHIvec_N(CHI2vec) == 1)
    9227         826 :     return charLFwtk_Fl(k, CHI1vec, vz, p);
    9228        1456 :   else return 0;
    9229             : }
    9230             : static GEN
    9231         133 : NK_eisen2(long k, GEN CHI1, GEN CHI2, long ord)
    9232             : {
    9233         133 :   long o, N = mfcharmodulus(CHI1)*mfcharmodulus(CHI2);
    9234         133 :   GEN CHI = mfcharmul(CHI1, CHI2);
    9235         133 :   o = mfcharorder(CHI);
    9236         133 :   if ((ord & 3) == 2) ord >>= 1;
    9237         133 :   if ((o & 3) == 2) o >>= 1;
    9238         133 :   if (ord != o) pari_err_IMPL("mfeisenstein for these characters");
    9239         126 :   return mkNK(N, k, CHI);
    9240             : }
    9241             : static GEN
    9242         371 : mfeisenstein_i(long k, GEN CHI1, GEN CHI2)
    9243             : {
    9244         371 :   long s = 1, ord, vt;
    9245             :   GEN E0, NK, vchi, T;
    9246         371 :   if (CHI2) { CHI2 = get_mfchar(CHI2); if (mfcharparity(CHI2) < 0) s = -s; }
    9247         371 :   if (CHI1) { CHI1 = get_mfchar(CHI1); if (mfcharparity(CHI1) < 0) s = -s; }
    9248         357 :   if (s != m1pk(k)) return mftrivial();
    9249         336 :   if (!CHI1) CHI1 = mfchartrivial();
    9250         336 :   if (!CHI2)
    9251             :   { /* E_k(chi1) */
    9252         203 :     vt = varn(mfcharpol(CHI1));
    9253         203 :     ord = mfcharorder(CHI1);
    9254         203 :     NK = mkNK(mfcharmodulus(CHI1), k, CHI1);
    9255         203 :     E0 = charLFwtk(mfcharmodulus(CHI1), k, CHI1, ord, 1);
    9256         203 :     vchi = mkvec3(E0, mkvec(mfcharpol(CHI1)), CHI1);
    9257         203 :     return tag(t_MF_EISEN, NK, vchi);
    9258             :   }
    9259             :   /* E_k(chi1,chi2) */
    9260         133 :   vt = varn(mfcharpol(CHI1));
    9261         133 :   ord = ulcm(mfcharorder(CHI1), mfcharorder(CHI2));
    9262         133 :   NK = NK_eisen2(k, CHI1, CHI2, ord);
    9263         126 :   E0 = mfeisenstein2_0(k, CHI1, CHI2, ord);
    9264         126 :   T = mkvec(polcyclo(ord, vt));
    9265         126 :   vchi = mkvec4(E0, T, CHI1, CHI2);
    9266         126 :   return tag2(t_MF_EISEN, NK, vchi, mkvecsmall2(ord,0));
    9267             : }
    9268             : GEN
    9269         371 : mfeisenstein(long k, GEN CHI1, GEN CHI2)
    9270             : {
    9271         371 :   pari_sp av = avma;
    9272         371 :   if (k < 1) pari_err_DOMAIN("mfeisenstein", "k", "<", gen_1, stoi(k));
    9273         371 :   return gerepilecopy(av, mfeisenstein_i(k, CHI1, CHI2));
    9274             : }
    9275             : 
    9276             : static GEN
    9277        2604 : mfeisenstein2all(long N0, GEN NK, long k, GEN CHI1, GEN CHI2, GEN T, long o)
    9278             : {
    9279        2604 :   GEN E, E0 = mfeisenstein2_0(k, CHI1,CHI2, o), vchi = mkvec4(E0, T, CHI1,CHI2);
    9280        2604 :   long j, d = (lg(T)==4)? itou(gmael(T,3,1)): 1;
    9281        2604 :   E = cgetg(d+1, t_VEC);
    9282        5327 :   for (j=1; j<=d; j++) gel(E,j) = tag2(t_MF_EISEN, NK,vchi,mkvecsmall2(o,j-1));
    9283        2604 :   return mfbdall(E, N0 / mf_get_N(gel(E,1)));
    9284             : }
    9285             : 
    9286             : /* list of characters on G = (Z/NZ)^*, v[i] = NULL if (i,N) > 1, else
    9287             :  * the conductor of Conrey label i, [conductor, primitive char].
    9288             :  * Trivial chi (label 1) comes first */
    9289             : static GEN
    9290        1169 : zncharsG(GEN G)
    9291             : {
    9292        1169 :   long i, l, N = itou(znstar_get_N(G));
    9293             :   GEN vCHI, V;
    9294        1169 :   if (N == 1) return mkvec2(gen_1,cgetg(1,t_COL));
    9295        1169 :   vCHI = const_vec(N,NULL);
    9296        1169 :   V = cyc2elts(znstar_get_conreycyc(G));
    9297        1169 :   l = lg(V);
    9298      207739 :   for (i = 1; i < l; i++)
    9299             :   {
    9300      206570 :     GEN chi0, chi = zc_to_ZC(gel(V,i)), n, F;
    9301      206570 :     F = znconreyconductor(G, chi, &chi0);
    9302      206570 :     if (typ(F) != t_INT) F = gel(F,1);
    9303      206570 :     n = znconreyexp(G, chi);
    9304      206570 :     gel(vCHI, itos(n)) = mkvec2(chi0, F);
    9305             :   }
    9306        1169 :   return vCHI;
    9307             : }
    9308             : 
    9309             : /* CHI primitive, f(CHI) | N. Return pairs (CHI1,CHI2) both primitive
    9310             :  * such that f(CHI1)*f(CHI2) | N and CHI1 * CHI2 = CHI;
    9311             :  * if k = 1, CHI1 is even; if k = 2, omit (1,1) if CHI = 1 */
    9312             : static GEN
    9313        1386 : mfeisensteinbasis_i(long N0, long k, GEN CHI)
    9314             : {
    9315        1386 :   GEN G = gel(CHI,1), chi = gel(CHI,2), vT = const_vec(myeulerphiu(N0), NULL);
    9316        1386 :   GEN CHI0, GN, chiN, Lchi, LG, V, RES, NK, T, C = mfcharpol(CHI);
    9317        1386 :   long i, j, l, n, n1, N, ord = mfcharorder(CHI);
    9318        1386 :   long F = mfcharmodulus(CHI), vt = varn(mfcharpol(CHI));
    9319             : 
    9320        1386 :   CHI0 = (F == 1)? CHI: mfchartrivial();
    9321        1386 :   j = 1; RES = cgetg(N0+1, t_VEC);
    9322        1386 :   T = gel(vT,ord) = Qab_trace_init(ord, ord, C, C);
    9323        1386 :   if (F != 1 || k != 2)
    9324             :   { /* N1 = 1 */
    9325        1232 :     NK = mkNK(F, k, CHI);
    9326        1232 :     gel(RES, j++) = mfeisenstein2all(N0, NK, k, CHI0, CHI, T, ord);
    9327        1232 :     if (F != 1 && k != 1)
    9328         329 :       gel(RES, j++) = mfeisenstein2all(N0, NK, k, CHI, CHI0, T, ord);
    9329             :   }
    9330        1386 :   if (N0 == 1) { setlg(RES,j); return RES; }
    9331        1316 :   GN = G; chiN = chi;
    9332        1316 :   if (F == N0) N = N0;
    9333             :   else
    9334             :   {
    9335         714 :     GEN faN = myfactoru(N0), P = gel(faN,1), E = gel(faN,2);
    9336         714 :     long lP = lg(P);
    9337        1848 :     for (i = N = 1; i < lP; i++)
    9338             :     {
    9339        1134 :       long p = P[i];
    9340        1134 :       N *= upowuu(p, maxuu(E[i]/2, z_lval(F,p)));
    9341             :     }
    9342         714 :     if ((N & 3) == 2) N >>= 1;
    9343         714 :     if (N == 1) { setlg(RES,j); return RES; }
    9344         567 :     if (F != N)
    9345             :     {
    9346         133 :       GN = znstar0(utoipos(N),1);
    9347         133 :       chiN = zncharinduce(G, chi, GN);
    9348             :     }
    9349             :   }
    9350        1169 :   LG = const_vec(N, NULL); /* LG[d] = znstar(d,1) or NULL */
    9351        1169 :   gel(LG,1) = gel(CHI0,1);
    9352        1169 :   gel(LG,F) = G;
    9353        1169 :   gel(LG,N) = GN;
    9354        1169 :   Lchi = coprimes_zv(N);
    9355        1169 :   n = itou(znconreyexp(GN,chiN));
    9356        1169 :   V = zncharsG(GN); l = lg(V);
    9357      263305 :   for (n1 = 2; n1 < l; n1++) /* skip 1 (trivial char) */
    9358             :   {
    9359      262136 :     GEN v = gel(V,n1), w, chi1, chi2, G1, G2, CHI1, CHI2;
    9360             :     long N12, N1, N2, no, o12, t, m;
    9361      262136 :     if (!Lchi[n1] || n1 == n) continue; /* skip trivial chi2 */
    9362      204197 :     chi1 = gel(v,1); N1 = itou(gel(v,2)); /* conductor of chi1 */
    9363      204197 :     w = gel(V, Fl_div(n,n1,N));
    9364      204197 :     chi2 = gel(w,1); N2 = itou(gel(w,2)); /* conductor of chi2 */
    9365      204197 :     N12 = N1 * N2;
    9366      204197 :     if (N0 % N12) continue;
    9367             : 
    9368        1771 :     G1 = gel(LG,N1); if (!G1) gel(LG,N1) = G1 = znstar0(utoipos(N1), 1);
    9369        1771 :     if (k == 1 && zncharisodd(G1,chi1)) continue;
    9370        1043 :     G2 = gel(LG,N2); if (!G2) gel(LG,N2) = G2 = znstar0(utoipos(N2), 1);
    9371        1043 :     CHI1 = mfcharGL(G1, chi1);
    9372        1043 :     CHI2 = mfcharGL(G2, chi2);
    9373        1043 :     o12 = ulcm(mfcharorder(CHI1), mfcharorder(CHI2));
    9374             :     /* remove Galois orbit: same trace */
    9375        1043 :     no = Fl_powu(n1, ord, N);
    9376        1414 :     for (t = 1+ord, m = n1; t <= o12; t += ord)
    9377             :     { /* m <-> CHI1^t, if t in Gal(Q(chi1,chi2)/Q), omit (CHI1^t,CHI2^t) */
    9378         371 :       m = Fl_mul(m, no, N); if (!m) break;
    9379         371 :       if (ugcd(t, o12) == 1) Lchi[m] = 0;
    9380             :     }
    9381        1043 :     T = gel(vT,o12);
    9382        1043 :     if (!T) T = gel(vT,o12) = Qab_trace_init(o12, ord, polcyclo(o12,vt), C);
    9383        1043 :     NK = mkNK(N12, k, CHI);
    9384        1043 :     gel(RES, j++) = mfeisenstein2all(N0, NK, k, CHI1, CHI2, T, o12);
    9385             :   }
    9386        1169 :   setlg(RES,j); return RES;
    9387             : }
    9388             : 
    9389             : static GEN
    9390         721 : mfbd_E2(GEN E2, long d, GEN CHI)
    9391             : {
    9392         721 :   GEN E2d = mfbd_i(E2, d);
    9393         721 :   GEN F = mkvec2(E2, E2d), L = mkvec2(gen_1, utoineg(d));
    9394             :   /* cannot use mflinear_i: E2 and E2d do not have the same level */
    9395         721 :   return tag3(t_MF_LINEAR, mkNK(d,2,CHI), F, L, gen_1);
    9396             : }
    9397             : /* C-basis of E_k(Gamma_0(N),chi). If k = 1, the first basis element must not
    9398             :  * vanish at oo [used in mf1basis]. Here E_1(CHI), whose q^0 coefficient
    9399             :  * does not vanish (since L(CHI,0) does not) *if* CHI is not trivial; which
    9400             :  * must be the case in weight 1.
    9401             :  *
    9402             :  * (k>=3): In weight k >= 3, basis is B(d) E(CHI1,(CHI/CHI1)_prim), where
    9403             :  * CHI1 is primitive modulo N1, and if N2 is the conductor of CHI/CHI1
    9404             :  * then d*N1*N2 | N.
    9405             :  * (k=2): In weight k=2, same if CHI is nontrivial. If CHI is trivial, must
    9406             :  * not take CHI1 trivial, and must add E_2(tau)-dE_2(d tau)), where
    9407             :  * d|N, d > 1.
    9408             :  * (k=1): In weight k=1, same as k >= 3 except that we restrict to CHI1 even */
    9409             : static GEN
    9410        1414 : mfeisensteinbasis(long N, long k, GEN CHI)
    9411             : {
    9412             :   long i, F;
    9413             :   GEN L;
    9414        1414 :   if (badchar(N, k, CHI)) return cgetg(1, t_VEC);
    9415        1414 :   if (k == 0) return mfcharistrivial(CHI)? mkvec(mf1()): cgetg(1, t_VEC);
    9416        1386 :   CHI = mfchartoprimitive(CHI, &F);
    9417        1386 :   L = mfeisensteinbasis_i(N, k, CHI);
    9418        1386 :   if (F == 1 && k == 2)
    9419             :   {
    9420         154 :     GEN v, E2 = mfeisenstein(2, NULL, NULL), D = mydivisorsu(N);
    9421         154 :     long nD = lg(D)-1;
    9422         154 :     v = cgetg(nD, t_VEC); L = vec_append(L,v);
    9423         868 :     for (i = 1; i < nD; i++) gel(v,i) = mfbd_E2(E2, D[i+1], CHI);
    9424             :   }
    9425        1386 :   return lg(L) == 1? L: shallowconcat1(L);
    9426             : }
    9427             : 
    9428             : static GEN
    9429          77 : not_in_space(GEN F, long flag)
    9430             : {
    9431          77 :   if (!flag) err_space(F);
    9432          70 :   return cgetg(1, t_COL);
    9433             : }
    9434             : /* when flag set, no error */
    9435             : GEN
    9436         994 : mftobasis(GEN mf, GEN F, long flag)
    9437             : {
    9438         994 :   pari_sp av2, av = avma;
    9439             :   GEN G, v, y, gk;
    9440         994 :   long N, B, ismf = checkmf_i(F);
    9441             : 
    9442         994 :   mf = checkMF(mf);
    9443         994 :   if (ismf)
    9444             :   {
    9445         903 :     if (mfistrivial(F)) return zerocol(MF_get_dim(mf));
    9446         896 :     if (!mf_same_k(mf, F) || !mf_same_CHI(mf, F)) return not_in_space(F, flag);
    9447             :   }
    9448         945 :   N = MF_get_N(mf);
    9449         945 :   gk = MF_get_gk(mf);
    9450         945 :   if (ismf)
    9451             :   {
    9452         854 :     long NF = mf_get_N(F);
    9453         854 :     B = maxuu(mfsturmNgk(NF,gk), mfsturmNgk(N,gk)) + 1;
    9454         854 :     v = mfcoefs_i(F,B,1);
    9455             :   }
    9456             :   else
    9457             :   {
    9458          91 :     B = mfsturmNgk(N, gk) + 1;
    9459          91 :     switch(typ(F))
    9460             :     { /* F(0),...,F(lg(v)-2) */
    9461          63 :       case t_SER: v = sertocol(F); settyp(v,t_VEC); break;
    9462          14 :       case t_VEC: v = F; break;
    9463           7 :       case t_COL: v = shallowtrans(F); break;
    9464           7 :       default: pari_err_TYPE("mftobasis",F);
    9465             :                v = NULL;/*LCOV_EXCL_LINE*/
    9466             :     }
    9467          84 :     if (flag) B = minss(B, lg(v)-2);
    9468             :   }
    9469         938 :   y = mftobasis_i(mf, v);
    9470         938 :   if (typ(y) == t_VEC)
    9471             :   {
    9472          21 :     if (flag) return gerepilecopy(av, y);
    9473           0 :     pari_err(e_MISC, "not enough coefficients in mftobasis");
    9474             :   }
    9475         917 :   av2 = avma;
    9476         917 :   if (MF_get_space(mf) == mf_FULL || mfsturm(mf)+1 == B) return y;
    9477         462 :   G = mflinear(mf, y);
    9478         462 :   if (!gequal(v, mfcoefs_i(G, lg(v)-2,1))) y = NULL;
    9479         462 :   if (!y) { set_avma(av); return not_in_space(F, flag); }
    9480         427 :   set_avma(av2); return gerepileupto(av, y);
    9481             : }
    9482             : 
    9483             : /* assume N > 0; first cusp is always 0 */
    9484             : static GEN
    9485          49 : mfcusps_i(long N)
    9486             : {
    9487             :   long i, c, l;
    9488             :   GEN D, v;
    9489             : 
    9490          49 :   if (N == 1) return mkvec(gen_0);
    9491          49 :   D = mydivisorsu(N); l = lg(D); /* left on stack */
    9492          49 :   c = mfnumcuspsu_fact(myfactoru(N));
    9493          49 :   v = cgetg(c + 1, t_VEC);
    9494         350 :   for (i = c = 1; i < l; i++)
    9495             :   {
    9496         301 :     long C = D[i], NC = D[l-i], lima = ugcd(C, NC), A0, A;
    9497         889 :     for (A0 = 0; A0 < lima; A0++)
    9498         588 :       if (ugcd(A0, lima) == 1)
    9499             :       {
    9500         539 :         A = A0; while (ugcd(A,C) > 1) A += lima;
    9501         392 :         gel(v, c++) = uutoQ(A, C);
    9502             :       }
    9503             :   }
    9504          49 :   return v;
    9505             : }
    9506             : /* List of cusps of Gamma_0(N) */
    9507             : GEN
    9508          28 : mfcusps(GEN gN)
    9509             : {
    9510             :   long N;
    9511             :   GEN mf;
    9512          28 :   if (typ(gN) == t_INT) N = itos(gN);
    9513          14 :   else if ((mf = checkMF_i(gN))) N = MF_get_N(mf);
    9514           0 :   else { pari_err_TYPE("mfcusps", gN); N = 0; }
    9515          28 :   if (N <= 0) pari_err_DOMAIN("mfcusps", "N", "<=", gen_0, stoi(N));
    9516          28 :   return mfcusps_i(N);
    9517             : }
    9518             : 
    9519             : long
    9520         315 : mfcuspisregular(GEN NK, GEN cusp)
    9521             : {
    9522             :   long v, N, dk, nk, t, o;
    9523             :   GEN mf, CHI, go, A, C, g, c, d;
    9524         315 :   if ((mf = checkMF_i(NK)))
    9525             :   {
    9526          49 :     GEN gk = MF_get_gk(mf);
    9527          49 :     N = MF_get_N(mf);
    9528          49 :     CHI = MF_get_CHI(mf);
    9529          49 :     Qtoss(gk, &nk, &dk);
    9530             :   }
    9531             :   else
    9532         266 :     checkNK2(NK, &N, &nk, &dk, &CHI, 0);
    9533         315 :   if (typ(cusp) == t_INFINITY) return 1;
    9534         315 :   if (typ(cusp) == t_FRAC) { A = gel(cusp,1); C = gel(cusp,2); }
    9535          28 :   else { A = cusp; C = gen_1; }
    9536         315 :   g = diviuexact(mului(N,C), ugcd(N, Fl_sqr(umodiu(C,N), N)));
    9537         315 :   c = mulii(negi(C),g);
    9538         315 :   d = addiu(mulii(A,g), 1);
    9539         315 :   if (!CHI) return 1;
    9540         315 :   go = gmfcharorder(CHI);
    9541         315 :   v = vali(go); if (v < 2) go = shifti(go, 2-v);
    9542         315 :   t = itou( znchareval(gel(CHI,1), gel(CHI,2), d, go) );
    9543         315 :   if (dk == 1) return t == 0;
    9544         154 :   o = itou(go);
    9545         154 :   if (kronecker(c,d) < 0) t = Fl_add(t, o/2, o);
    9546         154 :   if (Mod4(d) == 1) return t == 0;
    9547          14 :   t = Fl_sub(t, Fl_mul(o/4, nk, o), o);
    9548          14 :   return t == 0;
    9549             : }
    9550             : 
    9551             : /* Some useful closures */
    9552             : 
    9553             : /* sum_{d|n} d^k */
    9554             : static GEN
    9555       38311 : mysumdivku(ulong n, ulong k)
    9556             : {
    9557       38311 :   GEN fa = myfactoru(n);
    9558       38311 :   return k == 1? usumdiv_fact(fa): usumdivk_fact(fa,k);
    9559             : }
    9560             : static GEN
    9561         840 : c_Ek(long n, long d, GEN F)
    9562             : {
    9563         840 :   GEN E = cgetg(n + 2, t_VEC), C = gel(F,2);
    9564         840 :   long i, k = mf_get_k(F);
    9565         840 :   gel (E, 1) = gen_1;
    9566       25802 :   for (i = 1; i <= n; i++)
    9567             :   {
    9568       24962 :     pari_sp av = avma;
    9569       24962 :     gel(E, i+1) = gerepileupto(av, gmul(C, mysumdivku(i*d, k-1)));
    9570             :   }
    9571         840 :   return E;
    9572             : }
    9573             : 
    9574             : GEN
    9575         392 : mfEk(long k)
    9576             : {
    9577         392 :   pari_sp av = avma;
    9578             :   GEN E0, NK;
    9579         392 :   if (k < 0 || odd(k)) pari_err_TYPE("mfEk [incorrect k]", stoi(k));
    9580         392 :   if (!k) return mf1();
    9581         385 :   E0 = gdivsg(-2*k, bernfrac(k));
    9582         385 :   NK = mkNK(1,k,mfchartrivial());
    9583         385 :   return gerepilecopy(av, tag(t_MF_Ek, NK, E0));
    9584             : }
    9585             : 
    9586             : GEN
    9587          56 : mfDelta(void)
    9588             : {
    9589          56 :   pari_sp av = avma;
    9590          56 :   return gerepilecopy(av, tag0(t_MF_DELTA, mkNK(1,12,mfchartrivial())));
    9591             : }
    9592             : 
    9593             : GEN
    9594         798 : mfTheta(GEN psi)
    9595             : {
    9596         798 :   pari_sp av = avma;
    9597             :   GEN N, gk, psi2;
    9598             :   long par;
    9599         798 :   if (!psi) { psi = mfchartrivial(); N = utoipos(4); par = 1; }
    9600             :   else
    9601             :   {
    9602             :     long FC;
    9603          21 :     psi = get_mfchar(psi);
    9604          21 :     FC = mfcharconductor(psi);
    9605          21 :     if (mfcharmodulus(psi) != FC)
    9606           0 :       pari_err_TYPE("mfTheta [nonprimitive character]", psi);
    9607          21 :     par = mfcharparity(psi);
    9608          21 :     N = shifti(sqru(FC),2);
    9609             :   }
    9610         798 :   if (par > 0) { gk = ghalf; psi2 = psi; }
    9611           7 :   else { gk = gsubsg(2, ghalf); psi2 = mfcharmul(psi, get_mfchar(stoi(-4))); }
    9612         798 :   return gerepilecopy(av, tag(t_MF_THETA, mkgNK(N, gk, psi2, pol_x(1)), psi));
    9613             : }
    9614             : 
    9615             : /* Output 0 if not desired eta product: if flag=0 (default) require
    9616             :  * holomorphic at cusps. If flag set, accept meromorphic, but sill in some
    9617             :  * modular function space */
    9618             : GEN
    9619         210 : mffrometaquo(GEN eta, long flag)
    9620             : {
    9621         210 :   pari_sp av = avma;
    9622             :   GEN NK, N, k, BR, P;
    9623         210 :   long v, cusp = 0;
    9624         210 :   if (!etaquotype(&eta, &N,&k,&P, &v, NULL, flag? NULL: &cusp) || cusp < 0)
    9625          14 :     return gc_const(av, gen_0);
    9626         196 :   if (lg(gel(eta,1)) == 1) { set_avma(av); return mf1(); }
    9627         189 :   BR = mkvec2(ZV_to_zv(gel(eta,1)), ZV_to_zv(gel(eta,2)));
    9628         189 :   if (v < 0) v = 0;
    9629         189 :   NK = mkgNK(N, k, get_mfchar(P), pol_x(1));
    9630         189 :   return gerepilecopy(av, tag2(t_MF_ETAQUO, NK, BR, utoi(v)));
    9631             : }
    9632             : 
    9633             : /* Q^(-r) */
    9634             : static GEN
    9635         375 : RgXn_negpow(GEN Q, long r, long L)
    9636             : {
    9637         375 :   if (r < 0) r = -r; else Q = RgXn_inv_i(Q, L);
    9638         375 :   if (r != 1) Q = RgXn_powu_i(Q, r, L);
    9639         375 :   return Q;
    9640             : }
    9641             : /* flag same as in mffrometaquo: if set, accept meromorphic. */
    9642             : static GEN
    9643          49 : mfisetaquo_i(GEN F, long flag)
    9644             : {
    9645             :   GEN gk, P, E, M, S, G, CHI, v, w;
    9646             :   long b, l, L, N, vS, m, j;
    9647          49 :   const long bextra = 10;
    9648             : 
    9649          49 :   if (!checkmf_i(F)) pari_err_TYPE("mfisetaquo",F);
    9650          49 :   CHI = mf_get_CHI(F); if (mfcharorder(CHI) > 2) return NULL;
    9651          49 :   N = mf_get_N(F);
    9652          49 :   gk = mf_get_gk(F);
    9653          49 :   b = mfsturmNgk(N, gk);
    9654          49 :   L = maxss(N, b) + bextra;
    9655          49 :   S = mfcoefs_i(F, L, 1);
    9656          49 :   if (!RgV_is_ZV(S)) return NULL;
    9657         889 :   for (vS = 1; vS <= L+1; vS++)
    9658         889 :     if (signe(gel(S,vS))) break;
    9659          49 :   vS--;
    9660          49 :   if (vS >= bextra - 1) { L += vS; S = mfcoefs_i(F, L, 1); }
    9661          49 :   if (vS) { S = vecslice(S, vS+1, L+1); L -= vS; }
    9662          49 :   S = RgV_to_RgX(S, 0); l = lg(S)-2;
    9663          49 :   P = cgetg(l, t_COL);
    9664          49 :   E = cgetg(l, t_COL); w = v = gen_0; /* w = weight, v = valuation */
    9665        1908 :   for (m = j = 1; m+2 < lg(S); m++)
    9666             :   {
    9667        1866 :     GEN c = gel(S,m+2);
    9668             :     long r;
    9669        1866 :     if (is_bigint(c)) return NULL;
    9670        1859 :     r = -itos(c);
    9671        1859 :     if (r)
    9672             :     {
    9673         375 :       S = ZXn_mul(S, RgXn_negpow(eta_ZXn(m, L), r, L), L);
    9674         375 :       gel(P,j) = utoipos(m);
    9675         375 :       gel(E,j) = stoi(r);
    9676         375 :       v = addmuliu(v, gel(E,j), m);
    9677         375 :       w = addis(w, r);
    9678         375 :       j++;
    9679             :     }
    9680             :   }
    9681          42 :   if (!equalii(w, gmul2n(gk, 1)) || (!flag && !equalii(v, muluu(24,vS))))
    9682           7 :     return NULL;
    9683          35 :   setlg(P, j);
    9684          35 :   setlg(E, j); M = mkmat2(P, E); G = mffrometaquo(M, flag);
    9685          35 :   return (typ(G) != t_INT
    9686          35 :           && (mfsturmmf(G) <= b + bextra || mfisequal(F, G, b)))? M: NULL;
    9687             : }
    9688             : GEN
    9689          49 : mfisetaquo(GEN F, long flag)
    9690             : {
    9691          49 :   pari_sp av = avma;
    9692          49 :   GEN M = mfisetaquo_i(F, flag);
    9693          49 :   return M? gerepilecopy(av, M): gc_const(av, gen_0);
    9694             : }
    9695             : 
    9696             : #if 0
    9697             : /* number of primitive characters modulo N */
    9698             : static ulong
    9699             : numprimchars(ulong N)
    9700             : {
    9701             :   GEN fa, P, E;
    9702             :   long i, l;
    9703             :   ulong n;
    9704             :   if ((N & 3) == 2) return 0;
    9705             :   fa = myfactoru(N);
    9706             :   P = gel(fa,1); l = lg(P);
    9707             :   E = gel(fa,2);
    9708             :   for (i = n = 1; i < l; i++)
    9709             :   {
    9710             :     ulong p = P[i], e = E[i];
    9711             :     if (e == 2) n *= p-2; else n *= (p-1)*(p-1)*upowuu(p,e-2);
    9712             :   }
    9713             :   return n;
    9714             : }
    9715             : #endif
    9716             : 
    9717             : /* Space generated by products of two Eisenstein series */
    9718             : 
    9719             : static int
    9720       73332 : cmp_small_priority(void *E, GEN a, GEN b)
    9721             : {
    9722       73332 :   GEN prio = (GEN)E;
    9723       73332 :   return cmpss(prio[(long)a], prio[(long)b]);
    9724             : }
    9725             : static long
    9726        1232 : znstar_get_expo(GEN G) { return itou(cyc_get_expo(znstar_get_cyc(G))); }
    9727             : 
    9728             : /* Return [vchi, bymod, vG]:
    9729             :  * vG[f] = znstar(f,1) for f a conductor of (at least) a char mod N; else NULL
    9730             :  * bymod[f] = vecsmall of conrey indexes of chars modulo f | N; else NULL
    9731             :  * vchi[n] = a list of CHIvec [G0,chi0,o,ncharvecexpo(G0,nchi0),...]:
    9732             :  *   chi0 = primitive char attached to Conrey Mod(n,N)
    9733             :  * (resp. NULL if (n,N) > 1) */
    9734             : static GEN
    9735         616 : charsmodN(long N)
    9736             : {
    9737         616 :   GEN D, G, prio, phio, dummy = cgetg(1,t_VEC);
    9738         616 :   GEN vP, vG = const_vec(N,NULL), vCHI  = const_vec(N,NULL);
    9739         616 :   GEN bymod = const_vec(N,NULL);
    9740         616 :   long pn, i, l, vt = fetch_user_var("t");
    9741         616 :   D = mydivisorsu(N); l = lg(D);
    9742        3808 :   for (i = 1; i < l; i++)
    9743        3192 :     gel(bymod, D[i]) = vecsmalltrunc_init(myeulerphiu(D[i])+1);
    9744         616 :   gel(vG,N) = G = znstar0(utoipos(N),1);
    9745         616 :   pn = znstar_get_expo(G);  /* exponent(Z/NZ)^* */
    9746         616 :   vP = const_vec(pn,NULL);
    9747       26530 :   for (i = 1; i <= N; i++)
    9748             :   {
    9749             :     GEN P, gF, G0, chi0, nchi0, chi, v, go;
    9750             :     long j, F, o;
    9751       25914 :     if (ugcd(i,N) != 1) continue;
    9752       13769 :     chi = znconreylog(G, utoipos(i));
    9753       13769 :     gF = znconreyconductor(G, chi, &chi0);
    9754       13769 :     F = (typ(gF) == t_INT)? itou(gF): itou(gel(gF,1));
    9755       13769 :     G0 = gel(vG, F); if (!G0) G0 = gel(vG,F) = znstar0(gF, 1);
    9756       13769 :     nchi0 = znconreylog_normalize(G0,chi0);
    9757       13769 :     go = gel(nchi0,1); o = itou(go); /* order(chi0) */
    9758       13769 :     v = ncharvecexpo(G0, nchi0);
    9759       13769 :     if (!equaliu(go, pn)) v = zv_z_mul(v, pn / o);
    9760       13769 :     P = gel(vP, o); if (!P) P = gel(vP,o) = polcyclo(o,vt);
    9761             :     /* mfcharcxinit with dummy complex powers */
    9762       13769 :     gel(vCHI,i) = mkvecn(6, G0, chi0, go, v, dummy, P);
    9763       13769 :     D = mydivisorsu(N / F); l = lg(D);
    9764       39683 :     for (j = 1; j < l; j++) vecsmalltrunc_append(gel(bymod, F*D[j]), i);
    9765             :   }
    9766         616 :   phio = zero_zv(pn); l = lg(vCHI); prio = cgetg(l, t_VEC);
    9767       26530 :   for (i = 1; i < l; i++)
    9768             :   {
    9769       25914 :     GEN CHI = gel(vCHI,i);
    9770             :     long o;
    9771       25914 :     if (!CHI) continue;
    9772       13769 :     o = CHIvec_ord(CHI);
    9773       13769 :     if (!phio[o]) phio[o] = myeulerphiu(o);
    9774       13769 :     prio[i] = phio[o];
    9775             :   }
    9776         616 :   l = lg(bymod);
    9777             :   /* sort characters by increasing value of phi(order) */
    9778       26530 :   for (i = 1; i < l; i++)
    9779             :   {
    9780       25914 :     GEN z = gel(bymod,i);
    9781       25914 :     if (z) gen_sort_inplace(z, (void*)prio, &cmp_small_priority, NULL);
    9782             :   }
    9783         616 :   return mkvec3(vCHI, bymod, vG);
    9784             : }
    9785             : 
    9786             : static GEN
    9787        5040 : mfeisenstein2pure(long k, GEN CHI1, GEN CHI2, long ord, GEN P, long lim)
    9788             : {
    9789        5040 :   GEN c, V = cgetg(lim+2, t_COL);
    9790             :   long n;
    9791        5040 :   c = mfeisenstein2_0(k, CHI1, CHI2, ord);
    9792        5040 :   if (P) c = grem(c, P);
    9793        5040 :   gel(V,1) = c;
    9794       98322 :   for (n=1; n <= lim; n++)
    9795             :   {
    9796       93282 :     c = sigchi2(k, CHI1, CHI2, n, ord);
    9797       93282 :     if (P) c = grem(c, P);
    9798       93282 :     gel(V,n+1) = c;
    9799             :   }
    9800        5040 :   return V;
    9801             : }
    9802             : static GEN
    9803        4263 : mfeisenstein2pure_Fl(long k, GEN CHI1vec, GEN CHI2vec, GEN vz, ulong p, long lim)
    9804             : {
    9805        4263 :   GEN V = cgetg(lim+2, t_VECSMALL);
    9806             :   long n;
    9807        4263 :   V[1] = mfeisenstein2_0_Fl(k, CHI1vec, CHI2vec, vz, p);
    9808       59255 :   for (n=1; n <= lim; n++) V[n+1] = sigchi2_Fl(k, CHI1vec, CHI2vec, n, vz, p);
    9809        4263 :   return V;
    9810             : }
    9811             : 
    9812             : static GEN
    9813         245 : getcolswt2(GEN M, GEN D, ulong p)
    9814             : {
    9815         245 :   GEN R, v = gel(M,1);
    9816         245 :   long i, l = lg(M) - 1;
    9817         245 :   R = cgetg(l, t_MAT); /* skip D[1] = 1 */
    9818         980 :   for (i = 1; i < l; i++)
    9819             :   {
    9820         735 :     GEN w = Flv_Fl_mul(gel(M,i+1), D[i+1], p);
    9821         735 :     gel(R,i) = Flv_sub(v, w, p);
    9822             :   }
    9823         245 :   return R;
    9824             : }
    9825             : static GEN
    9826        5299 : expandbd(GEN V, long d)
    9827             : {
    9828             :   long L, n, nd;
    9829             :   GEN W;
    9830        5299 :   if (d == 1) return V;
    9831        2058 :   L = lg(V)-1; W = zerocol(L); /* nd = n/d */
    9832       17773 :   for (n = nd = 0; n < L; n += d, nd++) gel(W, n+1) = gel(V, nd+1);
    9833        2058 :   return W;
    9834             : }
    9835             : static GEN
    9836        6818 : expandbd_Fl(GEN V, long d)
    9837             : {
    9838             :   long L, n, nd;
    9839             :   GEN W;
    9840        6818 :   if (d == 1) return V;
    9841        2555 :   L = lg(V)-1; W = zero_Flv(L); /* nd = n/d */
    9842       16086 :   for (n = nd = 0; n < L; n += d, nd++) W[n+1] = V[nd+1];
    9843        2555 :   return W;
    9844             : }
    9845             : static void
    9846        4263 : getcols_i(GEN *pM, GEN *pvj, GEN gk, GEN CHI1vec, GEN CHI2vec, long NN1, GEN vz,
    9847             :           ulong p, long lim)
    9848             : {
    9849        4263 :   GEN CHI1 = CHIvec_CHI(CHI1vec), CHI2 = CHIvec_CHI(CHI2vec);
    9850        4263 :   long N2 = CHIvec_N(CHI2vec);
    9851        4263 :   GEN vj, M, D = mydivisorsu(NN1/N2);
    9852        4263 :   long i, l = lg(D), k = gk[2];
    9853        4263 :   GEN V = mfeisenstein2pure_Fl(k, CHI1vec, CHI2vec, vz, p, lim);
    9854        4263 :   M = cgetg(l, t_MAT);
    9855       11081 :   for (i = 1; i < l; i++) gel(M,i) = expandbd_Fl(V, D[i]);
    9856        4263 :   if (k == 2 && N2 == 1 && CHIvec_N(CHI1vec) == 1)
    9857             :   {
    9858         245 :     M = getcolswt2(M, D, p); l--;
    9859         245 :     D = vecslice(D, 2, l);
    9860             :   }
    9861        4263 :   *pM = M;
    9862        4263 :   *pvj = vj = cgetg(l, t_VEC);
    9863       10836 :   for (i = 1; i < l; i++) gel(vj,i) = mkvec4(gk, CHI1, CHI2, utoipos(D[i]));
    9864        4263 : }
    9865             : 
    9866             : /* find all CHI1, CHI2 mod N such that CHI1*CHI2 = CHI, f(CHI1)*f(CHI2) | N.
    9867             :  * set M = mfcoefs(B_e E(CHI1,CHI2), lim), vj = [e,i1,i2] */
    9868             : static void
    9869        1750 : getcols(GEN *pM, GEN *pv, long k, long nCHI, GEN allN, GEN vz, ulong p,
    9870             :         long lim)
    9871             : {
    9872        1750 :   GEN vCHI = gel(allN,1), gk = utoi(k);
    9873        1750 :   GEN M = cgetg(1,t_MAT), v = cgetg(1,t_VEC);
    9874        1750 :   long i1, N = lg(vCHI)-1;
    9875       85505 :   for (i1 = 1; i1 <= N; i1++)
    9876             :   {
    9877       83755 :     GEN CHI1vec = gel(vCHI, i1), CHI2vec, M1, v1;
    9878             :     long NN1, i2;
    9879      146510 :     if (!CHI1vec) continue;
    9880       65884 :     if (k == 1 && CHIvec_parity(CHI1vec) == -1) continue;
    9881       41188 :     NN1 = N/CHIvec_N(CHI1vec); /* N/f(chi1) */;
    9882       41188 :     i2 = Fl_div(nCHI,i1, N);
    9883       41188 :     if (!i2) i2 = 1;
    9884       41188 :     CHI2vec = gel(vCHI,i2);
    9885       41188 :     if (NN1 % CHIvec_N(CHI2vec)) continue; /* f(chi1)f(chi2) | N ? */
    9886        3129 :     getcols_i(&M1, &v1, gk, CHI1vec, CHI2vec, NN1, vz, p, lim);
    9887        3129 :     M = shallowconcat(M, M1);
    9888        3129 :     v = shallowconcat(v, v1);
    9889             :   }
    9890        1750 :   *pM = M;
    9891        1750 :   *pv = v;
    9892        1750 : }
    9893             : 
    9894             : static void
    9895        1162 : update_Mj(GEN *M, GEN *vecj, GEN *pz, ulong p)
    9896             : {
    9897             :   GEN perm;
    9898        1162 :   *pz = Flm_indexrank(*M, p); perm = gel(*pz,2);
    9899        1162 :   *M = vecpermute(*M, perm);
    9900        1162 :   *vecj = vecpermute(*vecj, perm);
    9901        1162 : }
    9902             : static int
    9903         399 : getcolsgen(long dim, GEN *pM, GEN *pvj, GEN *pz, long k, long ell, long nCHI,
    9904             :            GEN allN, GEN vz, ulong p, long lim)
    9905             : {
    9906         399 :   GEN vCHI = gel(allN,1), bymod = gel(allN,2), gell = utoi(ell);
    9907         399 :   long i1, N = lg(vCHI)-1;
    9908         399 :   long L = lim+1;
    9909         399 :   if (lg(*pvj)-1 >= dim) update_Mj(pM, pvj, pz, p);
    9910         399 :   if (lg(*pvj)-1 == dim) return 1;
    9911        1547 :   for (i1 = 1; i1 <= N; i1++)
    9912             :   {
    9913        1526 :     GEN CHI1vec = gel(vCHI, i1), T;
    9914             :     long par1, j, l, N1, NN1;
    9915             : 
    9916        1526 :     if (!CHI1vec) continue;
    9917        1505 :     par1 = CHIvec_parity(CHI1vec);
    9918        1505 :     if (ell == 1 && par1 == -1) continue;
    9919         924 :     if (odd(ell)) par1 = -par1;
    9920         924 :     N1 = CHIvec_N(CHI1vec);
    9921         924 :     NN1 = N/N1;
    9922         924 :     T = gel(bymod, NN1); l = lg(T);
    9923        3570 :     for (j = 1; j < l; j++)
    9924             :     {
    9925        2989 :       long i2 = T[j], l1, l2, j1, s, nC;
    9926        2989 :       GEN M, M1, M2, vj, vj1, vj2, CHI2vec = gel(vCHI, i2);
    9927        2989 :       if (CHIvec_parity(CHI2vec) != par1) continue;
    9928        1134 :       nC = Fl_div(nCHI, Fl_mul(i1,i2,N), N);
    9929        1134 :       getcols(&M2, &vj2, k-ell, nC, allN, vz, p, lim);
    9930        1134 :       l2 = lg(M2); if (l2 == 1) continue;
    9931        1134 :       getcols_i(&M1, &vj1, gell, CHI1vec, CHI2vec, NN1, vz, p, lim);
    9932        1134 :       l1 = lg(M1);
    9933        1134 :       M1 = Flm_to_FlxV(M1, 0);
    9934        1134 :       M2 = Flm_to_FlxV(M2, 0);
    9935        1134 :       M  = cgetg((l1-1)*(l2-1) + 1, t_MAT);
    9936        1134 :       vj = cgetg((l1-1)*(l2-1) + 1, t_VEC);
    9937        2779 :       for (j1 = s = 1; j1 < l1; j1++)
    9938             :       {
    9939        1645 :         GEN E = gel(M1,j1), v = gel(vj1,j1);
    9940             :         long j2;
    9941        6895 :         for (j2 = 1; j2 < l2; j2++, s++)
    9942             :         {
    9943        5250 :           GEN c = Flx_to_Flv(Flxn_mul(E, gel(M2,j2), L, p), L);
    9944        5250 :           gel(M,s) = c;
    9945        5250 :           gel(vj,s) = mkvec2(v, gel(vj2,j2));
    9946             :         }
    9947             :       }
    9948        1134 :       *pM = shallowconcat(*pM, M);
    9949        1134 :       *pvj = shallowconcat(*pvj, vj);
    9950        1134 :       if (lg(*pvj)-1 >= dim) update_Mj(pM, pvj, pz, p);
    9951        1134 :       if (lg(*pvj)-1 == dim) return 1;
    9952             :     }
    9953             :   }
    9954          21 :   if (ell == 1)
    9955             :   {
    9956          21 :     update_Mj(pM, pvj, pz, p);
    9957          21 :     return (lg(*pvj)-1 == dim);
    9958             :   }
    9959           0 :   return 0;
    9960             : }
    9961             : 
    9962             : static GEN
    9963        1519 : mkF2bd(long d, long lim)
    9964             : {
    9965        1519 :   GEN V = zerovec(lim + 1);
    9966             :   long n;
    9967        1519 :   gel(V, 1) = sstoQ(-1, 24);
    9968       14833 :   for (n = 1; n <= lim/d; n++) gel(V, n*d + 1) = mysumdivku(n, 1);
    9969        1519 :   return V;
    9970             : }
    9971             : 
    9972             : static GEN
    9973        5635 : mkeisen(GEN E, long ord, GEN P, long lim)
    9974             : {
    9975        5635 :   long k = itou(gel(E,1)), e = itou(gel(E,4));
    9976        5635 :   GEN CHI1 = gel(E,2), CHI2 = gel(E,3);
    9977        5635 :   if (k == 2 && mfcharistrivial(CHI1) && mfcharistrivial(CHI2))
    9978         595 :     return gsub(mkF2bd(1,lim), gmulgu(mkF2bd(e,lim), e));
    9979             :   else
    9980             :   {
    9981        5040 :     GEN V = mfeisenstein2pure(k, CHI1, CHI2, ord, P, lim);
    9982        5040 :     return expandbd(V, e);
    9983             :   }
    9984             : }
    9985             : static GEN
    9986         574 : mkM(GEN vj, long pn, GEN P, long lim)
    9987             : {
    9988         574 :   long j, l = lg(vj), L = lim+1;
    9989         574 :   GEN M = cgetg(l, t_MAT);
    9990        4697 :   for (j = 1; j < l; j++)
    9991             :   {
    9992             :     GEN E1, E2;
    9993        4123 :     parse_vecj(gel(vj,j), &E1,&E2);
    9994        4123 :     E1 = RgV_to_RgX(mkeisen(E1, pn, P, lim), 0);
    9995        4123 :     if (E2)
    9996             :     {
    9997        1512 :       E2 = RgV_to_RgX(mkeisen(E2, pn, P, lim), 0);
    9998        1512 :       E1 = RgXn_mul(E1, E2, L);
    9999             :     }
   10000        4123 :     E1 = RgX_to_RgC(E1, L);
   10001        4123 :     if (P && E2) E1 = RgXQV_red(E1, P);
   10002        4123 :     gel(M,j) = E1;
   10003             :   }
   10004         574 :   return M;
   10005             : }
   10006             : 
   10007             : /* assume N > 2 */
   10008             : static GEN
   10009          35 : mffindeisen1(long N)
   10010             : {
   10011          35 :   GEN G = znstar0(utoipos(N), 1), L = chargalois(G, NULL), chi0 = NULL;
   10012          35 :   long j, m = N, l = lg(L);
   10013         259 :   for (j = 1; j < l; j++)
   10014             :   {
   10015         245 :     GEN chi = gel(L,j);
   10016         245 :     long r = myeulerphiu(itou(zncharorder(G,chi)));
   10017         245 :     if (r >= m) continue;
   10018         182 :     chi = znconreyfromchar(G, chi);
   10019         182 :     if (zncharisodd(G,chi)) { m = r; chi0 = chi; if (r == 1) break; }
   10020             :   }
   10021          35 :   if (!chi0) pari_err_BUG("mffindeisen1 [no Eisenstein series found]");
   10022          35 :   chi0 = znchartoprimitive(G,chi0);
   10023          35 :   return mfcharGL(gel(chi0,1), gel(chi0,2));
   10024             : }
   10025             : 
   10026             : static GEN
   10027         616 : mfeisensteinspaceinit_i(long N, long k, GEN CHI)
   10028             : {
   10029         616 :   GEN M, Minv, vj, vG, GN, allN, P, vz, z = NULL;
   10030         616 :   long nCHI, lim, ell, ord, dim = mffulldim(N, k, CHI);
   10031             :   ulong r, p;
   10032             : 
   10033         616 :   if (!dim) retmkvec3(cgetg(1,t_VECSMALL),
   10034             :                       mkvec2(cgetg(1,t_MAT),gen_1),cgetg(1,t_VEC));
   10035         616 :   lim = mfsturmNk(N, k) + 1;
   10036         616 :   allN = charsmodN(N);
   10037         616 :   vG = gel(allN,3);
   10038         616 :   GN = gel(vG,N);
   10039         616 :   ord = znstar_get_expo(GN);
   10040         616 :   P = ord <= 2? NULL: polcyclo(ord, varn(mfcharpol(CHI)));
   10041         616 :   CHI = induce(GN, CHI); /* lift CHI mod N before mfcharno*/
   10042         616 :   nCHI = mfcharno(CHI);
   10043         616 :   r = QabM_init(ord, &p);
   10044         616 :   vz = Fl_powers(r, ord, p);
   10045         616 :   getcols(&M, &vj, k, nCHI, allN, vz, p, lim);
   10046         637 :   for (ell = k>>1; ell >= 1; ell--)
   10047         399 :     if (getcolsgen(dim, &M, &vj, &z, k, ell, nCHI, allN, vz, p, lim)) break;
   10048         616 :   if (!z) update_Mj(&M, &vj, &z, p);
   10049         616 :   if (lg(vj) - 1 < dim) return NULL;
   10050         574 :   M = mkM(vj, ord, P, lim);
   10051         574 :   Minv = QabM_Minv(rowpermute(M, gel(z,1)), P, ord);
   10052         574 :   return mkvec4(gel(z,1), Minv, vj, utoi(ord));
   10053             : }
   10054             : /* true mf */
   10055             : static GEN
   10056         574 : mfeisensteinspaceinit(GEN mf)
   10057             : {
   10058         574 :   pari_sp av = avma;
   10059         574 :   GEN z, CHI = MF_get_CHI(mf);
   10060         574 :   long N = MF_get_N(mf), k = MF_get_k(mf);
   10061         574 :   if (!CHI) CHI = mfchartrivial();
   10062         574 :   z = mfeisensteinspaceinit_i(N, k, CHI);
   10063         574 :   if (!z)
   10064             :   {
   10065          35 :     GEN E, CHIN = mffindeisen1(N), CHI0 = mfchartrivial();
   10066          35 :     z = mfeisensteinspaceinit_i(N, k+1, mfcharmul(CHI, CHIN));
   10067          35 :     if (z) E = mkvec4(gen_1, CHI0, CHIN, gen_1);
   10068             :     else
   10069             :     {
   10070           7 :       z = mfeisensteinspaceinit_i(N, k+2, CHI);
   10071           7 :       E = mkvec4(gen_2, CHI0, CHI0, utoipos(N));
   10072             :     }
   10073          35 :     z = mkvec2(z, E);
   10074             :   }
   10075         574 :   return gerepilecopy(av, z);
   10076             : }
   10077             : 
   10078             : /* decomposition of modular form on eisenspace */
   10079             : static GEN
   10080         987 : mfeisensteindec(GEN mf, GEN F)
   10081             : {
   10082         987 :   pari_sp av = avma;
   10083             :   GEN M, Mindex, Mvecj, V, B, CHI;
   10084             :   long o, ord;
   10085             : 
   10086         987 :   Mvecj = obj_checkbuild(mf, MF_EISENSPACE, &mfeisensteinspaceinit);
   10087         987 :   if (lg(Mvecj) < 5)
   10088             :   {
   10089          56 :     GEN E, e = gel(Mvecj,2), gkE = gel(e,1);
   10090          56 :     long dE = itou(gel(e,4));
   10091          56 :     Mvecj = gel(Mvecj,1);
   10092          56 :     E = mfeisenstein(itou(gkE), NULL, gel(e,3));
   10093          56 :     if (dE != 1) E = mfbd_E2(E, dE, gel(e,2)); /* here k = 2 */
   10094          56 :     F = mfmul(F, E);
   10095             :   }
   10096         987 :   M = gel(Mvecj, 2);
   10097         987 :   if (lg(M) == 1) return cgetg(1, t_VEC);
   10098         987 :   Mindex = gel(Mvecj, 1);
   10099         987 :   ord = itou(gel(Mvecj,4));
   10100         987 :   V = mfcoefs(F, Mindex[lg(Mindex)-1]-1, 1); settyp(V, t_COL);
   10101         987 :   CHI = mf_get_CHI(F);
   10102         987 :   o = mfcharorder(CHI);
   10103         987 :   if (o > 2 && o != ord)
   10104             :   { /* convert Mod(.,polcyclo(o)) to Mod(., polcyclo(N)) for o | N,
   10105             :      * o and N both != 2 (mod 4) */
   10106          84 :     GEN z, P = gel(M,4); /* polcyclo(ord) */
   10107          84 :     long vt = varn(P);
   10108          84 :     z = gmodulo(pol_xn(ord/o, vt), P);
   10109          84 :     if (ord % o) pari_err_TYPE("mfeisensteindec", V);
   10110          84 :     V = gsubst(liftpol_shallow(V), vt, z);
   10111             :   }
   10112         987 :   B = Minv_RgC_mul(M, vecpermute(V, Mindex));
   10113         987 :   return gerepileupto(av, B);
   10114             : }
   10115             : 
   10116             : /*********************************************************************/
   10117             : /*                        END EISENSPACE                             */
   10118             : /*********************************************************************/
   10119             : 
   10120             : static GEN
   10121          70 : sertocol2(GEN S, long l)
   10122             : {
   10123          70 :   GEN C = cgetg(l + 2, t_COL);
   10124             :   long i;
   10125         420 :   for (i = 0; i <= l; i++) gel(C, i+1) = polcoef_i(S, i, -1);
   10126          70 :   return C;
   10127             : }
   10128             : 
   10129             : /* Compute polynomial P0 such that F=E4^(k/4)P0(E6/E4^(3/2)). */
   10130             : static GEN
   10131          14 : mfcanfindp0(GEN F, long k)
   10132             : {
   10133          14 :   pari_sp ltop = avma;
   10134             :   GEN E4, E6, V, V1, Q, W, res, M, B;
   10135             :   long l, j;
   10136          14 :   l = k/6 + 2;
   10137          14 :   V = mfcoefsser(F,l);
   10138          14 :   E4 = mfcoefsser(mfEk(4),l);
   10139          14 :   E6 = mfcoefsser(mfEk(6),l);
   10140          14 :   V1 = gdiv(V, gpow(E4, uutoQ(k,4), 0));
   10141          14 :   Q = gdiv(E6, gpow(E4, uutoQ(3,2), 0));
   10142          14 :   W = gpowers(Q, l - 1);
   10143          14 :   M = cgetg(l + 1, t_MAT);
   10144          70 :   for (j = 1; j <= l; j++) gel(M,j) = sertocol2(gel(W,j), l);
   10145          14 :   B = sertocol2(V1, l);
   10146          14 :   res = inverseimage(M, B);
   10147          14 :   if (lg(res) == 1) err_space(F);
   10148          14 :   return gerepilecopy(ltop, gtopolyrev(res, 0));
   10149             : }
   10150             : 
   10151             : /* Compute the first n+1 Taylor coeffs at tau=I of a modular form
   10152             :  * on SL_2(Z). */
   10153             : GEN
   10154          14 : mftaylor(GEN F, long n, long flreal, long prec)
   10155             : {
   10156          14 :   pari_sp ltop = avma;
   10157          14 :   GEN P0, Pm1 = gen_0, v;
   10158          14 :   GEN X2 = mkpoln(3, ghalf,gen_0,gneg(ghalf)); /* (x^2-1) / 2 */
   10159             :   long k, m;
   10160          14 :   if (!checkmf_i(F)) pari_err_TYPE("mftaylor",F);
   10161          14 :   k = mf_get_k(F);
   10162          14 :   if (mf_get_N(F) != 1 || k < 0) pari_err_IMPL("mftaylor for this form");
   10163          14 :   P0 = mfcanfindp0(F, k);
   10164          14 :   v = cgetg(n+2, t_VEC); gel(v, 1) = RgX_coeff(P0,0);
   10165         154 :   for (m = 0; m < n; m++)
   10166             :   {
   10167         140 :     GEN P1 = gdivgu(gmulsg(-(k + 2*m), RgX_shift(P0,1)), 12);
   10168         140 :     P1 = gadd(P1, gmul(X2, RgX_deriv(P0)));
   10169         140 :     if (m) P1 = gsub(P1, gdivgu(gmulsg(m*(m+k-1), Pm1), 144));
   10170         140 :     Pm1 = P0; P0 = P1;
   10171         140 :     gel(v, m+2) = RgX_coeff(P0, 0);
   10172             :   }
   10173          14 :   if (flreal)
   10174             :   {
   10175           7 :     GEN pi2 = Pi2n(1, prec), pim4 = gmulsg(-2, pi2), VPC;
   10176           7 :     GEN C = gmulsg(3, gdiv(gpowgs(ggamma(uutoQ(1,4), prec), 8), gpowgs(pi2, 6)));
   10177             :     /* E_4(i): */
   10178           7 :     GEN facn = gen_1;
   10179           7 :     VPC = gpowers(gmul(pim4, gsqrt(C, prec)), n);
   10180           7 :     C = gpow(C, uutoQ(k,4), prec);
   10181          84 :     for (m = 0; m <= n; m++)
   10182             :     {
   10183          77 :       gel(v, m+1) = gdiv(gmul(C, gmul(gel(v, m+1), gel(VPC, m+1))), facn);
   10184          77 :       facn = gmulgu(facn, m+1);
   10185             :     }
   10186             :   }
   10187          14 :   return gerepilecopy(ltop, v);
   10188             : }
   10189             : 
   10190             : #if 0
   10191             : /* To be used in mfeigensearch() */
   10192             : GEN
   10193             : mfreadratfile()
   10194             : {
   10195             :   GEN eqn;
   10196             :   pariFILE *F = pari_fopengz("rateigen300.gp");
   10197             :   eqn = gp_readvec_stream(F->file);
   10198             :   pari_fclose(F);
   10199             :   return eqn;
   10200             : }
   10201             : #endif
   10202             :  /*****************************************************************/
   10203             : /*           EISENSTEIN CUSPS: COMPLEX DIRECTLY: one F_k         */
   10204             : /*****************************************************************/
   10205             : 
   10206             : /* CHIvec = charinit(CHI); data = [N1g/g1,N2g/g2,g1/g,g2/g,C/g1,C/g2,
   10207             :  * (N1g/g1)^{-1},(N2g/g2)^{-1}] */
   10208             : 
   10209             : /* nm = n/m;
   10210             :  * z1 = powers of \z_{C/g}^{(Ae/g)^{-1}},
   10211             :  * z2 = powers of \z_N^{A^{-1}(g1g2/C)}]
   10212             :  * N.B. : we compute value and conjugate at the end, so it is (Ae/g)^{-1}
   10213             :  * and not -(Ae/g)^{-1} */
   10214             : static GEN
   10215     7644966 : eiscnm(long nm, long m, GEN CHI1vec, GEN CHI2vec, GEN data, GEN z1)
   10216             : {
   10217     7644966 :   long Cg1 = data[5], s10 = (nm*data[7]) % Cg1, r10 = (nm - data[1]*s10) / Cg1;
   10218     7644966 :   long Cg2 = data[6], s20 = (m *data[8]) % Cg2, r20 = (m  - data[2]*s20) / Cg2;
   10219             :   long j1, r1, s1;
   10220     7644966 :   GEN T = gen_0;
   10221    18407172 :   for (j1 = 0, r1 = r10, s1 = s10; j1 < data[3]; j1++, r1 -= data[1], s1 += Cg1)
   10222             :   {
   10223    10762206 :     GEN c1 = mychareval(CHI1vec, r1);
   10224    10762206 :     if (!gequal0(c1))
   10225             :     {
   10226             :       long j2, r2, s2;
   10227     7908740 :       GEN S = gen_0;
   10228    20471066 :       for (j2 = 0, r2 = r20, s2 = s20; j2 < data[4]; j2++, r2 -= data[2], s2 += Cg2)
   10229             :       {
   10230    12562326 :         GEN c2 = mychareval(CHI2vec, r2);
   10231    12562326 :         if (!gequal0(c2)) S = gadd(S, gmul(c2, rootsof1pow(z1, s1*s2)));
   10232             :       }
   10233     7908740 :       T = gadd(T, gmul(c1, S));
   10234             :     }
   10235             :   }
   10236     7644966 :   return conj_i(T);
   10237             : }
   10238             : 
   10239             : static GEN
   10240      593908 : fg1g2n(long n, long k, GEN CHI1vec, GEN CHI2vec, GEN data, GEN z1, GEN z2)
   10241             : {
   10242      593908 :   pari_sp av = avma;
   10243      593908 :   GEN S = gen_0, D = mydivisorsu(n);
   10244      593908 :   long i, l = lg(D);
   10245     4416391 :   for (i = 1; i < l; i++)
   10246             :   {
   10247     3822483 :     long m = D[i], nm = D[l-i]; /* n/m */
   10248     3822483 :     GEN u = eiscnm( nm,  m, CHI1vec, CHI2vec, data, z1);
   10249     3822483 :     GEN v = eiscnm(-nm, -m, CHI1vec, CHI2vec, data, z1);
   10250     3822483 :     GEN w = odd(k) ? gsub(u, v) : gadd(u, v);
   10251     3822483 :     S = gadd(S, gmul(powuu(m, k-1), w));
   10252             :   }
   10253      593908 :   return gerepileupto(av, gmul(S, rootsof1pow(z2, n)));
   10254             : }
   10255             : 
   10256             : static GEN
   10257       13608 : gausssumcx(GEN CHIvec, long prec)
   10258             : {
   10259             :   GEN z, S, V;
   10260       13608 :   long m, N = CHIvec_N(CHIvec);
   10261       13608 :   if (N == 1) return gen_1;
   10262        7399 :   V = CHIvec_val(CHIvec);
   10263        7399 :   z = rootsof1u_cx(N, prec);
   10264        7399 :   S = gmul(z, gel(V, N));
   10265      102011 :   for (m = N-1; m >= 1; m--) S = gmul(z, gadd(gel(V, m), S));
   10266        7399 :   return S;
   10267             : }
   10268             : 
   10269             : /* Computation of Q_k(\z_N^s) as a polynomial in \z_N^s. FIXME: explicit
   10270             :  * formula ? */
   10271             : static GEN
   10272        2254 : mfqk(long k, long N)
   10273             : {
   10274             :   GEN X, P, ZI, Q, Xm1, invden;
   10275             :   long i;
   10276        2254 :   ZI = gdivgu(RgX_shift_shallow(RgV_to_RgX(identity_ZV(N-1), 0), 1), N);
   10277        2254 :   if (k == 1) return ZI;
   10278        1155 :   P = gsubgs(pol_xn(N,0), 1);
   10279        1155 :   invden = RgXQ_powu(ZI, k, P);
   10280        1155 :   X = pol_x(0); Q = gneg(X); Xm1 = gsubgs(X, 1);
   10281        2849 :   for (i = 2; i < k; i++)
   10282        1694 :     Q = RgX_shift_shallow(ZX_add(gmul(Xm1, ZX_deriv(Q)), gmulsg(-i, Q)), 1);
   10283        1155 :   return RgXQ_mul(Q, invden, P);
   10284             : }
   10285             : 
   10286             : /* CHI mfchar; M is a multiple of the conductor of CHI, but is NOT
   10287             :  * necessarily its modulus */
   10288             : static GEN
   10289        3150 : mfskcx(long k, GEN CHI, long M, long prec)
   10290             : {
   10291             :   GEN S, CHIvec, P;
   10292             :   long F, m, i, l;
   10293        3150 :   CHI = mfchartoprimitive(CHI, &F);
   10294        3150 :   CHIvec = mfcharcxinit(CHI, prec);
   10295        3150 :   if (F == 1) S = gdivgu(bernfrac(k), k);
   10296             :   else
   10297             :   {
   10298        2254 :     GEN Q = mfqk(k, F), V = CHIvec_val(CHIvec);
   10299        2254 :     S = gmul(gel(V, F), RgX_coeff(Q, 0));
   10300       39102 :     for (m = 1; m < F; m++) S = gadd(S, gmul(gel(V, m), RgX_coeff(Q, m)));
   10301        2254 :     S = conj_i(S);
   10302             :   }
   10303             :   /* prime divisors of M not dividing f(chi) */
   10304        3150 :   P = gel(myfactoru(u_ppo(M/F,F)), 1); l = lg(P);
   10305        3276 :   for (i = 1; i < l; i++)
   10306             :   {
   10307         126 :     long p = P[i];
   10308         126 :     S = gmul(S, gsubsg(1, gdiv(mychareval(CHIvec, p), powuu(p, k))));
   10309             :   }
   10310        3150 :   return gmul(gmul(gausssumcx(CHIvec, prec), S), powuu(M/F, k));
   10311             : }
   10312             : 
   10313             : static GEN
   10314        5852 : f00_i(long k, GEN CHI1vec, GEN CHI2vec, GEN G2, GEN S, long prec)
   10315             : {
   10316             :   GEN c, a;
   10317        5852 :   long N1 = CHIvec_N(CHI1vec), N2 = CHIvec_N(CHI2vec);
   10318        5852 :   if (S[2] != N1) return gen_0;
   10319        3150 :   c = mychareval(CHI1vec, S[3]);
   10320        3150 :   if (isintzero(c)) return gen_0;
   10321        3150 :   a = mfskcx(k, mfchardiv(CHIvec_CHI(CHI2vec), CHIvec_CHI(CHI1vec)), N1*N2, prec);
   10322        3150 :   a = gmul(a, conj_i(gmul(c,G2)));
   10323        3150 :   return gdiv(a, mulsi(-N2, powuu(S[1], k-1)));
   10324             : }
   10325             : 
   10326             : static GEN
   10327        4634 : f00(long k, GEN CHI1vec,GEN CHI2vec, GEN G1,GEN G2, GEN data, long prec)
   10328             : {
   10329             :   GEN T1, T2;
   10330        4634 :   T2 = f00_i(k, CHI1vec, CHI2vec, G2, data, prec);
   10331        4634 :   if (k > 1) return T2;
   10332        1218 :   T1 = f00_i(k, CHI2vec, CHI1vec, G1, data, prec);
   10333        1218 :   return gadd(T1, T2);
   10334             : }
   10335             : 
   10336             : /* ga in SL_2(Z), find beta [a,b;c,d] in Gamma_0(N) and mu in Z such that
   10337             :  * beta * ga * T^u = [A',B';C',D'] with C' | N and N | B', C' > 0 */
   10338             : static void
   10339        5229 : mfgatogap(GEN ga, long N, long *pA, long *pC, long *pD, long *pd, long *pmu)
   10340             : {
   10341        5229 :   GEN A = gcoeff(ga,1,1), B = gcoeff(ga,1,2);
   10342        5229 :   GEN C = gcoeff(ga,2,1), D = gcoeff(ga,2,2), a, b, c, d;
   10343             :   long t, Ap, Cp, B1, D1, mu;
   10344        5229 :   Cp = itou(bezout(muliu(A,N), C, &c, &d)); /* divides N */
   10345        5229 :   t = 0;
   10346        5229 :   if (Cp > 1)
   10347             :   { /* (d, N/Cp) = 1, find t such that (d - t*(A*N/Cp), N) = 1 */
   10348        2408 :     long dN = umodiu(d,Cp), Q = (N/Cp * umodiu(A,Cp)) % Cp;
   10349        2779 :     while (ugcd(dN, Cp) > 1) { t++; dN = Fl_sub(dN, Q, Cp); }
   10350             :   }
   10351        5229 :   if (t)
   10352             :   {
   10353         371 :     c = addii(c, mului(t, diviuexact(C,Cp)));
   10354         371 :     d = subii(d, mului(t, muliu(A, N/Cp))); /* (d,N) = 1 */
   10355             :   }
   10356        5229 :   D1 = umodiu(mulii(d,D), N);
   10357        5229 :   (void)bezout(d, mulis(c,-N), &a, &b); /* = 1 */
   10358        5229 :   t = 0; Ap = umodiu(addii(mulii(a,A), mulii(b,C)), N); /* (Ap,Cp) = 1 */
   10359        7231 :   while (ugcd(Ap, N) > 1) { t++; Ap = Fl_add(Ap, Cp, N); }
   10360        5229 :   B1 = umodiu(a,N)*umodiu(B,N) + umodiu(b,N)*umodiu(D,N) + t*D1;
   10361        5229 :   B1 %= N;
   10362        5229 :   *pmu = mu = Fl_neg(Fl_div(B1, Ap, N), N);
   10363             :   /* A', D' and d only needed modulo N */
   10364        5229 :   *pd = umodiu(d, N);
   10365        5229 :   *pA = Ap;
   10366        5229 :   *pC = Cp; *pD = (D1 + Cp*mu) % N;
   10367        5229 : }
   10368             : 
   10369             : #if 0
   10370             : /* CHI is a mfchar, return alpha(CHI) */
   10371             : static long
   10372             : mfalchi(GEN CHI, long AN, long cg)
   10373             : {
   10374             :   GEN G = gel(CHI,1), chi = gel(CHI,2), go = gmfcharorder(CHI);
   10375             :   long o = itou(go), a = itos( znchareval(G, chi, stoi(1 + AN/cg), go) );
   10376             :   if (a < 0 || (cg * a) % o) pari_err_BUG("mfalchi");
   10377             :   return (cg * a) / o;
   10378             : }
   10379             : #endif
   10380             : /* return A such that CHI1(t) * CHI2(t) = e(A) or NULL if (t,N1*N2) > 1 */
   10381             : static GEN
   10382       10458 : mfcharmuleval(GEN CHI1vec, GEN CHI2vec, long t)
   10383             : {
   10384       10458 :   long a1 = mycharexpo(CHI1vec, t), o1 = CHIvec_ord(CHI1vec);
   10385       10458 :   long a2 = mycharexpo(CHI2vec, t), o2 = CHIvec_ord(CHI2vec);;
   10386       10458 :   if (a1 < 0 || a2 < 0) return NULL;
   10387       10458 :   return sstoQ(a1*o2 + a2*o1, o1*o2);
   10388             : }
   10389             : static GEN
   10390        5229 : mfcharmulcxeval(GEN CHI1vec, GEN CHI2vec, long t, long prec)
   10391             : {
   10392        5229 :   GEN A = mfcharmuleval(CHI1vec, CHI2vec, t);
   10393             :   long n, d;
   10394        5229 :   if (!A) return gen_0;
   10395        5229 :   Qtoss(A, &n,&d); return rootsof1q_cx(n, d, prec);
   10396             : }
   10397             : /* alpha(CHI1 * CHI2) */
   10398             : static long
   10399        5229 : mfalchi2(GEN CHI1vec, GEN CHI2vec, long AN, long cg)
   10400             : {
   10401        5229 :   GEN A = mfcharmuleval(CHI1vec, CHI2vec, 1 + AN/cg);
   10402             :   long a;
   10403        5229 :   if (!A) pari_err_BUG("mfalchi2");
   10404        5229 :   A = gmulsg(cg, A);
   10405        5229 :   if (typ(A) != t_INT) pari_err_BUG("mfalchi2");
   10406        5229 :   a = itos(A) % cg; if (a < 0) a += cg;
   10407        5229 :   return a;
   10408             : }
   10409             : 
   10410             : /* return g = (a,b), set u >= 0 s.t. g = a * u (mod b) */
   10411             : static long
   10412       20916 : mybezout(long a, long b, long *pu)
   10413             : {
   10414       20916 :   long junk, g = cbezout(a, b, pu, &junk);
   10415       20916 :   if (*pu < 0) *pu += b/g;
   10416       20916 :   return g;
   10417             : }
   10418             : 
   10419             : /* E = [k, CHI1,CHI2, e], CHI1 and CHI2 primitive mfchars such that,
   10420             :  * CHI1(-1)*CHI2(-1) = (-1)^k; expansion of (B_e (E_k(CHI1,CHI2))) | ga.
   10421             :  * w is the width for the space of the calling function. */
   10422             : static GEN
   10423        5229 : mfeisensteingacx(GEN E, long w, GEN ga, long lim, long prec)
   10424             : {
   10425        5229 :   GEN CHI1vec, CHI2vec, CHI1 = gel(E,2), CHI2 = gel(E,3), v, S, ALPHA;
   10426             :   GEN G1, G2, z1, z2, data;
   10427        5229 :   long k = itou(gel(E,1)), e = itou(gel(E,4));
   10428        5229 :   long N1 = mfcharmodulus(CHI1);
   10429        5229 :   long N2 = mfcharmodulus(CHI2), N = e * N1 * N2;
   10430             :   long NsurC, cg, wN, A, C, Ai, d, mu, alchi, na, da;
   10431             :   long eg, g, gH, U, u0, u1, u2, Aig, H, m, n, t, Cg, NC1, NC2;
   10432             : 
   10433        5229 :   mfgatogap(ga, N, &A, &C, &Ai, &d, &mu);
   10434        5229 :   CHI1vec = mfcharcxinit(CHI1, prec);
   10435        5229 :   CHI2vec = mfcharcxinit(CHI2, prec);
   10436        5229 :   NsurC = N/C; cg  = ugcd(C, NsurC); wN = NsurC / cg;
   10437        5229 :   if (w%wN) pari_err_BUG("mfeisensteingacx [wN does not divide w]");
   10438        5229 :   alchi = mfalchi2(CHI1vec, CHI2vec, A*N, cg);
   10439        5229 :   ALPHA = sstoQ(alchi, NsurC);
   10440             : 
   10441        5229 :   g = mybezout(A*e, C, &u0); Cg = C/g; eg = e/g;
   10442        5229 :   NC1 = mybezout(N1, Cg, &u1);
   10443        5229 :   NC2 = mybezout(N2, Cg, &u2);
   10444        5229 :   H = (NC1*NC2*g)/Cg;
   10445        5229 :   Aig = (Ai*H)%N; if (Aig < 0) Aig += N;
   10446        5229 :   z1 = rootsof1powinit(u0, Cg, prec);
   10447        5229 :   z2 = rootsof1powinit(Aig, N, prec);
   10448        5229 :   data = mkvecsmalln(8, N1/NC1, N2/NC2, NC1, NC2, Cg/NC1, Cg/NC2, u1, u2);
   10449        5229 :   v = zerovec(lim + 1);
   10450             :   /* need n*H = alchi (mod cg) */
   10451        5229 :   gH = mybezout(H, cg, &U);
   10452        5229 :   if (gH > 1)
   10453             :   {
   10454         399 :     if (alchi % gH) return mkvec2(gen_0, v);
   10455         399 :     alchi /= gH; cg /= gH; H /= gH;
   10456             :   }
   10457        5229 :   G1 = gausssumcx(CHI1vec, prec);
   10458        5229 :   G2 = gausssumcx(CHI2vec, prec);
   10459        5229 :   if (!alchi)
   10460        4634 :     gel(v,1) = f00(k, CHI1vec,CHI2vec,G1,G2, mkvecsmall3(NC2,Cg,A*eg), prec);
   10461        5229 :   n = Fl_mul(alchi,U,cg); if (!n) n = cg;
   10462        5229 :   m = (n*H - alchi) / cg; /* positive, exact division */
   10463      599137 :   for (; m <= lim; n+=cg, m+=H)
   10464      593908 :     gel(v, m+1) = fg1g2n(n, k, CHI1vec, CHI2vec, data, z1,z2);
   10465        5229 :   t = (2*e)/g; if (odd(k)) t = -t;
   10466        5229 :   v = gdiv(v, gmul(conj_i(gmul(G1,G2)), mulsi(t, powuu(eg*N2/NC2, k-1))));
   10467        5229 :   if (k == 2 && N1 == 1 && N2 == 1) v = gsub(mkF2bd(wN,lim), gmulsg(e,v));
   10468             : 
   10469        5229 :   Qtoss(ALPHA, &na,&da);
   10470        5229 :   S = conj_i( mfcharmulcxeval(CHI1vec,CHI2vec,d,prec) ); /* CHI(1/d) */
   10471        5229 :   if (wN > 1)
   10472             :   {
   10473        4074 :     GEN z = rootsof1powinit(-mu, wN, prec);
   10474        4074 :     long i, l = lg(v);
   10475      571858 :     for (i = 1; i < l; i++) gel(v,i) = gmul(gel(v,i), rootsof1pow(z,i-1));
   10476             :   }
   10477        5229 :   v = RgV_Rg_mul(v, gmul(S, rootsof1q_cx(-mu*na, da, prec)));
   10478        5229 :   return mkvec2(ALPHA, bdexpand(v, w/wN));
   10479             : }
   10480             : 
   10481             : /*****************************************************************/
   10482             : /*                       END EISENSTEIN CUSPS                    */
   10483             : /*****************************************************************/
   10484             : 
   10485             : static GEN
   10486        1596 : mfchisimpl(GEN CHI)
   10487             : {
   10488             :   GEN G, chi;
   10489        1596 :   if (typ(CHI) == t_INT) return CHI;
   10490        1596 :   G = gel(CHI, 1); chi = gel(CHI, 2);
   10491        1596 :   switch(mfcharorder(CHI))
   10492             :   {
   10493        1148 :     case 1: chi = gen_1; break;
   10494         427 :     case 2: chi = znchartokronecker(G,chi,1); break;
   10495          21 :     default:chi = mkintmod(znconreyexp(G,chi), znstar_get_N(G)); break;
   10496             :   }
   10497        1596 :   return chi;
   10498             : }
   10499             : 
   10500             : GEN
   10501         700 : mfparams(GEN F)
   10502             : {
   10503         700 :   pari_sp av = avma;
   10504             :   GEN z, mf, CHI;
   10505         700 :   if ((mf = checkMF_i(F)))
   10506             :   {
   10507          14 :     long N = MF_get_N(mf);
   10508          14 :     GEN gk = MF_get_gk(mf);
   10509          14 :     CHI = MF_get_CHI(mf);
   10510          14 :     z = mkvec5(utoi(N), gk, CHI, utoi(MF_get_space(mf)), mfcharpol(CHI));
   10511             :   }
   10512             :   else
   10513             :   {
   10514         686 :     if (!checkmf_i(F)) pari_err_TYPE("mfparams", F);
   10515         686 :     z = vec_append(mf_get_NK(F), mfcharpol(mf_get_CHI(F)));
   10516             :   }
   10517         700 :   gel(z,3) = mfchisimpl(gel(z,3));
   10518         700 :   return gerepilecopy(av, z);
   10519             : }
   10520             : 
   10521             : GEN
   10522          14 : mfisCM(GEN F)
   10523             : {
   10524          14 :   pari_sp av = avma;
   10525             :   forprime_t S;
   10526             :   GEN D, v;
   10527             :   long N, k, lD, sb, p, i;
   10528          14 :   if (!checkmf_i(F)) pari_err_TYPE("mfisCM", F);
   10529          14 :   N = mf_get_N(F);
   10530          14 :   k = mf_get_k(F); if (N < 0 || k < 0) pari_err_IMPL("mfisCM for this F");
   10531          14 :   D = mfunram(N, -1);
   10532          14 :   lD = lg(D);
   10533          14 :   sb = maxss(mfsturmNk(N, k), 4*N);
   10534          14 :   v = mfcoefs_i(F, sb, 1);
   10535          14 :   u_forprime_init(&S, 2, sb);
   10536         504 :   while ((p = u_forprime_next(&S)))
   10537             :   {
   10538         490 :     GEN ap = gel(v, p+1);
   10539         490 :     if (!gequal0(ap))
   10540         406 :       for (i = 1; i < lD; i++)
   10541         245 :         if (kross(D[i], p) == -1) { D = vecsplice(D, i); lD--; }
   10542             :   }
   10543          14 :   if (lD == 1) return gc_const(av, gen_0);
   10544          14 :   if (lD == 2) return gc_stoi(av, D[1]);
   10545           7 :   if (k > 1) pari_err_BUG("mfisCM");
   10546           7 :   return gerepileupto(av, zv_to_ZV(D));
   10547             : }
   10548             : 
   10549             : static long
   10550         287 : mfspace_i(GEN mf, GEN F)
   10551             : {
   10552             :   GEN v, vF, gk;
   10553             :   long n, nE, i, l, s, N;
   10554             : 
   10555         287 :   mf = checkMF(mf); s = MF_get_space(mf);
   10556         287 :   if (!F) return s;
   10557         287 :   if (!checkmf_i(F)) pari_err_TYPE("mfspace",F);
   10558         287 :   v = mftobasis(mf, F, 1);
   10559         287 :   n = lg(v)-1; if (!n) return -1;
   10560         224 :   nE = lg(MF_get_E(mf))-1;
   10561         224 :   switch(s)
   10562             :   {
   10563          56 :     case mf_NEW: case mf_OLD: case mf_EISEN: return s;
   10564         140 :     case mf_FULL:
   10565         140 :       if (mf_get_type(F) == t_MF_THETA) return mf_EISEN;
   10566         133 :       if (!gequal0(vecslice(v,1,nE)))
   10567          63 :         return gequal0(vecslice(v,nE+1,n))? mf_EISEN: mf_FULL;
   10568             :   }
   10569             :   /* mf is mf_CUSP or mf_FULL, F a cusp form */
   10570          98 :   gk = mf_get_gk(F);
   10571          98 :   if (typ(gk) == t_FRAC || equali1(gk)) return mf_CUSP;
   10572          84 :   vF = mftonew_i(mf, vecslice(v, nE+1, n), &N);
   10573          84 :   if (N != MF_get_N(mf)) return mf_OLD;
   10574          56 :   l = lg(vF);
   10575          91 :   for (i = 1; i < l; i++)
   10576          56 :     if (itos(gmael(vF,i,1)) != N) return mf_CUSP;
   10577          35 :   return mf_NEW;
   10578             : }
   10579             : long
   10580         287 : mfspace(GEN mf, GEN F)
   10581         287 : { pari_sp av = avma; return gc_long(av, mfspace_i(mf,F)); }
   10582             : static GEN
   10583          21 : lfunfindchi(GEN ldata, GEN van, long prec)
   10584             : {
   10585          21 :   GEN gN = ldata_get_conductor(ldata), gk = ldata_get_k(ldata);
   10586          21 :   GEN G = znstar0(gN,1), cyc = znstar_get_conreycyc(G), L, go, vz;
   10587          21 :   long N = itou(gN), odd = typ(gk) == t_INT && mpodd(gk);
   10588          21 :   long i, j, o, l, B0 = 2, B = lg(van)-1, bit = 10 - prec2nbits(prec);
   10589             : 
   10590             :   /* if van is integral, chi must be trivial */
   10591          21 :   if (typ(van) == t_VECSMALL) return mfcharGL(G, zerocol(lg(cyc)-1));
   10592          14 :   L = cyc2elts(cyc); l = lg(L);
   10593          42 :   for (i = j = 1; i < l; i++)
   10594             :   {
   10595          28 :     GEN chi = zc_to_ZC(gel(L,i));
   10596          28 :     if (zncharisodd(G,chi) == odd) gel(L,j++) = mfcharGL(G,chi);
   10597             :   }
   10598          14 :   setlg(L,j); l = j;
   10599          14 :   if (l <= 2) return gel(L,1);
   10600           0 :   o = znstar_get_expo(G); go = utoi(o);
   10601           0 :   vz = grootsof1(o, prec);
   10602             :   for (;;)
   10603           0 :   {
   10604             :     long n;
   10605           0 :     for (n = B0; n <= B; n++)
   10606             :     {
   10607             :       GEN an, r;
   10608             :       long j;
   10609           0 :       if (ugcd(n, N) != 1) continue;
   10610           0 :       an = gel(van,n); if (gexpo(an) < bit) continue;
   10611           0 :       r = gdiv(an, conj_i(an));
   10612           0 :       for (i = 1; i < l; i++)
   10613             :       {
   10614           0 :         GEN CHI = gel(L,i);
   10615           0 :         if (gexpo(gsub(r, gel(vz, znchareval_i(CHI,n,go)+1))) > bit)
   10616           0 :           gel(L,i) = NULL;
   10617             :       }
   10618           0 :       for (i = j = 1; i < l; i++)
   10619           0 :         if (gel(L,i)) gel(L,j++) = gel(L,i);
   10620           0 :       l = j; setlg(L,l);
   10621           0 :       if (l == 2) return gel(L,1);
   10622             :     }
   10623           0 :     B0 = B+1; B <<= 1;
   10624           0 :     van = ldata_vecan(ldata_get_an(ldata), B, prec);
   10625             :   }
   10626             : }
   10627             : 
   10628             : GEN
   10629          21 : mffromlfun(GEN L, long prec)
   10630             : {
   10631          21 :   pari_sp av = avma;
   10632          21 :   GEN ldata = lfunmisc_to_ldata_shallow(L), Vga = ldata_get_gammavec(ldata);
   10633          21 :   GEN van, a0, CHI, NK, gk = ldata_get_k(ldata);
   10634             :   long N, space;
   10635          21 :   if (!gequal(Vga, mkvec2(gen_0, gen_1))) pari_err_TYPE("mffromlfun", L);
   10636          21 :   N = itou(ldata_get_conductor(ldata));
   10637          21 :   van = ldata_vecan(ldata_get_an(ldata), mfsturmNgk(N,gk) + 2, prec);
   10638          21 :   CHI = lfunfindchi(ldata, van, prec);
   10639          21 :   if (typ(van) != t_VEC) van = vecsmall_to_vec_inplace(van);
   10640          21 :   space = (lg(ldata) == 7)? mf_CUSP: mf_FULL;
   10641          21 :   a0 = (space == mf_CUSP)? gen_0: gneg(lfun(L, gen_0, prec2nbits(prec)));
   10642          21 :   NK = mkvec3(utoi(N), gk, mfchisimpl(CHI));
   10643          21 :   return gerepilecopy(av, mkvec3(NK, utoi(space), shallowconcat(a0, van)));
   10644             : }
   10645             : /*******************************************************************/
   10646             : /*                                                                 */
   10647             : /*                       HALF-INTEGRAL WEIGHT                      */
   10648             : /*                                                                 */
   10649             : /*******************************************************************/
   10650             : /* We use the prefix mf2; k represents the weight -1/2, so e.g.
   10651             :    k = 2 is weight 5/2. N is the level, so 4\mid N, and CHI is the
   10652             :    character, always even. */
   10653             : 
   10654             : static long
   10655        3360 : lamCO(long r, long s, long p)
   10656             : {
   10657        3360 :   if ((s << 1) <= r)
   10658             :   {
   10659        1232 :     long rp = r >> 1;
   10660        1232 :     if (odd(r)) return upowuu(p, rp) << 1;
   10661         336 :     else return (p + 1)*upowuu(p, rp - 1);
   10662             :   }
   10663        2128 :   else return upowuu(p, r - s) << 1;
   10664             : }
   10665             : 
   10666             : static int
   10667        1568 : condC(GEN faN, GEN valF)
   10668             : {
   10669        1568 :   GEN P = gel(faN, 1), E = gel(faN, 2);
   10670        1568 :   long l = lg(P), i;
   10671        3696 :   for (i = 1; i < l; i++)
   10672        3024 :     if ((P[i] & 3L) == 3)
   10673             :     {
   10674        1120 :       long r = E[i];
   10675        1120 :       if (odd(r) || r < (valF[i] << 1)) return 1;
   10676             :     }
   10677         672 :   return 0;
   10678             : }
   10679             : 
   10680             : /* returns 2*zetaCO; weight is k + 1/2 */
   10681             : static long
   10682        3696 : zeta2CO(GEN faN, GEN valF, long r2, long s2, long k)
   10683             : {
   10684        3696 :   if (r2 >= 4) return lamCO(r2, s2, 2) << 1;
   10685        2912 :   if (r2 == 3) return 6;
   10686        1568 :   if (condC(faN, valF)) return 4;
   10687         672 :   if (odd(k)) return s2 ? 3 : 5; else return s2 ? 5: 3;
   10688             : }
   10689             : 
   10690             : /* returns 4 times last term in formula */
   10691             : static long
   10692        3696 : dim22(long N, long F, long k)
   10693             : {
   10694        3696 :   pari_sp av = avma;
   10695        3696 :   GEN vF, faN = myfactoru(N), P = gel(faN, 1), E = gel(faN, 2);
   10696        3696 :   long i, D, l = lg(P);
   10697        3696 :   vF = cgetg(l, t_VECSMALL);
   10698        9968 :   for (i = 1; i < l; i++) vF[i] = u_lval(F, P[i]);
   10699        3696 :   D = zeta2CO(faN, vF, E[1], vF[1], k);
   10700        6272 :   for (i = 2; i < l; i++) D *= lamCO(E[i], vF[i], P[i]);
   10701        3696 :   return gc_long(av,D);
   10702             : }
   10703             : 
   10704             : /* PSI not necessarily primitive, of conductor F */
   10705             : static int
   10706       13846 : charistotallyeven(GEN PSI, long F)
   10707             : {
   10708       13846 :   pari_sp av = avma;
   10709       13846 :   GEN P = gel(myfactoru(F), 1);
   10710       13846 :   GEN G = gel(PSI,1), psi = gel(PSI,2);
   10711             :   long i;
   10712       14350 :   for (i = 1; i < lg(P); i++)
   10713             :   {
   10714         532 :     GEN psip = znchardecompose(G, psi, utoipos(P[i]));
   10715         532 :     if (zncharisodd(G, psip)) return gc_bool(av,0);
   10716             :   }
   10717       13818 :   return gc_bool(av,1);
   10718             : }
   10719             : 
   10720             : static GEN
   10721      299775 : get_PSI(GEN CHI, long t)
   10722             : {
   10723      299775 :   long r = t & 3L, t2 = (r == 2 || r == 3) ? t << 2 : t;
   10724      299775 :   return mfcharmul_i(CHI, induce(gel(CHI,1), utoipos(t2)));
   10725             : }
   10726             : /* space = mf_CUSP, mf_EISEN or mf_FULL, weight k + 1/2 */
   10727             : static long
   10728       41363 : mf2dimwt12(long N, GEN CHI, long space)
   10729             : {
   10730       41363 :   pari_sp av = avma;
   10731       41363 :   GEN D = mydivisorsu(N >> 2);
   10732       41363 :   long i, l = lg(D), dim3 = 0, dim4 = 0;
   10733             : 
   10734       41363 :   CHI = induceN(N, CHI);
   10735      341138 :   for (i = 1; i < l; i++)
   10736             :   {
   10737      299775 :     long rp, t = D[i], Mt = D[l-i];
   10738      299775 :     GEN PSI = get_PSI(CHI,t);
   10739      299775 :     rp = mfcharconductor(PSI);
   10740      299775 :     if (Mt % (rp*rp) == 0) { dim4++; if (charistotallyeven(PSI,rp)) dim3++; }
   10741             :   }
   10742       41363 :   set_avma(av);
   10743       41363 :   switch (space)
   10744             :   {
   10745       40439 :     case mf_CUSP: return dim4 - dim3;
   10746         462 :     case mf_EISEN:return dim3;
   10747         462 :     case mf_FULL: return dim4;
   10748             :   }
   10749             :   return 0; /*LCOV_EXCL_LINE*/
   10750             : }
   10751             : 
   10752             : static long
   10753         693 : mf2dimwt32(long N, GEN CHI, long F, long space)
   10754             : {
   10755             :   long D;
   10756         693 :   switch(space)
   10757             :   {
   10758         231 :     case mf_CUSP: D = mypsiu(N) - 6*dim22(N, F, 1);
   10759         231 :       if (D%24) pari_err_BUG("mfdim");
   10760         231 :       return D/24 + mf2dimwt12(N, CHI, 4);
   10761         231 :     case mf_FULL: D = mypsiu(N) + 6*dim22(N, F, 0);
   10762         231 :       if (D%24) pari_err_BUG("mfdim");
   10763         231 :       return D/24 + mf2dimwt12(N, CHI, 1);
   10764         231 :     case mf_EISEN: D = dim22(N, F, 0) + dim22(N, F, 1);
   10765         231 :       if (D & 3L) pari_err_BUG("mfdim");
   10766         231 :       return (D >> 2) - mf2dimwt12(N, CHI, 3);
   10767             :   }
   10768             :   return 0; /*LCOV_EXCL_LINE*/
   10769             : }
   10770             : 
   10771             : /* F = conductor(CHI), weight k = r+1/2 */
   10772             : static long
   10773       43729 : checkmf2(long N, long r, GEN CHI, long F, long space)
   10774             : {
   10775       43729 :   switch(space)
   10776             :   {
   10777       43708 :     case mf_FULL: case mf_CUSP: case mf_EISEN: break;
   10778          14 :     case mf_NEW: case mf_OLD:
   10779          14 :       pari_err_TYPE("half-integral weight [new/old spaces]", utoi(space));
   10780           7 :     default:
   10781           7 :       pari_err_TYPE("half-integral weight [incorrect space]",utoi(space));
   10782             :   }
   10783       43708 :   if (N & 3L)
   10784           0 :     pari_err_DOMAIN("half-integral weight", "N % 4", "!=", gen_0, stoi(N));
   10785       43708 :   return r >= 0 && mfcharparity(CHI) == 1 && N % F == 0;
   10786             : }
   10787             : 
   10788             : /* weight k = r + 1/2 */
   10789             : static long
   10790       43463 : mf2dim_Nkchi(long N, long r, GEN CHI, ulong space)
   10791             : {
   10792       43463 :   long D, D2, F = mfcharconductor(CHI);
   10793       43463 :   if (!checkmf2(N, r, CHI, F, space)) return 0;
   10794       43442 :   if (r == 0) return mf2dimwt12(N, CHI, space);
   10795        2772 :   if (r == 1) return mf2dimwt32(N, CHI, F, space);
   10796        2079 :   if (space == mf_EISEN)
   10797             :   {
   10798         693 :     D = dim22(N, F, r) + dim22(N, F, 1-r);
   10799         693 :     if (D & 3L) pari_err_BUG("mfdim");
   10800         693 :     return D >> 2;
   10801             :   }
   10802        1386 :   D2 = space == mf_FULL? dim22(N, F, 1-r): -dim22(N, F, r);
   10803        1386 :   D = (2*r-1)*mypsiu(N) + 6*D2;
   10804        1386 :   if (D%24) pari_err_BUG("mfdim");
   10805        1386 :   return D/24;
   10806             : }
   10807             : 
   10808             : /* weight k=r+1/2 */
   10809             : static GEN
   10810         266 : mf2init_Nkchi(long N, long r, GEN CHI, long space, long flraw)
   10811             : {
   10812         266 :   GEN CHI1, Minv, Minvmat, B, M, gk = gaddsg(r,ghalf);
   10813         266 :   GEN mf1 = mkvec4(utoi(N),gk,CHI,utoi(space));
   10814             :   long L;
   10815         266 :   if (!checkmf2(N, r, CHI, mfcharconductor(CHI), space)) return mfEMPTY(mf1);
   10816         266 :   if (space==mf_EISEN) pari_err_IMPL("half-integral weight Eisenstein space");
   10817         266 :   L = mfsturmNgk(N, gk) + 1;
   10818         266 :   B = mf2basis(N, r, CHI, &CHI1, space);
   10819         266 :   M = mflineardivtomat(N,B,L); /* defined modulo T = charpol(CHI) */
   10820         266 :   if (flraw) M = mkvec3(gen_0,gen_0,M);
   10821             :   else
   10822             :   {
   10823         266 :     long o1 = mfcharorder(CHI1), o = mfcharorder(CHI);
   10824         266 :     M = mfcleanCHI(M, CHI, 0);
   10825         266 :     Minv = gel(M,2);
   10826         266 :     Minvmat = RgM_Minv_mul(NULL, Minv); /* mod T */
   10827         266 :     if (o1 != o)
   10828             :     {
   10829         133 :       GEN tr = Qab_trace_init(o, o1, mfcharpol(CHI), mfcharpol(CHI1));
   10830         133 :       Minvmat = QabM_tracerel(tr, 0, Minvmat);
   10831             :     }
   10832             :     /* Minvmat mod T1 = charpol(CHI1) */
   10833         266 :     B = vecmflineardiv_linear(B, Minvmat);
   10834         266 :     gel(M,3) = RgM_Minv_mul(gel(M,3), Minv);
   10835         266 :     gel(M,2) = mkMinv(matid(lg(B)-1), NULL,NULL,NULL);
   10836             :   }
   10837         266 :   return mkmf(mf1, cgetg(1,t_VEC), B, gen_0, M);
   10838             : }
   10839             : 
   10840             : /**************************************************************************/
   10841             : /*                          Kohnen + space                                */
   10842             : /**************************************************************************/
   10843             : 
   10844             : static GEN
   10845          21 : mfkohnenbasis_i(GEN mf, GEN CHI, long eps, long sb)
   10846             : {
   10847          21 :   GEN M = mfcoefs_mf(mf, sb, 1), p, P;
   10848          21 :   long c, i, n = mfcharorder(CHI), l = sb + 2;
   10849          21 :   p = cgetg(l, t_VECSMALL);
   10850             :   /* keep the a_n, n = (2 or 2+eps) mod 4 */
   10851         210 :   for (i = 3, c = 1; i < l; i+=4) p[c++] = i;
   10852         203 :   for (i = 3+eps;    i < l; i+=4) p[c++] = i;
   10853          21 :   P = n <= 2? NULL: mfcharpol(CHI);
   10854          21 :   setlg(p, c);
   10855          21 :   return QabM_ker(rowpermute(M, p), P, n);
   10856             : }
   10857             : GEN
   10858          21 : mfkohnenbasis(GEN mf)
   10859             : {
   10860          21 :   pari_sp av = avma;
   10861             :   GEN gk, CHI, CHIP, K;
   10862             :   long N4, r, eps, sb;
   10863          21 :   mf = checkMF(mf);
   10864          21 :   if (MF_get_space(mf) != mf_CUSP)
   10865           0 :     pari_err_TYPE("mfkohnenbasis [not a cuspidal space", mf);
   10866          21 :   if (!MF_get_dim(mf)) return cgetg(1, t_MAT);
   10867          21 :   N4 = MF_get_N(mf) >> 2; gk = MF_get_gk(mf); CHI = MF_get_CHI(mf);
   10868          21 :   if (typ(gk) == t_INT) pari_err_TYPE("mfkohnenbasis", gk);
   10869          21 :   r = MF_get_r(mf);
   10870          21 :   CHIP = mfcharchiliftprim(CHI, N4);
   10871          21 :   eps = CHIP==CHI? 1: -1;
   10872          21 :   if (odd(r)) eps = -eps;
   10873          21 :   if (uissquarefree(N4))
   10874             :   {
   10875          14 :     long d = mfdim_Nkchi(N4, 2*r, mfcharpow(CHI, gen_2), mf_CUSP);
   10876          14 :     sb = mfsturmNgk(N4 << 2, gk) + 1;
   10877          14 :     K = mfkohnenbasis_i(mf, CHIP, eps, sb);
   10878          14 :     if (lg(K) - 1 == d) return gerepilecopy(av, K);
   10879             :   }
   10880           7 :   sb = mfsturmNgk(N4 << 4, gk) + 1;
   10881           7 :   K = mfkohnenbasis_i(mf, CHIP, eps, sb);
   10882           7 :   return gerepilecopy(av, K);
   10883             : }
   10884             : 
   10885             : static GEN
   10886          21 : get_Shimura(GEN mf, GEN CHI, GEN vB, long t)
   10887             : {
   10888          21 :   long N = MF_get_N(mf), r = MF_get_k(mf) >> 1;
   10889          21 :   long i, d = MF_get_dim(mf), sb = mfsturm_mf(mf);
   10890          21 :   GEN a = cgetg(d+1, t_MAT);
   10891          84 :   for (i = 1; i <= d; i++)
   10892             :   {
   10893          63 :     pari_sp av = avma;
   10894          63 :     GEN f = c_deflate(sb*sb, t, gel(vB,i));
   10895          63 :     f = mftobasis_i(mf, RgV_shimura(f, sb, t, N, r, CHI));
   10896          63 :     gel(a,i) = gerepileupto(av, f);
   10897             :   }
   10898          21 :   return a;
   10899             : }
   10900             : static long
   10901          35 : QabM_rank(GEN M, GEN P, long n)
   10902             : {
   10903          35 :   GEN z = QabM_indexrank(M, P, n);
   10904          35 :   return lg(gel(z,2))-1;
   10905             : }
   10906             : /* discard T[*i] */
   10907             : static void
   10908           0 : discard_Ti(GEN T, long *i, long *lt)
   10909             : {
   10910           0 :   long j, l = *lt-1;
   10911           0 :   for (j = *i; j < l; j++) T[j] = T[j+1];
   10912           0 :   (*i)--; *lt = l;
   10913           0 : }
   10914             : /* return [mf3, bijection, mfkohnenbasis, codeshi] */
   10915             : static GEN
   10916          14 : mfkohnenbijection_i(GEN mf)
   10917             : {
   10918          14 :   GEN CHI = MF_get_CHI(mf), K = mfkohnenbasis(mf);
   10919             :   GEN mres, dMi, Mi, M, C, vB, mf3, SHI, T, P;
   10920          14 :   long N4 = MF_get_N(mf)>>2, r = MF_get_r(mf), dK = lg(K) - 1;
   10921             :   long i, c, n, oldr, lt, ltold, sb3, t, limt;
   10922          14 :   const long MAXlt = 100;
   10923             : 
   10924          14 :   mf3 = mfinit_Nkchi(N4, r<<1, mfcharpow(CHI,gen_2), mf_CUSP, 0);
   10925          14 :   if (MF_get_dim(mf3) != dK)
   10926           0 :     pari_err_BUG("mfkohnenbijection [different dimensions]");
   10927          14 :   if (!dK) return mkvec4(mf3, cgetg(1, t_MAT), K, cgetg(1, t_VEC));
   10928          14 :   CHI = mfcharchiliftprim(CHI, N4);
   10929          14 :   n = mfcharorder(CHI);
   10930          14 :   P = n<=2? NULL: mfcharpol(CHI);
   10931          14 :   SHI = cgetg(MAXlt, t_COL);
   10932          14 :   T = cgetg(MAXlt, t_VECSMALL);
   10933          14 :   sb3 = mfsturm_mf(mf3);
   10934          14 :   limt = 6; oldr = 0; vB = C = M = NULL;
   10935          98 :   for (t = lt = ltold = 1; lt < MAXlt; t++)
   10936             :   {
   10937             :     pari_sp av;
   10938          98 :     if (!uissquarefree(t)) continue;
   10939          84 :     T[lt++] = t; if (t <= limt) continue;
   10940          14 :     av = avma;
   10941          14 :     if (vB) gunclone(vB);
   10942             :     /* could improve the rest but 99% of running time is spent here */
   10943          14 :     vB = gclone( RgM_mul(mfcoefs_mf(mf, t*sb3*sb3, 1), K) );
   10944          14 :     set_avma(av);
   10945          21 :     for (i = ltold; i < lt; i++)
   10946             :     {
   10947             :       pari_sp av;
   10948             :       long r;
   10949          21 :       M = get_Shimura(mf3, CHI, vB, T[i]);
   10950          21 :       r = QabM_rank(M, P, n); if (!r) { discard_Ti(T, &i, &lt); continue; }
   10951          21 :       gel(SHI, i) = M; setlg(SHI, i+1);
   10952          21 :       if (r >= dK) { C = vecsmall_ei(dK, i); goto DONE; }
   10953          14 :       if (i == 1) { oldr = r; continue; }
   10954           7 :       av = avma; M = shallowmatconcat(SHI);
   10955           7 :       r = QabM_rank(M, P, n); /* >= rank(sum C[j] SHI[j]), probably sharp */
   10956           7 :       if (r >= dK)
   10957             :       {
   10958           7 :         M = RgV_sum(SHI);
   10959           7 :         if (QabM_rank(M, P, n) >= dK) { C = const_vecsmall(dK, 1); goto DONE; }
   10960           0 :         C = random_Flv(dK, 16);
   10961           0 :         M = RgV_zc_mul(SHI, C);
   10962           0 :         if (QabM_rank(M, P, n) >= dK) goto DONE;
   10963             :       }
   10964           0 :       else if (r == oldr) discard_Ti(T, &i, &lt);
   10965           0 :       oldr = r; set_avma(av);
   10966             :     }
   10967           0 :     limt *= 2; ltold = lt;
   10968             :   }
   10969           0 :   pari_err_BUG("mfkohnenbijection");
   10970          14 : DONE:
   10971          14 :   gunclone(vB); lt = lg(SHI);
   10972          14 :   Mi = QabM_pseudoinv(M,P,n, NULL,&dMi); Mi = RgM_Rg_div(Mi,dMi);
   10973          14 :   mres = cgetg(lt, t_VEC);
   10974          35 :   for (i = c = 1; i < lt; i++)
   10975          21 :     if (C[i]) gel(mres,c++) = mkvec2s(T[i], C[i]);
   10976          14 :   setlg(mres,c); return mkvec4(mf3, Mi, K, mres);
   10977             : }
   10978             : GEN
   10979          14 : mfkohnenbijection(GEN mf)
   10980             : {
   10981          14 :   pari_sp av = avma;
   10982             :   long N;
   10983          14 :   mf = checkMF(mf); N = MF_get_N(mf);
   10984          14 :   if (!uissquarefree(N >> 2))
   10985           0 :     pari_err_TYPE("mfkohnenbijection [N/4 not squarefree]", utoi(N));
   10986          14 :   if (MF_get_space(mf) != mf_CUSP || MF_get_r(mf) == 0 || !mfshimura_space_cusp(mf))
   10987           0 :     pari_err_TYPE("mfkohnenbijection [incorrect mf for Kohnen]", mf);
   10988          14 :   return gerepilecopy(av, mfkohnenbijection_i(mf));
   10989             : }
   10990             : 
   10991             : static int
   10992           7 : checkbij_i(GEN b)
   10993             : {
   10994           7 :   return typ(b) == t_VEC && lg(b) == 5 && checkMF_i(gel(b,1))
   10995           7 :          && typ(gel(b,2)) == t_MAT
   10996           7 :          && typ(gel(b,3)) == t_MAT
   10997          14 :          && typ(gel(b,4)) == t_VEC;
   10998             : }
   10999             : 
   11000             : /* bij is the output of mfkohnenbijection */
   11001             : GEN
   11002           7 : mfkohneneigenbasis(GEN mf, GEN bij)
   11003             : {
   11004           7 :   pari_sp av = avma;
   11005             :   GEN mf3, mf30, B, KM, M, k;
   11006             :   long r, i, l, N4;
   11007           7 :   mf = checkMF(mf);
   11008           7 :   if (!checkbij_i(bij))
   11009           0 :     pari_err_TYPE("mfkohneneigenbasis [bijection]", bij);
   11010           7 :   if (MF_get_space(mf) != mf_CUSP)
   11011           0 :     pari_err_TYPE("mfkohneneigenbasis [not a cuspidal space]", mf);
   11012           7 :   if (!MF_get_dim(mf))
   11013           0 :     retmkvec3(cgetg(1, t_VEC), cgetg(1, t_VEC), cgetg(1, t_VEC));
   11014           7 :   N4 = MF_get_N(mf) >> 2; k = MF_get_gk(mf);
   11015           7 :   if (typ(k) == t_INT) pari_err_TYPE("mfkohneneigenbasis", k);
   11016           7 :   if (!uissquarefree(N4))
   11017           0 :     pari_err_TYPE("mfkohneneigenbasis [N not squarefree]", utoipos(N4));
   11018           7 :   r = MF_get_r(mf);
   11019           7 :   KM = RgM_mul(gel(bij,3), gel(bij,2));
   11020           7 :   mf3 = gel(bij,1);
   11021           7 :   mf30 = mfinit_Nkchi(N4, 2*r, MF_get_CHI(mf3), mf_NEW, 0);
   11022           7 :   B = mfcoefs_mf(mf30, mfsturm_mf(mf3), 1); l = lg(B);
   11023           7 :   M = cgetg(l, t_MAT);
   11024          21 :   for (i=1; i<l; i++) gel(M,i) = RgM_RgC_mul(KM, mftobasis_i(mf3, gel(B,i)));
   11025           7 :   return gerepilecopy(av, mkvec3(mf30, M, RgM_mul(M, MF_get_newforms(mf30))));
   11026             : }
   11027             : /*************************** End Kohnen ************************************/
   11028             : /***************************************************************************/
   11029             : 
   11030             : static GEN desc(GEN F);
   11031             : static GEN
   11032         504 : desc_mfeisen(GEN F)
   11033             : {
   11034         504 :   GEN R, gk = mf_get_gk(F);
   11035         504 :   if (typ(gk) == t_FRAC)
   11036           7 :     R = gsprintf("H_{%Ps}", gk);
   11037             :   else
   11038             :   {
   11039         497 :     GEN vchi = gel(F, 2), CHI = mfchisimpl(gel(vchi, 3));
   11040         497 :     long k = itou(gk);
   11041         497 :     if (lg(vchi) < 5) R = gsprintf("F_%ld(%Ps)", k, CHI);
   11042             :     else
   11043             :     {
   11044         294 :       GEN CHI2 = mfchisimpl(gel(vchi, 4));
   11045         294 :       R = gsprintf("F_%ld(%Ps, %Ps)", k, CHI, CHI2);
   11046             :     }
   11047             :   }
   11048         504 :   return R;
   11049             : }
   11050             : static GEN
   11051          35 : desc_hecke(GEN F)
   11052             : {
   11053             :   long n, N;
   11054          35 :   GEN D = gel(F,2);
   11055          35 :   if (typ(D) == t_VECSMALL) { N = D[3]; n = D[1]; }
   11056          14 :   else { GEN nN = gel(D,2); n = nN[1]; N = nN[2]; } /* half integer */
   11057          35 :   return gsprintf("T_%ld(%ld)(%Ps)", N, n, desc(gel(F,3)));
   11058             : }
   11059             : static GEN
   11060          98 : desc_linear(GEN FLD, GEN dL)
   11061             : {
   11062          98 :   GEN F = gel(FLD,2), L = gel(FLD,3), R = strtoGENstr("LIN([");
   11063          98 :   long n = lg(F) - 1, i;
   11064         168 :   for (i = 1; i <= n; i++)
   11065             :   {
   11066         168 :     R = shallowconcat(R, desc(gel(F,i))); if (i == n) break;
   11067          70 :     R = shallowconcat(R, strtoGENstr(", "));
   11068             :   }
   11069          98 :   return shallowconcat(R, gsprintf("], %Ps)", gdiv(L, dL)));
   11070             : }
   11071             : static GEN
   11072          21 : desc_dihedral(GEN F)
   11073             : {
   11074          21 :   GEN bnr = gel(F,2), D = nf_get_disc(bnr_get_nf(bnr)), f = bnr_get_mod(bnr);
   11075          21 :   GEN cyc = bnr_get_cyc(bnr);
   11076          21 :   GEN w = gel(F,3), chin = zv_to_ZV(gel(w,2)), o = utoi(gel(w,1)[1]);
   11077          21 :   GEN chi = char_denormalize(cyc, o, chin);
   11078          21 :   if (lg(gel(f,2)) == 1) f = gel(f,1);
   11079          21 :   return gsprintf("DIH(%Ps, %Ps, %Ps, %Ps)",D,f,cyc,chi);
   11080             : }
   11081             : 
   11082             : static void
   11083        1043 : unpack0(GEN *U)
   11084        1043 : { if (U) *U = mkvec2(cgetg(1, t_VEC), cgetg(1, t_VEC)); }
   11085             : static void
   11086          42 : unpack2(GEN F, GEN *U)
   11087          42 : { if (U) *U = mkvec2(mkvec2(gel(F,2), gel(F,3)), cgetg(1, t_VEC)); }
   11088             : static void
   11089         308 : unpack23(GEN F, GEN *U)
   11090         308 : { if (U) *U = mkvec2(mkvec(gel(F,2)), mkvec(gel(F,3))); }
   11091             : static GEN
   11092        1540 : desc_i(GEN F, GEN *U)
   11093             : {
   11094        1540 :   switch(mf_get_type(F))
   11095             :   {
   11096           7 :     case t_MF_CONST: unpack0(U); return gsprintf("CONST(%Ps)", gel(F,2));
   11097         504 :     case t_MF_EISEN: unpack0(U); return desc_mfeisen(F);
   11098         154 :     case t_MF_Ek: unpack0(U); return gsprintf("E_%ld", mf_get_k(F));
   11099          63 :     case t_MF_DELTA: unpack0(U); return gsprintf("DELTA");
   11100          35 :     case t_MF_THETA: unpack0(U);
   11101          35 :       return gsprintf("THETA(%Ps)", mfchisimpl(gel(F,2)));
   11102          56 :     case t_MF_ETAQUO: unpack0(U);
   11103          56 :       return gsprintf("ETAQUO(%Ps, %Ps)", gel(F,2), gel(F,3));
   11104          56 :     case t_MF_ELL: unpack0(U);
   11105          56 :       return gsprintf("ELL(%Ps)", vecslice(gel(F,2), 1, 5));
   11106           7 :     case t_MF_TRACE: unpack0(U); return gsprintf("TR(%Ps)", mfparams(F));
   11107         140 :     case t_MF_NEWTRACE: unpack0(U); return gsprintf("TR^new(%Ps)", mfparams(F));
   11108          21 :     case t_MF_DIHEDRAL: unpack0(U); return desc_dihedral(F);
   11109          28 :     case t_MF_MUL: unpack2(F, U);
   11110          28 :       return gsprintf("MUL(%Ps, %Ps)", desc(gel(F,2)), desc(gel(F,3)));
   11111          14 :     case t_MF_DIV: unpack2(F, U);
   11112          14 :       return gsprintf("DIV(%Ps, %Ps)", desc(gel(F,2)), desc(gel(F,3)));
   11113          14 :     case t_MF_POW: unpack23(F, U);
   11114          14 :       return gsprintf("POW(%Ps, %ld)", desc(gel(F,2)), itos(gel(F,3)));
   11115          14 :     case t_MF_SHIFT: unpack23(F, U);
   11116          14 :       return gsprintf("SHIFT(%Ps, %ld)", desc(gel(F,2)), itos(gel(F,3)));
   11117          14 :     case t_MF_DERIV: unpack23(F, U);
   11118          14 :       return gsprintf("DER^%ld(%Ps)", itos(gel(F,3)), desc(gel(F,2)));
   11119          21 :     case t_MF_DERIVE2: unpack23(F, U);
   11120          21 :       return gsprintf("DERE2^%ld(%Ps)", itos(gel(F,3)), desc(gel(F,2)));
   11121          14 :     case t_MF_TWIST: unpack23(F, U);
   11122          14 :       return gsprintf("TWIST(%Ps, %Ps)", desc(gel(F,2)), gel(F,3));
   11123         231 :     case t_MF_BD: unpack23(F, U);
   11124         231 :       return gsprintf("B(%ld)(%Ps)", itou(gel(F,3)), desc(gel(F,2)));
   11125          14 :     case t_MF_BRACKET:
   11126          14 :       if (U) *U = mkvec2(mkvec2(gel(F,2), gel(F,3)), mkvec(gel(F,4)));
   11127          14 :       return gsprintf("MULRC_%ld(%Ps, %Ps)", itos(gel(F,4)), desc(gel(F,2)), desc(gel(F,3)));
   11128          98 :     case t_MF_LINEAR_BHN:
   11129             :     case t_MF_LINEAR:
   11130          98 :       if (U) *U = mkvec2(gel(F,2), mkvec(gdiv(gel(F,3), gel(F,4))));
   11131          98 :       return desc_linear(F,gel(F,4));
   11132          35 :     case t_MF_HECKE:
   11133          35 :       if (U) *U = mkvec2(mkvec(gel(F,3)), mkvec(stoi(gel(F,2)[1])));
   11134          35 :       return desc_hecke(F);
   11135           0 :     default: pari_err_TYPE("mfdescribe",F);
   11136             :     return NULL;/*LCOV_EXCL_LINE*/
   11137             :   }
   11138             : }
   11139             : static GEN
   11140         623 : desc(GEN F) { return desc_i(F, NULL); }
   11141             : GEN
   11142         966 : mfdescribe(GEN F, GEN *U)
   11143             : {
   11144         966 :   pari_sp av = avma;
   11145             :   GEN mf;
   11146         966 :   if ((mf = checkMF_i(F)))
   11147             :   {
   11148          49 :     const char *f = NULL;
   11149          49 :     switch (MF_get_space(mf))
   11150             :     {
   11151           7 :       case mf_NEW:  f = "S_%Ps^new(G_0(%ld, %Ps))"; break;
   11152          14 :       case mf_CUSP: f = "S_%Ps(G_0(%ld, %Ps))"; break;
   11153           7 :       case mf_OLD:  f = "S_%Ps^old(G_0(%ld, %Ps))"; break;
   11154           7 :       case mf_EISEN:f = "E_%Ps(G_0(%ld, %Ps))"; break;
   11155          14 :       case mf_FULL: f = "M_%Ps(G_0(%ld, %Ps))"; break;
   11156             :     }
   11157          49 :     if (U) *U = cgetg(1, t_VEC);
   11158          49 :     return gsprintf(f, MF_get_gk(mf), MF_get_N(mf), mfchisimpl(MF_get_CHI(mf)));
   11159             :   }
   11160         917 :   if (!checkmf_i(F)) pari_err_TYPE("mfdescribe", F);
   11161         917 :   F = desc_i(F, U); return gc_all(av, U ? 2: 1, &F, U);
   11162             : }
   11163             : 
   11164             : /***********************************************************************/
   11165             : /*               Eisenstein series H_r of weight r+1/2                 */
   11166             : /***********************************************************************/
   11167             : /* radical(u_ppo(g,q)) */
   11168             : static long
   11169          28 : u_pporad(long g, long q)
   11170             : {
   11171          28 :   GEN F = myfactoru(g), P = gel(F,1);
   11172             :   long i, l, n;
   11173          28 :   if (q == 1) return zv_prod(P);
   11174          28 :   l = lg(P);
   11175          35 :   for (i = n = 1; i < l; i++)
   11176             :   {
   11177           7 :     long p = P[i];
   11178           7 :     if (q % p) n *= p;
   11179             :   }
   11180          28 :   return n;
   11181             : }
   11182             : static void
   11183         266 : c_F2TH4(long n, GEN *pF2, GEN *pTH4)
   11184             : {
   11185         266 :   GEN v = mfcoefs_i(mfEk(2), n, 1), v2 = bdexpand(v,2), v4 = bdexpand(v,4);
   11186         266 :   GEN F2 = gdivgs(ZC_add(ZC_sub(v, ZC_z_mul(v2,3)), ZC_z_mul(v4,2)), -24);
   11187         266 :   GEN TH4 = gdivgs(ZC_sub(v, ZC_z_mul(v4,4)), -3);
   11188         266 :   settyp(F2,t_VEC); *pF2 = F2;
   11189         266 :   settyp(TH4,t_VEC);*pTH4= TH4;
   11190         266 : }
   11191             : /* r > 0, N >= 0 */
   11192             : static GEN
   11193          77 : mfEHcoef(long r, long N)
   11194             : {
   11195             :   long D0, f, i, l, s;
   11196             :   GEN S, Df;
   11197             : 
   11198          77 :   if (r == 1) return hclassno(utoi(N));
   11199          77 :   if (N == 0) return gdivgs(bernfrac(2*r), -2*r);
   11200          56 :   s = N & 3L;
   11201          56 :   if (odd(r))
   11202             :   {
   11203          42 :     if (s == 2 || s == 1) return gen_0;
   11204          14 :     D0 = mycoredisc2neg(N,&f);
   11205             :   }
   11206             :   else
   11207             :   {
   11208          14 :     if (s == 2 || s == 3) return gen_0;
   11209          14 :     D0 = mycoredisc2pos(N,&f);
   11210             :   }
   11211          28 :   Df = mydivisorsu(u_pporad(f, D0)); l = lg(Df);
   11212          28 :   S = gen_0;
   11213          63 :   for (i = 1; i < l; i++)
   11214             :   {
   11215          35 :     long d = Df[i], s = mymoebiusu(d)*kross(D0, d); /* != 0 */
   11216          35 :     GEN c = gmul(powuu(d, r-1), mysumdivku(f/d, 2*r-1));
   11217          35 :     S = s > 0? addii(S, c): subii(S, c);
   11218             :   }
   11219          28 :   return gmul(lfunquadneg_naive(D0, r), S);
   11220             : }
   11221             : static GEN
   11222         266 : mfEHmat(long lim, long r)
   11223             : {
   11224         266 :   long j, l, d = r/2;
   11225             :   GEN f2, th4, th3, v, vth4, vf2;
   11226         266 :   c_F2TH4(lim, &f2, &th4);
   11227         266 :   f2 =  RgV_to_ser(f2, 0, lim+3);
   11228         266 :   th4 = RgV_to_ser(th4, 0, lim+3);
   11229         266 :   th3 = RgV_to_ser(c_theta(lim, 1, mfchartrivial()), 0, lim+3);
   11230         266 :   if (odd(r)) th3 = gpowgs(th3, 3);
   11231         266 :   vth4 = gpowers(th4, d);
   11232         266 :   vf2 = gpowers0(f2, d, th3); /* th3 f2^j */
   11233         266 :   l = d+2; v = cgetg(l, t_VEC);
   11234         924 :   for (j = 1; j < l; j++)
   11235         658 :     gel(v, j) = ser2rfrac_i(gmul(gel(vth4, l-j), gel(vf2, j)));
   11236         266 :   return RgXV_to_RgM(v, lim);
   11237             : }
   11238             : static GEN
   11239           7 : Hfind(long r, GEN *pden)
   11240             : {
   11241           7 :   long lim = (r/2)+3, i;
   11242             :   GEN res, M, B;
   11243             : 
   11244           7 :   if (r <= 0) pari_err_DOMAIN("mfEH", "r", "<=", gen_0, stoi(r));
   11245           7 :   M = mfEHmat(lim, r);
   11246           7 :   B = cgetg(lim+1, t_COL);
   11247          56 :   for (i = 1; i <= lim; i++) gel(B, i) = mfEHcoef(r, i-1);
   11248           7 :   res = QM_gauss(M, B);
   11249           7 :   if (lg(res) == 1) pari_err_BUG("mfEH");
   11250           7 :   return Q_remove_denom(res,pden);
   11251             : }
   11252             : GEN
   11253         266 : mfEH(GEN gk)
   11254             : {
   11255         266 :   pari_sp av = avma;
   11256         266 :   GEN v, d, NK, gr = gsub(gk, ghalf);
   11257             :   long r;
   11258         266 :   if (typ(gr) != t_INT) pari_err_TYPE("mfEH", gk);
   11259         266 :   r = itos(gr);
   11260         266 :   switch (r)
   11261             :   {
   11262           7 :     case 1: v=cgetg(1,t_VEC); d=gen_1; break;
   11263         133 :     case 2: v=mkvec2s(1,-20); d=utoipos(120); break;
   11264          56 :     case 3: v=mkvec2s(-1,14); d=utoipos(252); break;
   11265          35 :     case 4: v=mkvec3s(1,-16,16); d=utoipos(240); break;
   11266           7 :     case 5: v=mkvec3s(-1,22,-88); d=utoipos(132); break;
   11267          14 :     case 6: v=mkvec4s(691,-18096,110136,-4160); d=utoipos(32760); break;
   11268           7 :     case 7: v=mkvec4s(-1,30,-240,224); d=utoipos(12); break;
   11269           7 :     default: v = Hfind(r, &d); break;
   11270             :   }
   11271         266 :   NK = mkgNK(utoipos(4), gaddgs(ghalf,r), mfchartrivial(), pol_x(1));
   11272         266 :   return gerepilecopy(av, tag(t_MF_EISEN, NK, mkvec2(v,d)));
   11273             : }
   11274             : 
   11275             : /**********************************************************/
   11276             : /*             T(f^2) for half-integral weight            */
   11277             : /**********************************************************/
   11278             : 
   11279             : /* T_p^2 V, p2 = p^2, c1 = chi(p) (-1/p)^r p^(r-1), c2 = chi(p^2)*p^(2r-1) */
   11280             : static GEN
   11281          70 : tp2apply(GEN V, long p, long p2, GEN c1, GEN c2)
   11282             : {
   11283          70 :   long lw = (lg(V) - 2)/p2 + 1, m, n;
   11284          70 :   GEN a0 = gel(V,1), W = cgetg(lw + 1, t_VEC);
   11285             : 
   11286          70 :   gel(W,1) = gequal0(a0)? gen_0: gmul(a0, gaddsg(1, c2));
   11287       11109 :   for (n = 1; n < lw; n++)
   11288             :   {
   11289       11039 :     GEN c = gel(V, p2*n + 1);
   11290       11039 :     if (n%p) c = gadd(c, gmulsg(kross(n,p), gmul(gel(V,n+1), c1)));
   11291       11039 :     gel(W, n+1) = c; /* a(p^2*n) + c1 * (n/p) a(n) */
   11292             :   }
   11293        1253 :   for (m = 1, n = p2; n < lw; m++, n += p2)
   11294        1183 :     gel(W, n+1) = gadd(gel(W,n+1), gmul(gel(V,m+1), c2));
   11295          70 :   return W;
   11296             : }
   11297             : 
   11298             : /* T_{p^{2e}} V; can derecursify [Purkait, Hecke operators in half-integral
   11299             :  * weight, Prop 4.3], not worth it */
   11300             : static GEN
   11301          70 : tp2eapply(GEN V, long p, long p2, long e, GEN q, GEN c1, GEN c2)
   11302             : {
   11303          70 :   GEN V4 = NULL;
   11304          70 :   if (e > 1)
   11305             :   {
   11306          21 :     V4 = vecslice(V, 1, (lg(V) - 2)/(p2*p2) + 1);
   11307          21 :     V = tp2eapply(V, p, p2, e-1, q, c1, c2);
   11308             :   }
   11309          70 :   V = tp2apply(V, p, p2, c1, c2);
   11310          70 :   if (e > 1)
   11311          28 :     V = gsub(V, (e == 2)? gmul(q, V4)
   11312           7 :                         : gmul(c2, tp2eapply(V4, p, p2, e-2, q, c1, c2)));
   11313          70 :   return V;
   11314             : }
   11315             : /* weight k = r+1/2 */
   11316             : static GEN
   11317          98 : RgV_heckef2(long n, long d, GEN V, GEN F, GEN DATA)
   11318             : {
   11319          98 :   GEN CHI = mf_get_CHI(F), fa = gel(DATA,1), P = gel(fa,1), E = gel(fa,2);
   11320          98 :   long i, l = lg(P), r = mf_get_r(F), s4 = odd(r)? -4: 4, k2m2 = (r<<1)-1;
   11321          98 :   if (typ(V) == t_COL) V = shallowtrans(V);
   11322         140 :   for (i = 1; i < l; i++)
   11323             :   { /* p does not divide N */
   11324          42 :     long p = P[i], e = E[i], p2 = p*p;
   11325          42 :     GEN c1, c2, a, b, q = NULL, C = mfchareval(CHI,p), C2 = gsqr(C);
   11326          42 :     a = r? powuu(p,r-1): mkfrac(gen_1,utoipos(p)); /* p^(r-1) = p^(k-3/2) */
   11327          42 :     b = r? mulii(powuu(p,r), a): a; /* p^(2r-1) = p^(2k-2) */
   11328          42 :     c1 = gmul(C, gmulsg(kross(s4,p),a));
   11329          42 :     c2 = gmul(C2, b);
   11330          42 :     if (e > 1)
   11331             :     {
   11332          14 :       q = r? powuu(p,k2m2): a;
   11333          14 :       if (e == 2) q = gmul(q, uutoQ(p+1,p)); /* special case T_{p^4} */
   11334          14 :       q = gmul(C2, q); /* chi(p^2) [ p^(2k-2) or (p+1)p^(2k-3) ] */
   11335             :     }
   11336          42 :     V = tp2eapply(V, p, p2, e, q, c1, c2);
   11337             :   }
   11338          98 :   return c_deflate(n, d, V);
   11339             : }
   11340             : 
   11341             : static GEN
   11342        1120 : GL2toSL2(GEN g, GEN *abd)
   11343             : {
   11344             :   GEN A, B, C, D, u, v, a, b, d, q;
   11345        1120 :   g = Q_primpart(g);
   11346        1120 :   if (!check_M2Z(g)) pari_err_TYPE("GL2toSL2", g);
   11347        1120 :   A = gcoeff(g,1,1); B = gcoeff(g,1,2);
   11348        1120 :   C = gcoeff(g,2,1); D = gcoeff(g,2,2);
   11349        1120 :   a = bezout(A, C, &u, &v);
   11350        1120 :   if (!equali1(a)) { A = diviiexact(A,a); C = diviiexact(C,a); }
   11351        1120 :   d = subii(mulii(A,D), mulii(B,C));
   11352        1120 :   if (signe(d) <= 0) pari_err_TYPE("GL2toSL2",g);
   11353        1113 :   q = dvmdii(addii(mulii(u,B), mulii(v,D)), d, &b);
   11354        1113 :   *abd = (equali1(a) && equali1(d))? NULL: mkvec3(a, b, d);
   11355        1113 :   return mkmat22(A, subii(mulii(q,A), v), C, addii(mulii(q,C), u));
   11356             : }
   11357             : 
   11358             : static GEN
   11359        8092 : Rg_approx(GEN t, long bit)
   11360             : {
   11361        8092 :   GEN a = real_i(t), b = imag_i(t);
   11362        8092 :   long e1 = gexpo(a), e2 = gexpo(b);
   11363        8092 :   if (e2 < -bit) { t = e1 < -bit? gen_0: a; }
   11364        6195 :   else if (e1 < -bit) t = gmul(b, gen_I());
   11365        8092 :   return t;
   11366             : }
   11367             : static GEN
   11368         119 : RgV_approx(GEN v, long bit)
   11369             : {
   11370         119 :   long i, l = lg(v);
   11371         119 :   GEN w = cgetg_copy(v, &l);
   11372         805 :   for (i = 1; i < lg(v); i++) gel(w,i) = Rg_approx(gel(v,i), bit);
   11373         119 :   return w;
   11374             : }
   11375             : /* m != 2 (mod 4), D t_INT; V has "denominator" D, recognize in Q(zeta_m) */
   11376             : static GEN
   11377         119 : bestapprnf2(GEN V, long m, GEN D, long prec)
   11378             : {
   11379         119 :   long i, j, f, vt = fetch_user_var("t"), bit = prec2nbits_mul(prec, 0.8);
   11380         119 :   GEN Tinit, Vl, H, Pf, P = polcyclo(m, vt);
   11381             : 
   11382         119 :   V = liftpol_shallow(V);
   11383         119 :   V = gmul(RgV_approx(V, bit), D);
   11384         119 :   V = bestapprnf(V, P, NULL, prec);
   11385         119 :   Vl = liftpol_shallow(V);
   11386         119 :   H = coprimes_zv(m);
   11387         595 :   for (i = 2; i < m; i++)
   11388             :   {
   11389         476 :     if (H[i] != 1) continue;
   11390         259 :     if (!gequal(Vl, vecGalois(Vl, i, P, m))) H[i] = 0;
   11391           0 :     else for (j = i; j < m; j *= i) H[i] = 3;
   11392             :   }
   11393         119 :   f = znstar_conductor_bits(Flv_to_F2v(H));
   11394         119 :   if (f == 1) return gdiv(V, D);
   11395          91 :   if (f == m) return gmodulo(gdiv(V, D), P);
   11396           0 :   Pf = polcyclo(f, vt);
   11397           0 :   Tinit = Qab_trace_init(m, f, P, Pf);
   11398           0 :   Vl = QabV_tracerel(Tinit, 0, Vl);
   11399           0 :   return gmodulo(gdiv(Vl, muliu(D, degpol(P)/degpol(Pf))), Pf);
   11400             : }
   11401             : 
   11402             : /* f | ga expansion; [f, mf_eisendec(f)]~ allowed */
   11403             : GEN
   11404        1064 : mfslashexpansion(GEN mf, GEN f, GEN ga, long n, long flrat, GEN *params, long prec)
   11405             : {
   11406        1064 :   pari_sp av = avma;
   11407        1064 :   GEN a, b, d, res, al, V, M, ad, abd, gk, A, awd = NULL;
   11408             :   long i, w;
   11409             : 
   11410        1064 :   mf = checkMF(mf);
   11411        1064 :   gk = MF_get_gk(mf);
   11412        1064 :   M = GL2toSL2(ga, &abd);
   11413        1057 :   if (abd) { a = gel(abd,1); b = gel(abd,2); d = gel(abd,3); }
   11414         819 :   else { a = d = gen_1; b = gen_0; }
   11415        1057 :   ad = gdiv(a,d);
   11416        1057 :   res = mfgaexpansion(mf, f, M, n, prec);
   11417        1057 :   al = gel(res,1);
   11418        1057 :   w = itou(gel(res,2));
   11419        1057 :   V = gel(res,3);
   11420        1057 :   if (flrat)
   11421             :   {
   11422         119 :     GEN CHI = MF_get_CHI(mf);
   11423         119 :     long N = MF_get_N(mf), F = mfcharconductor(CHI);
   11424         119 :     long ord = mfcharorder(CHI), k, deg;
   11425         119 :     long B = umodiu(gcoeff(M,1,2), N);
   11426         119 :     long C = umodiu(gcoeff(M,2,1), N);
   11427         119 :     long D = umodiu(gcoeff(M,2,2), N);
   11428         119 :     long CD = (C * D) % N, BC = (B * C) % F;
   11429             :     GEN CV, t;
   11430             :     /* weight of f * Theta in 1/2-integral weight */
   11431         119 :     k = typ(gk) == t_INT? (long) itou(gk): MF_get_r(mf)+1;
   11432         119 :     CV = odd(k) ? powuu(N, k - 1) : powuu(N, k >> 1);
   11433         119 :     deg = ulcm(ulcm(ord, N/ugcd(N,CD)), F/ugcd(F,BC));
   11434         119 :     if ((deg & 3) == 2) deg >>= 1;
   11435         119 :     if (typ(gk) != t_INT && odd(deg) && mfthetaI(C,D)) deg <<= 2;
   11436         119 :     V = bestapprnf2(V, deg, CV, prec);
   11437         119 :     if (abd && !signe(b))
   11438             :     { /* can [a,0; 0,d] be simplified to id ? */
   11439           7 :       long nk, dk; Qtoss(gk, &nk, &dk);
   11440           7 :       if (ispower(ad, utoipos(2*dk), &t)) /* t^(2*dk) = a/d or t = NULL */
   11441             :       {
   11442           7 :         V = RgV_Rg_mul(V, powiu(t,nk));
   11443           7 :         awd = gdiv(a, muliu(d,w));
   11444             :       }
   11445             :     }
   11446             :   }
   11447         938 :   else if (abd)
   11448             :   { /* ga = M * [a,b;0,d] * rational, F := f | M = q^al * \sum V[j] q^(j/w) */
   11449         231 :     GEN u, t = NULL, wd = muliu(d,w);
   11450             :     /* a > 0, 0 <= b < d; f | ga = (a/d)^(k/2) * F(tau + b/d) */
   11451         231 :     if (signe(b))
   11452             :     {
   11453             :       long ns, ds;
   11454             :       GEN z;
   11455           0 :       Qtoss(gdiv(b, wd), &ns, &ds); z = rootsof1powinit(ns, ds, prec);
   11456           0 :       for (i = 1; i <= n+1; i++) gel(V,i) = gmul(gel(V,i), rootsof1pow(z, i-1));
   11457           0 :       if (!gequal0(al)) t = gexp(gmul(PiI2(prec), gmul(al, gdiv(b,d))), prec);
   11458             :     }
   11459         231 :     awd = gdiv(a, wd);
   11460         231 :     u = gpow(ad, gmul2n(gk,-1), prec);
   11461         231 :     t = t? gmul(t, u): u;
   11462         231 :     V = RgV_Rg_mul(V, t);
   11463             :   }
   11464        1057 :   if (!awd) A = mkmat22(a, b, gen_0, d);
   11465             :   else
   11466             :   { /* rescale and update w from [a,0; 0,d] */
   11467             :     long ns;
   11468         238 :     Qtoss(awd, &ns, &w); /* update w */
   11469         238 :     V = bdexpand(V, ns);
   11470         238 :     if (!gequal0(al))
   11471             :     {
   11472           0 :       GEN adal = gmul(ad, al), sh = gfloor(adal);
   11473           0 :       al = gsub(adal, sh);
   11474           0 :       V = RgV_shift(V, sh);
   11475             :     }
   11476         238 :     A = matid(2);
   11477             :   }
   11478        1057 :   if (params) *params = mkvec3(al, utoipos(w), A);
   11479        1057 :   return gc_all(av,params?2:1,&V,params);
   11480             : }
   11481             : 
   11482             : /**************************************************************/
   11483             : /*         Alternative method for 1/2-integral weight         */
   11484             : /**************************************************************/
   11485             : static GEN
   11486         266 : mf2basis(long N, long r, GEN CHI, GEN *pCHI1, long space)
   11487             : {
   11488             :   GEN CHI1, CHI2, mf1, mf2, B1, B2, BT, M1, M2, M, M2i, T, Th, v, den;
   11489         266 :   long sb, N2, o1, o2, k1 = r + 1;
   11490             : 
   11491         266 :   if (odd(k1))
   11492             :   {
   11493         154 :     CHI1 = mfcharmul(CHI, get_mfchar(stoi(-4)));
   11494         154 :     CHI2 = mfcharmul(CHI, get_mfchar(stoi(-8)));
   11495             :   }
   11496             :   else
   11497             :   {
   11498         112 :     CHI1 = CHI;
   11499         112 :     CHI2 = mfcharmul(CHI, get_mfchar(utoi(8)));
   11500             :   }
   11501         266 :   mf1 = mfinit_Nkchi(N, k1, CHI1, space, 1);
   11502         266 :   if (pCHI1) *pCHI1 = CHI1;
   11503         266 :   B1 = MF_get_basis(mf1); if (lg(B1) == 1) return cgetg(1,t_VEC);
   11504         259 :   N2 = ulcm(8, N);
   11505         259 :   mf2 = mfinit_Nkchi(N2, k1, CHI2, space, 1);
   11506         259 :   B2 = MF_get_basis(mf2); if (lg(B2) == 1) return cgetg(1,t_VEC);
   11507         259 :   sb = mfsturmNgk(N2, gaddsg(k1, ghalf));
   11508         259 :   M1 = mfcoefs_mf(mf1, sb, 1);
   11509         259 :   M2 = mfcoefs_mf(mf2, sb, 1);
   11510         259 :   Th = mfTheta(NULL);
   11511         259 :   BT = mfcoefs_i(Th, sb, 1);
   11512         259 :   M1 = mfmatsermul(M1, RgV_to_RgX(expandbd(BT,2),0));
   11513         259 :   M2 = mfmatsermul(M2, RgV_to_RgX(BT,0));
   11514         259 :   o1= mfcharorder(CHI1);
   11515         259 :   T = (o1 <= 2)? NULL: mfcharpol(CHI1);
   11516         259 :   if (o1 > 2) M1 = liftpol_shallow(M1);
   11517         259 :   o2= mfcharorder(CHI2);
   11518         259 :   if (T)
   11519             :   {
   11520          14 :     if (o2 == o1) M2 = liftpol_shallow(M2);
   11521             :     else
   11522             :     {
   11523           0 :       GEN tr = Qab_trace_init(o2, o1, mfcharpol(CHI2), mfcharpol(CHI1));
   11524           0 :       M2 = QabM_tracerel(tr, 0, M2);
   11525             :     }
   11526             :   }
   11527             :   /* now everything is defined mod T = mfcharpol(CHI1) */
   11528         259 :   M2i = QabM_pseudoinv_i(M2, T, o1, &v, &den);
   11529         259 :   M = RgM_mul(M2i, rowpermute(M1, gel(v,1)));
   11530         259 :   M = RgM_mul(M2, M);
   11531         259 :   M1 = RgM_Rg_mul(M1, den);
   11532         259 :   M = RgM_sub(M1, M); if (T) M = RgXQM_red(M, T);
   11533         259 :   return vecmflineardiv0(B1, QabM_ker(M, T, o1), Th);
   11534             : }
   11535             : 
   11536             : /*******************************************************************/
   11537             : /*                         Integration                             */
   11538             : /*******************************************************************/
   11539             : static GEN
   11540         420 : vanembed(GEN F, GEN v, long prec)
   11541             : {
   11542         420 :   GEN CHI = mf_get_CHI(F);
   11543         420 :   long o = mfcharorder(CHI);
   11544         420 :   if (o > 2 || degpol(mf_get_field(F)) > 1) v = liftpol_shallow(v);
   11545         420 :   if (o > 2) v = gsubst(v, varn(mfcharpol(CHI)), rootsof1u_cx(o, prec));
   11546         420 :   return v;
   11547             : }
   11548             : 
   11549             : static long
   11550        1085 : mfperiod_prelim_double(double t0, long k, long bitprec)
   11551             : {
   11552        1085 :   double nlim, c = 2*M_PI*t0;
   11553        1085 :   nlim = ceil(bitprec * M_LN2 / c);
   11554        1085 :   c -= (k - 1)/(2*nlim); if (c < 1) c = 1.;
   11555        1085 :   nlim += ceil((0.7 + (k-1)/2*log(nlim))/c);
   11556        1085 :   return (long)nlim;
   11557             : }
   11558             : static long
   11559         266 : mfperiod_prelim(GEN t0, long k, long bitprec)
   11560         266 : { return mfperiod_prelim_double(gtodouble(t0), k, bitprec); }
   11561             : 
   11562             : /* (-X)^(k-2) * P(-1/X) = (-1)^{k-2} P|_{k-2} S */
   11563             : static GEN
   11564        1281 : RgX_act_S(GEN P, long k)
   11565             : {
   11566        1281 :   P = RgX_unscale(RgX_recipspec_shallow(P+2, lgpol(P), k-1), gen_m1);
   11567        1281 :   setvarn(P,0); return P;
   11568             : }
   11569             : static int
   11570        2562 : RgX_act_typ(GEN P, long k)
   11571             : {
   11572        2562 :   switch(typ(P))
   11573             :   {
   11574          35 :     case t_RFRAC: return t_RFRAC;
   11575        2527 :     case t_POL:
   11576        2527 :       if (varn(P) == 0)
   11577             :       {
   11578        2527 :         long d = degpol(P);
   11579        2527 :         if (d > k-2) return t_RFRAC;
   11580        2380 :         if (d) return t_POL;
   11581             :       }
   11582             :   }
   11583         945 :   return 0;
   11584             : }
   11585             : static GEN
   11586        2310 : act_S(GEN P, long k)
   11587             : {
   11588             :   GEN X;
   11589        2310 :   switch(RgX_act_typ(P, k))
   11590             :   {
   11591         133 :     case t_RFRAC:
   11592         133 :       X = gneg(pol_x(0));
   11593         133 :       return gmul(gsubst(P, 0, ginv(X)), gpowgs(X, k - 2));
   11594        1281 :     case t_POL: return RgX_act_S(P, k);
   11595             :   }
   11596         896 :   return P;
   11597             : }
   11598             : 
   11599             : static GEN
   11600         203 : AX_B(GEN M)
   11601         203 : { GEN A = gcoeff(M,1,1), B = gcoeff(M,1,2); return deg1pol_shallow(A,B,0); }
   11602             : static GEN
   11603         203 : CX_D(GEN M)
   11604         203 : { GEN C = gcoeff(M,2,1), D = gcoeff(M,2,2); return deg1pol_shallow(C,D,0); }
   11605             : 
   11606             : /* P|_{2-k}M = (CX+D)^{k-2}P((AX+B)/(CX+D)) */
   11607             : static GEN
   11608         154 : RgX_act_gen(GEN P, GEN M, long k)
   11609             : {
   11610         154 :   GEN S = gen_0, PCD, PAB;
   11611             :   long i;
   11612         154 :   PCD = gpowers(CX_D(M), k-2);
   11613         154 :   PAB = gpowers(AX_B(M), k-2);
   11614         833 :   for (i = 0; i <= k-2; i++)
   11615             :   {
   11616         679 :     GEN t = RgX_coeff(P, i);
   11617         679 :     if (!gequal0(t)) S = gadd(S, gmul(t, gmul(gel(PCD, k-i-1), gel(PAB, i+1))));
   11618             :   }
   11619         154 :   return S;
   11620             : }
   11621             : static GEN
   11622         252 : act_GL2(GEN P, GEN M, long k)
   11623             : {
   11624         252 :   switch(RgX_act_typ(P, k))
   11625             :   {
   11626          49 :     case t_RFRAC:
   11627             :     {
   11628          49 :       GEN AB = AX_B(M), CD = CX_D(M);
   11629          49 :       return gmul(gsubst(P, 0, gdiv(AB, CD)), gpowgs(CD, k - 2));
   11630             :     }
   11631         154 :     case t_POL: return RgX_act_gen(P, M, k);
   11632             :   }
   11633          49 :   return P;
   11634             : }
   11635             : static GEN
   11636           7 : vecact_GL2(GEN x, GEN M, long k)
   11637          21 : { pari_APPLY_same(act_GL2(gel(x,i), M, k)); }
   11638             : 
   11639             : static GEN
   11640        2590 : normalizeapprox(GEN R, long bit)
   11641             : {
   11642        2590 :   GEN X = gen_1, Q;
   11643             :   long i, l;
   11644        2590 :   if (is_vec_t(typ(R)))
   11645             :   {
   11646          28 :     Q = cgetg_copy(R, &l);
   11647          84 :     for (i = 1; i < l; i++)
   11648             :     {
   11649          56 :       pari_sp av = avma;
   11650          56 :       gel(Q,i) = gerepileupto(av, normalizeapprox(gel(R,i), bit));
   11651             :     }
   11652          28 :     return Q;
   11653             :   }
   11654        2562 :   if (typ(R) == t_RFRAC && varn(gel(R,2)) == 0) { X = gel(R,2); R = gel(R,1); }
   11655        2562 :   if (typ(R) != t_POL || varn(R) != 0) return gdiv(R, X);
   11656        2555 :   Q = cgetg_copy(R, &l); Q[1] = R[1];
   11657        9961 :   for (i = 2; i < l; ++i) gel(Q,i) = Rg_approx(gel(R,i),bit);
   11658        2555 :   Q = normalizepol_lg(Q,l); return gdiv(Q, X);
   11659             : }
   11660             : 
   11661             : /* make sure T is a t_POL in variable 0 */
   11662             : static GEN
   11663        2562 : toRgX0(GEN T)
   11664        2562 : { return typ(T) == t_POL && varn(T) == 0? T: scalarpol_shallow(T,0); }
   11665             : 
   11666             : /* integrate by summing  nlim+1 terms of van [may be < lg(van)]
   11667             :  * van can be an expansion with vector coefficients
   11668             :  * \int_A^oo \sum_n van[n] * q^(n/w + al) * P(z-A) dz, q = e(z) */
   11669             : static GEN
   11670         861 : intAoo(GEN van, long nlim, GEN al, long w, GEN P, GEN A, long k, long prec)
   11671             : {
   11672             :   GEN alw, P1, piI2A, q, S, van0;
   11673         861 :   long n, vz = varn(gel(P,2));
   11674             : 
   11675         861 :   if (nlim < 1) nlim = 1;
   11676         861 :   alw = gmulsg(w, al);
   11677         861 :   P1 = RgX_translate(P, gneg(A));
   11678         861 :   piI2A = gmul(PiI2n(1, prec), A);
   11679         861 :   q = gexp(gdivgu(piI2A, w), prec);
   11680         861 :   S = gen_0;
   11681      113631 :   for (n = nlim; n >= 1; n--)
   11682             :   {
   11683      112770 :     GEN t = gsubst(P1, vz, gdivsg(w, gaddsg(n, alw)));
   11684      112770 :     S = gadd(gmul(gel(van, n+1), t), gmul(q, S));
   11685             :   }
   11686         861 :   S = gmul(q, S);
   11687         861 :   van0 = gel(van, 1);
   11688         861 :   if (!gequal0(al))
   11689             :   {
   11690          42 :     S = gadd(S, gmul(gsubst(P1, vz, ginv(al)), van0));
   11691          42 :     S = gmul(S, gexp(gmul(piI2A, al), prec));
   11692             :   }
   11693         819 :   else if (!gequal0(van0))
   11694         210 :     S = gsub(S, gdivgu(gmul(van0, gpowgs(gsub(pol_x(0), A), k-1)), k-1));
   11695         861 :   if (is_vec_t(typ(S)))
   11696             :   {
   11697         588 :     long j, l = lg(S);
   11698        2877 :     for (j = 1; j < l; j++) gel(S,j) = toRgX0(gel(S,j));
   11699             :   }
   11700             :   else
   11701         273 :     S = toRgX0(S);
   11702         861 :   return gneg(S);
   11703             : }
   11704             : 
   11705             : /* \sum_{j <= k} X^j * (Y / (2I\pi))^{k+1-j} k! / j! */
   11706             : static GEN
   11707         217 : get_P(long k, long v, long prec)
   11708             : {
   11709         217 :   GEN a, S = cgetg(k + 1, t_POL), u = invr(Pi2n(1, prec+EXTRAPREC64));
   11710         217 :   long j, K = k-2;
   11711         217 :   S[1] = evalsigne(1)|evalvarn(0); a = u;
   11712         217 :   gel(S,K+2) = monomial(mulcxpowIs(a,3), 1, v); /* j = K */
   11713         924 :   for(j = K-1; j >= 0; j--)
   11714             :   {
   11715         707 :     a = mulrr(mulru(a,j+1), u);
   11716         707 :     gel(S,j+2) = monomial(mulcxpowIs(a,3*(K+1-j)), K+1-j, v);
   11717             :   }
   11718         217 :   return S;
   11719             : }
   11720             : 
   11721             : static GEN
   11722        2289 : getw1w2(long N, GEN ga)
   11723        2289 : { return mkvecsmall2(mfZC_width(N, gel(ga,1)),
   11724        2289 :                      mfZC_width(N, gel(ga,2))); }
   11725             : 
   11726             : static GEN
   11727         126 : intAoowithvanall(GEN mf, GEN vanall, GEN P, GEN cosets, long bitprec)
   11728             : {
   11729         126 :   GEN vvan = gel(vanall,1), vaw = gel(vanall,2), W1W2, resall;
   11730         126 :   long prec = nbits2prec(bitprec), N, k, lco, j;
   11731             : 
   11732         126 :   N = MF_get_N(mf); k = MF_get_k(mf);
   11733         126 :   lco = lg(cosets);
   11734         126 :   W1W2 = cgetg(lco, t_VEC); resall = cgetg(lco, t_VEC);
   11735        2415 :   for (j = 1; j < lco; j++) gel(W1W2,j) = getw1w2(N, gel(cosets, j));
   11736        2415 :   for (j = 1; j < lco; j++)
   11737             :   {
   11738        2289 :     GEN w1w2j = gel(W1W2,j), alj, M, VAN, RES, AR, Q;
   11739             :     long jq, c, w1, w2, w;
   11740        2289 :     if (!w1w2j) continue;
   11741         588 :     alj = gel(vaw,j);
   11742         588 :     w1 = w1w2j[1]; Q = cgetg(lco, t_VECSMALL);
   11743         588 :     w2 = w1w2j[2]; M = cgetg(lco, t_COL);
   11744        7392 :     for (c = 1, jq = j; jq < lco; jq++)
   11745             :     {
   11746        6804 :       GEN W = gel(W1W2, jq);
   11747        6804 :       if (jq == j || (W && gequal(W, w1w2j) && gequal(gel(vaw, jq), alj)))
   11748             :       {
   11749        2289 :         Q[c] = jq; gel(W1W2, jq) = NULL;
   11750        2289 :         gel(M, c) = gel(vvan, jq); c++;
   11751             :       }
   11752             :     }
   11753         588 :     setlg(M,c); VAN = shallowmatconcat(M);
   11754         588 :     AR = mkcomplex(gen_0, sqrtr_abs(divru(utor(w1, prec+EXTRAPREC64), w2)));
   11755         588 :     w = itos(gel(alj,2));
   11756         588 :     RES = intAoo(VAN, lg(VAN)-2, gel(alj,1),w, P, AR, k, prec);
   11757        2877 :     for (jq = 1; jq < c; jq++) gel(resall, Q[jq]) = gel(RES, jq);
   11758             :   }
   11759         126 :   return resall;
   11760             : }
   11761             : 
   11762             : GEN
   11763         511 : mftobasisES(GEN mf, GEN F)
   11764             : {
   11765         511 :   GEN v = mftobasis(mf, F, 0);
   11766         504 :   long nE = lg(MF_get_E(mf))-1;
   11767         504 :   return mkvec2(vecslice(v,1,nE), vecslice(v,nE+1,lg(v)-1));
   11768             : }
   11769             : 
   11770             : static long
   11771           0 : wt1mulcond(GEN F, long D, long space)
   11772             : {
   11773           0 :   GEN E = mfeisenstein_i(1, mfchartrivial(), get_mfchar(stoi(D))), mf;
   11774           0 :   F = mfmul(F, E);
   11775           0 :   mf = mfinit_Nkchi(mf_get_N(F), mf_get_k(F), mf_get_CHI(F), space, 0);
   11776           0 :   return mfconductor(mf, F);
   11777             : }
   11778             : static int
   11779           7 : wt1newlevel(long N)
   11780             : {
   11781           7 :   GEN P = gel(myfactoru(N),1);
   11782           7 :   long l = lg(P), i;
   11783          14 :   for (i = 1; i < l; i++)
   11784           7 :     if (!wt1empty(N/P[i])) return 0;
   11785           7 :   return 1;
   11786             : }
   11787             : long
   11788         175 : mfconductor(GEN mf, GEN F)
   11789             : {
   11790         175 :   pari_sp av = avma;
   11791             :   GEN gk;
   11792             :   long space, N, M;
   11793             : 
   11794         175 :   mf = checkMF(mf);
   11795         175 :   if (!checkmf_i(F)) pari_err_TYPE("mfconductor",F);
   11796         175 :   if (mfistrivial(F)) return 1;
   11797         175 :   space = MF_get_space(mf);
   11798         175 :   if (space == mf_NEW) return mf_get_N(F);
   11799         175 :   gk = MF_get_gk(mf);
   11800         175 :   if (isint1(gk))
   11801             :   {
   11802           7 :     N = mf_get_N(F);
   11803           7 :     if (!wt1newlevel(N))
   11804             :     {
   11805           0 :       long s = space_is_cusp(space)? mf_CUSP: mf_FULL;
   11806           0 :       N = ugcd(N, wt1mulcond(F,-3,s));
   11807           0 :       if (!wt1newlevel(N)) N = ugcd(N, wt1mulcond(F,-4,s));
   11808             :     }
   11809           7 :     return gc_long(av,N);
   11810             :   }
   11811         168 :   if (typ(gk) != t_INT)
   11812             :   {
   11813          42 :     F = mfmultheta(F);
   11814          42 :     mf = obj_checkbuild(mf, MF_MF2INIT, &mf2init); /* mf_FULL */
   11815             :   }
   11816         168 :   N = 1;
   11817         168 :   if (space_is_cusp(space))
   11818             :   {
   11819           7 :     F = mftobasis_i(mf, F);
   11820           7 :     if (typ(gk) != t_INT) F = vecslice(F, lg(MF_get_E(mf)), lg(F) - 1);
   11821             :   }
   11822             :   else
   11823             :   {
   11824         161 :     GEN EF = mftobasisES(mf, F), vE = gel(EF,1), B = MF_get_E(mf);
   11825         161 :     long i, l = lg(B);
   11826        1267 :     for (i = 1; i < l; i++)
   11827        1106 :       if (!gequal0(gel(vE,i))) N = ulcm(N, mf_get_N(gel(B, i)));
   11828         161 :     F = gel(EF,2);
   11829             :   }
   11830         168 :   (void)mftonew_i(mf, F, &M); /* M = conductor of cuspidal part */
   11831         168 :   return gc_long(av, ulcm(M, N));
   11832             : }
   11833             : 
   11834             : static GEN
   11835        1288 : fs_get_MF(GEN fs) { return gel(fs,1); }
   11836             : static GEN
   11837         777 : fs_get_vES(GEN fs) { return gel(fs,2); }
   11838             : static GEN
   11839        1463 : fs_get_pols(GEN fs) { return gel(fs,3); }
   11840             : static GEN
   11841        1974 : fs_get_cosets(GEN fs) { return gel(fs,4); }
   11842             : static long
   11843         574 : fs_get_bitprec(GEN fs) { return itou(gel(fs,5)); }
   11844             : static GEN
   11845        1134 : fs_get_vE(GEN fs) { return gel(fs,6); }
   11846             : static GEN
   11847          56 : fs_get_EF(GEN fs) { return gel(fs,7); }
   11848             : static GEN
   11849        1694 : fs_get_expan(GEN fs) { return gel(fs,8); }
   11850             : static GEN
   11851          14 : fs_set_expan(GEN fs, GEN vanall)
   11852          14 : { GEN f = shallowcopy(fs); gel(f,8) = vanall; return f; }
   11853             : static int
   11854          42 : mfs_checkmf(GEN fs, GEN mf)
   11855          42 : { GEN mfF = fs_get_MF(fs); return gequal(gel(mfF,1), gel(mf,1)); }
   11856             : static long
   11857         721 : checkfs_i(GEN v)
   11858         721 : { return typ(v) == t_VEC && lg(v) == 9 && checkMF_i(fs_get_MF(v))
   11859         511 :     && typ(fs_get_vES(v)) == t_VEC
   11860         511 :     && typ(fs_get_pols(v)) == t_VEC
   11861         511 :     && typ(fs_get_cosets(v)) == t_VEC
   11862         511 :     && typ(fs_get_vE(v)) == t_VEC
   11863         511 :     && lg(fs_get_pols(v)) == lg(fs_get_cosets(v))
   11864         511 :     && typ(fs_get_expan(v)) == t_VEC
   11865         511 :     && lg(fs_get_expan(v)) == 3
   11866         511 :     && lg(gel(fs_get_expan(v), 1)) == lg(fs_get_cosets(v))
   11867        1442 :     && typ(gel(v,5)) == t_INT; }
   11868             : GEN
   11869       18564 : checkMF_i(GEN mf)
   11870             : {
   11871       18564 :   long l = lg(mf);
   11872             :   GEN v;
   11873       18564 :   if (typ(mf) != t_VEC) return NULL;
   11874       18536 :   if (l == 9) return checkMF_i(fs_get_MF(mf));
   11875       18536 :   if (l != 7) return NULL;
   11876        7364 :   v = gel(mf,1);
   11877        7364 :   if (typ(v) != t_VEC || lg(v) != 5) return NULL;
   11878        7364 :   return (typ(gel(v,1)) == t_INT
   11879        7364 :          && typ(gmul2n(gel(v,2), 1)) == t_INT
   11880        7364 :          && typ(gel(v,3)) == t_VEC
   11881       14728 :          && typ(gel(v,4)) == t_INT)? mf: NULL; }
   11882             : GEN
   11883        3801 : checkMF(GEN T)
   11884             : {
   11885        3801 :   GEN mf = checkMF_i(T);
   11886        3801 :   if (!mf) pari_err_TYPE("checkMF [please use mfinit]", T);
   11887        3801 :   return mf;
   11888             : }
   11889             : 
   11890             : /* c,d >= 0; c * Nc = N, find coset whose image in P1(Z/NZ) ~ (c, d + k(N/c)) */
   11891             : static GEN
   11892       11298 : coset_complete(long c, long d, long Nc)
   11893             : {
   11894             :   long a, b;
   11895       12607 :   while (ugcd(c, d) > 1) d += Nc;
   11896       11298 :   (void)cbezout(c, d, &b, &a);
   11897       11298 :   return mkmat22s(a, -b, c, d);
   11898             : }
   11899             : /* right cosets of $\G_0(N)$: $\G=\bigsqcup_j \G_0(N)\ga_j$. */
   11900             : /* We choose them with c\mid N and d mod N/c, not the reverse */
   11901             : GEN
   11902         147 : mfcosets(GEN gN)
   11903             : {
   11904         147 :   pari_sp av = avma;
   11905             :   GEN V, D, mf;
   11906         147 :   long l, i, ct, N = 0;
   11907         147 :   if (typ(gN) == t_INT) N = itos(gN);
   11908          14 :   else if ((mf = checkMF_i(gN))) N = MF_get_N(mf);
   11909           7 :   else pari_err_TYPE("mfcosets", gN);
   11910         140 :   if (N <= 0) pari_err_DOMAIN("mfcosets", "N", "<=", gen_0, stoi(N));
   11911         140 :   V = cgetg(mypsiu(N) + 1, t_VEC);
   11912         140 :   D = mydivisorsu(N); l = lg(D);
   11913         525 :   for (i = ct = 1; i < l; i++)
   11914             :   {
   11915         385 :     long d, c = D[i], Nc = D[l-i], e = ugcd(Nc, c);
   11916        2996 :     for (d = 0; d < Nc; d++)
   11917        2611 :       if (ugcd(d,e) == 1) gel(V, ct++) = coset_complete(c, d, Nc);
   11918             :   }
   11919         140 :   return gerepilecopy(av, V);
   11920             : }
   11921             : static int
   11922       33775 : cmp_coset(void *E, GEN A, GEN B)
   11923             : {
   11924       33775 :   ulong N = (ulong)E, Nc, c = itou(gcoeff(A,2,1));
   11925       33775 :   int r = cmpuu(c, itou(gcoeff(B,2,1)));
   11926       33775 :   if (r) return r;
   11927       29302 :   Nc = N / c;
   11928       29302 :   return cmpuu(umodiu(gcoeff(A,2,2), Nc), umodiu(gcoeff(B,2,2), Nc));
   11929             : }
   11930             : /* M in SL_2(Z) */
   11931             : static long
   11932        8799 : mftocoset_i(ulong N, GEN M, GEN cosets)
   11933             : {
   11934        8799 :   pari_sp av = avma;
   11935        8799 :   long A = itos(gcoeff(M,1,1)), c, u, v, Nc, i;
   11936        8799 :   long C = itos(gcoeff(M,2,1)), D = itos(gcoeff(M,2,2));
   11937             :   GEN ga;
   11938        8799 :   c = cbezout(N*A, C, &u, &v); Nc = N/c;
   11939        8799 :   ga = coset_complete(c, umodsu(v*D, Nc), Nc);
   11940        8799 :   i = gen_search(cosets, ga, (void*)N, &cmp_coset);
   11941        8799 :   if (i < 0) pari_err_BUG("mftocoset [no coset found]");
   11942        8799 :   return gc_long(av,i);
   11943             : }
   11944             : /* (U * V^(-1))[2,2] mod N, assuming V in SL2(Z) */
   11945             : static long
   11946        8785 : SL2_div_D(ulong N, GEN U, GEN V)
   11947             : {
   11948        8785 :   long c = umodiu(gcoeff(U,2,1), N), d = umodiu(gcoeff(U,2,2), N);
   11949        8785 :   long a2 = umodiu(gcoeff(V,1,1), N), b2 = umodiu(gcoeff(V,1,2), N);
   11950        8785 :   return (a2*d - b2*c) % (long)N;
   11951             : }
   11952             : static long
   11953        8785 : mftocoset_iD(ulong N, GEN M, GEN cosets, long *D)
   11954             : {
   11955        8785 :   long i = mftocoset_i(N, M, cosets);
   11956        8785 :   *D = SL2_div_D(N, M, gel(cosets,i)); return i;
   11957             : }
   11958             : GEN
   11959           7 : mftocoset(ulong N, GEN M, GEN cosets)
   11960             : {
   11961             :   long i;
   11962           7 :   if (!check_SL2Z(M)) pari_err_TYPE("mftocoset",M);
   11963           7 :   i = mftocoset_i(N, M, cosets);
   11964           7 :   retmkvec2(gdiv(M,gel(cosets,i)), utoipos(i));
   11965             : }
   11966             : 
   11967             : static long
   11968        2289 : getnlim2(long N, long w1, long w2, long nlim, long k, long bitprec)
   11969             : {
   11970        2289 :   if (w2 == N) return nlim;
   11971         420 :   return mfperiod_prelim_double(1./sqrt((double)w1*w2), k, bitprec + 32);
   11972             : }
   11973             : 
   11974             : /* g * S, g 2x2 */
   11975             : static GEN
   11976        1190 : ZM_mulS(GEN g)
   11977        1190 : { return mkmat2(gel(g,2), ZC_neg(gel(g,1))); }
   11978             : /* g * T, g 2x2 */
   11979             : static GEN
   11980        4424 : ZM_mulT(GEN g)
   11981        4424 : { return mkmat2(gel(g,1), ZC_add(gel(g,2), gel(g,1))); }
   11982             : /* g * T^(-1), g 2x2 */
   11983             : static GEN
   11984        2352 : ZM_mulTi(GEN g)
   11985        2352 : { return mkmat2(gel(g,1), ZC_sub(gel(g,2), gel(g,1))); }
   11986             : 
   11987             : /* Compute all slashexpansions for all cosets */
   11988             : static GEN
   11989         140 : mfgaexpansionall(GEN mf, GEN FE, GEN cosets, double height, long prec)
   11990             : {
   11991         140 :   GEN CHI = MF_get_CHI(mf), vres, vresaw;
   11992         140 :   long lco, j, k = MF_get_k(mf), N = MF_get_N(mf), bitprec = prec2nbits(prec);
   11993             : 
   11994         140 :   lco = lg(cosets);
   11995         140 :   vres = const_vec(lco-1, NULL);
   11996         140 :   vresaw = cgetg(lco, t_VEC);
   11997        2597 :   for (j = 1; j < lco; j++) if (!gel(vres,j))
   11998             :   {
   11999         385 :     GEN ga = gel(cosets, j), van, aw, al, z, gai;
   12000         385 :     long w1 = mfZC_width(N, gel(ga,1));
   12001         385 :     long w2 = mfZC_width(N, gel(ga,2));
   12002             :     long nlim, nlim2, daw, da, na, i;
   12003         385 :     double sqNinvdbl = height ? height/w1 : 1./sqrt((double)w1*N);
   12004         385 :     nlim = mfperiod_prelim_double(sqNinvdbl, k, bitprec + 32);
   12005         385 :     van = mfslashexpansion(mf, FE, ga, nlim, 0, &aw, prec + EXTRAPREC64);
   12006         385 :     van = vanembed(gel(FE, 1), van, prec + EXTRAPREC64);
   12007         385 :     al = gel(aw, 1);
   12008         385 :     nlim2 = height? nlim: getnlim2(N, w1, w2, nlim, k, bitprec);
   12009         385 :     gel(vres, j) = vecslice(van, 1, nlim2 + 1);
   12010         385 :     gel(vresaw, j) = aw;
   12011         385 :     Qtoss(al, &na, &da); daw = da*w1;
   12012         385 :     z = rootsof1powinit(1, daw, prec + EXTRAPREC64);
   12013         385 :     gai = ga;
   12014        2457 :     for (i = 1; i < w1; i++)
   12015             :     {
   12016             :       GEN V, coe;
   12017        2072 :       long Di, n, ind, w2, s = ((i*na) % da) * w1, t = i*da;
   12018        2072 :       gai = ZM_mulT(gai);
   12019        2072 :       ind = mftocoset_iD(N, gai, cosets, &Di);
   12020        2072 :       w2 = mfZC_width(N, gel(gel(cosets,ind), 2));
   12021        2072 :       nlim2 = height? nlim: getnlim2(N, w1, w2, nlim, k, bitprec);
   12022        2072 :       gel(vresaw, ind) = aw;
   12023        2072 :       V = cgetg(nlim2 + 2, t_VEC);
   12024      835884 :       for (n = 0; n <= nlim2; n++, s = Fl_add(s, t, daw))
   12025      833812 :         gel(V, n+1) = gmul(gel(van, n+1), rootsof1pow(z, s));
   12026        2072 :       coe = mfcharcxeval(CHI, Di, prec + EXTRAPREC64);
   12027        2072 :       if (!gequal1(coe)) V = RgV_Rg_mul(V, conj_i(coe));
   12028        2072 :       gel(vres, ind) = V;
   12029             :     }
   12030             :   }
   12031         140 :   return mkvec2(vres, vresaw);
   12032             : }
   12033             : 
   12034             : /* Compute all period pols of F|_k\ga_j, vF = mftobasis(F_S) */
   12035             : static GEN
   12036         147 : mfperiodpols_i(GEN mf, GEN FE, GEN cosets, GEN *pvan, long bit)
   12037             : {
   12038         147 :   long N, i, prec = nbits2prec(bit), k = MF_get_k(mf);
   12039         147 :   GEN vP, P, CHI, intall = gen_0;
   12040             : 
   12041         147 :   *pvan = gen_0;
   12042         147 :   if (k == 0 && gequal0(gel(FE,2)))
   12043           0 :     return cosets? const_vec(lg(cosets)-1, pol_0(0)): pol_0(0);
   12044         147 :   N = MF_get_N(mf);
   12045         147 :   CHI = MF_get_CHI(mf);
   12046         147 :   P = get_P(k, fetch_var(), prec);
   12047         147 :   if (!cosets)
   12048             :   { /* ga = id */
   12049          21 :     long nlim, PREC = prec + EXTRAPREC64;
   12050          21 :     GEN F = gel(FE,1), sqNinv = invr(sqrtr_abs(utor(N, PREC))); /* A/w */
   12051             :     GEN AR, v, van, T1, T2;
   12052             : 
   12053          21 :     nlim = mfperiod_prelim(sqNinv, k, bit + 32);
   12054             :     /* F|id: al = 0, w = 1 */
   12055          21 :     v = mfcoefs_i(F, nlim, 1);
   12056          21 :     van = vanembed(F, v, PREC);
   12057          21 :     AR = mkcomplex(gen_0, sqNinv);
   12058          21 :     T1 = intAoo(van, nlim, gen_0,1, P, AR, k, prec);
   12059          21 :     if (N == 1) T2 = T1;
   12060             :     else
   12061             :     { /* F|S: al = 0, w = N */
   12062           7 :       v = mfgaexpansion(mf, FE, mkS(), nlim, PREC);
   12063           7 :       van = vanembed(F, gel(v,3), PREC);
   12064           7 :       AR = mkcomplex(gen_0, mulur(N,sqNinv));
   12065           7 :       T2 = intAoo(van, nlim, gen_0,N, P, AR, k, prec);
   12066             :     }
   12067          21 :     T1 = gsub(T1, act_S(T2, k));
   12068          21 :     T1 = normalizeapprox(T1, bit-20);
   12069          21 :     vP = gprec_wtrunc(T1, prec);
   12070             :   }
   12071             :   else
   12072             :   {
   12073         126 :     long lco = lg(cosets);
   12074         126 :     GEN vanall = mfgaexpansionall(mf, FE, cosets, 0, prec);
   12075         126 :     *pvan = vanall;
   12076         126 :     intall = intAoowithvanall(mf, vanall, P, cosets, bit);
   12077         126 :     vP = const_vec(lco-1, NULL);
   12078        2415 :     for (i = 1; i < lco; i++)
   12079             :     {
   12080        2289 :       GEN P, P1, P2, c, ga = gel(cosets, i);
   12081             :       long iS, DS;
   12082        2366 :       if (gel(vP,i)) continue;
   12083        1183 :       P1 = gel(intall, i);
   12084        1183 :       iS = mftocoset_iD(N, ZM_mulS(ga), cosets, &DS);
   12085        1183 :       c = mfcharcxeval(CHI, DS, prec + EXTRAPREC64);
   12086        1183 :       P2 = gel(intall, iS);
   12087             : 
   12088        1183 :       P = act_S(isint1(c)? P2: gmul(c, P2), k);
   12089        1183 :       P = normalizeapprox(gsub(P1, P), bit-20);
   12090        1183 :       gel(vP,i) = gprec_wtrunc(P, prec);
   12091        1183 :       if (iS == i) continue;
   12092             : 
   12093        1106 :       P = act_S(isint1(c)? P1: gmul(conj_i(c), P1), k);
   12094        1106 :       if (!odd(k)) P = gneg(P);
   12095        1106 :       P = normalizeapprox(gadd(P, P2), bit-20);
   12096        1106 :       gel(vP,iS) = gprec_wtrunc(P, prec);
   12097             :     }
   12098             :   }
   12099         147 :   delete_var(); return vP;
   12100             : }
   12101             : 
   12102             : /* when cosets = NULL, return a "fake" symbol containing only fs(oo->0) */
   12103             : static GEN
   12104         147 : mfsymbol_i(GEN mf, GEN F, GEN cosets, long bit)
   12105             : {
   12106         147 :   GEN FE, van, vP, vE, Mvecj, vES = mftobasisES(mf,F);
   12107         147 :   long precnew, prec = nbits2prec(bit), k = MF_get_k(mf);
   12108         147 :   vE = mfgetembed(F, prec);
   12109         147 :   Mvecj = obj_checkbuild(mf, MF_EISENSPACE, &mfeisensteinspaceinit);
   12110         147 :   if (lg(Mvecj) >= 5) precnew = prec;
   12111             :   else
   12112             :   {
   12113          14 :     long N = MF_get_N(mf), n = mfperiod_prelim_double(1/(double)N, k, bit + 32);
   12114          14 :     precnew = prec + inveis_extraprec(N, mkS(), Mvecj, n);
   12115             :   }
   12116         147 :   FE = mkcol2(F, mf_eisendec(mf,F,precnew));
   12117         147 :   vP = mfperiodpols_i(mf, FE, cosets, &van, bit);
   12118         147 :   return mkvecn(8, mf, vES, vP, cosets, utoi(bit), vE, FE, van);
   12119             : }
   12120             : 
   12121             : static GEN
   12122          56 : fs2_get_cusps(GEN f) { return gel(f,3); }
   12123             : static GEN
   12124          56 : fs2_get_MF(GEN f) { return gel(f,1); }
   12125             : static GEN
   12126          56 : fs2_get_W(GEN f) { return gel(f,2); }
   12127             : static GEN
   12128          56 : fs2_get_F(GEN f) { return gel(f,4); }
   12129             : static long
   12130           0 : fs2_get_bitprec(GEN f) { return itou(gel(f,5)); }
   12131             : static GEN
   12132          56 : fs2_get_al0(GEN f) { return gel(f,6); }
   12133             : static GEN
   12134          21 : fs2_get_den(GEN f) { return gel(f,7); }
   12135             : static int
   12136         189 : checkfs2_i(GEN f)
   12137             : {
   12138             :   GEN W, C, F, al0;
   12139             :   long l;
   12140         189 :   if (typ(f) != t_VEC || lg(f) != 8 || typ(gel(f,5)) != t_INT) return 0;
   12141          35 :   C = fs2_get_cusps(f); l = lg(C);
   12142          35 :   W = fs2_get_W(f);
   12143          35 :   F = fs2_get_F(f);
   12144          35 :   al0 = fs2_get_al0(f);
   12145          35 :   return checkMF_i(fs2_get_MF(f))
   12146          35 :       && typ(W) == t_VEC && typ(F) == t_VEC && typ(al0) == t_VECSMALL
   12147          70 :       && lg(W) == l && lg(F) == l && lg(al0) == l;
   12148             : }
   12149             : static GEN fs2_init(GEN mf, GEN F, long bit);
   12150             : GEN
   12151         154 : mfsymbol(GEN mf, GEN F, long bit)
   12152             : {
   12153         154 :   pari_sp av = avma;
   12154         154 :   GEN cosets = NULL;
   12155         154 :   if (!F)
   12156             :   {
   12157          21 :     F = mf;
   12158          21 :     if (!checkmf_i(F)) pari_err_TYPE("mfsymbol", F);
   12159          21 :     mf = mfinit_i(F, mf_FULL);
   12160             :   }
   12161         133 :   else if (!checkmf_i(F)) pari_err_TYPE("mfsymbol", F);
   12162         154 :   if (checkfs2_i(mf)) return fs2_init(mf, F, bit);
   12163         154 :   if (checkfs_i(mf))
   12164             :   {
   12165           0 :     cosets = fs_get_cosets(mf);
   12166           0 :     mf = fs_get_MF(mf);
   12167             :   }
   12168         154 :   else if (checkMF_i(mf))
   12169             :   {
   12170         154 :     GEN gk = MF_get_gk(mf);
   12171         154 :     if (typ(gk) != t_INT || equali1(gk)) return fs2_init(mf, F, bit);
   12172         133 :     if (signe(gk) <= 0) pari_err_TYPE("mfsymbol [k <= 0]", mf);
   12173         126 :     cosets = mfcosets(MF_get_gN(mf));
   12174             :   }
   12175           0 :   else pari_err_TYPE("mfsymbol",mf);
   12176         126 :   return gerepilecopy(av, mfsymbol_i(mf, F, cosets, bit));
   12177             : }
   12178             : 
   12179             : static GEN
   12180          14 : RgX_by_parity(GEN P, long odd)
   12181             : {
   12182          14 :   long i, l = lg(P);
   12183             :   GEN Q;
   12184          14 :   if (l < 4) return odd ? pol_x(0): P;
   12185          14 :   Q = cgetg(l, t_POL); Q[1] = P[1];
   12186          91 :   for (i = odd? 2: 3; i < l; i += 2) gel(Q,i) = gen_0;
   12187          91 :   for (i = odd? 3: 2; i < l; i += 2) gel(Q,i) = gel(P,i);
   12188          14 :   return normalizepol_lg(Q, l);
   12189             : }
   12190             : /* flag 0: period polynomial of F, >0 or <0 with corresponding parity */
   12191             : GEN
   12192          35 : mfperiodpol(GEN mf0, GEN F, long flag, long bit)
   12193             : {
   12194          35 :   pari_sp av = avma;
   12195          35 :   GEN pol, mf = checkMF_i(mf0);
   12196          35 :   if (!mf) pari_err_TYPE("mfperiodpol",mf0);
   12197          35 :   if (checkfs_i(F))
   12198             :   {
   12199          14 :     GEN mfpols = fs_get_pols(F);
   12200          14 :     if (!mfs_checkmf(F, mf)) pari_err_TYPE("mfperiodpol [different mf]",F);
   12201          14 :     pol = veclast(mfpols); /* trivial coset is last */
   12202             :   }
   12203             :   else
   12204             :   {
   12205          21 :     GEN gk = MF_get_gk(mf);
   12206          21 :     if (typ(gk) != t_INT) pari_err_TYPE("mfperiodpol [half-integral k]", mf);
   12207          21 :     if (equali1(gk)) pari_err_TYPE("mfperiodpol [k = 1]", mf);
   12208          21 :     F = mfsymbol_i(mf, F, NULL, bit);
   12209          21 :     pol = fs_get_pols(F);
   12210             :   }
   12211          35 :   if (flag) pol = RgX_by_parity(pol, flag < 0);
   12212          35 :   return gerepilecopy(av, RgX_embedall(pol, fs_get_vE(F)));
   12213             : }
   12214             : 
   12215             : static int
   12216          35 : mfs_iscusp(GEN mfs) { return gequal0(gmael(mfs,2,1)); }
   12217             : /* given cusps s1 and s2 (rationals or oo)
   12218             :  * compute $\int_{s1}^{s2}(X-\tau)^{k-2}F|_k\ga_j(\tau)\,d\tau$ */
   12219             : /* If flag = 1, do not give an error message if divergent, but
   12220             :    give the rational function as result. */
   12221             : 
   12222             : static GEN
   12223         119 : col2cusp(GEN v)
   12224             : {
   12225             :   GEN A, C;
   12226         119 :   if (lg(v) != 3 || !RgV_is_ZV(v)) pari_err_TYPE("col2cusp",v);
   12227         119 :   A = gel(v,1);
   12228         119 :   C = gel(v,2);
   12229         119 :   if (gequal0(C))
   12230             :   {
   12231           0 :     if (gequal0(A)) pari_err_TYPE("mfsymboleval", mkvec2(A, C));
   12232           0 :     return mkoo();
   12233             :   }
   12234         119 :   return gdiv(A, C);
   12235             : }
   12236             : /* g.oo */
   12237             : static GEN
   12238         105 : mat2cusp(GEN g) { return col2cusp(gel(g,1)); }
   12239             : 
   12240             : static GEN
   12241           7 : pathmattovec(GEN path)
   12242           7 : { return mkvec2(col2cusp(gel(path,1)), col2cusp(gel(path,2))); }
   12243             : 
   12244             : static void
   12245         462 : get_mf_F(GEN fs, GEN *mf, GEN *F)
   12246             : {
   12247         462 :   if (lg(fs) == 3) { *mf = gel(fs,1); *F = gel(fs,2); }
   12248         462 :   else { *mf = fs_get_MF(fs); *F = NULL; }
   12249         462 : }
   12250             : static GEN
   12251         161 : mfgetvan(GEN fs, GEN ga, GEN *pal, long nlim, long prec)
   12252             : {
   12253             :   GEN van, mf, F, W;
   12254             :   long PREC;
   12255         161 :   get_mf_F(fs, &mf, &F);
   12256         161 :   if (!F)
   12257             :   {
   12258         161 :     GEN vanall = fs_get_expan(fs), cosets = fs_get_cosets(fs);
   12259         161 :     long D, jga = mftocoset_iD(MF_get_N(mf), ga, cosets, &D);
   12260         161 :     van = gmael(vanall, 1, jga);
   12261         161 :     W   = gmael(vanall, 2, jga);
   12262         161 :     if (lg(van) >= nlim + 2)
   12263             :     {
   12264         154 :       GEN z = mfcharcxeval(MF_get_CHI(mf), D, prec);
   12265         154 :       if (!gequal1(z)) van = RgV_Rg_mul(van, z);
   12266         154 :       *pal = gel(W,1); return van;
   12267             :     }
   12268           7 :     F = gel(fs_get_EF(fs), 1);
   12269             :   }
   12270           7 :   PREC = prec + EXTRAPREC64;
   12271           7 :   van = mfslashexpansion(mf, F, ga, nlim, 0, &W, PREC);
   12272           7 :   van = vanembed(F, van, PREC);
   12273           7 :   *pal = gel(W,1); return van;
   12274             : }
   12275             : /* Computation of int_A^oo (f | ga)(t)(X-t)^{k-2} dt, assuming convergence;
   12276             :  * fs is either a symbol or a triple [mf,F,bitprec]. A != oo and im(A) > 0 */
   12277             : static GEN
   12278          63 : intAoo0(GEN fs, GEN A, GEN ga, GEN P, long bit)
   12279             : {
   12280          63 :   long nlim, N, k, w, prec = nbits2prec(bit);
   12281             :   GEN van, mf, F, al;
   12282          63 :   get_mf_F(fs, &mf,&F); N = MF_get_N(mf); k = MF_get_k(mf);
   12283          63 :   w = mfZC_width(N, gel(ga,1));
   12284          63 :   nlim = mfperiod_prelim(gdivgu(imag_i(A), w), k, bit + 32);
   12285          63 :   van = mfgetvan(fs, ga, &al, nlim, prec);
   12286          63 :   return intAoo(van, nlim, al,w, P, A, k, prec);
   12287             : }
   12288             : 
   12289             : /* fs symbol, naive summation, A != oo, im(A) > 0 and B = oo or im(B) > 0 */
   12290             : static GEN
   12291          98 : mfsymboleval_direct(GEN fs, GEN path, GEN ga, GEN P)
   12292             : {
   12293          98 :   GEN A, B, van, S, al, mf = fs_get_MF(fs);
   12294          98 :   long w, nlimA, nlimB = 0, N = MF_get_N(mf), k = MF_get_k(mf);
   12295          98 :   long bit = fs_get_bitprec(fs), prec = nbits2prec(bit);
   12296             : 
   12297          98 :   A = gel(path, 1);
   12298          98 :   B = gel(path, 2); if (typ(B) == t_INFINITY) B = NULL;
   12299          98 :   w = mfZC_width(N, gel(ga,1));
   12300          98 :   nlimA = mfperiod_prelim(gdivgu(imag_i(A),w), k, bit + 32);
   12301          98 :   if (B) nlimB = mfperiod_prelim(gdivgu(imag_i(B),w), k, bit + 32);
   12302          98 :   van = mfgetvan(fs, ga, &al, maxss(nlimA,nlimB), prec);
   12303          98 :   S = intAoo(van, nlimA, al,w, P, A, k, prec);
   12304          98 :   if (B) S = gsub(S, intAoo(van, nlimB, al,w, P, B, k, prec));
   12305          98 :   return RgX_embedall(S, fs_get_vE(fs));
   12306             : }
   12307             : 
   12308             : /* Computation of int_A^oo (f | ga)(t)(X-t)^{k-2} dt, assuming convergence;
   12309             :  * fs is either a symbol or a pair [mf,F]. */
   12310             : static GEN
   12311          63 : mfsymbolevalpartial(GEN fs, GEN A, GEN ga, long bit)
   12312             : {
   12313             :   GEN Y, F, S, P, mf;
   12314          63 :   long N, k, w, prec = nbits2prec(bit);
   12315             : 
   12316          63 :   get_mf_F(fs, &mf, &F);
   12317          63 :   N = MF_get_N(mf); w = mfZC_width(N, gel(ga,1));
   12318          63 :   k = MF_get_k(mf);
   12319          63 :   Y = gdivgu(imag_i(A), w);
   12320          63 :   P = get_P(k, fetch_var(), prec);
   12321          63 :   if (lg(fs) != 3 && gtodouble(Y)*(2*N) < 1)
   12322          21 :   { /* true symbol + low imaginary part: use GL_2 action to improve */
   12323          21 :     GEN U, ga2, czd, A2 = cxredga0N(N, A, &U, &czd, 1);
   12324          21 :     GEN vE = fs_get_vE(fs);
   12325          21 :     ga2 = ZM_mul(ga, ZM_inv(U, NULL));
   12326          21 :     S = RgX_embedall(intAoo0(fs, A2, ga2, P, bit), vE);
   12327          21 :     S = gsub(S, mfsymboleval(fs, mkvec2(mat2cusp(U), mkoo()), ga2, bit));
   12328          21 :     S = typ(S) == t_VEC? vecact_GL2(S, U, k): act_GL2(S, U, k);
   12329             :   }
   12330             :   else
   12331             :   {
   12332          42 :     S = intAoo0(fs, A, ga, P, bit);
   12333          42 :     S = RgX_embedall(S, F? mfgetembed(F,prec): fs_get_vE(fs));
   12334             :   }
   12335          63 :   delete_var(); return normalizeapprox(S, bit-20);
   12336             : }
   12337             : 
   12338             : static GEN
   12339          42 : actal(GEN x, GEN vabd)
   12340             : {
   12341          42 :   if (typ(x) == t_INFINITY) return x;
   12342          35 :   return gdiv(gadd(gmul(gel(vabd,1), x), gel(vabd,2)), gel(vabd,3));
   12343             : }
   12344             : 
   12345             : static GEN
   12346          14 : unact(GEN z, GEN vabd, long k, long prec)
   12347             : {
   12348          14 :   GEN res = gsubst(z, 0, actal(pol_x(0), vabd));
   12349          14 :   GEN CO = gpow(gdiv(gel(vabd,3), gel(vabd,1)), sstoQ(k-2, 2), prec);
   12350          14 :   return gmul(CO, res);
   12351             : }
   12352             : 
   12353             : GEN
   12354         182 : mfsymboleval(GEN fs, GEN path, GEN ga, long bitprec)
   12355             : {
   12356         182 :   pari_sp av = avma;
   12357         182 :   GEN tau, V, LM, S, CHI, mfpols, cosets, al, be, mf, F, vabd = NULL;
   12358             :   long D, B, m, u, v, a, b, c, d, j, k, N, prec, tsc1, tsc2;
   12359             : 
   12360         182 :   if (checkfs_i(fs))
   12361             :   {
   12362         175 :     get_mf_F(fs, &mf, &F);
   12363         175 :     bitprec = minss(bitprec, fs_get_bitprec(fs));
   12364             :   }
   12365             :   else
   12366             :   {
   12367           7 :     if (checkfs2_i(fs)) pari_err_TYPE("mfsymboleval [need integral k > 1]",fs);
   12368           0 :     if (typ(fs) != t_VEC || lg(fs) != 3) pari_err_TYPE("mfsymboleval",fs);
   12369           0 :     get_mf_F(fs, &mf, &F);
   12370           0 :     mf = checkMF_i(mf);
   12371           0 :     if (!mf ||!checkmf_i(F)) pari_err_TYPE("mfsymboleval",fs);
   12372             :   }
   12373         175 :   if (lg(path) != 3) pari_err_TYPE("mfsymboleval",path);
   12374         175 :   if (typ(path) == t_MAT) path = pathmattovec(path);
   12375         175 :   if (typ(path) != t_VEC) pari_err_TYPE("mfsymboleval",path);
   12376         175 :   al = gel(path,1);
   12377         175 :   be = gel(path,2);
   12378         175 :   ga = ga? GL2toSL2(ga, &vabd): matid(2);
   12379         175 :   if (vabd)
   12380             :   {
   12381          14 :     al = actal(al, vabd);
   12382          14 :     be = actal(be, vabd); path = mkvec2(al, be);
   12383             :   }
   12384         175 :   tsc1 = cusp_AC(al, &a, &c);
   12385         175 :   tsc2 = cusp_AC(be, &b, &d);
   12386         175 :   prec = nbits2prec(bitprec);
   12387         175 :   k = MF_get_k(mf);
   12388         175 :   if (!tsc1)
   12389             :   {
   12390          42 :     GEN z2, z = mfsymbolevalpartial(fs, al, ga, bitprec);
   12391          42 :     if (tsc2)
   12392          28 :       z2 = d? mfsymboleval(fs, mkvec2(be, mkoo()), ga, bitprec): gen_0;
   12393             :     else
   12394          14 :       z2 = mfsymbolevalpartial(fs, be, ga, bitprec);
   12395          42 :     z = gsub(z, z2);
   12396          42 :     if (vabd) z = unact(z, vabd, k, prec);
   12397          42 :     return gerepileupto(av, normalizeapprox(z, bitprec-20));
   12398             :   }
   12399         133 :   else if (!tsc2)
   12400             :   {
   12401           7 :     GEN z = mfsymbolevalpartial(fs, be, ga, bitprec);
   12402           7 :     if (c) z = gsub(mfsymboleval(fs, mkvec2(al, mkoo()), ga, bitprec), z);
   12403           7 :     if (vabd) z = unact(z, vabd, k, prec);
   12404           7 :     return gerepileupto(av, normalizeapprox(z, bitprec-20));
   12405             :   }
   12406         126 :   if (F) pari_err_TYPE("mfsymboleval", fs);
   12407         126 :   D = a*d-b*c;
   12408         126 :   if (!D) { set_avma(av); return RgX_embedall(gen_0, fs_get_vE(fs)); }
   12409         112 :   mfpols = fs_get_pols(fs);
   12410         112 :   cosets = fs_get_cosets(fs);
   12411         112 :   CHI = MF_get_CHI(mf); N = MF_get_N(mf);
   12412         112 :   cbezout(a, c, &u, &v); B = u*b + v*d; tau = mkmat22s(a, -v, c, u);
   12413         112 :   V = gcf(sstoQ(B, D));
   12414         112 :   LM = shallowconcat(mkcol2(gen_1, gen_0), contfracpnqn(V, lg(V)));
   12415         112 :   S = gen_0; m = lg(LM) - 2;
   12416         336 :   for (j = 0; j < m; j++)
   12417             :   {
   12418             :     GEN M, P;
   12419             :     long D, iN;
   12420         224 :     M = mkmat2(gel(LM, j+2), gel(LM, j+1));
   12421         224 :     if (!odd(j)) gel(M,1) = ZC_neg(gel(M,1));
   12422         224 :     M = ZM_mul(tau, M);
   12423         224 :     iN = mftocoset_iD(N, ZM_mul(ga, M), cosets, &D);
   12424         224 :     P = gmul(gel(mfpols,iN), mfcharcxeval(CHI,D,prec));
   12425         224 :     S = gadd(S, act_GL2(P, ZM_inv(M, NULL), k));
   12426             :   }
   12427         112 :   if (typ(S) == t_RFRAC)
   12428             :   {
   12429             :     GEN R, S1, co;
   12430          21 :     gel(S,2) = primitive_part(gel(S,2), &co);
   12431          21 :     if (co) gel(S,1) = gdiv(gel(S,1), gtofp(co,prec));
   12432          21 :     S1 = poldivrem(gel(S,1), gel(S,2), &R);
   12433          21 :     if (gexpo(R) < -bitprec + 20) S = S1;
   12434             :   }
   12435         112 :   if (vabd) S = unact(S, vabd, k, prec);
   12436         112 :   S = RgX_embedall(S, fs_get_vE(fs));
   12437         112 :   return gerepileupto(av, normalizeapprox(S, bitprec-20));
   12438             : }
   12439             : 
   12440             : /* v a scalar or t_POL; set *pw = a if expo(a) > E for some coefficient;
   12441             :  * take the 'a' with largest exponent */
   12442             : static void
   12443        5740 : improve(GEN v, GEN *pw, long *E)
   12444             : {
   12445        5740 :   if (typ(v) != t_POL)
   12446             :   {
   12447        4270 :     long e = gexpo(v);
   12448        4270 :     if (e > *E) { *E = e; *pw = v; }
   12449             :   }
   12450             :   else
   12451             :   {
   12452        1470 :     long j, l = lg(v);
   12453        5740 :     for (j = 2; j < l; j++) improve(gel(v,j), pw, E);
   12454             :   }
   12455        5740 : }
   12456             : static GEN
   12457         518 : polabstorel(GEN rnfeq, GEN T)
   12458             : {
   12459             :   long i, l;
   12460             :   GEN U;
   12461         518 :   if (typ(T) != t_POL) return T;
   12462         518 :   U = cgetg_copy(T, &l); U[1] = T[1];
   12463        3500 :   for (i = 2; i < l; i++) gel(U,i) = eltabstorel(rnfeq, gel(T,i));
   12464         518 :   return U;
   12465             : }
   12466             : static GEN
   12467        1519 : bestapprnfrel(GEN x, GEN polabs, GEN roabs, GEN rnfeq, long prec)
   12468             : {
   12469        1519 :   x = bestapprnf(x, polabs, roabs, prec);
   12470        1519 :   if (rnfeq) x = polabstorel(rnfeq, liftpol_shallow(x));
   12471        1519 :   return x;
   12472             : }
   12473             : /* v vector of polynomials polynomial in C[X] (possibly scalar).
   12474             :  * Set *w = coeff with largest exponent and return T / *w, rationalized */
   12475             : static GEN
   12476          98 : normal(GEN v, GEN polabs, GEN roabs, GEN rnfeq, GEN *w, long prec)
   12477             : {
   12478          98 :   long i, l = lg(v), E = -(long)HIGHEXPOBIT;
   12479             :   GEN dv;
   12480        1568 :   for (i = 1; i < l; i++) improve(gel(v,i), w, &E);
   12481          98 :   v = RgV_Rg_mul(v, ginv(*w));
   12482        1568 :   for (i = 1; i < l; i++)
   12483        1470 :     gel(v,i) = bestapprnfrel(gel(v,i), polabs,roabs,rnfeq,prec);
   12484          98 :   v = Q_primitive_part(v,&dv);
   12485          98 :   if (dv) *w = gmul(*w,dv);
   12486          98 :   return v;
   12487             : }
   12488             : 
   12489             : static GEN mfpetersson_i(GEN FS, GEN GS);
   12490             : 
   12491             : GEN
   12492          42 : mfmanin(GEN FS, long bitprec)
   12493             : {
   12494          42 :   pari_sp av = avma;
   12495             :   GEN mf, M, vp, vm, cosets, CHI, vpp, vmm, f, T, P, vE, polabs, roabs, rnfeq;
   12496             :   GEN pet;
   12497             :   long N, k, lco, i, prec, lvE;
   12498             : 
   12499          42 :   if (!checkfs_i(FS))
   12500             :   {
   12501           7 :     if (checkfs2_i(FS)) pari_err_TYPE("mfmanin [need integral k > 1]",FS);
   12502           0 :     pari_err_TYPE("mfmanin",FS);
   12503             :   }
   12504          35 :   if (!mfs_iscusp(FS)) pari_err_TYPE("mfmanin [noncuspidal]",FS);
   12505          35 :   mf = fs_get_MF(FS);
   12506          35 :   vp = fs_get_pols(FS);
   12507          35 :   cosets = fs_get_cosets(FS);
   12508          35 :   bitprec = fs_get_bitprec(FS);
   12509          35 :   N = MF_get_N(mf); k = MF_get_k(mf); CHI = MF_get_CHI(mf);
   12510          35 :   lco = lg(cosets); vm = cgetg(lco, t_VEC);
   12511          35 :   prec = nbits2prec(bitprec);
   12512         476 :   for (i = 1; i < lco; i++)
   12513             :   {
   12514         441 :     GEN g = gel(cosets, i), c;
   12515         441 :     long A = itos(gcoeff(g,1,1)), B = itos(gcoeff(g,1,2));
   12516         441 :     long C = itos(gcoeff(g,2,1)), D = itos(gcoeff(g,2,2));
   12517         441 :     long Dbar, ibar = mftocoset_iD(N, mkmat22s(-B,-A,D,C), cosets, &Dbar);
   12518             : 
   12519         441 :     c = mfcharcxeval(CHI, Dbar, prec); if (odd(k)) c = gneg(c);
   12520         441 :     T = RgX_Rg_mul(gel(vp,ibar), c);
   12521         441 :     if (typ(T) == t_POL && varn(T) == 0) T = RgX_recip(T);
   12522         441 :     gel(vm,i) = T;
   12523             :   }
   12524          35 :   vpp = gadd(vp,vm);
   12525          35 :   vmm = gsub(vp,vm);
   12526             : 
   12527          35 :   vE = fs_get_vE(FS); lvE = lg(vE);
   12528          35 :   f = gel(fs_get_EF(FS), 1);
   12529          35 :   P = mf_get_field(f); if (degpol(P) == 1) P = NULL;
   12530          35 :   T = mfcharpol(CHI);  if (degpol(T) == 1) T = NULL;
   12531          35 :   if (T && P)
   12532             :   {
   12533           7 :     rnfeq = nf_rnfeqsimple(T, P);
   12534           7 :     polabs = gel(rnfeq,1);
   12535           7 :     roabs = gel(QX_complex_roots(polabs,prec), 1);
   12536             :   }
   12537             :   else
   12538             :   {
   12539          28 :     rnfeq = roabs = NULL;
   12540          28 :     polabs = P? P: T;
   12541             :   }
   12542          35 :   pet = mfpetersson_i(FS, NULL);
   12543          35 :   M = cgetg(lvE, t_VEC);
   12544          84 :   for (i = 1; i < lvE; i++)
   12545             :   {
   12546          49 :     GEN p, m, wp, wm, petdiag, r, E = gel(vE,i);
   12547          49 :     p = normal(RgXV_embed(vpp, E), polabs, roabs, rnfeq, &wp, prec);
   12548          49 :     m = normal(RgXV_embed(vmm, E), polabs, roabs, rnfeq, &wm, prec);
   12549          49 :     petdiag = typ(pet)==t_MAT? gcoeff(pet,i,i): pet;
   12550          49 :     r = gdiv(imag_i(gmul(wp, conj_i(wm))), petdiag);
   12551          49 :     r = bestapprnfrel(r, polabs, roabs, rnfeq, prec);
   12552          49 :     gel(M,i) = mkvec2(mkvec2(p,m), mkvec3(wp,wm,r));
   12553             :   }
   12554          35 :   return gerepilecopy(av, lvE == 2? gel(M,1): M);
   12555             : }
   12556             : 
   12557             : /* flag = 0: full, flag = +1 or -1, odd/even */
   12558             : /* Basis of period polynomials in level 1. */
   12559             : GEN
   12560          49 : mfperiodpolbasis(long k, long flag)
   12561             : {
   12562          49 :   pari_sp av = avma;
   12563          49 :   long i, j, n = k - 2;
   12564             :   GEN M, C, v;
   12565          49 :   if (k <= 4) return cgetg(1,t_VEC);
   12566          35 :   M = cgetg(k, t_MAT);
   12567          35 :   C = matpascal(n);
   12568          35 :   if (!flag)
   12569         392 :     for (j = 0; j <= n; j++)
   12570             :     {
   12571         371 :       gel(M, j+1) = v = cgetg(k, t_COL);
   12572        4767 :       for (i = 0; i <= j; i++) gel(v, i+1) = gcoeff(C, j+1, i+1);
   12573        4396 :       for (; i <= n; i++) gel(v, i+1) = gcoeff(C, n-j+1, i-j+1);
   12574             :     }
   12575             :   else
   12576         168 :     for (j = 0; j <= n; j++)
   12577             :     {
   12578         154 :       gel(M, j+1) = v = cgetg(k, t_COL);
   12579        1848 :       for (i = 0; i <= n; i++)
   12580             :       {
   12581        1694 :         GEN a = i < j ? gcoeff(C, j+1, i+1) : gen_0;
   12582        1694 :         if (i + j >= n)
   12583             :         {
   12584         924 :           GEN b = gcoeff(C, j+1, i+j-n+1);
   12585         924 :           a = flag < 0 ? addii(a,b) : subii(a,b);
   12586             :         }
   12587        1694 :         gel(v, i+1) = a;
   12588             :       }
   12589             :     }
   12590          35 :   return gerepilecopy(av, RgM_to_RgXV(ZM_ker(M), 0));
   12591             : }
   12592             : 
   12593             : static int
   12594         161 : zero_at_cusp(GEN mf, GEN F, GEN c)
   12595             : {
   12596         161 :   GEN v = evalcusp(mf, F, c, LOWDEFAULTPREC);
   12597         161 :   return (gequal0(v) || gexpo(v) <= -62);
   12598             : }
   12599             : /* Compute list E of j such that F|_k g_j vanishes at oo: return [E, s(E)] */
   12600             : static void
   12601           7 : mffvanish(GEN mf, GEN F, GEN G, GEN cosets, GEN *pres, GEN *press)
   12602             : {
   12603           7 :   long j, lc = lg(cosets), N = MF_get_N(mf);
   12604             :   GEN v, vs;
   12605           7 :   *pres = v  = zero_zv(lc-1);
   12606           7 :   *press= vs = zero_zv(lc-1);
   12607          91 :   for (j = 1; j < lc; j++)
   12608             :   {
   12609          84 :     GEN ga = gel(cosets,j), c = mat2cusp(ga);
   12610          84 :     if (zero_at_cusp(mf, F, c))
   12611           7 :       v[j] = vs[ mftocoset_i(N, ZM_mulS(ga), cosets) ] = 1;
   12612          77 :     else if (!zero_at_cusp(mf, G, c))
   12613           0 :       pari_err_IMPL("divergent Petersson product");
   12614             :   }
   12615           7 : }
   12616             : static GEN
   12617         133 : Haberland(GEN PF, GEN PG, GEN vEF, GEN vEG, long k)
   12618             : {
   12619         133 :   GEN S = gen_0, vC = vecbinomial(k-2); /* vC[n+1] = (-1)^n binom(k-2,n) */
   12620         133 :   long n, j, l = lg(PG);
   12621         364 :   for (n = 2; n < k; n+=2) gel(vC,n) = negi(gel(vC,n));
   12622        2569 :   for (j = 1; j < l; j++)
   12623             :   {
   12624        2436 :     GEN PFj = gel(PF,j), PGj = gel(PG,j);
   12625        9954 :     for (n = 0; n <= k-2; n++)
   12626             :     {
   12627        7518 :       GEN a = RgX_coeff(PGj, k-2-n), b = RgX_coeff(PFj, n);
   12628        7518 :       a = Rg_embedall(a, vEG);
   12629        7518 :       b = Rg_embedall(b, vEF);
   12630        7518 :       a = conj_i(a); if (typ(a) == t_VEC) settyp(a, t_COL);
   12631             :       /* a*b = scalar or t_VEC or t_COL or t_MAT */
   12632        7518 :       S = gadd(S, gdiv(gmul(a,b), gel(vC,n+1)));
   12633             :     }
   12634             :   }
   12635         133 :   S = mulcxpowIs(gmul2n(S, 1-k), 1+k);
   12636         133 :   return vEF==vEG? real_i(S): S;
   12637             : }
   12638             : /* F1S, F2S both symbols, same mf */
   12639             : static GEN
   12640           7 : mfpeterssonnoncusp(GEN F1S, GEN F2S)
   12641             : {
   12642           7 :   pari_sp av = avma;
   12643             :   GEN mf, F1, F2, GF1, GF2, P2, cosets, vE1, vE2, FE1, FE2, P;
   12644             :   GEN I, IP1, RHO, RHOP1, INF, res, ress;
   12645           7 :   const double height = sqrt(3.)/2;
   12646             :   long k, r, j, bitprec, prec;
   12647             : 
   12648           7 :   mf = fs_get_MF(F1S);
   12649           7 :   FE1 = fs_get_EF(F1S); F1 = gel(FE1, 1);
   12650           7 :   FE2 = fs_get_EF(F2S); F2 = gel(FE2, 1);
   12651           7 :   cosets = fs_get_cosets(F1S);
   12652           7 :   bitprec = minuu(fs_get_bitprec(F1S), fs_get_bitprec(F2S));
   12653           7 :   prec = nbits2prec(bitprec);
   12654           7 :   F1S = fs_set_expan(F1S, mfgaexpansionall(mf, FE1, cosets, height, prec));
   12655           7 :   if (F2S != F1S)
   12656           7 :     F2S = fs_set_expan(F2S, mfgaexpansionall(mf, FE2, cosets, height, prec));
   12657           7 :   k = MF_get_k(mf); r = lg(cosets) - 1;
   12658           7 :   vE1 = fs_get_vE(F1S);
   12659           7 :   vE2 = fs_get_vE(F2S);
   12660           7 :   I = gen_I();
   12661           7 :   IP1 = mkcomplex(gen_1,gen_1);
   12662           7 :   RHO = rootsof1u_cx(3, prec+EXTRAPREC64);
   12663           7 :   RHOP1 = gaddsg(1, RHO);
   12664           7 :   INF = mkoo();
   12665           7 :   mffvanish(mf, F1, F2, cosets, &res, &ress);
   12666           7 :   P2 = fs_get_pols(F2S);
   12667           7 :   GF1 = cgetg(r+1, t_VEC);
   12668           7 :   GF2 = cgetg(r+1, t_VEC); P = get_P(k, fetch_var(), prec);
   12669          91 :   for (j = 1; j <= r; j++)
   12670             :   {
   12671          84 :     GEN g = gel(cosets,j);
   12672          84 :     if (res[j]) {
   12673           7 :       gel(GF1,j) = mfsymboleval_direct(F1S, mkvec2(RHOP1,INF), g, P);
   12674           7 :       gel(GF2,j) = mfsymboleval_direct(F2S, mkvec2(I,IP1), g, P);
   12675          77 :     } else if (ress[j]) {
   12676           7 :       gel(GF1,j) = mfsymboleval_direct(F1S, mkvec2(RHOP1,RHO), g, P);
   12677           7 :       gel(GF2,j) = mfsymboleval_direct(F2S, mkvec2(I,INF), g, P);
   12678             :     } else {
   12679          70 :       gel(GF1,j) = mfsymboleval_direct(F1S, mkvec2(RHO,I), g, P);
   12680          70 :       gel(GF2,j) = gneg(gel(P2,j)); /* - symboleval(F2S, [0,oo] */
   12681             :     }
   12682             :   }
   12683           7 :   delete_var();
   12684           7 :   return gerepileupto(av, gdivgu(Haberland(GF1,GF2, vE1,vE2, k), r));
   12685             : }
   12686             : 
   12687             : /* Petersson product of F and G, given by mfsymbol's [k > 1 integral] */
   12688             : static GEN
   12689         133 : mfpetersson_i(GEN FS, GEN GS)
   12690             : {
   12691         133 :   pari_sp av = avma;
   12692             :   GEN mf, ESF, ESG, PF, PG, PH, CHI, cosets, vEF, vEG;
   12693             :   long k, r, j, N, bitprec, prec;
   12694             : 
   12695         133 :   if (!checkfs_i(FS)) pari_err_TYPE("mfpetersson",FS);
   12696         133 :   mf = fs_get_MF(FS);
   12697         133 :   ESF = fs_get_vES(FS);
   12698         133 :   if (!GS) GS = FS;
   12699             :   else
   12700             :   {
   12701          28 :     if (!checkfs_i(GS)) pari_err_TYPE("mfpetersson",GS);
   12702          28 :     if (!mfs_checkmf(GS, mf))
   12703           0 :       pari_err_TYPE("mfpetersson [different mf]", mkvec2(FS,GS));
   12704             :   }
   12705         133 :   ESG = fs_get_vES(GS);
   12706         133 :   if (!gequal0(gel(ESF,1)) && !gequal0(gel(ESG,1)))
   12707           7 :     return mfpeterssonnoncusp(FS, GS);
   12708         126 :   if (gequal0(gel(ESF,2)) || gequal0(gel(ESG,2))) return gc_const(av, gen_0);
   12709         126 :   N = MF_get_N(mf);
   12710         126 :   k = MF_get_k(mf);
   12711         126 :   CHI = MF_get_CHI(mf);
   12712         126 :   PF = fs_get_pols(FS); vEF = fs_get_vE(FS);
   12713         126 :   PG = fs_get_pols(GS); vEG = fs_get_vE(GS);
   12714         126 :   cosets = fs_get_cosets(FS);
   12715         126 :   bitprec = minuu(fs_get_bitprec(FS), fs_get_bitprec(GS));
   12716         126 :   prec = nbits2prec(bitprec);
   12717         126 :   r = lg(PG)-1;
   12718         126 :   PH = cgetg(r+1, t_VEC);
   12719        2478 :   for (j = 1; j <= r; j++)
   12720             :   {
   12721        2352 :     GEN ga = gel(cosets,j), PGj1, PGjm1;
   12722             :     long iT, D;
   12723        2352 :     iT = mftocoset_iD(N, ZM_mulTi(ga), cosets, &D);
   12724        2352 :     PGj1 = RgX_translate(gel(PG, iT), gen_1);
   12725        2352 :     PGj1 = RgX_Rg_mul(PGj1, mfcharcxeval(CHI, D, prec));
   12726        2352 :     iT = mftocoset_iD(N, ZM_mulT(ga), cosets, &D);
   12727        2352 :     PGjm1 = RgX_translate(gel(PG,iT), gen_m1);
   12728        2352 :     PGjm1 = RgX_Rg_mul(PGjm1, mfcharcxeval(CHI, D, prec));
   12729        2352 :     gel(PH,j) = gsub(PGj1, PGjm1);
   12730             :   }
   12731         126 :   return gerepileupto(av, gdivgu(Haberland(PF, PH, vEF, vEG, k), 6*r));
   12732             : }
   12733             : 
   12734             : /****************************************************************/
   12735             : /*           Petersson products using Nelson-Collins            */
   12736             : /****************************************************************/
   12737             : /* Compute W(k,z) = sum_{m >= 1} (mz)^{k-1}(mzK_{k-2}(mz)-K_{k-1}(mz))
   12738             :  * for z>0 and absolute accuracy < 2^{-B}.
   12739             :  * K_k(x) ~ (Pi/(2x))^{1/2} e^{-x} */
   12740             : 
   12741             : static void
   12742       10304 : Wparams(GEN *ph, long *pN, long k, double x, long prec)
   12743             : {
   12744       10304 :   double B = prec2nbits(prec) + 10;
   12745       10304 :   double C = B + k*log(x)/M_LN2 + 1, D = C*M_LN2 + 2.065;
   12746       10304 :   double F = 2 * ((C - 1) * M_LN2 + log(gtodouble(mpfact(k)))) / x;
   12747       10304 :   double T = log(F) * (1 + 2*k/x/F), PI2 = M_PI*M_PI;
   12748       10304 :   *pN = (long)ceil((T/PI2) * (D + log(D/PI2)));
   12749       10304 :   *ph = gprec_w(dbltor(T / *pN), prec);
   12750       10304 : }
   12751             : 
   12752             : static void
   12753       10304 : Wcoshall(GEN *pCH, GEN *pCHK, GEN *pCHK1, GEN h, long N, long k, long prec)
   12754             : {
   12755       10304 :   GEN CH, CHK, CHK1, z = gexp(h, prec);
   12756       10304 :   GEN PO = gpowers(z, N), POK1 = gpowers(gpowgs(z, k-1), N);
   12757       10304 :   GEN E = ginv(gel(PO, N + 1)); /* exp(-hN) */
   12758       10304 :   GEN E1 = ginv(gel(POK1, N + 1)); /* exp(-(k-1)h) */
   12759             :   long j;
   12760       10304 :   *pCH = CH = cgetg(N+1, t_VEC);
   12761       10304 :   *pCHK = CHK = cgetg(N+1, t_VEC);
   12762       10304 :   *pCHK1 = CHK1 = cgetg(N+1, t_VEC);
   12763      146048 :   for (j = 1; j <= N; j++)
   12764             :   {
   12765      135744 :     GEN eh = gel(PO, j+1), emh = gmul(gel(PO, N-j+1), E); /* e^{jh}, e^{-jh} */
   12766      135744 :     GEN ek1h = gel(POK1, j+1), ek1mh = gmul(gel(POK1, N-j+1), E1);
   12767      135744 :     gel(CH, j) = gmul2n(gadd(eh, emh), -1); /* cosh(jh) */
   12768      135744 :     gel(CHK1,j) = gmul2n(gadd(ek1h, ek1mh), -1); /* cosh((k-1)jh) */
   12769      135744 :     gel(CHK, j) = gmul2n(gadd(gmul(eh, ek1h), gmul(emh, ek1mh)), -1);
   12770             :   }
   12771       10304 : }
   12772             : 
   12773             : /* computing W(k,x) via integral */
   12774             : static GEN
   12775       10304 : Wint(long k, GEN vP, GEN x, long prec)
   12776             : {
   12777             :   GEN P, P1, S1, S, h, CH, CHK, CHK1;
   12778             :   long N, j;
   12779       10304 :   Wparams(&h, &N, k, gtodouble(x), prec);
   12780       10304 :   Wcoshall(&CH, &CHK, &CHK1, h, N, k, prec);
   12781       10304 :   P = gel(vP, k+1); P1 = gel(vP, k); S = S1 = NULL;
   12782      156352 :   for (j = 0; j <= N; j++)
   12783             :   {
   12784      146048 :     GEN eh = gexp(j? gmul(x, gel(CH, j)): x, prec);
   12785      146048 :     GEN eh1 = gsubgs(eh, 1), eh1k = gpowgs(eh1, k), t1, t;
   12786      146048 :     t = gdiv(poleval(P, eh), gmul(eh1, eh1k));
   12787      146048 :     t1 = gdiv(poleval(P1, eh), eh1k);
   12788      146048 :     if (j)
   12789             :     {
   12790      135744 :       S = gadd(S, gmul(t, gel(CHK, j)));
   12791      135744 :       S1 = gadd(S1, gmul(t1, gel(CHK1, j)));
   12792             :     }
   12793             :     else
   12794             :     {
   12795       10304 :       S = gmul2n(t, -1);
   12796       10304 :       S1 = gmul2n(t1, -1);
   12797             :     }
   12798             :   }
   12799       10304 :   return gmul(gmul(h, gpowgs(x, k-1)), gsub(gmul(x, S), gmulsg(2*k-1, S1)));
   12800             : }
   12801             : 
   12802             : static GEN
   12803          21 : get_vP(long k)
   12804             : {
   12805          21 :   GEN P, v = cgetg(k+2, t_VEC), Q = deg1pol_shallow(gen_1,gen_m1,0);
   12806             :   long j;
   12807          21 :   gel(v,1) = gen_1;
   12808          21 :   gel(v,2) = P = pol_x(0);
   12809          28 :   for (j = 2; j <= k; j++)
   12810           7 :     gel(v,j+1) = P = RgX_shift_shallow(gsub(gmulsg(j, P),
   12811             :                                             gmul(Q, ZX_deriv(P))), 1);
   12812          21 :   return v;
   12813             : }
   12814             : /* vector of (-1)^j(1/(exp(x)-1))^(j) [x = z] * z^j for 0<=j<=r */
   12815             : static GEN
   12816       63742 : VS(long r, GEN z, GEN V, long prec)
   12817             : {
   12818       63742 :   GEN e = gexp(z, prec), c = ginv(gsubgs(e,1));
   12819       63742 :   GEN T = gpowers0(gmul(c, z), r, c);
   12820             :   long j;
   12821       63742 :   V = gsubst(V, 0, e);
   12822      143864 :   for (j = 1; j <= r + 1; j++) gel(V,j) = gmul(gel(V,j), gel(T,j));
   12823       63742 :   return V;
   12824             : }
   12825             : 
   12826             : /* U(r,x)=sum_{m >= 1} (mx)^k K_k(mx), k = r+1/2 */
   12827             : static GEN
   12828       71932 : Unelson(long r, GEN V)
   12829             : {
   12830       71932 :   GEN S = gel(V,r+1), C = gen_1; /* (r+j)! / j! / (r-j)! */
   12831             :   long j;
   12832       71932 :   if (!r) return S;
   12833       40950 :   for (j = 1; j <= r; j++)
   12834             :   {
   12835       24570 :     C = gdivgu(gmulgu(C, (r+j)*(r-j+1)), j);
   12836       24570 :     S = gadd(S, gmul2n(gmul(C, gel(V, r-j+1)), -j));
   12837             :   }
   12838       16380 :   return S;
   12839             : }
   12840             : /* W(r+1/2,z) / sqrt(Pi/2) */
   12841             : static GEN
   12842       63742 : Wint2(long r, GEN vP, GEN z, long prec)
   12843             : {
   12844       63742 :   GEN R, V = VS(r, z, vP, prec);
   12845       63742 :   R = Unelson(r, V);
   12846       63742 :   if (r) R = gsub(R, gmulsg(2*r, Unelson(r-1, V)));
   12847       63742 :   return R;
   12848             : }
   12849             : typedef GEN(*Wfun_t)(long, GEN, GEN, long);
   12850             : static GEN
   12851       74046 : WfromZ(GEN Z, GEN vP, GEN gkm1, Wfun_t W, long k, GEN pi4, long prec)
   12852             : {
   12853       74046 :   pari_sp av = avma;
   12854       74046 :   GEN Zk = gpow(Z, gkm1, prec), z = gmul(pi4, gsqrt(Z,prec));
   12855       74046 :   return gerepileupto(av, gdiv(W(k, vP, z, prec), Zk));
   12856             : }
   12857             : /* mf a true mf or an fs2 */
   12858             : static GEN
   12859          21 : fs2_init(GEN mf, GEN F, long bit)
   12860             : {
   12861          21 :   pari_sp av = avma;
   12862          21 :   long i, l, lim, N, k, k2, prec = nbits2prec(bit);
   12863             :   GEN DEN, cusps, tab, gk, gkm1, W0, vW, vVW, vVF, vP, al0;
   12864          21 :   GEN vE = mfgetembed(F, prec), pi4 = Pi2n(2, prec);
   12865             :   Wfun_t Wf;
   12866             : 
   12867          21 :   if (lg(mf) == 7)
   12868             :   {
   12869          21 :     vW = cusps = NULL; /* true mf */
   12870          21 :     DEN = tab = NULL; /* -Wall */
   12871             :   }
   12872             :   else
   12873             :   { /* mf already an fs2, reset if its precision is too low */
   12874           0 :     vW = (fs2_get_bitprec(mf) < bit)? NULL: fs2_get_W(mf);
   12875           0 :     cusps = fs2_get_cusps(mf);
   12876           0 :     DEN = fs2_get_den(mf);
   12877           0 :     mf = fs2_get_MF(mf);
   12878             :   }
   12879          21 :   N = MF_get_N(mf);
   12880          21 :   gk = MF_get_gk(mf); gkm1 = gsubgs(gk, 1);
   12881          21 :   k2 = itos(gmul2n(gk,1));
   12882          21 :   Wf = odd(k2)? Wint2: Wint;
   12883          21 :   k = k2 >> 1; vP = get_vP(k);
   12884          21 :   if (vW) lim = (lg(gel(vW,1)) - 2) / N; /* vW[1] attached to cusp 0, width N */
   12885             :   else
   12886             :   { /* true mf */
   12887          21 :     double B = (bit + 10)*M_LN2;
   12888          21 :     double L = (B + k2*log(B)/2 + k2*k2*log(B)/(4*B)) / (4*M_PI);
   12889             :     long n, Lw;
   12890          21 :     lim = ((long)ceil(L*L));
   12891          21 :     Lw = N*lim;
   12892          21 :     tab = cgetg(Lw+1,t_VEC);
   12893       59157 :     for (n = 1; n <= Lw; n++)
   12894       59136 :       gel(tab,n) = WfromZ(uutoQ(n,N), vP, gkm1, Wf, k, pi4, prec);
   12895          21 :     if (!cusps) cusps = mfcusps_i(N);
   12896          21 :     DEN = gmul2n(gmulgu(gpow(Pi2n(3, prec), gkm1, prec), mypsiu(N)), -2);
   12897          21 :     if (odd(k2)) DEN = gdiv(DEN, sqrtr_abs(Pi2n(-1,prec)));
   12898             :   }
   12899          21 :   l = lg(cusps);
   12900          21 :   vVF = cgetg(l, t_VEC);
   12901          21 :   vVW = cgetg(l, t_VEC);
   12902          21 :   al0 = cgetg(l, t_VECSMALL);
   12903          21 :   W0 = k2==1? ginv(pi4): gen_0;
   12904         203 :   for (i = 1; i < l; i++)
   12905             :   {
   12906             :     long A, C, w, wi, Lw, n;
   12907             :     GEN VF, W, paramsF, al;
   12908         182 :     (void)cusp_AC(gel(cusps,i), &A,&C);
   12909         182 :     wi = ugcd(N, C*C); w = N / wi; Lw = w * lim;
   12910         182 :     VF = mfslashexpansion(mf, F, cusp2mat(A,C), Lw, 0, &paramsF, prec);
   12911             :     /* paramsF[2] = w */
   12912         182 :     al = gel(paramsF, 1); if (gequal0(al)) al = NULL;
   12913      100240 :     for (n = 0; n <= Lw; n++)
   12914             :     {
   12915      100058 :       GEN a = gel(VF,n+1);
   12916      100058 :       gel(VF,n+1) = gequal0(a)? gen_0: Rg_embedall(a, vE);
   12917             :     }
   12918         182 :     if (vW)
   12919           0 :       W = gel(vW, i);
   12920             :     else
   12921             :     {
   12922         182 :       W = cgetg(Lw+2, t_VEC);
   12923      100240 :       for (n = 0; n <= Lw; n++)
   12924      100058 :         gel(W, n+1) = al? WfromZ(gadd(al,uutoQ(n,w)),vP,gkm1,Wf,k,pi4, prec)
   12925      100058 :                         : (n? gel(tab, n * wi): W0);
   12926             :     }
   12927         182 :     al0[i] = !al;
   12928         182 :     gel(vVF, i) = VF;
   12929         182 :     gel(vVW, i) = W;
   12930             :   }
   12931          21 :   if (k2 <= 1) al0 = zero_zv(l-1); /* no need to test for convergence */
   12932          21 :   return gerepilecopy(av, mkvecn(7, mf,vVW,cusps,vVF,utoipos(bit),al0,DEN));
   12933             : }
   12934             : 
   12935             : static GEN
   12936          21 : mfpetersson2(GEN Fs, GEN Gs)
   12937             : {
   12938          21 :   pari_sp av = avma;
   12939          21 :   GEN VC, RES, vF, vG, vW = fs2_get_W(Fs), al0 = fs2_get_al0(Fs);
   12940          21 :   long N = MF_get_N(fs2_get_MF(Fs)), j, lC;
   12941             : 
   12942          21 :   VC = fs2_get_cusps(Fs); lC = lg(VC);
   12943          21 :   vF = fs2_get_F(Fs);
   12944          21 :   vG = Gs? fs2_get_F(Gs): vF;
   12945          21 :   RES = gen_0;
   12946         203 :   for (j = 1; j < lC; j++)
   12947             :   {
   12948         182 :     GEN W = gel(vW,j), VF = gel(vF,j), VG = gel(vG,j), T = gen_0;
   12949         182 :     long A, C, w, n, L = lg(W);
   12950         182 :     pari_sp av = avma;
   12951         182 :     (void)cusp_AC(gel(VC,j), &A,&C); w = N/ugcd(N, C*C);
   12952         182 :     if (al0[j] && !isintzero(gel(VF,1)) && !isintzero(gel(VG,1)))
   12953           0 :       pari_err_IMPL("divergent Petersson product");
   12954      100240 :     for (n = 1; n < L; n++)
   12955             :     {
   12956      100058 :       GEN b = gel(VF,n), a = gel(VG,n);
   12957      100058 :       if (!isintzero(a) && !isintzero(b))
   12958             :       {
   12959       79964 :         T = gadd(T, gmul(gel(W,n), gmul(conj_i(a),b)));
   12960       79964 :         if (gc_needed(av,2)) T = gerepileupto(av,T);
   12961             :       }
   12962             :     }
   12963         182 :     if (w != 1) T = gmulgu(T,w);
   12964         182 :     RES = gerepileupto(av, gadd(RES, T));
   12965             :   }
   12966          21 :   if (!Gs) RES = real_i(RES);
   12967          21 :   return gerepileupto(av, gdiv(RES, fs2_get_den(Fs)));
   12968             : }
   12969             : 
   12970             : static long
   12971         147 : symbol_type(GEN F)
   12972             : {
   12973         147 :   if (checkfs_i(F)) return 1;
   12974          21 :   if (checkfs2_i(F)) return 2;
   12975           0 :   return 0;
   12976             : }
   12977             : static int
   12978          28 : symbol_same_mf(GEN F, GEN G) { return gequal(gmael(F,1,1), gmael(G,1,1)); }
   12979             : GEN
   12980         119 : mfpetersson(GEN F, GEN G)
   12981             : {
   12982         119 :   long tF = symbol_type(F);
   12983         119 :   if (!tF) pari_err_TYPE("mfpetersson",F);
   12984         119 :   if (G)
   12985             :   {
   12986          28 :     long tG = symbol_type(G);
   12987          28 :     if (!tG) pari_err_TYPE("mfpetersson",F);
   12988          28 :     if (tF != tG || !symbol_same_mf(F,G))
   12989           0 :       pari_err_TYPE("mfpetersson [incompatible symbols]", mkvec2(F,G));
   12990             :   }
   12991         119 :   return (tF == 1)? mfpetersson_i(F, G): mfpetersson2(F, G);
   12992             : }
   12993             : 
   12994             : /****************************************************************/
   12995             : /*         projective Galois representation, weight 1           */
   12996             : /****************************************************************/
   12997             : static void
   12998         392 : moreorders(long N, GEN CHI, GEN F, GEN *pP, GEN *pO, ulong *bound)
   12999             : {
   13000         392 :   pari_sp av = avma;
   13001             :   forprime_t iter;
   13002         392 :   ulong a = *bound+1, b = 2*(*bound), p;
   13003         392 :   long i = 1;
   13004         392 :   GEN P, O, V = mfcoefs_i(F, b, 1);
   13005         392 :   *bound = b;
   13006         392 :   P = cgetg(b-a+2, t_VECSMALL);
   13007         392 :   O = cgetg(b-a+2, t_VECSMALL);
   13008         392 :   u_forprime_init(&iter, a, b);
   13009        2310 :   while((p = u_forprime_next(&iter))) if (N % p)
   13010             :   {
   13011        1813 :     O[i] = mffindrootof1(V, p, CHI);
   13012        1813 :     P[i++] = p;
   13013             :   }
   13014         392 :   setlg(P, i); *pP = shallowconcat(*pP, P);
   13015         392 :   setlg(O, i); *pO = shallowconcat(*pO, O);
   13016         392 :   gerepileall(av, 2, pP, pO);
   13017         392 : }
   13018             : 
   13019             : static GEN
   13020         182 : search_abelian(GEN nf, long n, long k, GEN N, GEN CHI, GEN F,
   13021             :                GEN *pP, GEN *pO, ulong *bound, long prec)
   13022             : {
   13023         182 :   pari_sp av = avma;
   13024             :   GEN bnr, cond, H, cyc, gn, T, Bquo, P, E;
   13025         182 :   long sN = itos(N), r1 = nf_get_r1(nf), i, j, d;
   13026             : 
   13027         182 :   cond = idealfactor(nf, N);
   13028         182 :   P = gel(cond,1);
   13029         182 :   E = gel(cond,2);
   13030         679 :   for (i = j = 1; i < lg(P); i++)
   13031             :   {
   13032         497 :     GEN pr = gel(P,i), Ej = gen_1;
   13033         497 :     long p = itos(pr_get_p(pr));
   13034         497 :     if (p == n)
   13035             :     {
   13036          98 :       long e = pr_get_e(pr); /* 1 + [e*p/(p-1)] */
   13037          98 :       Ej = utoipos(1 + (e*p) / (p-1));
   13038             :     }
   13039             :     else
   13040             :     {
   13041         399 :       long f = pr_get_f(pr);
   13042         399 :       if (Fl_powu(p % n, f, n) != 1) continue;
   13043             :     }
   13044         462 :     gel(P,j) = pr;
   13045         462 :     gel(E,j) = Ej; j++;
   13046             :   }
   13047         182 :   setlg(P,j);
   13048         182 :   setlg(E,j);
   13049         182 :   cond = mkvec2(cond, const_vec(r1, gen_1));
   13050         182 :   bnr = Buchraymod(Buchall(nf, nf_FORCE, prec), cond, nf_INIT, utoipos(n));
   13051         182 :   cyc = bnr_get_cyc(bnr);
   13052         182 :   d = lg(cyc)-1;
   13053         182 :   H = zv_diagonal(ZV_to_Flv(cyc, n));
   13054         182 :   gn = utoi(n);
   13055         182 :   for (i = 1;;)
   13056             :   {
   13057        2646 :     for(j = 2; i < lg(*pO); i++)
   13058             :     {
   13059        2072 :       long o, q = (*pP)[i];
   13060        2072 :       GEN pr = idealprimedec_galois(nf, stoi(q));
   13061        2072 :       o = ((*pO)[i] / pr_get_f(pr)) % n;
   13062        2072 :       if (o)
   13063             :       {
   13064        1442 :         GEN v = ZV_to_Flv(isprincipalray(bnr, pr), n);
   13065        1442 :         H = vec_append(H, Flv_Fl_mul(v, o, n));
   13066             :       }
   13067             :     }
   13068         574 :     H = Flm_image(H, n); if (lg(cyc)-lg(H) <= k) break;
   13069         392 :     moreorders(sN, CHI, F, pP, pO, bound);
   13070             :   }
   13071         182 :   H = hnfmodid(shallowconcat(zm_to_ZM(H), diagonal_shallow(cyc)), gn);
   13072             : 
   13073         182 :   Bquo = cgetg(k+1, t_MAT);
   13074         812 :   for (i = j = 1; i <= d; i++)
   13075         630 :     if (!equali1(gcoeff(H,i,i))) gel(Bquo,j++) = col_ei(d,i);
   13076             : 
   13077         441 :   for (i = 1, T = NULL; i<=k; i++)
   13078             :   {
   13079         259 :     GEN Hi = hnfmodid(shallowconcat(H, vecsplice(Bquo,i)), gn);
   13080         259 :     GEN pol = rnfkummer(bnr, Hi, prec);
   13081         259 :     T = T? nfcompositum(nf, T, pol, 2): pol;
   13082             :   }
   13083         182 :   T = rnfequation(nf, T); return gc_all(av, 3, &T, pP, pO);
   13084             : }
   13085             : 
   13086             : static GEN
   13087          77 : search_solvable(GEN LG, GEN mf, GEN F, long prec)
   13088             : {
   13089          77 :   GEN N = MF_get_gN(mf), CHI = MF_get_CHI(mf), pol, O, P, nf, Nfa;
   13090          77 :   long i, l = lg(LG), v = fetch_var();
   13091          77 :   ulong bound = 1;
   13092          77 :   O = cgetg(1, t_VECSMALL); /* projective order of rho(Frob_p) */
   13093          77 :   P = cgetg(1, t_VECSMALL);
   13094          77 :   Nfa = Z_factor(N);
   13095          77 :   pol = pol_x(v);
   13096         259 :   for (i = 1; i < l; i++)
   13097             :   { /* n prime, find a (Z/nZ)^k - extension */
   13098         182 :     GEN G = gel(LG,i);
   13099         182 :     long n = G[1], k = G[2];
   13100         182 :     nf = nfinitred(mkvec2(pol,Nfa), prec);
   13101         182 :     pol = search_abelian(nf, n, k, N, CHI, F, &P, &O, &bound, prec);
   13102         182 :     setvarn(pol,v);
   13103             :   }
   13104          77 :   delete_var(); setvarn(pol,0); return pol;
   13105             : }
   13106             : 
   13107             : static GEN
   13108           0 : search_A5(GEN mf, GEN F)
   13109             : {
   13110           0 :   GEN CHI = MF_get_CHI(mf), O, P, L;
   13111           0 :   long N = MF_get_N(mf), i, j, lL, nd, r;
   13112           0 :   ulong bound = 1;
   13113           0 :   r = radicalu(N);
   13114           0 :   L = veccond_to_A5(zv_z_mul(divisorsu(N/r),r), 2); lL = lg(L); nd = lL-1;
   13115           0 :   if (nd == 1) return gmael(L,1,1);
   13116           0 :   O = cgetg(1, t_VECSMALL); /* projective order of rho(Frob_p) */
   13117           0 :   P = cgetg(1, t_VECSMALL);
   13118           0 :   for(i = 1; nd > 1; )
   13119             :   {
   13120             :     long l;
   13121           0 :     moreorders(N, CHI, F, &P, &O, &bound);
   13122           0 :     l = lg(P);
   13123           0 :     for (   ; i < l; i++)
   13124             :     {
   13125           0 :       ulong p = P[i], f = O[i];
   13126           0 :       for (j = 1; j < lL; j++)
   13127           0 :         if (gel(L,j))
   13128             :         {
   13129           0 :           GEN FE = ZpX_primedec(gmael(L,j,1), utoi(p)), F = gel(FE,1);
   13130           0 :           long nF = lg(F)-1;
   13131           0 :           if (!equaliu(gel(F, nF), f)) { gel(L,j) = NULL; nd--; }
   13132             :         }
   13133           0 :       if (nd <= 1) break;
   13134             :     }
   13135             :   }
   13136           0 :   for (j = 1; j < lL; j++)
   13137           0 :     if (gel(L,j)) return gmael(L,j,1);
   13138           0 :   return NULL;
   13139             : }
   13140             : 
   13141             : GEN
   13142          77 : mfgaloisprojrep(GEN mf, GEN F, long prec)
   13143             : {
   13144          77 :   pari_sp av = avma;
   13145          77 :   GEN LG = NULL;
   13146          77 :   if (!checkMF_i(mf) && !checkmf_i(F)) pari_err_TYPE("mfgaloisrep", F);
   13147          77 :   switch( itos(mfgaloistype(mf,F)) )
   13148             :   {
   13149          49 :     case 0: case -12:
   13150          49 :       LG = mkvec2(mkvecsmall2(3,1), mkvecsmall2(2,2)); break;
   13151          28 :     case -24:
   13152          28 :       LG = mkvec3(mkvecsmall2(2,1), mkvecsmall2(3,1), mkvecsmall2(2,2)); break;
   13153           0 :     case -60: return gerepilecopy(av, search_A5(mf, F));
   13154           0 :     default: pari_err_IMPL("mfgaloisprojrep for types D_n");
   13155             :   }
   13156          77 :   return gerepilecopy(av, search_solvable(LG, mf, F, prec));
   13157             : }

Generated by: LCOV version 1.14