Code coverage tests

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

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

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

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

Generated by: LCOV version 1.16