Code coverage tests

This page documents the degree to which the PARI/GP source code is tested by our public test suite, distributed with the source distribution in directory src/test/. This is measured by the gcov utility; we then process gcov output using the lcov frond-end.

We test a few variants depending on Configure flags on the pari.math.u-bordeaux.fr machine (x86_64 architecture), and agregate them in the final report:

The target is to exceed 90% coverage for all mathematical modules (given that branches depending on DEBUGLEVEL or DEBUGMEM are not covered). This script is run to produce the results below.

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

Generated by: LCOV version 1.16