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

Generated by: LCOV version 1.11