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

Generated by: LCOV version 1.16