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

Generated by: LCOV version 1.16