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 - modsym.c (source / functions) Hit Total Coverage
Test: PARI/GP v2.18.1 lcov report (development 30316-0578a48613) Lines: 2815 3016 93.3 %
Date: 2025-05-31 09:20:01 Functions: 295 301 98.0 %
Legend: Lines: hit not hit

          Line data    Source code
       1             : /* Copyright (C) 2011  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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
      14             : 
      15             : #include "pari.h"
      16             : #include "paripriv.h"
      17             : 
      18             : #define DEBUGLEVEL DEBUGLEVEL_ms
      19             : 
      20             : /* Adapted from shp_package/moments by Robert Pollack
      21             :  * http://www.math.mcgill.ca/darmon/programs/shp/shp.html */
      22             : static GEN mskinit(ulong N, long k, long sign);
      23             : static GEN mshecke_i(GEN W, ulong p);
      24             : static GEN ZSl2_star(GEN v);
      25             : static GEN getMorphism(GEN W1, GEN W2, GEN v);
      26             : static GEN voo_act_Gl2Q(GEN g, long k);
      27             : 
      28             : /* Input: P^1(Z/NZ) (formed by create_p1mod)
      29             :    Output: # P^1(Z/NZ) */
      30             : static long
      31       16912 : p1_size(GEN p1N) { return lg(gel(p1N,1)) - 1; }
      32             : static ulong
      33    58034571 : p1N_get_N(GEN p1N) { return gel(p1N,3)[2]; }
      34             : static GEN
      35    26970132 : p1N_get_hash(GEN p1N) { return gel(p1N,2); }
      36             : static GEN
      37        4368 : p1N_get_fa(GEN p1N) { return gel(p1N,4); }
      38             : static GEN
      39        4256 : p1N_get_div(GEN p1N) { return gel(p1N,5); }
      40             : static GEN
      41    24172918 : p1N_get_invsafe(GEN p1N) { return gel(p1N,6); }
      42             : static GEN
      43     8018752 : p1N_get_inverse(GEN p1N) { return gel(p1N,7); }
      44             : 
      45             : /* ms-specific accessors */
      46             : /* W = msinit, return the output of msinit_N */
      47             : static GEN
      48     5446287 : get_msN(GEN W) { return lg(W) == 4? gel(W,1): W; }
      49             : static GEN
      50     3257100 : msN_get_p1N(GEN W) { return gel(W,1); }
      51             : static GEN
      52      213969 : msN_get_genindex(GEN W) { return gel(W,5); }
      53             : static GEN
      54    42388682 : msN_get_E2fromE1(GEN W) { return gel(W,7); }
      55             : static GEN
      56        1393 : msN_get_annT2(GEN W) { return gel(W,8); }
      57             : static GEN
      58        1393 : msN_get_annT31(GEN W) { return gel(W,9); }
      59             : static GEN
      60        1358 : msN_get_singlerel(GEN W) { return gel(W,10); }
      61             : static GEN
      62      926352 : msN_get_section(GEN W) { return gel(W,12); }
      63             : 
      64             : static GEN
      65      122003 : ms_get_p1N(GEN W) { return msN_get_p1N(get_msN(W)); }
      66             : static long
      67       96523 : ms_get_N(GEN W) { return p1N_get_N(ms_get_p1N(W)); }
      68             : static GEN
      69        1680 : ms_get_hashcusps(GEN W) { W = get_msN(W); return gel(W,16); }
      70             : static GEN
      71       29953 : ms_get_section(GEN W) { return msN_get_section(get_msN(W)); }
      72             : static GEN
      73      204050 : ms_get_genindex(GEN W) { return msN_get_genindex(get_msN(W)); }
      74             : static long
      75      199444 : ms_get_nbgen(GEN W) { return lg(ms_get_genindex(W))-1; }
      76             : static long
      77     2618315 : ms_get_nbE1(GEN W)
      78             : {
      79             :   GEN W11;
      80     2618315 :   W = get_msN(W); W11 = gel(W,11);
      81     2618315 :   return W11[4] - W11[3];
      82             : }
      83             : 
      84             : /* msk-specific accessors */
      85             : static long
      86         126 : msk_get_dim(GEN W) { return gmael(W,3,2)[2]; }
      87             : static GEN
      88       82516 : msk_get_basis(GEN W) { return gmael(W,3,1); }
      89             : static long
      90      130613 : msk_get_weight(GEN W) { return gmael(W,3,2)[1]; }
      91             : static long
      92       59724 : msk_get_sign(GEN W)
      93             : {
      94       59724 :   GEN t = gel(W,2);
      95       59724 :   return typ(t)==t_INT? 0: itos(gel(t,1));
      96             : }
      97             : static GEN
      98        3101 : msk_get_star(GEN W) { return gmael(W,2,2); }
      99             : static GEN
     100        3710 : msk_get_starproj(GEN W) { return gmael(W,2,3); }
     101             : 
     102             : static int
     103        2576 : is_Qevproj(GEN x)
     104        2576 : { return typ(x) == t_VEC && lg(x) == 5 && typ(gel(x,1)) == t_MAT; }
     105             : long
     106         224 : msdim(GEN W)
     107             : {
     108         224 :   if (is_Qevproj(W)) return lg(gel(W,1)) - 1;
     109         210 :   checkms(W);
     110         203 :   if (!msk_get_sign(W)) return msk_get_dim(W);
     111          91 :   return lg(gel(msk_get_starproj(W), 1)) - 1;
     112             : }
     113             : long
     114          14 : msgetlevel(GEN W) { checkms(W); return ms_get_N(W); }
     115             : long
     116          14 : msgetweight(GEN W) { checkms(W); return msk_get_weight(W); }
     117             : long
     118          28 : msgetsign(GEN W) { checkms(W); return msk_get_sign(W); }
     119             : 
     120             : void
     121       79135 : checkms(GEN W)
     122             : {
     123       79135 :   if (typ(W) != t_VEC || lg(W) != 4
     124       79135 :       || typ(gel(W,1)) != t_VEC || lg(gel(W,1)) != 17)
     125           7 :     pari_err_TYPE("checkms [please apply msinit]", W);
     126       79128 : }
     127             : 
     128             : /** MODULAR TO SYM **/
     129             : 
     130             : /* q a t_FRAC or t_INT */
     131             : static GEN
     132     2246944 : Q_log_init(ulong N, GEN q)
     133             : {
     134             :   long l, n;
     135             :   GEN Q;
     136             : 
     137     2246944 :   q = gboundcf(q, 0);
     138     2246944 :   l = lg(q);
     139     2246944 :   Q = cgetg(l, t_VECSMALL);
     140     2246944 :   Q[1] = 1;
     141    21386904 :   for (n=2; n <l; n++) Q[n] = umodiu(gel(q,n), N);
     142    19145098 :   for (n=3; n < l; n++)
     143    16898154 :     Q[n] = Fl_add(Fl_mul(Q[n], Q[n-1], N), Q[n-2], N);
     144     2246944 :   return Q;
     145             : }
     146             : 
     147             : /** INIT MODSYM STRUCTURE, WEIGHT 2 **/
     148             : 
     149             : /* num = [Gamma : Gamma_0(N)] = N * Prod_{p|N} (1+p^-1) */
     150             : static ulong
     151        4256 : count_Manin_symbols(ulong N, GEN P)
     152             : {
     153        4256 :   long i, l = lg(P);
     154        4256 :   ulong num = N;
     155       12019 :   for (i = 1; i < l; i++) { ulong p = P[i]; num *= p+1; num /= p; }
     156        4256 :   return num;
     157             : }
     158             : /* returns the list of "Manin symbols" (c,d) in (Z/NZ)^2, (c,d,N) = 1
     159             :  * generating H^1(X_0(N), Z) */
     160             : static GEN
     161        4256 : generatemsymbols(ulong N, ulong num, GEN divN)
     162             : {
     163        4256 :   GEN ret = cgetg(num+1, t_VEC);
     164        4256 :   ulong c, d, curn = 0;
     165             :   long i, l;
     166             :   /* generate Manin-symbols in two lists: */
     167             :   /* list 1: (c:1) for 0 <= c < N */
     168      358232 :   for (c = 0; c < N; c++) gel(ret, ++curn) = mkvecsmall2(c, 1);
     169        4256 :   if (N == 1) return ret;
     170             :   /* list 2: (c:d) with 1 <= c < N, c | N, 0 <= d < N, gcd(d,N) > 1, gcd(c,d)=1.
     171             :    * Furthermore, d != d0 (mod N/c) with c,d0 already in the list */
     172        4228 :   l = lg(divN) - 1;
     173             :   /* c = 1 first */
     174        4228 :   gel(ret, ++curn) = mkvecsmall2(1,0);
     175      349720 :   for (d = 2; d < N; d++)
     176      345492 :     if (ugcd(d,N) != 1UL)
     177      141806 :       gel(ret, ++curn) = mkvecsmall2(1,d);
     178             :   /* omit c = 1 (first) and c = N (last) */
     179       17969 :   for (i=2; i < l; i++)
     180             :   {
     181             :     ulong Novc, d0;
     182       13741 :     c = divN[i];
     183       13741 :     Novc = N / c;
     184      230118 :     for (d0 = 2; d0 <= Novc; d0++)
     185             :     {
     186      216377 :       ulong k, d = d0;
     187      216377 :       if (ugcd(d, Novc) == 1UL) continue;
     188      320397 :       for (k = 0; k < c; k++, d += Novc)
     189      286405 :         if (ugcd(c,d) == 1UL)
     190             :         {
     191       54320 :           gel(ret, ++curn) = mkvecsmall2(c,d);
     192       54320 :           break;
     193             :         }
     194             :     }
     195             :   }
     196        4228 :   if (curn != num) pari_err_BUG("generatemsymbols [wrong number of symbols]");
     197        4228 :   return ret;
     198             : }
     199             : 
     200             : static GEN
     201        4256 : inithashmsymbols(ulong N, GEN symbols)
     202             : {
     203        4256 :   GEN H = zerovec(N);
     204        4256 :   long k, l = lg(symbols);
     205             :   /* skip the (c:1), 0 <= c < N and (1:0) */
     206      200382 :   for (k=N+2; k < l; k++)
     207             :   {
     208      196126 :     GEN s = gel(symbols, k);
     209      196126 :     ulong c = s[1], d = s[2], Novc = N/c;
     210      196126 :     if (gel(H,c) == gen_0) gel(H,c) = const_vecsmall(Novc+1,0);
     211      196126 :     if (c != 1) { d %= Novc; if (!d) d = Novc; }
     212      196126 :     mael(H, c, d) = k;
     213             :   }
     214        4256 :   return H;
     215             : }
     216             : 
     217             : /** Helper functions for Sl2(Z) / Gamma_0(N) **/
     218             : /* M a 2x2 ZM in SL2(Z) */
     219             : GEN
     220     1275477 : SL2_inv_shallow(GEN M)
     221             : {
     222     1275477 :   GEN a = gcoeff(M,1,1), b = gcoeff(M,1,2);
     223     1275477 :   GEN c = gcoeff(M,2,1), d = gcoeff(M,2,2);
     224     1275477 :   retmkmat22(d,negi(b), negi(c),a);
     225             : }
     226             : /* SL2_inv(M)[2] */
     227             : static GEN
     228       41804 : SL2_inv2(GEN M)
     229             : {
     230       41804 :   GEN a = gcoeff(M,1,1), b = gcoeff(M,1,2);
     231       41804 :   return mkcol2(negi(b),a);
     232             : }
     233             : /* M a 2x2 mat2 in SL2(Z) */
     234             : static GEN
     235      886529 : sl2_inv(GEN M)
     236             : {
     237      886529 :   long a=coeff(M,1,1), b=coeff(M,1,2), c=coeff(M,2,1), d=coeff(M,2,2);
     238      886529 :   return mkvec2(mkvecsmall2(d, -c), mkvecsmall2(-b, a));
     239             : }
     240             : /* Return the mat2 [a,b; c,d], not a zm to avoid GP problems */
     241             : static GEN
     242     3136735 : mat2(long a, long b, long c, long d)
     243     3136735 : { return mkvec2(mkvecsmall2(a,c), mkvecsmall2(b,d)); }
     244             : static GEN
     245      633346 : mat2_to_ZM(GEN M)
     246             : {
     247      633346 :   GEN A = gel(M,1), B = gel(M,2);
     248      633346 :   retmkmat2(mkcol2s(A[1],A[2]), mkcol2s(B[1],B[2]));
     249             : }
     250             : 
     251             : /* Input: a = 2-vector = path = {r/s,x/y}
     252             :  * Output: either [r,x;s,y] or [-r,x;-s,y], whichever has determinant > 0 */
     253             : static GEN
     254      194327 : path_to_ZM(GEN a)
     255             : {
     256      194327 :   GEN v = gel(a,1), w = gel(a,2);
     257      194327 :   long r = v[1], s = v[2], x = w[1], y = w[2];
     258      194327 :   if (cmpii(mulss(r,y), mulss(x,s)) < 0) { r = -r; s = -s; }
     259      194327 :   return mkmat22s(r,x,s,y);
     260             : }
     261             : static GEN
     262     1954169 : path_to_zm(GEN a)
     263             : {
     264     1954169 :   GEN v = gel(a,1), w = gel(a,2);
     265     1954169 :   long r = v[1], s = v[2], x = w[1], y = w[2];
     266     1954169 :   if (cmpii(mulss(r,y), mulss(x,s)) < 0) { r = -r; s = -s; }
     267     1954169 :   return mat2(r,x,s,y);
     268             : }
     269             : /* path from c1 to c2 */
     270             : static GEN
     271     1124039 : mkpath(GEN c1, GEN c2) { return mat2(c1[1], c2[1], c1[2], c2[2]); }
     272             : static long
     273     1589847 : cc(GEN M) { GEN v = gel(M,1); return v[2]; }
     274             : static long
     275     1589847 : dd(GEN M) { GEN v = gel(M,2); return v[2]; }
     276             : 
     277             : /*Input: a,b = 2 paths, N = integer
     278             :  *Output: 1 if the a,b are \Gamma_0(N)-equivalent; 0 otherwise */
     279             : static int
     280      182798 : gamma_equiv(GEN a, GEN b, ulong N)
     281             : {
     282      182798 :   pari_sp av = avma;
     283      182798 :   GEN m = path_to_zm(a);
     284      182798 :   GEN n = path_to_zm(b);
     285      182798 :   GEN d = subii(mulss(cc(m),dd(n)), mulss(dd(m),cc(n)));
     286      182798 :   return gc_bool(av, umodiu(d, N) == 0);
     287             : }
     288             : /* Input: a,b = 2 paths that are \Gamma_0(N)-equivalent, N = integer
     289             :  * Output: M in \Gamma_0(N) such that Mb=a */
     290             : static GEN
     291       96425 : gamma_equiv_matrix(GEN a, GEN b)
     292             : {
     293       96425 :   GEN m = path_to_ZM(a);
     294       96425 :   GEN n = path_to_ZM(b);
     295       96425 :   return ZM_mul(m, SL2_inv_shallow(n));
     296             : }
     297             : 
     298             : /*************/
     299             : /* P^1(Z/NZ) */
     300             : /*************/
     301             : /* a != 0 in Z/NZ. Return v in (Z/NZ)^* such that av = gcd(a, N) (mod N)*/
     302             : static ulong
     303      551481 : Fl_inverse(ulong a, ulong N) { ulong g; return Fl_invgen(a,N,&g); }
     304             : 
     305             : /* Input: N = integer
     306             :  * Output: creates P^1(Z/NZ) = [symbols, H, N]
     307             :  *   symbols: list of vectors [x,y] that give a set of representatives
     308             :  *            of P^1(Z/NZ)
     309             :  *   H: an M by M grid whose value at the r,c-th place is the index of the
     310             :  *      "standard representative" equivalent to [r,c] occurring in the first
     311             :  *      list. If gcd(r,c,N) > 1 the grid has value 0. */
     312             : static GEN
     313        4256 : create_p1mod(ulong N)
     314             : {
     315        4256 :   GEN fa = factoru(N), div = divisorsu_fact(fa);
     316        4256 :   ulong i, nsym = count_Manin_symbols(N, gel(fa,1));
     317        4256 :   GEN symbols = generatemsymbols(N, nsym, div);
     318        4256 :   GEN H = inithashmsymbols(N,symbols);
     319        4256 :   GEN invsafe = cgetg(N, t_VECSMALL), inverse = cgetg(N, t_VECSMALL);
     320      353976 :   for (i = 1; i < N; i++)
     321             :   {
     322      349720 :     invsafe[i] = Fl_invsafe(i,N);
     323      349720 :     inverse[i] = Fl_inverse(i,N);
     324             :   }
     325        4256 :   return mkvecn(7, symbols, H, utoipos(N), fa, div, invsafe, inverse);
     326             : }
     327             : 
     328             : /* Let (c : d) in P1(Z/NZ).
     329             :  * If c = 0 return (0:1). If d = 0 return (1:0).
     330             :  * Else replace by (cu : du), where u in (Z/NZ)^* such that C := cu = gcd(c,N).
     331             :  * In create_p1mod(), (c : d) is represented by (C:D) where D = du (mod N/c)
     332             :  * is smallest such that gcd(C,D) = 1. Return (C : du mod N/c), which need
     333             :  * not belong to P1(Z/NZ) ! A second component du mod N/c = 0 is replaced by
     334             :  * N/c in this case to avoid problems with array indices */
     335             : static void
     336    26970132 : p1_std_form(long *pc, long *pd, GEN p1N)
     337             : {
     338    26970132 :   ulong N = p1N_get_N(p1N);
     339             :   ulong u;
     340    26970132 :   *pc = umodsu(*pc, N); if (!*pc) { *pd = 1; return; }
     341    24448039 :   *pd = umodsu(*pd, N); if (!*pd) { *pc = 1; return; }
     342    24172918 :   u = p1N_get_invsafe(p1N)[*pd];
     343    24172918 :   if (u) { *pc = Fl_mul(*pc,u,N); *pd = 1; return; } /* (d,N) = 1 */
     344             : 
     345     8018752 :   u = p1N_get_inverse(p1N)[*pc];
     346     8018752 :   if (u > 1) { *pc = Fl_mul(*pc,u,N); *pd = Fl_mul(*pd,u,N); }
     347             :   /* c | N */
     348     8018752 :   if (*pc != 1) *pd %= (N / *pc);
     349     8018752 :   if (!*pd) *pd = N / *pc;
     350             : }
     351             : 
     352             : /* Input: v = [x,y] = elt of P^1(Z/NZ) = class in Gamma_0(N) \ PSL2(Z)
     353             :  * Output: returns the index of the standard rep equivalent to v */
     354             : static long
     355    26970132 : p1_index(long x, long y, GEN p1N)
     356             : {
     357    26970132 :   ulong N = p1N_get_N(p1N);
     358    26970132 :   GEN H = p1N_get_hash(p1N);
     359             : 
     360    26970132 :   p1_std_form(&x, &y, p1N);
     361    26970132 :   if (y == 1) return x+1;
     362     8293873 :   if (y == 0) return N+1;
     363     8018752 :   if (mael(H,x,y) == 0) pari_err_BUG("p1_index");
     364     8018752 :   return mael(H,x,y);
     365             : }
     366             : 
     367             : /* Cusps for \Gamma_0(N) */
     368             : 
     369             : /* \sum_{d | N} \phi(gcd(d, N/d)), using multiplicativity. fa = factor(N) */
     370             : ulong
     371        4340 : mfnumcuspsu_fact(GEN fa)
     372             : {
     373        4340 :   GEN P = gel(fa,1), E = gel(fa,2);
     374        4340 :   long i, l = lg(P);
     375        4340 :   ulong T = 1;
     376       12201 :   for (i = 1; i < l; i++)
     377             :   {
     378        7861 :     long e = E[i], e2 = e >> 1; /* floor(E[i] / 2) */
     379        7861 :     ulong p = P[i];
     380        7861 :     if (odd(e))
     381        6559 :       T *= 2 * upowuu(p, e2);
     382             :     else
     383        1302 :       T *= (p+1) * upowuu(p, e2-1);
     384             :   }
     385        4340 :   return T;
     386             : }
     387             : ulong
     388           7 : mfnumcuspsu(ulong n)
     389           7 : { pari_sp av = avma; return gc_ulong(av, mfnumcuspsu_fact( factoru(n) )); }
     390             : /* \sum_{d | N} \phi(gcd(d, N/d)), using multiplicativity. fa = factor(N) */
     391             : GEN
     392          14 : mfnumcusps_fact(GEN fa)
     393             : {
     394          14 :   GEN P = gel(fa,1), E = gel(fa,2), T = gen_1;
     395          14 :   long i, l = lg(P);
     396          35 :   for (i = 1; i < l; i++)
     397             :   {
     398          21 :     GEN p = gel(P,i), c;
     399          21 :     long e = itos(gel(E,i)), e2 = e >> 1; /* floor(E[i] / 2) */
     400          21 :     if (odd(e))
     401           0 :       c = shifti(powiu(p, e2), 1);
     402             :     else
     403          21 :       c = mulii(addiu(p,1), powiu(p, e2-1));
     404          21 :     T = T? mulii(T, c): c;
     405             :   }
     406          14 :   return T? T: gen_1;
     407             : }
     408             : GEN
     409          21 : mfnumcusps(GEN n)
     410             : {
     411          21 :   pari_sp av = avma;
     412          21 :   GEN F = check_arith_pos(n,"mfnumcusps");
     413          21 :   if (!F)
     414             :   {
     415          14 :     if (lgefint(n) == 3) return utoi( mfnumcuspsu(n[2]) );
     416           7 :     F = absZ_factor(n);
     417             :   }
     418          14 :   return gc_INT(av, mfnumcusps_fact(F));
     419             : }
     420             : 
     421             : /* to each cusp in \Gamma_0(N) P1(Q), represented by p/q, we associate a
     422             :  * unique index. Canonical representative: (1:0) or (p:q) with q | N, q < N,
     423             :  * p defined modulo d := gcd(N/q,q), (p,d) = 1.
     424             :  * Return [[N, nbcusps], H, cusps]*/
     425             : static GEN
     426        4256 : inithashcusps(GEN p1N)
     427             : {
     428        4256 :   ulong N = p1N_get_N(p1N);
     429        4256 :   GEN div = p1N_get_div(p1N), H = zerovec(N+1);
     430        4256 :   long k, ind, l = lg(div), ncusp = mfnumcuspsu_fact(p1N_get_fa(p1N));
     431        4256 :   GEN cusps = cgetg(ncusp+1, t_VEC);
     432             : 
     433        4256 :   gel(H,1) = mkvecsmall2(0/*empty*/, 1/* first cusp: (1:0) */);
     434        4256 :   gel(cusps, 1) = mkvecsmall2(1,0);
     435        4256 :   ind = 2;
     436       22225 :   for (k=1; k < l-1; k++) /* l-1: remove q = N */
     437             :   {
     438       17969 :     ulong p, q = div[k], d = ugcd(q, N/q);
     439       17969 :     GEN h = const_vecsmall(d+1,0);
     440       17969 :     gel(H,q+1) = h ;
     441       48034 :     for (p = 0; p < d; p++)
     442       30065 :       if (ugcd(p,d) == 1)
     443             :       {
     444       22925 :         h[p+1] = ind;
     445       22925 :         gel(cusps, ind) = mkvecsmall2(p,q);
     446       22925 :         ind++;
     447             :       }
     448             :   }
     449        4256 :   return mkvec3(mkvecsmall2(N,ind-1), H, cusps);
     450             : }
     451             : /* c = [p,q], (p,q) = 1, return a canonical representative for
     452             :  * \Gamma_0(N)(p/q) */
     453             : static GEN
     454      203469 : cusp_std_form(GEN c, GEN S)
     455             : {
     456      203469 :   long p, N = gel(S,1)[1], q = umodsu(c[2], N);
     457             :   ulong u, d;
     458      203469 :   if (q == 0) return mkvecsmall2(1, 0);
     459      201761 :   p = umodsu(c[1], N);
     460      201761 :   u = Fl_inverse(q, N);
     461      201761 :   q = Fl_mul(q,u, N);
     462      201761 :   d = ugcd(q, N/q);
     463      201761 :   return mkvecsmall2(Fl_div(p % d,u % d, d), q);
     464             : }
     465             : /* c = [p,q], (p,q) = 1, return the index of the corresponding cusp.
     466             :  * S from inithashcusps */
     467             : static ulong
     468      203469 : cusp_index(GEN c, GEN S)
     469             : {
     470             :   long p, q;
     471      203469 :   GEN H = gel(S,2);
     472      203469 :   c = cusp_std_form(c, S);
     473      203469 :   p = c[1]; q = c[2];
     474      203469 :   if (!mael(H,q+1,p+1)) pari_err_BUG("cusp_index");
     475      203469 :   return mael(H,q+1,p+1);
     476             : }
     477             : 
     478             : /* M a square invertible ZM, return a ZM iM such that iM M = M iM = d.Id */
     479             : static GEN
     480        3066 : ZM_inv_denom(GEN M)
     481             : {
     482        3066 :   GEN diM, iM = ZM_inv(M, &diM);
     483        3066 :   return mkvec2(iM, diM);
     484             : }
     485             : /* return M^(-1) v, dinv = ZM_inv_denom(M) OR Qevproj_init(M) */
     486             : static GEN
     487      744023 : ZC_apply_dinv(GEN dinv, GEN v)
     488             : {
     489             :   GEN x, c, iM;
     490      744023 :   if (lg(dinv) == 3)
     491             :   {
     492      665917 :     iM = gel(dinv,1);
     493      665917 :     c = gel(dinv,2);
     494             :   }
     495             :   else
     496             :   { /* Qevproj_init */
     497       78106 :     iM = gel(dinv,2);
     498       78106 :     c = gel(dinv,3);
     499       78106 :     v = typ(v) == t_MAT? rowpermute(v, gel(dinv,4))
     500       78106 :                        : vecpermute(v, gel(dinv,4));
     501             :   }
     502      744023 :   x = RgM_RgC_mul(iM, v);
     503      744023 :   if (!isint1(c)) x = RgC_Rg_div(x, c);
     504      744023 :   return x;
     505             : }
     506             : 
     507             : /* M an n x d ZM of rank d (basis of a Q-subspace), n >= d.
     508             :  * Initialize a projector on M */
     509             : GEN
     510        8554 : Qevproj_init(GEN M)
     511             : {
     512             :   GEN v, perm, MM, iM, diM;
     513        8554 :   v = ZM_indexrank(M); perm = gel(v,1);
     514        8554 :   MM = rowpermute(M, perm); /* square invertible */
     515        8554 :   iM = ZM_inv(MM, &diM);
     516        8554 :   return mkvec4(M, iM, diM, perm);
     517             : }
     518             : 
     519             : /* same with typechecks */
     520             : static GEN
     521         728 : Qevproj_init0(GEN M)
     522             : {
     523         728 :   switch(typ(M))
     524             :   {
     525         665 :     case t_VEC:
     526         665 :       if (lg(M) == 5) return M;
     527           0 :       break;
     528          49 :     case t_COL:
     529          49 :       M = mkmat(M);/*fall through*/
     530          56 :     case t_MAT:
     531          56 :       M = Q_primpart(M);
     532          56 :       RgM_check_ZM(M,"Qevproj_init");
     533          56 :       return Qevproj_init(M);
     534             :   }
     535           7 :   pari_err_TYPE("Qevproj_init",M);
     536             :   return NULL;/*LCOV_EXCL_LINE*/
     537             : }
     538             : 
     539             : /* T an n x n QM, pro = Qevproj_init(M), pro2 = Qevproj_init(M2); TM \subset M2.
     540             :  * Express these column vectors on M2's basis */
     541             : static GEN
     542        3661 : Qevproj_apply2(GEN T, GEN pro, GEN pro2)
     543             : {
     544        3661 :   GEN M = gel(pro,1), iM = gel(pro2,2), ciM = gel(pro2,3), perm = gel(pro2,4);
     545        3661 :   return RgM_Rg_div(RgM_mul(iM, RgM_mul(rowpermute(T,perm), M)), ciM);
     546             : }
     547             : /* T an n x n QM, stabilizing d-dimensional Q-vector space spanned by the
     548             :  * d columns of M, pro = Qevproj_init(M). Return dxd matrix of T acting on M */
     549             : GEN
     550        3031 : Qevproj_apply(GEN T, GEN pro) { return Qevproj_apply2(T, pro, pro); }
     551             : /* Qevproj_apply(T,pro)[,k] */
     552             : GEN
     553         819 : Qevproj_apply_vecei(GEN T, GEN pro, long k)
     554             : {
     555         819 :   GEN M = gel(pro,1), iM = gel(pro,2), ciM = gel(pro,3), perm = gel(pro,4);
     556         819 :   GEN v = RgM_RgC_mul(iM, RgM_RgC_mul(rowpermute(T,perm), gel(M,k)));
     557         819 :   return RgC_Rg_div(v, ciM);
     558             : }
     559             : 
     560             : static int
     561         434 : cmp_dim(void *E, GEN a, GEN b)
     562             : {
     563             :   long k;
     564             :   (void)E;
     565         434 :   a = gel(a,1);
     566         434 :   b = gel(b,1); k = lg(a)-lg(b);
     567         434 :   return k? ((k > 0)? 1: -1): 0;
     568             : }
     569             : 
     570             : /* FIXME: could use ZX_roots for deglim = 1 */
     571             : static GEN
     572         343 : ZX_factor_limit(GEN T, long deglim, long *pl)
     573             : {
     574         343 :   GEN fa = ZX_factor(T), P, E;
     575             :   long i, l;
     576         343 :   P = gel(fa,1); *pl = l = lg(P);
     577         343 :   if (deglim <= 0) return fa;
     578         224 :   E = gel(fa,2);
     579         567 :   for (i = 1; i < l; i++)
     580         406 :     if (degpol(gel(P,i)) > deglim) break;
     581         224 :   setlg(P,i);
     582         224 :   setlg(E,i); return fa;
     583             : }
     584             : 
     585             : /* Decompose the subspace H (Qevproj format) in simple subspaces.
     586             :  * Eg for H = msnew */
     587             : static GEN
     588         266 : mssplit_i(GEN W, GEN H, long deglim)
     589             : {
     590         266 :   ulong p, N = ms_get_N(W);
     591             :   long first, dim;
     592             :   forprime_t S;
     593         266 :   GEN T1 = NULL, T2 = NULL, V;
     594         266 :   dim = lg(gel(H,1))-1;
     595         266 :   V = vectrunc_init(dim+1);
     596         266 :   if (!dim) return V;
     597         259 :   (void)u_forprime_init(&S, 2, ULONG_MAX);
     598         259 :   vectrunc_append(V, H);
     599         259 :   first = 1; /* V[1..first-1] contains simple subspaces */
     600         399 :   while ((p = u_forprime_next(&S)))
     601             :   {
     602             :     GEN T;
     603             :     long j, lV;
     604         399 :     if (N % p == 0) continue;
     605         336 :     if (T1 && T2) {
     606          21 :       T = RgM_add(T1,T2);
     607          21 :       T2 = NULL;
     608             :     } else {
     609         315 :       T2 = T1;
     610         315 :       T1 = T = mshecke(W, p, NULL);
     611             :     }
     612         336 :     lV = lg(V);
     613         679 :     for (j = first; j < lV; j++)
     614             :     {
     615         343 :       pari_sp av = avma;
     616             :       long lP;
     617         343 :       GEN Vj = gel(V,j), P = gel(Vj,1);
     618         343 :       GEN TVj = Qevproj_apply(T, Vj); /* c T | V_j */
     619         343 :       GEN ch = QM_charpoly_ZX(TVj), fa = ZX_factor_limit(ch,deglim, &lP);
     620         343 :       GEN F = gel(fa, 1), E = gel(fa, 2);
     621         343 :       long k, lF = lg(F);
     622         343 :       if (lF == 2 && lP == 2)
     623             :       {
     624         168 :         if (equali1(gel(E,1)))
     625             :         { /* simple subspace */
     626         168 :           swap(gel(V,first), gel(V,j));
     627         168 :           first++;
     628             :         }
     629             :         else
     630           0 :           set_avma(av);
     631             :       }
     632         175 :       else if (lF == 1) /* discard V[j] */
     633           7 :       { swap(gel(V,j), gel(V,lg(V)-1)); setlg(V, lg(V)-1); }
     634             :       else
     635             :       { /* can split Vj */
     636             :         GEN pows;
     637         168 :         long D = 1;
     638         658 :         for (k = 1; k < lF; k++)
     639             :         {
     640         490 :           long d = degpol(gel(F,k));
     641         490 :           if (d > D) D = d;
     642             :         }
     643             :         /* remove V[j] */
     644         168 :         gel(V,j) = gel(V,lg(V)-1); setlg(V, lg(V)-1);
     645         168 :         pows = RgM_powers(TVj, minss((long)2*sqrt((double)D), D));
     646         658 :         for (k = 1; k < lF; k++)
     647             :         {
     648         490 :           GEN f = gel(F,k);
     649         490 :           GEN K = QM_ker( RgX_RgMV_eval(f, pows)) ; /* Ker f(TVj) */
     650         490 :           GEN p = vec_Q_primpart( RgM_mul(P, K) );
     651         490 :           vectrunc_append(V, Qevproj_init(p));
     652         490 :           if (lg(K) == 2 || isint1(gel(E,k)))
     653             :           { /* simple subspace */
     654         406 :             swap(gel(V,first), gel(V, lg(V)-1));
     655         406 :             first++;
     656             :           }
     657             :         }
     658         168 :         if (j < first) j = first;
     659             :       }
     660             :     }
     661         336 :     if (first >= lg(V)) {
     662         259 :       gen_sort_inplace(V, NULL, cmp_dim, NULL);
     663         259 :       return V;
     664             :     }
     665             :   }
     666           0 :   pari_err_BUG("subspaces not found");
     667             :   return NULL;/*LCOV_EXCL_LINE*/
     668             : }
     669             : GEN
     670         266 : mssplit(GEN W, GEN H, long deglim)
     671             : {
     672         266 :   pari_sp av = avma;
     673         266 :   checkms(W);
     674         266 :   if (!msk_get_sign(W))
     675           0 :     pari_err_DOMAIN("mssplit","abs(sign)","!=",gen_1,gen_0);
     676         266 :   if (!H) H = msnew(W);
     677         266 :   H = Qevproj_init0(H);
     678         266 :   return gc_GEN(av, mssplit_i(W,H,deglim));
     679             : }
     680             : 
     681             : /* proV = Qevproj_init of a Hecke simple subspace, return [ a_n, n <= B ] */
     682             : static GEN
     683         245 : msqexpansion_i(GEN W, GEN proV, ulong B)
     684             : {
     685         245 :   ulong p, N = ms_get_N(W), sqrtB;
     686         245 :   long i, d, k = msk_get_weight(W);
     687             :   forprime_t S;
     688         245 :   GEN T1=NULL, T2=NULL, TV=NULL, ch=NULL, v, dTiv, Tiv, diM, iM, L;
     689         245 :   switch(B)
     690             :   {
     691           0 :     case 0: return cgetg(1,t_VEC);
     692           0 :     case 1: return mkvec(gen_1);
     693             :   }
     694         245 :   (void)u_forprime_init(&S, 2, ULONG_MAX);
     695         357 :   while ((p = u_forprime_next(&S)))
     696             :   {
     697             :     GEN T;
     698         357 :     if (N % p == 0) continue;
     699         266 :     if (T1 && T2)
     700             :     {
     701           0 :       T = RgM_add(T1,T2);
     702           0 :       T2 = NULL;
     703             :     }
     704             :     else
     705             :     {
     706         266 :       T2 = T1;
     707         266 :       T1 = T = mshecke(W, p, NULL);
     708             :     }
     709         266 :     TV = Qevproj_apply(T, proV); /* T | V */
     710         266 :     ch = QM_charpoly_ZX(TV);
     711         266 :     if (ZX_is_irred(ch)) break;
     712          21 :     ch = NULL;
     713             :   }
     714         245 :   if (!ch) pari_err_BUG("q-Expansion not found");
     715             :   /* T generates the Hecke algebra (acting on V) */
     716         245 :   d = degpol(ch);
     717         245 :   v = vec_ei(d, 1); /* take v = e_1 */
     718         245 :   Tiv = cgetg(d+1, t_MAT); /* Tiv[i] = T^(i-1)v */
     719         245 :   gel(Tiv, 1) = v;
     720         343 :   for (i = 2; i <= d; i++) gel(Tiv, i) = RgM_RgC_mul(TV, gel(Tiv,i-1));
     721         245 :   Tiv = Q_remove_denom(Tiv, &dTiv);
     722         245 :   iM = ZM_inv(Tiv, &diM);
     723         245 :   if (dTiv) diM = gdiv(diM, dTiv);
     724         245 :   L = const_vec(B,NULL);
     725         245 :   sqrtB = usqrt(B);
     726         245 :   gel(L,1) = d > 1? mkpolmod(gen_1,ch): gen_1;
     727        2471 :   for (p = 2; p <= B; p++)
     728             :   {
     729        2226 :     pari_sp av = avma;
     730             :     GEN T, u, Tv, ap, P;
     731             :     ulong m;
     732        2226 :     if (gel(L,p)) continue;  /* p not prime */
     733         819 :     T = mshecke(W, p, NULL);
     734         819 :     Tv = Qevproj_apply_vecei(T, proV, 1); /* Tp.v */
     735             :     /* Write Tp.v = \sum u_i T^i v */
     736         819 :     u = RgC_Rg_div(RgM_RgC_mul(iM, Tv), diM);
     737         819 :     ap = gc_GEN(av, RgV_to_RgX(u, 0));
     738         819 :     if (d > 1)
     739         399 :       ap = mkpolmod(ap,ch);
     740             :     else
     741         420 :       ap = simplify_shallow(ap);
     742         819 :     gel(L,p) = ap;
     743         819 :     if (!(N % p))
     744         147 :     { /* p divides the level */
     745         147 :       ulong C = B/p;
     746         546 :       for (m=1; m<=C; m++)
     747         399 :         if (gel(L,m)) gel(L,m*p) = gmul(gel(L,m), ap);
     748         147 :       continue;
     749             :     }
     750         672 :     P = powuu(p,k-1);
     751         672 :     if (p <= sqrtB) {
     752         119 :       ulong pj, oldpj = 1;
     753         546 :       for (pj = p; pj <= B; oldpj=pj, pj *= p)
     754             :       {
     755         427 :         GEN apj = (pj==p)? ap
     756         427 :                          : gsub(gmul(ap,gel(L,oldpj)), gmul(P,gel(L,oldpj/p)));
     757         427 :         gel(L,pj) = apj;
     758        3136 :         for (m = B/pj; m > 1; m--)
     759        2709 :           if (gel(L,m) && m%p) gel(L,m*pj) = gmul(gel(L,m), apj);
     760             :       }
     761             :     } else {
     762         553 :       gel(L,p) = ap;
     763        1092 :       for (m = B/p; m > 1; m--)
     764         539 :         if (gel(L,m)) gel(L,m*p) = gmul(gel(L,m), ap);
     765             :     }
     766             :   }
     767         245 :   return L;
     768             : }
     769             : GEN
     770         259 : msqexpansion(GEN W, GEN proV, long B)
     771             : {
     772         259 :   pari_sp av = avma;
     773         259 :   checkms(W);
     774         259 :   if (B < 0) pari_err_DOMAIN("msqexpansion", "B", "<", gen_0, stoi(B));
     775         252 :   proV = Qevproj_init0(proV);
     776         245 :   return gc_GEN(av, msqexpansion_i(W,proV,(ulong)B));
     777             : }
     778             : 
     779             : static GEN
     780         217 : Qevproj_apply0(GEN T, GEN pro)
     781             : {
     782         217 :   GEN iM = gel(pro,2), perm = gel(pro,4);
     783         217 :   return vec_Q_primpart(ZM_mul(iM, rowpermute(T,perm)));
     784             : }
     785             : /* T a ZC or ZM */
     786             : GEN
     787        4186 : Qevproj_down(GEN T, GEN pro)
     788             : {
     789        4186 :   GEN iM = gel(pro,2), ciM = gel(pro,3), perm = gel(pro,4);
     790        4186 :   if (typ(T) == t_COL)
     791        4186 :     return RgC_Rg_div(ZM_ZC_mul(iM, vecpermute(T,perm)), ciM);
     792             :   else
     793           0 :     return RgM_Rg_div(ZM_mul(iM, rowpermute(T,perm)), ciM);
     794             : }
     795             : 
     796             : static GEN
     797         287 : Qevproj_star(GEN W, GEN H)
     798             : {
     799         287 :   long s = msk_get_sign(W);
     800         287 :   if (s)
     801             :   { /* project on +/- component */
     802         217 :     GEN A = RgM_mul(msk_get_star(W), H);
     803         217 :     A = (s > 0)? gadd(A, H): gsub(A, H);
     804             :     /* Im(star + sign) = Ker(star - sign) */
     805         217 :     H = QM_image_shallow(A);
     806         217 :     H = Qevproj_apply0(H, msk_get_starproj(W));
     807             :   }
     808         287 :   return H;
     809             : }
     810             : 
     811             : static GEN
     812        5824 : Tp_matrices(ulong p)
     813             : {
     814        5824 :   GEN v = cgetg(p+2, t_VEC);
     815             :   ulong i;
     816       44429 :   for (i = 1; i <= p; i++) gel(v,i) = mat2(1, i-1, 0, p);
     817        5824 :   gel(v,i) = mat2(p, 0, 0, 1);
     818        5824 :   return v;
     819             : }
     820             : static GEN
     821         987 : Up_matrices(ulong p)
     822             : {
     823         987 :   GEN v = cgetg(p+1, t_VEC);
     824             :   ulong i;
     825        6300 :   for (i = 1; i <= p; i++) gel(v,i) = mat2(1, i-1, 0, p);
     826         987 :   return v;
     827             : }
     828             : 
     829             : /* M = N/p. Classes of Gamma_0(M) / Gamma_O(N) when p | M */
     830             : static GEN
     831         182 : NP_matrices(ulong M, ulong p)
     832             : {
     833         182 :   GEN v = cgetg(p+1, t_VEC);
     834             :   ulong i;
     835        1365 :   for (i = 1; i <= p; i++) gel(v,i) = mat2(1, 0, (i-1)*M, 1);
     836         182 :   return v;
     837             : }
     838             : /* M = N/p. Extra class of Gamma_0(M) / Gamma_O(N) when p \nmid M */
     839             : static GEN
     840          98 : NP_matrix_extra(ulong M, ulong p)
     841             : {
     842          98 :   long w,z, d = cbezout(p, -M, &w, &z);
     843          98 :   if (d != 1) return NULL;
     844          98 :   return mat2(w,z,M,p);
     845             : }
     846             : static GEN
     847         112 : WQ_matrix(long N, long Q)
     848             : {
     849         112 :   long w,z, d = cbezout(Q, N/Q, &w, &z);
     850         112 :   if (d != 1) return NULL;
     851         112 :   return mat2(Q,1,-N*z,Q*w);
     852             : }
     853             : 
     854             : GEN
     855         287 : msnew(GEN W)
     856             : {
     857         287 :   pari_sp av = avma;
     858         287 :   GEN S = mscuspidal(W, 0);
     859         287 :   ulong N = ms_get_N(W);
     860         287 :   long s = msk_get_sign(W), k = msk_get_weight(W);
     861         287 :   if (N > 1 && (!uisprime(N) || (k == 12 || k > 14)))
     862             :   {
     863         112 :     GEN p1N = ms_get_p1N(W), P = gel(p1N_get_fa(p1N), 1);
     864         112 :     long i, nP = lg(P)-1;
     865         112 :     GEN v = cgetg(2*nP + 1, t_COL);
     866         112 :     S = gel(S,1); /* Q basis */
     867         294 :     for (i = 1; i <= nP; i++)
     868             :     {
     869         182 :       pari_sp av = avma, av2;
     870         182 :       long M = N/P[i];
     871         182 :       GEN T1,Td, Wi = mskinit(M, k, s);
     872         182 :       GEN v1 = NP_matrices(M, P[i]);
     873         182 :       GEN vd = Up_matrices(P[i]);
     874             :       /* p^2 \nmid N */
     875         182 :       if (M % P[i])
     876             :       {
     877          98 :         v1 = vec_append(v1, NP_matrix_extra(M,P[i]));
     878          98 :         vd = vec_append(vd, WQ_matrix(N,P[i]));
     879             :       }
     880         182 :       T1 = getMorphism(W, Wi, v1);
     881         182 :       Td = getMorphism(W, Wi, vd);
     882         182 :       if (s)
     883             :       {
     884         168 :         T1 = Qevproj_apply2(T1, msk_get_starproj(W), msk_get_starproj(Wi));
     885         168 :         Td = Qevproj_apply2(Td, msk_get_starproj(W), msk_get_starproj(Wi));
     886             :       }
     887         182 :       av2 = avma;
     888         182 :       T1 = RgM_mul(T1,S);
     889         182 :       Td = RgM_mul(Td,S);  /* multiply by S = restrict to mscusp */
     890         182 :       gc_all_unsafe(av, av2, 2, &T1, &Td);
     891         182 :       gel(v,2*i-1) = T1;
     892         182 :       gel(v,2*i)   = Td;
     893             :     }
     894         112 :     S = ZM_mul(S, QM_ker(matconcat(v))); /* Snew */
     895         112 :     S = Qevproj_init(vec_Q_primpart(S));
     896             :   }
     897         287 :   return gc_GEN(av, S);
     898             : }
     899             : 
     900             : /* Solve the Manin relations for a congruence subgroup \Gamma by constructing
     901             :  * a well-formed fundamental domain for the action of \Gamma on upper half
     902             :  * space. See
     903             :  * Pollack and Stevens, Overconvergent modular symbols and p-adic L-functions
     904             :  * Annales scientifiques de l'ENS 44, fascicule 1 (2011), 1-42
     905             :  * http://math.bu.edu/people/rpollack/Papers/Overconvergent_modular_symbols_and_padic_Lfunctions.pdf
     906             :  *
     907             :  * FIXME: Implemented for \Gamma = \Gamma_0(N) only. */
     908             : 
     909             : /* linked lists */
     910             : typedef struct list_t { GEN data; struct list_t *next; } list_t;
     911             : static list_t *
     912      188503 : list_new(GEN x)
     913             : {
     914      188503 :   list_t *L = (list_t*)stack_malloc(sizeof(list_t));
     915      188503 :   L->data = x;
     916      188503 :   L->next = NULL; return L;
     917             : }
     918             : static void
     919      184275 : list_insert(list_t *L, GEN x)
     920             : {
     921      184275 :   list_t *l = list_new(x);
     922      184275 :   l->next = L->next;
     923      184275 :   L->next = l;
     924      184275 : }
     925             : 
     926             : /*Input: N > 1, p1N = P^1(Z/NZ)
     927             :  *Output: a connected fundamental domain for the action of \Gamma_0(N) on
     928             :  *  upper half space.  When \Gamma_0(N) is torsion free, the domain has the
     929             :  *  property that all of its vertices are cusps.  When \Gamma_0(N) has
     930             :  *  three-torsion, 2 extra triangles need to be added.
     931             :  *
     932             :  * The domain is constructed by beginning with the triangle with vertices 0,1
     933             :  * and oo.  Each adjacent triangle is successively tested to see if it contains
     934             :  * points not \Gamma_0(N) equivalent to some point in our region.  If a
     935             :  * triangle contains new points, it is added to the region.  This process is
     936             :  * continued until the region can no longer be extended (and still be a
     937             :  * fundamental domain) by added an adjacent triangle.  The list of cusps
     938             :  * between 0 and 1 are then returned
     939             :  *
     940             :  * Precisely, the function returns a list such that the elements of the list
     941             :  * with odd index are the cusps in increasing order.  The even elements of the
     942             :  * list are either an "x" or a "t".  A "t" represents that there is an element
     943             :  * of order three such that its fixed point is in the triangle directly
     944             :  * adjacent to the our region with vertices given by the cusp before and after
     945             :  * the "t".  The "x" represents that this is not the case. */
     946             : enum { type_X, type_DO /* ? */, type_T };
     947             : static GEN
     948        4228 : form_list_of_cusps(ulong N, GEN p1N)
     949             : {
     950        4228 :   pari_sp av = avma;
     951        4228 :   long i, position, nbC = 2;
     952             :   GEN v, L;
     953             :   list_t *C, *c;
     954             :   /* Let t be the index of a class in PSL2(Z) / \Gamma in our fixed enumeration
     955             :    * v[t] != 0 iff it is the class of z tau^r for z a previous alpha_i
     956             :    * or beta_i.
     957             :    * For \Gamma = \Gamma_0(N), the enumeration is given by p1_index.
     958             :    * We write cl(gamma) = the class of gamma mod \Gamma */
     959        4228 :   v = const_vecsmall(p1_size(p1N), 0);
     960        4228 :   i = p1_index( 0, 1, p1N); v[i] = 1;
     961        4228 :   i = p1_index( 1,-1, p1N); v[i] = 2;
     962        4228 :   i = p1_index(-1, 0, p1N); v[i] = 3;
     963             :   /* the value is unused [debugging]: what matters is whether it is != 0 */
     964        4228 :   position = 4;
     965             :   /* at this point, Fund = R, v contains the classes of Id, tau, tau^2 */
     966             : 
     967        4228 :   C  = list_new(mkvecsmall3(0,1, type_X));
     968        4228 :   list_insert(C, mkvecsmall3(1,1,type_DO));
     969             :   /* C is a list of triples[a,b,t], where c = a/b is a cusp, and t is the type
     970             :    * of the path between c and the PREVIOUS cusp in the list, coded as
     971             :    *   type_DO = "?", type_X = "x", type_T = "t"
     972             :    * Initially, C = [0/1,"?",1/1]; */
     973             : 
     974             :   /* loop through the current set of cusps C and check to see if more cusps
     975             :    * should be added */
     976             :   for (;;)
     977       24633 :   {
     978       28861 :     int done = 1;
     979      824383 :     for (c = C; c; c = c->next)
     980             :     {
     981             :       GEN cusp1, cusp2, gam;
     982             :       long pos, b1, b2, b;
     983             : 
     984      824383 :       if (!c->next) break;
     985      795522 :       cusp1 = c->data; /* = a1/b1 */
     986      795522 :       cusp2 = (c->next)->data; /* = a2/b2 */
     987      795522 :       if (cusp2[3] != type_DO) continue;
     988             : 
     989             :       /* gam (oo -> 0) = (cusp2 -> cusp1), gam in PSL2(Z) */
     990      364322 :       gam = path_to_zm(mkpath(cusp2, cusp1)); /* = [a2,a1;b2,b1] */
     991             :       /* we have normalized the cusp representation so that a1 b2 - a2 b1 = 1 */
     992      364322 :       b1 = coeff(gam,2,1); b2 = coeff(gam,2,2);
     993             :       /* gam.1  = (a1 + a2) / (b1 + b2) */
     994      364322 :       b = b1 + b2;
     995             :       /* Determine whether the adjacent triangle *below* (cusp1->cusp2)
     996             :        * should be added */
     997      364322 :       pos = p1_index(b1,b2, p1N); /* did we see cl(gam) before ? */
     998      364322 :       if (v[pos])
     999      182798 :         cusp2[3] = type_X; /* NO */
    1000             :       else
    1001             :       { /* YES */
    1002             :         ulong B1, B2;
    1003      181524 :         v[pos] = position;
    1004      181524 :         i = p1_index(-(b1+b2), b1, p1N); v[i] = position+1;
    1005      181524 :         i = p1_index(b2, -(b1+b2), p1N); v[i] = position+2;
    1006             :         /* add cl(gam), cl(gam*TAU), cl(gam*TAU^2) to v */
    1007      181524 :         position += 3;
    1008             :         /* gam tau gam^(-1) in \Gamma ? */
    1009      181524 :         B1 = umodsu(b1, N);
    1010      181524 :         B2 = umodsu(b2, N);
    1011      181524 :         if ((Fl_sqr(B2,N) + Fl_sqr(B1,N) + Fl_mul(B1,B2,N)) % N == 0)
    1012        1477 :           cusp2[3] = type_T;
    1013             :         else
    1014             :         {
    1015      180047 :           long a1 = coeff(gam, 1,1), a2 = coeff(gam, 1,2);
    1016      180047 :           long a = a1 + a2; /* gcd(a,b) = 1 */
    1017      180047 :           list_insert(c, mkvecsmall3(a,b,type_DO));
    1018      180047 :           c = c->next;
    1019      180047 :           nbC++;
    1020      180047 :           done = 0;
    1021             :         }
    1022             :       }
    1023             :     }
    1024       28861 :     if (done) break;
    1025             :   }
    1026        4228 :   L = cgetg(nbC+1, t_VEC); i = 1;
    1027      192731 :   for (c = C; c; c = c->next) gel(L,i++) = c->data;
    1028        4228 :   return gc_GEN(av, L);
    1029             : }
    1030             : 
    1031             : /* W an msN. M in PSL2(Z). Return index of M in P1^(Z/NZ) = Gamma0(N) \ PSL2(Z),
    1032             :  * and M0 in Gamma_0(N) such that M = M0 * M', where M' = chosen
    1033             :  * section( PSL2(Z) -> P1^(Z/NZ) ). */
    1034             : static GEN
    1035      498463 : Gamma0N_decompose(GEN W, GEN M, long *index)
    1036             : {
    1037      498463 :   GEN p1N = msN_get_p1N(W), W3 = gel(W,3), section = msN_get_section(W);
    1038             :   GEN A;
    1039      498463 :   ulong N = p1N_get_N(p1N);
    1040      498463 :   ulong c = umodiu(gcoeff(M,2,1), N);
    1041      498463 :   ulong d = umodiu(gcoeff(M,2,2), N);
    1042      498463 :   long s, ind = p1_index(c, d, p1N); /* as an elt of P1(Z/NZ) */
    1043      498463 :   *index = W3[ind]; /* as an elt of F, E2, ... */
    1044      498463 :   M = ZM_zm_mul(M, sl2_inv(gel(section,ind)));
    1045             :   /* normalize mod +/-Id */
    1046      498463 :   A = gcoeff(M,1,1);
    1047      498463 :   s = signe(A);
    1048      498463 :   if (s < 0)
    1049      237125 :     M = ZM_neg(M);
    1050      261338 :   else if (!s)
    1051             :   {
    1052         378 :     GEN C = gcoeff(M,2,1);
    1053         378 :     if (signe(C) < 0) M = ZM_neg(M);
    1054             :   }
    1055      498463 :   return M;
    1056             : }
    1057             : /* W an msN; as above for a path. Return [[ind], M] */
    1058             : static GEN
    1059      385462 : path_Gamma0N_decompose(GEN W, GEN path)
    1060             : {
    1061      385462 :   GEN p1N = msN_get_p1N(W);
    1062      385462 :   GEN p1index_to_ind = gel(W,3);
    1063      385462 :   GEN section = msN_get_section(W);
    1064      385462 :   GEN M = path_to_zm(path);
    1065      385462 :   long p1index = p1_index(cc(M), dd(M), p1N);
    1066      385462 :   long ind = p1index_to_ind[p1index];
    1067      385462 :   GEN M0 = ZM_zm_mul(mat2_to_ZM(M), sl2_inv(gel(section,p1index)));
    1068      385462 :   return mkvec2(mkvecsmall(ind), M0);
    1069             : }
    1070             : 
    1071             : /*Form generators of H_1(X_0(N),{cusps},Z)
    1072             : *
    1073             : *Input: N = integer > 1, p1N = P^1(Z/NZ)
    1074             : *Output: [cusp_list,E,F,T2,T3,E1] where
    1075             : *  cusps_list = list of cusps describing fundamental domain of
    1076             : *    \Gamma_0(N).
    1077             : *  E = list of paths in the boundary of the fundamental domains and oriented
    1078             : *    clockwise such that they do not contain a point
    1079             : *    fixed by an element of order 2 and they are not an edge of a
    1080             : *    triangle containing a fixed point of an element of order 3
    1081             : *  F = list of paths in the interior of the domain with each
    1082             : *    orientation appearing separately
    1083             : * T2 = list of paths in the boundary of domain containing a point fixed
    1084             : *    by an element of order 2 (oriented clockwise)
    1085             : * T3 = list of paths in the boundard of domain which are the edges of
    1086             : *    some triangle containing a fixed point of a matrix of order 3 (both
    1087             : *    orientations appear)
    1088             : * E1 = a sublist of E such that every path in E is \Gamma_0(N)-equivalent to
    1089             : *    either an element of E1 or the flip (reversed orientation) of an element
    1090             : *    of E1.
    1091             : * (Elements of T2 are \Gamma_0(N)-equivalent to their own flip.)
    1092             : *
    1093             : * sec = a list from 1..#p1N of matrices describing a section of the map
    1094             : *   SL_2(Z) to P^1(Z/NZ) given by [a,b;c,d]-->[c,d].
    1095             : *   Given our fixed enumeration of P^1(Z/NZ), the j-th element of the list
    1096             : *   represents the image of the j-th element of P^1(Z/NZ) under the section. */
    1097             : 
    1098             : /* insert path in set T */
    1099             : static void
    1100      554302 : set_insert(hashtable *T, GEN path)
    1101      554302 : { hash_insert(T, path,  (void*)(T->nb + 1)); }
    1102             : 
    1103             : static GEN
    1104       38052 : hash_to_vec(hashtable *h)
    1105             : {
    1106       38052 :   GEN v = cgetg(h->nb + 1, t_VEC);
    1107             :   ulong i;
    1108     4186994 :   for (i = 0; i < h->len; i++)
    1109             :   {
    1110     4148942 :     hashentry *e = h->table[i];
    1111     5066411 :     while (e)
    1112             :     {
    1113      917469 :       GEN key = (GEN)e->key;
    1114      917469 :       long index = (long)e->val;
    1115      917469 :       gel(v, index) = key;
    1116      917469 :       e = e->next;
    1117             :     }
    1118             :   }
    1119       38052 :   return v;
    1120             : }
    1121             : 
    1122             : static long
    1123      284487 : path_to_p1_index(GEN path, GEN p1N)
    1124             : {
    1125      284487 :   GEN M = path_to_zm(path);
    1126      284487 :   return p1_index(cc(M), dd(M), p1N);
    1127             : }
    1128             : 
    1129             : /* Pollack-Stevens sets */
    1130             : typedef struct PS_sets_t {
    1131             :   hashtable *F, *T2, *T31, *T32, *E1, *E2;
    1132             :   GEN E2fromE1, stdE1;
    1133             : } PS_sets_t;
    1134             : 
    1135             : /* T = E2fromE1[i] = [c, gamma] */
    1136             : static ulong
    1137    42523936 : E2fromE1_c(GEN T) { return itou(gel(T,1)); }
    1138             : static GEN
    1139      579957 : E2fromE1_Zgamma(GEN T) { return gel(T,2); }
    1140             : static GEN
    1141       94829 : E2fromE1_gamma(GEN T) { return gcoeff(gel(T,2),1,1); }
    1142             : 
    1143             : static void
    1144      189658 : insert_E(GEN path, PS_sets_t *S, GEN p1N)
    1145             : {
    1146      189658 :   GEN rev = vecreverse(path);
    1147      189658 :   long std = path_to_p1_index(rev, p1N);
    1148      189658 :   GEN v = gel(S->stdE1, std);
    1149      189658 :   if (v)
    1150             :   { /* [s, p1], where E1[s] is the path p1 = vecreverse(path) mod \Gamma */
    1151       94829 :     GEN gamma, p1 = gel(v,2);
    1152       94829 :     long r, s = itou(gel(v,1));
    1153             : 
    1154       94829 :     set_insert(S->E2, path);
    1155       94829 :     r = S->E2->nb;
    1156       94829 :     if (gel(S->E2fromE1, r) != gen_0) pari_err_BUG("insert_E");
    1157             : 
    1158       94829 :     gamma = gamma_equiv_matrix(rev, p1);
    1159             :     /* reverse(E2[r]) = gamma * E1[s] */
    1160       94829 :     gel(S->E2fromE1, r) = mkvec2(utoipos(s), to_famat_shallow(gamma,gen_m1));
    1161             :   }
    1162             :   else
    1163             :   {
    1164       94829 :     set_insert(S->E1, path);
    1165       94829 :     std = path_to_p1_index(path, p1N);
    1166       94829 :     gel(S->stdE1, std) = mkvec2(utoipos(S->E1->nb), path);
    1167             :   }
    1168      189658 : }
    1169             : 
    1170             : static GEN
    1171       16912 : cusp_infinity(void) { return mkvecsmall2(1,0); }
    1172             : 
    1173             : static void
    1174        4228 : form_E_F_T(ulong N, GEN p1N, GEN *pC, PS_sets_t *S)
    1175             : {
    1176        4228 :   GEN C, cusp_list = form_list_of_cusps(N, p1N);
    1177        4228 :   long nbgen = lg(cusp_list)-1, nbmanin = p1_size(p1N), r, s, i;
    1178             :   hashtable *F, *T2, *T31, *T32, *E1, *E2;
    1179             : 
    1180        4228 :   *pC = C = cgetg(nbgen+1, t_VEC);
    1181      192731 :   for (i = 1; i <= nbgen; i++)
    1182             :   {
    1183      188503 :     GEN c = gel(cusp_list,i);
    1184      188503 :     gel(C,i) = mkvecsmall2(c[1], c[2]);
    1185             :   }
    1186        4228 :   S->F  = F  = hash_create_GEN(nbmanin, 1);
    1187        4228 :   S->E1 = E1 = hash_create_GEN(nbgen, 1);
    1188        4228 :   S->E2 = E2 = hash_create_GEN(nbgen, 1);
    1189        4228 :   S->T2 = T2 = hash_create_GEN(nbgen, 1);
    1190        4228 :   S->T31 = T31 = hash_create_GEN(nbgen, 1);
    1191        4228 :   S->T32 = T32 = hash_create_GEN(nbgen, 1);
    1192             : 
    1193             :   /* T31 represents the three torsion paths going from left to right */
    1194             :   /* T32 represents the three torsion paths going from right to left */
    1195      188503 :   for (r = 1; r < nbgen; r++)
    1196             :   {
    1197      184275 :     GEN c2 = gel(cusp_list,r+1);
    1198      184275 :     if (c2[3] == type_T)
    1199             :     {
    1200        1477 :       GEN c1 = gel(cusp_list,r), path = mkpath(c1,c2), path2 = vecreverse(path);
    1201        1477 :       set_insert(T31, path);
    1202        1477 :       set_insert(T32, path2);
    1203             :     }
    1204             :   }
    1205             : 
    1206             :   /* to record relations between E2 and E1 */
    1207        4228 :   S->E2fromE1 = zerovec(nbgen);
    1208        4228 :   S->stdE1 = const_vec(nbmanin, NULL);
    1209             : 
    1210             :   /* Assumption later: path [oo,0] is E1[1], path [1,oo] is E2[1] */
    1211             :   {
    1212        4228 :     GEN oo = cusp_infinity();
    1213        4228 :     GEN p1 = mkpath(oo, mkvecsmall2(0,1)); /* [oo, 0] */
    1214        4228 :     GEN p2 = mkpath(mkvecsmall2(1,1), oo); /* [1, oo] */
    1215        4228 :     insert_E(p1, S, p1N);
    1216        4228 :     insert_E(p2, S, p1N);
    1217             :   }
    1218             : 
    1219      188503 :   for (r = 1; r < nbgen; r++)
    1220             :   {
    1221      184275 :     GEN c1 = gel(cusp_list,r);
    1222    23924719 :     for (s = r+1; s <= nbgen; s++)
    1223             :     {
    1224    23740444 :       pari_sp av = avma;
    1225    23740444 :       GEN c2 = gel(cusp_list,s), path;
    1226    23740444 :       GEN d = subii(mulss(c1[1],c2[2]), mulss(c1[2],c2[1]));
    1227    23740444 :       set_avma(av);
    1228    23740444 :       if (!is_pm1(d)) continue;
    1229             : 
    1230      364322 :       path = mkpath(c1,c2);
    1231      364322 :       if (r+1 == s)
    1232             :       {
    1233      184275 :         GEN w = path;
    1234      184275 :         ulong hash = T31->hash(w); /* T31, T32 use the same hash function */
    1235      184275 :         if (!hash_search2(T31, w, hash) && !hash_search2(T32, w, hash))
    1236             :         {
    1237      182798 :           if (gamma_equiv(path, vecreverse(path), N))
    1238        1596 :             set_insert(T2, path);
    1239             :           else
    1240      181202 :             insert_E(path, S, p1N);
    1241             :         }
    1242             :       } else {
    1243      180047 :         set_insert(F, mkvec2(path, mkvecsmall2(r,s)));
    1244      180047 :         set_insert(F, mkvec2(vecreverse(path), mkvecsmall2(s,r)));
    1245             :       }
    1246             :     }
    1247             :   }
    1248        4228 :   setlg(S->E2fromE1, E2->nb+1);
    1249        4228 : }
    1250             : 
    1251             : /* v = \sum n_i g_i, g_i in Sl(2,Z), return \sum n_i g_i^(-1) */
    1252             : static GEN
    1253      845705 : ZSl2_star(GEN v)
    1254             : {
    1255             :   long i, l;
    1256             :   GEN w, G;
    1257      845705 :   if (typ(v) == t_INT) return v;
    1258      845705 :   G = gel(v,1);
    1259      845705 :   w = cgetg_copy(G, &l);
    1260     2015363 :   for (i = 1; i < l; i++)
    1261             :   {
    1262     1169658 :     GEN g = gel(G,i);
    1263     1169658 :     if (typ(g) == t_MAT) g = SL2_inv_shallow(g);
    1264     1169658 :     gel(w,i) = g;
    1265             :   }
    1266      845705 :   return ZG_normalize(mkmat2(w, gel(v,2)));
    1267             : }
    1268             : 
    1269             : /* Input: h = set of unimodular paths, p1N = P^1(Z/NZ) = Gamma_0(N)\PSL2(Z)
    1270             :  * Output: Each path is converted to a matrix and then an element of P^1(Z/NZ)
    1271             :  * Append the matrix to W[12], append the index that represents
    1272             :  * these elements of P^1 (the classes mod Gamma_0(N) via our fixed
    1273             :  * enumeration to W[2]. */
    1274             : static void
    1275       25368 : paths_decompose(GEN W, hashtable *h, int flag)
    1276             : {
    1277       25368 :   GEN p1N = ms_get_p1N(W), section = ms_get_section(W);
    1278       25368 :   GEN v = hash_to_vec(h);
    1279       25368 :   long i, l = lg(v);
    1280      579670 :   for (i = 1; i < l; i++)
    1281             :   {
    1282      554302 :     GEN e = gel(v,i);
    1283      554302 :     GEN M = path_to_zm(flag? gel(e,1): e);
    1284      554302 :     long index = p1_index(cc(M), dd(M), p1N);
    1285      554302 :     vecsmalltrunc_append(gel(W,2), index);
    1286      554302 :     gel(section, index) = M;
    1287             :   }
    1288       25368 : }
    1289             : static void
    1290        4228 : fill_W2_W12(GEN W, PS_sets_t *S)
    1291             : {
    1292        4228 :   GEN p1N = msN_get_p1N(W);
    1293        4228 :   long n = p1_size(p1N);
    1294        4228 :   gel(W, 2) = vecsmalltrunc_init(n+1);
    1295        4228 :   gel(W,12) = cgetg(n+1, t_VEC);
    1296             :   /* F contains [path, [index cusp1, index cusp2]]. Others contain paths only */
    1297        4228 :   paths_decompose(W, S->F, 1);
    1298        4228 :   paths_decompose(W, S->E2, 0);
    1299        4228 :   paths_decompose(W, S->T32, 0);
    1300        4228 :   paths_decompose(W, S->E1, 0);
    1301        4228 :   paths_decompose(W, S->T2, 0);
    1302        4228 :   paths_decompose(W, S->T31, 0);
    1303        4228 : }
    1304             : 
    1305             : /* x t_VECSMALL, corresponds to a map x(i) = j, where 1 <= j <= max for all i
    1306             :  * Return y s.t. y[j] = i or 0 (not in image) */
    1307             : static GEN
    1308        8456 : reverse_list(GEN x, long max)
    1309             : {
    1310        8456 :   GEN y = const_vecsmall(max, 0);
    1311        8456 :   long r, lx = lg(x);
    1312      660660 :   for (r = 1; r < lx; r++) y[ x[r] ] = r;
    1313        8456 :   return y;
    1314             : }
    1315             : 
    1316             : /* go from C[a] to C[b]; return the indices of paths
    1317             :  * E.g. if a < b
    1318             :  *   (C[a]->C[a+1], C[a+1]->C[a+2], ... C[b-1]->C[b])
    1319             :  * (else reverse direction)
    1320             :  * = b - a paths */
    1321             : static GEN
    1322      347228 : F_indices(GEN W, long a, long b)
    1323             : {
    1324      347228 :   GEN v = cgetg(labs(b-a) + 1, t_VEC);
    1325      347228 :   long s, k = 1;
    1326      347228 :   if (a < b) {
    1327      173614 :     GEN index_forward = gel(W,13);
    1328     1193969 :     for (s = a; s < b; s++) gel(v,k++) = gel(index_forward,s);
    1329             :   } else {
    1330      173614 :     GEN index_backward = gel(W,14);
    1331     1193969 :     for (s = a; s > b; s--) gel(v,k++) = gel(index_backward,s);
    1332             :   }
    1333      347228 :   return v;
    1334             : }
    1335             : /* go from C[a] to C[b] via oo; return the indices of paths
    1336             :  * E.g. if a < b
    1337             :  *   (C[a]->C[a-1], ... C[2]->C[1],
    1338             :  *    C[1]->oo, oo-> C[end],
    1339             :  *    C[end]->C[end-1], ... C[b+1]->C[b])
    1340             :  *  a-1 + 2 + end-(b+1)+1 = end - b + a + 1 paths  */
    1341             : static GEN
    1342       12866 : F_indices_oo(GEN W, long end, long a, long b)
    1343             : {
    1344       12866 :   GEN index_oo = gel(W,15);
    1345       12866 :   GEN v = cgetg(end-labs(b-a)+1 + 1, t_VEC);
    1346       12866 :   long s, k = 1;
    1347             : 
    1348       12866 :   if (a < b) {
    1349        6433 :     GEN index_backward = gel(W,14);
    1350        6433 :     for (s = a; s > 1; s--) gel(v,k++) = gel(index_backward,s);
    1351        6433 :     gel(v,k++) = gel(index_backward,1); /* C[1] -> oo */
    1352        6433 :     gel(v,k++) = gel(index_oo,2); /* oo -> C[end] */
    1353       75264 :     for (s = end; s > b; s--) gel(v,k++) = gel(index_backward,s);
    1354             :   } else {
    1355        6433 :     GEN index_forward = gel(W,13);
    1356       75264 :     for (s = a; s < end; s++) gel(v,k++) = gel(index_forward,s);
    1357        6433 :     gel(v,k++) = gel(index_forward,end); /* C[end] -> oo */
    1358        6433 :     gel(v,k++) = gel(index_oo,1); /* oo -> C[1] */
    1359        6433 :     for (s = 1; s < b; s++) gel(v,k++) = gel(index_forward,s);
    1360             :   }
    1361       12866 :   return v;
    1362             : }
    1363             : /* index of oo -> C[1], oo -> C[end] */
    1364             : static GEN
    1365        4228 : indices_oo(GEN W, GEN C)
    1366             : {
    1367        4228 :   long end = lg(C)-1;
    1368        4228 :   GEN w, v = cgetg(2+1, t_VEC), oo = cusp_infinity();
    1369        4228 :   w = mkpath(oo, gel(C,1)); /* oo -> C[1]=0 */
    1370        4228 :   gel(v,1) = path_Gamma0N_decompose(W, w);
    1371        4228 :   w = mkpath(oo, gel(C,end)); /* oo -> C[end]=1 */
    1372        4228 :   gel(v,2) = path_Gamma0N_decompose(W, w);
    1373        4228 :   return v;
    1374             : }
    1375             : 
    1376             : /* index of C[1]->C[2], C[2]->C[3], ... C[end-1]->C[end], C[end]->oo
    1377             :  * Recall that C[1] = 0, C[end] = 1 */
    1378             : static GEN
    1379        4228 : indices_forward(GEN W, GEN C)
    1380             : {
    1381        4228 :   long s, k = 1, end = lg(C)-1;
    1382        4228 :   GEN v = cgetg(end+1, t_VEC);
    1383      192731 :   for (s = 1; s <= end; s++)
    1384             :   {
    1385      188503 :     GEN w = mkpath(gel(C,s), s == end? cusp_infinity(): gel(C,s+1));
    1386      188503 :     gel(v,k++) = path_Gamma0N_decompose(W, w);
    1387             :   }
    1388        4228 :   return v;
    1389             : }
    1390             : /* index of C[1]->oo, C[2]->C[1], ... C[end]->C[end-1] */
    1391             : static GEN
    1392        4228 : indices_backward(GEN W, GEN C)
    1393             : {
    1394        4228 :   long s, k = 1, end = lg(C)-1;
    1395        4228 :   GEN v = cgetg(end+1, t_VEC);
    1396      192731 :   for (s = 1; s <= end; s++)
    1397             :   {
    1398      188503 :     GEN w = mkpath(gel(C,s), s == 1? cusp_infinity(): gel(C,s-1));
    1399      188503 :     gel(v,k++) = path_Gamma0N_decompose(W, w);
    1400             :   }
    1401        4228 :   return v;
    1402             : }
    1403             : 
    1404             : /*[0,-1;1,-1]*/
    1405             : static GEN
    1406        4312 : mkTAU()
    1407        4312 : { retmkmat22(gen_0,gen_m1, gen_1,gen_m1); }
    1408             : /* S */
    1409             : static GEN
    1410          84 : mkS()
    1411          84 : { retmkmat22(gen_0,gen_1, gen_m1,gen_0); }
    1412             : /* N = integer > 1. Returns data describing Delta_0 = Z[P^1(Q)]_0 seen as
    1413             :  * a Gamma_0(N) - module. */
    1414             : static GEN
    1415        4256 : msinit_N(ulong N)
    1416             : {
    1417             :   GEN p1N, C, vecF, vecT2, vecT31, TAU, W, W2, singlerel, annT2, annT31;
    1418             :   GEN F_index;
    1419             :   ulong r, s, width;
    1420             :   long nball, nbgen, nbp1N;
    1421             :   hashtable *F, *T2, *T31, *T32, *E1, *E2;
    1422             :   PS_sets_t S;
    1423             : 
    1424        4256 :   W = zerovec(16);
    1425        4256 :   gel(W,1) = p1N = create_p1mod(N);
    1426        4256 :   gel(W,16)= inithashcusps(p1N);
    1427        4256 :   TAU = mkTAU();
    1428        4256 :   if (N == 1)
    1429             :   {
    1430          28 :     gel(W,5) = mkvecsmall(1);
    1431             :     /* cheat because sets are not disjoint if N=1 */
    1432          28 :     gel(W,11) = mkvecsmall5(0, 0, 1, 1, 2);
    1433          28 :     gel(W,12) = mkvec(mat2(1,0,0,1));
    1434          28 :     gel(W,8) = mkvec( mkmat22(gen_1,gen_1, mkS(),gen_1) );
    1435          28 :     gel(W,9) = mkvec( mkmat2(mkcol3(gen_1,TAU,ZM2_sqr(TAU)),
    1436             :                              mkcol3(gen_1,gen_1,gen_1)) );
    1437          28 :     return W;
    1438             :   }
    1439        4228 :   nbp1N = p1_size(p1N);
    1440        4228 :   form_E_F_T(N,p1N, &C, &S);
    1441        4228 :   E1  = S.E1;
    1442        4228 :   E2  = S.E2;
    1443        4228 :   T31 = S.T31;
    1444        4228 :   T32 = S.T32;
    1445        4228 :   F   = S.F;
    1446        4228 :   T2  = S.T2;
    1447        4228 :   nbgen = lg(C)-1;
    1448             : 
    1449             :  /* Put our paths in the order: F,E2,T32,E1,T2,T31
    1450             :   * W2[j] associates to the j-th element of this list its index in P1. */
    1451        4228 :   fill_W2_W12(W, &S);
    1452        4228 :   W2 = gel(W, 2);
    1453        4228 :   nball = lg(W2)-1;
    1454        4228 :   gel(W,3) = reverse_list(W2, nbp1N);
    1455        4228 :   gel(W,5) = vecslice(gel(W,2), F->nb + E2->nb + T32->nb + 1, nball);
    1456        4228 :   gel(W,4) = reverse_list(gel(W,5), nbp1N);
    1457        4228 :   gel(W,13) = indices_forward(W, C);
    1458        4228 :   gel(W,14) = indices_backward(W, C);
    1459        4228 :   gel(W,15) = indices_oo(W, C);
    1460        8456 :   gel(W,11) = mkvecsmall5(F->nb,
    1461        4228 :                           F->nb + E2->nb,
    1462        4228 :                           F->nb + E2->nb + T32->nb,
    1463        4228 :                           F->nb + E2->nb + T32->nb + E1->nb,
    1464        4228 :                           F->nb + E2->nb + T32->nb + E1->nb + T2->nb);
    1465             :   /* relations between T32 and T31 [not stored!]
    1466             :    * T32[i] = - T31[i] */
    1467             : 
    1468             :   /* relations of F */
    1469        4228 :   width = E1->nb + T2->nb + T31->nb;
    1470             :   /* F_index[r] = [index_1, ..., index_k], where index_i is the p1_index()
    1471             :    * of the elementary unimodular path between 2 consecutive cusps
    1472             :    * [in E1,E2,T2,T31 or T32] */
    1473        4228 :   F_index = cgetg(F->nb+1, t_VEC);
    1474        4228 :   vecF = hash_to_vec(F);
    1475      364322 :   for (r = 1; r <= F->nb; r++)
    1476             :   {
    1477      360094 :     GEN w = gel(gel(vecF,r), 2);
    1478      360094 :     long a = w[1], b = w[2], d = labs(b - a);
    1479             :     /* c1 = cusp_list[a],  c2 = cusp_list[b], ci != oo */
    1480      360094 :     gel(F_index,r) = (nbgen-d >= d-1)? F_indices(W, a,b)
    1481      360094 :                                      : F_indices_oo(W, lg(C)-1,a,b);
    1482             :   }
    1483             : 
    1484        4228 :   singlerel = cgetg(width+1, t_VEC);
    1485             :   /* form the single boundary relation */
    1486       99057 :   for (s = 1; s <= E2->nb; s++)
    1487             :   { /* reverse(E2[s]) = gamma * E1[c] */
    1488       94829 :     GEN T = gel(S.E2fromE1,s), gamma = E2fromE1_gamma(T);
    1489       94829 :     gel(singlerel, E2fromE1_c(T)) = mkmat22(gen_1,gen_1, gamma,gen_m1);
    1490             :   }
    1491        7301 :   for (r = E1->nb + 1; r <= width; r++) gel(singlerel, r) = gen_1;
    1492             : 
    1493             :   /* form the 2-torsion relations */
    1494        4228 :   annT2 = cgetg(T2->nb+1, t_VEC);
    1495        4228 :   vecT2 = hash_to_vec(T2);
    1496        5824 :   for (r = 1; r <= T2->nb; r++)
    1497             :   {
    1498        1596 :     GEN w = gel(vecT2,r);
    1499        1596 :     GEN gamma = gamma_equiv_matrix(vecreverse(w), w);
    1500        1596 :     gel(annT2, r) = mkmat22(gen_1,gen_1, gamma,gen_1);
    1501             :   }
    1502             : 
    1503             :   /* form the 3-torsion relations */
    1504        4228 :   annT31 = cgetg(T31->nb+1, t_VEC);
    1505        4228 :   vecT31 = hash_to_vec(T31);
    1506        5705 :   for (r = 1; r <= T31->nb; r++)
    1507             :   {
    1508        1477 :     GEN M = path_to_ZM( vecreverse(gel(vecT31,r)) );
    1509        1477 :     GEN gamma = ZM_mul(ZM_mul(M, TAU), SL2_inv_shallow(M));
    1510        1477 :     gel(annT31, r) = mkmat2(mkcol3(gen_1,gamma,ZM2_sqr(gamma)),
    1511             :                             mkcol3(gen_1,gen_1,gen_1));
    1512             :   }
    1513        4228 :   gel(W,6) = F_index;
    1514        4228 :   gel(W,7) = S.E2fromE1;
    1515        4228 :   gel(W,8) = annT2;
    1516        4228 :   gel(W,9) = annT31;
    1517        4228 :   gel(W,10)= singlerel;
    1518        4228 :   return W;
    1519             : }
    1520             : static GEN
    1521         112 : cusp_to_P1Q(GEN c) { return c[2]? sstoQ(c[1], c[2]): mkoo(); }
    1522             : static GEN
    1523          21 : mspathgens_i(GEN W)
    1524             : {
    1525             :   GEN R, r, g, section, gen, annT2, annT31;
    1526             :   long i, l;
    1527          21 :   checkms(W); W = get_msN(W);
    1528          21 :   section = msN_get_section(W);
    1529          21 :   gen = ms_get_genindex(W);
    1530          21 :   l = lg(gen);
    1531          21 :   g = cgetg(l,t_VEC);
    1532          77 :   for (i = 1; i < l; i++)
    1533             :   {
    1534          56 :     GEN p = gel(section,gen[i]);
    1535          56 :     gel(g,i) = mkvec2(cusp_to_P1Q(gel(p,1)), cusp_to_P1Q(gel(p,2)));
    1536             :   }
    1537          21 :   annT2 = msN_get_annT2(W);
    1538          21 :   annT31= msN_get_annT31(W);
    1539          21 :   if (ms_get_N(W) == 1)
    1540             :   {
    1541           7 :     R = cgetg(3, t_VEC);
    1542           7 :     gel(R,1) = mkvec( mkvec2(gel(annT2,1), gen_1) );
    1543           7 :     gel(R,2) = mkvec( mkvec2(gel(annT31,1), gen_1) );
    1544             :   }
    1545             :   else
    1546             :   {
    1547          14 :     GEN singlerel = msN_get_singlerel(W);
    1548          14 :     long j, nbT2 = lg(annT2)-1, nbT31 = lg(annT31)-1, nbE1 = ms_get_nbE1(W);
    1549          14 :     R = cgetg(nbT2+nbT31+2, t_VEC);
    1550          14 :     l = lg(singlerel);
    1551          14 :     r = cgetg(l, t_VEC);
    1552          42 :     for (i = 1; i <= nbE1; i++)
    1553          28 :       gel(r,i) = mkvec2(gel(singlerel, i), utoi(i));
    1554          35 :     for (; i < l; i++)
    1555          21 :       gel(r,i) = mkvec2(gen_1, utoi(i));
    1556          14 :     gel(R,1) = r; j = 2;
    1557          35 :     for (i = 1; i <= nbT2; i++,j++)
    1558          21 :       gel(R,j) = mkvec( mkvec2(gel(annT2,i), utoi(i + nbE1)) );
    1559          14 :     for (i = 1; i <= nbT31; i++,j++)
    1560           0 :       gel(R,j) = mkvec( mkvec2(gel(annT31,i), utoi(i + nbE1 + nbT2)) );
    1561             :   }
    1562          21 :   return mkvec2(g,R);
    1563             : }
    1564             : GEN
    1565          21 : mspathgens(GEN W)
    1566             : {
    1567          21 :   pari_sp av = avma;
    1568          21 :   return gc_GEN(av, mspathgens_i(W));
    1569             : }
    1570             : /* Modular symbols in weight k: Hom_Gamma(Delta, Q[x,y]_{k-2}) */
    1571             : /* A symbol phi is represented by the {phi(g_i)}, {phi(g'_i)}, {phi(g''_i)}
    1572             :  * where the {g_i, g'_i, g''_i} are the Z[\Gamma]-generators of Delta,
    1573             :  * g_i corresponds to E1, g'_i to T2, g''_i to T31.
    1574             :  */
    1575             : 
    1576             : /* FIXME: export. T^1, ..., T^n */
    1577             : static GEN
    1578      701834 : RgX_powers(GEN T, long n)
    1579             : {
    1580      701834 :   GEN v = cgetg(n+1, t_VEC);
    1581             :   long i;
    1582      701834 :   gel(v, 1) = T;
    1583     1643600 :   for (i = 1; i < n; i++) gel(v,i+1) = RgX_mul(gel(v,i), T);
    1584      701834 :   return v;
    1585             : }
    1586             : 
    1587             : /* g = [a,b;c,d] a mat2. Return (X^{k-2} | g)(X,Y)[X = 1]. */
    1588             : static GEN
    1589        2604 : voo_act_Gl2Q(GEN g, long k)
    1590             : {
    1591        2604 :   GEN mc = stoi(-coeff(g,2,1)), d = stoi(coeff(g,2,2));
    1592        2604 :   return RgX_to_RgC(gpowgs(deg1pol_shallow(mc, d, 0), k-2), k-1);
    1593             : }
    1594             : 
    1595             : struct m_act {
    1596             :   long dim, k, p;
    1597             :   GEN q;
    1598             :   GEN(*act)(struct m_act *,GEN);
    1599             : };
    1600             : 
    1601             : /* g = [a,b;c,d]. Return (P | g)(X,Y)[X = 1] = P(dX - cY, -b X + aY)[X = 1],
    1602             :  * for P = X^{k-2}, X^{k-3}Y, ..., Y^{k-2} */
    1603             : GEN
    1604      350749 : RgX_act_Gl2Q(GEN g, long k)
    1605             : {
    1606             :   GEN a,b,c,d, V1,V2,V;
    1607             :   long i;
    1608      350749 :   if (k == 2) return matid(1);
    1609      350749 :   a = gcoeff(g,1,1); b = gcoeff(g,1,2);
    1610      350749 :   c = gcoeff(g,2,1); d = gcoeff(g,2,2);
    1611      350749 :   V1 = RgX_powers(deg1pol_shallow(gneg(c), d, 0), k-2); /* d - c Y */
    1612      350749 :   V2 = RgX_powers(deg1pol_shallow(a, gneg(b), 0), k-2); /*-b + a Y */
    1613      350749 :   V = cgetg(k, t_MAT);
    1614      350749 :   gel(V,1)   = RgX_to_RgC(gel(V1, k-2), k-1);
    1615      819280 :   for (i = 1; i < k-2; i++)
    1616             :   {
    1617      468531 :     GEN v1 = gel(V1, k-2-i); /* (d-cY)^(k-2-i) */
    1618      468531 :     GEN v2 = gel(V2, i); /* (-b+aY)^i */
    1619      468531 :     gel(V,i+1) = RgX_to_RgC(RgX_mul(v1,v2), k-1);
    1620             :   }
    1621      350749 :   gel(V,k-1) = RgX_to_RgC(gel(V2, k-2), k-1);
    1622      350749 :   return V; /* V[i+1] = X^i | g */
    1623             : }
    1624             : /* z in Z[Gl2(Q)], return the matrix of z acting on V */
    1625             : static GEN
    1626      600649 : act_ZGl2Q(GEN z, struct m_act *T, hashtable *H)
    1627             : {
    1628      600649 :   GEN S = NULL, G, E;
    1629             :   pari_sp av;
    1630             :   long l, j;
    1631             :   /* paranoia: should not occur */
    1632      600649 :   if (typ(z) == t_INT) return scalarmat_shallow(z, T->dim);
    1633      600649 :   G = gel(z,1); l = lg(G);
    1634      600649 :   E = gel(z,2); av = avma;
    1635     1770307 :   for (j = 1; j < l; j++)
    1636             :   {
    1637     1169658 :     GEN M, g = gel(G,j), n = gel(E,j);
    1638     1169658 :     if (typ(g) == t_INT) /* = 1 */
    1639        3948 :       M = n; /* n*Id_dim */
    1640             :     else
    1641             :     { /*search in H succeeds because of preload*/
    1642     1165710 :       M = H? (GEN)hash_search(H,g)->val: T->act(T,g);
    1643     1165710 :       if (is_pm1(n))
    1644     1158185 :       { if (signe(n) < 0) M = RgM_neg(M); }
    1645             :       else
    1646        7525 :         M = RgM_Rg_mul(M, n);
    1647             :     }
    1648     1169658 :     if (!S) { S = M; continue; }
    1649      569009 :     S = gadd(S, M);
    1650      569009 :     if (gc_needed(av,1))
    1651             :     {
    1652           0 :       if(DEBUGMEM>1) pari_warn(warnmem,"act_ZGl2Q, j = %ld",j);
    1653           0 :       S = gc_upto(av, S);
    1654             :     }
    1655             :   }
    1656      600649 :   return gc_GEN(av, S);
    1657             : }
    1658             : static GEN
    1659      350602 : _RgX_act_Gl2Q(struct m_act *S, GEN z) { return RgX_act_Gl2Q(z, S->k); }
    1660             : /* acting on (X^{k-2},...,Y^{k-2}) */
    1661             : GEN
    1662       60907 : RgX_act_ZGl2Q(GEN z, long k)
    1663             : {
    1664             :   struct m_act T;
    1665       60907 :   T.k = k;
    1666       60907 :   T.dim = k-1;
    1667       60907 :   T.act=&_RgX_act_Gl2Q;
    1668       60907 :   return act_ZGl2Q(z, &T, NULL);
    1669             : }
    1670             : 
    1671             : /* First pass, identify matrices in Sl_2 to convert to operators;
    1672             :  * insert operators in hashtable. This allows GC in act_ZGl2Q */
    1673             : static void
    1674     1069894 : hash_preload(GEN M, struct m_act *S, hashtable *H)
    1675             : {
    1676     1069894 :   if (typ(M) != t_INT)
    1677             :   {
    1678     1069894 :     ulong h = H->hash(M);
    1679     1069894 :     hashentry *e = hash_search2(H, M, h);
    1680     1069894 :     if (!e) hash_insert2(H, M, S->act(S,M), h);
    1681             :   }
    1682     1069894 : }
    1683             : /* z a sparse operator */
    1684             : static void
    1685      539728 : hash_vecpreload(GEN z, struct m_act *S, hashtable *H)
    1686             : {
    1687      539728 :   GEN G = gel(z,1);
    1688      539728 :   long i, l = lg(G);
    1689     1609622 :   for (i = 1; i < l; i++) hash_preload(gel(G,i), S, H);
    1690      539728 : }
    1691             : static void
    1692       40677 : ZGl2QC_preload(struct m_act *S, GEN v, hashtable *H)
    1693             : {
    1694       40677 :   GEN val = gel(v,2);
    1695       40677 :   long i, l = lg(val);
    1696      580405 :   for (i = 1; i < l; i++) hash_vecpreload(gel(val,i), S, H);
    1697       40677 : }
    1698             : /* Given a sparse vector of elements in Z[G], convert it to a (sparse) vector
    1699             :  * of operators on V (given by t_MAT) */
    1700             : static void
    1701       40691 : ZGl2QC_to_act(struct m_act *S, GEN v, hashtable *H)
    1702             : {
    1703       40691 :   GEN val = gel(v,2);
    1704       40691 :   long i, l = lg(val);
    1705      580433 :   for (i = 1; i < l; i++) gel(val,i) = act_ZGl2Q(gel(val,i), S, H);
    1706       40691 : }
    1707             : 
    1708             : /* For all V[i] in Z[\Gamma], find the P such that  P . V[i]^* = 0;
    1709             :  * write P in basis X^{k-2}, ..., Y^{k-2} */
    1710             : static GEN
    1711        1260 : ZGV_tors(GEN V, long k)
    1712             : {
    1713        1260 :   long i, l = lg(V);
    1714        1260 :   GEN v = cgetg(l, t_VEC);
    1715        1764 :   for (i = 1; i < l; i++)
    1716             :   {
    1717         504 :     GEN a = ZSl2_star(gel(V,i));
    1718         504 :     gel(v,i) = ZM_ker(RgX_act_ZGl2Q(a,k));
    1719             :   }
    1720        1260 :   return v;
    1721             : }
    1722             : 
    1723             : static long
    1724   116583264 : set_from_index(GEN W11, long i)
    1725             : {
    1726   116583264 :   if (i <= W11[1]) return 1;
    1727   101477495 :   if (i <= W11[2]) return 2;
    1728    59091340 :   if (i <= W11[3]) return 3;
    1729    58897720 :   if (i <= W11[4]) return 4;
    1730     2330510 :   if (i <= W11[5]) return 5;
    1731      261849 :   return 6;
    1732             : }
    1733             : 
    1734             : /* det M = 1 */
    1735             : static void
    1736     1535667 : treat_index(GEN W, GEN M, long index, GEN v)
    1737             : {
    1738     1535667 :   GEN W11 = gel(W,11);
    1739     1535667 :   long shift = W11[3]; /* #F + #E2 + T32 */
    1740     1535667 :   switch(set_from_index(W11, index))
    1741             :   {
    1742      251167 :     case 1: /*F*/
    1743             :     {
    1744      251167 :       GEN F_index = gel(W,6), ind = gel(F_index, index);
    1745      251167 :       long j, l = lg(ind);
    1746     1288371 :       for (j = 1; j < l; j++)
    1747             :       {
    1748     1037204 :         GEN IND = gel(ind,j), M0 = gel(IND,2);
    1749     1037204 :         long index = mael(IND,1,1);
    1750     1037204 :         treat_index(W, ZM_mul(M,M0), index, v);
    1751             :       }
    1752      251167 :       break;
    1753             :     }
    1754             : 
    1755      579957 :     case 2: /*E2, E2[r] + gamma * E1[s] = 0 */
    1756             :     {
    1757      579957 :       long r = index - W11[1];
    1758      579957 :       GEN z = gel(msN_get_E2fromE1(W), r);
    1759             : 
    1760      579957 :       index = E2fromE1_c(z);
    1761      579957 :       M = G_ZG_mul(M, E2fromE1_Zgamma(z)); /* M * (-gamma) */
    1762      579957 :       gel(v, index) = ZG_add(gel(v, index), M);
    1763      579957 :       break;
    1764             :     }
    1765             : 
    1766        5922 :     case 3: /*T32, T32[i] = -T31[i] */
    1767             :     {
    1768        5922 :       long T3shift = W11[5] - W11[2]; /* #T32 + #E1 + #T2 */
    1769        5922 :       index += T3shift;
    1770        5922 :       index -= shift;
    1771        5922 :       gel(v, index) = ZG_add(gel(v, index), to_famat_shallow(M,gen_m1));
    1772        5922 :       break;
    1773             :     }
    1774      698621 :     default: /*E1,T2,T31*/
    1775      698621 :       index -= shift;
    1776      698621 :       gel(v, index) = ZG_add(gel(v, index), to_famat_shallow(M,gen_1));
    1777      698621 :       break;
    1778             :   }
    1779     1535667 : }
    1780             : static void
    1781   115047597 : treat_index_trivial(GEN v, GEN W, long index)
    1782             : {
    1783   115047597 :   GEN W11 = gel(W,11);
    1784   115047597 :   long shift = W11[3]; /* #F + #E2 + T32 */
    1785   115047597 :   switch(set_from_index(W11, index))
    1786             :   {
    1787    14854602 :     case 1: /*F*/
    1788             :     {
    1789    14854602 :       GEN F_index = gel(W,6), ind = gel(F_index, index);
    1790    14854602 :       long j, l = lg(ind);
    1791   105394835 :       for (j = 1; j < l; j++)
    1792             :       {
    1793    90540233 :         GEN IND = gel(ind,j);
    1794    90540233 :         treat_index_trivial(v, W, mael(IND,1,1));
    1795             :       }
    1796    14854602 :       break;
    1797             :     }
    1798             : 
    1799    41806198 :     case 2: /*E2, E2[r] + gamma * E1[s] = 0 */
    1800             :     {
    1801    41806198 :       long r = index - W11[1];
    1802    41806198 :       long s = E2fromE1_c(gel(msN_get_E2fromE1(W), r));
    1803    41806198 :       v[s]--;
    1804    41806198 :       break;
    1805             :     }
    1806             : 
    1807     2499672 :     case 3: case 5: case 6: /*T32,T2,T31*/
    1808     2499672 :       break;
    1809             : 
    1810    55887125 :     case 4: /*E1*/
    1811    55887125 :       v[index-shift]++;
    1812    55887125 :       break;
    1813             :   }
    1814   115047597 : }
    1815             : 
    1816             : static GEN
    1817      178213 : M2_log(GEN W, GEN M)
    1818             : {
    1819      178213 :   GEN a = gcoeff(M,1,1), b = gcoeff(M,1,2);
    1820      178213 :   GEN c = gcoeff(M,2,1), d = gcoeff(M,2,2);
    1821             :   GEN  u, v, D, V;
    1822             :   long index, s;
    1823             : 
    1824      178213 :   W = get_msN(W);
    1825      178213 :   V = zerovec(ms_get_nbgen(W));
    1826             : 
    1827      178213 :   D = subii(mulii(a,d), mulii(b,c));
    1828      178213 :   s = signe(D);
    1829      178213 :   if (!s) return V;
    1830      176869 :   if (is_pm1(D))
    1831             :   { /* shortcut, no need to apply Manin's trick */
    1832       63399 :     if (s < 0) { b = negi(b); d = negi(d); }
    1833       63399 :     M = Gamma0N_decompose(W, mkmat22(a,b, c,d), &index);
    1834       63399 :     treat_index(W, M, index, V);
    1835             :   }
    1836             :   else
    1837             :   {
    1838             :     GEN U, B, P, Q, PQ, C1,C2;
    1839             :     long i, l;
    1840      113470 :     (void)bezout(a,c,&u,&v);
    1841      113470 :     B = addii(mulii(b,u), mulii(d,v));
    1842             :     /* [u,v;-c,a] [a,b; c,d] = [1,B; 0,D], i.e. M = U [1,B;0,D] */
    1843      113470 :     U = mkmat22(a,negi(v), c,u);
    1844             : 
    1845             :     /* {1/0 -> B/D} as \sum g_i, g_i unimodular paths */
    1846      113470 :     PQ = ZV_allpnqn( gboundcf(gdiv(B,D), 0) );
    1847      113470 :     P = gel(PQ,1); l = lg(P);
    1848      113470 :     Q = gel(PQ,2);
    1849      113470 :     C1 = gel(U,1);
    1850      548534 :     for (i = 1; i < l; i++, C1 = C2)
    1851             :     {
    1852             :       GEN M;
    1853      435064 :       C2 = ZM_ZC_mul(U, mkcol2(gel(P,i), gel(Q,i)));
    1854      435064 :       if (!odd(i)) C1 = ZC_neg(C1);
    1855      435064 :       M = Gamma0N_decompose(W, mkmat2(C1,C2), &index);
    1856      435064 :       treat_index(W, M, index, V);
    1857             :     }
    1858             :   }
    1859      176869 :   return V;
    1860             : }
    1861             : 
    1862             : /* express +oo->q=a/b in terms of the Z[G]-generators, trivial action */
    1863             : static void
    1864     2246944 : Q_log_trivial(GEN v, GEN W, GEN q)
    1865             : {
    1866     2246944 :   GEN Q, W3 = gel(W,3), p1N = msN_get_p1N(W);
    1867     2246944 :   ulong c,d, N = p1N_get_N(p1N);
    1868             :   long i, lx;
    1869             : 
    1870     2246944 :   Q = Q_log_init(N, q);
    1871     2246944 :   lx = lg(Q);
    1872     2246944 :   c = 0;
    1873    23633848 :   for (i = 1; i < lx; i++, c = d)
    1874             :   {
    1875             :     long index;
    1876    21386904 :     d = Q[i];
    1877    21386904 :     if (c && !odd(i)) c = N - c;
    1878    21386904 :     index = W3[ p1_index(c,d,p1N) ];
    1879    21386904 :     treat_index_trivial(v, W, index);
    1880             :   }
    1881     2246944 : }
    1882             : static void
    1883     1248121 : M2_log_trivial(GEN V, GEN W, GEN M)
    1884             : {
    1885     1248121 :   GEN p1N = gel(W,1), W3 = gel(W,3);
    1886     1248121 :   ulong N = p1N_get_N(p1N);
    1887     1248121 :   GEN a = gcoeff(M,1,1), b = gcoeff(M,1,2);
    1888     1248121 :   GEN c = gcoeff(M,2,1), d = gcoeff(M,2,2);
    1889             :   GEN  u, v, D;
    1890             :   long index, s;
    1891             : 
    1892     1248121 :   D = subii(mulii(a,d), mulii(b,c));
    1893     1248121 :   s = signe(D);
    1894     1265537 :   if (!s) return;
    1895     1248114 :   if (is_pm1(D))
    1896             :   { /* shortcut, not need to apply Manin's trick */
    1897      449386 :     if (s < 0) d = negi(d);
    1898      449386 :     index = W3[ p1_index(umodiu(c,N),umodiu(d,N),p1N) ];
    1899      449386 :     treat_index_trivial(V, W, index);
    1900             :   }
    1901             :   else
    1902             :   {
    1903             :     GEN U, B, P, Q, PQ;
    1904             :     long i, l;
    1905      798728 :     if (!signe(c)) { Q_log_trivial(V,W,gdiv(b,d)); return; }
    1906      781312 :     (void)bezout(a,c,&u,&v);
    1907      781312 :     B = addii(mulii(b,u), mulii(d,v));
    1908             :     /* [u,v;-c,a] [a,b; c,d] = [1,B; 0,D], i.e. M = U [1,B;0,D] */
    1909      781312 :     U = mkvec2(c, u);
    1910             : 
    1911             :     /* {1/0 -> B/D} as \sum g_i, g_i unimodular paths */
    1912      781312 :     PQ = ZV_allpnqn( gboundcf(gdiv(B,D), 0) );
    1913      781312 :     P = gel(PQ,1); l = lg(P);
    1914      781312 :     Q = gel(PQ,2);
    1915     3452386 :     for (i = 1; i < l; i++, c = d)
    1916             :     {
    1917     2671074 :       d = addii(mulii(gel(U,1),gel(P,i)), mulii(gel(U,2),gel(Q,i)));
    1918     2671074 :       if (!odd(i)) c = negi(c);
    1919     2671074 :       index = W3[ p1_index(umodiu(c,N),umodiu(d,N),p1N) ];
    1920     2671074 :       treat_index_trivial(V, W, index);
    1921             :     }
    1922             :   }
    1923             : }
    1924             : 
    1925             : static GEN
    1926       16772 : cusp_to_ZC(GEN c)
    1927             : {
    1928       16772 :   switch(typ(c))
    1929             :   {
    1930          35 :     case t_INFINITY:
    1931          35 :       return mkcol2(gen_1,gen_0);
    1932          91 :     case t_INT:
    1933          91 :       return mkcol2(c,gen_1);
    1934         140 :     case t_FRAC:
    1935         140 :       return mkcol2(gel(c,1),gel(c,2));
    1936       16506 :     case t_VECSMALL:
    1937       16506 :       return mkcol2(stoi(c[1]), stoi(c[2]));
    1938           0 :     default:
    1939           0 :       pari_err_TYPE("mspathlog",c);
    1940             :       return NULL;/*LCOV_EXCL_LINE*/
    1941             :   }
    1942             : }
    1943             : static GEN
    1944        8386 : path2_to_M2(GEN p)
    1945        8386 : { return mkmat2(cusp_to_ZC(gel(p,1)), cusp_to_ZC(gel(p,2))); }
    1946             : static GEN
    1947       54439 : path_to_M2(GEN p)
    1948             : {
    1949       54439 :   if (lg(p) != 3) pari_err_TYPE("mspathlog",p);
    1950       54432 :   switch(typ(p))
    1951             :   {
    1952       48160 :     case t_MAT:
    1953       48160 :       RgM_check_ZM(p,"mspathlog");
    1954       48160 :       break;
    1955        6272 :     case t_VEC:
    1956        6272 :       p = path2_to_M2(p);
    1957        6272 :       break;
    1958           0 :     default: pari_err_TYPE("mspathlog",p);
    1959             :   }
    1960       54432 :   return p;
    1961             : }
    1962             : /* Expresses path p as \sum x_i g_i, where the g_i are our distinguished
    1963             :  * generators and x_i \in Z[\Gamma]. Returns [x_1,...,x_n] */
    1964             : GEN
    1965       12691 : mspathlog(GEN W, GEN p)
    1966             : {
    1967       12691 :   pari_sp av = avma;
    1968       12691 :   checkms(W);
    1969       12691 :   return gc_GEN(av, M2_log(W, path_to_M2(p)));
    1970             : }
    1971             : 
    1972             : /** HECKE OPERATORS **/
    1973             : /* [a,b;c,d] * cusp */
    1974             : static GEN
    1975     2733696 : cusp_mul(long a, long b, long c, long d, GEN cusp)
    1976             : {
    1977     2733696 :   long x = cusp[1], y = cusp[2];
    1978     2733696 :   long A = a*x+b*y, B = c*x+d*y, u = cgcd(A,B);
    1979     2733696 :   if (u != 1) { A /= u; B /= u; }
    1980     2733696 :   return mkcol2s(A, B);
    1981             : }
    1982             : /* f in Gl2(Q), act on path (zm), return path_to_M2(f.path) */
    1983             : static GEN
    1984     1366848 : Gl2Q_act_path(GEN f, GEN path)
    1985             : {
    1986     1366848 :   long a = coeff(f,1,1), b = coeff(f,1,2);
    1987     1366848 :   long c = coeff(f,2,1), d = coeff(f,2,2);
    1988     1366848 :   GEN c1 = cusp_mul(a,b,c,d, gel(path,1));
    1989     1366848 :   GEN c2 = cusp_mul(a,b,c,d, gel(path,2));
    1990     1366848 :   return mkmat2(c1,c2);
    1991             : }
    1992             : 
    1993             : static GEN
    1994     2561678 : init_act_trivial(GEN W) { return const_vecsmall(ms_get_nbE1(W), 0); }
    1995             : static GEN
    1996       41734 : mspathlog_trivial(GEN W, GEN p)
    1997             : {
    1998             :   GEN v;
    1999       41734 :   W = get_msN(W);
    2000       41734 :   v = init_act_trivial(W);
    2001       41734 :   M2_log_trivial(v, W, path_to_M2(p));
    2002       41727 :   return v;
    2003             : }
    2004             : 
    2005             : /* map from W1=Hom(Delta_0(N1),Q) -> W2=Hom(Delta_0(N2),Q), weight 2,
    2006             :  * trivial action. v a t_VEC of Gl2_Q (\sum v[i] in Z[Gl2(Q)]).
    2007             :  * Return the matrix attached to the action of v. */
    2008             : static GEN
    2009        8575 : getMorphism_trivial(GEN WW1, GEN WW2, GEN v)
    2010             : {
    2011        8575 :   GEN T, section, gen, W1 = get_msN(WW1), W2 = get_msN(WW2);
    2012             :   long j, lv, d2;
    2013        8575 :   if (ms_get_N(W1) == 1) return cgetg(1,t_MAT);
    2014        8575 :   if (ms_get_N(W2) == 1) return zeromat(0, ms_get_nbE1(W1));
    2015        8575 :   section = msN_get_section(W2);
    2016        8575 :   gen = msN_get_genindex(W2);
    2017        8575 :   d2 = ms_get_nbE1(W2);
    2018        8575 :   T = cgetg(d2+1, t_MAT);
    2019        8575 :   lv = lg(v);
    2020      298991 :   for (j = 1; j <= d2; j++)
    2021             :   {
    2022      290416 :     GEN w = gel(section, gen[j]);
    2023      290416 :     GEN t = init_act_trivial(W1);
    2024      290416 :     pari_sp av = avma;
    2025             :     long l;
    2026     1496810 :     for (l = 1; l < lv; l++) M2_log_trivial(t, W1, Gl2Q_act_path(gel(v,l), w));
    2027      290416 :     gel(T,j) = t; set_avma(av);
    2028             :   }
    2029        8575 :   return shallowtrans(zm_to_ZM(T));
    2030             : }
    2031             : 
    2032             : static GEN
    2033      165522 : RgV_sparse(GEN v, GEN *pind)
    2034             : {
    2035             :   long i, l, k;
    2036      165522 :   GEN w = cgetg_copy(v,&l), ind = cgetg(l, t_VECSMALL);
    2037    17143112 :   for (i = k = 1; i < l; i++)
    2038             :   {
    2039    16977590 :     GEN c = gel(v,i);
    2040    16977590 :     if (typ(c) == t_INT) continue;
    2041      784798 :     gel(w,k) = c; ind[k] = i; k++;
    2042             :   }
    2043      165522 :   setlg(w,k); setlg(ind,k);
    2044      165522 :   *pind = ind; return w;
    2045             : }
    2046             : 
    2047             : static int
    2048      162568 : mat2_isidentity(GEN M)
    2049             : {
    2050      162568 :   GEN A = gel(M,1), B = gel(M,2);
    2051      162568 :   return A[1] == 1 && A[2] == 0 && B[1] == 0 && B[2] == 1;
    2052             : }
    2053             : /* path a mat22/mat22s, return log(f.path)^* . f in sparse form */
    2054             : static GEN
    2055      165522 : M2_logf(GEN Wp, GEN path, GEN f)
    2056             : {
    2057      165522 :   pari_sp av = avma;
    2058             :   GEN ind, L;
    2059             :   long i, l;
    2060      165522 :   if (f)
    2061      160454 :     path = Gl2Q_act_path(f, path);
    2062        5068 :   else if (typ(gel(path,1)) == t_VECSMALL)
    2063        2114 :     path = path2_to_M2(path);
    2064      165522 :   L = M2_log(Wp, path);
    2065      165522 :   L = RgV_sparse(L,&ind); l = lg(L);
    2066      950320 :   for (i = 1; i < l; i++) gel(L,i) = ZSl2_star(gel(L,i));
    2067      165522 :   if (f) ZGC_G_mul_inplace(L, mat2_to_ZM(f));
    2068      165522 :   return gc_GEN(av, mkvec2(ind,L));
    2069             : }
    2070             : 
    2071             : static hashtable *
    2072        3668 : Gl2act_cache(long dim) { return hash_create_GEN(dim*10, 1); }
    2073             : 
    2074             : /* f zm/ZM in Gl_2(Q), acts from the left on Delta, which is generated by
    2075             :  * (g_i) as Z[Gamma1]-module, and by (G_i) as Z[Gamma2]-module.
    2076             :  * We have f.G_j = \sum_i \lambda_{i,j} g_i,   \lambda_{i,j} in Z[Gamma1]
    2077             :  * For phi in Hom_Gamma1(D,V), g in D, phi | f is in Hom_Gamma2(D,V) and
    2078             :  *  (phi | f)(G_j) = phi(f.G_j) | f
    2079             :  *                 = phi( \sum_i \lambda_{i,j} g_i ) | f
    2080             :  *                 = \sum_i phi(g_i) | (\lambda_{i,j}^* f)
    2081             :  *                 = \sum_i phi(g_i) | \mu_{i,j}(f)
    2082             :  * More generally
    2083             :  *  (\sum_k (phi |v_k))(G_j) = \sum_i phi(g_i) | \Mu_{i,j}
    2084             :  * with \Mu_{i,j} = \sum_k \mu{i,j}(v_k)
    2085             :  * Return the \Mu_{i,j} matrix as vector of sparse columns of operators on V */
    2086             : static GEN
    2087        3192 : init_dual_act(GEN v, GEN W1, GEN W2, struct m_act *S)
    2088             : {
    2089        3192 :   GEN section = ms_get_section(W2), gen = ms_get_genindex(W2);
    2090             :   /* HACK: the actions we consider in dimension 1 are trivial and in
    2091             :    * characteristic != 2, 3 => torsion generators are 0
    2092             :    * [satisfy e.g. (1+gamma).g = 0 => \phi(g) | 1+gamma  = 0 => \phi(g) = 0 */
    2093        3192 :   long j, lv = lg(v), dim = S->dim == 1? ms_get_nbE1(W2): lg(gen)-1;
    2094        3192 :   GEN T = cgetg(dim+1, t_VEC);
    2095        3192 :   hashtable *H = Gl2act_cache(dim);
    2096       40929 :   for (j = 1; j <= dim; j++)
    2097             :   {
    2098       37737 :     pari_sp av = avma;
    2099       37737 :     GEN w = gel(section, gen[j]); /* path_to_zm( E1/T2/T3 element ) */
    2100       37737 :     GEN t = NULL;
    2101             :     long k;
    2102      200305 :     for (k = 1; k < lv; k++)
    2103             :     {
    2104      162568 :       GEN tk, f = gel(v,k);
    2105      162568 :       if (typ(gel(f,1)) != t_VECSMALL) f = ZM_to_zm(f);
    2106      162568 :       if (mat2_isidentity(f)) f = NULL;
    2107      162568 :       tk = M2_logf(W1, w, f); /* mu_{.,j}(v[k]) as sparse vector */
    2108      162568 :       t = t? ZGCs_add(t, tk): tk;
    2109             :     }
    2110       37737 :     gel(T,j) = gc_GEN(av, t);
    2111             :   }
    2112       40929 :   for (j = 1; j <= dim; j++)
    2113             :   {
    2114       37737 :     ZGl2QC_preload(S, gel(T,j), H);
    2115       37737 :     ZGl2QC_to_act(S, gel(T,j), H);
    2116             :   }
    2117        3192 :   return T;
    2118             : }
    2119             : 
    2120             : /* modular symbol given by phi[j] = \phi(G_j)
    2121             :  * \sum L[i]*phi[i], L a sparse column of operators */
    2122             : static GEN
    2123      354354 : dense_act_col(GEN col, GEN phi)
    2124             : {
    2125      354354 :   GEN s = NULL, colind = gel(col,1), colval = gel(col,2);
    2126      354354 :   long i, l = lg(colind), lphi = lg(phi);
    2127     5630121 :   for (i = 1; i < l; i++)
    2128             :   {
    2129     5278490 :     long a = colind[i];
    2130             :     GEN t;
    2131     5278490 :     if (a >= lphi) break; /* happens if k=2: torsion generator t omitted */
    2132     5275767 :     t = gel(phi, a); /* phi(G_a) */
    2133     5275767 :     t = RgM_RgC_mul(gel(colval,i), t);
    2134     5275767 :     s = s? RgC_add(s, t): t;
    2135             :   }
    2136      354354 :   return s;
    2137             : }
    2138             : /* modular symbol given by \phi( G[ind[j]] ) = val[j]
    2139             :  * \sum L[i]*phi[i], L a sparse column of operators */
    2140             : static GEN
    2141      779093 : sparse_act_col(GEN col, GEN phi)
    2142             : {
    2143      779093 :   GEN s = NULL, colind = gel(col,1), colval = gel(col,2);
    2144      779093 :   GEN ind = gel(phi,2), val = gel(phi,3);
    2145      779093 :   long a, l = lg(ind);
    2146      779093 :   if (lg(gel(phi,1)) == 1) return RgM_RgC_mul(gel(colval,1), gel(val,1));
    2147     3033205 :   for (a = 1; a < l; a++)
    2148             :   {
    2149     2254413 :     GEN t = gel(val, a); /* phi(G_i) */
    2150     2254413 :     long i = zv_search(colind, ind[a]);
    2151     2254413 :     if (!i) continue;
    2152      540603 :     t = RgM_RgC_mul(gel(colval,i), t);
    2153      540603 :     s = s? RgC_add(s, t): t;
    2154             :   }
    2155      778792 :   return s;
    2156             : }
    2157             : static int
    2158       69139 : phi_sparse(GEN phi) { return typ(gel(phi,1)) == t_VECSMALL; }
    2159             : /* phi in Hom_Gamma1(Delta, V), return the matrix whose colums are the
    2160             :  *   \sum_i phi(g_i) | \mu_{i,j} = (phi|f)(G_j),
    2161             :  * see init_dual_act. */
    2162             : static GEN
    2163       69139 : dual_act(long dimV, GEN act, GEN phi)
    2164             : {
    2165       69139 :   long l = lg(act), j;
    2166       69139 :   GEN v = cgetg(l, t_MAT);
    2167       69139 :   GEN (*ACT)(GEN,GEN) = phi_sparse(phi)? sparse_act_col: dense_act_col;
    2168     1199254 :   for (j = 1; j < l; j++)
    2169             :   {
    2170     1130115 :     pari_sp av = avma;
    2171     1130115 :     GEN s = ACT(gel(act,j), phi);
    2172     1130115 :     gel(v,j) = s? gc_upto(av,s): zerocol(dimV);
    2173             :   }
    2174       69139 :   return v;
    2175             : }
    2176             : 
    2177             : /* in level N > 1 */
    2178             : static void
    2179       59087 : msk_get_st(GEN W, long *s, long *t)
    2180       59087 : { GEN st = gmael(W,3,3); *s = st[1]; *t = st[2]; }
    2181             : static GEN
    2182       59087 : msk_get_link(GEN W) { return gmael(W,3,4); }
    2183             : static GEN
    2184       59402 : msk_get_inv(GEN W) { return gmael(W,3,5); }
    2185             : /* \phi in Hom(Delta, V), \phi(G_k) = phi[k]. Write \phi as
    2186             :  *   \sum_{i,j} mu_{i,j} phi_{i,j}, mu_{i,j} in Q */
    2187             : static GEN
    2188       59402 : getMorphism_basis(GEN W, GEN phi)
    2189             : {
    2190       59402 :   GEN R, Q, Ls, T0, T1, Ts, link, basis, inv = msk_get_inv(W);
    2191             :   long i, j, r, s, t, dim, lvecT;
    2192             : 
    2193       59402 :   if (ms_get_N(W) == 1) return ZC_apply_dinv(inv, gel(phi,1));
    2194       59087 :   lvecT = lg(phi);
    2195       59087 :   basis = msk_get_basis(W);
    2196       59087 :   dim = lg(basis)-1;
    2197       59087 :   R = zerocol(dim);
    2198       59087 :   msk_get_st(W, &s, &t);
    2199       59087 :   link = msk_get_link(W);
    2200      789922 :   for (r = 2; r < lvecT; r++)
    2201             :   {
    2202             :     GEN Tr, L;
    2203      730835 :     if (r == s) continue;
    2204      671748 :     Tr = gel(phi,r); /* Phi(G_r), r != 1,s */
    2205      671748 :     L = gel(link, r);
    2206      671748 :     Q = ZC_apply_dinv(gel(inv,r), Tr);
    2207             :     /* write Phi(G_r) as sum_{a,b} mu_{a,b} Phi_{a,b}(G_r) */
    2208     3510668 :     for (j = 1; j < lg(L); j++) gel(R, L[j]) = gel(Q,j);
    2209             :   }
    2210       59087 :   Ls = gel(link, s);
    2211       59087 :   T1 = gel(phi,1); /* Phi(G_1) */
    2212       59087 :   gel(R, Ls[t]) = gel(T1, 1);
    2213             : 
    2214       59087 :   T0 = NULL;
    2215      789922 :   for (i = 2; i < lg(link); i++)
    2216             :   {
    2217             :     GEN L;
    2218      730835 :     if (i == s) continue;
    2219      671748 :     L = gel(link,i);
    2220     3510668 :     for (j =1 ; j < lg(L); j++)
    2221             :     {
    2222     2838920 :       long n = L[j]; /* phi_{i,j} = basis[n] */
    2223     2838920 :       GEN mu_ij = gel(R, n);
    2224     2838920 :       GEN phi_ij = gel(basis, n), pols = gel(phi_ij,3);
    2225     2838920 :       GEN z = RgC_Rg_mul(gel(pols, 3), mu_ij);
    2226     2838920 :       T0 = T0? RgC_add(T0, z): z; /* += mu_{i,j} Phi_{i,j} (G_s) */
    2227             :     }
    2228             :   }
    2229       59087 :   Ts = gel(phi,s); /* Phi(G_s) */
    2230       59087 :   if (T0) Ts = RgC_sub(Ts, T0);
    2231             :   /* solve \sum_{j!=t} mu_{s,j} Phi_{s,j}(G_s) = Ts */
    2232       59087 :   Q = ZC_apply_dinv(gel(inv,s), Ts);
    2233      234080 :   for (j = 1; j < t; j++) gel(R, Ls[j]) = gel(Q,j);
    2234             :   /* avoid mu_{s,t} */
    2235       59906 :   for (j = t; j < lg(Q); j++) gel(R, Ls[j+1]) = gel(Q,j);
    2236       59087 :   return R;
    2237             : }
    2238             : 
    2239             : /* a = s(g_i) for some modular symbol s; b in Z[G]
    2240             :  * return s(b.g_i) = b^* . s(g_i) */
    2241             : static GEN
    2242      115626 : ZGl2Q_act_s(GEN b, GEN a, long k)
    2243             : {
    2244      115626 :   if (typ(b) == t_INT)
    2245             :   {
    2246       58604 :     if (!signe(b)) return gen_0;
    2247          14 :     switch(typ(a))
    2248             :     {
    2249          14 :       case t_POL:
    2250          14 :         a = RgX_to_RgC(a, k-1); /*fall through*/
    2251          14 :       case t_COL:
    2252          14 :         a = RgC_Rg_mul(a,b);
    2253          14 :         break;
    2254           0 :       default: a = scalarcol_shallow(b,k-1);
    2255             :     }
    2256             :   }
    2257             :   else
    2258             :   {
    2259       57022 :     b = RgX_act_ZGl2Q(ZSl2_star(b), k);
    2260       57022 :     switch(typ(a))
    2261             :     {
    2262          63 :       case t_POL:
    2263          63 :         a = RgX_to_RgC(a, k-1); /*fall through*/
    2264       45262 :       case t_COL:
    2265       45262 :         a = RgM_RgC_mul(b,a);
    2266       45262 :         break;
    2267       11760 :       default: a = RgC_Rg_mul(gel(b,1),a);
    2268             :     }
    2269             :   }
    2270       57036 :   return a;
    2271             : }
    2272             : 
    2273             : static int
    2274          21 : checksymbol(GEN W, GEN s)
    2275             : {
    2276             :   GEN t, annT2, annT31, singlerel;
    2277             :   long i, k, l, nbE1, nbT2, nbT31;
    2278          21 :   k = msk_get_weight(W);
    2279          21 :   W = get_msN(W);
    2280          21 :   nbE1 = ms_get_nbE1(W);
    2281          21 :   singlerel = gel(W,10);
    2282          21 :   l = lg(singlerel);
    2283          21 :   if (k == 2)
    2284             :   {
    2285           0 :     for (i = nbE1+1; i < l; i++)
    2286           0 :       if (!gequal0(gel(s,i))) return 0;
    2287           0 :     return 1;
    2288             :   }
    2289          21 :   annT2 = msN_get_annT2(W); nbT2 = lg(annT2)-1;
    2290          21 :   annT31 = msN_get_annT31(W);nbT31 = lg(annT31)-1;
    2291          21 :   t = NULL;
    2292          84 :   for (i = 1; i < l; i++)
    2293             :   {
    2294          63 :     GEN a = gel(s,i);
    2295          63 :     a = ZGl2Q_act_s(gel(singlerel,i), a, k);
    2296          63 :     t = t? gadd(t, a): a;
    2297             :   }
    2298          21 :   if (!gequal0(t)) return 0;
    2299          14 :   for (i = 1; i <= nbT2; i++)
    2300             :   {
    2301           0 :     GEN a = gel(s,i + nbE1);
    2302           0 :     a = ZGl2Q_act_s(gel(annT2,i), a, k);
    2303           0 :     if (!gequal0(a)) return 0;
    2304             :   }
    2305          28 :   for (i = 1; i <= nbT31; i++)
    2306             :   {
    2307          14 :     GEN a = gel(s,i + nbE1 + nbT2);
    2308          14 :     a = ZGl2Q_act_s(gel(annT31,i), a, k);
    2309          14 :     if (!gequal0(a)) return 0;
    2310             :   }
    2311          14 :   return 1;
    2312             : }
    2313             : GEN
    2314          56 : msissymbol(GEN W, GEN s)
    2315             : {
    2316             :   long k, nbgen;
    2317          56 :   checkms(W);
    2318          56 :   k = msk_get_weight(W);
    2319          56 :   nbgen = ms_get_nbgen(W);
    2320          56 :   switch(typ(s))
    2321             :   {
    2322          21 :     case t_VEC: /* values s(g_i) */
    2323          21 :       if (lg(s)-1 != nbgen) return gen_0;
    2324          21 :       break;
    2325          28 :     case t_COL:
    2326          28 :       if (msk_get_sign(W))
    2327             :       {
    2328           0 :         GEN star = gel(msk_get_starproj(W), 1);
    2329           0 :         if (lg(star) == lg(s)) return gen_1;
    2330             :       }
    2331          28 :       if (k == 2) /* on the dual basis of (g_i) */
    2332             :       {
    2333           0 :         if (lg(s)-1 != nbgen) return gen_0;
    2334             :       }
    2335             :       else
    2336             :       {
    2337          28 :         GEN basis = msk_get_basis(W);
    2338          28 :         return (lg(s) == lg(basis))? gen_1: gen_0;
    2339             :       }
    2340           0 :       break;
    2341           7 :     case t_MAT:
    2342             :     {
    2343           7 :       long i, l = lg(s);
    2344           7 :       GEN v = cgetg(l, t_VEC);
    2345          21 :       for (i = 1; i < l; i++) gel(v,i) = msissymbol(W,gel(s,i))? gen_1: gen_0;
    2346           7 :       return v;
    2347             :     }
    2348           0 :     default: return gen_0;
    2349             :   }
    2350          21 :   return checksymbol(W,s)? gen_1: gen_0;
    2351             : }
    2352             : 
    2353             : /* map op: W1 = Hom(Delta_0(N1),V) -> W2 = Hom(Delta_0(N2),V), given by
    2354             :  * \sum v[i], v[i] in Gl2(Q) */
    2355             : static GEN
    2356       11284 : getMorphism(GEN W1, GEN W2, GEN v)
    2357             : {
    2358             :   struct m_act S;
    2359             :   GEN B1, M, act;
    2360       11284 :   long a, l, k = msk_get_weight(W1);
    2361       11284 :   if (k == 2) return getMorphism_trivial(W1,W2,v);
    2362        2709 :   S.k = k;
    2363        2709 :   S.dim = k-1;
    2364        2709 :   S.act = &_RgX_act_Gl2Q;
    2365        2709 :   act = init_dual_act(v,W1,W2,&S);
    2366        2709 :   B1 = msk_get_basis(W1);
    2367        2709 :   l = lg(B1); M = cgetg(l, t_MAT);
    2368       61180 :   for (a = 1; a < l; a++)
    2369             :   {
    2370       58471 :     pari_sp av = avma;
    2371       58471 :     GEN phi = dual_act(S.dim, act, gel(B1,a));
    2372       58471 :     GEN D = getMorphism_basis(W2, phi);
    2373       58471 :     gel(M,a) = gc_GEN(av, D);
    2374             :   }
    2375        2709 :   return M;
    2376             : }
    2377             : static GEN
    2378       10122 : msendo(GEN W, GEN v) { return getMorphism(W, W, v); }
    2379             : 
    2380             : static GEN
    2381        2527 : endo_project(GEN W, GEN e, GEN H)
    2382             : {
    2383        2527 :   if (msk_get_sign(W)) e = Qevproj_apply(e, msk_get_starproj(W));
    2384        2527 :   if (H) e = Qevproj_apply(e, Qevproj_init0(H));
    2385        2527 :   return e;
    2386             : }
    2387             : static GEN
    2388        6146 : mshecke_i(GEN W, ulong p)
    2389             : {
    2390        6146 :   GEN v = ms_get_N(W) % p? Tp_matrices(p): Up_matrices(p);
    2391        6146 :   return msendo(W,v);
    2392             : }
    2393             : GEN
    2394        2478 : mshecke(GEN W, long p, GEN H)
    2395             : {
    2396        2478 :   pari_sp av = avma;
    2397             :   GEN T;
    2398        2478 :   checkms(W);
    2399        2478 :   if (p <= 1) pari_err_PRIME("mshecke",stoi(p));
    2400        2478 :   T = mshecke_i(W,p);
    2401        2478 :   T = endo_project(W,T,H);
    2402        2478 :   return gc_GEN(av, T);
    2403             : }
    2404             : 
    2405             : static GEN
    2406          42 : msatkinlehner_i(GEN W, long Q)
    2407             : {
    2408          42 :   long N = ms_get_N(W);
    2409             :   GEN v;
    2410          42 :   if (Q == 1) return matid(msk_get_dim(W));
    2411          28 :   if (Q == N) return msendo(W, mkvec(mat2(0,1,-N,0)));
    2412          21 :   if (N % Q) pari_err_DOMAIN("msatkinlehner","N % Q","!=",gen_0,stoi(Q));
    2413          14 :   v = WQ_matrix(N, Q);
    2414          14 :   if (!v) pari_err_DOMAIN("msatkinlehner","gcd(Q,N/Q)","!=",gen_1,stoi(Q));
    2415          14 :   return msendo(W,mkvec(v));
    2416             : }
    2417             : GEN
    2418          42 : msatkinlehner(GEN W, long Q, GEN H)
    2419             : {
    2420          42 :   pari_sp av = avma;
    2421             :   GEN w;
    2422             :   long k;
    2423          42 :   checkms(W);
    2424          42 :   k = msk_get_weight(W);
    2425          42 :   if (Q <= 0) pari_err_DOMAIN("msatkinlehner","Q","<=",gen_0,stoi(Q));
    2426          42 :   w = msatkinlehner_i(W,Q);
    2427          35 :   w = endo_project(W,w,H);
    2428          35 :   if (k > 2 && Q != 1) w = RgM_Rg_div(w, powuu(Q,(k-2)>>1));
    2429          35 :   return gc_GEN(av, w);
    2430             : }
    2431             : 
    2432             : static GEN
    2433        3955 : msstar_i(GEN W) { return msendo(W, mkvec(mat2(-1,0,0,1))); }
    2434             : GEN
    2435          14 : msstar(GEN W, GEN H)
    2436             : {
    2437          14 :   pari_sp av = avma;
    2438             :   GEN s;
    2439          14 :   checkms(W);
    2440          14 :   s = msstar_i(W);
    2441          14 :   s = endo_project(W,s,H);
    2442          14 :   return gc_GEN(av, s);
    2443             : }
    2444             : 
    2445             : #if 0
    2446             : /* is \Gamma_0(N) cusp1 = \Gamma_0(N) cusp2 ? */
    2447             : static int
    2448             : iscuspeq(ulong N, GEN cusp1, GEN cusp2)
    2449             : {
    2450             :   long p1, q1, p2, q2, s1, s2, d;
    2451             :   p1 = cusp1[1]; p2 = cusp2[1];
    2452             :   q1 = cusp1[2]; q2 = cusp2[2];
    2453             :   d = Fl_mul(umodsu(q1,N),umodsu(q2,N), N);
    2454             :   d = ugcd(d, N);
    2455             : 
    2456             :   s1 = q1 > 2? Fl_inv(umodsu(p1,q1), q1): 1;
    2457             :   s2 = q2 > 2? Fl_inv(umodsu(p2,q2), q2): 1;
    2458             :   return Fl_mul(s1,q2,d) == Fl_mul(s2,q1,d);
    2459             : }
    2460             : #endif
    2461             : 
    2462             : /* return E_c(r) */
    2463             : static GEN
    2464        2604 : get_Ec_r(GEN c, long k)
    2465             : {
    2466        2604 :   long p = c[1], q = c[2], u, v;
    2467             :   GEN gr;
    2468        2604 :   (void)cbezout(p, q, &u, &v);
    2469        2604 :   gr = mat2(p, -v, q, u); /* g . (1:0) = (p:q) */
    2470        2604 :   return voo_act_Gl2Q(sl2_inv(gr), k);
    2471             : }
    2472             : /* N > 1; returns the modular symbol attached to the cusp c := p/q via the rule
    2473             :  * E_c(path from a to b in Delta_0) := E_c(b) - E_c(a), where
    2474             :  * E_c(r) := 0 if r != c mod Gamma
    2475             :  *           v_oo | gamma_r^(-1)
    2476             :  * where v_oo is stable by T = [1,1;0,1] (i.e x^(k-2)) and
    2477             :  * gamma_r . (1:0) = r, for some gamma_r in SL_2(Z) * */
    2478             : static GEN
    2479         462 : msfromcusp_trivial(GEN W, GEN c)
    2480             : {
    2481         462 :   GEN section = ms_get_section(W), gen = ms_get_genindex(W);
    2482         462 :   GEN S = ms_get_hashcusps(W);
    2483         462 :   long j, ic = cusp_index(c, S), l = ms_get_nbE1(W)+1;
    2484         462 :   GEN phi = cgetg(l, t_COL);
    2485       90356 :   for (j = 1; j < l; j++)
    2486             :   {
    2487       89894 :     GEN vj, g = gel(section, gen[j]); /* path_to_zm(generator) */
    2488       89894 :     GEN c1 = gel(g,1), c2 = gel(g,2);
    2489       89894 :     long i1 = cusp_index(c1, S);
    2490       89894 :     long i2 = cusp_index(c2, S);
    2491       89894 :     if (i1 == ic)
    2492        3290 :       vj = (i2 == ic)?  gen_0: gen_1;
    2493             :     else
    2494       86604 :       vj = (i2 == ic)? gen_m1: gen_0;
    2495       89894 :     gel(phi, j) = vj;
    2496             :   }
    2497         462 :   return phi;
    2498             : }
    2499             : static GEN
    2500        1393 : msfromcusp_i(GEN W, GEN c)
    2501             : {
    2502             :   GEN section, gen, S, phi;
    2503        1393 :   long j, ic, l, k = msk_get_weight(W);
    2504        1393 :   if (k == 2)
    2505             :   {
    2506         462 :     long N = ms_get_N(W);
    2507         462 :     return N == 1? cgetg(1,t_COL): msfromcusp_trivial(W, c);
    2508             :   }
    2509         931 :   k = msk_get_weight(W);
    2510         931 :   section = ms_get_section(W);
    2511         931 :   gen = ms_get_genindex(W);
    2512         931 :   S = ms_get_hashcusps(W);
    2513         931 :   ic = cusp_index(c, S);
    2514         931 :   l = lg(gen);
    2515         931 :   phi = cgetg(l, t_COL);
    2516       12075 :   for (j = 1; j < l; j++)
    2517             :   {
    2518       11144 :     GEN vj = NULL, g = gel(section, gen[j]); /* path_to_zm(generator) */
    2519       11144 :     GEN c1 = gel(g,1), c2 = gel(g,2);
    2520       11144 :     long i1 = cusp_index(c1, S);
    2521       11144 :     long i2 = cusp_index(c2, S);
    2522       11144 :     if (i1 == ic) vj = get_Ec_r(c1, k);
    2523       11144 :     if (i2 == ic)
    2524             :     {
    2525        1302 :       GEN s = get_Ec_r(c2, k);
    2526        1302 :       vj = vj? gsub(vj, s): gneg(s);
    2527             :     }
    2528       11144 :     if (!vj) vj = zerocol(k-1);
    2529       11144 :     gel(phi, j) = vj;
    2530             :   }
    2531         931 :   return getMorphism_basis(W, phi);
    2532             : }
    2533             : GEN
    2534          28 : msfromcusp(GEN W, GEN c)
    2535             : {
    2536          28 :   pari_sp av = avma;
    2537             :   long N;
    2538          28 :   checkms(W);
    2539          28 :   N = ms_get_N(W);
    2540          28 :   switch(typ(c))
    2541             :   {
    2542           7 :     case t_INFINITY:
    2543           7 :       c = mkvecsmall2(1,0);
    2544           7 :       break;
    2545          14 :     case t_INT:
    2546          14 :       c = mkvecsmall2(smodis(c,N), 1);
    2547          14 :       break;
    2548           7 :     case t_FRAC:
    2549           7 :       c = mkvecsmall2(smodis(gel(c,1),N), smodis(gel(c,2),N));
    2550           7 :       break;
    2551           0 :     default:
    2552           0 :       pari_err_TYPE("msfromcusp",c);
    2553             :   }
    2554          28 :   return gc_GEN(av, msfromcusp_i(W,c));
    2555             : }
    2556             : 
    2557             : static GEN
    2558         287 : mseisenstein_i(GEN W)
    2559             : {
    2560         287 :   GEN M, S = ms_get_hashcusps(W), cusps = gel(S,3);
    2561         287 :   long i, l = lg(cusps);
    2562         287 :   if (msk_get_weight(W)==2) l--;
    2563         287 :   M = cgetg(l, t_MAT);
    2564        1652 :   for (i = 1; i < l; i++) gel(M,i) = msfromcusp_i(W, gel(cusps,i));
    2565         287 :   return Qevproj_init(Qevproj_star(W, QM_image_shallow(M)));
    2566             : }
    2567             : GEN
    2568          21 : mseisenstein(GEN W)
    2569             : {
    2570          21 :   pari_sp av = avma;
    2571          21 :   checkms(W); return gc_GEN(av, mseisenstein_i(W));
    2572             : }
    2573             : 
    2574             : /* upper bound for log_2 |charpoly(T_p|S)|, where S is a cuspidal subspace of
    2575             :  * dimension d, k is the weight */
    2576             : #if 0
    2577             : static long
    2578             : TpS_char_bound(ulong p, long k, long d)
    2579             : { /* |eigenvalue| <= 2 p^(k-1)/2 */
    2580             :   return d * (2 + (log2((double)p)*(k-1))/2);
    2581             : }
    2582             : #endif
    2583             : static long
    2584         266 : TpE_char_bound(ulong p, long k, long d)
    2585             : { /* |eigenvalue| <= 2 p^(k-1) */
    2586         266 :   return d * (2 + log2((double)p)*(k-1));
    2587             : }
    2588             : 
    2589             : static GEN eisker(GEN M);
    2590             : static int
    2591         294 : use_Petersson(long N, long k, long s)
    2592             : {
    2593         294 :   if (!s)
    2594             :   {
    2595          70 :     if (N == 1)  return 1;
    2596          49 :     if (N <= 3)  return k >= 42;
    2597          42 :     if (N == 4)  return k >= 30;
    2598          42 :     if (N == 5)  return k >= 20;
    2599          42 :     if (N <= 10) return k >= 14;
    2600          35 :     if (N <= 16) return k >= 10;
    2601           7 :     if (N <= 28) return k >= 8;
    2602           7 :     if (N <= 136 || N == 180 || N == 200 || N == 225) return k >= 6;
    2603           0 :     return k >= 4;
    2604             :   }
    2605         224 :   if (s < 0)
    2606             :   {
    2607           0 :     if (N <= 64 || N == 100 || N == 128 || N == 144 || N == 225
    2608           0 :         || N == 351 || N == 375) return k >= 8;
    2609           0 :     return k >= 6;
    2610             :   }
    2611         224 :   if (N == 1) return 1;
    2612         217 :   if (N == 2) return k >= 56;
    2613         217 :   if (N == 3) return k >= 68;
    2614         182 :   if (N == 4) return k >= 78;
    2615         175 :   if (N == 5) return k >= 38;
    2616         147 :   if (N == 6) return k >= 24;
    2617         147 :   if (N == 7) return k >= 44;
    2618         140 :   if (N <= 9) return k >= 28;
    2619         133 :   if (N <= 13) return k >= 20;
    2620          98 :   if (N <= 21 || N == 50) return k >= 14;
    2621          70 :   if (N == 24 || N == 25) return k >= 16;
    2622          70 :   if (N <= 58 || N == 63 || N == 72 || N == 84 || N == 208 || N == 224) return k >= 10;
    2623          42 :   if (N <= 128 || N == 144 || N == 145 || N == 160 || N == 168 || N == 175 ||
    2624          21 :       N == 180 || N == 252 || N == 253 || N == 273 || N == 320 || N == 335 ||
    2625          42 :       N == 336 || N == 345 || N == 360) return k >= 8;
    2626          21 :   return k >= 6;
    2627             : }
    2628             : /* eisspace^-(N) = 0 */
    2629             : static int
    2630          49 : isminustriv(GEN F)
    2631             : {
    2632          49 :   GEN P = gel(F,1), E = gel(F,2);
    2633          49 :   long i = 1, l = lg(P);
    2634          49 :   if (l == 1) return 1;
    2635          49 :   if (P[1] == 2)
    2636             :   {
    2637           7 :     if (E[1] >= 4) return 0;
    2638           7 :     i++;
    2639             :   }
    2640          98 :   for (; i < l; i++)
    2641          49 :     if (E[i] > 1) return 0;
    2642          49 :   return 1;
    2643             : }
    2644             : 
    2645             : GEN
    2646         343 : mscuspidal(GEN W, long flag)
    2647             : {
    2648         343 :   pari_sp av = avma;
    2649             :   GEN M, E, S;
    2650             :   ulong p, N;
    2651             :   long k, s;
    2652             : 
    2653         343 :   checkms(W);
    2654         343 :   N = ms_get_N(W);
    2655         343 :   k = msk_get_weight(W);
    2656         343 :   s = msk_get_sign(W);
    2657         343 :   E = flag? mseisenstein_i(W): NULL;
    2658         343 :   if (s < 0 && isminustriv(factoru(N))) M = matid(msdim(W));
    2659         294 :   else if (use_Petersson(N, k, s)) M = eisker(W);
    2660             :   else
    2661             :   {
    2662             :     GEN dT, T, TE, chE;
    2663             :     forprime_t F;
    2664             :     long bit;
    2665             :     pari_timer ti;
    2666             : 
    2667         266 :     if (!E) E = mseisenstein_i(W);
    2668         266 :     (void)u_forprime_init(&F, 2, ULONG_MAX);
    2669         392 :     while ((p = u_forprime_next(&F)))
    2670         392 :       if (N % p) break;
    2671         266 :     if (DEBUGLEVEL) timer_start(&ti);
    2672         266 :     T = mshecke(W, p, NULL);
    2673         266 :     if (DEBUGLEVEL) timer_printf(&ti,"Tp, p = %ld", p);
    2674         266 :     TE = Qevproj_apply(T, E); /* T_p | E */
    2675         266 :     if (DEBUGLEVEL) timer_printf(&ti,"Qevproj_init(E)");
    2676         266 :     bit = TpE_char_bound(p, k, lg(TE)-1);
    2677         266 :     chE = QM_charpoly_ZX_bound(TE, bit);
    2678         266 :     chE = ZX_radical(chE);
    2679         266 :     T = Q_remove_denom(T, &dT);
    2680         266 :     if (dT) chE = ZX_rescale(chE, dT);
    2681         266 :     M = RgX_RgM_eval(chE, T);
    2682         266 :     M = QM_image_shallow(M); /* = Im chE(T / dT) */
    2683             :   }
    2684         343 :   S = Qevproj_init(M);
    2685         343 :   return gc_GEN(av, flag? mkvec2(S,E): S);
    2686             : }
    2687             : 
    2688             : /** INIT ELLSYM STRUCTURE **/
    2689             : /* V a vector of ZM. If all of them have 0 last row, return NULL.
    2690             :  * Otherwise return [m,i,j], where m = V[i][last,j] contains the value
    2691             :  * of smallest absolute value */
    2692             : static GEN
    2693         945 : RgMV_find_non_zero_last_row(long offset, GEN V)
    2694             : {
    2695         945 :   long i, lasti = 0, lastj = 0, lV = lg(V);
    2696         945 :   GEN m = NULL;
    2697        4109 :   for (i = 1; i < lV; i++)
    2698             :   {
    2699        3164 :     GEN M = gel(V,i);
    2700        3164 :     long j, n, l = lg(M);
    2701        3164 :     if (l == 1) continue;
    2702        2849 :     n = nbrows(M);
    2703       13860 :     for (j = 1; j < l; j++)
    2704             :     {
    2705       11011 :       GEN a = gcoeff(M, n, j);
    2706       11011 :       if (!gequal0(a) && (!m || abscmpii(a, m) < 0))
    2707             :       {
    2708        1596 :         m = a; lasti = i; lastj = j;
    2709        1596 :         if (is_pm1(m)) goto END;
    2710             :       }
    2711             :     }
    2712             :   }
    2713         945 : END:
    2714         945 :   if (!m) return NULL;
    2715         630 :   return mkvec2(m, mkvecsmall2(lasti+offset, lastj));
    2716             : }
    2717             : /* invert the d_oo := (\gamma_oo - 1) operator, acting on
    2718             :  * [x^(k-2), ..., y^(k-2)] */
    2719             : static GEN
    2720         630 : Delta_inv(GEN doo, long k)
    2721             : {
    2722         630 :   GEN M = RgX_act_ZGl2Q(doo, k);
    2723         630 :   M = RgM_minor(M, k-1, 1); /* 1st column and last row are 0 */
    2724         630 :   return ZM_inv_denom(M);
    2725             : }
    2726             : /* The ZX P = \sum a_i x^i y^{k-2-i} is given by the ZV [a_0, ..., a_k-2]~,
    2727             :  * return Q and d such that P = doo Q + d y^k-2, where d in Z and Q */
    2728             : static GEN
    2729       12873 : doo_decompose(GEN dinv, GEN P, GEN *pd)
    2730             : {
    2731       12873 :   long l = lg(P); *pd = gel(P, l-1);
    2732       12873 :   P = vecslice(P, 1, l-2);
    2733       12873 :   return vec_prepend(ZC_apply_dinv(dinv, P), gen_0);
    2734             : }
    2735             : 
    2736             : static GEN
    2737       12873 : get_phi_ij(long i,long j,long n, long s,long t,GEN P_st,GEN Q_st,GEN d_st,
    2738             :            GEN P_ij, GEN lP_ij, GEN dinv)
    2739             : {
    2740             :   GEN ind, pols;
    2741       12873 :   if (i == s && j == t)
    2742             :   {
    2743         630 :     ind = mkvecsmall(1);
    2744         630 :     pols = mkvec(scalarcol_shallow(gen_1, lg(P_st)-1)); /* x^{k-2} */
    2745             :   }
    2746             :   else
    2747             :   {
    2748       12243 :     GEN d_ij, Q_ij = doo_decompose(dinv, lP_ij, &d_ij);
    2749       12243 :     GEN a = ZC_Z_mul(P_ij, d_st);
    2750       12243 :     GEN b = ZC_Z_mul(P_st, negi(d_ij));
    2751       12243 :     GEN c = RgC_sub(RgC_Rg_mul(Q_ij, d_st), RgC_Rg_mul(Q_st, d_ij));
    2752       12243 :     if (i == s) { /* j != t */
    2753        1659 :       ind = mkvecsmall2(1, s);
    2754        1659 :       pols = mkvec2(c, ZC_add(a, b));
    2755             :     } else {
    2756       10584 :       ind = mkvecsmall3(1, i, s);
    2757       10584 :       pols = mkvec3(c, a, b); /* image of g_1, g_i, g_s */
    2758             :     }
    2759       12243 :     pols = Q_primpart(pols);
    2760             :   }
    2761       12873 :   return mkvec3(mkvecsmall3(i,j,n), ind, pols);
    2762             : }
    2763             : 
    2764             : static GEN
    2765        3297 : mskinit_trivial(GEN WN)
    2766             : {
    2767        3297 :   long dim = ms_get_nbE1(WN);
    2768        3297 :   return mkvec3(WN, gen_0, mkvec2(gen_0,mkvecsmall2(2, dim)));
    2769             : }
    2770             : /* sum of #cols of the matrices contained in V */
    2771             : static long
    2772        1260 : RgMV_dim(GEN V)
    2773             : {
    2774        1260 :   long l = lg(V), d = 0, i;
    2775        1764 :   for (i = 1; i < l; i++) d += lg(gel(V,i)) - 1;
    2776        1260 :   return d;
    2777             : }
    2778             : static GEN
    2779         630 : mskinit_nontrivial(GEN WN, long k)
    2780             : {
    2781         630 :   GEN annT2 = gel(WN,8), annT31 = gel(WN,9), singlerel = gel(WN,10);
    2782             :   GEN link, basis, monomials, Inv;
    2783         630 :   long nbE1 = ms_get_nbE1(WN);
    2784         630 :   GEN dinv = Delta_inv(ZG_neg( ZSl2_star(gel(singlerel,1)) ), k);
    2785         630 :   GEN p1 = cgetg(nbE1+1, t_VEC), remove;
    2786         630 :   GEN p2 = ZGV_tors(annT2, k);
    2787         630 :   GEN p3 = ZGV_tors(annT31, k);
    2788         630 :   GEN gentor = shallowconcat(p2, p3);
    2789             :   GEN P_st, lP_st, Q_st, d_st;
    2790             :   long n, i, dim, s, t, u;
    2791         630 :   gel(p1, 1) = cgetg(1,t_MAT); /* dummy */
    2792        3381 :   for (i = 2; i <= nbE1; i++) /* skip 1st element = (\gamma_oo-1)g_oo */
    2793             :   {
    2794        2751 :     GEN z = gel(singlerel, i);
    2795        2751 :     gel(p1, i) = RgX_act_ZGl2Q(ZSl2_star(z), k);
    2796             :   }
    2797         630 :   remove = RgMV_find_non_zero_last_row(nbE1, gentor);
    2798         630 :   if (!remove) remove = RgMV_find_non_zero_last_row(0, p1);
    2799         630 :   if (!remove) pari_err_BUG("msinit [no y^k-2]");
    2800         630 :   remove = gel(remove,2); /* [s,t] */
    2801         630 :   s = remove[1];
    2802         630 :   t = remove[2];
    2803             :   /* +1 because of = x^(k-2), but -1 because of Manin relation */
    2804         630 :   dim = (k-1)*(nbE1-1) + RgMV_dim(p2) + RgMV_dim(p3);
    2805             :   /* Let (g_1,...,g_d) be the Gamma-generators of Delta, g_1 = g_oo.
    2806             :    * We describe modular symbols by the collection phi(g_1), ..., phi(g_d)
    2807             :    * \in V := Q[x,y]_{k-2}, with right Gamma action.
    2808             :    * For each i = 1, .., d, let V_i \subset V be the Q-vector space of
    2809             :    * allowed values for phi(g_i): with basis (P^{i,j}) given by the monomials
    2810             :    * x^(j-1) y^{k-2-(j-1)}, j = 1 .. k-1
    2811             :    * (g_i in E_1) or the solution of the torsion equations (1 + gamma)P = 0
    2812             :    * (g_i in T2) or (1 + gamma + gamma^2)P = 0 (g_i in T31). All such P
    2813             :    * are chosen in Z[x,y] with Q_content 1.
    2814             :    *
    2815             :    * The Manin relation (singlerel) is of the form \sum_i \lambda_i g_i = 0,
    2816             :    * where \lambda_i = 1 if g_i in T2 or T31, and \lambda_i = (1 - \gamma_i)
    2817             :    * for g_i in E1.
    2818             :    *
    2819             :    * If phi \in Hom_Gamma(Delta, V), it is defined by phi(g_i) := P_i in V
    2820             :    * with \sum_i P_i . \lambda_i^* = 0, where (\sum n_i g_i)^* :=
    2821             :    * \sum n_i \gamma_i^(-1).
    2822             :    *
    2823             :    * We single out gamma_1 / g_1 (g_oo in Pollack-Stevens paper) and
    2824             :    * write P_{i,j} \lambda_i^* =  Q_{i,j} (\gamma_1 - 1)^* + d_{i,j} y^{k-2}
    2825             :    * where d_{i,j} is a scalar and Q_{i,j} in V; we normalize Q_{i,j} to
    2826             :    * that the coefficient of x^{k-2} is 0.
    2827             :    *
    2828             :    * There exist (s,t) such that d_{s,t} != 0.
    2829             :    * A Q-basis of the (dual) space of modular symbols is given by the
    2830             :    * functions phi_{i,j}, 2 <= i <= d, 1 <= j <= k-1, mapping
    2831             :    *  g_1 -> d_{s,t} Q_{i,j} - d_{i,j} Q_{s,t} + [(i,j)=(s,t)] x^{k-2}
    2832             :    * If i != s
    2833             :    *   g_i -> d_{s,t} P_{i,j}
    2834             :    *   g_s -> - d_{i,j} P_{s,t}
    2835             :    * If i = s, j != t
    2836             :    *   g_i -> d_{s,t} P_{i,j} - d_{i,j} P_{s,t}
    2837             :    * And everything else to 0. Again we normalize the phi_{i,j} such that
    2838             :    * their image has content 1. */
    2839         630 :   monomials = matid(k-1); /* represent the monomials x^{k-2}, ... , y^{k-2} */
    2840         630 :   if (s <= nbE1) /* in E1 */
    2841             :   {
    2842         315 :     P_st = gel(monomials, t);
    2843         315 :     lP_st = gmael(p1, s, t); /* P_{s,t} lambda_s^* */
    2844             :   }
    2845             :   else /* in T2, T31 */
    2846             :   {
    2847         315 :     P_st = gmael(gentor, s - nbE1, t);
    2848         315 :     lP_st = P_st;
    2849             :   }
    2850         630 :   Q_st = doo_decompose(dinv, lP_st, &d_st);
    2851         630 :   basis = cgetg(dim+1, t_VEC);
    2852         630 :   link = cgetg(nbE1 + lg(gentor), t_VEC);
    2853         630 :   gel(link,1) = cgetg(1,t_VECSMALL); /* dummy */
    2854         630 :   n = 1;
    2855        3381 :   for (i = 2; i <= nbE1; i++)
    2856             :   {
    2857        2751 :     GEN L = cgetg(k, t_VECSMALL);
    2858             :     long j;
    2859             :     /* link[i][j] = n gives correspondance between phi_{i,j} and basis[n] */
    2860        2751 :     gel(link,i) = L;
    2861       14056 :     for (j = 1; j < k; j++)
    2862             :     {
    2863       11305 :       GEN lP_ij = gmael(p1, i, j); /* P_{i,j} lambda_i^* */
    2864       11305 :       GEN P_ij = gel(monomials,j);
    2865       11305 :       L[j] = n;
    2866       11305 :       gel(basis, n) = get_phi_ij(i,j,n, s,t, P_st, Q_st, d_st, P_ij, lP_ij, dinv);
    2867       11305 :       n++;
    2868             :     }
    2869             :   }
    2870        1134 :   for (u = 1; u < lg(gentor); u++,i++)
    2871             :   {
    2872         504 :     GEN V = gel(gentor,u);
    2873         504 :     long j, lV = lg(V);
    2874         504 :     GEN L = cgetg(lV, t_VECSMALL);
    2875         504 :     gel(link,i) = L;
    2876        2072 :     for (j = 1; j < lV; j++)
    2877             :     {
    2878        1568 :       GEN lP_ij = gel(V, j); /* P_{i,j} lambda_i^* = P_{i,j} */
    2879        1568 :       GEN P_ij = lP_ij;
    2880        1568 :       L[j] = n;
    2881        1568 :       gel(basis, n) = get_phi_ij(i,j,n, s,t, P_st, Q_st, d_st, P_ij, lP_ij, dinv);
    2882        1568 :       n++;
    2883             :     }
    2884             :   }
    2885         630 :   Inv = cgetg(lg(link), t_VEC);
    2886         630 :   gel(Inv,1) = cgetg(1, t_MAT); /* dummy */
    2887        3885 :   for (i = 2; i < lg(link); i++)
    2888             :   {
    2889        3255 :     GEN M, inv, B = gel(link,i);
    2890        3255 :     long j, lB = lg(B);
    2891        3255 :     if (i == s) { B = vecsplice(B, t); lB--; } /* remove phi_st */
    2892        3255 :     M = cgetg(lB, t_MAT);
    2893       15498 :     for (j = 1; j < lB; j++)
    2894             :     {
    2895       12243 :       GEN phi_ij = gel(basis, B[j]), pols = gel(phi_ij,3);
    2896       12243 :       gel(M, j) = gel(pols, 2); /* phi_ij(g_i) */
    2897             :     }
    2898        3255 :     if (i <= nbE1 && i != s) /* maximal rank k-1 */
    2899        2436 :       inv = ZM_inv_denom(M);
    2900             :     else /* i = s (rank k-2) or from torsion: rank k/3 or k/2 */
    2901         819 :       inv = Qevproj_init(M);
    2902        3255 :     gel(Inv,i) = inv;
    2903             :   }
    2904         630 :   return mkvec3(WN, gen_0, mkvec5(basis, mkvecsmall2(k, dim), mkvecsmall2(s,t),
    2905             :                                   link, Inv));
    2906             : }
    2907             : static GEN
    2908        3941 : add_star(GEN W, long sign)
    2909             : {
    2910        3941 :   GEN s = msstar_i(W);
    2911        3941 :   GEN K = sign? QM_ker(gsubgs(s, sign)): cgetg(1,t_MAT);
    2912        3941 :   gel(W,2) = mkvec3(stoi(sign), s, Qevproj_init(K));
    2913        3941 :   return W;
    2914             : }
    2915             : /* WN = msinit_N(N) */
    2916             : static GEN
    2917        3941 : mskinit(ulong N, long k, long sign)
    2918             : {
    2919        3941 :   GEN W, WN = msinit_N(N);
    2920        3941 :   if (N == 1)
    2921             :   {
    2922          14 :     GEN basis, M = RgXV_to_RgM(mfperiodpolbasis(k, 0), k-1);
    2923          14 :     GEN T = cgetg(1, t_VECSMALL), ind = mkvecsmall(1);
    2924          14 :     long i, l = lg(M);
    2925          14 :     basis = cgetg(l, t_VEC);
    2926          70 :     for (i = 1; i < l; i++) gel(basis,i) = mkvec3(T, ind, mkvec(gel(M,i)));
    2927          14 :     W = mkvec3(WN, gen_0, mkvec5(basis, mkvecsmall2(k, l-1), mkvecsmall2(0,0),
    2928             :                                  gen_0, Qevproj_init(M)));
    2929             :   }
    2930             :   else
    2931        3927 :     W = k == 2? mskinit_trivial(WN)
    2932        3927 :               : mskinit_nontrivial(WN, k);
    2933        3941 :   return add_star(W, sign);
    2934             : }
    2935             : GEN
    2936         518 : msinit(GEN N, GEN K, long s)
    2937             : {
    2938         518 :   pari_sp av = avma;
    2939             :   GEN W;
    2940             :   long k;
    2941         518 :   if (typ(N) != t_INT) pari_err_TYPE("msinit", N);
    2942         511 :   if (typ(K) != t_INT) pari_err_TYPE("msinit", K);
    2943         504 :   k = itos(K);
    2944         504 :   if (k < 2) pari_err_DOMAIN("msinit","k", "<", gen_2,K);
    2945         497 :   if (odd(k)) pari_err_IMPL("msinit [odd weight]");
    2946         497 :   if (signe(N) <= 0) pari_err_DOMAIN("msinit","N", "<=", gen_0,N);
    2947         490 :   if (labs(s) > 1) pari_err_DOMAIN("msinit", "|sign|", ">", gen_1, stoi(s));
    2948         476 :   W = mskinit(itou(N), k, s);
    2949         476 :   return gc_GEN(av, W);
    2950             : }
    2951             : 
    2952             : /* W = msinit, xpm integral modular symbol of weight 2, c t_FRAC
    2953             :  * Return image of <oo->c> */
    2954             : GEN
    2955     2229528 : mseval2_ooQ(GEN W, GEN xpm, GEN c)
    2956             : {
    2957     2229528 :   pari_sp av = avma;
    2958             :   GEN v;
    2959     2229528 :   W = get_msN(W);
    2960     2229528 :   v = init_act_trivial(W);
    2961     2229528 :   Q_log_trivial(v, W, c); /* oo -> (a:b), c = a/b */
    2962     2229528 :   return gc_INT(av, ZV_zc_mul(xpm, v));
    2963             : }
    2964             : 
    2965             : static GEN
    2966       20314 : eval_single(GEN s, long k, GEN B, long v)
    2967             : {
    2968             :   long i, l;
    2969       20314 :   GEN A = cgetg_copy(s,&l);
    2970      135863 :   for (i=1; i<l; i++) gel(A,i) = ZGl2Q_act_s(gel(B,i), gel(s,i), k);
    2971       20314 :   A = RgV_sum(A);
    2972       20314 :   if (is_vec_t(typ(A))) A = RgV_to_RgX(A, v);
    2973       20314 :   return A;
    2974             : }
    2975             : /* Evaluate symbol s on mspathlog B (= sum p_i g_i, p_i in Z[G]). Allow
    2976             :  * s = t_MAT [ collection of symbols, return a vector ]*/
    2977             : static GEN
    2978       54362 : mseval_by_values(GEN W, GEN s, GEN p, long v)
    2979             : {
    2980       54362 :   long i, l, k = msk_get_weight(W);
    2981             :   GEN A;
    2982       54362 :   if (k == 2)
    2983             :   { /* trivial represention: don't bother with Z[G] */
    2984       41734 :     GEN B = mspathlog_trivial(W,p);
    2985       41727 :     if (typ(s) != t_MAT) return RgV_zc_mul(s,B);
    2986       41657 :     l = lg(s); A = cgetg(l, t_VEC);
    2987      124971 :     for (i = 1; i < l; i++) gel(A,i) = RgV_zc_mul(gel(s,i), B);
    2988             :   }
    2989             :   else
    2990             :   {
    2991       12628 :     GEN B = mspathlog(W,p);
    2992       12628 :     if (typ(s) != t_MAT) return eval_single(s, k, B, v);
    2993         812 :     l = lg(s); A = cgetg(l, t_VEC);
    2994        9310 :     for (i = 1; i < l; i++) gel(A,i) = eval_single(gel(s,i), k, B, v);
    2995             :   }
    2996       42469 :   return A;
    2997             : }
    2998             : 
    2999             : /* express symbol on the basis phi_{i,j} */
    3000             : static GEN
    3001       20692 : symtophi(GEN W, GEN s)
    3002             : {
    3003       20692 :   GEN e, basis = msk_get_basis(W);
    3004       20692 :   long i, l = lg(basis);
    3005       20692 :   if (lg(s) != l) pari_err_TYPE("mseval",s);
    3006       20692 :   e = zerovec(ms_get_nbgen(W));
    3007      313670 :   for (i=1; i<l; i++)
    3008             :   {
    3009      292978 :     GEN phi, ind, pols, c = gel(s,i);
    3010             :     long j, m;
    3011      292978 :     if (gequal0(c)) continue;
    3012      122696 :     phi = gel(basis,i);
    3013      122696 :     ind = gel(phi,2); m = lg(ind);
    3014      122696 :     pols = gel(phi,3);
    3015      470806 :     for (j=1; j<m; j++)
    3016             :     {
    3017      348110 :       long t = ind[j];
    3018      348110 :       gel(e,t) = gadd(gel(e,t), gmul(c, gel(pols,j)));
    3019             :     }
    3020             :   }
    3021       20692 :   return e;
    3022             : }
    3023             : /* evaluate symbol s on path p */
    3024             : GEN
    3025       55321 : mseval(GEN W, GEN s, GEN p)
    3026             : {
    3027       55321 :   pari_sp av = avma;
    3028       55321 :   long i, k, l, v = 0;
    3029       55321 :   checkms(W);
    3030       55321 :   k = msk_get_weight(W);
    3031       55321 :   switch(typ(s))
    3032             :   {
    3033           7 :     case t_VEC: /* values s(g_i) */
    3034           7 :       if (lg(s)-1 != ms_get_nbgen(W)) pari_err_TYPE("mseval",s);
    3035           7 :       if (!p) return gcopy(s);
    3036           0 :       v = gvar(s);
    3037           0 :       break;
    3038       12831 :     case t_COL:
    3039       12831 :       if (msk_get_sign(W))
    3040             :       {
    3041         399 :         GEN star = gel(msk_get_starproj(W), 1);
    3042         399 :         if (lg(star) == lg(s)) s = RgM_RgC_mul(star, s);
    3043             :       }
    3044       12831 :       if (k == 2) /* on the dual basis of (g_i) */
    3045             :       {
    3046         637 :         if (lg(s)-1 != ms_get_nbE1(W)) pari_err_TYPE("mseval",s);
    3047         637 :         if (!p) return gtrans(s);
    3048             :       }
    3049             :       else
    3050       12194 :         s = symtophi(W,s);
    3051       12271 :       break;
    3052       42483 :     case t_MAT:
    3053       42483 :       l = lg(s);
    3054       42483 :       if (!p)
    3055             :       {
    3056           7 :         GEN v = cgetg(l, t_VEC);
    3057          28 :         for (i = 1; i < l; i++) gel(v,i) = mseval(W, gel(s,i), NULL);
    3058           7 :         return v;
    3059             :       }
    3060       42476 :       if (l == 1) return cgetg(1, t_VEC);
    3061       42469 :       if (msk_get_sign(W))
    3062             :       {
    3063          84 :         GEN star = gel(msk_get_starproj(W), 1);
    3064          84 :         if (lg(star) == lgcols(s)) s = RgM_mul(star, s);
    3065             :       }
    3066       42469 :       if (k == 2)
    3067       41657 :       { if (nbrows(s) != ms_get_nbE1(W)) pari_err_TYPE("mseval",s); }
    3068             :       else
    3069             :       {
    3070         812 :         GEN t = cgetg(l, t_MAT);
    3071        9310 :         for (i = 1; i < l; i++) gel(t,i) = symtophi(W,gel(s,i));
    3072         812 :         s = t;
    3073             :       }
    3074       42469 :       break;
    3075           0 :     default: pari_err_TYPE("mseval",s);
    3076             :   }
    3077       54740 :   if (p)
    3078       54362 :     s = mseval_by_values(W, s, p, v);
    3079             :   else
    3080             :   {
    3081         378 :     l = lg(s);
    3082        3675 :     for (i = 1; i < l; i++)
    3083             :     {
    3084        3297 :       GEN c = gel(s,i);
    3085        3297 :       if (!isintzero(c)) gel(s,i) = RgV_to_RgX(gel(s,i), v);
    3086             :     }
    3087             :   }
    3088       54733 :   return gc_GEN(av, s);
    3089             : }
    3090             : 
    3091             : static GEN
    3092        9464 : allxpm(GEN W, GEN xpm, long f)
    3093             : {
    3094        9464 :   GEN v, L = coprimes_zv(f);
    3095        9464 :   long a, nonzero = 0;
    3096        9464 :   v = const_vec(f, NULL);
    3097       33719 :   for (a = 1; a <= f; a++)
    3098             :   {
    3099             :     GEN c;
    3100       24255 :     if (!L[a]) continue;
    3101       18564 :     c = mseval2_ooQ(W, xpm, sstoQ(a, f));
    3102       18564 :     if (!gequal0(c)) { gel(v,a) = c; nonzero = 1; }
    3103             :   }
    3104        9464 :   return nonzero? v: NULL;
    3105             : }
    3106             : /* \sum_{a mod f} chi(a) x(a/f) */
    3107             : static GEN
    3108        5138 : seval(GEN G, GEN chi, GEN vx)
    3109             : {
    3110        5138 :   GEN vZ, T, s = gen_0, go = zncharorder(G,chi);
    3111        5138 :   long i, l = lg(vx), o = itou(go);
    3112        5138 :   T = polcyclo(o,0);
    3113        5138 :   vZ = mkvec2(RgXQ_powers(RgX_rem(pol_x(0), T), o-1, T), go);
    3114       20643 :   for (i = 1; i < l; i++)
    3115             :   {
    3116       15505 :     GEN x = gel(vx,i);
    3117       15505 :     if (x) s = gadd(s, gmul(x, znchareval(G, chi, utoi(i), vZ)));
    3118             :   }
    3119        5138 :   return gequal0(s)? NULL: poleval(s, rootsof1u_cx(o, DEFAULTPREC));
    3120             : }
    3121             : 
    3122             : /* Let W = msinit(conductor(E), 2), xpm an integral modular symbol with the same
    3123             :  * eigenvalues as L_E. There exist a unique C such that
    3124             :  *   C*L(E,(D/.),1)_{xpm} = L(E,(D/.),1) / w1(E_D) != 0,
    3125             :  * for all D fundamental, sign(D) = s, and such that E_D has rank 0.
    3126             :  * Return C * ellQtwist_bsdperiod(E,s) */
    3127             : static GEN
    3128        5138 : ell_get_Cw(GEN LE, GEN W, GEN xpm, long s)
    3129             : {
    3130        5138 :   long f, NE = ms_get_N(W);
    3131        5138 :   const long bit = 64;
    3132             : 
    3133        5138 :   for (f = 1;; f++)
    3134       10367 :   { /* look for chi with conductor f coprime to N(E) and parity s
    3135             :      * such that L(E,chi,1) != 0 */
    3136       15505 :     pari_sp av = avma;
    3137             :     GEN vchi, vx, G;
    3138             :     long l, i;
    3139       15505 :     if ((f & 3) == 2 || ugcd(NE,f) != 1) continue;
    3140        9464 :     vx = allxpm(W, xpm, f); if (!vx) continue;
    3141        5138 :     G = znstar0(utoipos(f),1);
    3142        5138 :     vchi = chargalois(G,NULL); l = lg(vchi);
    3143        8204 :     for (i = 1; i < l; i++)
    3144             :     {
    3145        8204 :       pari_sp av2 = avma;
    3146        8204 :       GEN tau, z, S, L, chi = gel(vchi,i);
    3147        8204 :       long o = zncharisodd(G,chi);
    3148        8204 :       if ((s > 0 && o) || (s < 0 && !o)
    3149        8204 :           || itos(zncharconductor(G, chi)) != f) continue;
    3150        5138 :       S = seval(G, chi, vx);
    3151        5138 :       if (!S) { set_avma(av2); continue; }
    3152             : 
    3153        5138 :       L = lfuntwist(LE, mkvec2(G, zncharconj(G,chi)), bit);
    3154        5138 :       z = lfun(L, gen_1, bit);
    3155        5138 :       tau = znchargauss(G, chi, gen_1, bit);
    3156        5138 :       return gdiv(gmul(z, tau), S); /* C * w */
    3157             :     }
    3158           0 :     set_avma(av);
    3159             :   }
    3160             : }
    3161             : static GEN
    3162        2884 : ell_get_scale(GEN LE, GEN W, long sign, GEN x)
    3163             : {
    3164        2884 :   if (sign)
    3165         630 :     return ell_get_Cw(LE, W, gel(x,1), sign);
    3166             :   else
    3167             :   {
    3168        2254 :     GEN Cwp = ell_get_Cw(LE, W, gel(x,1), 1);
    3169        2254 :     GEN Cwm = ell_get_Cw(LE, W, gel(x,2),-1);
    3170        2254 :     return mkvec2(Cwp, Cwm);
    3171             :   }
    3172             : }
    3173             : /* E minimal */
    3174             : static GEN
    3175       10101 : msfromell_scale(GEN x, GEN Cw, GEN E, long s)
    3176             : {
    3177       10101 :   GEN B = int2n(32);
    3178       10101 :   if (s)
    3179             :   {
    3180         630 :     GEN C = gdiv(Cw, ellQtwist_bsdperiod(E,s));
    3181         630 :     return ZC_Q_mul(gel(x,1), bestappr(C,B));
    3182             :   }
    3183             :   else
    3184             :   {
    3185        9471 :     GEN xp = gel(x,1), Cp = gdiv(gel(Cw,1), ellQtwist_bsdperiod(E, 1)), L;
    3186        9471 :     GEN xm = gel(x,2), Cm = gdiv(gel(Cw,2), ellQtwist_bsdperiod(E,-1));
    3187        9471 :     xp = ZC_Q_mul(xp, bestappr(Cp,B));
    3188        9471 :     xm = ZC_Q_mul(xm, bestappr(Cm,B));
    3189        9471 :     if (signe(ell_get_disc(E)) > 0)
    3190        5320 :       L = mkmat2(xp, xm); /* E(R) has 2 connected components */
    3191             :     else
    3192        4151 :       L = mkmat2(gsub(xp,xm), gmul2n(xm,1));
    3193        9471 :     return mkvec3(xp, xm, L);
    3194             :   }
    3195             : }
    3196             : /* v != 0 */
    3197             : static GEN
    3198        5138 : Flc_normalize(GEN v, ulong p)
    3199             : {
    3200        5138 :   long i, l = lg(v);
    3201        9128 :   for (i = 1; i < l; i++)
    3202        9128 :     if (v[i])
    3203             :     {
    3204        5138 :       if (v[i] != 1) v = Flv_Fl_div(v, v[i], p);
    3205        5138 :       return v;
    3206             :     }
    3207           0 :   return NULL;
    3208             : }
    3209             : /* K \cap Ker M  [F_l vector spaces]. K = NULL means full space */
    3210             : static GEN
    3211        3668 : msfromell_ker(GEN K, GEN M, ulong l)
    3212             : {
    3213        3668 :   GEN B, Ml = ZM_to_Flm(M, l);
    3214        3668 :   if (K) Ml = Flm_mul(Ml, K, l);
    3215        3668 :   B = Flm_ker(Ml, l);
    3216        3668 :   if (!K) K = B;
    3217         784 :   else if (lg(B) < lg(K))
    3218         616 :     K = Flm_mul(K, B, l);
    3219        3668 :   return K;
    3220             : }
    3221             : /* K = \cap_p Ker(T_p - a_p), 2-dimensional. Set *xl to the 1-dimensional
    3222             :  * Fl-basis  such that star . xl = sign . xl if sign != 0 and
    3223             :  * star * xl[1] = xl[1]; star * xl[2] = -xl[2] if sign = 0 */
    3224             : static void
    3225        2884 : msfromell_l(GEN *pxl, GEN K, GEN star, long sign, ulong l)
    3226             : {
    3227        2884 :   GEN s = ZM_to_Flm(star, l);
    3228        2884 :   GEN a = gel(K,1), Sa = Flm_Flc_mul(s,a,l);
    3229        2884 :   GEN b = gel(K,2);
    3230        2884 :   GEN t = Flv_add(a,Sa,l), xp, xm;
    3231        2884 :   if (zv_equal0(t))
    3232             :   {
    3233         497 :     xm = a;
    3234         497 :     xp = Flv_add(b,Flm_Flc_mul(s,b,l), l);
    3235             :   }
    3236             :   else
    3237             :   {
    3238        2387 :     xp = t; t = Flv_sub(a, Sa, l);
    3239        2387 :     xm = zv_equal0(t)? Flv_sub(b, Flm_Flc_mul(s,b,l), l): t;
    3240             :   }
    3241             :   /* xp = 0 on Im(S - 1), xm = 0 on Im(S + 1) */
    3242        2884 :   if (sign > 0)
    3243         518 :     *pxl = mkmat(Flc_normalize(xp, l));
    3244        2366 :   else if (sign < 0)
    3245         112 :     *pxl = mkmat(Flc_normalize(xm, l));
    3246             :   else
    3247        2254 :     *pxl = mkmat2(Flc_normalize(xp, l), Flc_normalize(xm, l));
    3248        2884 : }
    3249             : /* return a primitive symbol */
    3250             : static GEN
    3251        2884 : msfromell_ratlift(GEN x, GEN q)
    3252             : {
    3253        2884 :   GEN B = sqrti(shifti(q,-1));
    3254        2884 :   GEN r = FpM_ratlift(x, q, B, B, NULL);
    3255        2884 :   if (r) r = Q_primpart(r);
    3256        2884 :   return r;
    3257             : }
    3258             : static int
    3259        2884 : msfromell_check(GEN x, GEN vT, GEN star, long sign)
    3260             : {
    3261             :   long i, l;
    3262             :   GEN sx;
    3263        2884 :   if (!x) return 0;
    3264        2884 :   l = lg(vT);
    3265        6552 :   for (i = 1; i < l; i++)
    3266             :   {
    3267        3668 :     GEN T = gel(vT,i);
    3268        3668 :     if (!gequal0(ZM_mul(T, x))) return 0; /* fail */
    3269             :   }
    3270        2884 :   sx = ZM_mul(star,x);
    3271        2884 :   if (sign)
    3272         630 :     return ZV_equal(gel(sx,1), sign > 0? gel(x,1): ZC_neg(gel(x,1)));
    3273             :   else
    3274        2254 :     return ZV_equal(gel(sx,1),gel(x,1)) && ZV_equal(gel(sx,2),ZC_neg(gel(x,2)));
    3275             : }
    3276             : GEN
    3277        2884 : msfromell(GEN E0, long sign)
    3278             : {
    3279        2884 :   pari_sp av = avma, av2;
    3280        2884 :   GEN T, Cw, E, NE, star, q, vT, xl, xr, W, x = NULL, K = NULL;
    3281             :   long lE, single;
    3282             :   ulong p, l, N;
    3283             :   forprime_t S, Sl;
    3284             : 
    3285        2884 :   if (typ(E0) != t_VEC) pari_err_TYPE("msfromell",E0);
    3286        2884 :   lE = lg(E0);
    3287        2884 :   if (lE == 1) return cgetg(1,t_VEC);
    3288        2884 :   single = (typ(gel(E0,1)) != t_VEC);
    3289        2884 :   E = single ? E0: gel(E0,1);
    3290        2884 :   NE = ellQ_get_N(E);
    3291             :   /* must make it integral for ellap; we have minimal model at hand */
    3292        2884 :   T = obj_check(E, Q_MINIMALMODEL); if (lg(T) != 2) E = gel(T,3);
    3293        2884 :   N = itou(NE); av2 = avma;
    3294        2884 :   W = gc_GEN(av2, mskinit(N,2,0));
    3295        2884 :   star = msk_get_star(W);
    3296        2884 :   (void)u_forprime_init(&Sl, 1UL<<29, ULONG_MAX);
    3297             :   /* loop for p <= count_Manin_symbols(N) / 6 would be enough */
    3298        2884 :   (void)u_forprime_init(&S, 2, ULONG_MAX);
    3299        2884 :   vT = cgetg(1, t_VEC);
    3300        2884 :   l = u_forprime_next(&Sl);
    3301        6265 :   while( (p = u_forprime_next(&S)) )
    3302             :   {
    3303             :     GEN M;
    3304        6265 :     if (N % p == 0) continue;
    3305        3668 :     av2 = avma;
    3306        3668 :     M = RgM_Rg_sub_shallow(mshecke_i(W, p), ellap(E, utoipos(p)));
    3307        3668 :     M = gc_GEN(av2, M);
    3308        3668 :     vT = vec_append(vT, M); /* for certification at the end */
    3309        3668 :     K = msfromell_ker(K, M, l);
    3310        3668 :     if (lg(K) == 3) break;
    3311             :   }
    3312        2884 :   if (!p) pari_err_BUG("msfromell: ran out of primes");
    3313             : 
    3314             :   /* mod one l should be enough */
    3315        2884 :   msfromell_l(&xl, K, star, sign, l);
    3316        2884 :   x = ZM_init_CRT(xl, l);
    3317        2884 :   q = utoipos(l);
    3318        2884 :   xr = msfromell_ratlift(x, q);
    3319             :   /* paranoia */
    3320        2884 :   while (!msfromell_check(xr, vT, star, sign) && (l = u_forprime_next(&Sl)) )
    3321             :   {
    3322           0 :     GEN K = NULL;
    3323           0 :     long i, lvT = lg(vT);
    3324           0 :     for (i = 1; i < lvT; i++)
    3325             :     {
    3326           0 :       K = msfromell_ker(K, gel(vT,i), l);
    3327           0 :       if (lg(K) == 3) break;
    3328             :     }
    3329           0 :     if (i >= lvT) { x = NULL; continue; }
    3330           0 :     msfromell_l(&xl, K, star, sign, l);
    3331           0 :     ZM_incremental_CRT(&x, xl, &q, l);
    3332           0 :     xr = msfromell_ratlift(x, q);
    3333             :   }
    3334             :   /* linear form = 0 on all Im(Tp - ap) and Im(S - sign) if sign != 0 */
    3335        2884 :   Cw = ell_get_scale(lfuncreate(E), W, sign, xr);
    3336        2884 :   if (single)
    3337         693 :     x = msfromell_scale(xr, Cw, E, sign);
    3338             :   else
    3339             :   { /* assume all E0[i] isogenous, given by minimal models */
    3340        2191 :     GEN v = cgetg(lE, t_VEC);
    3341             :     long i;
    3342       11599 :     for (i=1; i<lE; i++) gel(v,i) = msfromell_scale(xr, Cw, gel(E0,i), sign);
    3343        2191 :     x = v;
    3344             :   }
    3345        2884 :   return gc_GEN(av, mkvec2(W, x));
    3346             : }
    3347             : 
    3348             : GEN
    3349          21 : msfromhecke(GEN W, GEN v, GEN H)
    3350             : {
    3351          21 :   pari_sp av = avma;
    3352          21 :   long i, l = lg(v);
    3353          21 :   GEN K = NULL;
    3354          21 :   checkms(W);
    3355          21 :   if (typ(v) != t_VEC) pari_err_TYPE("msfromhecke",v);
    3356          49 :   for (i = 1; i < l; i++)
    3357             :   {
    3358          28 :     GEN K2, T, p, P, c = gel(v,i);
    3359          28 :     if (typ(c) != t_VEC || lg(c) != 3) pari_err_TYPE("msfromhecke",v);
    3360          28 :     p = gel(c,1);
    3361          28 :     if (typ(p) != t_INT) pari_err_TYPE("msfromhecke",v);
    3362          28 :     P = gel(c,2);
    3363          28 :     switch(typ(P))
    3364             :     {
    3365          21 :       case t_INT:
    3366          21 :         P = deg1pol_shallow(gen_1, negi(P), 0);
    3367          21 :         break;
    3368           7 :       case t_POL:
    3369           7 :         if (RgX_is_ZX(P)) break;
    3370             :       default:
    3371           0 :         pari_err_TYPE("msfromhecke",v);
    3372             :     };
    3373          28 :     T = mshecke(W, itos(p), H);
    3374          28 :     T = Q_primpart(RgX_RgM_eval(P, T));
    3375          28 :     if (K) T = ZM_mul(T,K);
    3376          28 :     K2 = ZM_ker(T);
    3377          28 :     if (!K) K = K2;
    3378           7 :     else if (lg(K2) < lg(K)) K = ZM_mul(K,K2);
    3379             :   }
    3380          21 :   return gc_GEN(av, K);
    3381             : }
    3382             : 
    3383             : /* OVERCONVERGENT MODULAR SYMBOLS */
    3384             : 
    3385             : static GEN
    3386        2933 : mspadic_get_Wp(GEN W) { return gel(W,1); }
    3387             : static GEN
    3388         483 : mspadic_get_Tp(GEN W) { return gel(W,2); }
    3389             : static GEN
    3390         483 : mspadic_get_bin(GEN W) { return gel(W,3); }
    3391             : static GEN
    3392         476 : mspadic_get_actUp(GEN W) { return gel(W,4); }
    3393             : static GEN
    3394         476 : mspadic_get_q(GEN W) { return gel(W,5); }
    3395             : static long
    3396        1456 : mspadic_get_p(GEN W) { return gel(W,6)[1]; }
    3397             : static long
    3398        1211 : mspadic_get_n(GEN W) { return gel(W,6)[2]; }
    3399             : static long
    3400         161 : mspadic_get_flag(GEN W) { return gel(W,6)[3]; }
    3401             : static GEN
    3402         483 : mspadic_get_M(GEN W) { return gel(W,7); }
    3403             : static GEN
    3404         483 : mspadic_get_C(GEN W) { return gel(W,8); }
    3405             : static long
    3406         973 : mspadic_get_weight(GEN W) { return msk_get_weight(mspadic_get_Wp(W)); }
    3407             : 
    3408             : void
    3409         980 : checkmspadic(GEN W)
    3410             : {
    3411         980 :   if (typ(W) != t_VEC || lg(W) != 9) pari_err_TYPE("checkmspadic",W);
    3412         980 :   checkms(mspadic_get_Wp(W));
    3413         980 : }
    3414             : 
    3415             : /* f in M_2(Z) \cap GL_2(Q), p \nmid a [ and for the result to mean anything
    3416             :  * p | c, but not needed here]. Return the matrix M in M_D(Z), D = M+k-1
    3417             :  * such that, if v = \int x^i d mu, i < D, is a vector of D moments of mu,
    3418             :  * then M * v is the vector of moments of mu | f  mod p^D */
    3419             : static GEN
    3420      276073 : moments_act_i(struct m_act *S, GEN f)
    3421             : {
    3422      276073 :   long j, k = S->k, D = S->dim;
    3423      276073 :   GEN a = gcoeff(f,1,1), b = gcoeff(f,1,2);
    3424      276073 :   GEN c = gcoeff(f,2,1), d = gcoeff(f,2,2);
    3425      276073 :   GEN u, z, q = S->q, mat = cgetg(D+1, t_MAT);
    3426             : 
    3427      276073 :   a = modii(a,q);
    3428      276073 :   c = modii(c,q);
    3429      276073 :   z = FpX_powu(deg1pol(c,a,0), k-2, q); /* (a+cx)^(k-2) */
    3430             :   /* u := (b+dx) / (a+cx) mod (q,x^D) = (b/a +d/a*x) / (1 - (-c/a)*x) */
    3431      276073 :   if (!equali1(a))
    3432             :   {
    3433      271229 :     GEN ai = Fp_inv(a,q);
    3434      271229 :     b = Fp_mul(b,ai,q);
    3435      271229 :     c = Fp_mul(c,ai,q);
    3436      271229 :     d = Fp_mul(d,ai,q);
    3437             :   }
    3438      276073 :   u = deg1pol_shallow(d, b, 0);
    3439             :   /* multiply by 1 / (1 - (-c/a)*x) */
    3440      276073 :   if (signe(c))
    3441             :   {
    3442      269640 :     GEN C = Fp_neg(c,q), v = cgetg(D+2,t_POL);
    3443      269640 :     v[1] = evalsigne(1)|evalvarn(0);
    3444      269640 :     gel(v, 2) = gen_1; gel(v, 3) = C;
    3445     1405138 :     for (j = 4; j < D+2; j++)
    3446             :     {
    3447     1329027 :       GEN t = Fp_mul(gel(v,j-1), C, q);
    3448     1329027 :       if (!signe(t)) { setlg(v,j); break; }
    3449     1135498 :       gel(v,j) = t;
    3450             :     }
    3451      269640 :     u = FpXn_mul(u, v, D, q);
    3452             :   }
    3453     2369024 :   for (j = 1; j <= D; j++)
    3454             :   {
    3455     2092951 :     gel(mat,j) = RgX_to_RgC(z, D); /* (a+cx)^(k-2) * ((b+dx)/(a+cx))^(j-1) */
    3456     2092951 :     if (j != D) z = FpXn_mul(z, u, D, q);
    3457             :   }
    3458      276073 :   return shallowtrans(mat);
    3459             : }
    3460             : static GEN
    3461      275611 : moments_act(struct m_act *S, GEN f)
    3462      275611 : { pari_sp av = avma; return gc_GEN(av, moments_act_i(S,f)); }
    3463             : static GEN
    3464         483 : init_moments_act(GEN W, long p, long n, GEN q, GEN v)
    3465             : {
    3466             :   struct m_act S;
    3467         483 :   long k = msk_get_weight(W);
    3468         483 :   S.p = p;
    3469         483 :   S.k = k;
    3470         483 :   S.q = q;
    3471         483 :   S.dim = n+k-1;
    3472         483 :   S.act = &moments_act; return init_dual_act(v,W,W,&S);
    3473             : }
    3474             : 
    3475             : static void
    3476        6762 : clean_tail(GEN phi, long c, GEN q)
    3477             : {
    3478        6762 :   long a, l = lg(phi);
    3479      214438 :   for (a = 1; a < l; a++)
    3480             :   {
    3481      207676 :     GEN P = FpC_red(gel(phi,a), q); /* phi(G_a) = vector of moments */
    3482      207676 :     long j, lP = lg(P);
    3483     1007825 :     for (j = c; j < lP; j++) gel(P,j) = gen_0; /* reset garbage to 0 */
    3484      207676 :     gel(phi,a) = P;
    3485             :   }
    3486        6762 : }
    3487             : /* concat z to all x[i] */
    3488             : static GEN
    3489         630 : concat2(GEN x, GEN z)
    3490       29022 : { pari_APPLY_same(shallowconcat(gel(x,i), z)); }
    3491             : static GEN
    3492         630 : red_mod_FilM(GEN phi, ulong p, long k, long flag)
    3493             : {
    3494             :   long a, l;
    3495         630 :   GEN den = gen_1, v = cgetg_copy(phi, &l);
    3496         630 :   if (flag)
    3497             :   {
    3498         343 :     phi = Q_remove_denom(phi, &den);
    3499         343 :     if (!den) { den = gen_1; flag = 0; }
    3500             :   }
    3501       29386 :   for (a = 1; a < l; a++)
    3502             :   {
    3503       28756 :     GEN P = gel(phi,a), q = den;
    3504             :     long j;
    3505      207676 :     for (j = lg(P)-1; j >= k+1; j--)
    3506             :     {
    3507      178920 :       q = muliu(q,p);
    3508      178920 :       gel(P,j) = modii(gel(P,j),q);
    3509             :     }
    3510       28756 :     q = muliu(q,p);
    3511       93380 :     for (     ; j >= 1; j--)
    3512       64624 :       gel(P,j) = modii(gel(P,j),q);
    3513       28756 :     gel(v,a) = P;
    3514             :   }
    3515         630 :   if (flag) v = gdiv(v, den);
    3516         630 :   return v;
    3517             : }
    3518             : 
    3519             : /* denom(C) | p^(2(k-1) - v_p(ap)) */
    3520             : static GEN
    3521         154 : oms_dim2(GEN W, GEN phi, GEN C, GEN ap)
    3522             : {
    3523         154 :   long t, i, k = mspadic_get_weight(W);
    3524         154 :   long p = mspadic_get_p(W), n = mspadic_get_n(W);
    3525         154 :   GEN phi1 = gel(phi,1), phi2 = gel(phi,2);
    3526         154 :   GEN v, q = mspadic_get_q(W);
    3527         154 :   GEN act = mspadic_get_actUp(W);
    3528             : 
    3529         154 :   t = signe(ap)? Z_lval(ap,p) : k-1;
    3530         154 :   phi1 = concat2(phi1, zerovec(n));
    3531         154 :   phi2 = concat2(phi2, zerovec(n));
    3532        2107 :   for (i = 1; i <= n; i++)
    3533             :   {
    3534        1953 :     phi1 = dual_act(k-1, act, phi1);
    3535        1953 :     phi1 = dual_act(k-1, act, phi1);
    3536        1953 :     clean_tail(phi1, k + i*t, q);
    3537             : 
    3538        1953 :     phi2 = dual_act(k-1, act, phi2);
    3539        1953 :     phi2 = dual_act(k-1, act, phi2);
    3540        1953 :     clean_tail(phi2, k + i*t, q);
    3541             :   }
    3542         154 :   C = gpowgs(C,n);
    3543         154 :   v = RgM_RgC_mul(C, mkcol2(phi1,phi2));
    3544         154 :   phi1 = red_mod_FilM(gel(v,1), p, k, 1);
    3545         154 :   phi2 = red_mod_FilM(gel(v,2), p, k, 1);
    3546         154 :   return mkvec2(phi1,phi2);
    3547             : }
    3548             : 
    3549             : /* flag = 0 iff alpha is a p-unit */
    3550             : static GEN
    3551         322 : oms_dim1(GEN W, GEN phi, GEN alpha, long flag)
    3552             : {
    3553         322 :   long i, k = mspadic_get_weight(W);
    3554         322 :   long p = mspadic_get_p(W), n = mspadic_get_n(W);
    3555         322 :   GEN q = mspadic_get_q(W);
    3556         322 :   GEN act = mspadic_get_actUp(W);
    3557         322 :   phi = concat2(phi, zerovec(n));
    3558        3178 :   for (i = 1; i <= n; i++)
    3559             :   {
    3560        2856 :     phi = dual_act(k-1, act, phi);
    3561        2856 :     clean_tail(phi, k + i, q);
    3562             :   }
    3563         322 :   phi = gmul(lift_shallow(gpowgs(alpha,n)), phi);
    3564         322 :   phi = red_mod_FilM(phi, p, k, flag);
    3565         322 :   return mkvec(phi);
    3566             : }
    3567             : 
    3568             : /* lift polynomial P in RgX[X,Y]_{k-2} to a distribution \mu such that
    3569             :  * \int (Y - X z)^(k-2) d\mu(z) = P(X,Y)
    3570             :  * Return the t_VEC of k-1 first moments of \mu: \int z^i d\mu(z), 0<= i < k-1.
    3571             :  *   \sum_j (-1)^(k-2-j) binomial(k-2,j) Y^j \int z^(k-2-j) d\mu(z) = P(1,Y)
    3572             :  * Input is P(1,Y), bin = vecbinomial(k-2): bin[j] = binomial(k-2,j-1) */
    3573             : static GEN
    3574       38626 : RgX_to_moments(GEN P, GEN bin)
    3575             : {
    3576       38626 :   long j, k = lg(bin);
    3577             :   GEN Pd, Bd;
    3578       38626 :   if (typ(P) != t_POL) P = scalarpol(P,0);
    3579       38626 :   P = RgX_to_RgC(P, k-1); /* deg <= k-2 */
    3580       38626 :   settyp(P, t_VEC);
    3581       38626 :   Pd = P+1;  /* Pd[i] = coeff(P,i) */
    3582       38626 :   Bd = bin+1;/* Bd[i] = binomial(k-2,i) */
    3583       46249 :   for (j = 1; j < k-2; j++)
    3584             :   {
    3585        7623 :     GEN c = gel(Pd,j);
    3586        7623 :     if (odd(j)) c = gneg(c);
    3587        7623 :     gel(Pd,j) = gdiv(c, gel(Bd,j));
    3588             :   }
    3589       38626 :   return vecreverse(P);
    3590             : }
    3591             : static GEN
    3592         882 : RgXC_to_moments(GEN x, GEN bin)
    3593       39508 : { pari_APPLY_same(RgX_to_moments(gel(x,i), bin)); }
    3594             : 
    3595             : /* W an mspadic, assume O[2] is integral, den is the cancelled denominator
    3596             :  * or NULL, L = log(path)^* in sparse form */
    3597             : static GEN
    3598        2954 : omseval_int(struct m_act *S, GEN PHI, GEN L, hashtable *H)
    3599             : {
    3600             :   long i, l;
    3601        2954 :   GEN v = cgetg_copy(PHI, &l);
    3602        2954 :   ZGl2QC_to_act(S, L, H); /* as operators on V */
    3603        6286 :   for (i = 1; i < l; i++)
    3604             :   {
    3605        3332 :     GEN T = dense_act_col(L, gel(PHI,i));
    3606        3332 :     gel(v,i) = T? FpC_red(T,S->q): zerocol(S->dim);
    3607             :   }
    3608        2954 :   return v;
    3609             : }
    3610             : 
    3611             : GEN
    3612          14 : msomseval(GEN W, GEN phi, GEN path)
    3613             : {
    3614             :   struct m_act S;
    3615          14 :   pari_sp av = avma;
    3616             :   GEN v, Wp;
    3617             :   long n, vden;
    3618          14 :   checkmspadic(W);
    3619          14 :   if (typ(phi) != t_COL || lg(phi) != 4)  pari_err_TYPE("msomseval",phi);
    3620          14 :   vden = itos(gel(phi,2));
    3621          14 :   phi = gel(phi,1);
    3622          14 :   n = mspadic_get_n(W);
    3623          14 :   Wp= mspadic_get_Wp(W);
    3624          14 :   S.k = mspadic_get_weight(W);
    3625          14 :   S.p = mspadic_get_p(W);
    3626          14 :   S.q = powuu(S.p, n+vden);
    3627          14 :   S.dim = n + S.k - 1;
    3628          14 :   S.act = &moments_act;
    3629          14 :   path = path_to_M2(path);
    3630          14 :   v = omseval_int(&S, phi, M2_logf(Wp,path,NULL), NULL);
    3631          14 :   return gc_GEN(av, v);
    3632             : }
    3633             : /* W = msinit(N,k,...); if flag < 0 or flag >= k-1, allow all symbols;
    3634             :  * else commit to v_p(a_p) <= flag (ordinary if flag = 0)*/
    3635             : GEN
    3636         490 : mspadicinit(GEN W, long p, long n, long flag)
    3637             : {
    3638         490 :   pari_sp av = avma;
    3639             :   long a, N, k;
    3640             :   GEN P, C, M, bin, Wp, Tp, q, pn, actUp, teich, pas;
    3641             : 
    3642         490 :   checkms(W);
    3643         490 :   N = ms_get_N(W);
    3644         490 :   k = msk_get_weight(W);
    3645         490 :   if (flag < 0) flag = 1; /* worst case */
    3646         357 :   else if (flag >= k) flag = k-1;
    3647             : 
    3648         490 :   bin = vecbinomial(k-2);
    3649         490 :   Tp = mshecke(W, p, NULL);
    3650         490 :   if (N % p == 0)
    3651             :   {
    3652          91 :     if ((N/p) % p == 0) pari_err_IMPL("mspadicinit when p^2 | N");
    3653             :     /* a_p != 0 */
    3654          84 :     Wp = W;
    3655          84 :     M = gen_0;
    3656          84 :     flag = (k-2) / 2; /* exact valuation */
    3657             :     /* will multiply by matrix with denominator p^(k-2)/2 in mspadicint.
    3658             :      * Except if p = 2 (multiply by alpha^2) */
    3659          84 :     if (p == 2) n += k-2; else n += (k-2)/2;
    3660          84 :     pn = powuu(p,n);
    3661             :     /* For accuracy mod p^n, oms_dim1 require p^(k/2*n) */
    3662          84 :     q = powiu(pn, k/2);
    3663             :   }
    3664             :   else
    3665             :   { /* p-stabilize */
    3666         399 :     long s = msk_get_sign(W);
    3667             :     GEN M1, M2;
    3668             : 
    3669         399 :     Wp = mskinit(N*p, k, s);
    3670         399 :     M1 = getMorphism(W, Wp, mkvec(mat2(1,0,0,1)));
    3671         399 :     M2 = getMorphism(W, Wp, mkvec(mat2(p,0,0,1)));
    3672         399 :     if (s)
    3673             :     {
    3674         147 :       GEN SW = msk_get_starproj(W), SWp = msk_get_starproj(Wp);
    3675         147 :       M1 = Qevproj_apply2(M1, SW, SWp);
    3676         147 :       M2 = Qevproj_apply2(M2, SW, SWp);
    3677             :     }
    3678         399 :     M = mkvec2(M1,M2);
    3679         399 :     n += Z_lval(Q_denom(M), p); /*den. introduced by p-stabilization*/
    3680             :     /* in supersingular case: will multiply by matrix with denominator p^k
    3681             :      * in mspadicint. Except if p = 2 (multiply by alpha^2) */
    3682         399 :     if (flag) { if (p == 2) n += 2*k-2; else n += k; }
    3683         399 :     pn = powuu(p,n);
    3684             :     /* For accuracy mod p^n, supersingular require p^((2k-1-v_p(a_p))*n) */
    3685         399 :     if (flag) /* k-1 also takes care of a_p = 0. Worst case v_p(a_p) = flag */
    3686         231 :       q = powiu(pn, 2*k-1 - flag);
    3687             :     else
    3688         168 :       q = pn;
    3689             :   }
    3690         483 :   actUp = init_moments_act(Wp, p, n, q, Up_matrices(p));
    3691             : 
    3692         483 :   if (p == 2) C = gen_0;
    3693             :   else
    3694             :   {
    3695         427 :     pas = matpascal(n);
    3696         427 :     teich = teichmullerinit(p, n+1);
    3697         427 :     P = gpowers(utoipos(p), n);
    3698         427 :     C = cgetg(p, t_VEC);
    3699        2317 :     for (a = 1; a < p; a++)
    3700             :     { /* powb[j+1] = ((a - w(a)) / p)^j mod p^n */
    3701        1890 :       GEN powb = Fp_powers(diviuexact(subui(a, gel(teich,a)), p), n, pn);
    3702        1890 :       GEN Ca = cgetg(n+2, t_VEC);
    3703        1890 :       long j, r, ai = Fl_inv(a, p); /* a^(-1) */
    3704        1890 :       gel(C,a) = Ca;
    3705       22134 :       for (j = 0; j <= n; j++)
    3706             :       {
    3707       20244 :         GEN Caj = cgetg(j+2, t_VEC);
    3708       20244 :         GEN atij = gel(teich, Fl_powu(ai,j,p));/* w(a)^(-j) = w(a^(-j) mod p) */
    3709       20244 :         gel(Ca,j+1) = Caj;
    3710      158200 :         for (r = 0; r <= j; r++)
    3711             :         {
    3712      137956 :           GEN c = Fp_mul(gcoeff(pas,j+1,r+1), gel(powb, j-r+1), pn);
    3713      137956 :           c = Fp_mul(c,atij,pn); /* binomial(j,r)*b^(j-r)*w(a)^(-j) mod p^n */
    3714      137956 :           gel(Caj,r+1) = mulii(c, gel(P,j+1)); /* p^j * c mod p^(n+j) */
    3715             :         }
    3716             :       }
    3717             :     }
    3718             :   }
    3719         483 :   return gc_GEN(av, mkvecn(8, Wp,Tp, bin, actUp, q,
    3720             :                                  mkvecsmall3(p,n,flag), M, C));
    3721             : }
    3722             : 
    3723             : #if 0
    3724             : /* assume phi an ordinary OMS */
    3725             : static GEN
    3726             : omsactgl2(GEN W, GEN phi, GEN M)
    3727             : {
    3728             :   GEN q, Wp, act;
    3729             :   long p, k, n;
    3730             :   checkmspadic(W);
    3731             :   Wp = mspadic_get_Wp(W);
    3732             :   p = mspadic_get_p(W);
    3733             :   k = mspadic_get_weight(W);
    3734             :   n = mspadic_get_n(W);
    3735             :   q = mspadic_get_q(W);
    3736             :   act = init_moments_act(Wp, p, n, q, M);
    3737             :   phi = gel(phi,1);
    3738             :   return dual_act(k-1, act, gel(phi,1));
    3739             : }
    3740             : #endif
    3741             : 
    3742             : static GEN
    3743         483 : eigenvalue(GEN T, GEN x)
    3744             : {
    3745         483 :   long i, l = lg(x);
    3746         637 :   for (i = 1; i < l; i++)
    3747         637 :     if (!isintzero(gel(x,i))) break;
    3748         483 :   if (i == l) pari_err_DOMAIN("mstooms", "phi", "=", gen_0, x);
    3749         483 :   return gdiv(RgMrow_RgC_mul(T,x,i), gel(x,i));
    3750             : }
    3751             : 
    3752             : /* p coprime to ap, return unit root of x^2 - ap*x + p^(k-1), accuracy p^n */
    3753             : GEN
    3754         532 : mspadic_unit_eigenvalue(GEN ap, long k, GEN p, long n)
    3755             : {
    3756         532 :   GEN sqrtD, D = subii(sqri(ap), shifti(powiu(p,k-1),2));
    3757         532 :   if (absequaliu(p,2))
    3758             :   {
    3759          35 :     n++; sqrtD = Zp_sqrt(D, p, n);
    3760          35 :     if (mod4(sqrtD) != mod4(ap)) sqrtD = negi(sqrtD);
    3761             :   }
    3762             :   else
    3763         497 :     sqrtD = Zp_sqrtlift(D, ap, p, n);
    3764             :   /* sqrtD = ap (mod p) */
    3765         532 :   return gmul2n(gadd(ap, cvtop(sqrtD,p,n)), -1);
    3766             : }
    3767             : 
    3768             : /* W = msinit(N,k,...); phi = T_p/U_p - eigensymbol */
    3769             : GEN
    3770         483 : mstooms(GEN W, GEN phi)
    3771             : {
    3772         483 :   pari_sp av = avma;
    3773             :   GEN Wp, bin, Tp, c, alpha, ap, phi0, M;
    3774             :   long k, p, vden;
    3775             : 
    3776         483 :   checkmspadic(W);
    3777         483 :   if (typ(phi) != t_COL)
    3778             :   {
    3779         161 :     if (!is_Qevproj(phi)) pari_err_TYPE("mstooms",phi);
    3780         161 :     phi = gel(phi,1);
    3781         161 :     if (lg(phi) != 2) pari_err_TYPE("mstooms [dim_Q (eigenspace) > 1]",phi);
    3782         161 :     phi = gel(phi,1);
    3783             :   }
    3784             : 
    3785         483 :   Wp = mspadic_get_Wp(W);
    3786         483 :   Tp = mspadic_get_Tp(W);
    3787         483 :   bin = mspadic_get_bin(W);
    3788         483 :   k = msk_get_weight(Wp);
    3789         483 :   p = mspadic_get_p(W);
    3790         483 :   M = mspadic_get_M(W);
    3791             : 
    3792         483 :   phi = Q_remove_denom(phi, &c);
    3793         483 :   ap = eigenvalue(Tp, phi);
    3794         483 :   vden = c? Z_lvalrem(c, p, &c): 0;
    3795             : 
    3796         483 :   if (typ(M) == t_INT)
    3797             :   { /* p | N */
    3798             :     GEN c1;
    3799          84 :     alpha = ap;
    3800          84 :     alpha = ginv(alpha);
    3801          84 :     phi0 = mseval(Wp, phi, NULL);
    3802          84 :     phi0 = RgXC_to_moments(phi0, bin);
    3803          84 :     phi0 = Q_remove_denom(phi0, &c1);
    3804          84 :     if (c1) { vden += Z_lvalrem(c1, p, &c1); c = mul_denom(c,c1); }
    3805          84 :     if (umodiu(ap,p)) /* p \nmid a_p */
    3806          49 :       phi = oms_dim1(W, phi0, alpha, 0);
    3807             :     else
    3808             :     {
    3809          35 :       phi = oms_dim1(W, phi0, alpha, 1);
    3810          35 :       phi = Q_remove_denom(phi, &c1);
    3811          35 :       if (c1) { vden += Z_lvalrem(c1, p, &c1); c = mul_denom(c,c1); }
    3812             :     }
    3813             :   }
    3814             :   else
    3815             :   { /* p-stabilize */
    3816             :     GEN M1, M2, phi1, phi2, c1;
    3817         399 :     if (typ(M) != t_VEC || lg(M) != 3) pari_err_TYPE("mstooms",W);
    3818         399 :     M1 = gel(M,1);
    3819         399 :     M2 = gel(M,2);
    3820             : 
    3821         399 :     phi1 = RgM_RgC_mul(M1, phi);
    3822         399 :     phi2 = RgM_RgC_mul(M2, phi);
    3823         399 :     phi1 = mseval(Wp, phi1, NULL);
    3824         399 :     phi2 = mseval(Wp, phi2, NULL);
    3825             : 
    3826         399 :     phi1 = RgXC_to_moments(phi1, bin);
    3827         399 :     phi2 = RgXC_to_moments(phi2, bin);
    3828         399 :     phi = Q_remove_denom(mkvec2(phi1,phi2), &c1);
    3829         399 :     phi1 = gel(phi,1);
    3830         399 :     phi2 = gel(phi,2);
    3831         399 :     if (c1) { vden += Z_lvalrem(c1, p, &c1); c = mul_denom(c,c1); }
    3832             :     /* all polynomials multiplied by c p^vden */
    3833         399 :     if (umodiu(ap, p))
    3834             :     {
    3835         238 :       alpha = mspadic_unit_eigenvalue(ap, k, utoipos(p), mspadic_get_n(W));
    3836         238 :       alpha = ginv(alpha);
    3837         238 :       phi0 = gsub(phi1, gmul(lift_shallow(alpha),phi2));
    3838         238 :       phi = oms_dim1(W, phi0, alpha, 0);
    3839             :     }
    3840             :     else
    3841             :     { /* p | ap, alpha = [a_p, -1; p^(k-1), 0] */
    3842         161 :       long flag = mspadic_get_flag(W);
    3843         161 :       if (!flag || (signe(ap) && Z_lval(ap,p) < flag))
    3844           7 :         pari_err_TYPE("mstooms [v_p(ap) > mspadicinit flag]", phi);
    3845         154 :       alpha = mkmat22(ap,gen_m1, powuu(p, k-1),gen_0);
    3846         154 :       alpha = ginv(alpha);
    3847         154 :       phi = oms_dim2(W, mkvec2(phi1,phi2), gsqr(alpha), ap);
    3848         154 :       phi = Q_remove_denom(phi, &c1);
    3849         154 :       if (c1) { vden += Z_lvalrem(c1, p, &c1); c = mul_denom(c,c1); }
    3850             :     }
    3851             :   }
    3852         476 :   if (vden) c = mul_denom(c, powuu(p,vden));
    3853         476 :   if (p == 2) alpha = gsqr(alpha);
    3854         476 :   if (c) alpha = gdiv(alpha,c);
    3855         476 :   if (typ(alpha) == t_MAT)
    3856             :   { /* express in basis (omega,-p phi(omega)) */
    3857         154 :     gcoeff(alpha,2,1) = gdivgs(gcoeff(alpha,2,1), -p);
    3858         154 :     gcoeff(alpha,2,2) = gdivgs(gcoeff(alpha,2,2), -p);
    3859             :     /* at the end of mspadicint we shall multiply result by [1,0;0,-1/p]*alpha
    3860             :      * vden + k is the denominator of this matrix */
    3861             :   }
    3862             :   /* phi is integral-valued */
    3863         476 :   return gc_GEN(av, mkcol3(phi, stoi(vden), alpha));
    3864             : }
    3865             : 
    3866             : /* HACK: the v[j] have different lengths */
    3867             : static GEN
    3868        2156 : FpVV_dotproduct(GEN v, GEN w, GEN p)
    3869             : {
    3870        2156 :   long j, l = lg(v);
    3871        2156 :   GEN T = cgetg(l, t_VEC);
    3872       26026 :   for (j = 1; j < l; j++) gel(T,j) = FpV_dotproduct(gel(v,j),w,p);
    3873        2156 :   return T;
    3874             : }
    3875             : 
    3876             : /* 4^(i-1) x */
    3877             : static GEN
    3878        3822 : _4i(GEN x, long i)
    3879             : {
    3880        3822 :   if (i > 1) x = gmul2n(x, (i-1)<<1);
    3881        3822 :   return x;
    3882             : }
    3883             : /* (-1)^i 4^(i-1) x */
    3884             : static GEN
    3885        1911 : _m4i(GEN x, long i)
    3886        1911 : { x = _4i(x, i); return odd(i)? x: gneg(x); }
    3887             : /* \int (-4z)^j given \int z^j */
    3888             : static GEN
    3889          98 : twistmoment_m4(GEN x)
    3890        2009 : { pari_APPLY_same(_m4i(gel(x,i), i)); }
    3891             : /* \int (4z)^j given \int z^j */
    3892             : static GEN
    3893          98 : twistmoment_4(GEN x)
    3894        2009 : { pari_APPLY_same(_4i(gel(x,i), i)); }
    3895             : 
    3896             : /* W an mspadic, phi eigensymbol, p \nmid D. Return C(x) mod FilM */
    3897             : GEN
    3898         483 : mspadicmoments(GEN W, GEN PHI, long D)
    3899             : {
    3900         483 :   pari_sp av = avma;
    3901         483 :   long na, ia, b, lphi, aD = labs(D), pp, p, k, n, vden;
    3902             :   GEN Wp, Dact, vL, v, C, pn, phi;
    3903             :   struct m_act S;
    3904             :   hashtable *H;
    3905             : 
    3906         483 :   checkmspadic(W);
    3907         483 :   Wp = mspadic_get_Wp(W);
    3908         483 :   p = mspadic_get_p(W);
    3909         483 :   k = mspadic_get_weight(W);
    3910         483 :   n = mspadic_get_n(W);
    3911         483 :   C = mspadic_get_C(W);
    3912         483 :   if (typ(PHI) != t_COL || lg(PHI) != 4 || typ(gel(PHI,1)) != t_VEC)
    3913         476 :     PHI = mstooms(W, PHI);
    3914         476 :   vden = itos( gel(PHI,2) );
    3915         476 :   phi = gel(PHI,1); lphi = lg(phi);
    3916         476 :   if (p == 2) { na = 2; pp = 4; }
    3917         420 :   else        { na = p-1; pp = p; }
    3918         476 :   pn = powuu(p, n + vden);
    3919             : 
    3920         476 :   S.p = p;
    3921         476 :   S.k = k;
    3922         476 :   S.q = pn;
    3923         476 :   S.dim = n+k-1;
    3924         476 :   S.act = &moments_act;
    3925         476 :   H = Gl2act_cache(ms_get_nbgen(Wp));
    3926         476 :   if (D == 1) Dact = NULL;
    3927             :   else
    3928             :   {
    3929          63 :     GEN gaD = utoi(aD), Dk = Fp_pows(stoi(D), 2-k, pn);
    3930          63 :     if (!sisfundamental(D)) pari_err_TYPE("mspadicmoments", stoi(D));
    3931          63 :     if (D % p == 0) pari_err_DOMAIN("mspadicmoments","p","|", stoi(D), utoi(p));
    3932          63 :     Dact = cgetg(aD, t_VEC);
    3933         532 :     for (b = 1; b < aD; b++)
    3934             :     {
    3935         469 :       GEN z = NULL;
    3936         469 :       long s = kross(D, b);
    3937         469 :       if (s)
    3938             :       {
    3939         462 :         pari_sp av2 = avma;
    3940             :         GEN d;
    3941         462 :         z = moments_act_i(&S, mkmat22(gaD,utoipos(b), gen_0,gaD));
    3942         462 :         d = s > 0? Dk: Fp_neg(Dk, pn);
    3943         924 :         z = equali1(d)? gc_GEN(av2, z)
    3944         462 :                       : gc_upto(av2, FpM_Fp_mul(z, d, pn));
    3945             :       }
    3946         469 :       gel(Dact,b) = z;
    3947             :     }
    3948             :   }
    3949         476 :   vL = cgetg(na+1,t_VEC);
    3950             :   /* first pass to precompute log(paths), preload matrices and allow GC later */
    3951        2464 :   for (ia = 1; ia <= na; ia++)
    3952             :   {
    3953             :     GEN path, La;
    3954        1988 :     long a = (p == 2 && ia == 2)? -1: ia;
    3955        1988 :     if (Dact)
    3956             :     { /* twist by D */
    3957         224 :       La = cgetg(aD, t_VEC);
    3958        1442 :       for (b = 1; b < aD; b++)
    3959             :       {
    3960        1218 :         GEN Actb = gel(Dact,b);
    3961        1218 :         if (!Actb) continue;
    3962             :         /* oo -> a/pp + b/|D|*/
    3963        1176 :         path = mkmat22(gen_1, addii(mulss(a, aD), muluu(pp, b)),
    3964             :                        gen_0, muluu(pp, aD));
    3965        1176 :         gel(La,b) = M2_logf(Wp,path,NULL);
    3966        1176 :         ZGl2QC_preload(&S, gel(La,b), H);
    3967             :       }
    3968             :     }
    3969             :     else
    3970             :     {
    3971        1764 :       path = mkmat22(gen_1,stoi(a), gen_0, utoipos(pp));
    3972        1764 :       La = M2_logf(Wp,path,NULL);
    3973        1764 :       ZGl2QC_preload(&S, La, H);
    3974             :     }
    3975        1988 :     gel(vL,ia) = La;
    3976             :   }
    3977         476 :   v = cgetg(na+1,t_VEC);
    3978             :   /* second pass, with GC */
    3979        2464 :   for (ia = 1; ia <= na; ia++)
    3980             :   {
    3981        1988 :     pari_sp av2 = avma;
    3982        1988 :     GEN vca, Ca = gel(C,ia), La = gel(vL,ia), va = cgetg(lphi, t_VEC);
    3983             :     long i;
    3984        1988 :     if (!Dact) vca = omseval_int(&S, phi, La, H);
    3985             :     else
    3986             :     { /* twist by D */
    3987         224 :       vca = cgetg(lphi,t_VEC);
    3988        1442 :       for (b = 1; b < aD; b++)
    3989             :       {
    3990        1218 :         GEN T, Actb = gel(Dact,b);
    3991        1218 :         if (!Actb) continue;
    3992        1176 :         T = omseval_int(&S, phi, gel(La,b), H);
    3993        2352 :         for (i = 1; i < lphi; i++)
    3994             :         {
    3995        1176 :           GEN z = FpM_FpC_mul(Actb, gel(T,i), pn);
    3996        1176 :           gel(vca,i) = b==1? z: ZC_add(gel(vca,i), z);
    3997             :         }
    3998             :       }
    3999             :     }
    4000        1988 :     if (p != 2)
    4001        4032 :     { for (i=1; i<lphi; i++) gel(va,i) = FpVV_dotproduct(Ca,gel(vca,i),pn); }
    4002         112 :     else if (ia == 1) /* \tilde{a} = 1 */
    4003         154 :     { for (i=1; i<lphi; i++) gel(va,i) = twistmoment_4(gel(vca,i)); }
    4004             :     else /* \tilde{a} = -1 */
    4005         154 :     { for (i=1; i<lphi; i++) gel(va,i) = twistmoment_m4(gel(vca,i)); }
    4006        1988 :     gel(v,ia) = gc_GEN(av2, va);
    4007             :   }
    4008         476 :   return gc_GEN(av, mkvec3(v, gel(PHI,3), mkvecsmall4(p,n+vden,n,D)));
    4009             : }
    4010             : static void
    4011        1918 : checkoms(GEN v)
    4012             : {
    4013        1918 :   if (typ(v) != t_VEC || lg(v) != 4 || typ(gel(v,1)) != t_VEC
    4014        1918 :       || typ(gel(v,3))!=t_VECSMALL)
    4015           0 :     pari_err_TYPE("checkoms [apply mspadicmoments]", v);
    4016        1918 : }
    4017             : static long
    4018        4284 : oms_get_p(GEN oms) { return gel(oms,3)[1]; }
    4019             : static long
    4020        4186 : oms_get_n(GEN oms) { return gel(oms,3)[2]; }
    4021             : static long
    4022        2464 : oms_get_n0(GEN oms) { return gel(oms,3)[3]; }
    4023             : static long
    4024        1918 : oms_get_D(GEN oms) { return gel(oms,3)[4]; }
    4025             : static int
    4026          98 : oms_is_supersingular(GEN oms) { GEN v = gel(oms,1); return lg(gel(v,1)) == 3; }
    4027             : 
    4028             : /* sum(j = 1, n, (-1)^(j+1)/j * x^j) */
    4029             : static GEN
    4030         784 : log1x(long n)
    4031             : {
    4032         784 :   long i, l = n+3;
    4033         784 :   GEN v = cgetg(l, t_POL);
    4034         784 :   v[1] = evalvarn(0)|evalsigne(1); gel(v,2) = gen_0;
    4035        8904 :   for (i = 3; i < l; i++)
    4036        8120 :     gel(v,i) = mkfrac(odd(i)? gen_1: gen_m1, utoipos(i-2));
    4037         784 :   return v;
    4038             : }
    4039             : 
    4040             : /* S = (1+x)^zk log(1+x)^logj (mod x^(n+1)) */
    4041             : static GEN
    4042        1820 : xlog1x(long n, long zk, long logj, long *pteich)
    4043             : {
    4044        1820 :   GEN S = logj? RgXn_powu_i(log1x(n), logj, n+1): NULL;
    4045        1820 :   if (zk)
    4046             :   {
    4047        1183 :     GEN L = deg1pol_shallow(gen_1, gen_1, 0); /* x+1 */
    4048        1183 :     *pteich += zk;
    4049        1183 :     if (zk < 0) { L = RgXn_inv(L,n+1); zk = -zk; }
    4050        1183 :     if (zk != 1) L = RgXn_powu_i(L, zk, n+1);
    4051        1183 :     S = S? RgXn_mul(S, L, n+1): L;
    4052             :   }
    4053        1820 :   return S;
    4054             : }
    4055             : 
    4056             : /* oms from mspadicmoments; integrate teichmuller^i * S(x) [S = NULL: 1]*/
    4057             : static GEN
    4058        2366 : mspadicint(GEN oms, long teichi, GEN S)
    4059             : {
    4060        2366 :   pari_sp av = avma;
    4061        2366 :   long p = oms_get_p(oms), n = oms_get_n(oms), n0 = oms_get_n0(oms);
    4062        2366 :   GEN vT = gel(oms,1), alpha = gel(oms,2), gp = utoipos(p);
    4063        2366 :   long loss = S? Z_lval(Q_denom(S), p): 0;
    4064        2366 :   long nfinal = minss(n-loss, n0);
    4065        2366 :   long i, la, l = lg(gel(vT,1));
    4066        2366 :   GEN res = cgetg(l, t_COL), teich = NULL;
    4067             : 
    4068        2366 :   if (S) S = RgX_to_RgC(S,lg(gmael(vT,1,1))-1);
    4069        2366 :   if (p == 2)
    4070             :   {
    4071         448 :     la = 3; /* corresponds to [1,-1] */
    4072         448 :     teichi &= 1;
    4073             :   }
    4074             :   else
    4075             :   {
    4076        1918 :     la = p; /* corresponds to [1,2,...,p-1] */
    4077        1918 :     teichi = umodsu(teichi, p-1);
    4078        1918 :     if (teichi) teich = teichmullerinit(p, n);
    4079             :   }
    4080        5446 :   for (i=1; i<l; i++)
    4081             :   {
    4082        3080 :     pari_sp av2 = avma;
    4083        3080 :     GEN s = gen_0;
    4084             :     long ia;
    4085       14756 :     for (ia = 1; ia < la; ia++)
    4086             :     { /* Ta[j+1] correct mod p^n */
    4087       11676 :       GEN Ta = gmael(vT,ia,i), v = S? RgV_dotproduct(Ta, S): gel(Ta,1);
    4088       11676 :       if (teichi && ia != 1)
    4089             :       {
    4090        3843 :         if (p != 2)
    4091        3626 :           v = gmul(v, gel(teich, Fl_powu(ia,teichi,p)));
    4092             :         else
    4093         217 :           if (teichi) v = gneg(v);
    4094             :       }
    4095       11676 :       s = gadd(s, v);
    4096             :     }
    4097        3080 :     s = gadd(s, zeropadic_shallow(gp,nfinal));
    4098        3080 :     gel(res,i) = gc_upto(av2, s);
    4099             :   }
    4100        2366 :   return gc_upto(av, gmul(alpha, res));
    4101             : }
    4102             : /* integrate P = polynomial in log(x); vlog[j+1] = mspadicint(0,log(1+x)^j) */
    4103             : static GEN
    4104         539 : mspadicint_RgXlog(GEN P, GEN vlog)
    4105             : {
    4106         539 :   long i, d = degpol(P);
    4107         539 :   GEN s = gmul(gel(P,2), gel(vlog,1));
    4108        1848 :   for (i = 1; i <= d; i++) s = gadd(s, gmul(gel(P,i+2), gel(vlog,i+1)));
    4109         539 :   return s;
    4110             : };
    4111             : 
    4112             : /* oms from mspadicmoments */
    4113             : GEN
    4114          98 : mspadicseries(GEN oms, long teichi)
    4115             : {
    4116          98 :   pari_sp av = avma;
    4117             :   GEN S, L, X, vlog, s, s2, u, logu, bin;
    4118             :   long j, p, m, n, step, stop;
    4119          98 :   checkoms(oms);
    4120          98 :   n = oms_get_n0(oms);
    4121          98 :   if (n < 1)
    4122             :   {
    4123           0 :     s = zeroser(0,0);
    4124           0 :     if (oms_is_supersingular(oms)) s = mkvec2(s,s);
    4125           0 :     return gc_GEN(av, s);
    4126             :   }
    4127          98 :   p = oms_get_p(oms);
    4128          98 :   vlog = cgetg(n+1, t_VEC);
    4129          98 :   step = p == 2? 2: 1;
    4130          98 :   stop = 0;
    4131          98 :   S = NULL;
    4132          98 :   L = log1x(n);
    4133         644 :   for (j = 0; j < n; j++)
    4134             :   {
    4135         616 :     if (j) stop += step + u_lval(j,p); /* = step*j + v_p(j!) */
    4136         616 :     if (stop >= n) break;
    4137             :     /* S = log(1+x)^j */
    4138         546 :     gel(vlog,j+1) = mspadicint(oms,teichi,S);
    4139         546 :     S = S? RgXn_mul(S, L, n+1): L;
    4140             :   }
    4141          98 :   m = j;
    4142          98 :   u = utoipos(p == 2? 5: 1+p);
    4143          98 :   logu = glog(cvtop(u, utoipos(p), 4*m), 0);
    4144          98 :   X = gdiv(pol_x(0), logu);
    4145          98 :   s = cgetg(m+1, t_VEC);
    4146          98 :   s2 = oms_is_supersingular(oms)? cgetg(m+1, t_VEC): NULL;
    4147          98 :   bin = pol_1(0);
    4148         539 :   for (j = 0; j < m; j++)
    4149             :   { /* bin = binomial(x/log(1+p+O(p^(4*n))), j) mod x^m */
    4150         539 :     GEN a, v = mspadicint_RgXlog(bin, vlog);
    4151         539 :     int done = 1;
    4152         539 :     gel(s,j+1) = a = gel(v,1);
    4153         539 :     if (!gequal0(a) || valp(a) > 0) done = 0; else setlg(s,j+1);
    4154         539 :     if (s2)
    4155             :     {
    4156         119 :       gel(s2,j+1) = a = gel(v,2);
    4157         119 :       if (!gequal0(a) || valp(a) > 0) done = 0; else setlg(s2,j+1);
    4158             :     }
    4159         539 :     if (done || j == m-1) break;
    4160         441 :     bin = RgXn_mul(bin, gdivgu(gsubgs(X, j), j+1), m);
    4161             :   }
    4162          98 :   s = RgV_to_ser(s,0,lg(s)+1);
    4163          98 :   if (s2) { s2 = RgV_to_ser(s2,0,lg(s2)+1); s = mkvec2(s, s2); }
    4164          98 :   if (kross(oms_get_D(oms), p) >= 0) return gc_GEN(av, s);
    4165           7 :   return gc_upto(av, gneg(s));
    4166             : }
    4167             : void
    4168        1911 : mspadic_parse_chi(GEN s, GEN *s1, GEN *s2)
    4169             : {
    4170        1911 :   if (!s) *s1 = *s2 = gen_0;
    4171        1778 :   else switch(typ(s))
    4172             :   {
    4173        1274 :     case t_INT: *s1 = *s2 = s; break;
    4174         504 :     case t_VEC:
    4175         504 :       if (lg(s) == 3)
    4176             :       {
    4177         504 :         *s1 = gel(s,1);
    4178         504 :         *s2 = gel(s,2);
    4179         504 :         if (typ(*s1) == t_INT && typ(*s2) == t_INT) break;
    4180             :       }
    4181           0 :     default: pari_err_TYPE("mspadicL",s);
    4182           0 :              *s1 = *s2 = NULL;
    4183             :   }
    4184        1911 : }
    4185             : /* oms from mspadicmoments
    4186             :  * r-th derivative of L(f,chi^s,psi) in direction <chi>
    4187             :    - s \in Z_p \times \Z/(p-1)\Z, s-> chi^s=<\chi>^s_1 omega^s_2)
    4188             :    - Z -> Z_p \times \Z/(p-1)\Z par s-> (s, s mod p-1).
    4189             :  */
    4190             : GEN
    4191        1820 : mspadicL(GEN oms, GEN s, long r)
    4192             : {
    4193        1820 :   pari_sp av = avma;
    4194             :   GEN s1, s2, z, S;
    4195             :   long p, n, teich;
    4196        1820 :   checkoms(oms);
    4197        1820 :   p = oms_get_p(oms);
    4198        1820 :   n = oms_get_n(oms);
    4199        1820 :   mspadic_parse_chi(s, &s1,&s2);
    4200        1820 :   teich = umodiu(subii(s2,s1), p==2? 2: p-1);
    4201        1820 :   S = xlog1x(n, itos(s1), r, &teich);
    4202        1820 :   z = mspadicint(oms, teich, S);
    4203        1820 :   if (lg(z) == 2) z = gel(z,1);
    4204        1820 :   if (kross(oms_get_D(oms), p) < 0) z = gneg(z);
    4205        1820 :   return gc_GEN(av, z);
    4206             : }
    4207             : 
    4208             : /****************************************************************************/
    4209             : 
    4210             : struct siegel
    4211             : {
    4212             :   GEN V, Ast;
    4213             :   long N; /* level */
    4214             :   long oo; /* index of the [oo,0] path */
    4215             :   long k1, k2; /* two distinguished indices */
    4216             :   long n; /* #W, W = initial segment [in siegelstepC] already normalized */
    4217             : };
    4218             : 
    4219             : static void
    4220        2527 : siegel_init(struct siegel *C, GEN M)
    4221             : {
    4222             :   GEN CPI, CP, MM, V, W, Ast;
    4223        2527 :   GEN m = gel(M,11), M2 = gel(M,2), S = msN_get_section(M);
    4224        2527 :   GEN E2fromE1 = msN_get_E2fromE1(M);
    4225        2527 :   long m0 = lg(M2)-1;
    4226        2527 :   GEN E2  = vecslice(M2, m[1]+1, m[2]);/* E2 */
    4227        2527 :   GEN E1T = vecslice(M2, m[3]+1, m0); /* E1,T2,T31 */
    4228        2527 :   GEN L = shallowconcat(E1T, E2);
    4229        2527 :   long i, l = lg(L), n = lg(E1T)-1, lE = lg(E2);
    4230             : 
    4231        2527 :   Ast = cgetg(l, t_VECSMALL);
    4232       45479 :   for (i = 1; i < lE; ++i)
    4233             :   {
    4234       42952 :     long j = E2fromE1_c(gel(E2fromE1,i));
    4235       42952 :     Ast[n+i] = j;
    4236       42952 :     Ast[j] = n+i;
    4237             :   }
    4238        4053 :   for (; i<=n; ++i) Ast[i] = i;
    4239        2527 :   MM = cgetg (l,t_VEC);
    4240             : 
    4241       89957 :   for (i = 1; i < l; i++)
    4242             :   {
    4243       87430 :     GEN c = gel(S, L[i]);
    4244       87430 :     long c12, c22, c21 = ucoeff(c,2,1);
    4245       87430 :     if (!c21) { gel(MM,i) = gen_0; continue; }
    4246       84903 :     c22 = ucoeff(c,2,2);
    4247       84903 :     if (!c22) { gel(MM,i) = gen_m1; continue; }
    4248       82376 :     c12 = ucoeff(c,1,2);
    4249       82376 :     gel(MM,i) = sstoQ(c12, c22); /* right extremity > 0 */
    4250             :   }
    4251        2527 :   CP = indexsort(MM);
    4252        2527 :   CPI = cgetg(l, t_VECSMALL);
    4253        2527 :   V = cgetg(l, t_VEC);
    4254        2527 :   W = cgetg(l, t_VECSMALL);
    4255       89957 :   for (i = 1; i < l; ++i)
    4256             :   {
    4257       87430 :     gel(V,i) = mat2_to_ZM(gel(S, L[CP[i]]));
    4258       87430 :     CPI[CP[i]] = i;
    4259             :   }
    4260       89957 :   for (i = 1; i < l; ++i) W[CPI[i]] = CPI[Ast[i]];
    4261        2527 :   C->V = V;
    4262        2527 :   C->Ast = W;
    4263        2527 :   C->n = 0;
    4264        2527 :   C->oo = 2;
    4265        2527 :   C->N = ms_get_N(M);
    4266        2527 : }
    4267             : 
    4268             : static double
    4269           0 : ZMV_size(GEN v)
    4270             : {
    4271           0 :   long i, l = lg(v);
    4272           0 :   GEN z = cgetg(l, t_VECSMALL);
    4273           0 :   for (i = 1; i < l; i++) z[i] = gexpo(gel(v,i));
    4274           0 :   return ((double)zv_sum(z)) / (4*(l-1));
    4275             : }
    4276             : 
    4277             : /* apply permutation perm to struct S. Don't follow k1,k2 */
    4278             : static void
    4279        5558 : siegel_perm0(struct siegel *S, GEN perm)
    4280             : {
    4281        5558 :   pari_sp av = avma;
    4282        5558 :   long i, l = lg(S->V);
    4283        5558 :   GEN V2 = cgetg(l, t_VEC), Ast2 = cgetg(l, t_VECSMALL);
    4284        5558 :   GEN V = S->V, Ast = S->Ast;
    4285             : 
    4286      267078 :   for (i = 1; i < l; i++) gel(V2,perm[i]) = gel(V,i);
    4287      267078 :   for (i = 1; i < l; i++) Ast2[perm[i]] = perm[Ast[i]];
    4288      267078 :   for (i = 1; i < l; i++) { S->Ast[i] = Ast2[i]; gel(V,i) = gel(V2,i); }
    4289        5558 :   set_avma(av); S->oo = perm[S->oo];
    4290        5558 : }
    4291             : /* apply permutation perm to full struct S */
    4292             : static void
    4293        5194 : siegel_perm(struct siegel *S, GEN perm)
    4294             : {
    4295        5194 :   siegel_perm0(S, perm);
    4296        5194 :   S->k1 = perm[S->k1];
    4297        5194 :   S->k2 = perm[S->k2];
    4298        5194 : }
    4299             : /* cyclic permutation of lg = l-1 moving a -> 1, a+1 -> 2, etc.  */
    4300             : static GEN
    4301        2884 : rotate_perm(long l, long a)
    4302             : {
    4303        2884 :   GEN p = cgetg(l, t_VECSMALL);
    4304        2884 :   long i, j = 1;
    4305       86905 :   for (i = a; i < l; i++) p[i] = j++;
    4306       49329 :   for (i = 1; i < a; i++) p[i] = j++;
    4307        2884 :   return p;
    4308             : }
    4309             : 
    4310             : /* a1 < c1 <= a2 < c2*/
    4311             : static GEN
    4312        2520 : basic_op_perm(long l, long a1, long a2, long c1, long c2)
    4313             : {
    4314        2520 :   GEN p = cgetg(l, t_VECSMALL);
    4315        2520 :   long i, j = 1;
    4316        2520 :   p[a1] = j++;
    4317       22568 :   for (i = c1; i < a2; i++)   p[i] = j++;
    4318       32284 :   for (i = a1+1; i < c1; i++) p[i] = j++;
    4319        2520 :   p[a2] = j++;
    4320       44891 :   for (i = c2; i < l; i++)    p[i] = j++;
    4321        2520 :   for (i = 1; i < a1; i++)    p[i] = j++;
    4322       29855 :   for (i = a2+1; i < c2; i++) p[i] = j++;
    4323        2520 :   return p;
    4324             : }
    4325             : static GEN
    4326         154 : basic_op_perm_elliptic(long l, long a1)
    4327             : {
    4328         154 :   GEN p = cgetg(l, t_VECSMALL);
    4329         154 :   long i, j = 1;
    4330         154 :   p[a1] = j++;
    4331        2660 :   for (i = 1; i < a1; i++)   p[i] = j++;
    4332        3990 :   for (i = a1+1; i < l; i++) p[i] = j++;
    4333         154 :   return p;
    4334             : }
    4335             : static GEN
    4336       90104 : ZM2_rev(GEN T) { return mkmat2(gel(T,2), ZC_neg(gel(T,1))); }
    4337             : 
    4338             : /* In place, V = vector of consecutive paths, between x <= y.
    4339             :  * V[x..y-1] <- g*V[x..y-1] */
    4340             : static void
    4341        5733 : path_vec_mul(GEN V, long x, long y, GEN g)
    4342             : {
    4343             :   long j;
    4344             :   GEN M;
    4345        5733 :   if (x == y) return;
    4346        3360 :   M = gel(V,x); gel(V,x) = ZM_mul(g,M);
    4347       37709 :   for (j = x+1; j < y; j++) /* V[j] <- g*V[j], optimized */
    4348             :   {
    4349       34349 :     GEN Mnext = gel(V,j); /* Mnext[,1] = M[,2] */
    4350       34349 :     GEN gM = gel(V,j-1), u = gel(gM,2);
    4351       34349 :     if (!ZV_equal(gel(M,2), gel(Mnext,1))) u = ZC_neg(u);
    4352       34349 :     gel(V,j) = mkmat2(u, ZM_ZC_mul(g,gel(Mnext,2)));
    4353       34349 :     M = Mnext;
    4354             :   }
    4355             : }
    4356             : 
    4357        4830 : static long prev(GEN V, long i) { return (i == 1)? lg(V)-1: i-1; }
    4358        4830 : static long next(GEN V, long i) { return (i == lg(V)-1)? 1: i+1; }
    4359             : static GEN
    4360       95298 : ZM_det2(GEN u, GEN v)
    4361             : {
    4362       95298 :   GEN a = gel(u,1), c = gel(u,2);
    4363       95298 :   GEN b = gel(v,1), d = gel(v,2); return subii(mulii(a,d), mulii(b,c));
    4364             : }
    4365             : static GEN
    4366       90104 : ZM2_det(GEN T) { return ZM_det2(gel(T,1),gel(T,2)); }
    4367             : static long
    4368        5194 : ZM_det2_sign(GEN u, GEN v)
    4369             : {
    4370        5194 :   pari_sp av = avma;
    4371        5194 :   long s = signe(ZM_det2(u, v));
    4372        5194 :   return gc_long(av, s);
    4373             : }
    4374             : static void
    4375        4466 : fill1(GEN V, long a)
    4376             : {
    4377        4466 :   long p = prev(V,a), n = next(V,a);
    4378        4466 :   GEN u = gmael(V,p,2), v = gmael(V,n,1);
    4379        4466 :   if (ZM_det2_sign(u,v) < 0) v = ZC_neg(v);
    4380        4466 :   gel(V,a) = mkmat2(u, v);
    4381        4466 : }
    4382             : /* a1 < a2 */
    4383             : static void
    4384        2520 : fill2(GEN V, long a1, long a2)
    4385             : {
    4386        2520 :   if (a2 != a1+1) { fill1(V,a1); fill1(V,a2); } /* non adjacent, reconnect */
    4387             :   else
    4388             :   { /* parabolic */
    4389         364 :     long p = prev(V,a1), n = next(V,a2);
    4390         364 :     GEN u, v, C = gmael(V,a1,2), mC = NULL; /* = \pm V[a2][1] */
    4391         364 :     u = gmael(V,p,2); v = C;
    4392         364 :     if (ZM_det2_sign(u,v) < 0) v = mC = ZC_neg(C);
    4393         364 :     gel(V,a1) = mkmat2(u,v);
    4394         364 :     v = gmael(V,n,1); u = C;
    4395         364 :     if (ZM_det2_sign(u,v) < 0) u = mC? mC: ZC_neg(C);
    4396         364 :     gel(V,a2) = mkmat2(u,v);
    4397             :   }
    4398        2520 : }
    4399             : 
    4400             : /* DU = det(U), return g = T*U^(-1) or NULL if not in Gamma0(N); if N = 0,
    4401             :  * only test whether g is integral */
    4402             : static GEN
    4403       90979 : ZM2_div(GEN T, GEN U, GEN DU, long N)
    4404             : {
    4405       90979 :   GEN a=gcoeff(U,1,1), b=gcoeff(U,1,2), c=gcoeff(U,2,1), d=gcoeff(U,2,2);
    4406       90979 :   GEN e=gcoeff(T,1,1), f=gcoeff(T,1,2), g=gcoeff(T,2,1), h=gcoeff(T,2,2);
    4407             :   GEN A, B, C, D, r;
    4408             : 
    4409       90979 :   C = dvmdii(subii(mulii(d,g), mulii(c,h)), DU, &r);
    4410       90979 :   if (r != gen_0 || (N && smodis(C,N))) return NULL;
    4411       90104 :   A = dvmdii(subii(mulii(d,e), mulii(c,f)), DU, &r);
    4412       90104 :   if (r != gen_0) return NULL;
    4413       90104 :   B = dvmdii(subii(mulii(a,f), mulii(b,e)), DU, &r);
    4414       90104 :   if (r != gen_0) return NULL;
    4415       90104 :   D = dvmdii(subii(mulii(a,h), mulii(g,b)), DU, &r);
    4416       90104 :   if (r != gen_0) return NULL;
    4417       90104 :   retmkmat22(A,B,C,D);
    4418             : }
    4419             : 
    4420             : static GEN
    4421       90104 : get_g(struct siegel *S, long a1)
    4422             : {
    4423       90104 :   pari_sp av = avma;
    4424       90104 :   long a2 = S->Ast[a1];
    4425       90104 :   GEN a = gel(S->V,a1), ar = ZM2_rev(gel(S->V,a2)), Dar = ZM2_det(ar);
    4426       90104 :   GEN g = ZM2_div(a, ar, Dar, S->N);
    4427       90104 :   if (!g)
    4428             :   {
    4429         875 :     GEN tau = mkmat22(gen_0,gen_m1, gen_1,gen_m1); /*[0,-1;1,-1]*/
    4430         875 :     g = ZM2_div(ZM_mul(ar, tau), ar, Dar, 0);
    4431             :   }
    4432       90104 :   return gc_GEN(av, g);
    4433             : }
    4434             : /* input V = (X1 a X2 | X3 a^* X4) + Ast
    4435             :  * a1 = index of a
    4436             :  * a2 = index of a^*, inferred from a1. We must have a != a^*
    4437             :  * c1 = first cut [ index of first path in X3 ]
    4438             :  * c2 = second cut [ either in X4 or X1, index of first path ]
    4439             :  * Assume a < a^* (cf Paranoia below): c1 or c2 must be in
    4440             :  *    ]a,a^*], and the other in the "complement" ]a^*,a] */
    4441             : static void
    4442        2520 : basic_op(struct siegel *S, long a1, long c1, long c2)
    4443             : {
    4444             :   pari_sp av;
    4445        2520 :   long l = lg(S->V), a2 = S->Ast[a1];
    4446             :   GEN g;
    4447             : 
    4448        2520 :   if (a1 == a2)
    4449             :   { /* a = a^* */
    4450           0 :     g = get_g(S, a1);
    4451           0 :     path_vec_mul(S->V, a1+1, l, g);
    4452           0 :     av = avma;
    4453           0 :     siegel_perm(S, basic_op_perm_elliptic(l, a1));
    4454             :     /* fill the hole left at a1, reconnect the path */
    4455           0 :     set_avma(av); fill1(S->V, a1); return;
    4456             :   }
    4457             : 
    4458             :   /* Paranoia: (a,a^*) conjugate, call 'a' the first one */
    4459        2520 :   if (a2 < a1) lswap(a1,a2);
    4460             :   /* Now a1 < a2 */
    4461        2520 :   if (c1 <= a1 || c1 > a2) lswap(c1,c2); /* ensure a1 < c1 <= a2 */
    4462        2520 :   if (c2 < a1)
    4463             :   { /* if cut c2 is in X1 = X11|X12, rotate to obtain
    4464             :        (a X2 | X3 a^* X4 X11|X12): then a1 = 1 */
    4465             :     GEN p;
    4466        2520 :     av = avma; p = rotate_perm(l, a1);
    4467        2520 :     siegel_perm(S, p);
    4468        2520 :     a1 = 1; /* = p[a1] */
    4469        2520 :     a2 = S->Ast[1]; /* > a1 */
    4470        2520 :     c1 = p[c1];
    4471        2520 :     c2 = p[c2]; set_avma(av);
    4472             :   }
    4473             :   /* Now a1 < c1 <= a2 < c2; a != a^* */
    4474        2520 :   g = get_g(S, a1);
    4475        2520 :   if (S->oo >= c1 && S->oo < c2) /* W inside [c1..c2[ */
    4476         539 :   { /* c2 -> c1 excluding a1 */
    4477         539 :     GEN gi = SL2_inv_shallow(g); /* g a^* = a; gi a = a^* */
    4478         539 :     path_vec_mul(S->V, 1, a1, gi);
    4479         539 :     path_vec_mul(S->V, a1+1, c1, gi);
    4480         539 :     path_vec_mul(S->V, c2, l, gi);
    4481             :   }
    4482             :   else
    4483             :   { /* c1 -> c2 excluding a2 */
    4484        1981 :     path_vec_mul(S->V, c1, a2, g);
    4485        1981 :     path_vec_mul(S->V, a2+1, c2, g);
    4486             :   }
    4487        2520 :   av = avma;
    4488        2520 :   siegel_perm(S, basic_op_perm(l, a1,a2, c1,c2));
    4489        2520 :   set_avma(av);
    4490             :   /* fill the holes left at a1,a2, reconnect the path */
    4491        2520 :   fill2(S->V, a1, a2);
    4492             : }
    4493             : /* a = a^* (elliptic case) */
    4494             : static void
    4495         154 : basic_op_elliptic(struct siegel *S, long a1)
    4496             : {
    4497             :   pari_sp av;
    4498         154 :   long l = lg(S->V);
    4499         154 :   GEN g = get_g(S, a1);
    4500         154 :   path_vec_mul(S->V, a1+1, l, g);
    4501         154 :   av = avma; siegel_perm(S, basic_op_perm_elliptic(l, a1));
    4502             :   /* fill the hole left at a1 (now at 1), reconnect the path */
    4503         154 :   set_avma(av); fill1(S->V, 1);
    4504         154 : }
    4505             : 
    4506             : /* input V = W X a b Y a^* Z b^* T, W already normalized
    4507             :  * X = [n+1, k1-1], Y = [k2+1, Ast[k1]-1],
    4508             :  * Z = [Ast[k1]+1, Ast[k2]-1], T = [Ast[k2]+1, oo].
    4509             :  * Assume that X doesn't start by c c^* or a b a^* b^*. */
    4510             : static void
    4511        1057 : siegelstep(struct siegel *S)
    4512             : {
    4513        1057 :   if (S->Ast[S->k1] == S->k1)
    4514             :   {
    4515         154 :     basic_op_elliptic(S, S->k1);
    4516         154 :     S->n++;
    4517             :   }
    4518         903 :   else if (S->Ast[S->k1] == S->k1+1)
    4519             :   {
    4520         364 :     basic_op(S, S->k1, S->Ast[S->k1], 1); /* 1: W starts there */
    4521         364 :     S->n += 2;
    4522             :   }
    4523             :   else
    4524             :   {
    4525         539 :     basic_op(S, S->k2, S->Ast[S->k1], 1); /* 1: W starts there */
    4526         539 :     basic_op(S, S->k1, S->k2, S->Ast[S->k2]);
    4527         539 :     basic_op(S, S->Ast[S->k2], S->k2, S->Ast[S->k1]);
    4528         539 :     basic_op(S, S->k1, S->Ast[S->k1], S->Ast[S->k2]);
    4529         539 :     S->n += 4;
    4530             :   }
    4531        1057 : }
    4532             : 
    4533             : /* normalize hyperbolic polygon */
    4534             : static void
    4535         301 : mssiegel(struct siegel *S)
    4536             : {
    4537         301 :   pari_sp av = avma;
    4538             :   long k, t, nv;
    4539             : #ifdef COUNT
    4540             :   long countset[16];
    4541             :   for (k = 0; k < 16; k++) countset[k] = 0;
    4542             : #endif
    4543             : 
    4544         301 :   nv = lg(S->V)-1;
    4545         301 :   if (DEBUGLEVEL>1) err_printf("nv = %ld, expo = %.2f\n", nv,ZMV_size(S->V));
    4546         301 :   t = 0;
    4547        2205 :   while (S->n < nv)
    4548             :   {
    4549        1904 :     if (S->Ast[S->n+1] == S->n+1) { S->n++; continue; }
    4550        1778 :     if (S->Ast[S->n+1] == S->n+2) { S->n += 2; continue; }
    4551        1134 :     if (S->Ast[S->n+1] == S->n+3 && S->Ast[S->n+2] == S->n+4) { S->n += 4; continue; }
    4552        1057 :     k = nv;
    4553        1127 :     while (k > S->n)
    4554             :     {
    4555        1127 :       if (S->Ast[k] == k) { k--; continue; }
    4556        1099 :       if (S->Ast[k] == k-1) { k -= 2; continue; }
    4557        1057 :       if (S->Ast[k] == k-2 && S->Ast[k-1] == k-3) { k -= 4; continue; }
    4558        1057 :       break;
    4559             :     }
    4560        1057 :     if (k != nv)
    4561             :     {
    4562          63 :       pari_sp av2 = avma;
    4563          63 :       siegel_perm0(S, rotate_perm(nv+1, k+1));
    4564          63 :       set_avma(av2); S->n += nv-k;
    4565             :     }
    4566             : 
    4567        6223 :     for (k = S->n+1; k <= nv; k++)
    4568        6223 :       if (S->Ast[k] <= k) { t = S->Ast[k]; break; }
    4569        1057 :     S->k1 = t;
    4570        1057 :     S->k2 = t+1;
    4571             : #ifdef COUNT
    4572             :     countset[ ((S->k1-1 == S->n)
    4573             :               | ((S->k2 == S->Ast[S->k1]-1) << 1)
    4574             :               | ((S->Ast[S->k1] == S->Ast[S->k2]-1) << 2)
    4575             :               | ((S->Ast[S->k2] == nv) << 3)) ]++;
    4576             : #endif
    4577        1057 :     siegelstep(S);
    4578        1057 :     if (gc_needed(av,2))
    4579             :     {
    4580           0 :       if(DEBUGMEM>1) pari_warn(warnmem,"mspolygon, n = %ld",S->n);
    4581           0 :       (void)gc_all(av, 2, &S->V, &S->Ast);
    4582             :     }
    4583             :   }
    4584         301 :   if (DEBUGLEVEL>1) err_printf("expo = %.2f\n", ZMV_size(S->V));
    4585             : #ifdef COUNT
    4586             :   for (k = 0; k < 16; k++)
    4587             :     err_printf("%3ld: %6ld\n", k, countset[k]);
    4588             : #endif
    4589         301 : }
    4590             : 
    4591             : /* return a vector of char* */
    4592             : static GEN
    4593           0 : Ast2v(GEN Ast)
    4594             : {
    4595           0 :   long j = 0, k, l = lg(Ast);
    4596           0 :   GEN v = const_vec(l-1, NULL);
    4597           0 :   for (k=1; k < l; k++)
    4598             :   {
    4599             :     char *sj;
    4600           0 :     if (gel(v,k)) continue;
    4601           0 :     j++;
    4602           0 :     sj = stack_sprintf("$%ld$", j);
    4603           0 :     gel(v,k) = (GEN)sj;
    4604           0 :     if (Ast[k] != k) gel(v,Ast[k]) = (GEN)stack_sprintf("$%ld^*$", j);
    4605             :   }
    4606           0 :   return v;
    4607             : };
    4608             : 
    4609             : static void
    4610           0 : decorate(pari_str *s, GEN g, GEN arc, double high)
    4611             : {
    4612           0 :   double a = gtodouble(gcoeff(g,1,1)), c = gtodouble(gcoeff(g,2,1));
    4613           0 :   double d = gtodouble(gcoeff(g,2,2));
    4614           0 :   if (a + d)
    4615             :   {
    4616           0 :     double t, u, C = 360/(2*M_PI), x = (a-d) / (2*c), y = 0.8660254/fabs(c);
    4617           0 :     long D1 = itos(gcoeff(arc,2,1));
    4618           0 :     long D2 = itos(gcoeff(arc,2,2));
    4619           0 :     str_printf(s, "\\coordinate (ellpt) at (%.4f,%.4f);\n\\draw (ellpt) node {$\\bullet$}\n", x, y);
    4620           0 :     if (D1)
    4621             :     {
    4622           0 :       t = gtodouble(gcoeff(arc,1,1)) / D1;
    4623           0 :       u = (x*x + y*y - t*t)/(x-t)/2;
    4624           0 :       str_printf(s, "arc (%.4f:180:%.4f)\n", C*atan2(y,x-u), fabs(t-u));
    4625             :     }
    4626             :     else
    4627           0 :       str_printf(s, "-- (%.4f,%.4f)\n", x, high);
    4628           0 :     if (D2)
    4629             :     {
    4630           0 :       t = gtodouble(gcoeff(arc,1,2)) / D2;
    4631           0 :       u = (x*x + y*y - t*t)/(x-t)/2;
    4632           0 :       str_printf(s, "(ellpt) arc (%.4f:0:%.4f);\n", C*atan2(y,x-u), fabs(t-u));
    4633             :     }
    4634             :     else
    4635           0 :       str_printf(s, "(ellpt) -- (%.4f,%.4f);\n", x, high);
    4636             :   }
    4637             :   else
    4638           0 :     str_printf(s, "\\draw (%.4f,%.4f) node {$\\circ$};\n",a/c,fabs(1/c));
    4639           0 : }
    4640             : 
    4641             : static GEN
    4642           0 : polygon2tex(GEN V, GEN Ast, GEN G)
    4643             : {
    4644           0 :   pari_sp av = avma;
    4645             :   pari_str s;
    4646           0 :   long j, l = lg(V), flag = (l <= 16);
    4647           0 :   double d, high = (l < 4)? 1.2: 0.5;
    4648           0 :   GEN v = Ast2v(Ast), r1 = NULL, r2 = NULL;
    4649             : 
    4650           0 :   for (j = 1; j < l; j++)
    4651             :   {
    4652           0 :     GEN arc = gel(V,j);
    4653           0 :     if (!signe(gcoeff(arc,2,1)))
    4654           0 :       r1 = gdiv(gcoeff(arc,1,2), gcoeff(arc,2,2));
    4655           0 :     else if (!signe(gcoeff(arc,2,2)))
    4656           0 :       r2 = gdiv(gcoeff(arc,1,1), gcoeff(arc,2,1));
    4657             :   }
    4658           0 :   if (!r1 || !r2) pari_err_BUG("polgon2tex");
    4659           0 :   str_init(&s, 1); d = fabs(gtodouble(gsub(r1,r2)));
    4660           0 :   str_printf(&s, "\n\\begin{tikzpicture}[scale=%.2f]\n",
    4661             :                  d? (10 / d): 10);
    4662           0 :   for (j = 1; j < l; j++)
    4663             :   {
    4664           0 :     GEN arc = gel(V,j);
    4665           0 :     if (itos(gcoeff(arc,2,1)))
    4666             :     {
    4667           0 :       GEN a = gdiv(gcoeff(arc,1,1), gcoeff(arc,2,1));
    4668           0 :       double aa = gtodouble(a);
    4669           0 :       str_printf(&s, "\\draw (%.4f,0) ", aa);
    4670           0 :       if (flag || j == 2 || j == l-1)
    4671             :       {
    4672             :         long n, d;
    4673           0 :         Qtoss(a, &n, &d);
    4674           0 :         if (d == 1)
    4675           0 :           str_printf(&s, "node [below] {$%ld$}\n", n);
    4676             :         else
    4677           0 :           str_printf(&s, "node [below] {$\\frac{%ld}{%ld}$}\n", n, d);
    4678             :       }
    4679           0 :       if (itos(gcoeff(arc,2,2)))
    4680             :       {
    4681           0 :         GEN b = gdiv(gcoeff(arc,1,2),gcoeff(arc,2,2));
    4682           0 :         str_printf(&s, "arc (%s:%.4f) ", (gcmp(a,b)<0)?"180:0":"0:180",
    4683           0 :                    fabs((gtodouble(b)-aa)/2));
    4684           0 :         if (flag)
    4685           0 :           str_printf(&s, "node [midway, above] {%s} ", (char*)gel(v,j));
    4686             :       }
    4687             :       else
    4688             :       {
    4689           0 :         str_printf(&s, "-- (%.4f,%.4f) ", aa, high);
    4690           0 :         if (flag)
    4691           0 :           str_printf(&s, "node [very near end, right] {%s}",(char*)gel(v,j));
    4692             :       }
    4693             :     }
    4694             :     else
    4695             :     {
    4696           0 :       GEN b = gdiv(gcoeff(arc,1,2), gcoeff(arc,2,2));
    4697           0 :       double bb = gtodouble(b);
    4698           0 :       str_printf(&s, "\\draw (%.4f,%.4f)--(%.4f,0)\n", bb, high, bb);
    4699           0 :       if (flag)
    4700           0 :         str_printf(&s,"node [very near start, left] {%s}\n", (char*)gel(v,j));
    4701             :     }
    4702           0 :     str_printf(&s,";\n");
    4703           0 :     if (Ast[j] == j) decorate(&s, gel(G,j), arc, high);
    4704             :   }
    4705           0 :   str_printf(&s, "\n\\end{tikzpicture}");
    4706           0 :   return gc_leaf(av, strtoGENstr(s.string));
    4707             : }
    4708             : 
    4709             : static GEN
    4710           0 : circle2tex(GEN Ast, GEN G)
    4711             : {
    4712           0 :   pari_sp av = avma;
    4713           0 :   GEN v = Ast2v(Ast);
    4714             :   pari_str s;
    4715           0 :   long u, n = lg(Ast)-1;
    4716           0 :   const double ang = 360./n;
    4717             : 
    4718           0 :   if (n > 30)
    4719             :   {
    4720           0 :     v = const_vec(n, (GEN)"");
    4721           0 :     gel(v,1) = (GEN)"$(1,\\infty)$";
    4722             :   }
    4723           0 :   str_init(&s, 1);
    4724           0 :   str_puts(&s, "\n\\begingroup\n\
    4725             :   \\def\\geo#1#2{(#2:1) arc (90+#2:270+#1:{tan((#2-#1)/2)})}\n\
    4726             :   \\def\\sgeo#1#2{(#2:1) -- (#1:1)}\n\
    4727             :   \\def\\unarc#1#2#3{({#1 * #3}:1.2) node {#2}}\n\
    4728             :   \\def\\cell#1#2{({#1 * #2}:0.95) circle(0.05)}\n\
    4729             :   \\def\\link#1#2#3#4#5{\\unarc{#1}{#2}{#5}\\geo{#1*#5}{#3*#5}\\unarc{#3}{#4}{#5}}\n\
    4730             :   \\def\\slink#1#2#3#4#5{\\unarc{#1}{#2}{#5}\\sgeo{#1*#5}{#3*#5}\\unarc{#3}{#4}{#5}}");
    4731             : 
    4732           0 :   str_puts(&s, "\n\\begin{tikzpicture}[scale=4]\n");
    4733           0 :   str_puts(&s, "\\draw (0, 0) circle(1);\n");
    4734           0 :   for (u=1; u <= n; u++)
    4735             :   {
    4736           0 :     if (Ast[u] == u)
    4737             :     {
    4738           0 :       str_printf(&s,"\\draw\\unarc{%ld}{%s}{%.4f}; \\draw\\cell{%ld}{%.4f};\n",
    4739           0 :                  u, v[u], ang, u, ang);
    4740           0 :       if (ZM_isscalar(gpowgs(gel(G,u),3), NULL))
    4741           0 :         str_printf(&s,"\\fill \\cell{%ld}{%.4f};\n", u, ang);
    4742             :     }
    4743           0 :     else if(Ast[u] > u)
    4744           0 :       str_printf(&s, "\\draw \\%slink {%ld}{%s}{%ld}{%s}{%.4f};\n",
    4745           0 :                      (Ast[u] - u)*ang > 179? "s": "", u, v[u], Ast[u], v[Ast[u]], ang);
    4746             :   }
    4747           0 :   str_printf(&s, "\\end{tikzpicture}\\endgroup");
    4748           0 :   return gc_leaf(av, strtoGENstr(s.string));
    4749             : }
    4750             : 
    4751             : GEN
    4752        2583 : mspolygon(GEN M, long flag)
    4753             : {
    4754        2583 :   pari_sp av = avma;
    4755             :   struct siegel T;
    4756        2583 :   GEN v, msN = NULL, G = NULL;
    4757        2583 :   if (typ(M) == t_INT)
    4758             :   {
    4759         315 :     long N = itos(M);
    4760         315 :     if (N <= 0) pari_err_DOMAIN("msinit","N", "<=", gen_0,M);
    4761         315 :     msN = msinit_N(N);
    4762             :   }
    4763        2268 :   else if (checkfarey_i(M))
    4764             :   {
    4765           0 :     T.V = gel(M,1);
    4766           0 :     T.Ast = gel(M,2);
    4767           0 :     G = gel(M,3);
    4768             :   }
    4769             :   else
    4770        2268 :   { checkms(M); msN = get_msN(M); }
    4771        2583 :   if (flag < 0 || flag > 3) pari_err_FLAG("mspolygon");
    4772        2583 :   if (!G)
    4773             :   {
    4774        2583 :     if (ms_get_N(msN) == 1)
    4775             :     {
    4776          56 :       GEN S = mkS();
    4777          56 :       T.V = mkvec2(matid(2), S);
    4778          56 :       T.Ast = mkvecsmall2(1,2);
    4779          56 :       G = mkvec2(S, mkTAU());
    4780             :     }
    4781             :     else
    4782             :     {
    4783             :       long i, l;
    4784        2527 :       siegel_init(&T, msN);
    4785        2527 :       l = lg(T.V);
    4786        2527 :       if (flag & 1)
    4787             :       {
    4788         301 :         long oo2 = 0;
    4789             :         pari_sp av;
    4790         301 :         mssiegel(&T);
    4791        3451 :         for (i = 1; i < l; i++)
    4792             :         {
    4793        3451 :           GEN c = gel(T.V, i);
    4794        3451 :           GEN c22 = gcoeff(c,2,2); if (!signe(c22)) { oo2 = i; break; }
    4795             :         }
    4796         301 :         if (!oo2) pari_err_BUG("mspolygon");
    4797         301 :         av = avma; siegel_perm0(&T, rotate_perm(l, oo2));
    4798         301 :         set_avma(av);
    4799             :       }
    4800        2527 :       G = cgetg(l, t_VEC);
    4801       89957 :       for (i = 1; i < l; i++) gel(G,i) = get_g(&T, i);
    4802             :     }
    4803             :   }
    4804        2583 :   if (flag & 2)
    4805           0 :     v = mkvec5(T.V, T.Ast, G, polygon2tex(T.V,T.Ast,G), circle2tex(T.Ast,G));
    4806             :   else
    4807        2583 :     v = mkvec3(T.V, T.Ast, G);
    4808        2583 :   return gc_GEN(av, v);
    4809             : }
    4810             : 
    4811             : #if 0
    4812             : static int
    4813             : iselliptic(GEN Ast, long i) { return i == Ast[i]; }
    4814             : static int
    4815             : isparabolic(GEN Ast, long i)
    4816             : { long i2 = Ast[i]; return (i2 == i+1 || i2 == i-1); }
    4817             : #endif
    4818             : 
    4819             : /* M from msinit, F QM maximal rank */
    4820             : GEN
    4821        2219 : mslattice(GEN M, GEN F)
    4822             : {
    4823        2219 :   pari_sp av = avma;
    4824             :   long i, ivB, j, k, l, lF;
    4825             :   GEN D, U, G, A, vB, m, d;
    4826             : 
    4827        2219 :   checkms(M);
    4828        2219 :   if (!F) F = gel(mscuspidal(M, 0), 1);
    4829             :   else
    4830             :   {
    4831        2191 :     if (is_Qevproj(F)) F = gel(F,1);
    4832        2191 :     if (typ(F) != t_MAT) pari_err_TYPE("mslattice",F);
    4833             :   }
    4834        2219 :   lF = lg(F); if (lF == 1) return cgetg(1, t_MAT);
    4835        2219 :   D = mspolygon(M,0);
    4836        2219 :   k = msk_get_weight(M);
    4837        2219 :   F = vec_Q_primpart(F);
    4838        2219 :   if (typ(F)!=t_MAT || !RgM_is_ZM(F)) pari_err_TYPE("mslattice",F);
    4839        2219 :   G = gel(D,3); l = lg(G);
    4840        2219 :   A = gel(D,2);
    4841        2219 :   vB = cgetg(l, t_COL);
    4842        2219 :   d = mkcol2(gen_0,gen_1);
    4843        2219 :   m = mkmat2(d, d);
    4844       84595 :   for (i = ivB = 1; i < l; i++)
    4845             :   {
    4846       82376 :     GEN B, vb, g = gel(G,i);
    4847       82376 :     if (A[i] < i) continue;
    4848       41804 :     gel(m,2) = SL2_inv2(g);
    4849       41804 :     vb = mseval(M, F, m);
    4850       41804 :     if (k == 2) B = vb;
    4851             :     else
    4852             :     {
    4853             :       long lB;
    4854         147 :       B = RgXV_to_RgM(vb, k-1);
    4855             :       /* add coboundaries */
    4856         147 :       B = shallowconcat(B, RgM_Rg_sub_shallow(RgX_act_Gl2Q(g, k), gen_1));
    4857             :       /* beware: the basis for RgX_act_Gl2Q is (X^(k-2),...,Y^(k-2)) */
    4858         147 :       lB = lg(B);
    4859        3444 :       for (j = 1; j < lB; j++) gel(B,j) = vecreverse(gel(B,j));
    4860             :     }
    4861       41804 :     gel(vB, ivB++) = B;
    4862             :   }
    4863        2219 :   setlg(vB, ivB);
    4864        2219 :   vB = shallowmatconcat(vB);
    4865        2219 :   if (ZM_equal0(vB)) return gc_GEN(av, F);
    4866             : 
    4867        2219 :   (void)QM_ImQ_hnfall(vB, &U, 0);
    4868        2219 :   if (k > 2) U = rowslice(U, 1, lgcols(U)-k); /* remove coboundary part */
    4869        2219 :   U = Q_remove_denom(U, &d);
    4870        2219 :   F = ZM_hnf(ZM_mul(F, U));
    4871        2219 :   if (d) F = RgM_Rg_div(F, d);
    4872        2219 :   return gc_upto(av, F);
    4873             : }
    4874             : 
    4875             : /**** Petersson scalar product ****/
    4876             : /* TODO:
    4877             :  * Eisspace: represent functions by coordinates of nonzero entries in matrix */
    4878             : 
    4879             : /* oo -> g^(-1) oo */
    4880             : static GEN
    4881        6181 : cocycle(GEN g)
    4882        6181 : { retmkmat22(gen_1, gcoeff(g,2,2), gen_0, negi(gcoeff(g,2,1))); }
    4883             : 
    4884             : /* CD = binomial_init(k-2); return <P,Q> * D (integral) */
    4885             : static GEN
    4886       18151 : bil(GEN P, GEN Q, GEN CD)
    4887             : {
    4888       18151 :   GEN s, C = gel(CD,1);
    4889       18151 :   long i, n = lg(C)-2; /* k - 2 */
    4890       18151 :   if (!n) return gmul(P,Q);
    4891       18130 :   if (typ(P) != t_POL) P = scalarpol_shallow(P,0);
    4892       18130 :   if (typ(Q) != t_POL) Q = scalarpol_shallow(Q,0);
    4893       18130 :   s = gen_0;
    4894       37282 :   for (i = n - degpol(Q); i <= degpol(P); i++)
    4895             :   {
    4896       19152 :     GEN t = gmul(gmul(RgX_coeff(P,i), RgX_coeff(Q, n-i)), gel(C,i+1));
    4897       19152 :     s = odd(i)? gsub(s, t): gadd(s, t);
    4898             :   }
    4899       18130 :   return s;
    4900             : }
    4901             : 
    4902             : /* Let D = lcm {binomial(n,k), k = 0..n} = lcm([1..n+1]) / (n+1)
    4903             :  * Return [C, D] where C[i] = D / binomial(n,i+1), i = 0..n */
    4904             : static GEN
    4905        1379 : binomial_init(long n, GEN vC)
    4906             : {
    4907        1379 :   GEN C = vC? shallowcopy(vC): vecbinomial(n), c = C + 1;
    4908        1379 :   GEN D = diviuexact(ZV_lcm(identity_ZV(n+1)), n+1);
    4909        1379 :   long k, d = (n + 1) >> 1;
    4910             : 
    4911        1379 :   gel(c,0) = D;
    4912        2961 :   for (k = 1; k <= d; k++) gel(c, k) = diviiexact(D, gel(c, k));
    4913        2961 :   for (     ; k <= n;  k++) gel(c, k) = gel(c, n-k);
    4914        1379 :   return mkvec2(C, D);
    4915             : }
    4916             : 
    4917             : static void
    4918        1351 : mspetersson_i(GEN W, GEN F, GEN G, GEN *pvf, GEN *pvg, GEN *pC)
    4919             : {
    4920        1351 :   GEN WN = get_msN(W), annT2, annT31, section, c, vf, vg;
    4921             :   long i, n1, n2, n3;
    4922             : 
    4923        1351 :   annT2 = msN_get_annT2(WN);
    4924        1351 :   annT31 = msN_get_annT31(WN);
    4925        1351 :   section = msN_get_section(WN);
    4926             : 
    4927        1351 :   if (ms_get_N(WN) == 1)
    4928             :   {
    4929           7 :     vf = cgetg(3, t_VEC);
    4930           7 :     vg = cgetg(3, t_VEC);
    4931           7 :     gel(vf,1) = mseval(W, F, gel(section,1));
    4932           7 :     gel(vf,2) = gneg(gel(vf,1));
    4933           7 :     n1 = 0;
    4934             :   }
    4935             :   else
    4936             :   {
    4937        1344 :     GEN singlerel = msN_get_singlerel(WN);
    4938        1344 :     GEN gen = msN_get_genindex(WN);
    4939        1344 :     long l = lg(gen);
    4940        1344 :     vf = cgetg(l, t_VEC);
    4941        1344 :     vg = cgetg(l, t_VEC); /* generators of Delta ordered as E1,T2,T31 */
    4942        7476 :     for (i = 1; i < l; i++) gel(vf, i) = mseval(W, F, gel(section,gen[i]));
    4943        1344 :     n1 = ms_get_nbE1(WN); /* E1 */
    4944        7420 :     for (i = 1; i <= n1; i++)
    4945             :     {
    4946        6076 :       c = cocycle(gcoeff(gel(singlerel,i),2,1));
    4947        6076 :       gel(vg, i) = mseval(W, G, c);
    4948             :     }
    4949             :   }
    4950        1351 :   n2 = lg(annT2)-1; /* T2 */
    4951        1386 :   for (i = 1; i <= n2; i++)
    4952             :   {
    4953          35 :     c = cocycle(gcoeff(gel(annT2,i), 2,1));
    4954          35 :     gel(vg, i+n1) = gmul2n(mseval(W, G, c), -1);
    4955             :   }
    4956        1351 :   n3 = lg(annT31)-1; /* T31 */
    4957        1386 :   for (i = 1; i <= n3; i++)
    4958             :   {
    4959             :     GEN f;
    4960          35 :     c = cocycle(gcoeff(gel(annT31,i), 2,1));
    4961          35 :     f = mseval(W, G, c);
    4962          35 :     c = cocycle(gcoeff(gel(annT31,i), 3,1));
    4963          35 :     gel(vg, i+n1+n2) = gdivgu(gadd(f, mseval(W, G, c)), 3);
    4964             :   }
    4965        1351 :   *pC = binomial_init(msk_get_weight(W) - 2, NULL);
    4966        1351 :   *pvf = vf;
    4967        1351 :   *pvg = vg;
    4968        1351 : }
    4969             : 
    4970             : /* Petersson product on Hom_G(Delta_0, V_k) */
    4971             : GEN
    4972        1351 : mspetersson(GEN W, GEN F, GEN G)
    4973             : {
    4974        1351 :   pari_sp av = avma;
    4975             :   GEN vf, vg, CD, cf, cg, A;
    4976             :   long k, l, tG, tF;
    4977        1351 :   checkms(W);
    4978        1351 :   if (!F) F = matid(msdim(W));
    4979        1351 :   if (!G) G = F;
    4980        1351 :   tF = typ(F);
    4981        1351 :   tG = typ(G);
    4982        1351 :   if (tF == t_MAT && tG != t_MAT) pari_err_TYPE("mspetersson",G);
    4983        1351 :   if (tG == t_MAT && tF != t_MAT) pari_err_TYPE("mspetersson",F);
    4984        1351 :   mspetersson_i(W, F, G, &vf, &vg, &CD);
    4985        1351 :   vf = Q_primitive_part(vf, &cf);
    4986        1351 :   vg = Q_primitive_part(vg, &cg);
    4987        1351 :   A = div_content(mul_content(cf, cg), gel(CD,2));
    4988        1351 :   l = lg(vf);
    4989        1351 :   if (tF != t_MAT)
    4990             :   { /* <F,G>, two symbols */
    4991        1274 :     GEN s = gen_0;
    4992        7105 :     for (k = 1; k < l; k++) s = gadd(s, bil(gel(vf,k), gel(vg,k), CD));
    4993        1274 :     return gc_upto(av, gmul(s, A));
    4994             :   }
    4995          77 :   else if (F != G)
    4996             :   { /* <(f_1,...,f_m), (g_1,...,g_n)> */
    4997           0 :     long iF, iG, lF = lg(F), lG = lg(G);
    4998           0 :     GEN M = cgetg(lG, t_MAT);
    4999           0 :     for (iG = 1; iG < lG; iG++)
    5000             :     {
    5001           0 :       GEN c = cgetg(lF, t_COL);
    5002           0 :       gel(M,iG) = c;
    5003           0 :       for (iF = 1; iF < lF; iF++)
    5004             :       {
    5005           0 :         GEN s = gen_0;
    5006           0 :         for (k = 1; k < l; k++)
    5007           0 :           s = gadd(s, bil(gmael(vf,k,iF), gmael(vg,k,iG), CD));
    5008           0 :         gel(c,iF) = s; /* M[iF,iG] = <F[iF], G[iG] > */
    5009             :       }
    5010             :     }
    5011           0 :     return gc_upto(av, RgM_Rg_mul(M, A));
    5012             :   }
    5013             :   else
    5014             :   { /* <(f_1,...,f_n), (f_1,...,f_n)> */
    5015          77 :     long iF, iG, n = lg(F)-1;
    5016          77 :     GEN M = zeromatcopy(n,n);
    5017         693 :     for (iG = 1; iG <= n; iG++)
    5018        3192 :       for (iF = iG+1; iF <= n; iF++)
    5019             :       {
    5020        2576 :         GEN s = gen_0;
    5021       14728 :         for (k = 1; k < l; k++)
    5022       12152 :           s = gadd(s, bil(gmael(vf,k,iF), gmael(vg,k,iG), CD));
    5023        2576 :         gcoeff(M,iF,iG) = s; /* <F[iF], F[iG] > */
    5024        2576 :         gcoeff(M,iG,iF) = gneg(s);
    5025             :       }
    5026          77 :     return gc_upto(av, RgM_Rg_mul(M, A));
    5027             :   }
    5028             : }
    5029             : 
    5030             : static GEN
    5031           0 : act_ij(GEN v, ulong a, ulong b, ulong c, ulong d, ulong N)
    5032             : {
    5033           0 :   long I, J, i = v[1], j = v[2];
    5034           0 :   I = Fl_add(Fl_mul(a,i,N), Fl_mul(c,j,N), N); if (!I) I = N;
    5035           0 :   J = Fl_add(Fl_mul(b,i,N), Fl_mul(d,j,N), N); if (!J) J = N;
    5036           0 :   return mkvecsmall2(I,J);
    5037             : }
    5038             : /* action of g in SL_2(Z/NZ) on functions f: (Z/NZ)^2 -> Q given by sparse
    5039             :  * matrix x. */
    5040             : static GEN
    5041         168 : actf(long N, GEN x, GEN g)
    5042             : {
    5043             :   long a, b, c, d;
    5044         168 :   c = umodiu(gcoeff(g,2,1), N); if (!c) return x;
    5045           0 :   d = umodiu(gcoeff(g,2,2), N);
    5046           0 :   a = umodiu(gcoeff(g,1,1), N);
    5047           0 :   b = umodiu(gcoeff(g,1,2), N);
    5048           0 :   pari_APPLY_same(act_ij(gel(x,i), a, b, c, d, N));
    5049             : }
    5050             : 
    5051             : /* q1 = N/a, q2 = q1/d, (u,a) = 1. Gamma_0(N)-orbit attached to [q1,q2,u]
    5052             :  * in (Z/N)^2; set of [q1 v, q2 w], v in (Z/a)^*, w in Z/a*d,
    5053             :  * w mod a = u / v [invertible]; w mod d in (Z/d)^*; c1+c2= q2, d2|c1, d1|c2
    5054             :  * The orbit has cardinal C = a phi(d) <= N */
    5055             : static GEN
    5056          28 : eisf(long N, long C, long a, long d1, GEN Z2, long c1, long c2,
    5057             :      long q1, long u)
    5058             : {
    5059          28 :   GEN m = cgetg(C+1, t_VEC);
    5060          28 :   long v, n = 1, l = lg(Z2);
    5061          56 :   for (v = 1; v <= a; v++)
    5062          28 :     if (ugcd(v,a)==1)
    5063             :     {
    5064          28 :       long w1 = Fl_div(u, v, a), vq1 = v * q1, i, j;
    5065          56 :       for (i = 0; i < d1; i++, w1 += a)
    5066             :       { /* w1 defined mod a*d1, lifts u/v (mod a) */
    5067          56 :         for (j = 1; j < l; j++)
    5068          28 :           if (Z2[j])
    5069             :           {
    5070          28 :             long wq2 = (c1 * w1 + c2 * j) % N;
    5071          28 :             if (wq2 <= 0) wq2 += N;
    5072          28 :             gel(m, n++) = mkvecsmall2(vq1, wq2);
    5073             :           }
    5074             :       }
    5075             :     }
    5076          28 :   return m;
    5077             : }
    5078             : 
    5079             : /* basis for Gamma_0(N)-invariant functions attached to cusps */
    5080             : static GEN
    5081          28 : eisspace(long N, long k, long s)
    5082             : {
    5083          28 :   GEN v, D, F = factoru(N);
    5084             :   long l, n, i, j;
    5085          28 :   D = divisorsu_fact(F); l = lg(D);
    5086          28 :   n = mfnumcuspsu_fact(F);
    5087          28 :   v = cgetg((k==2)? n: n+1, t_VEC);
    5088          56 :   for (i = (k==2)? 2: 1, j = 1; i < l; i++) /* remove d = 1 if k = 2 */
    5089             :   {
    5090          28 :     long d = D[i], Nd = D[l-i], a = ugcd(d, Nd), q1, q2, d1, d2, C, c1, c2, u;
    5091             :     GEN Z2;
    5092             : 
    5093          56 :     if (s < 0 && a <= 2) continue;
    5094          28 :     q1 = N / a;
    5095          28 :     q2 = q1 / d;
    5096          28 :     d2 = u_ppo(d/a, a);
    5097          28 :     d1 = d / d2;
    5098          28 :     C = eulerphiu(d) * a;
    5099          28 :     Z2 = coprimes_zv(d2);
    5100             :     /* d = d1d2, (d2,a) = 1; d1 and a have same prime divisors */
    5101          28 :     (void)cbezout(d1, d2, &c2, &c1);
    5102          28 :     c2 *= d1 * q2;
    5103          28 :     c1 *= d2 * q2;
    5104          28 :     if (a <= 2)
    5105             :     { /* sigma.(C cusp attached to [q1,q2,u]) = C */
    5106          28 :       gel(v, j++) = eisf(N,C,a,d1,Z2,c1,c2, N/a, 1);
    5107          28 :       continue;
    5108             :     }
    5109           0 :     for (u = 1; 2*u < a; u++)
    5110             :     {
    5111           0 :       if (ugcd(u,a) != 1) continue;
    5112           0 :       gel(v, j++) = eisf(N,C,a,d1,Z2,c1,c2, q1, u);
    5113           0 :       if (!s) gel(v, j++) = eisf(N,C,a,d1,Z2,c1,c2, q1, a-u);
    5114             :     }
    5115             :   }
    5116          28 :   if (s) setlg(v, j);
    5117          28 :   return v;
    5118             : }
    5119             : 
    5120             : /* action of g on V_k */
    5121             : static GEN
    5122         168 : act(GEN P, GEN g, long k)
    5123             : {
    5124         168 :   GEN a = gcoeff(g,1,1), b = gcoeff(g,1,2), V1, V2, Q;
    5125         168 :   GEN c = gcoeff(g,2,1), d = gcoeff(g,2,2);
    5126             :   long i;
    5127         168 :   if (k == 2) return P;
    5128         168 :   V1 = RgX_powers(deg1pol_shallow(c, a, 0), k-2); /* V1[i] = (a + c Y)^i */
    5129         168 :   V2 = RgX_powers(deg1pol_shallow(d, b, 0), k-2); /* V2[j] = (b + d Y)^j */
    5130         168 :   Q = gmul(RgX_coeff(P,0), gel(V1, k-2));
    5131        2520 :   for (i = 1; i < k-2; i++)
    5132             :   {
    5133        2352 :     GEN v1 = gel(V1, k-2-i);
    5134        2352 :     GEN v2 = gel(V2, i);
    5135        2352 :     Q = gadd(Q, gmul(RgX_coeff(P,i), RgX_mul(v1,v2)));
    5136             :   }
    5137         168 :   return gadd(Q, gmul(RgX_coeff(P,k-2), gel(V2,k-2)));
    5138             : }
    5139             : 
    5140             : static long
    5141         420 : co_get_N(GEN co) { return gel(co,1)[1]; }
    5142             : static long
    5143         504 : co_get_k(GEN co) { return gel(co,1)[2]; }
    5144             : static GEN
    5145         140 : co_get_B(GEN co) { return gel(co,2); }
    5146             : static GEN
    5147         112 : co_get_BD(GEN co) { return gel(co,3); }
    5148             : static GEN
    5149          84 : co_get_C(GEN co) { return gel(co,4); }
    5150             : 
    5151             : /* N g^(-1) . eval on g([0,a]_oo)=g([pi_oo(0),pi_oo(a)]), fg = f|g */
    5152             : static GEN
    5153         252 : evalcap(GEN co, GEN fg, GEN a)
    5154             : {
    5155         252 :   long n, t, l = lg(fg), N = co_get_N(co), k = co_get_k(co);
    5156             :   GEN P, B, z, T;
    5157             :   pari_sp av;
    5158         252 :   if (isintzero(a)) return gen_0;
    5159             :   /* (a+y)^(k-1) - y^(k-1) */
    5160          56 :   P = gsub(gpowgs(deg1pol_shallow(gen_1, a, 0), k-1), pol_xn(k-1, 0));
    5161          56 :   B = co_get_B(co); z = gen_0;
    5162          56 :   av = avma; T = zero_zv(N);
    5163         112 :   for (n = 1; n < l; n++)
    5164             :   {
    5165          56 :     GEN v = gel(fg, n);
    5166          56 :     t = v[1]; T[t]++;
    5167             :   }
    5168         112 :   for (t = 1; t <= N; t++)
    5169             :   {
    5170          56 :     long c = T[t];
    5171          56 :     if (c)
    5172             :     {
    5173          56 :       GEN u = gmael(B, k, t);
    5174          56 :       if (c != 1) u = gmulsg(c, u);
    5175          56 :       z = gadd(z, u);
    5176             :     }
    5177             :   }
    5178          56 :   if (co_get_BD(co)) z = gmul(co_get_BD(co),z);
    5179          56 :   z = gc_upto(av, gdivgs(z, -k * (k-1)));
    5180          56 :   return RgX_Rg_mul(P, z);
    5181             : };
    5182             : 
    5183             : /* eval N g^(-1) * Psi(f) on g{oo,0}, fg = f|g */
    5184             : static GEN
    5185          84 : evalcup(GEN co, GEN fg)
    5186             : {
    5187          84 :   long j, n, k = co_get_k(co), l = lg(fg);
    5188          84 :   GEN B = co_get_B(co), C = co_get_C(co), P = cgetg(k+1, t_POL);
    5189          84 :   P[1] = evalvarn(0);
    5190        1428 :   for (j = 2; j <= k; j++) gel(P,j) = gen_0;
    5191         168 :   for (n = 1; n < l; n++)
    5192             :   {
    5193          84 :     GEN v = gel(fg,n);
    5194          84 :     long t = v[1], s = v[2];
    5195        1428 :     for (j = 1; j < k; j++)
    5196             :     {
    5197        1344 :       long j1 = k-j;
    5198        1344 :       GEN u = gmael(B, j1, t);
    5199        1344 :       GEN v = gmael(B, j, s);
    5200        1344 :       gel(P, j1+1) = gadd(gel(P, j1+1), gmul(u,v));
    5201             :     }
    5202             :   }
    5203        1428 :   for (j = 1; j < k; j++) gel(P, j+1) = gmul(gel(C,j), gel(P, j+1));
    5204          84 :   return normalizepol(P);
    5205             : }
    5206             : 
    5207             : /* Manin-Stevens algorithm, prepare for [pi_0(oo),pi_r(oo)] */
    5208             : static GEN
    5209          84 : evalmanin(GEN r)
    5210             : {
    5211          84 :   GEN fr = gboundcf(r, 0), pq, V;
    5212          84 :   long j, n = lg(fr)-1; /* > 0 */
    5213          84 :   V = cgetg(n+2, t_VEC);
    5214          84 :   gel(V,1) = gel(fr,1); /* a_0; tau_{-1} = id */
    5215          84 :   if (n == 1)
    5216             :   { /* r integer, can happen iff N = 1 */
    5217          84 :     gel(V,2) = mkvec2(gen_0, mkmat22(negi(r), gen_1, gen_m1, gen_0));
    5218          84 :     return V;
    5219             :   }
    5220           0 :   pq = contfracpnqn(fr,n-1);
    5221           0 :   fr = vec_append(fr, gdiv(negi(gcoeff(pq,2,n-1)), gcoeff(pq,2,n)));
    5222           0 :   for (j = 0; j < n; j++)
    5223             :   {
    5224           0 :     GEN v1 = gel(pq, j+1), v2 = (j == 0)? col_ei(2,1): gel(pq, j);
    5225           0 :     GEN z = gel(fr,j+2);
    5226           0 :     if (!odd(j)) { v1 = ZC_neg(v1); z = gneg(z); }
    5227           0 :     gel(V,j+2) = mkvec2(z, mkmat2(v1,v2)); /* [a_{j+1}, tau_j] */
    5228             :   }
    5229           0 :   return V;
    5230             : }
    5231             : 
    5232             : /* evaluate N * Psi(f) on
    5233             :   g[pi_oo(0),pi_r(oo)]=g[pi_oo(0),pi_0(oo)] + g[pi_0(oo),pi_r(oo)] */
    5234             : static GEN
    5235          84 : evalhull(GEN co, GEN f, GEN r)
    5236             : {
    5237          84 :   GEN V = evalmanin(r), res = evalcap(co,f,gel(V,1));
    5238          84 :   long j, l = lg(V), N = co_get_N(co);
    5239         168 :   for (j = 2; j < l; j++)
    5240             :   {
    5241          84 :     GEN v = gel(V,j), t = gel(v,2); /* in SL_2(Z) */
    5242          84 :     GEN ft = actf(N, f, t), a = gel(v,1); /* in Q */
    5243             :     /* t([pi_0(oo),pi_oo(a)]) */
    5244          84 :     res = gsub(res, act(gsub(evalcup(co,ft), evalcap(co,ft,a)), t, co_get_k(co)));
    5245             :   }
    5246          84 :   return res;
    5247             : };
    5248             : 
    5249             : /* evaluate N * cocycle at g in Gamma_0(N), f Gamma_0(N)-invariant */
    5250             : static GEN
    5251          84 : eiscocycle(GEN co, GEN f, GEN g)
    5252             : {
    5253          84 :   pari_sp av = avma;
    5254          84 :   GEN a = gcoeff(g,1,1), b = gcoeff(g,1,2);
    5255          84 :   GEN c = gcoeff(g,2,1), d = gcoeff(g,2,2), P;
    5256          84 :   long N = co_get_N(co);
    5257          84 :   if (!signe(c))
    5258           0 :     P = evalcap(co,f, gdiv(negi(b),a));
    5259             :   else
    5260             :   {
    5261          84 :     GEN gi = SL2_inv_shallow(g);
    5262          84 :     P = gsub(evalhull(co, f, gdiv(negi(d),c)),
    5263             :              act(evalcap(co, actf(N,f,gi), gdiv(a,c)), gi, co_get_k(co)));
    5264             :   }
    5265          84 :   return gc_upto(av, P);
    5266             : }
    5267             : 
    5268             : static GEN
    5269          28 : eisCocycle(GEN co, GEN D, GEN f)
    5270             : {
    5271          28 :   GEN V = gel(D,1), Ast = gel(D,2), G = gel(D,3);
    5272          28 :   long i, j, n = lg(G)-1;
    5273          28 :   GEN VG = cgetg(n+1, t_VEC);
    5274          84 :   for (i = j = 1; i <= n; i++)
    5275             :   {
    5276          56 :     GEN c, g, d, s = gel(V,i);
    5277          56 :     if (i > Ast[i]) continue;
    5278          56 :     g = SL2_inv_shallow(gel(G,i));
    5279          56 :     c = eiscocycle(co,f,g);
    5280          56 :     if (i < Ast[i]) /* non elliptic */
    5281           0 :       d = gen_1;
    5282             :     else
    5283             :     { /* i = Ast[i] */
    5284          56 :       GEN g2 = ZM2_sqr(g);
    5285          56 :       if (ZM_isdiagonal(g2)) d = gen_2; /* \pm Id */
    5286             :       else
    5287             :       {
    5288          28 :         c = gadd(c, eiscocycle(co,f,g2));
    5289          28 :         d = utoipos(3);
    5290             :       }
    5291             :     }
    5292          56 :     gel(VG, j++) = mkvec3(d, s, c);
    5293             :   }
    5294          28 :   setlg(VG, j); return VG;
    5295             : };
    5296             : 
    5297             : /* F=modular symbol, Eis = cocycle attached to f invariant function
    5298             :  * by Gamma_0(N); CD = binomial_init(k-2) */
    5299             : static GEN
    5300          84 : eispetersson(GEN M, GEN F, GEN Eis, GEN CD)
    5301             : {
    5302          84 :   pari_sp av = avma;
    5303          84 :   long i, l = lg(Eis);
    5304          84 :   GEN res = gen_0;
    5305         252 :   for (i = 1; i < l; i++)
    5306             :   {
    5307         168 :     GEN e = gel(Eis,i), Q = mseval(M, F, gel(e,2)), z = bil(gel(e,3), Q, CD);
    5308         168 :     long d = itou(gel(e,1));
    5309         168 :     res = gadd(res, d == 1? z: gdivgu(z,d));
    5310             :   }
    5311          84 :   return gc_upto(av, gdiv(simplify_shallow(res), gel(CD,2)));
    5312             : };
    5313             : 
    5314             : /*vB[j][i] = {i/N} */
    5315             : static GEN
    5316          28 : get_bern(long N, long k)
    5317             : {
    5318          28 :   GEN vB = cgetg(k+1, t_VEC), gN = utoipos(N);
    5319             :   long i, j; /* no need for j = 0 */
    5320         504 :   for (j = 1; j <= k; j++)
    5321             :   {
    5322         476 :     GEN c, B = RgX_rescale(bernpol(j, 0), gN);
    5323         476 :     gel(vB, j) = c = cgetg(N+1, t_VEC);
    5324         476 :     for (i = 1; i < N; i++) gel(c,i) = poleval(B, utoipos(i));
    5325         476 :     gel(c,N) = gel(B,2); /* B(0) */
    5326             :   }
    5327          28 :   return vB;
    5328             : }
    5329             : GEN
    5330          28 : eisker_worker(GEN Ei, GEN M, GEN D, GEN co, GEN CD)
    5331             : {
    5332          28 :   pari_sp av = avma;
    5333          28 :   long j, n = msdim(M), s = msk_get_sign(M);
    5334          28 :   GEN V, Eis = eisCocycle(co, D, Ei), v = cgetg(n+1, t_VEC);
    5335             : 
    5336          28 :   V = s? gel(msk_get_starproj(M), 1): matid(n);
    5337             :   /* T is multiplied by N * BD^2: same Ker */
    5338         112 :   for (j = 1; j <= n; j++) gel(v,j) = eispetersson(M, gel(V,j), Eis, CD);
    5339          28 :   return gc_upto(av, v);
    5340             : }
    5341             : /* vC = vecbinomial(k-2); vC[j] = binom(k-2,j-1) = vC[k-j], j = 1..k-1, k even.
    5342             :  * C[k-j+1] = (-1)^(j-1) binom(k-2, j-1) / (j(k-j)) = C[j+1] */
    5343             : static GEN
    5344          28 : get_C(GEN vC, long k)
    5345             : {
    5346          28 :   GEN C = cgetg(k, t_VEC);
    5347          28 :   long j, k2 = k/2;
    5348         266 :   for (j = 1; j <= k2; j++)
    5349             :   {
    5350         238 :     GEN c = gel(vC, j);
    5351         238 :     if (!odd(j)) c = negi(c);
    5352         238 :     gel(C,k-j) = gel(C, j) = gdivgu(c, j*(k-j));
    5353             :   }
    5354          28 :   return C;
    5355             : }
    5356             : static GEN
    5357          28 : eisker(GEN M)
    5358             : {
    5359          28 :   long N = ms_get_N(M), k = msk_get_weight(M), s = msk_get_sign(M);
    5360          28 :   GEN worker, vC, co, CD, D, B, BD, T, E = eisspace(N, k, s);
    5361          28 :   long i, j, m = lg(E)-1, n = msdim(M), pending = 0;
    5362             :   struct pari_mt pt;
    5363             : 
    5364          28 :   if (m == 0) return matid(n);
    5365          28 :   vC = vecbinomial(k-2);
    5366          28 :   T = zeromatcopy(m, n);
    5367          28 :   D = mspolygon(M, 0);
    5368          28 :   B = Q_remove_denom(get_bern(N,k), &BD);
    5369          28 :   co = mkvec4(mkvecsmall2(N,k), B, BD, get_C(vC, k));
    5370          28 :   CD = binomial_init(k-2, vC);
    5371          28 :   worker = snm_closure(is_entry("_eisker_worker"), mkvec4(M, D, co, CD));
    5372          28 :   mt_queue_start_lim(&pt, worker, m);
    5373          56 :   for (i = 1; i <= m || pending; i++)
    5374             :   {
    5375             :     long workid;
    5376             :     GEN done;
    5377          28 :     mt_queue_submit(&pt, i, i<=m? mkvec(gel(E,i)): NULL);
    5378          28 :     done = mt_queue_get(&pt, &workid, &pending);
    5379         112 :     if (done) for (j = 1; j <= n; j++) gcoeff(T,workid,j) = gel(done,j);
    5380             :   }
    5381          28 :   mt_queue_end(&pt); return QM_ker(T);
    5382             : }

Generated by: LCOV version 1.16