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 - modules - algebras.c (source / functions) Hit Total Coverage
Test: PARI/GP v2.12.1 lcov report (development 25579-8c4672f557) Lines: 3017 3125 96.5 %
Date: 2020-07-09 06:03:45 Functions: 269 274 98.2 %
Legend: Lines: hit not hit

          Line data    Source code
       1             : /* Copyright (C) 2000  The PARI group.
       2             : 
       3             : This file is part of the PARI/GP package.
       4             : 
       5             : PARI/GP is free software; you can redistribute it and/or modify it under the
       6             : terms of the GNU General Public License as published by the Free Software
       7             : Foundation. It is distributed in the hope that it will be useful, but WITHOUT
       8             : ANY WARRANTY WHATSOEVER.
       9             : 
      10             : Check the License for details. You should have received a copy of it, along
      11             : with the package; see the file 'COPYING'. If not, write to the Free Software
      12             : Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
      13             : #include "pari.h"
      14             : #include "paripriv.h"
      15             : 
      16             : #define dbg_printf(lvl) if (DEBUGLEVEL >= (lvl) + 3) err_printf
      17             : 
      18             : /********************************************************************/
      19             : /**                                                                **/
      20             : /**           ASSOCIATIVE ALGEBRAS, CENTRAL SIMPLE ALGEBRAS        **/
      21             : /**                 contributed by Aurel Page (2014)               **/
      22             : /**                                                                **/
      23             : /********************************************************************/
      24             : static GEN alg_subalg(GEN al, GEN basis);
      25             : static GEN alg_maximal_primes(GEN al, GEN P);
      26             : static GEN algnatmultable(GEN al, long D);
      27             : static GEN _tablemul_ej(GEN mt, GEN x, long j);
      28             : static GEN _tablemul_ej_Fp(GEN mt, GEN x, long j, GEN p);
      29             : static GEN _tablemul_ej_Fl(GEN mt, GEN x, long j, ulong p);
      30             : static ulong algtracei(GEN mt, ulong p, ulong expo, ulong modu);
      31             : static GEN alg_pmaximal(GEN al, GEN p);
      32             : static GEN alg_maximal(GEN al);
      33             : static GEN algtracematrix(GEN al);
      34             : static GEN algtableinit_i(GEN mt0, GEN p);
      35             : static GEN algbasisrightmultable(GEN al, GEN x);
      36             : static GEN algabstrace(GEN al, GEN x);
      37             : static GEN algbasismul(GEN al, GEN x, GEN y);
      38             : static GEN algbasismultable(GEN al, GEN x);
      39             : static GEN algbasismultable_Flm(GEN mt, GEN x, ulong m);
      40             : 
      41             : static int
      42      815088 : checkalg_i(GEN al)
      43             : {
      44             :   GEN mt, rnf;
      45      815088 :   if (typ(al) != t_VEC || lg(al) != 12) return 0;
      46      814892 :   mt = alg_get_multable(al);
      47      814892 :   if (typ(mt) != t_VEC || lg(mt) == 1 || typ(gel(mt,1)) != t_MAT) return 0;
      48      814871 :   rnf = alg_get_splittingfield(al);
      49      814871 :   if (isintzero(rnf) || !gequal0(alg_get_char(al))) return 1;
      50      459501 :   if (typ(gel(al,2)) != t_VEC || lg(gel(al,2)) == 1) return 0;
      51             :   /* not checkrnf_i: beware placeholder from alg_csa_table */
      52      459494 :   return typ(rnf)==t_VEC && lg(rnf)==13;
      53             : }
      54             : void
      55      814416 : checkalg(GEN al)
      56      814416 : { if (!checkalg_i(al)) pari_err_TYPE("checkalg [please apply alginit()]",al); }
      57             : 
      58             : static int
      59      180992 : checklat_i(GEN al, GEN lat)
      60             : {
      61             :   long N,i,j;
      62             :   GEN m,t,c;
      63      180992 :   if (typ(lat)!=t_VEC || lg(lat) != 3) return 0;
      64      180992 :   t = gel(lat,2);
      65      180992 :   if (typ(t) != t_INT && typ(t) != t_FRAC) return 0;
      66      180992 :   if (gsigne(t)<=0) return 0;
      67      180992 :   m = gel(lat,1);
      68      180992 :   if (typ(m) != t_MAT) return 0;
      69      180992 :   N = alg_get_absdim(al);
      70      180992 :   if (lg(m)-1 != N || lg(gel(m,1))-1 != N) return 0;
      71     1628886 :   for (i=1; i<=N; i++)
      72    13031067 :     for (j=1; j<=N; j++) {
      73    11583173 :       c = gcoeff(m,i,j);
      74    11583173 :       if (typ(c) != t_INT) return 0;
      75    11583173 :       if (j<i && signe(gcoeff(m,i,j))) return 0;
      76    11583173 :       if (i==j && !signe(gcoeff(m,i,j))) return 0;
      77             :     }
      78      180985 :   return 1;
      79             : }
      80      180992 : void checklat(GEN al, GEN lat)
      81      180992 : { if (!checklat_i(al,lat)) pari_err_TYPE("checklat [please apply alglathnf()]", lat); }
      82             : 
      83             : /**  ACCESSORS  **/
      84             : long
      85     4820174 : alg_type(GEN al)
      86             : {
      87     4820174 :   if (isintzero(alg_get_splittingfield(al)) || !gequal0(alg_get_char(al))) return al_TABLE;
      88     3575754 :   switch(typ(gmael(al,2,1))) {
      89      895678 :     case t_MAT: return al_CSA;
      90     2680055 :     case t_INT:
      91             :     case t_FRAC:
      92             :     case t_POL:
      93     2680055 :     case t_POLMOD: return al_CYCLIC;
      94          21 :     default: return al_NULL;
      95             :   }
      96             :   return -1; /*LCOV_EXCL_LINE*/
      97             : }
      98             : long
      99         203 : algtype(GEN al)
     100         203 : { return checkalg_i(al)? alg_type(al): al_NULL; }
     101             : 
     102             : /* absdim == dim for al_TABLE. */
     103             : long
     104      224406 : alg_get_dim(GEN al)
     105             : {
     106             :   long d;
     107      224406 :   switch(alg_type(al)) {
     108       10535 :     case al_TABLE: return lg(alg_get_multable(al))-1;
     109      213794 :     case al_CSA: return lg(alg_get_relmultable(al))-1;
     110          77 :     case al_CYCLIC: d = alg_get_degree(al); return d*d;
     111           0 :     default: pari_err_TYPE("alg_get_dim", al);
     112             :   }
     113             :   return -1; /*LCOV_EXCL_LINE*/
     114             : }
     115             : 
     116             : long
     117     1545616 : alg_get_absdim(GEN al)
     118             : {
     119     1545616 :   switch(alg_type(al)) {
     120      657449 :     case al_TABLE: return lg(alg_get_multable(al))-1;
     121      113162 :     case al_CSA: return alg_get_dim(al)*nf_get_degree(alg_get_center(al));
     122      775005 :     case al_CYCLIC:
     123      775005 :       return rnf_get_absdegree(alg_get_splittingfield(al))*alg_get_degree(al);
     124           0 :     default: pari_err_TYPE("alg_get_absdim", al);
     125             :   }
     126             :   return -1;/*LCOV_EXCL_LINE*/
     127             : }
     128             : 
     129             : long
     130        1715 : algdim(GEN al, long abs)
     131             : {
     132        1715 :   checkalg(al);
     133        1694 :   if (abs) return alg_get_absdim(al);
     134        1491 :   return alg_get_dim(al);
     135             : }
     136             : 
     137             : /* only cyclic */
     138             : GEN
     139       12936 : alg_get_auts(GEN al)
     140             : {
     141       12936 :   if (alg_type(al) != al_CYCLIC)
     142           0 :     pari_err_TYPE("alg_get_auts [non-cyclic algebra]", al);
     143       12936 :   return gel(al,2);
     144             : }
     145             : GEN
     146          91 : alg_get_aut(GEN al)
     147             : {
     148          91 :   if (alg_type(al) != al_CYCLIC)
     149           7 :     pari_err_TYPE("alg_get_aut [non-cyclic algebra]", al);
     150          84 :   return gel(alg_get_auts(al),1);
     151             : }
     152             : GEN
     153          21 : algaut(GEN al) { checkalg(al); return alg_get_aut(al); }
     154             : GEN
     155       12957 : alg_get_b(GEN al)
     156             : {
     157       12957 :   if (alg_type(al) != al_CYCLIC)
     158           7 :     pari_err_TYPE("alg_get_b [non-cyclic algebra]", al);
     159       12950 :   return gel(al,3);
     160             : }
     161             : GEN
     162          35 : algb(GEN al) { checkalg(al); return alg_get_b(al); }
     163             : 
     164             : /* only CSA */
     165             : GEN
     166      215831 : alg_get_relmultable(GEN al)
     167             : {
     168      215831 :   if (alg_type(al) != al_CSA)
     169           7 :     pari_err_TYPE("alg_get_relmultable [algebra not given via mult. table]", al);
     170      215824 :   return gel(al,2);
     171             : }
     172             : GEN
     173          42 : algrelmultable(GEN al) { checkalg(al); return alg_get_relmultable(al); }
     174             : GEN
     175          49 : alg_get_splittingdata(GEN al)
     176             : {
     177          49 :   if (alg_type(al) != al_CSA)
     178           7 :     pari_err_TYPE("alg_get_splittingdata [algebra not given via mult. table]",al);
     179          42 :   return gel(al,3);
     180             : }
     181             : GEN
     182          49 : algsplittingdata(GEN al) { checkalg(al); return alg_get_splittingdata(al); }
     183             : GEN
     184        4102 : alg_get_splittingbasis(GEN al)
     185             : {
     186        4102 :   if (alg_type(al) != al_CSA)
     187           0 :     pari_err_TYPE("alg_get_splittingbasis [algebra not given via mult. table]",al);
     188        4102 :   return gmael(al,3,2);
     189             : }
     190             : GEN
     191        4102 : alg_get_splittingbasisinv(GEN al)
     192             : {
     193        4102 :   if (alg_type(al) != al_CSA)
     194           0 :     pari_err_TYPE("alg_get_splittingbasisinv [algebra not given via mult. table]",al);
     195        4102 :   return gmael(al,3,3);
     196             : }
     197             : 
     198             : /* only cyclic and CSA */
     199             : GEN
     200     8084359 : alg_get_splittingfield(GEN al) { return gel(al,1); }
     201             : GEN
     202          91 : algsplittingfield(GEN al)
     203             : {
     204             :   long ta;
     205          91 :   checkalg(al);
     206          91 :   ta = alg_type(al);
     207          91 :   if (ta != al_CYCLIC && ta != al_CSA)
     208           7 :     pari_err_TYPE("alg_get_splittingfield [use alginit]",al);
     209          84 :   return alg_get_splittingfield(al);
     210             : }
     211             : long
     212     1227576 : alg_get_degree(GEN al)
     213             : {
     214             :   long ta;
     215     1227576 :   ta = alg_type(al);
     216     1227576 :   if (ta != al_CYCLIC && ta != al_CSA)
     217          21 :     pari_err_TYPE("alg_get_degree [use alginit]",al);
     218     1227555 :   return rnf_get_degree(alg_get_splittingfield(al));
     219             : }
     220             : long
     221         301 : algdegree(GEN al)
     222             : {
     223         301 :   checkalg(al);
     224         294 :   return alg_get_degree(al);
     225             : }
     226             : 
     227             : GEN
     228      294343 : alg_get_center(GEN al)
     229             : {
     230             :   long ta;
     231      294343 :   ta = alg_type(al);
     232      294343 :   if (ta != al_CSA && ta != al_CYCLIC)
     233           7 :     pari_err_TYPE("alg_get_center [use alginit]",al);
     234      294336 :   return rnf_get_nf(alg_get_splittingfield(al));
     235             : }
     236             : GEN
     237          70 : alg_get_splitpol(GEN al)
     238             : {
     239          70 :   long ta = alg_type(al);
     240          70 :   if (ta != al_CYCLIC && ta != al_CSA)
     241           0 :     pari_err_TYPE("alg_get_splitpol [use alginit]",al);
     242          70 :   return rnf_get_pol(alg_get_splittingfield(al));
     243             : }
     244             : GEN
     245       67116 : alg_get_abssplitting(GEN al)
     246             : {
     247       67116 :   long ta = alg_type(al), prec;
     248       67116 :   if (ta != al_CYCLIC && ta != al_CSA)
     249           0 :     pari_err_TYPE("alg_get_abssplitting [use alginit]",al);
     250       67116 :   prec = nf_get_prec(alg_get_center(al));
     251       67116 :   return rnf_build_nfabs(alg_get_splittingfield(al), prec);
     252             : }
     253             : GEN
     254        1134 : alg_get_hasse_i(GEN al)
     255             : {
     256        1134 :   long ta = alg_type(al);
     257        1134 :   if (ta != al_CYCLIC && ta != al_CSA)
     258           7 :     pari_err_TYPE("alg_get_hasse_i [use alginit]",al);
     259        1127 :   if (ta == al_CSA) pari_err_IMPL("computation of Hasse invariants over table CSA");
     260        1120 :   return gel(al,4);
     261             : }
     262             : GEN
     263         210 : alghassei(GEN al) { checkalg(al); return alg_get_hasse_i(al); }
     264             : GEN
     265        1883 : alg_get_hasse_f(GEN al)
     266             : {
     267        1883 :   long ta = alg_type(al);
     268        1883 :   if (ta != al_CYCLIC && ta != al_CSA)
     269           7 :     pari_err_TYPE("alg_get_hasse_f [use alginit]",al);
     270        1876 :   if (ta == al_CSA) pari_err_IMPL("computation of Hasse invariants over table CSA");
     271        1869 :   return gel(al,5);
     272             : }
     273             : GEN
     274         329 : alghassef(GEN al) { checkalg(al); return alg_get_hasse_f(al); }
     275             : 
     276             : /* all types */
     277             : GEN
     278        2695 : alg_get_basis(GEN al) { return gel(al,7); }
     279             : GEN
     280          49 : algbasis(GEN al) { checkalg(al); return alg_get_basis(al); }
     281             : GEN
     282       59465 : alg_get_invbasis(GEN al) { return gel(al,8); }
     283             : GEN
     284          49 : alginvbasis(GEN al) { checkalg(al); return alg_get_invbasis(al); }
     285             : GEN
     286     2220305 : alg_get_multable(GEN al) { return gel(al,9); }
     287             : GEN
     288         217 : algmultable(GEN al) { checkalg(al); return alg_get_multable(al); }
     289             : GEN
     290     5558720 : alg_get_char(GEN al) { return gel(al,10); }
     291             : GEN
     292          91 : algchar(GEN al) { checkalg(al); return alg_get_char(al); }
     293             : GEN
     294      235361 : alg_get_tracebasis(GEN al) { return gel(al,11); }
     295             : 
     296             : /* lattices */
     297             : GEN
     298      244314 : alglat_get_primbasis(GEN lat) { return gel(lat,1); }
     299             : GEN
     300      289905 : alglat_get_scalar(GEN lat) { return gel(lat,2); }
     301             : 
     302             : /** ADDITIONAL **/
     303             : 
     304             : /* no garbage collection */
     305             : static GEN
     306         777 : backtrackfacto(GEN y0, long n, GEN red, GEN pl, GEN nf, GEN data, int (*test)(GEN,GEN,GEN), GEN* fa, GEN N, GEN I)
     307             : {
     308             :   long b, i;
     309             :   GEN y1, y2, ny, fan;
     310         777 :   long *v = new_chunk(n+1);
     311         777 :   pari_sp av = avma;
     312         777 :   for (b = 0;; b = b+(2*b)/(3*n)+1)
     313             :   {
     314         798 :     set_avma(av);
     315        2317 :     for (i=1; i<=n; i++) v[i] = -b;
     316         798 :     v[n]--;
     317             :     while (1) {
     318         154 :       i=n;
     319        1106 :       while (i>0) {
     320        1085 :         if (v[i]==b) { v[i] = -b; i--; } else { v[i]++; break; }
     321             :       }
     322         952 :       if (i==0) break;
     323             : 
     324         931 :       y1 = y0;
     325        2968 :       for (i=1; i<=n; i++) y1 = nfadd(nf, y1, ZC_z_mul(gel(red,i), v[i]));
     326         931 :       if (!nfchecksigns(nf, y1, pl)) continue;
     327             : 
     328         812 :       ny = absi_shallow(nfnorm(nf, y1));
     329         812 :       if (!signe(ny)) continue;
     330         812 :       ny = diviiexact(ny,gcdii(ny,N));
     331         812 :       fan = Z_factor_limit(ny,1<<17);
     332         812 :       if (lg(fan)>1 && nbrows(fan)>0 && !isprime(gcoeff(fan,nbrows(fan),1)))
     333           0 :         continue;
     334             : 
     335         812 :       y2 = idealdivexact(nf,y1,idealadd(nf,y1,I));
     336         812 :       *fa = idealfactor(nf, y2);
     337         812 :       if (!data || test(data,y1,*fa)) return y1;
     338             :     }
     339             :   }
     340             : }
     341             : 
     342             : /* if data == NULL, the test is skipped */
     343             : /* in the test, the factorization does not contain the known factors */
     344             : static GEN
     345         777 : factoredextchinesetest(GEN nf, GEN x, GEN y, GEN pl, GEN* fa, GEN data, int (*test)(GEN,GEN,GEN))
     346             : {
     347         777 :   pari_sp av = avma;
     348             :   long n,i;
     349         777 :   GEN x1, y0, y1, red, N, I, P = gel(x,1), E = gel(x,2);
     350         777 :   n = nf_get_degree(nf);
     351         777 :   x = idealchineseinit(nf, mkvec2(x,pl));
     352         777 :   x1 = gel(x,1);
     353         777 :   red = lg(x1) == 1? matid(n): gel(x1,1);
     354         777 :   y0 = idealchinese(nf, x, y);
     355             : 
     356         777 :   E = shallowcopy(E);
     357         777 :   if (!gequal0(y0))
     358        1981 :     for (i=1; i<lg(E); i++)
     359             :     {
     360        1204 :       long v = nfval(nf,y0,gel(P,i));
     361        1204 :       if (cmpsi(v, gel(E,i)) < 0) gel(E,i) = stoi(v);
     362             :     }
     363             :   /* N and I : known factors */
     364         777 :   I = factorbackprime(nf, P, E);
     365         777 :   N = idealnorm(nf,I);
     366             : 
     367         777 :   y1 = backtrackfacto(y0, n, red, pl, nf, data, test, fa, N, I);
     368             : 
     369             :   /* restore known factors */
     370        1981 :   for (i=1; i<lg(E); i++) gel(E,i) = stoi(nfval(nf,y1,gel(P,i)));
     371         777 :   *fa = famat_reduce(famat_mul_shallow(*fa, mkmat2(P, E)));
     372             : 
     373         777 :   gerepileall(av, 2, &y1, fa);
     374         777 :   return y1;
     375             : }
     376             : 
     377             : static GEN
     378         553 : factoredextchinese(GEN nf, GEN x, GEN y, GEN pl, GEN* fa)
     379         553 : { return factoredextchinesetest(nf,x,y,pl,fa,NULL,NULL); }
     380             : 
     381             : /** OPERATIONS ON ASSOCIATIVE ALGEBRAS algebras.c **/
     382             : 
     383             : /*
     384             : Convention:
     385             : (K/F,sigma,b) = sum_{i=0..n-1} u^i*K
     386             : t*u = u*sigma(t)
     387             : 
     388             : Natural basis:
     389             : 1<=i<=d*n^2
     390             : b_i = u^((i-1)/(dn))*ZKabs.((i-1)%(dn)+1)
     391             : 
     392             : Integral basis:
     393             : Basis of some order.
     394             : 
     395             : al:
     396             : 1- rnf of the cyclic splitting field of degree n over the center nf of degree d
     397             : 2- VEC of aut^i 1<=i<=n
     398             : 3- b in nf
     399             : 4- infinite hasse invariants (mod n) : VECSMALL of size r1, values only 0 or n/2 (if integral)
     400             : 5- finite hasse invariants (mod n) : VEC[VEC of primes, VECSMALL of hasse inv mod n]
     401             : 6- nf of the splitting field (absolute)
     402             : 7* dn^2*dn^2 matrix expressing the integral basis in terms of the natural basis
     403             : 8* dn^2*dn^2 matrix expressing the natural basis in terms of the integral basis
     404             : 9* VEC of dn^2 matrices giving the dn^2*dn^2 left multiplication tables of the integral basis
     405             : 10* characteristic of the base field (used only for algebras given by a multiplication table)
     406             : 11* trace of basis elements
     407             : 
     408             : If al is given by a multiplication table (al_TABLE), only the * fields are present.
     409             : */
     410             : 
     411             : /* assumes same center and same variable */
     412             : /* currently only works for coprime degrees */
     413             : GEN
     414          77 : algtensor(GEN al1, GEN al2, long maxord) {
     415          77 :   pari_sp av = avma;
     416             :   long v, k, d1, d2;
     417             :   GEN nf, P1, P2, aut1, aut2, b1, b2, C, rnf, aut, b, x1, x2, al;
     418             : 
     419          77 :   checkalg(al1);
     420          63 :   checkalg(al2);
     421          56 :   if (alg_type(al1) != al_CYCLIC  || alg_type(al2) != al_CYCLIC)
     422          14 :     pari_err_IMPL("tensor of non-cyclic algebras"); /* TODO: do it. */
     423             : 
     424          42 :   nf=alg_get_center(al1);
     425          42 :   if (!gequal(alg_get_center(al2),nf))
     426           7 :     pari_err_OP("tensor product [not the same center]", al1, al2);
     427             : 
     428          35 :   P1=alg_get_splitpol(al1); aut1=alg_get_aut(al1); b1=alg_get_b(al1);
     429          35 :   P2=alg_get_splitpol(al2); aut2=alg_get_aut(al2); b2=alg_get_b(al2);
     430          35 :   v=varn(P1);
     431             : 
     432          35 :   d1=alg_get_degree(al1);
     433          35 :   d2=alg_get_degree(al2);
     434          35 :   if (ugcd(d1,d2) != 1)
     435           7 :     pari_err_IMPL("tensor of cylic algebras of non-coprime degrees"); /* TODO */
     436             : 
     437          28 :   if (d1==1) return gcopy(al2);
     438          21 :   if (d2==1) return gcopy(al1);
     439             : 
     440          14 :   C = nfcompositum(nf, P1, P2, 3);
     441          14 :   rnf = rnfinit(nf,gel(C,1));
     442          14 :   x1 = gel(C,2);
     443          14 :   x2 = gel(C,3);
     444          14 :   k = itos(gel(C,4));
     445          14 :   aut = gadd(gsubst(aut2,v,x2),gmulsg(k,gsubst(aut1,v,x1)));
     446          14 :   b = nfmul(nf,nfpow_u(nf,b1,d2),nfpow_u(nf,b2,d1));
     447          14 :   al = alg_cyclic(rnf,aut,b,maxord);
     448          14 :   return gerepilecopy(av,al);
     449             : }
     450             : 
     451             : /* M an n x d Flm of rank d, n >= d. Initialize Mx = y solver */
     452             : static GEN
     453        4298 : Flm_invimage_init(GEN M, ulong p)
     454             : {
     455        4298 :   GEN v = Flm_indexrank(M, p), perm = gel(v,1);
     456        4298 :   GEN MM = rowpermute(M, perm); /* square invertible */
     457        4298 :   return mkvec2(Flm_inv(MM,p), perm);
     458             : }
     459             : /* assume Mx = y has a solution, v = Flm_invimage_init(M,p); return x */
     460             : static GEN
     461      243523 : Flm_invimage_pre(GEN v, GEN y, ulong p)
     462             : {
     463      243523 :   GEN inv = gel(v,1), perm = gel(v,2);
     464      243523 :   return Flm_Flc_mul(inv, vecsmallpermute(y, perm), p);
     465             : }
     466             : 
     467             : GEN
     468        5201 : algradical(GEN al)
     469             : {
     470        5201 :   pari_sp av = avma;
     471             :   GEN I, x, traces, K, MT, P, mt;
     472             :   long l,i,ni, n;
     473             :   ulong modu, expo, p;
     474        5201 :   checkalg(al);
     475        5201 :   P = alg_get_char(al);
     476        5201 :   mt = alg_get_multable(al);
     477        5201 :   n = alg_get_absdim(al);
     478        5201 :   dbg_printf(1)("algradical: char=%Ps, dim=%d\n", P, n);
     479        5201 :   traces = algtracematrix(al);
     480        5201 :   if (!signe(P))
     481             :   {
     482         567 :     dbg_printf(2)(" char 0, computing kernel...\n");
     483         567 :     K = ker(traces);
     484         567 :     dbg_printf(2)(" ...done.\n");
     485         567 :     ni = lg(K)-1; if (!ni) return gc_const(av, gen_0);
     486          70 :     return gerepileupto(av, K);
     487             :   }
     488        4634 :   dbg_printf(2)(" char>0, computing kernel...\n");
     489        4634 :   K = FpM_ker(traces, P);
     490        4634 :   dbg_printf(2)(" ...done.\n");
     491        4634 :   ni = lg(K)-1; if (!ni) return gc_const(av, gen_0);
     492        2828 :   if (abscmpiu(P,n)>0) return gerepileupto(av, K);
     493             : 
     494             :   /* tough case, p <= n. Ronyai's algorithm */
     495        2324 :   p = P[2]; l = 1;
     496        2324 :   expo = p; modu = p*p;
     497        2324 :   dbg_printf(2)(" char>0, hard case.\n");
     498        4697 :   while (modu<=(ulong)n) { l++; modu *= p; }
     499        2324 :   MT = ZMV_to_FlmV(mt, modu);
     500        2324 :   I = ZM_to_Flm(K,p); /* I_0 */
     501        6321 :   for (i=1; i<=l; i++) {/*compute I_i, expo = p^i, modu = p^(l+1) > n*/
     502             :     long j, lig,col;
     503        4298 :     GEN v = cgetg(ni+1, t_VECSMALL);
     504        4298 :     GEN invI = Flm_invimage_init(I, p);
     505        4298 :     dbg_printf(2)(" computing I_%d:\n", i);
     506        4298 :     traces = cgetg(ni+1,t_MAT);
     507       28770 :     for (j = 1; j <= ni; j++)
     508             :     {
     509       24472 :       GEN M = algbasismultable_Flm(MT, gel(I,j), modu);
     510       24472 :       uel(v,j) = algtracei(M, p,expo,modu);
     511             :     }
     512       28770 :     for (col=1; col<=ni; col++)
     513             :     {
     514       24472 :       GEN t = cgetg(n+1,t_VECSMALL); gel(traces,col) = t;
     515       24472 :       x = gel(I, col); /*col-th basis vector of I_{i-1}*/
     516      267995 :       for (lig=1; lig<=n; lig++)
     517             :       {
     518      243523 :         GEN y = _tablemul_ej_Fl(MT,x,lig,p);
     519      243523 :         GEN z = Flm_invimage_pre(invI, y, p);
     520      243523 :         uel(t,lig) = Flv_dotproduct(v, z, p);
     521             :       }
     522             :     }
     523        4298 :     dbg_printf(2)(" computing kernel...\n");
     524        4298 :     K = Flm_ker(traces, p);
     525        4298 :     dbg_printf(2)(" ...done.\n");
     526        4298 :     ni = lg(K)-1; if (!ni) return gc_const(av, gen_0);
     527        3997 :     I = Flm_mul(I,K,p);
     528        3997 :     expo *= p;
     529             :   }
     530        2023 :   return Flm_to_ZM(I);
     531             : }
     532             : 
     533             : /* compute the multiplication table of the element x, where mt is a
     534             :  * multiplication table in an arbitrary ring */
     535             : static GEN
     536         427 : Rgmultable(GEN mt, GEN x)
     537             : {
     538         427 :   long i, l = lg(x);
     539         427 :   GEN z = NULL;
     540        5796 :   for (i = 1; i < l; i++)
     541             :   {
     542        5369 :     GEN c = gel(x,i);
     543        5369 :     if (!gequal0(c))
     544             :     {
     545         644 :       GEN M = RgM_Rg_mul(gel(mt,i),c);
     546         644 :       z = z? RgM_add(z, M): M;
     547             :     }
     548             :   }
     549         427 :   return z;
     550             : }
     551             : 
     552             : static GEN
     553          49 : change_Rgmultable(GEN mt, GEN P, GEN Pi)
     554             : {
     555             :   GEN mt2;
     556          49 :   long lmt = lg(mt), i;
     557          49 :   mt2 = cgetg(lmt,t_VEC);
     558         476 :   for (i=1;i<lmt;i++) {
     559         427 :     GEN mti = Rgmultable(mt,gel(P,i));
     560         427 :     gel(mt2,i) = RgM_mul(Pi, RgM_mul(mti,P));
     561             :   }
     562          49 :   return mt2;
     563             : }
     564             : 
     565             : static GEN
     566       19719 : alg_quotient0(GEN al, GEN S, GEN Si, long nq, GEN p, long maps)
     567             : {
     568       19719 :   GEN mt = cgetg(nq+1,t_VEC), P, Pi, d;
     569             :   long i;
     570       19719 :   dbg_printf(3)("  alg_quotient0: char=%Ps, dim=%d, dim I=%d\n", p, alg_get_absdim(al), lg(S)-1);
     571       77916 :   for (i=1; i<=nq; i++) {
     572       58197 :     GEN mti = algbasismultable(al,gel(S,i));
     573       58197 :     if (signe(p)) gel(mt,i) = FpM_mul(Si, FpM_mul(mti,S,p), p);
     574        5257 :     else          gel(mt,i) = RgM_mul(Si, RgM_mul(mti,S));
     575             :   }
     576       19719 :   if (!signe(p) && !isint1(Q_denom(mt))) {
     577          35 :     dbg_printf(3)("  bad case: denominator=%Ps\n", Q_denom(mt));
     578          35 :     P = Q_remove_denom(Si,&d);
     579          35 :     P = ZM_hnf(P);
     580          35 :     P = RgM_Rg_div(P,d);
     581          35 :     Pi = RgM_inv(P);
     582          35 :     mt = change_Rgmultable(mt,P,Pi);
     583          35 :     Si = RgM_mul(P,Si);
     584          35 :     S = RgM_mul(S,Pi);
     585             :   }
     586       19719 :   al = algtableinit_i(mt,p);
     587       19719 :   if (maps) al = mkvec3(al,Si,S); /* algebra, proj, lift */
     588       19719 :   return al;
     589             : }
     590             : 
     591             : /* quotient of an algebra by a nontrivial two-sided ideal */
     592             : GEN
     593        2702 : alg_quotient(GEN al, GEN I, long maps)
     594             : {
     595        2702 :   pari_sp av = avma;
     596             :   GEN p, IS, ISi, S, Si;
     597             :   long n, ni;
     598             : 
     599        2702 :   checkalg(al);
     600        2702 :   p = alg_get_char(al);
     601        2702 :   n = alg_get_absdim(al);
     602        2702 :   ni = lg(I)-1;
     603             : 
     604             :   /* force first vector of complement to be the identity */
     605        2702 :   IS = shallowconcat(I, gcoeff(alg_get_multable(al),1,1));
     606        2702 :   if (signe(p)) {
     607        2674 :     IS = FpM_suppl(IS,p);
     608        2674 :     ISi = FpM_inv(IS,p);
     609             :   }
     610             :   else {
     611          28 :     IS = suppl(IS);
     612          28 :     ISi = RgM_inv(IS);
     613             :   }
     614        2702 :   S = vecslice(IS, ni+1, n);
     615        2702 :   Si = rowslice(ISi, ni+1, n);
     616        2702 :   return gerepilecopy(av, alg_quotient0(al, S, Si, n-ni, p, maps));
     617             : }
     618             : 
     619             : static GEN
     620       27090 : image_keep_first(GEN m, GEN p) /* assume first column is nonzero or m==0, no GC */
     621             : {
     622             :   GEN ir, icol, irow, M, c, x;
     623             :   long i;
     624       27090 :   if (gequal0(gel(m,1))) return zeromat(nbrows(m),0);
     625             : 
     626       27076 :   if (signe(p)) ir = FpM_indexrank(m,p);
     627        1498 :   else          ir = indexrank(m);
     628             : 
     629       27076 :   icol = gel(ir,2);
     630       27076 :   if (icol[1]==1) return extract0(m,icol,NULL);
     631             : 
     632          21 :   irow = gel(ir,1);
     633          21 :   M = extract0(m, irow, icol);
     634          21 :   c = extract0(gel(m,1), irow, NULL);
     635          21 :   if (signe(p)) x = FpM_FpC_invimage(M,c,p);
     636           0 :   else          x = inverseimage(M,c); /* TODO modulo a small prime */
     637             : 
     638          21 :   for (i=1; i<lg(x); i++)
     639             :   {
     640          21 :     if (!gequal0(gel(x,i)))
     641             :     {
     642          21 :       icol[i] = 1;
     643          21 :       vecsmall_sort(icol);
     644          21 :       return extract0(m,icol,NULL);
     645             :     }
     646             :   }
     647             : 
     648             :   return NULL; /* LCOV_EXCL_LINE */
     649             : }
     650             : 
     651             : /* z[1],...z[nz] central elements such that z[1]A + z[2]A + ... + z[nz]A = A
     652             :  * is a direct sum. idempotents ==> first basis element is identity */
     653             : GEN
     654        8057 : alg_centralproj(GEN al, GEN z, long maps)
     655             : {
     656        8057 :   pari_sp av = avma;
     657             :   GEN S, U, Ui, alq, p;
     658        8057 :   long i, iu, lz = lg(z);
     659             : 
     660        8057 :   checkalg(al);
     661        8057 :   if (typ(z) != t_VEC) pari_err_TYPE("alcentralproj",z);
     662        8050 :   p = alg_get_char(al);
     663        8050 :   dbg_printf(3)("  alg_centralproj: char=%Ps, dim=%d, #z=%d\n", p, alg_get_absdim(al), lz-1);
     664        8050 :   S = cgetg(lz,t_VEC); /* S[i] = Im(z_i) */
     665       25081 :   for (i=1; i<lz; i++)
     666             :   {
     667       17031 :     GEN mti = algbasismultable(al, gel(z,i));
     668       17031 :     gel(S,i) = image_keep_first(mti,p);
     669             :   }
     670        8050 :   U = shallowconcat1(S); /* U = [Im(z_1)|Im(z_2)|...|Im(z_nz)], n x n */
     671        8050 :   if (lg(U)-1 < alg_get_absdim(al)) pari_err_TYPE("alcentralproj [z[i]'s not surjective]",z);
     672        8043 :   if (signe(p)) Ui = FpM_inv(U,p);
     673         749 :   else          Ui = RgM_inv(U);
     674             :   if (!Ui) pari_err_BUG("alcentralproj"); /*LCOV_EXCL_LINE*/
     675             : 
     676        8043 :   alq = cgetg(lz,t_VEC);
     677       25060 :   for (iu=0,i=1; i<lz; i++)
     678             :   {
     679       17017 :     long nq = lg(gel(S,i))-1, ju = iu + nq;
     680       17017 :     GEN Si = rowslice(Ui, iu+1, ju);
     681       17017 :     gel(alq, i) = alg_quotient0(al,gel(S,i),Si,nq,p,maps);
     682       17017 :     iu = ju;
     683             :   }
     684        8043 :   return gerepilecopy(av, alq);
     685             : }
     686             : 
     687             : /* al is an al_TABLE */
     688             : static GEN
     689       18214 : algtablecenter(GEN al)
     690             : {
     691       18214 :   pari_sp av = avma;
     692             :   long n, i, j, k, ic;
     693             :   GEN C, cij, mt, p;
     694             : 
     695       18214 :   n = alg_get_absdim(al);
     696       18214 :   mt = alg_get_multable(al);
     697       18214 :   p = alg_get_char(al);
     698       18214 :   C = cgetg(n+1,t_MAT);
     699       89061 :   for (j=1; j<=n; j++)
     700             :   {
     701       70847 :     gel(C,j) = cgetg(n*n-n+1,t_COL);
     702       70847 :     ic = 1;
     703      584479 :     for (i=2; i<=n; i++) {
     704      513632 :       if (signe(p)) cij = FpC_sub(gmael(mt,i,j),gmael(mt,j,i),p);
     705       52318 :       else          cij = RgC_sub(gmael(mt,i,j),gmael(mt,j,i));
     706     7236516 :       for (k=1; k<=n; k++, ic++) gcoeff(C,ic,j) = gel(cij, k);
     707             :     }
     708             :   }
     709       18214 :   if (signe(p)) return gerepileupto(av, FpM_ker(C,p));
     710        1645 :   else          return gerepileupto(av, ker(C));
     711             : }
     712             : 
     713             : GEN
     714        4865 : algcenter(GEN al)
     715             : {
     716        4865 :   checkalg(al);
     717        4865 :   if (alg_type(al)==al_TABLE) return algtablecenter(al);
     718          28 :   return alg_get_center(al);
     719             : }
     720             : 
     721             : /* Only in positive characteristic. Assumes that al is semisimple. */
     722             : GEN
     723        3892 : algprimesubalg(GEN al)
     724             : {
     725        3892 :   pari_sp av = avma;
     726             :   GEN p, Z, F, K;
     727             :   long nz, i;
     728        3892 :   checkalg(al);
     729        3892 :   p = alg_get_char(al);
     730        3892 :   if (!signe(p)) pari_err_DOMAIN("algprimesubalg","characteristic","=",gen_0,p);
     731             : 
     732        3878 :   Z = algtablecenter(al);
     733        3878 :   nz = lg(Z)-1;
     734        3878 :   if (nz==1) return Z;
     735             : 
     736        2625 :   F = cgetg(nz+1, t_MAT);
     737       14042 :   for (i=1; i<=nz; i++) {
     738       11417 :     GEN zi = gel(Z,i);
     739       11417 :     gel(F,i) = FpC_sub(algpow(al,zi,p),zi,p);
     740             :   }
     741        2625 :   K = FpM_ker(F,p);
     742        2625 :   return gerepileupto(av, FpM_mul(Z,K,p));
     743             : }
     744             : 
     745             : static GEN
     746        9774 : _FpX_mul(void* D, GEN x, GEN y) { return FpX_mul(x,y,(GEN)D); }
     747             : static GEN
     748       25993 : _FpX_pow(void* D, GEN x, GEN n) { return FpX_powu(x,itos(n),(GEN)D); }
     749             : static GEN
     750       16219 : FpX_factorback(GEN fa, GEN p)
     751             : {
     752       16219 :   return gen_factorback(gel(fa,1), zv_to_ZV(gel(fa,2)), (void *)p, &_FpX_mul, &_FpX_pow);
     753             : }
     754             : 
     755             : static GEN
     756       14532 : out_decompose(GEN t, GEN Z, GEN P, GEN p)
     757             : {
     758       14532 :   GEN ali = gel(t,1), projm = gel(t,2), liftm = gel(t,3), pZ;
     759       14532 :   if (signe(p)) pZ = FpM_image(FpM_mul(projm,Z,p),p);
     760        1407 :   else          pZ = image(RgM_mul(projm,Z));
     761       14532 :   return mkvec5(ali, projm, liftm, pZ, P);
     762             : }
     763             : /* fa factorization of charpol(x) */
     764             : static GEN
     765        7308 : alg_decompose_from_facto(GEN al, GEN x, GEN fa, GEN Z, long mini)
     766             : {
     767        7308 :   long k = lgcols(fa)-1, k2 = mini? 1: k/2;
     768        7308 :   GEN v1 = rowslice(fa,1,k2);
     769        7308 :   GEN v2 = rowslice(fa,k2+1,k);
     770        7308 :   GEN alq, P, Q, p = alg_get_char(al);
     771        7308 :   dbg_printf(3)("  alg_decompose_from_facto\n");
     772        7308 :   if (signe(p)) {
     773        6587 :     P = FpX_factorback(v1, p);
     774        6587 :     Q = FpX_factorback(v2, p);
     775        6587 :     P = FpX_mul(P, FpXQ_inv(P,Q,p), p);
     776             :   }
     777             :   else {
     778         721 :     P = factorback(v1);
     779         721 :     Q = factorback(v2);
     780         721 :     P = RgX_mul(P, RgXQ_inv(P,Q));
     781             :   }
     782        7308 :   P = algpoleval(al, P, x);
     783        7308 :   if (signe(p)) Q = FpC_sub(col_ei(lg(P)-1,1), P, p);
     784         721 :   else          Q = gsub(gen_1, P);
     785        7308 :   if (gequal0(P) || gequal0(Q)) return NULL;
     786        7308 :   alq = alg_centralproj(al, mkvec2(P,Q), 1);
     787             : 
     788        7308 :   P = out_decompose(gel(alq,1), Z, P, p); if (mini) return P;
     789        7224 :   Q = out_decompose(gel(alq,2), Z, Q, p);
     790        7224 :   return mkvec2(P,Q);
     791             : }
     792             : 
     793             : static GEN
     794       11767 : random_pm1(long n)
     795             : {
     796       11767 :   GEN z = cgetg(n+1,t_VECSMALL);
     797             :   long i;
     798       51624 :   for (i = 1; i <= n; i++) z[i] = random_bits(5)%3 - 1;
     799       11767 :   return z;
     800             : }
     801             : 
     802             : static GEN alg_decompose(GEN al, GEN Z, long mini, GEN* pt_primelt);
     803             : /* Try to split al using x's charpoly. Return gen_0 if simple, NULL if failure.
     804             :  * And a splitting otherwise
     805             :  * If pt_primelt!=NULL, compute a primitive element of the center when simple */
     806             : static GEN
     807       13739 : try_fact(GEN al, GEN x, GEN zx, GEN Z, GEN Zal, long mini, GEN* pt_primelt)
     808             : {
     809       13739 :   GEN z, dec0, dec1, cp = algcharpoly(Zal,zx,0,1), fa, p = alg_get_char(al);
     810             :   long nfa, e;
     811       13739 :   dbg_printf(3)("  try_fact: zx=%Ps\n", zx);
     812       13739 :   if (signe(p)) fa = FpX_factor(cp,p);
     813        1330 :   else          fa = factor(cp);
     814       13739 :   dbg_printf(3)("  charpoly=%Ps\n", fa);
     815       13739 :   nfa = nbrows(fa);
     816       13739 :   if (nfa == 1) {
     817        6431 :     if (signe(p)) e = gel(fa,2)[1];
     818         609 :     else          e = itos(gcoeff(fa,1,2));
     819        6431 :     if (e == 1) {
     820        3689 :       if (pt_primelt != NULL) *pt_primelt = mkvec2(x, cp);
     821        3689 :       return gen_0;
     822             :     }
     823        2742 :     else return NULL;
     824             :   }
     825        7308 :   dec0 = alg_decompose_from_facto(al, x, fa, Z, mini);
     826        7308 :   if (!dec0) return NULL;
     827        7308 :   if (!mini) return dec0;
     828          84 :   dec1 = alg_decompose(gel(dec0,1), gel(dec0,4), 1, pt_primelt);
     829          84 :   z = gel(dec0,5);
     830          84 :   if (!isintzero(dec1)) {
     831          14 :     if (signe(p)) z = FpM_FpC_mul(gel(dec0,3),dec1,p);
     832           7 :     else          z = RgM_RgC_mul(gel(dec0,3),dec1);
     833             :   }
     834          84 :   return z;
     835             : }
     836             : static GEN
     837           7 : randcol(long n, GEN b)
     838             : {
     839           7 :   GEN N = addiu(shifti(b,1), 1);
     840             :   long i;
     841           7 :   GEN res =  cgetg(n+1,t_COL);
     842          63 :   for (i=1; i<=n; i++)
     843             :   {
     844          56 :     pari_sp av = avma;
     845          56 :     gel(res,i) = gerepileuptoint(av, subii(randomi(N),b));
     846             :   }
     847           7 :   return res;
     848             : }
     849             : /* Return gen_0 if already simple. mini: only returns a central idempotent
     850             :  * corresponding to one simple factor
     851             :  * if pt_primelt!=NULL, sets it to a primitive element of the center when simple */
     852             : static GEN
     853       19992 : alg_decompose(GEN al, GEN Z, long mini, GEN* pt_primelt)
     854             : {
     855             :   pari_sp av;
     856             :   GEN Zal, x, zx, rand, dec0, B, p;
     857       19992 :   long i, nz = lg(Z)-1;
     858             : 
     859       19992 :   if (nz == 1) {
     860        8995 :     if (pt_primelt != 0) *pt_primelt = mkvec2(zerocol(alg_get_dim(al)), pol_x(0));
     861        8995 :     return gen_0;
     862             :   }
     863       10997 :   p = alg_get_char(al);
     864       10997 :   dbg_printf(2)(" alg_decompose: char=%Ps, dim=%d, dim Z=%d\n", p, alg_get_absdim(al), nz);
     865       10997 :   Zal = alg_subalg(al,Z);
     866       10997 :   Z = gel(Zal,2);
     867       10997 :   Zal = gel(Zal,1);
     868       10997 :   av = avma;
     869             : 
     870       10997 :   rand = random_pm1(nz);
     871       10997 :   zx = zc_to_ZC(rand);
     872       10997 :   if (signe(p)) {
     873       10024 :     zx = FpC_red(zx,p);
     874       10024 :     x = ZM_zc_mul(Z,rand);
     875       10024 :     x = FpC_red(x,p);
     876             :   }
     877         973 :   else x = RgM_zc_mul(Z,rand);
     878       10997 :   dec0 = try_fact(al,x,zx,Z,Zal,mini,pt_primelt);
     879       10997 :   if (dec0) return dec0;
     880        2686 :   set_avma(av);
     881             : 
     882        2742 :   for (i=2; i<=nz; i++)
     883             :   {
     884        2735 :     dec0 = try_fact(al,gel(Z,i),col_ei(nz,i),Z,Zal,mini,pt_primelt);
     885        2735 :     if (dec0) return dec0;
     886          56 :     set_avma(av);
     887             :   }
     888           7 :   B = int2n(10);
     889             :   for (;;)
     890           0 :   {
     891           7 :     GEN x = randcol(nz,B), zx = ZM_ZC_mul(Z,x);
     892           7 :     dec0 = try_fact(al,x,zx,Z,Zal,mini,pt_primelt);
     893           7 :     if (dec0) return dec0;
     894           0 :     set_avma(av);
     895             :   }
     896             : }
     897             : 
     898             : static GEN
     899       16387 : alg_decompose_total(GEN al, GEN Z, long maps)
     900             : {
     901             :   GEN dec, sc, p;
     902             :   long i;
     903             : 
     904       16387 :   dec = alg_decompose(al, Z, 0, NULL);
     905       16387 :   if (isintzero(dec))
     906             :   {
     907        9163 :     if (maps) {
     908        6531 :       long n = alg_get_absdim(al);
     909        6531 :       al = mkvec3(al, matid(n), matid(n));
     910             :     }
     911        9163 :     return mkvec(al);
     912             :   }
     913        7224 :   p = alg_get_char(al); if (!signe(p)) p = NULL;
     914        7224 :   sc = cgetg(lg(dec), t_VEC);
     915       21672 :   for (i=1; i<lg(sc); i++) {
     916       14448 :     GEN D = gel(dec,i), a = gel(D,1), Za = gel(D,4);
     917       14448 :     GEN S = alg_decompose_total(a, Za, maps);
     918       14448 :     gel(sc,i) = S;
     919       14448 :     if (maps)
     920             :     {
     921       10192 :       GEN projm = gel(D,2), liftm = gel(D,3);
     922       10192 :       long j, lS = lg(S);
     923       27831 :       for (j=1; j<lS; j++)
     924             :       {
     925       17639 :         GEN Sj = gel(S,j), p2 = gel(Sj,2), l2 = gel(Sj,3);
     926       17639 :         if (p) p2 = FpM_mul(p2, projm, p);
     927          49 :         else   p2 = RgM_mul(p2, projm);
     928       17639 :         if (p) l2 = FpM_mul(liftm, l2, p);
     929          49 :         else   l2 = RgM_mul(liftm, l2);
     930       17639 :         gel(Sj,2) = p2;
     931       17639 :         gel(Sj,3) = l2;
     932             :       }
     933             :     }
     934             :   }
     935        7224 :   return shallowconcat1(sc);
     936             : }
     937             : 
     938             : static GEN
     939       11053 : alg_subalg(GEN al, GEN basis)
     940             : {
     941       11053 :   GEN invbasis, mt, p = alg_get_char(al);
     942       11053 :   long i, j, n = lg(basis)-1;
     943             : 
     944       11053 :   if (!signe(p)) p = NULL;
     945       11053 :   basis = shallowmatconcat(mkvec2(col_ei(n,1), basis));
     946       11053 :   if (p)
     947             :   {
     948       10059 :     basis = image_keep_first(basis,p);
     949       10059 :     invbasis = FpM_inv(basis,p);
     950             :   }
     951             :   else
     952             :   { /* FIXME use an integral variant of image_keep_first */
     953         994 :     basis = QM_ImQ_hnf(basis);
     954         994 :     invbasis = RgM_inv(basis);
     955             :   }
     956       11053 :   mt = cgetg(n+1,t_VEC);
     957       11053 :   gel(mt,1) = matid(n);
     958       37176 :   for (i = 2; i <= n; i++)
     959             :   {
     960       26123 :     GEN mtx = cgetg(n+1,t_MAT), x = gel(basis,i);
     961       26123 :     gel(mtx,1) = col_ei(n,i);
     962      165426 :     for (j = 2; j <= n; j++)
     963             :     {
     964      139303 :       GEN xy = algmul(al, x, gel(basis,j));
     965      139303 :       if (p) gel(mtx,j) = FpM_FpC_mul(invbasis, xy, p);
     966       28070 :       else   gel(mtx,j) = RgM_RgC_mul(invbasis, xy);
     967             :     }
     968       26123 :     gel(mt,i) = mtx;
     969             :   }
     970       11053 :   return mkvec2(algtableinit_i(mt,p), basis);
     971             : }
     972             : 
     973             : GEN
     974          63 : algsubalg(GEN al, GEN basis)
     975             : {
     976          63 :   pari_sp av = avma;
     977             :   GEN p;
     978          63 :   checkalg(al);
     979          63 :   if (typ(basis) != t_MAT) pari_err_TYPE("algsubalg",basis);
     980          56 :   p = alg_get_char(al);
     981          56 :   if (signe(p)) basis = RgM_to_FpM(basis,p);
     982          56 :   return gerepilecopy(av, alg_subalg(al,basis));
     983             : }
     984             : 
     985             : static int
     986       11795 : cmp_algebra(GEN x, GEN y)
     987             : {
     988             :   long d;
     989       11795 :   d = gel(x,1)[1] - gel(y,1)[1]; if (d) return d < 0? -1: 1;
     990       10598 :   d = gel(x,1)[2] - gel(y,1)[2]; if (d) return d < 0? -1: 1;
     991       10598 :   return cmp_universal(gel(x,2), gel(y,2));
     992             : }
     993             : 
     994             : GEN
     995        3969 : algsimpledec_ss(GEN al, long maps)
     996             : {
     997        3969 :   pari_sp av = avma;
     998             :   GEN Z, p, r, res, perm;
     999             :   long i, l, n;
    1000        3969 :   checkalg(al);
    1001        3969 :   p = alg_get_char(al);
    1002        3969 :   dbg_printf(1)("algsimpledec_ss: char=%Ps, dim=%d\n", p, alg_get_absdim(al));
    1003        3969 :   if (signe(p)) Z = algprimesubalg(al);
    1004         245 :   else          Z = algtablecenter(al);
    1005             : 
    1006        3969 :   if (lg(Z) == 2) {/* dim Z = 1 */
    1007        2030 :     n = alg_get_absdim(al);
    1008        2030 :     set_avma(av);
    1009        2030 :     if (!maps) return mkveccopy(al);
    1010        1904 :     retmkvec(mkvec3(gcopy(al), matid(n), matid(n)));
    1011             :   }
    1012        1939 :   res = alg_decompose_total(al, Z, maps);
    1013        1939 :   l = lg(res); r = cgetg(l, t_VEC);
    1014       11102 :   for (i = 1; i < l; i++)
    1015             :   {
    1016        9163 :     GEN A = maps? gmael(res,i,1): gel(res,i);
    1017        9163 :     gel(r,i) = mkvec2(mkvecsmall2(alg_get_dim(A), lg(algtablecenter(A))),
    1018             :                       alg_get_multable(A));
    1019             :   }
    1020        1939 :   perm = gen_indexsort(r, (void*)cmp_algebra, &cmp_nodata);
    1021        1939 :   return gerepilecopy(av, vecpermute(res, perm));
    1022             : }
    1023             : 
    1024             : GEN
    1025         756 : algsimpledec(GEN al, long maps)
    1026             : {
    1027         756 :   pari_sp av = avma;
    1028             :   int ss;
    1029         756 :   GEN rad, dec, res, proj=NULL, lift=NULL;
    1030         756 :   rad = algradical(al);
    1031         756 :   ss = gequal0(rad);
    1032         756 :   if (!ss)
    1033             :   {
    1034          42 :     al = alg_quotient(al, rad, maps);
    1035          42 :     if (maps) {
    1036          14 :       proj = gel(al,2);
    1037          14 :       lift = gel(al,3);
    1038          14 :       al = gel(al,1);
    1039             :     }
    1040             :   }
    1041         756 :   dec = algsimpledec_ss(al, maps);
    1042         756 :   if (!ss && maps) /* update maps */
    1043             :   {
    1044          14 :     GEN p = alg_get_char(al);
    1045             :     long i;
    1046          42 :     for (i=1; i<lg(dec); i++)
    1047             :     {
    1048          28 :       if (signe(p))
    1049             :       {
    1050          14 :         gmael(dec,i,2) = FpM_mul(gmael(dec,i,2), proj, p);
    1051          14 :         gmael(dec,i,3) = FpM_mul(lift, gmael(dec,i,3), p);
    1052             :       }
    1053             :       else
    1054             :       {
    1055          14 :         gmael(dec,i,2) = RgM_mul(gmael(dec,i,2), proj);
    1056          14 :         gmael(dec,i,3) = RgM_mul(lift, gmael(dec,i,3));
    1057             :       }
    1058             :     }
    1059             :   }
    1060         756 :   res = mkvec2(rad, dec);
    1061         756 :   return gerepilecopy(av,res);
    1062             : }
    1063             : 
    1064             : static GEN alg_idempotent(GEN al, long n, long d);
    1065             : static GEN
    1066        6482 : try_split(GEN al, GEN x, long n, long d)
    1067             : {
    1068        6482 :   GEN cp, p = alg_get_char(al), fa, e, pol, exp, P, Q, U, u, mx, mte, ire;
    1069        6482 :   long nfa, i, smalldim = alg_get_absdim(al)+1, dim, smalli = 0;
    1070        6482 :   cp = algcharpoly(al,x,0,1);
    1071        6482 :   fa = FpX_factor(cp,p);
    1072        6482 :   nfa = nbrows(fa);
    1073        6482 :   if (nfa == 1) return NULL;
    1074        3052 :   pol = gel(fa,1);
    1075        3052 :   exp = gel(fa,2);
    1076             : 
    1077             :   /* charpoly is always a d-th power */
    1078        9254 :   for (i=1; i<lg(exp); i++) {
    1079        6209 :     if (exp[i]%d) pari_err(e_MISC, "the algebra must be simple (try_split 1)");
    1080        6202 :     exp[i] /= d;
    1081             :   }
    1082        3045 :   cp = FpX_factorback(fa,p);
    1083             : 
    1084             :   /* find smallest Fp-dimension of a characteristic space */
    1085        9247 :   for (i=1; i<lg(pol); i++) {
    1086        6202 :     dim = degree(gel(pol,i))*exp[i];
    1087        6202 :     if (dim < smalldim) {
    1088        3115 :       smalldim = dim;
    1089        3115 :       smalli = i;
    1090             :     }
    1091             :   }
    1092        3045 :   i = smalli;
    1093        3045 :   if (smalldim != n) return NULL;
    1094             :   /* We could also compute e*al*e and try again with this smaller algebra */
    1095             :   /* Fq-rank 1 = Fp-rank n idempotent: success */
    1096             : 
    1097             :   /* construct idempotent */
    1098        3031 :   mx = algbasismultable(al,x);
    1099        3031 :   P = gel(pol,i);
    1100        3031 :   P = FpX_powu(P, exp[i], p);
    1101        3031 :   Q = FpX_div(cp, P, p);
    1102        3031 :   e = algpoleval(al, Q, mkvec2(x,mx));
    1103        3031 :   U = FpXQ_inv(Q, P, p);
    1104        3031 :   u = algpoleval(al, U, mkvec2(x,mx));
    1105        3031 :   e = algbasismul(al, e, u);
    1106        3031 :   mte = algbasisrightmultable(al,e);
    1107        3031 :   ire = FpM_indexrank(mte,p);
    1108        3031 :   if (lg(gel(ire,1))-1 != smalldim*d) pari_err(e_MISC, "the algebra must be simple (try_split 2)");
    1109             : 
    1110        3024 :   return mkvec3(e,mte,ire);
    1111             : }
    1112             : 
    1113             : /*
    1114             :  * Given a simple algebra al of dimension d^2 over its center of degree n,
    1115             :  * find an idempotent e in al with rank n (which is minimal).
    1116             : */
    1117             : static GEN
    1118        3038 : alg_idempotent(GEN al, long n, long d)
    1119             : {
    1120        3038 :   pari_sp av = avma;
    1121        3038 :   long i, N = alg_get_absdim(al);
    1122        3038 :   GEN e, p = alg_get_char(al), x;
    1123        6377 :   for(i=2; i<=N; i++) {
    1124        6321 :     x = col_ei(N,i);
    1125        6321 :     e = try_split(al, x, n, d);
    1126        6307 :     if (e) return e;
    1127        3339 :     set_avma(av);
    1128             :   }
    1129             :   for(;;) {
    1130         161 :     x = random_FpC(N,p);
    1131         161 :     e = try_split(al, x, n, d);
    1132         161 :     if (e) return e;
    1133         105 :     set_avma(av);
    1134             :   }
    1135             : }
    1136             : 
    1137             : static GEN
    1138        3857 : try_descend(GEN M, GEN B, GEN p, long m, long n, long d)
    1139             : {
    1140        3857 :   GEN B2 = cgetg(m+1,t_MAT), b;
    1141        3857 :   long i, j, k=0;
    1142       11011 :   for (i=1; i<=d; i++)
    1143             :   {
    1144        7154 :     k++;
    1145        7154 :     b = gel(B,i);
    1146        7154 :     gel(B2,k) = b;
    1147       17248 :     for (j=1; j<n; j++)
    1148             :     {
    1149       10094 :       k++;
    1150       10094 :       b = FpM_FpC_mul(M,b,p);
    1151       10094 :       gel(B2,k) = b;
    1152             :     }
    1153             :   }
    1154        3857 :   if (!signe(FpM_det(B2,p))) return NULL;
    1155        3437 :   return FpM_inv(B2,p);
    1156             : }
    1157             : 
    1158             : /* Given an m*m matrix M with irreducible charpoly over F of degree n,
    1159             :  * let K = F(M), which is a field, and write m=d*n.
    1160             :  * Compute the d-dimensional K-vector space structure on V=F^m induced by M.
    1161             :  * Return [B,C] where:
    1162             :  *  - B is m*d matrix over F giving a K-basis b_1,...,b_d of V
    1163             :  *  - C is d*m matrix over F[x] expressing the canonical F-basis of V on the b_i
    1164             :  * Currently F = Fp TODO extend this. */
    1165             : static GEN
    1166        3437 : descend_i(GEN M, long n, GEN p)
    1167             : {
    1168             :   GEN B, C;
    1169             :   long m,d,i;
    1170             :   pari_sp av;
    1171        3437 :   m = lg(M)-1;
    1172        3437 :   d = m/n;
    1173        3437 :   B = cgetg(d+1,t_MAT);
    1174        3437 :   av = avma;
    1175             : 
    1176             :   /* try a subset of the canonical basis */
    1177        9751 :   for (i=1; i<=d; i++)
    1178        6314 :     gel(B,i) = col_ei(m,n*(i-1)+1);
    1179        3437 :   C = try_descend(M,B,p,m,n,d);
    1180        3437 :   if (C) return mkvec2(B,C);
    1181         385 :   set_avma(av);
    1182             : 
    1183             :   /* try smallish elements */
    1184        1155 :   for (i=1; i<=d; i++)
    1185         770 :     gel(B,i) = FpC_red(zc_to_ZC(random_pm1(m)),p);
    1186         385 :   C = try_descend(M,B,p,m,n,d);
    1187         385 :   if (C) return mkvec2(B,C);
    1188          35 :   set_avma(av);
    1189             : 
    1190             :   /* try random elements */
    1191             :   for (;;)
    1192             :   {
    1193         105 :     for (i=1; i<=d; i++)
    1194          70 :       gel(B,i) = random_FpC(m,p);
    1195          35 :     C = try_descend(M,B,p,m,n,d);
    1196          35 :     if (C) return mkvec2(B,C);
    1197           0 :     set_avma(av);
    1198             :   }
    1199             : }
    1200             : static GEN
    1201       15568 : RgC_contract(GEN C, long n, long v) /* n>1 */
    1202             : {
    1203             :   GEN C2, P;
    1204             :   long m, d, i, j;
    1205       15568 :   m = lg(C)-1;
    1206       15568 :   d = m/n;
    1207       15568 :   C2 = cgetg(d+1,t_COL);
    1208       43344 :   for (i=1; i<=d; i++)
    1209             :   {
    1210       27776 :     P = pol_xn(n-1,v);
    1211      105728 :     for (j=1; j<=n; j++)
    1212       77952 :       gel(P,j+1) = gel(C,n*(i-1)+j);
    1213       27776 :     P = normalizepol(P);
    1214       27776 :     gel(C2,i) = P;
    1215             :   }
    1216       15568 :   return C2;
    1217             : }
    1218             : static GEN
    1219        3437 : RgM_contract(GEN A, long n, long v) /* n>1 */
    1220             : {
    1221        3437 :   GEN A2 = cgetg(lg(A),t_MAT);
    1222             :   long i;
    1223       19005 :   for (i=1; i<lg(A2); i++)
    1224       15568 :     gel(A2,i) = RgC_contract(gel(A,i),n,v);
    1225        3437 :   return A2;
    1226             : }
    1227             : static GEN
    1228        3437 : descend(GEN M, long n, GEN p, long v)
    1229             : {
    1230        3437 :   GEN res = descend_i(M,n,p);
    1231        3437 :   gel(res,2) = RgM_contract(gel(res,2),n,v);
    1232        3437 :   return res;
    1233             : }
    1234             : 
    1235             : /* isomorphism of Fp-vector spaces M_d(F_p^n) -> (F_p)^(d^2*n) */
    1236             : static GEN
    1237       29939 : Fq_mat2col(GEN M, long d, long n)
    1238             : {
    1239       29939 :   long N = d*d*n, i, j, k;
    1240       29939 :   GEN C = cgetg(N+1, t_COL);
    1241       90160 :   for (i=1; i<=d; i++)
    1242      191632 :     for (j=1; j<=d; j++)
    1243      400526 :       for (k=0; k<n; k++)
    1244      269115 :         gel(C,n*(d*(i-1)+j-1)+k+1) = polcoef_i(gcoeff(M,i,j),k,-1);
    1245       29939 :   return C;
    1246             : }
    1247             : 
    1248             : static GEN
    1249        3752 : alg_finite_csa_split(GEN al, long v)
    1250             : {
    1251             :   GEN Z, e, mte, ire, primelt, b, T, M, proje, lifte, extre, p, B, C, mt, mx, map, mapi, T2, ro;
    1252        3752 :   long n, d, N = alg_get_absdim(al), i;
    1253        3752 :   p = alg_get_char(al);
    1254             :   /* compute the center */
    1255        3752 :   Z = algcenter(al);
    1256             :   /* TODO option to give the center as input instead of computing it */
    1257        3752 :   n = lg(Z)-1;
    1258             : 
    1259             :   /* compute a minimal rank idempotent e */
    1260        3752 :   if (n==N) {
    1261         707 :     d = 1;
    1262         707 :     e = col_ei(N,1);
    1263         707 :     mte = matid(N);
    1264         707 :     ire = mkvec2(identity_perm(n),identity_perm(n));
    1265             :   }
    1266             :   else {
    1267        3045 :     d = usqrt(N/n);
    1268        3045 :     if (d*d*n != N) pari_err(e_MISC, "the algebra must be simple (alg_finite_csa_split 1)");
    1269        3038 :     e = alg_idempotent(al,n,d);
    1270        3024 :     mte = gel(e,2);
    1271        3024 :     ire = gel(e,3);
    1272        3024 :     e = gel(e,1);
    1273             :   }
    1274             : 
    1275             :   /* identify the center */
    1276        3731 :   if (n==1)
    1277             :   {
    1278         287 :     T = pol_x(v);
    1279         287 :     primelt = gen_0;
    1280             :   }
    1281             :   else
    1282             :   {
    1283        3444 :     b = alg_decompose(al, Z, 1, &primelt);
    1284        3444 :     if (!gequal0(b)) pari_err(e_MISC, "the algebra must be simple (alg_finite_csa_split 2)");
    1285        3437 :     T = gel(primelt,2);
    1286        3437 :     primelt = gel(primelt,1);
    1287        3437 :     setvarn(T,v);
    1288             :   }
    1289             : 
    1290             :   /* use the ffinit polynomial */
    1291        3724 :   if (n>1)
    1292             :   {
    1293        3437 :     T2 = init_Fq(p,n,v);
    1294        3437 :     setvarn(T,fetch_var_higher());
    1295        3437 :     ro = FpXQX_roots(T2,T,p);
    1296        3437 :     ro = gel(ro,1);
    1297        3437 :     primelt = algpoleval(al,ro,primelt);
    1298        3437 :     T = T2;
    1299             :   }
    1300             : 
    1301             :   /* descend al*e to a vector space over the center */
    1302             :   /* lifte: al*e -> al ; proje: al*e -> al */
    1303        3724 :   lifte = shallowextract(mte,gel(ire,2));
    1304        3724 :   extre = shallowmatextract(mte,gel(ire,1),gel(ire,2));
    1305        3724 :   extre = FpM_inv(extre,p);
    1306        3724 :   proje = rowpermute(mte,gel(ire,1));
    1307        3724 :   proje = FpM_mul(extre,proje,p);
    1308        3724 :   if (n==1)
    1309             :   {
    1310         287 :     B = lifte;
    1311         287 :     C = proje;
    1312             :   }
    1313             :   else
    1314             :   {
    1315        3437 :     M = algbasismultable(al,primelt);
    1316        3437 :     M = FpM_mul(M,lifte,p);
    1317        3437 :     M = FpM_mul(proje,M,p);
    1318        3437 :     B = descend(M,n,p,v);
    1319        3437 :     C = gel(B,2);
    1320        3437 :     B = gel(B,1);
    1321        3437 :     B = FpM_mul(lifte,B,p);
    1322        3437 :     C = FqM_mul(C,proje,T,p);
    1323             :   }
    1324             : 
    1325             :   /* compute the isomorphism */
    1326        3724 :   mt = alg_get_multable(al);
    1327        3724 :   map = cgetg(N+1,t_VEC);
    1328        3724 :   M = cgetg(N+1,t_MAT);
    1329       33663 :   for (i=1; i<=N; i++)
    1330             :   {
    1331       29939 :     mx = gel(mt,i);
    1332       29939 :     mx = FpM_mul(mx,B,p);
    1333       29939 :     mx = FqM_mul(C,mx,T,p);
    1334       29939 :     gel(map,i) = mx;
    1335       29939 :     gel(M,i) = Fq_mat2col(mx,d,n);
    1336             :   }
    1337        3724 :   mapi = FpM_inv(M,p);
    1338        3724 :   if (!mapi) pari_err(e_MISC, "the algebra must be simple (alg_finite_csa_split 3)");
    1339        3717 :   return mkvec3(T,map,mapi);
    1340             : }
    1341             : 
    1342             : GEN
    1343        3766 : algsplit(GEN al, long v)
    1344             : {
    1345        3766 :   pari_sp av = avma;
    1346             :   GEN res, T, map, mapi, ff, p;
    1347             :   long i,j,k,li,lj;
    1348        3766 :   checkalg(al);
    1349        3759 :   p = alg_get_char(al);
    1350        3759 :   if (gequal0(p))
    1351           7 :     pari_err_IMPL("splitting a characteristic 0 algebra over its center");
    1352        3752 :   res = alg_finite_csa_split(al, v);
    1353        3717 :   T = gel(res,1);
    1354        3717 :   map = gel(res,2);
    1355        3717 :   mapi = gel(res,3);
    1356        3717 :   ff = Tp_to_FF(T,p);
    1357       33593 :   for (i=1; i<lg(map); i++)
    1358             :   {
    1359       29876 :     li = lg(gel(map,i));
    1360       89908 :     for (j=1; j<li; j++)
    1361             :     {
    1362       60032 :       lj = lg(gmael(map,i,j));
    1363      190876 :       for (k=1; k<lj; k++)
    1364      130844 :         gmael3(map,i,j,k) = Fq_to_FF(gmael3(map,i,j,k),ff);
    1365             :     }
    1366             :   }
    1367             : 
    1368        3717 :   return gerepilecopy(av, mkvec2(map,mapi));
    1369             : }
    1370             : 
    1371             : /* multiplication table sanity checks */
    1372             : static GEN
    1373       36589 : check_mt_noid(GEN mt, GEN p)
    1374             : {
    1375             :   long i, l;
    1376       36589 :   GEN MT = cgetg_copy(mt, &l);
    1377       36589 :   if (typ(MT) != t_VEC || l == 1) return NULL;
    1378      177721 :   for (i = 1; i < l; i++)
    1379             :   {
    1380      141174 :     GEN M = gel(mt,i);
    1381      141174 :     if (typ(M) != t_MAT || lg(M) != l || lgcols(M) != l) return NULL;
    1382      141153 :     if (p) M = RgM_to_FpM(M,p);
    1383      141153 :     gel(MT,i) = M;
    1384             :   }
    1385       36547 :   return MT;
    1386             : }
    1387             : static GEN
    1388       36127 : check_mt(GEN mt, GEN p)
    1389             : {
    1390             :   long i;
    1391             :   GEN MT;
    1392       36127 :   MT = check_mt_noid(mt, p);
    1393       36127 :   if (!MT || !ZM_isidentity(gel(MT,1))) return NULL;
    1394      138108 :   for (i=2; i<lg(MT); i++)
    1395      102002 :     if (ZC_is_ei(gmael(MT,i,1)) != i) return NULL;
    1396       36106 :   return MT;
    1397             : }
    1398             : 
    1399             : static GEN
    1400         161 : check_relmt(GEN nf, GEN mt)
    1401             : {
    1402         161 :   long i, l = lg(mt), j, k;
    1403         161 :   GEN MT = gcopy(mt), a, b, d;
    1404         161 :   if (typ(MT) != t_VEC || l == 1) return NULL;
    1405         623 :   for (i = 1; i < l; i++)
    1406             :   {
    1407         483 :     GEN M = gel(MT,i);
    1408         483 :     if (typ(M) != t_MAT || lg(M) != l || lgcols(M) != l) return NULL;
    1409        2478 :     for (k = 1; k < l; k++)
    1410       12523 :       for (j = 1; j < l; j++)
    1411             :       {
    1412       10528 :         a = gcoeff(M,j,k);
    1413       10528 :         if (typ(a)==t_INT) continue;
    1414        1771 :         b = algtobasis(nf,a);
    1415        1771 :         d = Q_denom(b);
    1416        1771 :         if (!isint1(d))
    1417          14 :           pari_err_DOMAIN("alg_csa_table", "denominator(mt)", "!=", gen_1, mt);
    1418        1757 :         gcoeff(M,j,k) = lift(basistoalg(nf,b));
    1419             :       }
    1420         469 :     if (i > 1 && RgC_is_ei(gel(M,1)) != i) return NULL; /* i = 1 checked at end */
    1421         462 :     gel(MT,i) = M;
    1422             :   }
    1423         140 :   if (!RgM_isidentity(gel(MT,1))) return NULL;
    1424         140 :   return MT;
    1425             : }
    1426             : 
    1427             : int
    1428         469 : algisassociative(GEN mt0, GEN p)
    1429             : {
    1430         469 :   pari_sp av = avma;
    1431             :   long i, j, k, n;
    1432             :   GEN M, mt;
    1433             : 
    1434         469 :   if (checkalg_i(mt0)) { p = alg_get_char(mt0); mt0 = alg_get_multable(mt0); }
    1435         469 :   if (typ(p) != t_INT) pari_err_TYPE("algisassociative",p);
    1436         462 :   mt = check_mt_noid(mt0, isintzero(p)? NULL: p);
    1437         462 :   if (!mt) pari_err_TYPE("algisassociative (mult. table)", mt0);
    1438         427 :   if (!ZM_isidentity(gel(mt,1))) return gc_bool(av,0);
    1439         413 :   n = lg(mt)-1;
    1440         413 :   M = cgetg(n+1,t_MAT);
    1441        3402 :   for (j=1; j<=n; j++) gel(M,j) = cgetg(n+1,t_COL);
    1442        3402 :   for (i=1; i<=n; i++)
    1443             :   {
    1444        2989 :     GEN mi = gel(mt,i);
    1445       34790 :     for (j=1; j<=n; j++) gcoeff(M,i,j) = gel(mi,j); /* ei.ej */
    1446             :   }
    1447        2975 :   for (i=2; i<=n; i++) {
    1448        2569 :     GEN mi = gel(mt,i);
    1449       28777 :     for (j=2; j<=n; j++) {
    1450      367759 :       for (k=2; k<=n; k++) {
    1451             :         GEN x, y;
    1452      341551 :         if (signe(p)) {
    1453      242039 :           x = _tablemul_ej_Fp(mt,gcoeff(M,i,j),k,p);
    1454      242039 :           y = FpM_FpC_mul(mi,gcoeff(M,j,k),p);
    1455             :         }
    1456             :         else {
    1457       99512 :           x = _tablemul_ej(mt,gcoeff(M,i,j),k);
    1458       99512 :           y = RgM_RgC_mul(mi,gcoeff(M,j,k));
    1459             :         }
    1460             :         /* not cmp_universal: must not fail on 0 == Mod(0,2) for instance */
    1461      341551 :         if (!gequal(x,y)) return gc_bool(av,0);
    1462             :       }
    1463             :     }
    1464             :   }
    1465         406 :   return gc_bool(av,1);
    1466             : }
    1467             : 
    1468             : int
    1469         350 : algiscommutative(GEN al) /* assumes e_1 = 1 */
    1470             : {
    1471             :   long i,j,k,N,sp;
    1472             :   GEN mt,a,b,p;
    1473         350 :   checkalg(al);
    1474         350 :   if (alg_type(al) != al_TABLE) return alg_get_degree(al)==1;
    1475         308 :   N = alg_get_absdim(al);
    1476         308 :   mt = alg_get_multable(al);
    1477         308 :   p = alg_get_char(al);
    1478         308 :   sp = signe(p);
    1479        1449 :   for (i=2; i<=N; i++)
    1480        9464 :     for (j=2; j<=N; j++)
    1481       85820 :       for (k=1; k<=N; k++) {
    1482       77553 :         a = gcoeff(gel(mt,i),k,j);
    1483       77553 :         b = gcoeff(gel(mt,j),k,i);
    1484       77553 :         if (sp) {
    1485       73423 :           if (cmpii(Fp_red(a,p), Fp_red(b,p))) return 0;
    1486             :         }
    1487        4130 :         else if (gcmp(a,b)) return 0;
    1488             :       }
    1489         252 :   return 1;
    1490             : }
    1491             : 
    1492             : int
    1493         350 : algissemisimple(GEN al)
    1494             : {
    1495         350 :   pari_sp av = avma;
    1496             :   GEN rad;
    1497         350 :   checkalg(al);
    1498         350 :   if (alg_type(al) != al_TABLE) return 1;
    1499         308 :   rad = algradical(al);
    1500         308 :   set_avma(av);
    1501         308 :   return gequal0(rad);
    1502             : }
    1503             : 
    1504             : /* ss : known to be semisimple */
    1505             : int
    1506         259 : algissimple(GEN al, long ss)
    1507             : {
    1508         259 :   pari_sp av = avma;
    1509             :   GEN Z, dec, p;
    1510         259 :   checkalg(al);
    1511         259 :   if (alg_type(al) != al_TABLE) return 1;
    1512         224 :   if (!ss && !algissemisimple(al)) return 0;
    1513             : 
    1514         182 :   p = alg_get_char(al);
    1515         182 :   if (signe(p)) Z = algprimesubalg(al);
    1516          91 :   else          Z = algtablecenter(al);
    1517             : 
    1518         182 :   if (lg(Z) == 2) {/* dim Z = 1 */
    1519         105 :     set_avma(av);
    1520         105 :     return 1;
    1521             :   }
    1522          77 :   dec = alg_decompose(al, Z, 1, NULL);
    1523          77 :   set_avma(av);
    1524          77 :   return gequal0(dec);
    1525             : }
    1526             : 
    1527             : static long
    1528         329 : is_place_emb(GEN nf, GEN pl)
    1529             : {
    1530             :   long r, r1, r2;
    1531         329 :   if (typ(pl) != t_INT) pari_err_TYPE("is_place_emb", pl);
    1532         315 :   if (signe(pl)<=0) pari_err_DOMAIN("is_place_emb", "pl", "<=", gen_0, pl);
    1533         308 :   nf_get_sign(nf,&r1,&r2); r = r1+r2;
    1534         308 :   if (cmpiu(pl,r)>0) pari_err_DOMAIN("is_place_emb", "pl", ">", utoi(r), pl);
    1535         294 :   return itou(pl);
    1536             : }
    1537             : 
    1538             : static long
    1539         294 : alghasse_emb(GEN al, long emb)
    1540             : {
    1541         294 :   GEN nf = alg_get_center(al);
    1542         294 :   long r1 = nf_get_r1(nf);
    1543         294 :   return (emb <= r1)? alg_get_hasse_i(al)[emb]: 0;
    1544             : }
    1545             : 
    1546             : static long
    1547         399 : alghasse_pr(GEN al, GEN pr)
    1548             : {
    1549         399 :   GEN hf = alg_get_hasse_f(al);
    1550         399 :   long i = tablesearch(gel(hf,1), pr, &cmp_prime_ideal);
    1551         399 :   return i? gel(hf,2)[i]: 0;
    1552             : }
    1553             : 
    1554             : static long
    1555         735 : alghasse_0(GEN al, GEN pl)
    1556             : {
    1557             :   GEN pr, nf;
    1558         735 :   if (alg_type(al)== al_CSA)
    1559           7 :     pari_err_IMPL("computation of Hasse invariants over table CSA");
    1560         728 :   if ((pr = get_prid(pl))) return alghasse_pr(al, pr);
    1561         329 :   nf = alg_get_center(al);
    1562         329 :   return alghasse_emb(al, is_place_emb(nf, pl));
    1563             : }
    1564             : GEN
    1565         210 : alghasse(GEN al, GEN pl)
    1566             : {
    1567             :   long h;
    1568         210 :   checkalg(al);
    1569         210 :   if (alg_type(al) == al_TABLE) pari_err_TYPE("alghasse [use alginit]",al);
    1570         203 :   h = alghasse_0(al,pl);
    1571         161 :   return sstoQ(h, alg_get_degree(al));
    1572             : }
    1573             : 
    1574             : /* h >= 0, d >= 0 */
    1575             : static long
    1576         812 : indexfromhasse(long h, long d) { return d/ugcd(h,d); }
    1577             : 
    1578             : long
    1579         728 : algindex(GEN al, GEN pl)
    1580             : {
    1581             :   long d, res, i, l;
    1582             :   GEN hi, hf;
    1583             : 
    1584         728 :   checkalg(al);
    1585         721 :   if (alg_type(al) == al_TABLE) pari_err_TYPE("algindex [use alginit]",al);
    1586         714 :   d = alg_get_degree(al);
    1587         714 :   if (pl) return indexfromhasse(alghasse_0(al,pl), d);
    1588             : 
    1589             :   /* else : global index */
    1590         182 :   res = 1;
    1591         182 :   hi = alg_get_hasse_i(al); l = lg(hi);
    1592         308 :   for (i=1; i<l && res!=d; i++) res = ulcm(res, indexfromhasse(hi[i],d));
    1593         182 :   hf = gel(alg_get_hasse_f(al), 2); l = lg(hf);
    1594         336 :   for (i=1; i<l && res!=d; i++) res = ulcm(res, indexfromhasse(hf[i],d));
    1595         182 :   return res;
    1596             : }
    1597             : 
    1598             : int
    1599         203 : algisdivision(GEN al, GEN pl)
    1600             : {
    1601         203 :   checkalg(al);
    1602         203 :   if (alg_type(al) == al_TABLE) {
    1603          21 :     if (!algissimple(al,0)) return 0;
    1604          14 :     if (algiscommutative(al)) return 1;
    1605           7 :     pari_err_IMPL("algisdivision for table algebras");
    1606             :   }
    1607         182 :   return algindex(al,pl) == alg_get_degree(al);
    1608             : }
    1609             : 
    1610             : int
    1611         182 : algissplit(GEN al, GEN pl)
    1612             : {
    1613         182 :   checkalg(al);
    1614         182 :   if (alg_type(al) == al_TABLE) pari_err_TYPE("algissplit [use alginit]", al);
    1615         175 :   return algindex(al,pl) == 1;
    1616             : }
    1617             : 
    1618             : int
    1619         182 : algisramified(GEN al, GEN pl)
    1620             : {
    1621         182 :   checkalg(al);
    1622         182 :   if (alg_type(al) == al_TABLE) pari_err_TYPE("algisramified [use alginit]", al);
    1623         175 :   return algindex(al,pl) != 1;
    1624             : }
    1625             : 
    1626             : GEN
    1627          91 : algramifiedplaces(GEN al)
    1628             : {
    1629          91 :   pari_sp av = avma;
    1630             :   GEN ram, hf, hi, Lpr;
    1631             :   long r1, count, i;
    1632          91 :   checkalg(al);
    1633          91 :   if (alg_type(al) == al_TABLE) pari_err_TYPE("algramifiedplaces [use alginit]", al);
    1634          84 :   r1 = nf_get_r1(alg_get_center(al));
    1635          84 :   hi = alg_get_hasse_i(al);
    1636          84 :   hf = alg_get_hasse_f(al);
    1637          84 :   Lpr = gel(hf,1);
    1638          84 :   hf = gel(hf,2);
    1639          84 :   ram = cgetg(r1+lg(Lpr), t_VEC);
    1640          84 :   count = 0;
    1641         280 :   for (i=1; i<=r1; i++)
    1642         196 :     if (hi[i]) {
    1643          91 :       count++;
    1644          91 :       gel(ram,count) = stoi(i);
    1645             :     }
    1646         273 :   for (i=1; i<lg(Lpr); i++)
    1647         189 :     if (hf[i]) {
    1648          77 :       count++;
    1649          77 :       gel(ram,count) = gel(Lpr,i);
    1650             :     }
    1651          84 :   setlg(ram, count+1);
    1652          84 :   return gerepilecopy(av, ram);
    1653             : }
    1654             : 
    1655             : /** OPERATIONS ON ELEMENTS operations.c **/
    1656             : 
    1657             : static long
    1658     1042694 : alg_model0(GEN al, GEN x)
    1659             : {
    1660     1042694 :   long t, N = alg_get_absdim(al), lx = lg(x), d, n, D, i;
    1661     1042694 :   if (typ(x) == t_MAT) return al_MATRIX;
    1662      996739 :   if (typ(x) != t_COL) return al_INVALID;
    1663      996676 :   if (N == 1) {
    1664        2667 :     if (lx != 2) return al_INVALID;
    1665        2646 :     switch(typ(gel(x,1)))
    1666             :     {
    1667        1652 :       case t_INT: case t_FRAC: return al_TRIVIAL; /* cannot distinguish basis and alg from size */
    1668         994 :       case t_POL: case t_POLMOD: return al_ALGEBRAIC;
    1669           0 :       default: return al_INVALID;
    1670             :     }
    1671             :   }
    1672             : 
    1673      994009 :   switch(alg_type(al)) {
    1674      549635 :     case al_TABLE:
    1675      549635 :       if (lx != N+1) return al_INVALID;
    1676      549614 :       return al_BASIS;
    1677      358330 :     case al_CYCLIC:
    1678      358330 :       d = alg_get_degree(al);
    1679      358330 :       if (lx == N+1) return al_BASIS;
    1680      100443 :       if (lx == d+1) return al_ALGEBRAIC;
    1681          14 :       return al_INVALID;
    1682       86044 :     case al_CSA:
    1683       86044 :       D = alg_get_dim(al);
    1684       86044 :       n = nf_get_degree(alg_get_center(al));
    1685       86044 :       if (n == 1) {
    1686        1302 :         if (lx != D+1) return al_INVALID;
    1687        3871 :         for (i=1; i<=D; i++) {
    1688        3227 :           t = typ(gel(x,i));
    1689        3227 :           if (t == t_POL || t == t_POLMOD)  return al_ALGEBRAIC;
    1690             :             /* TODO t_COL for coefficients in basis form ? */
    1691             :         }
    1692         644 :         return al_BASIS;
    1693             :       }
    1694             :       else {
    1695       84742 :         if (lx == N+1) return al_BASIS;
    1696       23135 :         if (lx == D+1) return al_ALGEBRAIC;
    1697           0 :         return al_INVALID;
    1698             :       }
    1699             :   }
    1700             :   return al_INVALID; /* LCOV_EXCL_LINE */
    1701             : }
    1702             : 
    1703             : static void
    1704     1042568 : checkalgx(GEN x, long model)
    1705             : {
    1706             :   long t, i;
    1707     1042568 :   switch(model) {
    1708      869752 :     case al_BASIS:
    1709     9175857 :       for (i=1; i<lg(x); i++) {
    1710     8306112 :         t = typ(gel(x,i));
    1711     8306112 :         if (t != t_INT && t != t_FRAC)
    1712           7 :           pari_err_TYPE("checkalgx", gel(x,i));
    1713             :       }
    1714      869745 :       return;
    1715      126861 :     case al_TRIVIAL:
    1716             :     case al_ALGEBRAIC:
    1717      443499 :       for (i=1; i<lg(x); i++) {
    1718      316645 :         t = typ(gel(x,i));
    1719      316645 :         if (t != t_INT && t != t_FRAC && t != t_POL && t != t_POLMOD)
    1720             :           /* TODO t_COL ? */
    1721           7 :           pari_err_TYPE("checkalgx", gel(x,i));
    1722             :       }
    1723      126854 :       return;
    1724             :   }
    1725             : }
    1726             : 
    1727             : long
    1728     1042694 : alg_model(GEN al, GEN x)
    1729             : {
    1730     1042694 :   long res = alg_model0(al, x);
    1731     1042694 :   if (res == al_INVALID) pari_err_TYPE("alg_model", x);
    1732     1042568 :   checkalgx(x, res); return res;
    1733             : }
    1734             : 
    1735             : static GEN
    1736         518 : alC_add_i(GEN al, GEN x, GEN y, long lx)
    1737             : {
    1738         518 :   GEN A = cgetg(lx, t_COL);
    1739             :   long i;
    1740        1554 :   for (i=1; i<lx; i++) gel(A,i) = algadd(al, gel(x,i), gel(y,i));
    1741         518 :   return A;
    1742             : }
    1743             : static GEN
    1744         280 : alM_add(GEN al, GEN x, GEN y)
    1745             : {
    1746         280 :   long lx = lg(x), l, j;
    1747             :   GEN z;
    1748         280 :   if (lg(y) != lx) pari_err_DIM("alM_add (rows)");
    1749         273 :   if (lx == 1) return cgetg(1, t_MAT);
    1750         266 :   z = cgetg(lx, t_MAT); l = lgcols(x);
    1751         266 :   if (lgcols(y) != l) pari_err_DIM("alM_add (columns)");
    1752         777 :   for (j = 1; j < lx; j++) gel(z,j) = alC_add_i(al, gel(x,j), gel(y,j), l);
    1753         259 :   return z;
    1754             : }
    1755             : GEN
    1756       36974 : algadd(GEN al, GEN x, GEN y)
    1757             : {
    1758       36974 :   pari_sp av = avma;
    1759             :   long tx, ty;
    1760             :   GEN p;
    1761       36974 :   checkalg(al);
    1762       36974 :   tx = alg_model(al,x);
    1763       36967 :   ty = alg_model(al,y);
    1764       36967 :   p = alg_get_char(al);
    1765       36967 :   if (signe(p)) return FpC_add(x,y,p);
    1766       36834 :   if (tx==ty) {
    1767       36022 :     if (tx!=al_MATRIX) return gadd(x,y);
    1768         280 :     return gerepilecopy(av, alM_add(al,x,y));
    1769             :   }
    1770         812 :   if (tx==al_ALGEBRAIC) x = algalgtobasis(al,x);
    1771         812 :   if (ty==al_ALGEBRAIC) y = algalgtobasis(al,y);
    1772         812 :   return gerepileupto(av, gadd(x,y));
    1773             : }
    1774             : 
    1775             : GEN
    1776         147 : algneg(GEN al, GEN x) { checkalg(al); (void)alg_model(al,x); return gneg(x); }
    1777             : 
    1778             : static GEN
    1779         210 : alC_sub_i(GEN al, GEN x, GEN y, long lx)
    1780             : {
    1781             :   long i;
    1782         210 :   GEN A = cgetg(lx, t_COL);
    1783         630 :   for (i=1; i<lx; i++) gel(A,i) = algsub(al, gel(x,i), gel(y,i));
    1784         210 :   return A;
    1785             : }
    1786             : static GEN
    1787         126 : alM_sub(GEN al, GEN x, GEN y)
    1788             : {
    1789         126 :   long lx = lg(x), l, j;
    1790             :   GEN z;
    1791         126 :   if (lg(y) != lx) pari_err_DIM("alM_sub (rows)");
    1792         119 :   if (lx == 1) return cgetg(1, t_MAT);
    1793         112 :   z = cgetg(lx, t_MAT); l = lgcols(x);
    1794         112 :   if (lgcols(y) != l) pari_err_DIM("alM_sub (columns)");
    1795         315 :   for (j = 1; j < lx; j++) gel(z,j) = alC_sub_i(al, gel(x,j), gel(y,j), l);
    1796         105 :   return z;
    1797             : }
    1798             : GEN
    1799         966 : algsub(GEN al, GEN x, GEN y)
    1800             : {
    1801             :   long tx, ty;
    1802         966 :   pari_sp av = avma;
    1803             :   GEN p;
    1804         966 :   checkalg(al);
    1805         966 :   tx = alg_model(al,x);
    1806         959 :   ty = alg_model(al,y);
    1807         959 :   p = alg_get_char(al);
    1808         959 :   if (signe(p)) return FpC_sub(x,y,p);
    1809         868 :   if (tx==ty) {
    1810         546 :     if (tx != al_MATRIX) return gsub(x,y);
    1811         126 :     return gerepilecopy(av, alM_sub(al,x,y));
    1812             :   }
    1813         322 :   if (tx==al_ALGEBRAIC) x = algalgtobasis(al,x);
    1814         322 :   if (ty==al_ALGEBRAIC) y = algalgtobasis(al,y);
    1815         322 :   return gerepileupto(av, gsub(x,y));
    1816             : }
    1817             : 
    1818             : static GEN
    1819        1659 : algalgmul_cyc(GEN al, GEN x, GEN y)
    1820             : {
    1821        1659 :   pari_sp av = avma;
    1822        1659 :   long n = alg_get_degree(al), i, k;
    1823             :   GEN xalg, yalg, res, rnf, auts, sum, b, prod, autx;
    1824        1659 :   rnf = alg_get_splittingfield(al);
    1825        1659 :   auts = alg_get_auts(al);
    1826        1659 :   b = alg_get_b(al);
    1827             : 
    1828        1659 :   xalg = cgetg(n+1, t_COL);
    1829        4935 :   for (i=0; i<n; i++)
    1830        3276 :     gel(xalg,i+1) = lift_shallow(rnfbasistoalg(rnf,gel(x,i+1)));
    1831             : 
    1832        1659 :   yalg = cgetg(n+1, t_COL);
    1833        4935 :   for (i=0; i<n; i++) gel(yalg,i+1) = rnfbasistoalg(rnf,gel(y,i+1));
    1834             : 
    1835        1659 :   res = cgetg(n+1,t_COL);
    1836        4935 :   for (k=0; k<n; k++) {
    1837        3276 :     gel(res,k+1) = gmul(gel(xalg,k+1),gel(yalg,1));
    1838        5166 :     for (i=1; i<=k; i++) {
    1839        1890 :       autx = poleval(gel(xalg,k-i+1),gel(auts,i));
    1840        1890 :       prod = gmul(autx,gel(yalg,i+1));
    1841        1890 :       gel(res,k+1) = gadd(gel(res,k+1), prod);
    1842             :     }
    1843             : 
    1844        3276 :     sum = gen_0;
    1845        5166 :     for (; i<n; i++) {
    1846        1890 :       autx = poleval(gel(xalg,k+n-i+1),gel(auts,i));
    1847        1890 :       prod = gmul(autx,gel(yalg,i+1));
    1848        1890 :       sum = gadd(sum,prod);
    1849             :     }
    1850        3276 :     sum = gmul(b,sum);
    1851             : 
    1852        3276 :     gel(res,k+1) = gadd(gel(res,k+1),sum);
    1853             :   }
    1854             : 
    1855        1659 :   return gerepilecopy(av, res);
    1856             : }
    1857             : 
    1858             : static GEN
    1859      203763 : _tablemul(GEN mt, GEN x, GEN y)
    1860             : {
    1861      203763 :   pari_sp av = avma;
    1862      203763 :   long D = lg(mt)-1, i;
    1863      203763 :   GEN res = NULL;
    1864     1906905 :   for (i=1; i<=D; i++) {
    1865     1703142 :     GEN c = gel(x,i);
    1866     1703142 :     if (!gequal0(c)) {
    1867      988876 :       GEN My = RgM_RgC_mul(gel(mt,i),y);
    1868      988876 :       GEN t = RgC_Rg_mul(My,c);
    1869      988876 :       res = res? RgC_add(res,t): t;
    1870             :     }
    1871             :   }
    1872      203763 :   if (!res) { set_avma(av); return zerocol(D); }
    1873      202860 :   return gerepileupto(av, res);
    1874             : }
    1875             : 
    1876             : static GEN
    1877      189752 : _tablemul_Fp(GEN mt, GEN x, GEN y, GEN p)
    1878             : {
    1879      189752 :   pari_sp av = avma;
    1880      189752 :   long D = lg(mt)-1, i;
    1881      189752 :   GEN res = NULL;
    1882     2237988 :   for (i=1; i<=D; i++) {
    1883     2048236 :     GEN c = gel(x,i);
    1884     2048236 :     if (signe(c)) {
    1885      325370 :       GEN My = FpM_FpC_mul(gel(mt,i),y,p);
    1886      325370 :       GEN t = FpC_Fp_mul(My,c,p);
    1887      325370 :       res = res? FpC_add(res,t,p): t;
    1888             :     }
    1889             :   }
    1890      189752 :   if (!res) { set_avma(av); return zerocol(D); }
    1891      189213 :   return gerepileupto(av, res);
    1892             : }
    1893             : 
    1894             : /* x*ej */
    1895             : static GEN
    1896       99512 : _tablemul_ej(GEN mt, GEN x, long j)
    1897             : {
    1898       99512 :   pari_sp av = avma;
    1899       99512 :   long D = lg(mt)-1, i;
    1900       99512 :   GEN res = NULL;
    1901     1561861 :   for (i=1; i<=D; i++) {
    1902     1462349 :     GEN c = gel(x,i);
    1903     1462349 :     if (!gequal0(c)) {
    1904      114023 :       GEN My = gel(gel(mt,i),j);
    1905      114023 :       GEN t = RgC_Rg_mul(My,c);
    1906      114023 :       res = res? RgC_add(res,t): t;
    1907             :     }
    1908             :   }
    1909       99512 :   if (!res) { set_avma(av); return zerocol(D); }
    1910       99372 :   return gerepileupto(av, res);
    1911             : }
    1912             : static GEN
    1913      242039 : _tablemul_ej_Fp(GEN mt, GEN x, long j, GEN p)
    1914             : {
    1915      242039 :   pari_sp av = avma;
    1916      242039 :   long D = lg(mt)-1, i;
    1917      242039 :   GEN res = NULL;
    1918     4364787 :   for (i=1; i<=D; i++) {
    1919     4122748 :     GEN c = gel(x,i);
    1920     4122748 :     if (!gequal0(c)) {
    1921      289954 :       GEN My = gel(gel(mt,i),j);
    1922      289954 :       GEN t = FpC_Fp_mul(My,c,p);
    1923      289954 :       res = res? FpC_add(res,t,p): t;
    1924             :     }
    1925             :   }
    1926      242039 :   if (!res) { set_avma(av); return zerocol(D); }
    1927      241927 :   return gerepileupto(av, res);
    1928             : }
    1929             : 
    1930             : static GEN
    1931      243523 : _tablemul_ej_Fl(GEN mt, GEN x, long j, ulong p)
    1932             : {
    1933      243523 :   pari_sp av = avma;
    1934      243523 :   long D = lg(mt)-1, i;
    1935      243523 :   GEN res = NULL;
    1936     3937416 :   for (i=1; i<=D; i++) {
    1937     3693893 :     ulong c = x[i];
    1938     3693893 :     if (c) {
    1939      385126 :       GEN My = gel(gel(mt,i),j);
    1940      385126 :       GEN t = Flv_Fl_mul(My,c, p);
    1941      385126 :       res = res? Flv_add(res,t, p): t;
    1942             :     }
    1943             :   }
    1944      243523 :   if (!res) { set_avma(av); return zero_Flv(D); }
    1945      243523 :   return gerepileupto(av, res);
    1946             : }
    1947             : 
    1948             : static GEN
    1949         686 : algalgmul_csa(GEN al, GEN x, GEN y)
    1950             : {
    1951         686 :   GEN z, nf = alg_get_center(al);
    1952             :   long i;
    1953         686 :   z = _tablemul(alg_get_relmultable(al), x, y);
    1954        2485 :   for (i=1; i<lg(z); i++)
    1955        1799 :     gel(z,i) = basistoalg(nf,gel(z,i));
    1956         686 :   return z;
    1957             : }
    1958             : 
    1959             : /* assumes x and y in algebraic form */
    1960             : static GEN
    1961        2345 : algalgmul(GEN al, GEN x, GEN y)
    1962             : {
    1963        2345 :   switch(alg_type(al))
    1964             :   {
    1965        1659 :     case al_CYCLIC: return algalgmul_cyc(al, x, y);
    1966         686 :     case al_CSA: return algalgmul_csa(al, x, y);
    1967             :   }
    1968             :   return NULL; /*LCOV_EXCL_LINE*/
    1969             : }
    1970             : 
    1971             : static GEN
    1972      392829 : algbasismul(GEN al, GEN x, GEN y)
    1973             : {
    1974      392829 :   GEN mt = alg_get_multable(al), p = alg_get_char(al);
    1975      392829 :   if (signe(p)) return _tablemul_Fp(mt, x, y, p);
    1976      203077 :   return _tablemul(mt, x, y);
    1977             : }
    1978             : 
    1979             : /* x[i,]*y. Assume lg(x) > 1 and 0 < i < lgcols(x) */
    1980             : static GEN
    1981       85001 : alMrow_alC_mul_i(GEN al, GEN x, GEN y, long i, long lx)
    1982             : {
    1983       85001 :   pari_sp av = avma;
    1984       85001 :   GEN c = algmul(al,gcoeff(x,i,1),gel(y,1)), ZERO;
    1985             :   long k;
    1986       85001 :   ZERO = zerocol(alg_get_absdim(al));
    1987      170002 :   for (k = 2; k < lx; k++)
    1988             :   {
    1989       85001 :     GEN t = algmul(al, gcoeff(x,i,k), gel(y,k));
    1990       85001 :     if (!gequal(t,ZERO)) c = algadd(al, c, t);
    1991             :   }
    1992       85001 :   return gerepilecopy(av, c);
    1993             : }
    1994             : /* return x * y, 1 < lx = lg(x), l = lgcols(x) */
    1995             : static GEN
    1996       42518 : alM_alC_mul_i(GEN al, GEN x, GEN y, long lx, long l)
    1997             : {
    1998       42518 :   GEN z = cgetg(l,t_COL);
    1999             :   long i;
    2000      127519 :   for (i=1; i<l; i++) gel(z,i) = alMrow_alC_mul_i(al,x,y,i,lx);
    2001       42518 :   return z;
    2002             : }
    2003             : static GEN
    2004       21336 : alM_mul(GEN al, GEN x, GEN y)
    2005             : {
    2006       21336 :   long j, l, lx=lg(x), ly=lg(y);
    2007             :   GEN z;
    2008       21336 :   if (ly==1) return cgetg(1,t_MAT);
    2009       21287 :   if (lx != lgcols(y)) pari_err_DIM("alM_mul");
    2010       21266 :   if (lx==1) return zeromat(0, ly-1);
    2011       21259 :   l = lgcols(x); z = cgetg(ly,t_MAT);
    2012       63777 :   for (j=1; j<ly; j++) gel(z,j) = alM_alC_mul_i(al,x,gel(y,j),lx,l);
    2013       21259 :   return z;
    2014             : }
    2015             : 
    2016             : GEN
    2017      365088 : algmul(GEN al, GEN x, GEN y)
    2018             : {
    2019      365088 :   pari_sp av = avma;
    2020             :   long tx, ty;
    2021      365088 :   checkalg(al);
    2022      365088 :   tx = alg_model(al,x);
    2023      365074 :   ty = alg_model(al,y);
    2024      365074 :   if (tx==al_MATRIX) {
    2025       20832 :     if (ty==al_MATRIX) return alM_mul(al,x,y);
    2026           7 :     pari_err_TYPE("algmul", y);
    2027             :   }
    2028      344242 :   if (signe(alg_get_char(al))) return algbasismul(al,x,y);
    2029      203504 :   if (tx==al_TRIVIAL) retmkcol(gmul(gel(x,1),gel(y,1)));
    2030      203399 :   if (tx==al_ALGEBRAIC && ty==al_ALGEBRAIC) return algalgmul(al,x,y);
    2031      201873 :   if (tx==al_ALGEBRAIC) x = algalgtobasis(al,x);
    2032      201873 :   if (ty==al_ALGEBRAIC) y = algalgtobasis(al,y);
    2033      201873 :   return gerepileupto(av,algbasismul(al,x,y));
    2034             : }
    2035             : 
    2036             : GEN
    2037       48790 : algsqr(GEN al, GEN x)
    2038             : {
    2039       48790 :   pari_sp av = avma;
    2040             :   long tx;
    2041       48790 :   checkalg(al);
    2042       48755 :   tx = alg_model(al,x);
    2043       48699 :   if (tx==al_MATRIX) return gerepilecopy(av,alM_mul(al,x,x));
    2044       48188 :   if (signe(alg_get_char(al))) return algbasismul(al,x,x);
    2045        2205 :   if (tx==al_TRIVIAL) retmkcol(gsqr(gel(x,1)));
    2046        2023 :   if (tx==al_ALGEBRAIC) return algalgmul(al,x,x);
    2047        1204 :   return gerepileupto(av,algbasismul(al,x,x));
    2048             : }
    2049             : 
    2050             : static GEN
    2051        8099 : algmtK2Z_cyc(GEN al, GEN m)
    2052             : {
    2053        8099 :   pari_sp av = avma;
    2054        8099 :   GEN nf = alg_get_abssplitting(al), res, mt, rnf = alg_get_splittingfield(al), c, dc;
    2055        8099 :   long n = alg_get_degree(al), N = nf_get_degree(nf), Nn, i, j, i1, j1;
    2056        8099 :   Nn = N*n;
    2057        8099 :   res = zeromatcopy(Nn,Nn);
    2058       38150 :   for (i=0; i<n; i++)
    2059      186242 :   for (j=0; j<n; j++) {
    2060      156191 :     c = gcoeff(m,i+1,j+1);
    2061      156191 :     if (!gequal0(c)) {
    2062       30051 :       c = rnfeltreltoabs(rnf,c);
    2063       30051 :       c = algtobasis(nf,c);
    2064       30051 :       c = Q_remove_denom(c,&dc);
    2065       30051 :       mt = zk_multable(nf,c);
    2066       30051 :       if (dc) mt = ZM_Z_div(mt,dc);
    2067      270634 :       for (i1=1; i1<=N; i1++)
    2068     2529646 :       for (j1=1; j1<=N; j1++)
    2069     2289063 :         gcoeff(res,i*N+i1,j*N+j1) = gcoeff(mt,i1,j1);
    2070             :     }
    2071             :   }
    2072        8099 :   return gerepilecopy(av,res);
    2073             : }
    2074             : 
    2075             : static GEN
    2076         861 : algmtK2Z_csa(GEN al, GEN m)
    2077             : {
    2078         861 :   pari_sp av = avma;
    2079         861 :   GEN nf = alg_get_center(al), res, mt, c, dc;
    2080         861 :   long d2 = alg_get_dim(al), n = nf_get_degree(nf), D, i, j, i1, j1;
    2081         861 :   D = d2*n;
    2082         861 :   res = zeromatcopy(D,D);
    2083        5082 :   for (i=0; i<d2; i++)
    2084       29442 :   for (j=0; j<d2; j++) {
    2085       25221 :     c = gcoeff(m,i+1,j+1);
    2086       25221 :     if (!gequal0(c)) {
    2087        3360 :       c = algtobasis(nf,c);
    2088        3360 :       c = Q_remove_denom(c,&dc);
    2089        3360 :       mt = zk_multable(nf,c);
    2090        3360 :       if (dc) mt = ZM_Z_div(mt,dc);
    2091       11550 :       for (i1=1; i1<=n; i1++)
    2092       29736 :       for (j1=1; j1<=n; j1++)
    2093       21546 :         gcoeff(res,i*n+i1,j*n+j1) = gcoeff(mt,i1,j1);
    2094             :     }
    2095             :   }
    2096         861 :   return gerepilecopy(av,res);
    2097             : }
    2098             : 
    2099             : /* assumes al is a CSA or CYCLIC */
    2100             : static GEN
    2101        8960 : algmtK2Z(GEN al, GEN m)
    2102             : {
    2103        8960 :   switch(alg_type(al))
    2104             :   {
    2105        8099 :     case al_CYCLIC: return algmtK2Z_cyc(al, m);
    2106         861 :     case al_CSA: return algmtK2Z_csa(al, m);
    2107             :   }
    2108             :   return NULL; /*LCOV_EXCL_LINE*/
    2109             : }
    2110             : 
    2111             : /* left multiplication table, as a vector space of dimension n over the splitting field (by right multiplication) */
    2112             : static GEN
    2113       10717 : algalgmultable_cyc(GEN al, GEN x)
    2114             : {
    2115       10717 :   pari_sp av = avma;
    2116       10717 :   long n = alg_get_degree(al), i, j;
    2117             :   GEN res, rnf, auts, b, pol;
    2118       10717 :   rnf = alg_get_splittingfield(al);
    2119       10717 :   auts = alg_get_auts(al);
    2120       10717 :   b = alg_get_b(al);
    2121       10717 :   pol = rnf_get_pol(rnf);
    2122             : 
    2123       10717 :   res = zeromatcopy(n,n);
    2124       46074 :   for (i=0; i<n; i++)
    2125       35357 :     gcoeff(res,i+1,1) = lift_shallow(rnfbasistoalg(rnf,gel(x,i+1)));
    2126             : 
    2127       46074 :   for (i=0; i<n; i++) {
    2128      101423 :     for (j=1; j<=i; j++)
    2129       66066 :       gcoeff(res,i+1,j+1) = gmodulo(poleval(gcoeff(res,i-j+1,1),gel(auts,j)),pol);
    2130      101423 :     for (; j<n; j++)
    2131       66066 :       gcoeff(res,i+1,j+1) = gmodulo(gmul(b,poleval(gcoeff(res,n+i-j+1,1),gel(auts,j))), pol);
    2132             :   }
    2133             : 
    2134       46074 :   for (i=0; i<n; i++)
    2135       35357 :     gcoeff(res,i+1,1) = gmodulo(gcoeff(res,i+1,1),pol);
    2136             : 
    2137       10717 :   return gerepilecopy(av, res);
    2138             : }
    2139             : 
    2140             : static GEN
    2141        1309 : elementmultable(GEN mt, GEN x)
    2142             : {
    2143        1309 :   pari_sp av = avma;
    2144        1309 :   long D = lg(mt)-1, i;
    2145        1309 :   GEN z = NULL;
    2146        7028 :   for (i=1; i<=D; i++)
    2147             :   {
    2148        5719 :     GEN c = gel(x,i);
    2149        5719 :     if (!gequal0(c))
    2150             :     {
    2151        2079 :       GEN M = RgM_Rg_mul(gel(mt,i),c);
    2152        2079 :       z = z? RgM_add(z, M): M;
    2153             :     }
    2154             :   }
    2155        1309 :   if (!z) { set_avma(av); return zeromatcopy(D,D); }
    2156        1309 :   return gerepileupto(av, z);
    2157             : }
    2158             : /* mt a t_VEC of Flm modulo m */
    2159             : static GEN
    2160       24472 : algbasismultable_Flm(GEN mt, GEN x, ulong m)
    2161             : {
    2162       24472 :   pari_sp av = avma;
    2163       24472 :   long D = lg(gel(mt,1))-1, i;
    2164       24472 :   GEN z = NULL;
    2165      267995 :   for (i=1; i<=D; i++)
    2166             :   {
    2167      243523 :     ulong c = x[i];
    2168      243523 :     if (c)
    2169             :     {
    2170       33362 :       GEN M = Flm_Fl_mul(gel(mt,i),c, m);
    2171       33362 :       z = z? Flm_add(z, M, m): M;
    2172             :     }
    2173             :   }
    2174       24472 :   if (!z) { set_avma(av); return zero_Flm(D,D); }
    2175       24472 :   return gerepileupto(av, z);
    2176             : }
    2177             : static GEN
    2178      218838 : elementabsmultable_Z(GEN mt, GEN x)
    2179             : {
    2180      218838 :   long i, l = lg(x);
    2181      218838 :   GEN z = NULL;
    2182     2328742 :   for (i = 1; i < l; i++)
    2183             :   {
    2184     2109904 :     GEN c = gel(x,i);
    2185     2109904 :     if (signe(c))
    2186             :     {
    2187      792811 :       GEN M = ZM_Z_mul(gel(mt,i),c);
    2188      792811 :       z = z? ZM_add(z, M): M;
    2189             :     }
    2190             :   }
    2191      218838 :   return z;
    2192             : }
    2193             : static GEN
    2194      114443 : elementabsmultable(GEN mt, GEN x)
    2195             : {
    2196      114443 :   GEN d, z = elementabsmultable_Z(mt, Q_remove_denom(x,&d));
    2197      114443 :   return (z && d)? ZM_Z_div(z, d): z;
    2198             : }
    2199             : static GEN
    2200      104395 : elementabsmultable_Fp(GEN mt, GEN x, GEN p)
    2201             : {
    2202      104395 :   GEN z = elementabsmultable_Z(mt, x);
    2203      104395 :   return z? FpM_red(z, p): z;
    2204             : }
    2205             : static GEN
    2206      218838 : algbasismultable(GEN al, GEN x)
    2207             : {
    2208      218838 :   pari_sp av = avma;
    2209      218838 :   GEN z, p = alg_get_char(al), mt = alg_get_multable(al);
    2210      218838 :   z = signe(p)? elementabsmultable_Fp(mt, x, p): elementabsmultable(mt, x);
    2211      218838 :   if (!z)
    2212             :   {
    2213         754 :     long D = lg(mt)-1;
    2214         754 :     set_avma(av); return zeromat(D,D);
    2215             :   }
    2216      218084 :   return gerepileupto(av, z);
    2217             : }
    2218             : 
    2219             : static GEN
    2220        1309 : algalgmultable_csa(GEN al, GEN x)
    2221             : {
    2222        1309 :   GEN nf = alg_get_center(al), m;
    2223             :   long i,j;
    2224        1309 :   m = elementmultable(alg_get_relmultable(al), x);
    2225        7028 :   for (i=1; i<lg(m); i++)
    2226       36638 :     for(j=1; j<lg(m); j++)
    2227       30919 :       gcoeff(m,i,j) = basistoalg(nf,gcoeff(m,i,j));
    2228        1309 :   return m;
    2229             : }
    2230             : 
    2231             : /* assumes x in algebraic form */
    2232             : static GEN
    2233       11732 : algalgmultable(GEN al, GEN x)
    2234             : {
    2235       11732 :   switch(alg_type(al))
    2236             :   {
    2237       10717 :     case al_CYCLIC: return algalgmultable_cyc(al, x);
    2238        1015 :     case al_CSA: return algalgmultable_csa(al, x);
    2239             :   }
    2240             :   return NULL; /*LCOV_EXCL_LINE*/
    2241             : }
    2242             : 
    2243             : /* on the natural basis */
    2244             : /* assumes x in algebraic form */
    2245             : static GEN
    2246        8960 : algZmultable(GEN al, GEN x) {
    2247        8960 :   pari_sp av = avma;
    2248        8960 :   GEN res = NULL, x0;
    2249        8960 :   long tx = alg_model(al,x);
    2250        8960 :   switch(tx) {
    2251           0 :     case al_TRIVIAL:
    2252           0 :       x0 = gel(x,1);
    2253           0 :       if (typ(x0)==t_POLMOD) x0 = gel(x0,2);
    2254           0 :       if (typ(x0)==t_POL) x0 = constant_coeff(x0);
    2255           0 :       res = mkmatcopy(mkcol(x0));
    2256           0 :       break;
    2257        8960 :     case al_ALGEBRAIC: res = algmtK2Z(al,algalgmultable(al,x)); break;
    2258             :   }
    2259        8960 :   return gerepileupto(av,res);
    2260             : }
    2261             : 
    2262             : /* x integral */
    2263             : static GEN
    2264       36561 : algbasisrightmultable(GEN al, GEN x)
    2265             : {
    2266       36561 :   long N = alg_get_absdim(al), i,j,k;
    2267       36561 :   GEN res = zeromatcopy(N,N), c, mt = alg_get_multable(al), p = alg_get_char(al);
    2268       36561 :   if (gequal0(p)) p = NULL;
    2269      330862 :   for (i=1; i<=N; i++) {
    2270      294301 :     c = gel(x,i);
    2271      294301 :     if (!gequal0(c)) {
    2272      872200 :       for (j=1; j<=N; j++)
    2273     7417690 :       for(k=1; k<=N; k++) {
    2274     6639682 :         if (p) gcoeff(res,k,j) = Fp_add(gcoeff(res,k,j), Fp_mul(c, gcoeff(gel(mt,j),k,i), p), p);
    2275     5014814 :         else gcoeff(res,k,j) = addii(gcoeff(res,k,j), mulii(c, gcoeff(gel(mt,j),k,i)));
    2276             :       }
    2277             :     }
    2278             :   }
    2279       36561 :   return res;
    2280             : }
    2281             : 
    2282             : /* basis for matrices : 1, E_{i,j} for (i,j)!=(1,1) */
    2283             : /* index : ijk = ((i-1)*N+j-1)*n + k */
    2284             : /* square matrices only, coefficients in basis form, shallow function */
    2285             : static GEN
    2286       20097 : algmat2basis(GEN al, GEN M)
    2287             : {
    2288       20097 :   long n = alg_get_absdim(al), N = lg(M)-1, i, j, k, ij, ijk;
    2289             :   GEN res, x;
    2290       20097 :   res = zerocol(N*N*n);
    2291       60291 :   for (i=1; i<=N; i++) {
    2292      120582 :     for (j=1, ij=(i-1)*N+1; j<=N; j++, ij++) {
    2293       80388 :       x = gcoeff(M,i,j);
    2294      660772 :       for (k=1, ijk=(ij-1)*n+1; k<=n; k++, ijk++) {
    2295      580384 :         gel(res, ijk) = gel(x, k);
    2296      580384 :         if (i>1 && i==j) gel(res, ijk) = gsub(gel(res,ijk), gel(res,k));
    2297             :       }
    2298             :     }
    2299             :   }
    2300             : 
    2301       20097 :   return res;
    2302             : }
    2303             : 
    2304             : static GEN
    2305         294 : algbasis2mat(GEN al, GEN M, long N)
    2306             : {
    2307         294 :   long n = alg_get_absdim(al), i, j, k, ij, ijk;
    2308             :   GEN res, x;
    2309         294 :   res = zeromatcopy(N,N);
    2310         882 :   for (i=1; i<=N; i++)
    2311        1764 :   for (j=1; j<=N; j++)
    2312        1176 :     gcoeff(res,i,j) = zerocol(n);
    2313             : 
    2314         882 :   for (i=1; i<=N; i++) {
    2315        1764 :     for (j=1, ij=(i-1)*N+1; j<=N; j++, ij++) {
    2316        1176 :       x = gcoeff(res,i,j);
    2317        9240 :       for (k=1, ijk=(ij-1)*n+1; k<=n; k++, ijk++) {
    2318        8064 :         gel(x,k) = gel(M,ijk);
    2319        8064 :         if (i>1 && i==j) gel(x,k) = gadd(gel(x,k), gel(M,k));
    2320             :       }
    2321             :     }
    2322             :   }
    2323             : 
    2324         294 :   return res;
    2325             : }
    2326             : 
    2327             : static GEN
    2328       20020 : algmatbasis_ei(GEN al, long ijk, long N)
    2329             : {
    2330       20020 :   long n = alg_get_absdim(al), i, j, k, ij;
    2331             :   GEN res;
    2332             : 
    2333       20020 :   res = zeromatcopy(N,N);
    2334       60060 :   for (i=1; i<=N; i++)
    2335      120120 :   for (j=1; j<=N; j++)
    2336       80080 :     gcoeff(res,i,j) = zerocol(n);
    2337             : 
    2338       20020 :   k = ijk%n;
    2339       20020 :   if (k==0) k=n;
    2340       20020 :   ij = (ijk-k)/n+1;
    2341             : 
    2342       20020 :   if (ij==1) {
    2343       15015 :     for (i=1; i<=N; i++)
    2344       10010 :       gcoeff(res,i,i) = col_ei(n,k);
    2345        5005 :     return res;
    2346             :   }
    2347             : 
    2348       15015 :   j = ij%N;
    2349       15015 :   if (j==0) j=N;
    2350       15015 :   i = (ij-j)/N+1;
    2351             : 
    2352       15015 :   gcoeff(res,i,j) = col_ei(n,k);
    2353       15015 :   return res;
    2354             : }
    2355             : 
    2356             : /* FIXME lazy implementation! */
    2357             : static GEN
    2358         777 : algleftmultable_mat(GEN al, GEN M)
    2359             : {
    2360         777 :   long N = lg(M)-1, n = alg_get_absdim(al), D = N*N*n, j;
    2361             :   GEN res, x, Mx;
    2362         777 :   if (N == 0) return cgetg(1, t_MAT);
    2363         770 :   if (N != nbrows(M)) pari_err_DIM("algleftmultable_mat (nonsquare)");
    2364         749 :   res = cgetg(D+1, t_MAT);
    2365       20769 :   for (j=1; j<=D; j++) {
    2366       20020 :     x = algmatbasis_ei(al, j, N);
    2367       20020 :     Mx = algmul(al, M, x);
    2368       20020 :     gel(res, j) = algmat2basis(al, Mx);
    2369             :   }
    2370         749 :   return res;
    2371             : }
    2372             : 
    2373             : /* left multiplication table on integral basis */
    2374             : static GEN
    2375        6951 : algleftmultable(GEN al, GEN x)
    2376             : {
    2377        6951 :   pari_sp av = avma;
    2378             :   long tx;
    2379             :   GEN res;
    2380             : 
    2381        6951 :   checkalg(al);
    2382        6951 :   tx = alg_model(al,x);
    2383        6944 :   switch(tx) {
    2384          98 :     case al_TRIVIAL : res = mkmatcopy(mkcol(gel(x,1))); break;
    2385         196 :     case al_ALGEBRAIC : x = algalgtobasis(al,x);
    2386        6328 :     case al_BASIS : res = algbasismultable(al,x); break;
    2387         518 :     case al_MATRIX : res = algleftmultable_mat(al,x); break;
    2388             :     default : return NULL; /* LCOV_EXCL_LINE */
    2389             :   }
    2390        6937 :   return gerepileupto(av,res);
    2391             : }
    2392             : 
    2393             : static GEN
    2394        4102 : algbasissplittingmatrix_csa(GEN al, GEN x)
    2395             : {
    2396        4102 :   long d = alg_get_degree(al), i, j;
    2397        4102 :   GEN rnf = alg_get_splittingfield(al), splba = alg_get_splittingbasis(al), splbainv = alg_get_splittingbasisinv(al), M;
    2398        4102 :   M = algbasismultable(al,x);
    2399        4102 :   M = RgM_mul(M, splba); /* TODO best order ? big matrix /Q vs small matrix /nf */
    2400        4102 :   M = RgM_mul(splbainv, M);
    2401       12131 :   for (i=1; i<=d; i++)
    2402       23912 :   for (j=1; j<=d; j++)
    2403       15883 :     gcoeff(M,i,j) = rnfeltabstorel(rnf, gcoeff(M,i,j));
    2404        4102 :   return M;
    2405             : }
    2406             : 
    2407             : GEN
    2408        7399 : algtomatrix(GEN al, GEN x, long abs)
    2409             : {
    2410        7399 :   pari_sp av = avma;
    2411        7399 :   GEN res = NULL;
    2412             :   long ta, tx, i, j;
    2413        7399 :   checkalg(al);
    2414        7399 :   ta = alg_type(al);
    2415        7399 :   if (abs || ta==al_TABLE) return algleftmultable(al,x);
    2416        6622 :   tx = alg_model(al,x);
    2417        6622 :   if (tx==al_MATRIX) {
    2418         469 :     if (lg(x) == 1) return cgetg(1, t_MAT);
    2419         441 :     res = zeromatcopy(nbrows(x),lg(x)-1);
    2420        1323 :     for (j=1; j<lg(x); j++)
    2421        2618 :     for (i=1; i<lgcols(x); i++)
    2422        1736 :       gcoeff(res,i,j) = algtomatrix(al,gcoeff(x,i,j),0);
    2423         441 :     res = shallowmatconcat(res);
    2424             :   }
    2425        6153 :   else switch(alg_type(al))
    2426             :   {
    2427        2051 :     case al_CYCLIC:
    2428        2051 :       if (tx==al_BASIS) x = algbasistoalg(al,x);
    2429        2051 :       res = algalgmultable(al,x);
    2430        2051 :       break;
    2431        4102 :     case al_CSA:
    2432        4102 :       if (tx==al_ALGEBRAIC) x = algalgtobasis(al,x);
    2433        4102 :       res = algbasissplittingmatrix_csa(al,x);
    2434        4102 :       break;
    2435           0 :     default:
    2436           0 :       pari_err_DOMAIN("algtomatrix", "alg_type(al)", "=", stoi(alg_type(al)), stoi(alg_type(al)));
    2437             :   }
    2438        6594 :   return gerepilecopy(av,res);
    2439             : }
    2440             : 
    2441             : /*  x^(-1)*y, NULL if no solution */
    2442             : static GEN
    2443        1715 : algdivl_i(GEN al, GEN x, GEN y, long tx, long ty) {
    2444        1715 :   pari_sp av = avma;
    2445        1715 :   GEN res, p = alg_get_char(al), mtx;
    2446        1715 :   if (tx != ty) {
    2447         343 :     if (tx==al_ALGEBRAIC) { x = algalgtobasis(al,x); tx=al_BASIS; }
    2448         343 :     if (ty==al_ALGEBRAIC) { y = algalgtobasis(al,y); ty=al_BASIS; }
    2449             :   }
    2450        1715 :   if (ty == al_MATRIX)
    2451             :   {
    2452          77 :     if (alg_type(al) != al_TABLE) y = algalgtobasis(al,y);
    2453          77 :     y = algmat2basis(al,y);
    2454             :   }
    2455        1715 :   if (signe(p)) res = FpM_FpC_invimage(algbasismultable(al,x),y,p);
    2456             :   else
    2457             :   {
    2458        1526 :     if (ty==al_ALGEBRAIC)   mtx = algalgmultable(al,x);
    2459         819 :     else                    mtx = algleftmultable(al,x);
    2460        1526 :     res = inverseimage(mtx,y);
    2461             :   }
    2462        1715 :   if (!res || lg(res)==1) return gc_NULL(av);
    2463        1687 :   if (tx == al_MATRIX) {
    2464         294 :     res = algbasis2mat(al, res, lg(x)-1);
    2465         294 :     return gerepilecopy(av,res);
    2466             :   }
    2467        1393 :   return gerepileupto(av,res);
    2468             : }
    2469             : static GEN
    2470         721 : algdivl_i2(GEN al, GEN x, GEN y)
    2471             : {
    2472             :   long tx, ty;
    2473         721 :   checkalg(al);
    2474         721 :   tx = alg_model(al,x);
    2475         714 :   ty = alg_model(al,y);
    2476         714 :   if (tx == al_MATRIX) {
    2477         119 :     if (ty != al_MATRIX) pari_err_TYPE2("\\", x, y);
    2478         112 :     if (lg(y) == 1) return cgetg(1, t_MAT);
    2479         105 :     if (lg(x) == 1) return NULL;
    2480          98 :     if (lgcols(x) != lgcols(y)) pari_err_DIM("algdivl");
    2481          91 :     if (lg(x) != lgcols(x) || lg(y) != lgcols(y))
    2482          14 :       pari_err_DIM("algdivl (nonsquare)");
    2483             :   }
    2484         672 :   return algdivl_i(al,x,y,tx,ty);
    2485             : }
    2486             : 
    2487         672 : GEN algdivl(GEN al, GEN x, GEN y)
    2488             : {
    2489             :   GEN z;
    2490         672 :   z = algdivl_i2(al,x,y);
    2491         637 :   if (!z) pari_err_INV("algdivl", x);
    2492         623 :   return z;
    2493             : }
    2494             : 
    2495             : int
    2496          49 : algisdivl(GEN al, GEN x, GEN y, GEN* ptz)
    2497             : {
    2498          49 :   pari_sp av = avma;
    2499          49 :   GEN z = algdivl_i2(al,x,y);
    2500          49 :   if (!z) return gc_bool(av,0);
    2501          42 :   if (ptz != NULL) *ptz = z;
    2502          42 :   return 1;
    2503             : }
    2504             : 
    2505             : static GEN
    2506        1148 : alginv_i(GEN al, GEN x)
    2507             : {
    2508        1148 :   pari_sp av = avma;
    2509        1148 :   GEN res = NULL, p = alg_get_char(al);
    2510        1148 :   long tx = alg_model(al,x), n;
    2511        1127 :   switch(tx) {
    2512          63 :     case al_TRIVIAL :
    2513          63 :       if (signe(p)) { res = mkcol(Fp_inv(gel(x,1),p)); break; }
    2514          49 :       else          { res = mkcol(ginv(gel(x,1))); break; }
    2515         455 :     case al_ALGEBRAIC :
    2516         455 :       switch(alg_type(al)) {
    2517         350 :         case al_CYCLIC: n = alg_get_degree(al); break;
    2518         105 :         case al_CSA: n = alg_get_dim(al); break;
    2519             :         default: return NULL; /* LCOV_EXCL_LINE */
    2520             :       }
    2521         455 :       res = algdivl_i(al, x, col_ei(n,1), tx, al_ALGEBRAIC); break;
    2522         371 :     case al_BASIS : res = algdivl_i(al, x, col_ei(alg_get_absdim(al),1), tx,
    2523         371 :                                                             al_BASIS); break;
    2524         238 :     case al_MATRIX :
    2525         238 :       n = lg(x)-1;
    2526         238 :       if (n==0) return cgetg(1, t_MAT);
    2527         224 :       if (n != nbrows(x)) pari_err_DIM("alginv_i (nonsquare)");
    2528         217 :       res = algdivl_i(al, x, col_ei(n*n*alg_get_absdim(al),1), tx, al_BASIS);
    2529             :         /* cheat on type because wrong dimension */
    2530             :   }
    2531        1106 :   if (!res) return gc_NULL(av);
    2532        1092 :   return gerepilecopy(av,res);
    2533             : }
    2534             : GEN
    2535        1078 : alginv(GEN al, GEN x)
    2536             : {
    2537             :   GEN z;
    2538        1078 :   checkalg(al);
    2539        1078 :   z = alginv_i(al,x);
    2540        1050 :   if (!z) pari_err_INV("alginv", x);
    2541        1043 :   return z;
    2542             : }
    2543             : 
    2544             : int
    2545          70 : algisinv(GEN al, GEN x, GEN* ptix)
    2546             : {
    2547          70 :   pari_sp av = avma;
    2548             :   GEN ix;
    2549          70 :   checkalg(al);
    2550          70 :   ix = alginv_i(al,x);
    2551          70 :   if (!ix) return gc_bool(av,0);
    2552          63 :   if (ptix != NULL) *ptix = ix;
    2553          63 :   return 1;
    2554             : }
    2555             : 
    2556             : /*  x*y^(-1)  */
    2557             : GEN
    2558         406 : algdivr(GEN al, GEN x, GEN y) { return algmul(al, x, alginv(al, y)); }
    2559             : 
    2560       25144 : static GEN _mul(void* data, GEN x, GEN y) { return algmul((GEN)data,x,y); }
    2561       47698 : static GEN _sqr(void* data, GEN x) { return algsqr((GEN)data,x); }
    2562             : 
    2563             : static GEN
    2564          21 : algmatid(GEN al, long N)
    2565             : {
    2566          21 :   long n = alg_get_absdim(al), i, j;
    2567             :   GEN res, one, zero;
    2568             : 
    2569          21 :   res = zeromatcopy(N,N);
    2570          21 :   one = col_ei(n,1);
    2571          21 :   zero = zerocol(n);
    2572          49 :   for (i=1; i<=N; i++)
    2573          84 :   for (j=1; j<=N; j++)
    2574          56 :     gcoeff(res,i,j) = i==j ? one : zero;
    2575          21 :   return res;
    2576             : }
    2577             : 
    2578             : GEN
    2579       12208 : algpow(GEN al, GEN x, GEN n)
    2580             : {
    2581       12208 :   pari_sp av = avma;
    2582             :   GEN res;
    2583       12208 :   checkalg(al);
    2584       12208 :   switch(signe(n)) {
    2585          28 :     case 0:
    2586          28 :       if (alg_model(al,x) == al_MATRIX)
    2587          21 :         res = algmatid(al,lg(x)-1);
    2588             :       else
    2589           7 :         res = col_ei(alg_get_absdim(al),1);
    2590          28 :       return res;
    2591       12096 :     case 1:
    2592       12096 :       res = gen_pow_i(x, n, (void*)al, _sqr, _mul); break;
    2593          84 :     default: /* -1 */
    2594          84 :       res = gen_pow_i(alginv(al,x), gneg(n), (void*)al, _sqr, _mul);
    2595             :   }
    2596       12173 :   return gerepilecopy(av,res);
    2597             : }
    2598             : 
    2599             : static GEN
    2600         378 : algredcharpoly_i(GEN al, GEN x, long v)
    2601             : {
    2602         378 :   GEN rnf = alg_get_splittingfield(al);
    2603         378 :   GEN cp = charpoly(algtomatrix(al,x,0),v);
    2604         371 :   long i, m = lg(cp);
    2605        1540 :   for (i=2; i<m; i++) gel(cp,i) = rnfeltdown(rnf, gel(cp,i));
    2606         371 :   return cp;
    2607             : }
    2608             : 
    2609             : /* assumes al is CSA or CYCLIC */
    2610             : static GEN
    2611         385 : algredcharpoly(GEN al, GEN x, long v)
    2612             : {
    2613         385 :   pari_sp av = avma;
    2614         385 :   long w = gvar(rnf_get_pol(alg_get_center(al)));
    2615         385 :   if (varncmp(v,w)>=0) pari_err_PRIORITY("algredcharpoly",pol_x(v),">=",w);
    2616         378 :   switch(alg_type(al))
    2617             :   {
    2618         378 :     case al_CYCLIC:
    2619             :     case al_CSA:
    2620         378 :       return gerepileupto(av, algredcharpoly_i(al, x, v));
    2621             :   }
    2622             :   return NULL; /*LCOV_EXCL_LINE*/
    2623             : }
    2624             : 
    2625             : static GEN
    2626       20921 : algbasischarpoly(GEN al, GEN x, long v)
    2627             : {
    2628       20921 :   pari_sp av = avma;
    2629       20921 :   GEN p = alg_get_char(al), mx;
    2630       20921 :   if (alg_model(al,x) == al_MATRIX) mx = algleftmultable_mat(al,x);
    2631       20830 :   else                              mx = algbasismultable(al,x);
    2632       20914 :   if (signe(p)) {
    2633       19010 :     GEN res = FpM_charpoly(mx,p);
    2634       19010 :     setvarn(res,v);
    2635       19010 :     return gerepileupto(av, res);
    2636             :   }
    2637        1904 :   return gerepileupto(av, charpoly(mx,v));
    2638             : }
    2639             : 
    2640             : GEN
    2641       20991 : algcharpoly(GEN al, GEN x, long v, long abs)
    2642             : {
    2643       20991 :   checkalg(al);
    2644       20991 :   if (v<0) v=0;
    2645             : 
    2646             :   /* gneg(x[1]) left on stack */
    2647       20991 :   if (alg_model(al,x) == al_TRIVIAL) {
    2648          56 :     GEN p = alg_get_char(al);
    2649          56 :     if (signe(p)) return deg1pol(gen_1,Fp_neg(gel(x,1),p),v);
    2650          42 :     return deg1pol(gen_1,gneg(gel(x,1)),v);
    2651             :   }
    2652             : 
    2653       20928 :   switch(alg_type(al)) {
    2654         490 :     case al_CYCLIC: case al_CSA:
    2655         490 :       if (abs)
    2656             :       {
    2657         105 :         if (alg_model(al,x)==al_ALGEBRAIC) x = algalgtobasis(al,x);
    2658             :       }
    2659         385 :       else return algredcharpoly(al,x,v);
    2660       20543 :     case al_TABLE: return algbasischarpoly(al,x,v);
    2661             :     default : return NULL; /* LCOV_EXCL_LINE */
    2662             :   }
    2663             : }
    2664             : 
    2665             : /* assumes x in basis form */
    2666             : static GEN
    2667      235445 : algabstrace(GEN al, GEN x)
    2668             : {
    2669      235445 :   pari_sp av = avma;
    2670      235445 :   GEN res = NULL, p = alg_get_char(al);
    2671      235445 :   if (signe(p)) return FpV_dotproduct(x, alg_get_tracebasis(al), p);
    2672       42644 :   switch(alg_model(al,x)) {
    2673          84 :     case al_TRIVIAL: return gcopy(gel(x,1)); break;
    2674       42560 :     case al_BASIS: res = RgV_dotproduct(x, alg_get_tracebasis(al)); break;
    2675             :   }
    2676       42560 :   return gerepileupto(av,res);
    2677             : }
    2678             : 
    2679             : static GEN
    2680        1372 : algredtrace(GEN al, GEN x)
    2681             : {
    2682        1372 :   pari_sp av = avma;
    2683        1372 :   GEN res = NULL;
    2684        1372 :   switch(alg_model(al,x)) {
    2685          35 :     case al_TRIVIAL: return gcopy(gel(x,1)); break;
    2686         490 :     case al_BASIS: return algredtrace(al, algbasistoalg(al,x));
    2687             :                    /* TODO precompute too? */
    2688         847 :     case al_ALGEBRAIC:
    2689         847 :       switch(alg_type(al))
    2690             :       {
    2691         553 :         case al_CYCLIC:
    2692         553 :           res = rnfelttrace(alg_get_splittingfield(al),gel(x,1));
    2693         553 :           break;
    2694         294 :         case al_CSA:
    2695         294 :           res = gtrace(algalgmultable_csa(al,x));
    2696         294 :           res = gdiv(res, stoi(alg_get_degree(al)));
    2697         294 :           break;
    2698             :         default: return NULL; /* LCOV_EXCL_LINE */
    2699             :       }
    2700         847 :   }
    2701         847 :   return gerepileupto(av,res);
    2702             : }
    2703             : 
    2704             : static GEN
    2705         308 : algtrace_mat(GEN al, GEN M, long abs) {
    2706         308 :   pari_sp av = avma;
    2707         308 :   long N = lg(M)-1, i;
    2708         308 :   GEN res, p = alg_get_char(al);
    2709         308 :   if (N == 0) return gen_0;
    2710         294 :   if (N != nbrows(M)) pari_err_DIM("algtrace_mat (nonsquare)");
    2711             : 
    2712         287 :   if (!signe(p)) p = NULL;
    2713         287 :   res = algtrace(al, gcoeff(M,1,1), abs);
    2714         574 :   for (i=2; i<=N; i++) {
    2715         287 :     if (p)  res = Fp_add(res, algtrace(al,gcoeff(M,i,i),abs), p);
    2716         280 :     else    res = gadd(res, algtrace(al,gcoeff(M,i,i),abs));
    2717             :   }
    2718         287 :   if (abs || alg_type(al) == al_TABLE) res = gmulgs(res, N); /* absolute trace */
    2719         287 :   return gerepileupto(av, res);
    2720             : }
    2721             : 
    2722             : GEN
    2723        1519 : algtrace(GEN al, GEN x, long abs)
    2724             : {
    2725        1519 :   checkalg(al);
    2726        1519 :   if (alg_model(al,x) == al_MATRIX) return algtrace_mat(al,x,abs);
    2727        1211 :   switch(alg_type(al)) {
    2728        1078 :     case al_CYCLIC: case al_CSA:
    2729        1078 :       if (!abs) return algredtrace(al,x);
    2730         196 :       if (alg_model(al,x)==al_ALGEBRAIC) x = algalgtobasis(al,x);
    2731         329 :     case al_TABLE: return algabstrace(al,x);
    2732             :     default : return NULL; /* LCOV_EXCL_LINE */
    2733             :   }
    2734             : }
    2735             : 
    2736             : static GEN
    2737       40481 : ZM_trace(GEN x)
    2738             : {
    2739       40481 :   long i, lx = lg(x);
    2740             :   GEN t;
    2741       40481 :   if (lx < 3) return lx == 1? gen_0: gcopy(gcoeff(x,1,1));
    2742       39683 :   t = gcoeff(x,1,1);
    2743      672861 :   for (i = 2; i < lx; i++) t = addii(t, gcoeff(x,i,i));
    2744       39683 :   return t;
    2745             : }
    2746             : static GEN
    2747      125690 : FpM_trace(GEN x, GEN p)
    2748             : {
    2749      125690 :   long i, lx = lg(x);
    2750             :   GEN t;
    2751      125690 :   if (lx < 3) return lx == 1? gen_0: gcopy(gcoeff(x,1,1));
    2752      117990 :   t = gcoeff(x,1,1);
    2753      878670 :   for (i = 2; i < lx; i++) t = Fp_add(t, gcoeff(x,i,i), p);
    2754      117990 :   return t;
    2755             : }
    2756             : 
    2757             : static GEN
    2758       38605 : algtracebasis(GEN al)
    2759             : {
    2760       38605 :   pari_sp av = avma;
    2761       38605 :   GEN mt = alg_get_multable(al), p = alg_get_char(al);
    2762       38605 :   long i, l = lg(mt);
    2763       38605 :   GEN v = cgetg(l, t_VEC);
    2764      164295 :   if (signe(p)) for (i=1; i < l; i++) gel(v,i) = FpM_trace(gel(mt,i), p);
    2765       45899 :   else          for (i=1; i < l; i++) gel(v,i) = ZM_trace(gel(mt,i));
    2766       38605 :   return gerepileupto(av,v);
    2767             : }
    2768             : 
    2769             : /* Assume: i > 0, expo := p^i <= absdim, x contained in I_{i-1} given by mult
    2770             :  * table modulo modu=p^(i+1). Return Tr(x^(p^i)) mod modu */
    2771             : static ulong
    2772       24472 : algtracei(GEN mt, ulong p, ulong expo, ulong modu)
    2773             : {
    2774       24472 :   pari_sp av = avma;
    2775       24472 :   long j, l = lg(mt);
    2776       24472 :   ulong tr = 0;
    2777       24472 :   mt = Flm_powu(mt,expo,modu);
    2778      267995 :   for (j=1; j<l; j++) tr += ucoeff(mt,j,j);
    2779       24472 :   return gc_ulong(av, (tr/expo) % p);
    2780             : }
    2781             : 
    2782             : GEN
    2783         952 : algnorm(GEN al, GEN x, long abs)
    2784             : {
    2785         952 :   pari_sp av = avma;
    2786             :   long tx;
    2787             :   GEN p, rnf, res, mx;
    2788         952 :   checkalg(al);
    2789         952 :   p = alg_get_char(al);
    2790         952 :   tx = alg_model(al,x);
    2791         952 :   if (signe(p)) {
    2792          21 :     if (tx == al_MATRIX)    mx = algleftmultable_mat(al,x);
    2793          14 :     else                    mx = algbasismultable(al,x);
    2794          21 :     return gerepileupto(av, FpM_det(mx,p));
    2795             :   }
    2796         931 :   if (tx == al_TRIVIAL) return gcopy(gel(x,1));
    2797             : 
    2798         889 :   switch(alg_type(al)) {
    2799         819 :     case al_CYCLIC: case al_CSA:
    2800         819 :       if (abs)
    2801             :       {
    2802         196 :         if (alg_model(al,x)==al_ALGEBRAIC) x = algalgtobasis(al,x);
    2803             :       }
    2804             :       else
    2805             :       {
    2806         623 :         rnf = alg_get_splittingfield(al);
    2807         623 :         res = rnfeltdown(rnf, det(algtomatrix(al,x,0)));
    2808         616 :         break;
    2809             :       }
    2810             :     case al_TABLE:
    2811         266 :       if (tx == al_MATRIX)  mx = algleftmultable_mat(al,x);
    2812         105 :       else                  mx = algbasismultable(al,x);
    2813         259 :       res = det(mx);
    2814         259 :       break;
    2815             :     default: return NULL; /* LCOV_EXCL_LINE */
    2816             :   }
    2817         875 :   return gerepileupto(av, res);
    2818             : }
    2819             : 
    2820             : static GEN
    2821       48160 : algalgtonat_cyc(GEN al, GEN x)
    2822             : {
    2823       48160 :   pari_sp av = avma;
    2824       48160 :   GEN nf = alg_get_abssplitting(al), rnf = alg_get_splittingfield(al), res, c;
    2825       48160 :   long n = alg_get_degree(al), N = nf_get_degree(nf), i, i1;
    2826       48160 :   res = zerocol(N*n);
    2827      147686 :   for (i=0; i<n; i++) {
    2828       99526 :     c = gel(x,i+1);
    2829       99526 :     c = rnfeltreltoabs(rnf,c);
    2830       99526 :     if (!gequal0(c)) {
    2831       75782 :       c = algtobasis(nf,c);
    2832      409276 :       for (i1=1; i1<=N; i1++) gel(res,i*N+i1) = gel(c,i1);
    2833             :     }
    2834             :   }
    2835       48160 :   return gerepilecopy(av, res);
    2836             : }
    2837             : 
    2838             : static GEN
    2839       11256 : algalgtonat_csa(GEN al, GEN x)
    2840             : {
    2841       11256 :   pari_sp av = avma;
    2842       11256 :   GEN nf = alg_get_center(al), res, c;
    2843       11256 :   long d2 = alg_get_dim(al), n = nf_get_degree(nf), i, i1;
    2844       11256 :   res = zerocol(d2*n);
    2845       56133 :   for (i=0; i<d2; i++) {
    2846       44877 :     c = gel(x,i+1);
    2847       44877 :     if (!gequal0(c)) {
    2848       31318 :       c = algtobasis(nf,c);
    2849       94395 :       for (i1=1; i1<=n; i1++) gel(res,i*n+i1) = gel(c,i1);
    2850             :     }
    2851             :   }
    2852       11256 :   return gerepilecopy(av, res);
    2853             : }
    2854             : 
    2855             : /* assumes al CSA or CYCLIC */
    2856             : static GEN
    2857       59416 : algalgtonat(GEN al, GEN x)
    2858             : {
    2859       59416 :   switch(alg_type(al))
    2860             :   {
    2861       48160 :     case al_CYCLIC: return algalgtonat_cyc(al, x);
    2862       11256 :     case al_CSA: return algalgtonat_csa(al, x);
    2863             :   }
    2864             :   return NULL; /*LCOV_EXCL_LINE*/
    2865             : }
    2866             : 
    2867             : static GEN
    2868       10381 : algnattoalg_cyc(GEN al, GEN x)
    2869             : {
    2870       10381 :   pari_sp av = avma;
    2871       10381 :   GEN nf = alg_get_abssplitting(al), rnf = alg_get_splittingfield(al), res, c;
    2872       10381 :   long n = alg_get_degree(al), N = nf_get_degree(nf), i, i1;
    2873       10381 :   res = zerocol(n);
    2874       10381 :   c = zerocol(N);
    2875       44926 :   for (i=0; i<n; i++) {
    2876      292978 :     for (i1=1; i1<=N; i1++) gel(c,i1) = gel(x,i*N+i1);
    2877       34545 :     gel(res,i+1) = rnfeltabstorel(rnf,basistoalg(nf,c));
    2878             :   }
    2879       10381 :   return gerepilecopy(av, res);
    2880             : }
    2881             : 
    2882             : static GEN
    2883        1225 : algnattoalg_csa(GEN al, GEN x)
    2884             : {
    2885        1225 :   pari_sp av = avma;
    2886        1225 :   GEN nf = alg_get_center(al), res, c;
    2887        1225 :   long d2 = alg_get_dim(al), n = nf_get_degree(nf), i, i1;
    2888        1225 :   res = zerocol(d2);
    2889        1225 :   c = zerocol(n);
    2890        6608 :   for (i=0; i<d2; i++) {
    2891       18494 :     for (i1=1; i1<=n; i1++) gel(c,i1) = gel(x,i*n+i1);
    2892        5383 :     gel(res,i+1) = basistoalg(nf,c);
    2893             :   }
    2894        1225 :   return gerepilecopy(av, res);
    2895             : }
    2896             : 
    2897             : /* assumes al CSA or CYCLIC */
    2898             : static GEN
    2899       11606 : algnattoalg(GEN al, GEN x)
    2900             : {
    2901       11606 :   switch(alg_type(al))
    2902             :   {
    2903       10381 :     case al_CYCLIC: return algnattoalg_cyc(al, x);
    2904        1225 :     case al_CSA: return algnattoalg_csa(al, x);
    2905             :   }
    2906             :   return NULL; /*LCOV_EXCL_LINE*/
    2907             : }
    2908             : 
    2909             : static GEN
    2910         182 : algalgtobasis_mat(GEN al, GEN x) /* componentwise */
    2911             : {
    2912         182 :   pari_sp av = avma;
    2913             :   long lx, lxj, i, j;
    2914             :   GEN res;
    2915         182 :   lx = lg(x);
    2916         182 :   res = cgetg(lx, t_MAT);
    2917         546 :   for (j=1; j<lx; j++) {
    2918         364 :     lxj = lg(gel(x,j));
    2919         364 :     gel(res,j) = cgetg(lxj, t_COL);
    2920        1092 :     for (i=1; i<lxj; i++)
    2921         728 :       gcoeff(res,i,j) = algalgtobasis(al,gcoeff(x,i,j));
    2922             :   }
    2923         182 :   return gerepilecopy(av,res);
    2924             : }
    2925             : GEN
    2926       59871 : algalgtobasis(GEN al, GEN x)
    2927             : {
    2928             :   pari_sp av;
    2929             :   long tx;
    2930       59871 :   checkalg(al);
    2931       59871 :   if (alg_type(al) == al_TABLE) pari_err_TYPE("algalgtobasis [use alginit]", al);
    2932       59857 :   tx = alg_model(al,x);
    2933       59857 :   if (tx==al_BASIS) return gcopy(x);
    2934       59598 :   if (tx==al_MATRIX) return algalgtobasis_mat(al,x);
    2935       59416 :   av = avma;
    2936       59416 :   x = algalgtonat(al,x);
    2937       59416 :   x = RgM_RgC_mul(alg_get_invbasis(al),x);
    2938       59416 :   return gerepileupto(av, x);
    2939             : }
    2940             : 
    2941             : static GEN
    2942         119 : algbasistoalg_mat(GEN al, GEN x) /* componentwise */
    2943             : {
    2944         119 :   long j, lx = lg(x);
    2945         119 :   GEN res = cgetg(lx, t_MAT);
    2946         357 :   for (j=1; j<lx; j++) {
    2947         238 :     long i, lxj = lg(gel(x,j));
    2948         238 :     gel(res,j) = cgetg(lxj, t_COL);
    2949         714 :     for (i=1; i<lxj; i++) gcoeff(res,i,j) = algbasistoalg(al,gcoeff(x,i,j));
    2950             :   }
    2951         119 :   return res;
    2952             : }
    2953             : GEN
    2954        2912 : algbasistoalg(GEN al, GEN x)
    2955             : {
    2956             :   pari_sp av;
    2957             :   long tx;
    2958        2912 :   checkalg(al);
    2959        2912 :   if (alg_type(al) == al_TABLE) pari_err_TYPE("algbasistoalg [use alginit]", al);
    2960        2898 :   tx = alg_model(al,x);
    2961        2898 :   if (tx==al_ALGEBRAIC) return gcopy(x);
    2962        2765 :   if (tx==al_MATRIX) return algbasistoalg_mat(al,x);
    2963        2646 :   av = avma;
    2964        2646 :   x = RgM_RgC_mul(alg_get_basis(al),x);
    2965        2646 :   x = algnattoalg(al,x);
    2966        2646 :   return gerepileupto(av, x);
    2967             : }
    2968             : 
    2969             : GEN
    2970       18305 : algrandom(GEN al, GEN b)
    2971             : {
    2972             :   GEN res, p, N;
    2973             :   long i, n;
    2974       18305 :   if (typ(b) != t_INT) pari_err_TYPE("algrandom",b);
    2975       18298 :   if (signe(b)<0) pari_err_DOMAIN("algrandom", "b", "<", gen_0, b);
    2976       18291 :   checkalg(al);
    2977       18284 :   n = alg_get_absdim(al);
    2978       18284 :   N = addiu(shifti(b,1), 1); /* left on stack */
    2979       18284 :   p = alg_get_char(al); if (!signe(p)) p = NULL;
    2980       18284 :   res = cgetg(n+1,t_COL);
    2981      163828 :   for (i=1; i<= n; i++)
    2982             :   {
    2983      145544 :     pari_sp av = avma;
    2984      145544 :     GEN t = subii(randomi(N),b);
    2985      145544 :     if (p) t = modii(t, p);
    2986      145544 :     gel(res,i) = gerepileuptoint(av, t);
    2987             :   }
    2988       18284 :   return res;
    2989             : }
    2990             : 
    2991             : /* Assumes pol has coefficients in the same ring as the COL x; x either
    2992             :  * in basis or algebraic form or [x,mx] where mx is the mult. table of x.
    2993             :  TODO more general version: pol with coeffs in center and x in basis form */
    2994             : GEN
    2995       17073 : algpoleval(GEN al, GEN pol, GEN x)
    2996             : {
    2997       17073 :   pari_sp av = avma;
    2998       17073 :   GEN p, mx = NULL, res;
    2999             :   long i;
    3000       17073 :   checkalg(al);
    3001       17073 :   p = alg_get_char(al);
    3002       17073 :   if (typ(pol) != t_POL) pari_err_TYPE("algpoleval", pol);
    3003       17066 :   if (typ(x) == t_VEC)
    3004             :   {
    3005        6097 :     if (lg(x) != 3) pari_err_TYPE("algpoleval [vector must be of length 2]", x);
    3006        6090 :     mx = gel(x,2);
    3007        6090 :     x = gel(x,1);
    3008        6090 :     if (typ(mx)!=t_MAT || !gequal(x,gel(mx,1)))
    3009          21 :       pari_err_TYPE("algpoleval [mx must be the multiplication table of x]", mx);
    3010             :   }
    3011             :   else
    3012             :   {
    3013       10969 :     switch(alg_model(al,x))
    3014             :     {
    3015          14 :       case al_ALGEBRAIC: mx = algalgmultable(al,x); break;
    3016       10927 :       case al_BASIS: if (!RgX_is_QX(pol))
    3017           7 :         pari_err_IMPL("algpoleval with x in basis form and pol not in Q[x]");
    3018       10934 :       case al_TRIVIAL: mx = algbasismultable(al,x); break;
    3019           7 :       default: pari_err_TYPE("algpoleval", x);
    3020             :     }
    3021             :   }
    3022       17017 :   res = zerocol(lg(mx)-1);
    3023       17017 :   if (signe(p)) {
    3024       63950 :     for (i=lg(pol)-1; i>1; i--)
    3025             :     {
    3026       47731 :       gel(res,1) = Fp_add(gel(res,1), gel(pol,i), p);
    3027       47731 :       if (i>2) res = FpM_FpC_mul(mx, res, p);
    3028             :     }
    3029             :   }
    3030             :   else {
    3031        4746 :     for (i=lg(pol)-1; i>1; i--)
    3032             :     {
    3033        3948 :       gel(res,1) = gadd(gel(res,1), gel(pol,i));
    3034        3948 :       if (i>2) res = RgM_RgC_mul(mx, res);
    3035             :     }
    3036             :   }
    3037       17017 :   return gerepileupto(av, res);
    3038             : }
    3039             : 
    3040             : /** GRUNWALD-WANG **/
    3041             : /*
    3042             : Song Wang's PhD thesis (pdf pages)
    3043             : p.25 definition of chi_b. K^Ker(chi_b) = K(b^(1/m))
    3044             : p.26 bound on the conductor (also Cohen adv. GTM 193 p.166)
    3045             : p.21 & p.34 description special case, also on wikipedia:
    3046             : http://en.wikipedia.org/wiki/Grunwald%E2%80%93Wang_theorem#Special_fields
    3047             : p.77 Kummer case
    3048             : */
    3049             : 
    3050             : /* n > 0. Is n = 2^k ? */
    3051             : static int
    3052         154 : uispow2(ulong n) { return !(n &(n-1)); }
    3053             : 
    3054             : static GEN
    3055         175 : get_phi0(GEN bnr, GEN Lpr, GEN Ld, GEN pl, long *pr, long *pn)
    3056             : {
    3057         175 :   const long NTRY = 10; /* FIXME: magic constant */
    3058         175 :   const long n = (lg(Ld)==1)? 2: vecsmall_max(Ld);
    3059         175 :   GEN S = bnr_get_cyc(bnr);
    3060             :   GEN Sst, G, globGmod, loc, X, Rglob, Rloc, H, U, Lconj;
    3061             :   long i, j, r, nbfrob, nbloc, nz, t;
    3062             : 
    3063         175 :   *pn = n;
    3064         175 :   *pr = r = lg(S)-1;
    3065         175 :   if (!r) return NULL;
    3066         154 :   Lconj = NULL;
    3067         154 :   nbloc = nbfrob = lg(Lpr)-1;
    3068         154 :   if (uispow2(n))
    3069             :   {
    3070          84 :     long l = lg(pl), k = 1;
    3071          84 :     GEN real = cgetg(l, t_VECSMALL);
    3072         210 :     for (i=1; i<l; i++)
    3073         126 :       if (pl[i]==-1) real[k++] = i;
    3074          84 :     if (k > 1)
    3075             :     {
    3076          84 :       GEN nf = bnr_get_nf(bnr), I = bid_get_fact(bnr_get_bid(bnr));
    3077          84 :       GEN v, y, C = idealchineseinit(bnr, I);
    3078          84 :       long r1 = nf_get_r1(nf), n = nbrows(I);
    3079          84 :       nbloc += k-1;
    3080          84 :       Lconj = cgetg(k, t_VEC);
    3081          84 :       v = const_vecsmall(r1,1);
    3082          84 :       y = const_vec(n, gen_1);
    3083         210 :       for (i = 1; i < k; i++)
    3084             :       {
    3085         126 :         v[i] = -1; gel(Lconj,i) = idealchinese(nf,mkvec2(C,v),y);
    3086         126 :         v[i] = 1;
    3087             :       }
    3088             :     }
    3089             :   }
    3090             : 
    3091             :   /* compute Z/n-dual */
    3092         154 :   Sst = cgetg(r+1, t_VECSMALL);
    3093         336 :   for (i=1; i<=r; i++) Sst[i] = ugcdiu(gel(S,i), n);
    3094         154 :   if (Sst[1] != n) return NULL;
    3095             : 
    3096         154 :   globGmod = cgetg(r+1,t_MAT);
    3097         154 :   G = cgetg(r+1,t_VECSMALL);
    3098         336 :   for (i=1; i<=r; i++)
    3099             :   {
    3100         182 :     G[i] = n / Sst[i]; /* pairing between S and Sst */
    3101         182 :     gel(globGmod,i) = cgetg(nbloc+1,t_VECSMALL);
    3102             :   }
    3103             : 
    3104             :   /* compute images of Frobenius elements (and complex conjugation) */
    3105         154 :   loc = cgetg(nbloc+1,t_VECSMALL);
    3106         490 :   for (i=1; i<=nbloc; i++) {
    3107             :     long L;
    3108         350 :     if (i<=nbfrob)
    3109             :     {
    3110         224 :       X = gel(Lpr,i);
    3111         224 :       L = Ld[i];
    3112             :     }
    3113             :     else
    3114             :     { /* X = 1 (mod f), sigma_i(x) < 0, positive at all other real places */
    3115         126 :       X = gel(Lconj,i-nbfrob);
    3116         126 :       L = 2;
    3117             :     }
    3118         350 :     X = ZV_to_Flv(isprincipalray(bnr,X), n);
    3119         868 :     for (nz=0,j=1; j<=r; j++)
    3120             :     {
    3121         518 :       ulong c = (X[j] * G[j]) % L;
    3122         518 :       ucoeff(globGmod,i,j) = c;
    3123         518 :       if (c) nz = 1;
    3124             :     }
    3125         350 :     if (!nz) return NULL;
    3126         336 :     loc[i] = L;
    3127             :   }
    3128             : 
    3129             :   /* try some random elements in the dual */
    3130         140 :   Rglob = cgetg(r+1,t_VECSMALL);
    3131         462 :   for (t=0; t<NTRY; t++) {
    3132        1113 :     for (j=1; j<=r; j++) Rglob[j] = random_Fl(Sst[j]);
    3133         455 :     Rloc = zm_zc_mul(globGmod,Rglob);
    3134         938 :     for (i=1; i<=nbloc; i++)
    3135         805 :       if (Rloc[i] % loc[i] == 0) break;
    3136         455 :     if (i > nbloc)
    3137         133 :       return zv_to_ZV(Rglob);
    3138             :   }
    3139             : 
    3140             :   /* try to realize some random elements of the product of the local duals */
    3141           7 :   H = ZM_hnfall_i(shallowconcat(zm_to_ZM(globGmod),
    3142             :                                 diagonal_shallow(zv_to_ZV(loc))), &U, 2);
    3143             :   /* H,U nbloc x nbloc */
    3144           7 :   Rloc = cgetg(nbloc+1,t_COL);
    3145          77 :   for (t=0; t<NTRY; t++) {
    3146             :     /* nonzero random coordinate */ /* TODO add special case ? */
    3147         560 :     for (i=1; i<=nbloc; i++) gel(Rloc,i) = stoi(1 + random_Fl(loc[i]-1));
    3148          70 :     Rglob = hnf_invimage(H, Rloc);
    3149          70 :     if (Rglob)
    3150             :     {
    3151           0 :       Rglob = ZM_ZC_mul(U,Rglob);
    3152           0 :       return vecslice(Rglob,1,r);
    3153             :     }
    3154             :   }
    3155           7 :   return NULL;
    3156             : }
    3157             : 
    3158             : static GEN
    3159         175 : bnrgwsearch(GEN bnr, GEN Lpr, GEN Ld, GEN pl)
    3160             : {
    3161         175 :   pari_sp av = avma;
    3162             :   long n, r;
    3163         175 :   GEN phi0 = get_phi0(bnr,Lpr,Ld,pl, &r,&n), gn, v, H,U;
    3164         175 :   if (!phi0) return gc_const(av, gen_0);
    3165         133 :   gn = stoi(n);
    3166             :   /* compute kernel of phi0 */
    3167         133 :   v = ZV_extgcd(shallowconcat(phi0, gn));
    3168         133 :   U = vecslice(gel(v,2), 1,r);
    3169         133 :   H = ZM_hnfmodid(rowslice(U, 1,r), gn);
    3170         133 :   return gerepileupto(av, H);
    3171             : }
    3172             : 
    3173             : GEN
    3174         133 : bnfgwgeneric(GEN bnf, GEN Lpr, GEN Ld, GEN pl, long var)
    3175             : {
    3176         133 :   pari_sp av = avma;
    3177         133 :   const long n = (lg(Ld)==1)? 2: vecsmall_max(Ld);
    3178             :   forprime_t S;
    3179         133 :   GEN bnr = NULL, ideal = gen_1, nf, dec, H = gen_0, finf, pol;
    3180             :   ulong ell, p;
    3181             :   long deg, i, degell;
    3182         133 :   (void)uisprimepower(n, &ell);
    3183         133 :   nf = bnf_get_nf(bnf);
    3184         133 :   deg = nf_get_degree(nf);
    3185         133 :   degell = ugcd(deg,ell-1);
    3186         133 :   finf = cgetg(lg(pl),t_VEC);
    3187         329 :   for (i=1; i<lg(pl); i++) gel(finf,i) = pl[i]==-1 ? gen_1 : gen_0;
    3188             : 
    3189         133 :   u_forprime_init(&S, 2, ULONG_MAX);
    3190         532 :   while ((p = u_forprime_next(&S))) {
    3191         532 :     if (Fl_powu(p % ell, degell, ell) != 1) continue; /* ell | p^deg-1 ? */
    3192         238 :     dec = idealprimedec(nf, utoipos(p));
    3193         392 :     for (i=1; i<lg(dec); i++) {
    3194         287 :       GEN pp = gel(dec,i);
    3195         287 :       if (RgV_isin(Lpr,pp)) continue;
    3196             :         /* TODO also accept the prime ideals at which there is a condition
    3197             :          * (use local Artin)? */
    3198         231 :       if (smodis(idealnorm(nf,pp),ell) != 1) continue; /* ell | N(pp)-1 ? */
    3199         175 :       ideal = idealmul(bnf,ideal,pp);
    3200             :       /* TODO: give factorization ? */
    3201         175 :       bnr = Buchray(bnf, mkvec2(ideal,finf), nf_INIT);
    3202         175 :       H = bnrgwsearch(bnr,Lpr,Ld,pl);
    3203         175 :       if (H != gen_0)
    3204             :       {
    3205         133 :         pol = rnfkummer(bnr,H,nf_get_prec(nf));
    3206         133 :         setvarn(pol, var);
    3207         133 :         return gerepileupto(av,pol);
    3208             :       }
    3209             :     }
    3210             :   }
    3211             :   pari_err_BUG("bnfgwgeneric (no suitable p)"); /*LCOV_EXCL_LINE*/
    3212             :   return NULL;/*LCOV_EXCL_LINE*/
    3213             : }
    3214             : 
    3215             : /* no garbage collection */
    3216             : static GEN
    3217         245 : localextdeg(GEN nf, GEN pr, GEN cnd, long d, long ell, long n)
    3218             : {
    3219         245 :   long g = n/d;
    3220         245 :   GEN res, modpr, ppr = pr, T, p, gen, k;
    3221         245 :   if (d==1) return gen_1;
    3222         224 :   if (equalsi(ell,pr_get_p(pr))) { /* ell == p */
    3223          21 :     res = nfadd(nf, gen_1, pr_get_gen(pr));
    3224          21 :     res = nfpowmodideal(nf, res, stoi(g), cnd);
    3225             :   }
    3226             :   else { /* ell != p */
    3227         203 :     k = powis(stoi(ell),Z_lval(subiu(pr_norm(pr),1),ell));
    3228         203 :     k = divis(k,g);
    3229         203 :     modpr = nf_to_Fq_init(nf, &ppr, &T, &p);
    3230         203 :     (void)Fq_sqrtn(gen_1,k,T,p,&gen);
    3231         203 :     res = Fq_to_nf(gen, modpr);
    3232             :   }
    3233         224 :   return res;
    3234             : }
    3235             : 
    3236             : /* Ld[i] must be nontrivial powers of the same prime ell */
    3237             : /* pl : -1 at real places at which the extention must ramify, 0 elsewhere */
    3238             : GEN
    3239         168 : nfgwkummer(GEN nf, GEN Lpr, GEN Ld, GEN pl, long var)
    3240             : {
    3241         168 :   const long n = (lg(Ld)==1)? 2: vecsmall_max(Ld);
    3242         168 :   pari_sp av = avma;
    3243             :   ulong ell;
    3244             :   long i, v;
    3245             :   GEN cnd, y, x, pol;
    3246         168 :   v = uisprimepower(n, &ell);
    3247         168 :   cnd = zeromatcopy(lg(Lpr)-1,2);
    3248             : 
    3249         168 :   y = vec_ei(lg(Lpr)-1,1);
    3250         413 :   for (i=1; i<lg(Lpr); i++) {
    3251         245 :     GEN pr = gel(Lpr,i), p = pr_get_p(pr), E;
    3252         245 :     long e = pr_get_e(pr);
    3253         245 :     gcoeff(cnd,i,1) = pr;
    3254             : 
    3255         245 :     if (!absequalui(ell,p))
    3256         217 :       E = gen_1;
    3257             :     else
    3258          28 :       E = addui(1 + v*e, divsi(e,subiu(p,1)));
    3259         245 :     gcoeff(cnd,i,2) = E;
    3260         245 :     gel(y,i) = localextdeg(nf, pr, idealpow(nf,pr,E), Ld[i], ell, n);
    3261             :   }
    3262             : 
    3263             :   /* TODO use a factoredextchinese to ease computations afterwards ? */
    3264         168 :   x = idealchinese(nf, mkvec2(cnd,pl), y);
    3265         168 :   x = basistoalg(nf,x);
    3266         168 :   pol = gsub(gpowgs(pol_x(var),n),x);
    3267             : 
    3268         168 :   return gerepileupto(av,pol);
    3269             : }
    3270             : 
    3271             : static GEN
    3272         707 : get_vecsmall(GEN v)
    3273             : {
    3274         707 :   switch(typ(v))
    3275             :   {
    3276         581 :     case t_VECSMALL: return v;
    3277         119 :     case t_VEC: if (RgV_is_ZV(v)) return ZV_to_zv(v);
    3278             :   }
    3279           7 :   pari_err_TYPE("nfgrunwaldwang",v);
    3280             :   return NULL;/*LCOV_EXCL_LINE*/
    3281             : }
    3282             : GEN
    3283         399 : nfgrunwaldwang(GEN nf0, GEN Lpr, GEN Ld, GEN pl, long var)
    3284             : {
    3285             :   ulong n, ell, ell2;
    3286         399 :   pari_sp av = avma;
    3287             :   GEN nf, bnf;
    3288             :   long t, w, i, vnf;
    3289             : 
    3290         399 :   if (var < 0) var = 0;
    3291         399 :   nf = get_nf(nf0,&t);
    3292         399 :   if (!nf) pari_err_TYPE("nfgrunwaldwang",nf0);
    3293         399 :   vnf = nf_get_varn(nf);
    3294         399 :   if (varncmp(var, vnf) >= 0)
    3295           7 :     pari_err_PRIORITY("nfgrunwaldwang", pol_x(var), ">=", vnf);
    3296         392 :   if (typ(Lpr) != t_VEC) pari_err_TYPE("nfgrunwaldwang",Lpr);
    3297         378 :   if (lg(Lpr) != lg(Ld)) pari_err_DIM("nfgrunwaldwang [#Lpr != #Ld]");
    3298         371 :   if (nf_get_degree(nf)==1) Lpr = shallowcopy(Lpr);
    3299         854 :   for (i=1; i<lg(Lpr); i++) {
    3300         490 :     GEN pr = gel(Lpr,i);
    3301         490 :     if (nf_get_degree(nf)==1 && typ(pr)==t_INT)
    3302          77 :       gel(Lpr,i) = gel(idealprimedec(nf,pr), 1);
    3303         413 :     else checkprid(pr);
    3304             :   }
    3305         364 :   if (lg(pl)-1 != nf_get_r1(nf))
    3306           7 :     pari_err_DOMAIN("nfgrunwaldwang [pl should have r1 components]", "#pl",
    3307           7 :         "!=", stoi(nf_get_r1(nf)), stoi(lg(pl)-1));
    3308             : 
    3309         357 :   Ld = get_vecsmall(Ld);
    3310         350 :   pl = get_vecsmall(pl);
    3311         350 :   bnf = get_bnf(nf0,&t);
    3312         350 :   n = (lg(Ld)==1)? 2: vecsmall_max(Ld);
    3313             : 
    3314         350 :   if (!uisprimepower(n, &ell))
    3315           7 :     pari_err_IMPL("nfgrunwaldwang for non prime-power local degrees (a)");
    3316         791 :   for (i=1; i<lg(Ld); i++)
    3317         455 :     if (Ld[i]!=1 && (!uisprimepower(Ld[i],&ell2) || ell2!=ell))
    3318           7 :       pari_err_IMPL("nfgrunwaldwang for non prime-power local degrees (b)");
    3319         784 :   for (i=1; i<lg(pl); i++)
    3320         455 :     if (pl[i]==-1 && ell%2)
    3321           7 :       pari_err_IMPL("nfgrunwaldwang for non prime-power local degrees (c)");
    3322             : 
    3323         329 :   w = bnf? bnf_get_tuN(bnf): itos(gel(nfrootsof1(nf),1));
    3324             : 
    3325             :   /* TODO choice between kummer and generic ? Let user choose between speed
    3326             :    * and size */
    3327         329 :   if (w%n==0 && lg(Ld)>1)
    3328         168 :     return gerepileupto(av,nfgwkummer(nf,Lpr,Ld,pl,var));
    3329         161 :   if (ell==n) {
    3330         133 :     if (!bnf) bnf = Buchall(nf,0,0);
    3331         133 :     return gerepileupto(av,bnfgwgeneric(bnf,Lpr,Ld,pl,var));
    3332             :   }
    3333          28 :   pari_err_IMPL("nfgrunwaldwang for non-prime degree");
    3334             :   return NULL; /*LCOV_EXCL_LINE*/
    3335             : }
    3336             : 
    3337             : /** HASSE INVARIANTS **/
    3338             : 
    3339             : /* TODO long -> ulong + uel */
    3340             : static GEN
    3341         917 : hasseconvert(GEN H, long n)
    3342             : {
    3343             :   GEN h, c;
    3344             :   long i, l;
    3345         917 :   switch(typ(H)) {
    3346         847 :     case t_VEC:
    3347         847 :       l = lg(H); h = cgetg(l,t_VECSMALL);
    3348         847 :       if (l == 1) return h;
    3349         749 :       c = gel(H,1);
    3350         749 :       if (typ(c) == t_VEC && l == 3)
    3351         287 :         return mkvec2(gel(H,1),hasseconvert(gel(H,2),n));
    3352        1225 :       for (i=1; i<l; i++)
    3353             :       {
    3354         791 :         c = gel(H,i);
    3355         791 :         switch(typ(c)) {
    3356         567 :           case t_INT:  break;
    3357           7 :           case t_INTMOD:
    3358           7 :             c = gel(c,2); break;
    3359         196 :           case t_FRAC :
    3360         196 :             c = gmulgs(c,n);
    3361         196 :             if (typ(c) == t_INT) break;
    3362           7 :             pari_err_DOMAIN("hasseconvert [degree should be a denominator of the invariant]", "denom(h)", "ndiv", stoi(n), Q_denom(gel(H,i)));
    3363          21 :           default : pari_err_TYPE("Hasse invariant", c);
    3364             :         }
    3365         763 :         h[i] = smodis(c,n);
    3366             :       }
    3367         434 :       return h;
    3368          63 :     case t_VECSMALL: return H;
    3369             :   }
    3370           7 :   pari_err_TYPE("Hasse invariant", H);
    3371             :   return NULL;/*LCOV_EXCL_LINE*/
    3372             : }
    3373             : 
    3374             : /* assume f >= 2 */
    3375             : static long
    3376         392 : cyclicrelfrob0(GEN nf, GEN aut, GEN pr, GEN q, long f, long g)
    3377             : {
    3378         392 :   pari_sp av = avma;
    3379             :   long s;
    3380             :   GEN T, p, modpr, a, b;
    3381             : 
    3382         392 :   modpr = nf_to_Fq_init(nf,&pr,&T,&p);
    3383         392 :   a = pol_x(nf_get_varn(nf));
    3384         392 :   b = galoisapply(nf, aut, modpr_genFq(modpr));
    3385         392 :   b = nf_to_Fq(nf, b, modpr);
    3386        1253 :   for (s=0; !ZX_equal(a, b); s++) a = Fq_pow(a, q, T, p);
    3387         392 :   set_avma(av);
    3388         392 :   return g*Fl_inv(s, f);/* <n */
    3389             : }
    3390             : 
    3391             : static GEN
    3392        1022 : rnfprimedec(GEN rnf, GEN pr)
    3393        1022 : { return idealfactor(obj_check(rnf,rnf_NFABS), rnfidealup0(rnf, pr, 1)); }
    3394             : 
    3395             : static long
    3396         938 : cyclicrelfrob(GEN rnf, GEN auts, GEN pr)
    3397             : {
    3398         938 :   pari_sp av = avma;
    3399         938 :   long f,g,frob, n = rnf_get_degree(rnf);
    3400         938 :   GEN fa = rnfprimedec(rnf, pr);
    3401             : 
    3402         938 :   if (cmpis(gcoeff(fa,1,2), 1) > 0)
    3403           0 :     pari_err_DOMAIN("cyclicrelfrob","e(PR/pr)",">",gen_1,pr);
    3404         938 :   g = nbrows(fa);
    3405         938 :   f = n/g;
    3406             : 
    3407         938 :   if (f <= 2) frob = g%n;
    3408             :   else {
    3409         392 :     GEN nf2, PR = gcoeff(fa,1,1);
    3410         392 :     GEN autabs = rnfeltreltoabs(rnf,gel(auts,g));
    3411         392 :     nf2 = obj_check(rnf,rnf_NFABS);
    3412         392 :     autabs = nfadd(nf2, autabs, gmul(rnf_get_k(rnf), rnf_get_alpha(rnf)));
    3413         392 :     frob = cyclicrelfrob0(nf2, autabs, PR, pr_norm(pr), f, g);
    3414             :   }
    3415         938 :   return gc_long(av, frob);
    3416             : }
    3417             : 
    3418             : static long
    3419         553 : localhasse(GEN rnf, GEN cnd, GEN pl, GEN auts, GEN b, long k)
    3420             : {
    3421         553 :   pari_sp av = avma;
    3422             :   long v, m, h, lfa, frob, n, i;
    3423             :   GEN previous, y, pr, nf, q, fa;
    3424         553 :   nf = rnf_get_nf(rnf);
    3425         553 :   n = rnf_get_degree(rnf);
    3426         553 :   pr = gcoeff(cnd,k,1);
    3427         553 :   v = nfval(nf, b, pr);
    3428         553 :   m = lg(cnd)>1 ? nbrows(cnd) : 0;
    3429             : 
    3430             :   /* add the valuation of b to the conductor... */
    3431         553 :   previous = gcoeff(cnd,k,2);
    3432         553 :   gcoeff(cnd,k,2) = addis(previous, v);
    3433             : 
    3434         553 :   y = const_vec(m, gen_1);
    3435         553 :   gel(y,k) = b;
    3436             :   /* find a factored element y congruent to b mod pr^(vpr(b)+vpr(cnd)) and to 1 mod the conductor. */
    3437         553 :   y = factoredextchinese(nf, cnd, y, pl, &fa);
    3438         553 :   h = 0;
    3439         553 :   lfa = nbrows(fa);
    3440             :   /* sum of all Hasse invariants of (rnf/nf,aut,y) is 0, Hasse invariants at q!=pr are easy, Hasse invariant at pr is the same as for al=(rnf/nf,aut,b). */
    3441        1043 :   for (i=1; i<=lfa; i++) {
    3442         490 :     q = gcoeff(fa,i,1);
    3443         490 :     if (cmp_prime_ideal(pr,q)) {
    3444         455 :       frob = cyclicrelfrob(rnf, auts, q);
    3445         455 :       frob = Fl_mul(frob,umodiu(gcoeff(fa,i,2),n),n);
    3446         455 :       h = Fl_add(h,frob,n);
    3447             :     }
    3448             :   }
    3449             :   /* ...then restore it. */
    3450         553 :   gcoeff(cnd,k,2) = previous;
    3451         553 :   return gc_long(av, Fl_neg(h,n));
    3452             : }
    3453             : 
    3454             : static GEN
    3455         700 : allauts(GEN rnf, GEN aut)
    3456             : {
    3457         700 :   long n = rnf_get_degree(rnf), i;
    3458         700 :   GEN pol = rnf_get_pol(rnf), vaut;
    3459         700 :   if (n==1) n=2;
    3460         700 :   vaut = cgetg(n,t_VEC);
    3461         700 :   aut = lift_shallow(rnfbasistoalg(rnf,aut));
    3462         700 :   gel(vaut,1) = aut;
    3463        1008 :   for (i=1; i<n-1; i++)
    3464         308 :     gel(vaut,i+1) = RgX_rem(poleval(gel(vaut,i), aut), pol);
    3465         700 :   return vaut;
    3466             : }
    3467             : 
    3468             : static GEN
    3469         224 : clean_factor(GEN fa)
    3470             : {
    3471         224 :   GEN P2,E2, P = gel(fa,1), E = gel(fa,2);
    3472         224 :   long l = lg(P), i, j = 1;
    3473         224 :   P2 = cgetg(l, t_COL);
    3474         224 :   E2 = cgetg(l, t_COL);
    3475         609 :   for (i = 1;i < l; i++)
    3476         385 :     if (signe(gel(E,i))) {
    3477         252 :       gel(P2,j) = gel(P,i);
    3478         252 :       gel(E2,j) = gel(E,i); j++;
    3479             :     }
    3480         224 :   setlg(P2,j);
    3481         224 :   setlg(E2,j); return mkmat2(P2,E2);
    3482             : }
    3483             : 
    3484             : /* shallow concat x[1],...x[nx],y[1], ... y[ny], returning a t_COL. To be
    3485             :  * used when we do not know whether x,y are t_VEC or t_COL */
    3486             : static GEN
    3487         448 : colconcat(GEN x, GEN y)
    3488             : {
    3489         448 :   long i, lx = lg(x), ly = lg(y);
    3490         448 :   GEN z=cgetg(lx+ly-1, t_COL);
    3491         714 :   for (i=1; i<lx; i++) z[i]     = x[i];
    3492         952 :   for (i=1; i<ly; i++) z[lx+i-1]= y[i];
    3493         448 :   return z;
    3494             : }
    3495             : 
    3496             : /* return v(x) at all primes in listpr, replace x by cofactor */
    3497             : static GEN
    3498         924 : nfmakecoprime(GEN nf, GEN *px, GEN listpr)
    3499             : {
    3500         924 :   long j, l = lg(listpr);
    3501         924 :   GEN x1, x = *px, L = cgetg(l, t_COL);
    3502             : 
    3503         924 :   if (typ(x) != t_MAT)
    3504             :   { /* scalar, divide at the end (fast valuation) */
    3505         819 :     x1 = NULL;
    3506        1708 :     for (j=1; j<l; j++)
    3507             :     {
    3508         889 :       GEN pr = gel(listpr,j), e;
    3509         889 :       long v = nfval(nf, x, pr);
    3510         889 :       e = stoi(v); gel(L,j) = e;
    3511        1057 :       if (v) x1 = x1? idealmulpowprime(nf, x1, pr, e)
    3512         168 :                     : idealpow(nf, pr, e);
    3513             :     }
    3514         819 :     if (x1) x = idealdivexact(nf, idealhnf(nf,x), x1);
    3515             :   }
    3516             :   else
    3517             :   { /* HNF, divide as we proceed (reduce size) */
    3518         119 :     for (j=1; j<l; j++)
    3519             :     {
    3520          14 :       GEN pr = gel(listpr,j);
    3521          14 :       long v = idealval(nf, x, pr);
    3522          14 :       gel(L,j) = stoi(v);
    3523          14 :       if (v) x = idealmulpowprime(nf, x, pr, stoi(-v));
    3524             :     }
    3525             :   }
    3526         924 :   *px = x; return L;
    3527             : }
    3528             : 
    3529             : /* Caveat: factorizations are not sorted wrt cmp_prime_ideal: Lpr comes first */
    3530             : static GEN
    3531         224 : computecnd(GEN rnf, GEN Lpr)
    3532             : {
    3533             :   GEN id, nf, fa, Le, P,E;
    3534         224 :   long n = rnf_get_degree(rnf);
    3535             : 
    3536         224 :   nf = rnf_get_nf(rnf);
    3537         224 :   id = rnf_get_idealdisc(rnf);
    3538         224 :   Le = nfmakecoprime(nf, &id, Lpr);
    3539         224 :   fa = idealfactor(nf, id); /* part of D_{L/K} coprime with Lpr */
    3540         224 :   P =  colconcat(Lpr,gel(fa,1));
    3541         224 :   E =  colconcat(Le, gel(fa,2));
    3542         224 :   fa = mkmat2(P, gdiventgs(E, eulerphiu(n)));
    3543         224 :   return mkvec2(fa, clean_factor(fa));
    3544             : }
    3545             : 
    3546             : /* h >= 0 */
    3547             : static void
    3548           0 : nextgen(GEN gene, long h, GEN* gens, GEN* hgens, long* ngens, long* curgcd) {
    3549           0 :   long nextgcd = ugcd(h,*curgcd);
    3550           0 :   if (nextgcd == *curgcd) return;
    3551           0 :   (*ngens)++;
    3552           0 :   gel(*gens,*ngens) = gene;
    3553           0 :   gel(*hgens,*ngens) = utoi(h);
    3554           0 :   *curgcd = nextgcd;
    3555           0 :   return;
    3556             : }
    3557             : 
    3558             : static int
    3559           0 : dividesmod(long d, long h, long n) { return !(h%cgcd(d,n)); }
    3560             : 
    3561             : /* ramified prime with nontrivial Hasse invariant */
    3562             : static GEN
    3563           0 : localcomplete(GEN rnf, GEN pl, GEN cnd, GEN auts, long j, long n, long h, long* v)
    3564             : {
    3565             :   GEN nf, gens, hgens, pr, modpr, T, p, sol, U, D, b, gene, randg, pu;
    3566             :   long ngens, i, d, np, k, d1, d2, hg, dnf, vcnd, curgcd;
    3567           0 :   nf = rnf_get_nf(rnf);
    3568           0 :   pr = gcoeff(cnd,j,1);
    3569           0 :   np = umodiu(pr_norm(pr), n);
    3570           0 :   dnf = nf_get_degree(nf);
    3571           0 :   vcnd = itos(gcoeff(cnd,j,2));
    3572           0 :   ngens = 13+dnf;
    3573           0 :   gens = zerovec(ngens);
    3574           0 :   hgens = zerovec(ngens);
    3575           0 :   *v = 0;
    3576           0 :   curgcd = 0;
    3577           0 :   ngens = 0;
    3578             : 
    3579           0 :   if (!uisprime(n)) {
    3580           0 :     gene =  pr_get_gen(pr);
    3581           0 :     hg = localhasse(rnf, cnd, pl, auts, gene, j);
    3582           0 :     nextgen(gene, hg, &gens, &hgens, &ngens, &curgcd);
    3583             :   }
    3584             : 
    3585           0 :   if (ugcd(np,n) != 1) { /* GCD(Np,n) != 1 */
    3586           0 :     pu = idealprincipalunits(nf,pr,vcnd);
    3587           0 :     pu = abgrp_get_gen(pu);
    3588           0 :     for (i=1; i<lg(pu) && !dividesmod(curgcd,h,n); i++) {
    3589           0 :       gene = gel(pu,i);
    3590           0 :       hg = localhasse(rnf, cnd, pl, auts, gene, j);
    3591           0 :       nextgen(gene, hg, &gens, &hgens, &ngens, &curgcd);
    3592             :     }
    3593             :   }
    3594             : 
    3595           0 :   d = ugcd(np-1,n);
    3596           0 :   if (d != 1) { /* GCD(Np-1,n) != 1 */
    3597           0 :     modpr = nf_to_Fq_init(nf, &pr, &T, &p);
    3598           0 :     while (!dividesmod(curgcd,h,n)) { /* TODO gener_FpXQ_local */
    3599           0 :       if (T==NULL) randg = randomi(p);
    3600           0 :       else randg = random_FpX(degpol(T), varn(T),p);
    3601             : 
    3602           0 :       if (!gequal0(randg) && !gequal1(randg)) {
    3603           0 :         gene = Fq_to_nf(randg, modpr);
    3604           0 :         hg = localhasse(rnf, cnd, pl, auts, gene, j);
    3605           0 :         nextgen(gene, hg, &gens, &hgens, &ngens, &curgcd);
    3606             :       }
    3607             :     }
    3608             :   }
    3609             : 
    3610           0 :   setlg(gens,ngens+1);
    3611           0 :   setlg(hgens,ngens+1);
    3612             : 
    3613           0 :   sol = ZV_extgcd(hgens);
    3614           0 :   D = gel(sol,1);
    3615           0 :   U = gmael(sol,2,ngens);
    3616             : 
    3617           0 :   b = gen_1;
    3618           0 :   d = itou(D);
    3619           0 :   d1 = ugcd(d,n);
    3620           0 :   d2 = d/d1;
    3621           0 :   d = ((h/d1)*Fl_inv(d2,n))%n;
    3622           0 :   for (i=1; i<=ngens; i++) {
    3623           0 :     k = (itos(gel(U,i))*d)%n;
    3624           0 :     if (k<0) k = n-k;
    3625           0 :     if (k) b = nfmul(nf, b, nfpow_u(nf, gel(gens,i),k));
    3626           0 :     if (i==1) *v = k;
    3627             :   }
    3628           0 :   return b;
    3629             : }
    3630             : 
    3631             : static int
    3632         259 : testsplits(GEN data, GEN b, GEN fa)
    3633             : {
    3634             :   GEN rnf, fapr, forbid, P, E;
    3635             :   long i, n;
    3636         259 :   if (gequal0(b)) return 0;
    3637         259 :   P = gel(fa,1);
    3638         259 :   E = gel(fa,2);
    3639         259 :   rnf = gel(data,1);
    3640         259 :   forbid = gel(data,2);
    3641         259 :   n = rnf_get_degree(rnf);
    3642         329 :   for (i=1; i<lgcols(fa); i++) {
    3643         105 :     GEN pr = gel(P,i);
    3644             :     long g;
    3645         105 :     if (tablesearch(forbid, pr, &cmp_prime_ideal)) return 0;
    3646          84 :     fapr = rnfprimedec(rnf,pr);
    3647          84 :     g = nbrows(fapr);
    3648          84 :     if ((itos(gel(E,i))*g)%n) return 0;
    3649             :   }
    3650         224 :   return 1;
    3651             : }
    3652             : 
    3653             : /* remove entries with Hasse invariant 0 */
    3654             : static GEN
    3655         476 : hassereduce(GEN hf)
    3656             : {
    3657         476 :   GEN pr,h, PR = gel(hf,1), H = gel(hf,2);
    3658         476 :   long i, j, l = lg(PR);
    3659             : 
    3660         476 :   pr= cgetg(l, t_VEC);
    3661         476 :   h = cgetg(l, t_VECSMALL);
    3662        1099 :   for (i = j = 1; i < l; i++)
    3663         623 :     if (H[i]) {
    3664         294 :       gel(pr,j) = gel(PR,i);
    3665         294 :       h[j] = H[i]; j++;
    3666             :     }
    3667         476 :   setlg(pr,j);
    3668         476 :   setlg(h,j); return mkvec2(pr,h);
    3669             : }
    3670             : 
    3671             : /* v vector of prid. Return underlying list of rational primes */
    3672             : static GEN
    3673         623 : pr_primes(GEN v)
    3674             : {
    3675         623 :   long i, l = lg(v);
    3676         623 :   GEN w = cgetg(l,t_VEC);
    3677        1722 :   for (i=1; i<l; i++) gel(w,i) = pr_get_p(gel(v,i));
    3678         623 :   return ZV_sort_uniq(w);
    3679             : }
    3680             : 
    3681             : /* rnf complete */
    3682             : static GEN
    3683         224 : alg_complete0(GEN rnf, GEN aut, GEN hf, GEN hi, long maxord)
    3684             : {
    3685         224 :   pari_sp av = avma;
    3686             :   GEN nf, pl, pl2, cnd, prcnd, cnds, y, Lpr, auts, b, fa, data, hfe;
    3687             :   GEN forbid, al, ind;
    3688             :   long D, n, d, i, j, l;
    3689         224 :   nf = rnf_get_nf(rnf);
    3690         224 :   n = rnf_get_degree(rnf);
    3691         224 :   d = nf_get_degree(nf);
    3692         224 :   D = d*n*n;
    3693         224 :   checkhasse(nf,hf,hi,n);
    3694         224 :   hf = hassereduce(hf);
    3695         224 :   Lpr = gel(hf,1);
    3696         224 :   hfe = gel(hf,2);
    3697             : 
    3698         224 :   auts = allauts(rnf,aut);
    3699             : 
    3700         224 :   pl = leafcopy(hi); /* conditions on the final b */
    3701         224 :   pl2 = leafcopy(hi); /* conditions for computing local Hasse invariants */
    3702         224 :   l = lg(pl); ind = cgetg(l, t_VECSMALL);
    3703         497 :   for (i = j = 1; i < l; i++)
    3704         273 :     if (hi[i]) { pl[i] = -1; pl2[i] = 1; } else ind[j++] = i;
    3705         224 :   setlg(ind, j);
    3706         224 :   y = nfpolsturm(nf, rnf_get_pol(rnf), ind);
    3707         420 :   for (i = 1; i < j; i++)
    3708         196 :     if (!signe(gel(y,i))) { pl[ind[i]] = 1; pl2[ind[i]] = 1; }
    3709             : 
    3710         224 :   cnds = computecnd(rnf,Lpr);
    3711         224 :   prcnd = gel(cnds,1);
    3712         224 :   cnd = gel(cnds,2);
    3713         224 :   y = cgetg(lgcols(prcnd),t_VEC);
    3714         224 :   forbid = vectrunc_init(lg(Lpr));
    3715         357 :   for (i=j=1; i<lg(Lpr); i++)
    3716             :   {
    3717         133 :     GEN pr = gcoeff(prcnd,i,1), yi;
    3718         133 :     long v, e = itou( gcoeff(prcnd,i,2) );
    3719         133 :     if (!e) {
    3720         133 :       long frob = cyclicrelfrob(rnf,auts,pr), f1 = ugcd(frob,n);
    3721         133 :       vectrunc_append(forbid, pr);
    3722         133 :       yi = gen_0;
    3723         133 :       v = ((hfe[i]/f1) * Fl_inv(frob/f1,n)) % n;
    3724             :     }
    3725             :     else
    3726           0 :       yi = localcomplete(rnf, pl2, cnd, auts, j++, n, hfe[i], &v);
    3727         133 :     gel(y,i) = yi;
    3728         133 :     gcoeff(prcnd,i,2) = stoi(e + v);
    3729             :   }
    3730         476 :   for (; i<lgcols(prcnd); i++) gel(y,i) = gen_1;
    3731         224 :   gen_sort_inplace(forbid, (void*)&cmp_prime_ideal, &cmp_nodata, NULL);
    3732         224 :   data = mkvec2(rnf,forbid);
    3733         224 :   b = factoredextchinesetest(nf,prcnd,y,pl,&fa,data,testsplits);
    3734             : 
    3735         224 :   al = cgetg(12, t_VEC);
    3736         224 :   gel(al,10)= gen_0; /* must be set first */
    3737         224 :   gel(al,1) = rnf;
    3738         224 :   gel(al,2) = auts;
    3739         224 :   gel(al,3) = basistoalg(nf,b);
    3740         224 :   gel(al,4) = hi;
    3741             :   /* add primes | disc or b with trivial Hasse invariant to hf */
    3742         224 :   Lpr = gel(prcnd,1); y = b;
    3743         224 :   (void)nfmakecoprime(nf, &y, Lpr);
    3744         224 :   Lpr = shallowconcat(Lpr, gel(idealfactor(nf,y), 1));
    3745         224 :   settyp(Lpr,t_VEC);
    3746         224 :   hf = mkvec2(Lpr, shallowconcat(hfe, const_vecsmall(lg(Lpr)-lg(hfe), 0)));
    3747         224 :   gel(al,5) = hf;
    3748         224 :   gel(al,6) = gen_0;
    3749         224 :   gel(al,7) = matid(D);
    3750         224 :   gel(al,8) = matid(D); /* TODO modify 7, 8 et 9 once LLL added */
    3751         224 :   gel(al,9) = algnatmultable(al,D);
    3752         224 :   gel(al,11)= algtracebasis(al);
    3753         224 :   if (maxord) al = alg_maximal_primes(al, pr_primes(Lpr));
    3754         224 :   return gerepilecopy(av, al);
    3755             : }
    3756             : 
    3757             : GEN
    3758           0 : alg_complete(GEN rnf, GEN aut, GEN hf, GEN hi, long maxord)
    3759             : {
    3760           0 :   long n = rnf_get_degree(rnf);
    3761           0 :   rnfcomplete(rnf);
    3762           0 :   return alg_complete0(rnf,aut,hasseconvert(hf,n),hasseconvert(hi,n), maxord);
    3763             : }
    3764             : 
    3765             : void
    3766        1239 : checkhasse(GEN nf, GEN hf, GEN hi, long n)
    3767             : {
    3768             :   GEN Lpr, Lh;
    3769             :   long i, sum;
    3770        1239 :   if (typ(hf) != t_VEC || lg(hf) != 3) pari_err_TYPE("checkhasse [hf]", hf);
    3771        1232 :   Lpr = gel(hf,1);
    3772        1232 :   Lh = gel(hf,2);
    3773        1232 :   if (typ(Lpr) != t_VEC) pari_err_TYPE("checkhasse [Lpr]", Lpr);
    3774        1232 :   if (typ(Lh) != t_VECSMALL) pari_err_TYPE("checkhasse [Lh]", Lh);
    3775        1232 :   if (typ(hi) != t_VECSMALL) pari_err_TYPE("checkhasse [hi]", hi);
    3776        1232 :   if ((nf && lg(hi) != nf_get_r1(nf)+1))
    3777           7 :     pari_err_DOMAIN("checkhasse [hi should have r1 components]","#hi","!=",stoi(nf_get_r1(nf)),stoi(lg(hi)-1));
    3778        1225 :   if (lg(Lpr) != lg(Lh))
    3779           7 :     pari_err_DIM("checkhasse [Lpr and Lh should have same length]");
    3780        2898 :   for (i=1; i<lg(Lpr); i++) checkprid(gel(Lpr,i));
    3781        1218 :   if (lg(gen_sort_uniq(Lpr, (void*)cmp_prime_ideal, cmp_nodata)) < lg(Lpr))
    3782           7 :     pari_err(e_MISC, "error in checkhasse [duplicate prime ideal]");
    3783        1211 :   sum = 0;
    3784        2877 :   for (i=1; i<lg(Lh); i++) sum = (sum+Lh[i])%n;
    3785        2611 :   for (i=1; i<lg(hi); i++) {
    3786        1414 :       if (hi[i] && 2*hi[i] != n) pari_err_DOMAIN("checkhasse", "Hasse invariant at real place [must be 0 or 1/2]", "!=", n%2? gen_0 : stoi(n/2), stoi(hi[i]));
    3787        1400 :       sum = (sum+hi[i])%n;
    3788             :   }
    3789        1197 :   if (sum<0) sum = n+sum;
    3790        1197 :   if (sum != 0)
    3791           7 :     pari_err_DOMAIN("checkhasse","sum(Hasse invariants)","!=",gen_0,Lh);
    3792        1190 : }
    3793             : 
    3794             : static GEN
    3795         322 : hassecoprime(GEN hf, GEN hi, long n)
    3796             : {
    3797         322 :   pari_sp av = avma;
    3798             :   long l, i, j, lk, inv;
    3799             :   GEN fa, P,E, res, hil, hfl;
    3800         322 :   hi = hasseconvert(hi, n);
    3801         308 :   hf = hasseconvert(hf, n);
    3802         287 :   checkhasse(NULL,hf,hi,n);
    3803         245 :   fa = factoru(n);
    3804         245 :   P = gel(fa,1); l = lg(P);
    3805         245 :   E = gel(fa,2);
    3806         245 :   res = cgetg(l,t_VEC);
    3807         497 :   for (i=1; i<l; i++) {
    3808         252 :     lk = upowuu(P[i],E[i]);
    3809         252 :     inv = Fl_invsafe((n/lk)%lk, lk);
    3810         252 :     hil = gcopy(hi);
    3811         252 :     hfl = gcopy(hf);
    3812             : 
    3813         252 :     if (P[i] == 2)
    3814         469 :       for (j=1; j<lg(hil); j++) hil[j] = hi[j]==0 ? 0 : lk/2;
    3815             :     else
    3816          91 :       for (j=1; j<lg(hil); j++) hil[j] = 0;
    3817         742 :     for (j=1; j<lgcols(hfl); j++) gel(hfl,2)[j] = (gel(hf,2)[j]*inv)%lk;
    3818         252 :     hfl = hassereduce(hfl);
    3819         252 :     gel(res,i) = mkvec3(hfl,hil,utoi(lk));
    3820             :   }
    3821             : 
    3822         245 :   return gerepilecopy(av, res);
    3823             : }
    3824             : 
    3825             : /* no garbage collection */
    3826             : static GEN
    3827          70 : genefrob(GEN nf, GEN gal, GEN r)
    3828             : {
    3829             :   long i;
    3830          70 :   GEN g = identity_perm(nf_get_degree(nf)), fa = Z_factor(r), p, pr, frob;
    3831         119 :   for (i=1; i<lgcols(fa); i++) {
    3832          49 :     p = gcoeff(fa,i,1);
    3833          49 :     pr = idealprimedec(nf, p);
    3834          49 :     pr = gel(pr,1);
    3835          49 :     frob = idealfrobenius(nf, gal, pr);
    3836          49 :     g = perm_mul(g, perm_pow(frob, itos(gcoeff(fa,i,2))));
    3837             :   }
    3838          70 :   return g;
    3839             : }
    3840             : 
    3841             : static GEN
    3842         224 : rnfcycaut(GEN rnf)
    3843             : {
    3844         224 :   GEN nf2 = obj_check(rnf, rnf_NFABS);
    3845             :   GEN L, alpha, pol, salpha, s, sj, polabs, k, X, pol0, nf;
    3846             :   long i, d, j;
    3847         224 :   d = rnf_get_degree(rnf);
    3848         224 :   L = galoisconj(nf2,NULL);
    3849         224 :   alpha = lift_shallow(rnf_get_alpha(rnf));
    3850         224 :   pol = rnf_get_pol(rnf);
    3851         224 :   k = rnf_get_k(rnf);
    3852         224 :   polabs = rnf_get_polabs(rnf);
    3853         224 :   nf = rnf_get_nf(rnf);
    3854         224 :   pol0 = nf_get_pol(nf);
    3855         224 :   X = RgX_rem(pol_x(varn(pol0)), pol0);
    3856             : 
    3857             :   /* TODO check mod prime of degree 1 */
    3858         301 :   for (i=1; i<lg(L); i++) {
    3859         301 :     s = gel(L,i);
    3860         301 :     salpha = RgX_RgXQ_eval(alpha,s,polabs);
    3861         301 :     if (!gequal(alpha,salpha)) continue;
    3862             : 
    3863         273 :     s = lift_shallow(rnfeltabstorel(rnf,s));
    3864         273 :     sj = s = gsub(s, gmul(k,X));
    3865         532 :     for (j=1; !gequal0(gsub(sj,pol_x(varn(s)))); j++)
    3866         259 :       sj = RgX_RgXQ_eval(sj,s,pol);
    3867         273 :     if (j<d) continue;
    3868         224 :     return s;
    3869             :   }
    3870             :   return NULL; /*LCOV_EXCL_LINE*/
    3871             : }
    3872             : 
    3873             : /* returns Lpr augmented with an extra, distinct prime */
    3874             : /* TODO be less lazy and return a small prime */
    3875             : static GEN
    3876          84 : extraprime(GEN nf, GEN Lpr)
    3877             : {
    3878          84 :   GEN Lpr2, p = gen_2, pr;
    3879             :   long i;
    3880          84 :   Lpr2 = cgetg(lg(Lpr)+1,t_VEC);
    3881          98 :   for (i=1; i<lg(Lpr); i++)
    3882             :   {
    3883          14 :     gel(Lpr2,i) = gel(Lpr,i);
    3884          14 :     p = gmax_shallow(p, pr_get_p(gel(Lpr,i)));
    3885             :   }
    3886          84 :   p = nextprime(addis(p,1));
    3887          84 :   pr = gel(idealprimedec_limit_f(nf, p, 0), 1);
    3888          84 :   gel(Lpr2,lg(Lpr)) = pr;
    3889          84 :   return Lpr2;
    3890             : }
    3891             : 
    3892             : GEN
    3893         336 : alg_hasse(GEN nf, long n, GEN hf, GEN hi, long var, long maxord)
    3894             : {
    3895         336 :   pari_sp av = avma;
    3896         336 :   GEN primary, al = gen_0, al2, rnf, hil, hfl, Ld, pl, pol, Lpr, aut, Lpr2, Ld2;
    3897             :   long i, lk, j, maxdeg;
    3898         336 :   dbg_printf(1)("alg_hasse\n");
    3899         336 :   if (n<=1) pari_err_DOMAIN("alg_hasse", "degree", "<=", gen_1, stoi(n));
    3900         322 :   primary = hassecoprime(hf, hi, n);
    3901         476 :   for (i=1; i<lg(primary); i++) {
    3902         252 :     lk = itos(gmael(primary,i,3));
    3903         252 :     hfl = gmael(primary,i,1);
    3904         252 :     hil = gmael(primary,i,2);
    3905         252 :     checkhasse(nf, hfl, hil, lk);
    3906         245 :     dbg_printf(1)("alg_hasse: i=%d hf=%Ps hi=%Ps lk=%d\n", i, hfl, hil, lk);
    3907             : 
    3908         245 :     if (lg(gel(hfl,1))>1 || lk%2==0) {
    3909         238 :       maxdeg = 1;
    3910         238 :       Lpr = gel(hfl,1);
    3911         238 :       Ld = gcopy(gel(hfl,2));
    3912         385 :       for (j=1; j<lg(Ld); j++)
    3913             :       {
    3914         147 :         Ld[j] = lk/ugcd(lk,Ld[j]);
    3915         147 :         maxdeg = maxss(Ld[j],maxdeg);
    3916             :       }
    3917         238 :       pl = gcopy(hil);
    3918         525 :       for (j=1; j<lg(pl); j++) if(pl[j])
    3919             :       {
    3920          77 :         pl[j] = -1;
    3921          77 :         maxdeg = maxss(maxdeg,2);
    3922             :       }
    3923             : 
    3924         238 :       Lpr2 = Lpr;
    3925         238 :       Ld2 = Ld;
    3926         238 :       if (maxdeg<lk)
    3927             :       {
    3928         154 :         if (maxdeg==1 && lk==2 && lg(pl)>1) pl[1] = -1;
    3929             :         else
    3930             :         {
    3931          84 :           Lpr2 = extraprime(nf,Lpr);
    3932          84 :           Ld2 = cgetg(lg(Ld)+1, t_VECSMALL);
    3933          98 :           for (j=1; j<lg(Ld); j++) Ld2[j] = Ld[j];
    3934          84 :           Ld2[lg(Ld)] = lk;
    3935             :         }
    3936             :       }
    3937             : 
    3938         238 :       dbg_printf(2)("alg_hasse: calling nfgrunwaldwang Lpr=%Ps Pd=%Ps pl=%Ps\n",
    3939             :           Lpr, Ld, pl);
    3940         238 :       pol = nfgrunwaldwang(nf, Lpr2, Ld2, pl, var);
    3941         224 :       dbg_printf(2)("alg_hasse: calling rnfinit(%Ps)\n", pol);
    3942         224 :       rnf = rnfinit0(nf,pol,1);
    3943         224 :       dbg_printf(2)("alg_hasse: computing automorphism\n");
    3944         224 :       aut = rnfcycaut(rnf);
    3945         224 :       dbg_printf(2)("alg_hasse: calling alg_complete\n");
    3946         224 :       al2 = alg_complete0(rnf,aut,hfl,hil,maxord);
    3947             :     }
    3948           7 :     else al2 = alg_matrix(nf, lk, var, cgetg(1,t_VEC), maxord);
    3949             : 
    3950         231 :     if (i==1) al = al2;
    3951           7 :     else      al = algtensor(al,al2,maxord);
    3952             :   }
    3953         224 :   return gerepilecopy(av,al);
    3954             : }
    3955             : 
    3956             : /** CYCLIC ALGEBRA WITH GIVEN HASSE INVARIANTS **/
    3957             : 
    3958             : /* no garbage collection */
    3959             : static int
    3960          70 : linindep(GEN pol, GEN L)
    3961             : {
    3962             :   long i;
    3963             :   GEN fa;
    3964          70 :   for (i=1; i<lg(L); i++) {
    3965           0 :     fa = nffactor(gel(L,i),pol);
    3966           0 :     if (lgcols(fa)>2) return 0;
    3967             :   }
    3968          70 :   return 1;
    3969             : }
    3970             : 
    3971             : /* no garbage collection */
    3972             : static GEN
    3973          70 : subcycloindep(GEN nf, long n, long v, GEN L, GEN *pr)
    3974             : {
    3975             :   pari_sp av;
    3976             :   forprime_t S;
    3977             :   ulong p;
    3978          70 :   u_forprime_arith_init(&S, 1, ULONG_MAX, 1, n);
    3979          70 :   av = avma;
    3980          77 :   while ((p = u_forprime_next(&S)))
    3981             :   {
    3982          77 :     ulong r = pgener_Fl(p);
    3983          77 :     GEN pol = galoissubcyclo(utoipos(p), utoipos(Fl_powu(r,n,p)), 0, v);
    3984          77 :     GEN fa = nffactor(nf, pol);
    3985          77 :     if (lgcols(fa) == 2 && linindep(pol,L)) { *pr = utoipos(r); return pol; }
    3986           7 :     set_avma(av);
    3987             :   }
    3988             :   pari_err_BUG("subcycloindep (no suitable prime = 1(mod n))"); /*LCOV_EXCL_LINE*/
    3989             :   *pr = NULL; return NULL; /*LCOV_EXCL_LINE*/
    3990             : }
    3991             : 
    3992             : GEN
    3993          77 : alg_matrix(GEN nf, long n, long v, GEN L, long maxord)
    3994             : {
    3995          77 :   pari_sp av = avma;
    3996             :   GEN pol, gal, rnf, cyclo, g, r, aut;
    3997          77 :   dbg_printf(1)("alg_matrix\n");
    3998          77 :   if (n<=0) pari_err_DOMAIN("alg_matrix", "n", "<=", gen_0, stoi(n));
    3999          70 :   pol = subcycloindep(nf, n, v, L, &r);
    4000          70 :   rnf = rnfinit(nf, pol);
    4001          70 :   cyclo = nfinit(pol, nf_get_prec(nf));
    4002          70 :   gal = galoisinit(cyclo, NULL);
    4003          70 :   g = genefrob(cyclo,gal,r);
    4004          70 :   aut = galoispermtopol(gal,g);
    4005          70 :   return gerepileupto(av, alg_cyclic(rnf, aut, gen_1, maxord));
    4006             : }
    4007             : 
    4008             : GEN
    4009         273 : alg_hilbert(GEN nf, GEN a, GEN b, long v, long maxord)
    4010             : {
    4011         273 :   pari_sp av = avma;
    4012             :   GEN C, P, rnf, aut;
    4013         273 :   dbg_printf(1)("alg_hilbert\n");
    4014         273 :   checknf(nf);
    4015         273 :   if (!isint1(Q_denom(a)))
    4016           7 :     pari_err_DOMAIN("alg_hilbert", "denominator(a)", "!=", gen_1,a);
    4017         266 :   if (!isint1(Q_denom(b)))
    4018           7 :     pari_err_DOMAIN("alg_hilbert", "denominator(b)", "!=", gen_1,b);
    4019             : 
    4020         259 :   if (v < 0) v = 0;
    4021         259 :   C = Rg_col_ei(gneg(a), 3, 3);
    4022         259 :   gel(C,1) = gen_1;
    4023         259 :   P = gtopoly(C,v);
    4024         259 :   rnf = rnfinit(nf, P);
    4025         252 :   aut = gneg(pol_x(v));
    4026         252 :   return gerepileupto(av, alg_cyclic(rnf, aut, b, maxord));
    4027             : }
    4028             : 
    4029             : GEN
    4030        1043 : alginit(GEN A, GEN B, long v, long maxord)
    4031             : {
    4032             :   long w;
    4033        1043 :   switch(nftyp(A))
    4034             :   {
    4035         875 :     case typ_NF:
    4036         875 :       if (v<0) v=0;
    4037         875 :       w = gvar(nf_get_pol(A));
    4038         875 :       if (varncmp(v,w)>=0) pari_err_PRIORITY("alginit", pol_x(v), ">=", w);
    4039         861 :       switch(typ(B))
    4040             :       {
    4041             :         long nB;
    4042          70 :         case t_INT: return alg_matrix(A, itos(B), v, cgetg(1,t_VEC), maxord);
    4043         784 :         case t_VEC:
    4044         784 :           nB = lg(B)-1;
    4045         784 :           if (nB && typ(gel(B,1)) == t_MAT) return alg_csa_table(A,B,v,maxord);
    4046             :           switch(nB)
    4047             :           {
    4048         273 :             case 2: return alg_hilbert(A, gel(B,1), gel(B,2), v, maxord);
    4049         343 :             case 3:
    4050         343 :               if (typ(gel(B,1))!=t_INT)
    4051           7 :                   pari_err_TYPE("alginit [degree should be an integer]", gel(B,1));
    4052         336 :               return alg_hasse(A, itos(gel(B,1)), gel(B,2), gel(B,3), v,
    4053             :                                                                       maxord);
    4054             :           }
    4055             :       }
    4056          14 :       pari_err_TYPE("alginit", B); break;
    4057             : 
    4058         161 :     case typ_RNF:
    4059         161 :       if (typ(B) != t_VEC || lg(B) != 3) pari_err_TYPE("alginit", B);
    4060         147 :       return alg_cyclic(A, gel(B,1), gel(B,2), maxord);
    4061             :   }
    4062           7 :   pari_err_TYPE("alginit", A);
    4063             :   return NULL;/*LCOV_EXCL_LINE*/
    4064             : }
    4065             : 
    4066             : /* assumes al CSA or CYCLIC */
    4067             : static GEN
    4068         833 : algnatmultable(GEN al, long D)
    4069             : {
    4070             :   GEN res, x;
    4071             :   long i;
    4072         833 :   res = cgetg(D+1,t_VEC);
    4073        9793 :   for (i=1; i<=D; i++) {
    4074        8960 :     x = algnattoalg(al,col_ei(D,i));
    4075        8960 :     gel(res,i) = algZmultable(al,x);
    4076             :   }
    4077         833 :   return res;
    4078             : }
    4079             : 
    4080             : /* no garbage collection */
    4081             : static void
    4082         476 : algcomputehasse(GEN al)
    4083             : {
    4084             :   long r1, k, n, m, m1, m2, m3, i, m23, m123;
    4085             :   GEN rnf, nf, b, fab, disc2, cnd, fad, auts, pr, pl, perm, y, hi, PH, H, L;
    4086             : 
    4087         476 :   rnf = alg_get_splittingfield(al);
    4088         476 :   n = rnf_get_degree(rnf);
    4089         476 :   nf = rnf_get_nf(rnf);
    4090         476 :   b = alg_get_b(al);
    4091         476 :   r1 = nf_get_r1(nf);
    4092         476 :   auts = alg_get_auts(al);
    4093         476 :   (void)alg_get_abssplitting(al);
    4094             : 
    4095         476 :   y = nfpolsturm(nf, rnf_get_pol(rnf), NULL);
    4096         476 :   pl = cgetg(r1+1, t_VECSMALL);
    4097             :   /* real places where rnf/nf ramifies */
    4098        1001 :   for (k = 1; k <= r1; k++) pl[k] = !signe(gel(y,k));
    4099             : 
    4100             :   /* infinite Hasse invariants */
    4101         476 :   if (odd(n)) hi = const_vecsmall(r1, 0);
    4102             :   else
    4103             :   {
    4104         406 :     GEN s = nfsign(nf, b);
    4105         406 :     hi = cgetg(r1+1, t_VECSMALL);
    4106         882 :     for (k = 1; k<=r1; k++) hi[k] = (s[k] && pl[k]) ? (n/2) : 0;
    4107             :   }
    4108             : 
    4109         476 :   fab = idealfactor(nf, b);
    4110         476 :   disc2 = rnf_get_idealdisc(rnf);
    4111         476 :   L = nfmakecoprime(nf, &disc2, gel(fab,1));
    4112         476 :   m = lg(L)-1;
    4113             :   /* m1 = #{pr|b: pr \nmid disc}, m3 = #{pr|b: pr | disc} */
    4114         476 :   perm = cgetg(m+1, t_VECSMALL);
    4115         861 :   for (i=1, m1=m, k=1; k<=m; k++)
    4116         385 :     if (signe(gel(L,k))) perm[m1--] = k; else perm[i++] = k;
    4117         476 :   m3 = m - m1;
    4118             : 
    4119             :   /* disc2 : factor of disc coprime to b */
    4120         476 :   fad = idealfactor(nf, disc2);
    4121             :   /* m2 : number of prime factors of disc not dividing b */
    4122         476 :   m2 = nbrows(fad);
    4123         476 :   m23 = m2+m3;
    4124         476 :   m123 = m1+m2+m3;
    4125             : 
    4126             :   /* initialize the possibly ramified primes (hasse) and the factored conductor of rnf/nf (cnd) */
    4127         476 :   cnd = zeromatcopy(m23,2);
    4128         476 :   PH = cgetg(m123+1, t_VEC); /* ramified primes */
    4129         476 :   H = cgetg(m123+1, t_VECSMALL); /* Hasse invariant */
    4130             :   /* compute Hasse invariant at primes that are unramified in rnf/nf */
    4131         826 :   for (k=1; k<=m1; k++) {/* pr | b, pr \nmid disc */
    4132         350 :     long frob, e, j = perm[k];
    4133         350 :     pr = gcoeff(fab,j,1);
    4134         350 :     e = itos(gcoeff(fab,j,2));
    4135         350 :     frob = cyclicrelfrob(rnf, auts, pr);
    4136         350 :     gel(PH,k) = pr;
    4137         350 :     H[k] = Fl_mul(frob, e, n);
    4138             :   }
    4139             :   /* compute Hasse invariant at primes that are ramified in rnf/nf */
    4140         994 :   for (k=1; k<=m2; k++) {/* pr \nmid b, pr | disc */
    4141         518 :     pr = gcoeff(fad,k,1);
    4142         518 :     gel(PH,k+m1) = pr;
    4143         518 :     gcoeff(cnd,k,1) = pr;
    4144         518 :     gcoeff(cnd,k,2) = gcoeff(fad,k,2);
    4145             :   }
    4146         511 :   for (k=1; k<=m3; k++) { /* pr | (b, disc) */
    4147          35 :     long j = perm[k+m1];
    4148          35 :     pr = gcoeff(fab,j,1);
    4149          35 :     gel(PH,k+m1+m2) = pr;
    4150          35 :     gcoeff(cnd,k+m2,1) = pr;
    4151          35 :     gcoeff(cnd,k+m2,2) = gel(L,j);
    4152             :   }
    4153         476 :   gel(cnd,2) = gdiventgs(gel(cnd,2), eulerphiu(n));
    4154        1029 :   for (k=1; k<=m23; k++) H[k+m1] = localhasse(rnf, cnd, pl, auts, b, k);
    4155         476 :   gel(al,4) = hi;
    4156         476 :   perm = gen_indexsort(PH, (void*)&cmp_prime_ideal, &cmp_nodata);
    4157         476 :   gel(al,5) = mkvec2(vecpermute(PH,perm),vecsmallpermute(H,perm));
    4158         476 :   checkhasse(nf,alg_get_hasse_f(al),alg_get_hasse_i(al),n);
    4159         476 : }
    4160             : 
    4161             : static GEN
    4162         749 : alg_maximal_primes(GEN al, GEN P)
    4163             : {
    4164         749 :   pari_sp av = avma;
    4165         749 :   long l = lg(P), i;
    4166        1932 :   for (i=1; i<l; i++)
    4167             :   {
    4168        1183 :     if (i != 1) al = gerepilecopy(av, al);
    4169        1183 :     al = alg_pmaximal(al,gel(P,i));
    4170             :   }
    4171         749 :   return al;
    4172             : }
    4173             : 
    4174             : GEN
    4175         483 : alg_cyclic(GEN rnf, GEN aut, GEN b, long maxord)
    4176             : {
    4177         483 :   pari_sp av = avma;
    4178             :   GEN al, nf;
    4179             :   long D, n, d;
    4180         483 :   dbg_printf(1)("alg_cyclic\n");
    4181         483 :   checkrnf(rnf);
    4182         483 :   if (!isint1(Q_denom(b)))
    4183           7 :     pari_err_DOMAIN("alg_cyclic", "denominator(b)", "!=", gen_1,b);
    4184             : 
    4185         476 :   nf = rnf_get_nf(rnf);
    4186         476 :   n = rnf_get_degree(rnf);
    4187         476 :   d = nf_get_degree(nf);
    4188         476 :   D = d*n*n;
    4189             : 
    4190         476 :   al = cgetg(12,t_VEC);
    4191         476 :   gel(al,10)= gen_0; /* must be set first */
    4192         476 :   gel(al,1) = rnf;
    4193         476 :   gel(al,2) = allauts(rnf, aut);
    4194         476 :   gel(al,3) = basistoalg(nf,b);
    4195         476 :   rnf_build_nfabs(rnf, nf_get_prec(nf));
    4196         476 :   gel(al,6) = gen_0;
    4197         476 :   gel(al,7) = matid(D);
    4198         476 :   gel(al,8) = matid(D); /* TODO modify 7, 8 et 9 once LLL added */
    4199         476 :   gel(al,9) = algnatmultable(al,D);
    4200         476 :   gel(al,11)= algtracebasis(al);
    4201             : 
    4202         476 :   algcomputehasse(al);
    4203             : 
    4204         476 :   if (maxord) {
    4205         413 :     GEN hf = alg_get_hasse_f(al), pr = gel(hf,1);
    4206         413 :     al = alg_maximal_primes(al, pr_primes(pr));
    4207             :   }
    4208         476 :   return gerepilecopy(av, al);
    4209             : }
    4210             : 
    4211             : static int
    4212         378 : ismaximalsubfield(GEN al, GEN x, GEN d, long v, GEN *pt_minpol)
    4213             : {
    4214         378 :   GEN cp = algbasischarpoly(al, x, v), lead;
    4215         378 :   if (!ispower(cp, d, pt_minpol)) return 0;
    4216         378 :   lead = leading_coeff(*pt_minpol);
    4217         378 :   if (isintm1(lead)) *pt_minpol = gneg(*pt_minpol);
    4218         378 :   return ZX_is_irred(*pt_minpol);
    4219             : }
    4220             : 
    4221             : static GEN
    4222         133 : findmaximalsubfield(GEN al, GEN d, long v)
    4223             : {
    4224         133 :   long count, nb=2, i, N = alg_get_absdim(al), n = nf_get_degree(alg_get_center(al));
    4225         133 :   GEN x, minpol, maxc = gen_1;
    4226             : 
    4227         210 :   for (i=n+1; i<=N; i+=n) {
    4228         336 :     for (count=0; count<2 && i+count<=N; count++) {
    4229         259 :       x = col_ei(N,i+count);
    4230         259 :       if (ismaximalsubfield(al, x, d, v, &minpol)) return mkvec2(x,minpol);
    4231             :     }
    4232             :   }
    4233             : 
    4234             :   while(1) {
    4235         119 :     x = zerocol(N);
    4236         504 :     for (count=0; count<nb; count++)
    4237             :     {
    4238         385 :       i = random_Fl(N)+1;
    4239         385 :       gel(x,i) = addiu(randomi(maxc),1);
    4240         385 :       if (random_bits(1)) gel(x,i) = negi(gel(x,i));
    4241             :     }
    4242         119 :     if (ismaximalsubfield(al, x, d, v, &minpol)) return mkvec2(x,minpol);
    4243          56 :     if (!random_bits(3)) maxc = addiu(maxc,1);
    4244          56 :     if (nb<N) nb++;
    4245             :   }
    4246             : 
    4247             :   return NULL; /* LCOV_EXCL_LINE */
    4248             : }
    4249             : 
    4250             : static GEN
    4251         133 : frobeniusform(GEN al, GEN x)
    4252             : {
    4253             :   GEN M, FP, P, Pi;
    4254             : 
    4255             :   /* /!\ has to be the *right* multiplication table */
    4256         133 :   M = algbasisrightmultable(al, x);
    4257             : 
    4258         133 :   FP = matfrobenius(M,2,0); /* M = P^(-1)*F*P */
    4259         133 :   P = gel(FP,2);
    4260         133 :   Pi = RgM_inv(P);
    4261         133 :   return mkvec2(P, Pi);
    4262             : }
    4263             : 
    4264             : static void
    4265         133 : computesplitting(GEN al, long d, long v)
    4266             : {
    4267         133 :   GEN subf, x, pol, polabs, basis, P, Pi, nf = alg_get_center(al), rnf, Lbasis, Lbasisinv, Q, pows;
    4268         133 :   long i, n = nf_get_degree(nf), nd = n*d, N = alg_get_absdim(al), j, j2;
    4269             : 
    4270         133 :   subf = findmaximalsubfield(al, utoipos(d), v);
    4271         133 :   x = gel(subf, 1);
    4272         133 :   polabs = gel(subf, 2);
    4273             : 
    4274             :   /* Frobenius form to obtain L-vector space structure */
    4275         133 :   basis = frobeniusform(al, x);
    4276         133 :   P = gel(basis, 1);
    4277         133 :   Pi = gel(basis, 2);
    4278             : 
    4279             :   /* construct rnf of splitting field */
    4280         133 :   pol = nffactor(nf,polabs);
    4281         133 :   pol = gcoeff(pol,1,1);
    4282         133 :   gel(al,1) = rnf = rnfinit(nf, pol);
    4283             :   /* since pol is irreducible over Q, we have k=0 in rnf. */
    4284         133 :   if (!gequal0(rnf_get_k(rnf)))
    4285             :     pari_err_BUG("computesplitting (k!=0)"); /*LCOV_EXCL_LINE*/
    4286         133 :   gel(al,6) = gen_0;
    4287         133 :   rnf_build_nfabs(rnf, nf_get_prec(nf));
    4288             : 
    4289             :   /* construct splitting data */
    4290         133 :   Lbasis = cgetg(d+1, t_MAT);
    4291         357 :   for (j=j2=1; j<=d; j++, j2+=nd)
    4292         224 :     gel(Lbasis,j) = gel(Pi,j2);
    4293             : 
    4294         133 :   Q = zeromatcopy(d,N);
    4295         133 :   pows = pol_x_powers(nd,v);
    4296         357 :   for (i=j=1; j<=N; j+=nd, i++)
    4297        1085 :   for (j2=0; j2<nd; j2++)
    4298         861 :     gcoeff(Q,i,j+j2) = mkpolmod(gel(pows,j2+1),polabs);
    4299         133 :   Lbasisinv = RgM_mul(Q,P);
    4300             : 
    4301         133 :   gel(al,3) = mkvec3(x,Lbasis,Lbasisinv);
    4302         133 : }
    4303             : 
    4304             : /* assumes that mt defines a central simple algebra over nf */
    4305             : GEN
    4306         161 : alg_csa_table(GEN nf, GEN mt0, long v, long maxord)
    4307             : {
    4308         161 :   pari_sp av = avma;
    4309             :   GEN al, mt;
    4310         161 :   long n, D, d2 = lg(mt0)-1, d = usqrt(d2);
    4311         161 :   dbg_printf(1)("alg_csa_table\n");
    4312             : 
    4313         161 :   nf = checknf(nf);
    4314         161 :   mt = check_relmt(nf,mt0);
    4315         147 :   if (!mt) pari_err_TYPE("alg_csa_table", mt0);
    4316         140 :   n = nf_get_degree(nf);
    4317         140 :   D = n*d2;
    4318         140 :   if (d*d != d2)
    4319           7 :     pari_err_DOMAIN("alg_csa_table","(nonsquare) dimension","!=",stoi(d*d),mt);
    4320             : 
    4321         133 :   al = cgetg(12, t_VEC);
    4322         133 :   gel(al,10) = gen_0; /* must be set first */
    4323         133 :   gel(al,1) = zerovec(12); gmael(al,1,10) = nf;
    4324         133 :   gmael(al,1,1) = gpowgs(pol_x(0), d); /* placeholder before splitting field */
    4325         133 :   gel(al,2) = mt;
    4326         133 :   gel(al,3) = gen_0; /* placeholder */
    4327         133 :   gel(al,4) = gel(al,5) = gen_0; /* TODO Hasse invariants */
    4328         133 :   gel(al,5) = gel(al,6) = gen_0; /* placeholder */
    4329         133 :   gel(al,7) = matid(D);
    4330         133 :   gel(al,8) = matid(D);
    4331         133 :   gel(al,9) = algnatmultable(al,D);
    4332         133 :   gel(al,11)= algtracebasis(al);
    4333         133 :   if (maxord) al = alg_maximal(al);
    4334         133 :   computesplitting(al, d, v);
    4335         133 :   return gerepilecopy(av, al);
    4336             : }
    4337             : 
    4338             : static GEN
    4339       36085 : algtableinit_i(GEN mt0, GEN p)
    4340             : {
    4341             :   GEN al, mt;
    4342             :   long i, n;
    4343             : 
    4344       36085 :   if (p && !signe(p)) p = NULL;
    4345       36085 :   mt = check_mt(mt0,p);
    4346       36085 :   if (!mt) pari_err_TYPE("algtableinit", mt0);
    4347       36085 :   if (!p && !isint1(Q_denom(mt0)))
    4348           7 :     pari_err_DOMAIN("algtableinit", "denominator(mt)", "!=", gen_1, mt0);
    4349       36078 :   n = lg(mt)-1;
    4350       36078 :   al = cgetg(12, t_VEC);
    4351      252546 :   for (i=1; i<=6; i++) gel(al,i) = gen_0;
    4352       36078 :   gel(al,7) = matid(n);
    4353       36078 :   gel(al,8) = matid(n);
    4354       36078 :   gel(al,9) = mt;
    4355       36078 :   gel(al,10) = p? p: gen_0;
    4356       36078 :   gel(al,11)= algtracebasis(al);
    4357       36078 :   return al;
    4358             : }
    4359             : GEN
    4360        4193 : algtableinit(GEN mt0, GEN p)
    4361             : {
    4362        4193 :   pari_sp av = avma;
    4363        4193 :   if (p)
    4364             :   {
    4365        4074 :     if (typ(p) != t_INT) pari_err_TYPE("algtableinit",p);
    4366        4067 :     if (signe(p) && !BPSW_psp(p)) pari_err_PRIME("algtableinit",p);
    4367             :   }
    4368        4172 :   return gerepilecopy(av, algtableinit_i(mt0, p));
    4369             : }
    4370             : 
    4371             : /** REPRESENTATIONS OF GROUPS **/
    4372             : 
    4373             : static GEN
    4374         294 : list_to_regular_rep(GEN elts, long n)
    4375             : {
    4376             :   GEN reg, elts2, g;
    4377             :   long i,j;
    4378         294 :   elts = shallowcopy(elts);
    4379         294 :   gen_sort_inplace(elts, (void*)&vecsmall_lexcmp, &cmp_nodata, NULL);
    4380         294 :   reg = cgetg(n+1, t_VEC);
    4381         294 :   gel(reg,1) = identity_perm(n);
    4382        3857 :   for (i=2; i<=n; i++) {
    4383        3563 :     g = perm_inv(gel(elts,i));
    4384        3563 :     elts2 = cgetg(n+1, t_VEC);
    4385       74543 :     for (j=1; j<=n; j++) gel(elts2,j) = perm_mul(g,gel(elts,j));
    4386        3563 :     gen_sort_inplace(elts2, (void*)&vecsmall_lexcmp, &cmp_nodata, &gel(reg,i));
    4387             :   }
    4388         294 :   return reg;
    4389             : }
    4390             : 
    4391             : static GEN
    4392        3857 : matrix_perm(GEN perm, long n)
    4393             : {
    4394             :   GEN m;
    4395             :   long j;
    4396        3857 :   m = cgetg(n+1, t_MAT);
    4397       78694 :   for (j=1; j<=n; j++) {
    4398       74837 :     gel(m,j) = col_ei(n,perm[j]);
    4399             :   }
    4400        3857 :   return m;
    4401             : }
    4402             : 
    4403             : GEN
    4404         847 : conjclasses_algcenter(GEN cc, GEN p)
    4405             : {
    4406         847 :   GEN mt, elts = gel(cc,1), conjclass = gel(cc,2), rep = gel(cc,3), card;
    4407         847 :   long i, nbcl = lg(rep)-1, n = lg(elts)-1;
    4408             :   pari_sp av;
    4409             : 
    4410         847 :   card = zero_Flv(nbcl);
    4411       14819 :   for (i=1; i<=n; i++) card[conjclass[i]]++;
    4412             : 
    4413             :   /* multiplication table of the center of Z[G] (class functions) */
    4414         847 :   mt = cgetg(nbcl+1,t_VEC);
    4415        7217 :   for (i=1;i<=nbcl;i++) gel(mt,i) = zero_Flm_copy(nbcl,nbcl);
    4416         847 :   av = avma;
    4417        7217 :   for (i=1;i<=nbcl;i++)
    4418             :   {
    4419        6370 :     GEN xi = gel(elts,rep[i]), mi = gel(mt,i);
    4420             :     long j,k;
    4421      132244 :     for (j=1;j<=n;j++)
    4422             :     {
    4423      125874 :       GEN xj = gel(elts,j);
    4424      125874 :       k = vecsearch(elts, perm_mul(xi,xj), NULL);
    4425      125874 :       ucoeff(mi, conjclass[k], conjclass[j])++;
    4426             :     }
    4427       70238 :     for (k=1; k<=nbcl; k++)
    4428      852362 :       for (j=1; j<=nbcl; j++)
    4429             :       {
    4430      788494 :         ucoeff(mi,k,j) *= card[i];
    4431      788494 :         ucoeff(mi,k,j) /= card[k];
    4432             :       }
    4433        6370 :     set_avma(av);
    4434             :   }
    4435        7217 :   for (i=1;i<=nbcl;i++) gel(mt,i) = Flm_to_ZM(gel(mt,i));
    4436         847 :   return algtableinit_i(mt,p);
    4437             : }
    4438             : 
    4439             : GEN
    4440         329 : alggroupcenter(GEN G, GEN p, GEN *pcc)
    4441             : {
    4442         329 :   pari_sp av = avma;
    4443         329 :   GEN cc = group_to_cc(G), al = conjclasses_algcenter(cc, p);
    4444         315 :   if (!pcc) al = gerepilecopy(av,al);
    4445             :   else
    4446           7 :   { *pcc = cc; gerepileall(av,2,&al,pcc); }
    4447         315 :   return al;
    4448             : }
    4449             : 
    4450             : static GEN
    4451         294 : groupelts_algebra(GEN elts, GEN p)
    4452             : {
    4453         294 :   pari_sp av = avma;
    4454             :   GEN mt;
    4455         294 :   long i, n = lg(elts)-1;
    4456         294 :   elts = list_to_regular_rep(elts,n);
    4457         294 :   mt = cgetg(n+1, t_VEC);
    4458        4151 :   for (i=1; i<=n; i++) gel(mt,i) = matrix_perm(gel(elts,i),n);
    4459         294 :   return gerepilecopy(av, algtableinit_i(mt,p));
    4460             : }
    4461             : 
    4462             : GEN
    4463         329 : alggroup(GEN gal, GEN p)
    4464             : {
    4465         329 :   GEN elts = checkgroupelts(gal);
    4466         294 :   return groupelts_algebra(elts, p);
    4467             : }
    4468             : 
    4469             : /** MAXIMAL ORDER **/
    4470             : 
    4471             : GEN
    4472           0 : alg_changeorder(GEN al, GEN ord)
    4473             : {
    4474             :   GEN al2, mt, iord, mtx;
    4475             :   long i, n;
    4476           0 :   pari_sp av = avma;
    4477             : 
    4478           0 :   if (!gequal0(gel(al,10)))
    4479           0 :     pari_err_DOMAIN("alg_changeorder","characteristic","!=",gen_0,gel(al,10));
    4480           0 :   n = alg_get_absdim(al);
    4481             : 
    4482           0 :   iord = QM_inv(ord);
    4483           0 :   al2 = shallowcopy(al);
    4484             : 
    4485           0 :   gel(al2,7) = RgM_mul(gel(al2,7), ord);
    4486             : 
    4487           0 :   gel(al2,8) = RgM_mul(iord, gel(al,8));
    4488             : 
    4489           0 :   mt = cgetg(n+1,t_VEC);
    4490           0 :   gel(mt,1) = matid(n);
    4491           0 :   for (i=2; i<=n; i++) {
    4492           0 :     mtx = algbasismultable(al,gel(ord,i));
    4493           0 :     gel(mt,i) = RgM_mul(iord, RgM_mul(mtx, ord));
    4494             :   }
    4495           0 :   gel(al2,9) = mt;
    4496             : 
    4497           0 :   gel(al2,11) = algtracebasis(al2);
    4498             : 
    4499           0 :   return gerepilecopy(av,al2);
    4500             : }
    4501             : 
    4502             : static GEN
    4503       49147 : mattocol(GEN M, long n)
    4504             : {
    4505       49147 :   GEN C = cgetg(n*n+1, t_COL);
    4506             :   long i,j,ic;
    4507       49147 :   ic = 1;
    4508     1035216 :   for (i=1; i<=n; i++)
    4509    26004468 :   for (j=1; j<=n; j++, ic++) gel(C,ic) = gcoeff(M,i,j);
    4510       49147 :   return C;
    4511             : }
    4512             : 
    4513             : /* Ip is a lift of a left O/pO-ideal where O is the integral basis of al */
    4514             : static GEN
    4515        3619 : algleftordermodp(GEN al, GEN Ip, GEN p)
    4516             : {
    4517        3619 :   pari_sp av = avma;
    4518             :   GEN I, Ii, M, mt, K, imi, p2;
    4519             :   long n, i;
    4520        3619 :   n = alg_get_absdim(al);
    4521        3619 :   mt = alg_get_multable(al);
    4522        3619 :   p2 = sqri(p);
    4523             : 
    4524        3619 :   I = ZM_hnfmodid(Ip, p);
    4525        3619 :   Ii = ZM_inv(I,NULL);
    4526             : 
    4527        3619 :   M = cgetg(n+1, t_MAT);
    4528       52766 :   for (i=1; i<=n; i++) {
    4529       49147 :     imi = FpM_mul(Ii, FpM_mul(gel(mt,i), I, p2), p2);
    4530       49147 :     imi = ZM_Z_divexact(imi, p);
    4531       49147 :     gel(M,i) = mattocol(imi, n);
    4532             :   }
    4533        3619 :   K = FpM_ker(M, p);
    4534        3619 :   if (lg(K)==1) { set_avma(av); return matid(n); }
    4535        1694 :   K = ZM_hnfmodid(K,p);
    4536             : 
    4537        1694 :   return gerepileupto(av, ZM_Z_div(K,p));
    4538             : }
    4539             : 
    4540             : static GEN
    4541        4788 : alg_ordermodp(GEN al, GEN p)
    4542             : {
    4543             :   GEN alp;
    4544        4788 :   long i, N = alg_get_absdim(al);
    4545        4788 :   alp = cgetg(12, t_VEC);
    4546       43092 :   for (i=1; i<=8; i++) gel(alp,i) = gen_0;
    4547        4788 :   gel(alp,9) = cgetg(N+1, t_VEC);
    4548       58072 :   for (i=1; i<=N; i++) gmael(alp,9,i) = FpM_red(gmael(al,9,i), p);
    4549        4788 :   gel(alp,10) = p;
    4550        4788 :   gel(alp,11) = cgetg(N+1, t_VEC);
    4551       58072 :   for (i=1; i<=N; i++) gmael(alp,11,i) = Fp_red(gmael(al,11,i), p);
    4552             : 
    4553        4788 :   return alp;
    4554             : }
    4555             : 
    4556             : static GEN
    4557        2877 : algpradical_i(GEN al, GEN p, GEN zprad, GEN projs)
    4558             : {
    4559        2877 :   pari_sp av = avma;
    4560        2877 :   GEN alp = alg_ordermodp(al, p), liftrad, projrad, alq, alrad, res, Lalp, radq;
    4561             :   long i;
    4562        2877 :   if (lg(zprad)==1) {
    4563        1792 :     liftrad = NULL;
    4564        1792 :     projrad = NULL;
    4565             :   }
    4566             :   else {
    4567        1085 :     alq = alg_quotient(alp, zprad, 1);
    4568        1085 :     alp = gel(alq,1);
    4569        1085 :     projrad = gel(alq,2);
    4570        1085 :     liftrad = gel(alq,3);
    4571             :   }
    4572             : 
    4573        2877 :   if (projs) {
    4574         364 :     if (projrad) {
    4575          28 :       projs = gcopy(projs);
    4576          84 :       for (i=1; i<lg(projs); i++)
    4577          56 :         gel(projs,i) = FpM_FpC_mul(projrad, gel(projs,i), p);
    4578             :     }
    4579         364 :     Lalp = alg_centralproj(alp, projs, 1);
    4580             : 
    4581         364 :     alrad = cgetg(lg(Lalp),t_VEC);
    4582        1561 :     for (i=1; i<lg(Lalp); i++) {
    4583        1197 :       alq = gel(Lalp,i);
    4584        1197 :       radq = algradical(gel(alq,1));
    4585        1197 :       if (gequal0(radq))
    4586         742 :         gel(alrad,i) = cgetg(1,t_MAT);
    4587             :       else {
    4588         455 :         radq = FpM_mul(gel(alq,3),radq,p);
    4589         455 :         gel(alrad,i) = radq;
    4590             :       }
    4591             :     }
    4592         364 :     alrad = shallowmatconcat(alrad);
    4593         364 :     alrad = FpM_image(alrad,p);
    4594             :   }
    4595        2513 :   else alrad = algradical(alp);
    4596             : 
    4597        2877 :   if (!gequal0(alrad)) {
    4598        2212 :     if (liftrad) alrad = FpM_mul(liftrad, alrad, p);
    4599        2212 :     res = shallowmatconcat(mkvec2(alrad, zprad));
    4600        2212 :     res = FpM_image(res,p);
    4601             :   }
    4602         665 :   else res = lg(zprad)==1 ? gen_0 : zprad;
    4603        2877 :   return gerepilecopy(av, res);
    4604             : }
    4605             : 
    4606             : static GEN
    4607        1911 : algpdecompose0(GEN al, GEN prad, GEN p, GEN projs)
    4608             : {
    4609        1911 :   pari_sp av = avma;
    4610        1911 :   GEN alp, quo, ss, liftm = NULL, projm = NULL, dec, res, I, Lss, deci;
    4611             :   long i, j;
    4612             : 
    4613        1911 :   alp = alg_ordermodp(al, p);
    4614        1911 :   if (!gequal0(prad)) {
    4615        1512 :     quo = alg_quotient(alp, prad, 1);
    4616        1512 :     ss = gel(quo,1);
    4617        1512 :     projm = gel(quo,2);
    4618        1512 :     liftm = gel(quo,3);
    4619             :   }
    4620         399 :   else ss = alp;
    4621             : 
    4622        1911 :   if (projs) {
    4623         308 :     if (projm) {
    4624         966 :       for (i=1; i<lg(projs); i++)
    4625         728 :         gel(projs,i) = FpM_FpC_mul(projm, gel(projs,i), p);
    4626             :     }
    4627         308 :     Lss = alg_centralproj(ss, projs, 1);
    4628             : 
    4629         308 :     dec = cgetg(lg(Lss),t_VEC);
    4630        1386 :     for (i=1; i<lg(Lss); i++) {
    4631        1078 :       gel(dec,i) = algsimpledec_ss(gmael(Lss,i,1), 1);
    4632        1078 :       deci = gel(dec,i);
    4633        2394 :       for (j=1; j<lg(deci); j++)
    4634        1316 :        gmael(deci,j,3) = FpM_mul(gmael(Lss,i,3), gmael(deci,j,3), p);
    4635             :     }
    4636         308 :     dec = shallowconcat1(dec);
    4637             :   }
    4638        1603 :   else dec = algsimpledec_ss(ss,1);
    4639             : 
    4640        1911 :   res = cgetg(lg(dec),t_VEC);
    4641        5537 :   for (i=1; i<lg(dec); i++) {
    4642        3626 :     I = gmael(dec,i,3);
    4643        3626 :     if (liftm) I = FpM_mul(liftm,I,p);
    4644        3626 :     I = shallowmatconcat(mkvec2(I,prad));
    4645        3626 :     gel(res,i) = I;
    4646             :   }
    4647             : 
    4648        1911 :   return gerepilecopy(av, res);
    4649             : }
    4650             : 
    4651             : /* finds a nontrivial ideal of O/prad or gen_0 if there is none. */
    4652             : static GEN
    4653         728 : algpdecompose_i(GEN al, GEN p, GEN zprad, GEN projs)
    4654             : {
    4655         728 :   pari_sp av = avma;
    4656         728 :   GEN prad = algpradical_i(al,p,zprad,projs);
    4657         728 :   return gerepileupto(av, algpdecompose0(al, prad, p, projs));
    4658             : }
    4659             : 
    4660             : /* ord is assumed to be in hnf wrt the integral basis of al. */
    4661             : /* assumes that alg_get_invbasis(al) is integral. */
    4662             : static GEN
    4663        1694 : alg_change_overorder_shallow(GEN al, GEN ord)
    4664             : {
    4665             :   GEN al2, mt, iord, mtx, den, den2, div;
    4666             :   long i, n;
    4667        1694 :   n = alg_get_absdim(al);
    4668             : 
    4669        1694 :   iord = QM_inv(ord);
    4670        1694 :   al2 = shallowcopy(al);
    4671        1694 :   ord = Q_remove_denom(ord,&den);
    4672             : 
    4673        1694 :   gel(al2,7) = Q_remove_denom(gel(al,7), &den2);
    4674        1694 :   if (den2) div = mulii(den,den2);
    4675         644 :   else      div = den;
    4676        1694 :   gel(al2,7) = ZM_Z_div(ZM_mul(gel(al2,7), ord), div);
    4677             : 
    4678        1694 :   gel(al2,8) = ZM_mul(iord, gel(al,8));
    4679             : 
    4680        1694 :   mt = cgetg(n+1,t_VEC);
    4681        1694 :   gel(mt,1) = matid(n);
    4682        1694 :   div = sqri(den);
    4683       19194 :   for (i=2; i<=n; i++) {
    4684       17500 :     mtx = algbasismultable(al,gel(ord,i));
    4685       17500 :     gel(mt,i) = ZM_mul(iord, ZM_mul(mtx, ord));
    4686       17500 :     gel(mt,i) = ZM_Z_divexact(gel(mt,i), div);
    4687             :   }
    4688        1694 :   gel(al2,9) = mt;
    4689             : 
    4690        1694 :   gel(al2,11) = algtracebasis(al2);
    4691             : 
    4692        1694 :   return al2;
    4693             : }
    4694             : 
    4695             : static GEN
    4696       10031 : algfromcenter(GEN al, GEN x)
    4697             : {
    4698       10031 :   GEN nf = alg_get_center(al);
    4699             :   long n;
    4700       10031 :   switch(alg_type(al)) {
    4701        8939 :     case al_CYCLIC:
    4702        8939 :       n = alg_get_degree(al);
    4703        8939 :       break;
    4704        1092 :     case al_CSA:
    4705        1092 :       n = alg_get_dim(al);
    4706        1092 :       break;
    4707           0 :     default:
    4708             :       return NULL; /*LCOV_EXCL_LINE*/
    4709             :   }
    4710       10031 :   return algalgtobasis(al, scalarcol(basistoalg(nf, x), n));
    4711             : }
    4712             : 
    4713             : /* x is an ideal of the center in hnf form */
    4714             : static GEN
    4715        2877 : algfromcenterhnf(GEN al, GEN x)
    4716             : {
    4717             :   GEN res;
    4718             :   long i;
    4719        2877 :   res = cgetg(lg(x), t_MAT);
    4720        9198 :   for (i=1; i<lg(x); i++) gel(res,i) = algfromcenter(al, gel(x,i));
    4721        2877 :   return res;
    4722             : }
    4723             : 
    4724             : /* assumes al is CSA or CYCLIC */
    4725             : static GEN
    4726        1183 : algcenter_precompute(GEN al, GEN p)
    4727             : {
    4728        1183 :   GEN fa, pdec, nfprad, projs, nf = alg_get_center(al);
    4729             :   long i, np;
    4730             : 
    4731        1183 :   pdec = idealprimedec(nf, p);
    4732        1183 :   settyp(pdec, t_COL);
    4733        1183 :   np = lg(pdec)-1;
    4734        1183 :   fa = mkmat2(pdec, const_col(np, gen_1));
    4735        1183 :   if (dvdii(nf_get_disc(nf), p))
    4736         329 :     nfprad = idealprodprime(nf, pdec);
    4737             :   else
    4738         854 :     nfprad = scalarmat_shallow(p, nf_get_degree(nf));
    4739        1183 :   fa = idealchineseinit(nf, fa);
    4740        1183 :   projs = cgetg(np+1, t_VEC);
    4741        2772 :   for (i=1; i<=np; i++) gel(projs, i) = idealchinese(nf, fa, vec_ei(np,i));
    4742        1183 :   return mkvec2(nfprad, projs);
    4743             : }
    4744             : 
    4745             : static GEN
    4746        2877 : algcenter_prad(GEN al, GEN p, GEN pre)
    4747             : {
    4748             :   GEN nfprad, zprad, mtprad;
    4749             :   long i;
    4750        2877 :   nfprad = gel(pre,1);
    4751        2877 :   zprad = algfromcenterhnf(al, nfprad);
    4752        2877 :   zprad = FpM_image(zprad, p);
    4753        2877 :   mtprad = cgetg(lg(zprad), t_VEC);
    4754        4564 :   for (i=1; i<lg(zprad); i++) gel(mtprad, i) = algbasismultable(al, gel(zprad,i));
    4755        2877 :   mtprad = shallowmatconcat(mtprad);
    4756        2877 :   zprad = FpM_image(mtprad, p);
    4757        2877 :   return zprad;
    4758             : }
    4759             : 
    4760             : static GEN
    4761        2877 : algcenter_p_projs(GEN al, GEN p, GEN pre)
    4762             : {
    4763             :   GEN projs, zprojs;
    4764             :   long i;
    4765        2877 :   projs = gel(pre,2);
    4766        2877 :   zprojs = cgetg(lg(projs), t_VEC);
    4767        6587 :   for (i=1; i<lg(projs); i++) gel(zprojs,i) = FpC_red(algfromcenter(al, gel(projs,i)),p);
    4768        2877 :   return zprojs;
    4769             : }
    4770             : 
    4771             : /* al is assumed to be simple */
    4772             : static GEN
    4773        1183 : alg_pmaximal(GEN al, GEN p)
    4774             : {
    4775        1183 :   GEN al2, prad, lord = gen_0, I, id, dec, zprad, projs, pre;
    4776             :   long n, i;
    4777        1183 :   n = alg_get_absdim(al);
    4778        1183 :   id = matid(n);
    4779        1183 :   al2 = al;
    4780             : 
    4781        1183 :   dbg_printf(0)("Round 2 (non-commutative) at p=%Ps, dim=%d\n", p, n);
    4782             : 
    4783        1183 :   pre = algcenter_precompute(al,p);
    4784             : 
    4785             :   while (1) {
    4786        2149 :     zprad = algcenter_prad(al2, p, pre);
    4787        2149 :     projs = algcenter_p_projs(al2, p, pre);
    4788        2149 :     if (lg(projs) == 2) projs = NULL;
    4789        2149 :     prad = algpradical_i(al2,p,zprad,projs);
    4790        2149 :     if (typ(prad) == t_INT) break;
    4791        2128 :     lord = algleftordermodp(al2,prad,p);
    4792        2128 :     if (!cmp_universal(lord,id)) break;
    4793         966 :     al2 = alg_change_overorder_shallow(al2,lord);
    4794             :   }
    4795             : 
    4796        1183 :   dec = algpdecompose0(al2,prad,p,projs);
    4797        1911 :   while (lg(dec)>2) {
    4798        1680 :     for (i=1; i<lg(dec); i++) {
    4799        1491 :       I = gel(dec,i);
    4800        1491 :       lord = algleftordermodp(al2,I,p);
    4801        1491 :       if (cmp_universal(lord,matid(n))) break;
    4802             :     }
    4803         917 :     if (i==lg(dec)) break;
    4804         728 :     al2 = alg_change_overorder_shallow(al2,lord);
    4805         728 :     zprad = algcenter_prad(al2, p, pre);
    4806         728 :     projs = algcenter_p_projs(al2, p, pre);
    4807         728 :     if (lg(projs) == 2) projs = NULL;
    4808         728 :     dec = algpdecompose_i(al2,p,zprad,projs);
    4809             :   }
    4810        1183 :   return al2;
    4811             : }
    4812             : 
    4813             : static GEN
    4814        5334 : algtracematrix(GEN al)
    4815             : {
    4816             :   GEN M, mt;
    4817             :   long n, i, j;
    4818        5334 :   n = alg_get_absdim(al);
    4819        5334 :   mt = alg_get_multable(al);
    4820        5334 :   M = cgetg(n+1, t_MAT);
    4821       42595 :   for (i=1; i<=n; i++)
    4822             :   {
    4823       37261 :     gel(M,i) = cgetg(n+1,t_MAT);
    4824      272377 :     for (j=1; j<=i; j++)
    4825      235116 :       gcoeff(M,j,i) = gcoeff(M,i,j) = algabstrace(al,gmael(mt,i,j));
    4826             :   }
    4827        5334 :   return M;
    4828             : }
    4829             : static GEN
    4830         133 : algdisc_i(GEN al) { return ZM_det(algtracematrix(al)); }
    4831             : GEN
    4832           7 : algdisc(GEN al)
    4833             : {
    4834           7 :   pari_sp av = avma;
    4835           7 :   checkalg(al); return gerepileuptoint(av, algdisc_i(al));
    4836             : }
    4837             : static GEN
    4838         126 : alg_maximal(GEN al)
    4839             : {
    4840         126 :   GEN fa = absZ_factor(algdisc_i(al));
    4841         126 :   return alg_maximal_primes(al, gel(fa,1));
    4842             : }
    4843             : 
    4844             : /** LATTICES **/
    4845             : 
    4846             : /*
    4847             :  Convention: lattice = [I,t] representing t*I, where
    4848             :  - I integral nonsingular upper-triangular matrix representing a lattice over
    4849             :    the integral basis of the algebra, and
    4850             :  - t>0 either an integer or a rational number.
    4851             : 
    4852             :  Recommended and returned by the functions below:
    4853             :  - I HNF and primitive
    4854             : */
    4855             : 
    4856             : /* TODO use hnfmodid whenever possible using a*O <= I <= O
    4857             :  * for instance a = ZM_det_triangular(I) */
    4858             : 
    4859             : static GEN
    4860       63343 : primlat(GEN lat)
    4861             : {
    4862             :   GEN m, t, c;
    4863       63343 :   m = alglat_get_primbasis(lat);
    4864       63343 :   t = alglat_get_scalar(lat);
    4865       63343 :   m = Q_primitive_part(m,&c);
    4866       63343 :   if (c) return mkvec2(m,gmul(t,c));
    4867       53760 :   return lat;
    4868             : }
    4869             : 
    4870             : /* assumes the lattice contains d * integral basis, d=0 allowed */
    4871             : GEN
    4872       51065 : alglathnf(GEN al, GEN m, GEN d)
    4873             : {
    4874       51065 :   pari_sp av = avma;
    4875             :   long N,i,j;
    4876             :   GEN m2, c;
    4877       51065 :   checkalg(al);
    4878       51065 :   N = alg_get_absdim(al);
    4879       51065 :   if (!d) d = gen_0;
    4880       51065 :   if (typ(m) == t_VEC) m = matconcat(m);
    4881       51065 :   if (typ(m) == t_COL) m = algleftmultable(al,m);
    4882       51065 :   if (typ(m) != t_MAT) pari_err_TYPE("alglathnf",m);
    4883       51058 :   if (typ(d) != t_FRAC && typ(d) != t_INT) pari_err_TYPE("alglathnf",d);
    4884       51058 :   if (lg(m)-1 < N || lg(gel(m,1))-1 != N) pari_err_DIM("alglathnf");
    4885      459242 :   for (i=1; i<=N; i++)
    4886     6820758 :     for (j=1; j<lg(m); j++)
    4887     6412546 :       if (typ(gcoeff(m,i,j)) != t_FRAC && typ(gcoeff(m,i,j)) != t_INT)
    4888           7 :         pari_err_TYPE("alglathnf", gcoeff(m,i,j));
    4889       51023 :   m2 = Q_primitive_part(m,&c);
    4890       51023 :   if (!c) c = gen_1;
    4891       51023 :   if (!signe(d)) d = detint(m2);
    4892       45593 :   else           d = gdiv(d,c); /* should be an integer */
    4893       51023 :   if (!signe(d)) pari_err_INV("alglathnf [m does not have full rank]", m2);
    4894       51009 :   m2 = ZM_hnfmodid(m2,d);
    4895       51009 :   return gerepilecopy(av, mkvec2(m2,c));
    4896             : }
    4897             : 
    4898             : static GEN
    4899       10689 : prepare_multipliers(GEN *a, GEN *b)
    4900             : {
    4901             :   GEN na, nb, da, db, d;
    4902       10689 :   na = numer_i(*a); da = denom_i(*a);
    4903       10689 :   nb = numer_i(*b); db = denom_i(*b);
    4904       10689 :   na = mulii(na,db);
    4905       10689 :   nb = mulii(nb,da);
    4906       10689 :   d = gcdii(na,nb);
    4907       10689 :   *a = diviiexact(na,d);
    4908       10689 :   *b = diviiexact(nb,d);
    4909       10689 :   return gdiv(d, mulii(da,db));
    4910             : }
    4911             : 
    4912             : static GEN
    4913       10689 : prepare_lat(GEN m1, GEN t1, GEN m2, GEN t2)
    4914             : {
    4915       10689 :   GEN d = prepare_multipliers(&t1, &t2);
    4916       10689 :   m1 = ZM_Z_mul(m1,t1);
    4917       10689 :   m2 = ZM_Z_mul(m2,t2);
    4918       10689 :   return mkvec3(m1,m2,d);
    4919             : }
    4920             : 
    4921             : static GEN
    4922       10689 : alglataddinter(GEN al, GEN lat1, GEN lat2, GEN *sum, GEN *inter)
    4923             : {
    4924             :   GEN d, m1, m2, t1, t2, M, prep, d1, d2, ds, di, K;
    4925       10689 :   checkalg(al);
    4926       10689 :   checklat(al,lat1);
    4927       10689 :   checklat(al,lat2);
    4928             : 
    4929       10689 :   m1 = alglat_get_primbasis(lat1);
    4930       10689 :   t1 = alglat_get_scalar(lat1);
    4931       10689 :   m2 = alglat_get_primbasis(lat2);
    4932       10689 :   t2 = alglat_get_scalar(lat2);
    4933       10689 :   prep = prepare_lat(m1, t1, m2, t2);
    4934       10689 :   m1 = gel(prep,1);
    4935       10689 :   m2 = gel(prep,2);
    4936       10689 :   d = gel(prep,3);
    4937       10689 :   M = matconcat(mkvec2(m1,m2));
    4938       10689 :   d1 = ZM_det_triangular(m1);
    4939       10689 :   d2 = ZM_det_triangular(m2);
    4940       10689 :   ds = gcdii(d1,d2);
    4941       10689 :   if (inter)
    4942             :   {
    4943        7112 :     di = diviiexact(mulii(d1,d2),ds);
    4944        7112 :     K = matkermod(M,di,sum);
    4945        7112 :     K = rowslice(K,1,lg(m1));
    4946        7112 :     *inter = hnfmodid(FpM_mul(m1,K,di),di);
    4947        7112 :     if (sum) *sum = hnfmodid(*sum,ds);
    4948             :   }
    4949        3577 :   else *sum = hnfmodid(M,ds);
    4950       10689 :   return d;
    4951             : }
    4952             : 
    4953             : GEN
    4954        3598 : alglatinter(GEN al, GEN lat1, GEN lat2, GEN* ptsum)
    4955             : {
    4956        3598 :   pari_sp av = avma;
    4957             :   GEN inter, d;
    4958        3598 :   d = alglataddinter(al, lat1, lat2, ptsum, &inter);
    4959        3598 :   inter = primlat(mkvec2(inter, d));
    4960        3598 :   if (ptsum)
    4961             :   {
    4962          14 :     *ptsum = primlat(mkvec2(*ptsum,d));
    4963          14 :     gerepileall(av, 2, &inter, ptsum);
    4964             :   }
    4965        3584 :   else inter = gerepilecopy(av, inter);
    4966        3598 :   return inter;
    4967             : }
    4968             : 
    4969             : GEN
    4970        7091 : alglatadd(GEN al, GEN lat1, GEN lat2, GEN* ptinter)
    4971             : {
    4972        7091 :   pari_sp av = avma;
    4973             :   GEN sum, d;
    4974        7091 :   d = alglataddinter(al, lat1, lat2, &sum, ptinter);
    4975        7091 :   sum = primlat(mkvec2(sum, d));
    4976        7091 :   if (ptinter)
    4977             :   {
    4978        3514 :     *ptinter = primlat(mkvec2(*ptinter,d));
    4979        3514 :     gerepileall(av, 2, &sum, ptinter);
    4980             :   }
    4981        3577 :   else sum = gerepilecopy(av, sum);
    4982        7091 :   return sum;
    4983             : }
    4984             : 
    4985             : int
    4986       31549 : alglatsubset(GEN al, GEN lat1, GEN lat2, GEN* ptindex)
    4987             : {
    4988             :   /* TODO version that returns the quotient as abelian group? */
    4989             :   /* return matrices to convert coordinates from one to other? */
    4990       31549 :   pari_sp av = avma;
    4991             :   int res;
    4992             :   GEN m1, m2, m2i, m, t;
    4993       31549 :   checkalg(al);
    4994       31549 :   checklat(al,lat1);
    4995       31549 :   checklat(al,lat2);
    4996       31549 :   m1 = alglat_get_primbasis(lat1);
    4997       31549 :   m2 = alglat_get_primbasis(lat2);
    4998       31549 :   m2i = RgM_inv_upper(m2);
    4999       31549 :   t = gdiv(alglat_get_scalar(lat1), alglat_get_scalar(lat2));
    5000       31549 :   m = RgM_Rg_mul(RgM_mul(m2i,m1), t);
    5001       31549 :   res = RgM_is_ZM(m);
    5002       31549 :   if (res && ptindex)
    5003             :   {
    5004        1757 :     *ptindex = mpabs(ZM_det_triangular(m));
    5005        1757 :     gerepileall(av,1,ptindex);
    5006             :   }
    5007       29792 :   else set_avma(av);
    5008       31549 :   return res;
    5009             : }
    5010             : 
    5011             : GEN
    5012        5264 : alglatindex(GEN al, GEN lat1, GEN lat2)
    5013             : {
    5014        5264 :   pari_sp av = avma;
    5015             :   long N;
    5016             :   GEN res;
    5017        5264 :   checkalg(al);
    5018        5264 :   checklat(al,lat1);
    5019        5264 :   checklat(al,lat2);
    5020        5264 :   N = alg_get_absdim(al);
    5021        5264 :   res = alglat_get_scalar(lat1);
    5022        5264 :   res = gdiv(res, alglat_get_scalar(lat2));
    5023        5264 :   res = gpowgs(res, N);
    5024        5264 :   res = gmul(res,RgM_det_triangular(alglat_get_primbasis(lat1)));
    5025        5264 :   res = gdiv(res, RgM_det_triangular(alglat_get_primbasis(lat2)));
    5026        5264 :   res = gabs(res,0);
    5027        5264 :   return gerepilecopy(av, res);
    5028             : }
    5029             : 
    5030             : GEN
    5031       45605 : alglatmul(GEN al, GEN lat1, GEN lat2)
    5032             : {
    5033       45605 :   pari_sp av = avma;
    5034             :   long N,i;
    5035             :   GEN m1, m2, m, V, lat, t, d, dp;
    5036       45605 :   checkalg(al);
    5037       45605 :   if (typ(lat1)==t_COL)
    5038             :   {
    5039       19292 :     if (typ(lat2)==t_COL)
    5040           7 :       pari_err_TYPE("alglatmul [one of lat1, lat2 has to be a lattice]", lat2);
    5041       19285 :     checklat(al,lat2);
    5042       19285 :     lat1 = Q_remove_denom(lat1,&d);
    5043       19285 :     m = algbasismultable(al,lat1);
    5044       19285 :     m2 = alglat_get_primbasis(lat2);
    5045       19285 :     dp = mulii(detint(m),ZM_det_triangular(m2));
    5046       19285 :     m = ZM_mul(m,m2);
    5047       19285 :     t = alglat_get_scalar(lat2);
    5048       19285 :     if (d) t = gdiv(t,d);
    5049             :   }
    5050             :   else /* typ(lat1)!=t_COL */
    5051             :   {
    5052       26313 :     checklat(al,lat1);
    5053       26313 :     if (typ(lat2)==t_COL)
    5054             :     {
    5055       19285 :       lat2 = Q_remove_denom(lat2,&d);
    5056       19285 :       m = algbasisrightmultable(al,lat2);
    5057       19285 :       m1 = alglat_get_primbasis(lat1);
    5058       19285 :       dp = mulii(detint(m),ZM_det_triangular(m1));
    5059       19285 :       m = ZM_mul(m,m1);
    5060       19285 :       t = alglat_get_scalar(lat1);
    5061       19285 :       if (d) t = gdiv(t,d);
    5062             :     }
    5063             :     else /* typ(lat2)!=t_COL */
    5064             :     {
    5065        7028 :       checklat(al,lat2);
    5066        7021 :       N = alg_get_absdim(al);
    5067        7021 :       m1 = alglat_get_primbasis(lat1);
    5068        7021 :       m2 = alglat_get_primbasis(lat2);
    5069        7021 :       dp = mulii(ZM_det_triangular(m1), ZM_det_triangular(m2));
    5070        7021 :       V = cgetg(N+1,t_VEC);
    5071       63189 :       for (i=1; i<=N; i++) {
    5072       56168 :         gel(V,i) = algbasismultable(al,gel(m1,i));
    5073       56168 :         gel(V,i) = ZM_mul(gel(V,i),m2);
    5074             :       }
    5075        7021 :       m = matconcat(V);
    5076        7021 :       t = gmul(alglat_get_scalar(lat1), alglat_get_scalar(lat2));
    5077             :     }
    5078             :   }
    5079             : 
    5080       45591 :   lat = alglathnf(al,m,dp);
    5081       45591 :   gel(lat,2) = gmul(alglat_get_scalar(lat), t);
    5082       45591 :   lat = primlat(lat);
    5083       45591 :   return gerepilecopy(av, lat);
    5084             : }
    5085             : 
    5086             : int
    5087       17521 : alglatcontains(GEN al, GEN lat, GEN x, GEN *ptc)
    5088             : {
    5089       17521 :   pari_sp av = avma;
    5090             :   GEN m, t, sol;
    5091       17521 :   checkalg(al);
    5092       17521 :   checklat(al,lat);
    5093       17521 :   m = alglat_get_primbasis(lat);
    5094       17521 :   t = alglat_get_scalar(lat);
    5095       17521 :   x = RgC_Rg_div(x,t);
    5096       17521 :   if (!RgV_is_ZV(x)) return gc_bool(av,0);
    5097       17521 :   sol = hnf_solve(m,x);
    5098       17521 :   if (!sol) return gc_bool(av,0);
    5099        8771 :   if (!ptc) return gc_bool(av,1);
    5100        8764 :   *ptc = sol; gerepileall(av,1,ptc); return 1;
    5101             : }
    5102             : 
    5103             : GEN
    5104        8771 : alglatelement(GEN al, GEN lat, GEN c)
    5105             : {
    5106        8771 :   pari_sp av = avma;
    5107             :   GEN res;
    5108        8771 :   checkalg(al);
    5109        8771 :   checklat(al,lat);
    5110        8771 :   if (typ(c)!=t_COL) pari_err_TYPE("alglatelement", c);
    5111        8764 :   res = ZM_ZC_mul(alglat_get_primbasis(lat),c);
    5112        8764 :   res = RgC_Rg_mul(res, alglat_get_scalar(lat));
    5113        8764 :   return gerepilecopy(av,res);
    5114             : }
    5115             : 
    5116             : /* idem QM_invimZ, knowing result is contained in 1/c*Z^n */
    5117             : static GEN
    5118        3535 : QM_invimZ_mod(GEN m, GEN c)
    5119             : {
    5120             :   GEN d, m0, K;
    5121        3535 :   m0 = Q_remove_denom(m, &d);
    5122        3535 :   if (d)    d = mulii(d,c);
    5123          21 :   else      d = c;
    5124        3535 :   K = matkermod(m0, d, NULL);
    5125        3535 :   if (lg(K)==1) K = scalarmat(d, lg(m)-1);
    5126        3521 :   else          K = hnfmodid(K, d);
    5127        3535 :   return RgM_Rg_div(K,c);
    5128             : }
    5129             : 
    5130             : /* If m is injective, computes a Z-basis of the submodule of elements whose
    5131             :  * image under m is integral */
    5132             : static GEN
    5133          14 : QM_invimZ(GEN m)
    5134             : {
    5135          14 :   return RgM_invimage(m, QM_ImQ_hnf(m));
    5136             : }
    5137             : 
    5138             : /* An isomorphism of R-modules M_{m,n}(R) -> R^{m*n} */
    5139             : static GEN
    5140       28322 : mat2col(GEN M, long m, long n)
    5141             : {
    5142             :   long i,j,k,p;
    5143             :   GEN C;
    5144       28322 :   p = m*n;
    5145       28322 :   C = cgetg(p+1,t_COL);
    5146      254702 :   for (i=1,k=1;i<=m;i++)
    5147     2036804 :     for (j=1;j<=n;j++,k++)
    5148     1810424 :       gel(C,k) = gcoeff(M,i,j);
    5149       28322 :   return C;
    5150             : }
    5151             : 
    5152             : static GEN
    5153        3535 : alglattransporter_i(GEN al, GEN lat1, GEN lat2, long right)
    5154             : {
    5155             :   GEN m1, m2, m2i, M, MT, mt, t1, t2, T, c;
    5156             :   long N, i;
    5157        3535 :   N = alg_get_absdim(al);
    5158        3535 :   m1 = alglat_get_primbasis(lat1);
    5159        3535 :   m2 = alglat_get_primbasis(lat2);
    5160        3535 :   m2i = RgM_inv_upper(m2);
    5161        3535 :   c = detint(m1);
    5162        3535 :   t1 = alglat_get_scalar(lat1);
    5163        3535 :   m1 = RgM_Rg_mul(m1,t1);
    5164        3535 :   t2 = alglat_get_scalar(lat2);
    5165        3535 :   m2i = RgM_Rg_div(m2i,t2);
    5166             : 
    5167        3535 :   MT = right? NULL: alg_get_multable(al);
    5168        3535 :   M = cgetg(N+1, t_MAT);
    5169       31815 :   for (i=1; i<=N; i++) {
    5170       28280 :     if (right) mt = algbasisrightmultable(al, vec_ei(N,i));
    5171       14168 :     else       mt = gel(MT,i);
    5172       28280 :     mt = RgM_mul(m2i,mt);
    5173       28280 :     mt = RgM_mul(mt,m1);
    5174       28280 :     gel(M,i) = mat2col(mt, N, N);
    5175             :   }
    5176             : 
    5177        3535 :   c = gdiv(t2,gmul(c,t1));
    5178        3535 :   c = denom_i(c);
    5179        3535 :   T = QM_invimZ_mod(M,c);
    5180        3535 :   return primlat(mkvec2(T,gen_1));
    5181             : }
    5182             : 
    5183             : /*
    5184             :    { x in al | x*lat1 subset lat2}
    5185             : */
    5186             : GEN
    5187        1771 : alglatlefttransporter(GEN al, GEN lat1, GEN lat2)
    5188             : {
    5189        1771 :   pari_sp av = avma;
    5190        1771 :   checkalg(al);
    5191        1771 :   checklat(al,lat1);
    5192        1771 :   checklat(al,lat2);
    5193        1771 :   return gerepilecopy(av, alglattransporter_i(al,lat1,lat2,0));
    5194             : }
    5195             : 
    5196             : /*
    5197             :    { x in al | lat1*x subset lat2}
    5198             : */
    5199             : GEN
    5200        1764 : alglatrighttransporter(GEN al, GEN lat1, GEN lat2)
    5201             : {
    5202        1764 :   pari_sp av = avma;
    5203        1764 :   checkalg(al);
    5204        1764 :   checklat(al,lat1);
    5205        1764 :   checklat(al,lat2);
    5206        1764 :   return gerepilecopy(av, alglattransporter_i(al,lat1,lat2,1));
    5207             : }
    5208             : 
    5209             : GEN
    5210          42 : algmakeintegral(GEN mt0, long maps)
    5211             : {
    5212          42 :   pari_sp av = avma;
    5213             :   long n,i;
    5214             :   GEN m,P,Pi,mt2,mt;
    5215          42 :   n = lg(mt0)-1;
    5216          42 :   mt = check_mt(mt0,NULL);
    5217          42 :   if (!mt) pari_err_TYPE("algmakeintegral", mt0);
    5218          21 :   if (isint1(Q_denom(mt0))) {
    5219           7 :     if (maps) mt = mkvec3(mt,matid(n),matid(n));
    5220           7 :     return gerepilecopy(av,mt);
    5221             :   }
    5222          14 :   dbg_printf(2)(" algmakeintegral: dim=%d, denom=%Ps\n", n, Q_denom(mt0));
    5223          14 :   m = cgetg(n+1,t_MAT);
    5224          56 :   for (i=1;i<=n;i++)
    5225          42 :     gel(m,i) = mat2col(gel(mt,i),n,n);
    5226          14 :   dbg_printf(2)(" computing order, dims m = %d x %d...\n", nbrows(m), lg(m)-1);
    5227          14 :   P = QM_invimZ(m);
    5228          14 :   dbg_printf(2)(" ...done.\n");
    5229          14 :   P = shallowmatconcat(mkvec2(col_ei(n,1),P));
    5230          14 :   P = hnf(P);
    5231          14 :   Pi = RgM_inv(P);
    5232          14 :   mt2 = change_Rgmultable(mt,P,Pi);
    5233          14 :   if (maps) mt2 = mkvec3(mt2,Pi,P); /* mt2, mt->mt2, mt2->mt */
    5234          14 :   return gerepilecopy(av,mt2);
    5235             : }
    5236             : 
    5237             : /** ORDERS **/
    5238             : 
    5239             : /** IDEALS **/
    5240             : 

Generated by: LCOV version 1.13