Annotation of OpenXM_contrib/pari-2.2/src/modules/kummer.c, Revision 1.2
1.2 ! noro 1: /* $Id: kummer.c,v 1.48 2002/09/07 01:28:54 karim Exp $
1.1 noro 2:
3: Copyright (C) 2000 The PARI group.
4:
5: This file is part of the PARI/GP package.
6:
7: PARI/GP is free software; you can redistribute it and/or modify it under the
8: terms of the GNU General Public License as published by the Free Software
9: Foundation. It is distributed in the hope that it will be useful, but WITHOUT
10: ANY WARRANTY WHATSOEVER.
11:
12: Check the License for details. You should have received a copy of it, along
13: with the package; see the file 'COPYING'. If not, write to the Free Software
14: Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
15:
16: /*******************************************************************/
17: /* */
18: /* KUMMER EXTENSIONS */
19: /* */
20: /*******************************************************************/
21: #include "pari.h"
1.2 ! noro 22: #include "parinf.h"
! 23: extern GEN gmul_mati_smallvec(GEN x, GEN y);
1.1 noro 24: extern GEN check_and_build_cycgen(GEN bnf);
25: extern GEN get_arch_real(GEN nf,GEN x,GEN *emb,long prec);
26: extern GEN T2_from_embed_norm(GEN x, long r1);
1.2 ! noro 27: extern GEN vconcat(GEN A, GEN B);
! 28: extern long int_elt_val(GEN nf, GEN x, GEN p, GEN b, GEN *newx);
1.1 noro 29:
1.2 ! noro 30: extern GEN famat_inv(GEN f);
! 31: extern GEN famat_pow(GEN f, GEN n);
! 32: extern GEN famat_mul(GEN f, GEN g);
! 33: extern GEN famat_reduce(GEN fa);
! 34: extern GEN famat_ideallog(GEN nf, GEN g, GEN e, GEN bid);
! 35: extern GEN to_famat(GEN g, GEN e);
! 36:
! 37: typedef struct {
! 38: GEN x; /* tau ( Mod(x, nf.pol) ) */
! 39: GEN zk; /* action of tau on nf.zk (as t_MAT) */
! 40: } tau_s;
! 41:
! 42: typedef struct {
! 43: GEN polnf, invexpoteta1;
! 44: tau_s *tau;
! 45: long m;
! 46: } toK_s;
1.1 noro 47:
1.2 ! noro 48: long
! 49: prank(GEN cyc, long ell)
1.1 noro 50: {
1.2 ! noro 51: long i;
! 52: for (i=1; i<lg(cyc); i++)
! 53: if (smodis((GEN)cyc[i],ell)) break;
! 54: return i-1;
! 55: }
1.1 noro 56:
1.2 ! noro 57: /* increment y, which runs through [0,ell-1]^(k-1). Return 0 when done. */
! 58: static int
! 59: increment(GEN y, long k, long ell)
! 60: {
! 61: long i = k, j;
! 62: do
1.1 noro 63: {
1.2 ! noro 64: if (--i == 0) return 0;
! 65: y[i]++;
! 66: } while (y[i] >= ell);
! 67: for (j = i+1; j < k; j++) y[j] = 0;
! 68: return 1;
1.1 noro 69: }
70:
1.2 ! noro 71: /* as above, y increasing (y[i] <= y[i+1]) */
! 72: static int
! 73: increment_inc(GEN y, long k, long ell)
1.1 noro 74: {
1.2 ! noro 75: long i = k, j;
! 76: do
! 77: {
! 78: if (--i == 0) return 0;
! 79: y[i]++;
! 80: } while (y[i] >= ell);
! 81: for (j = i+1; j < k; j++) y[j] = y[i];
! 82: return 1;
! 83: }
1.1 noro 84:
1.2 ! noro 85: static int
! 86: ok_congruence(GEN X, GEN ell, long lW, GEN vecMsup)
! 87: {
! 88: long i, l;
! 89: if (gcmp0(X)) return 0;
! 90: l = lg(X);
! 91: for (i=lW; i<l; i++)
! 92: if (gcmp0((GEN)X[i])) return 0;
! 93: l = lg(vecMsup);
! 94: for (i=1; i<l; i++)
! 95: if (gcmp0(FpV_red(gmul((GEN)vecMsup[i],X), ell))) return 0;
! 96: return 1;
1.1 noro 97: }
98:
99: static int
1.2 ! noro 100: ok_sign(GEN X, GEN msign, GEN arch)
! 101: {
! 102: GEN p1 = lift(gmul(msign,X)); settyp(p1,t_VEC);
! 103: return gegal(p1, arch);
! 104: }
! 105:
! 106: /* REDUCTION MOD ell-TH POWERS */
! 107:
! 108: static GEN
! 109: fix_be(GEN bnfz, GEN be, GEN u)
! 110: {
! 111: GEN nf = checknf(bnfz), fu = gmael(bnfz,8,5);
! 112: return element_mul(nf, be, factorbackelt(fu, u, nf));
! 113: }
! 114:
! 115: static GEN
! 116: logarch2arch(GEN x, long r1, long prec)
1.1 noro 117: {
1.2 ! noro 118: long i, lx = lg(x), tx = typ(x);
! 119: GEN y = cgetg(lx, tx);
! 120:
! 121: if (tx == t_MAT)
1.1 noro 122: {
1.2 ! noro 123: for (i=1; i<lx; i++) y[i] = (long)logarch2arch((GEN)x[i], r1, prec);
! 124: return y;
1.1 noro 125: }
1.2 ! noro 126: for (i=1; i<=r1;i++) y[i] = lexp((GEN)x[i],prec);
! 127: for ( ; i<lx; i++) y[i] = lexp(gmul2n((GEN)x[i],-1),prec);
! 128: return y;
1.1 noro 129: }
130:
1.2 ! noro 131: /* multiply be by ell-th powers of units as to find small L2-norm for new be */
1.1 noro 132: static GEN
1.2 ! noro 133: reducebetanaive(GEN bnfz, GEN be, GEN b, GEN ell)
1.1 noro 134: {
1.2 ! noro 135: long i,k,n,ru,r1, prec = nfgetprec(bnfz);
! 136: GEN z,p1,p2,nmax,c, nf = checknf(bnfz);
1.1 noro 137:
1.2 ! noro 138: r1 = nf_get_r1(nf);
! 139: if (!b)
! 140: {
! 141: if (typ(be) != t_COL) be = algtobasis(nf, be);
! 142: b = gmul(gmael(nf,5,1), be);
! 143: }
! 144: n = max((itos(ell)>>1), 3);
! 145: z = cgetg(n+1, t_VEC);
! 146: c = gmul(greal((GEN)bnfz[3]), ell);
! 147: c = logarch2arch(c, r1, prec); /* = embeddings of fu^ell */
! 148: c = gprec_w(gnorm(c), DEFAULTPREC);
! 149: b = gprec_w(gnorm(b), DEFAULTPREC); /* need little precision */
! 150: z[1] = (long)concatsp(c, vecinv(c));
! 151: for (k=2; k<=n; k++) z[k] = (long) vecmul((GEN)z[1], (GEN)z[k-1]);
! 152: nmax = T2_from_embed_norm(b, r1);
! 153: ru = lg(c)-1; c = zerovec(ru);
1.1 noro 154: for(;;)
155: {
1.2 ! noro 156: GEN B = NULL;
! 157: long besti = 0, bestk = 0;
! 158: for (k=1; k<=n; k++)
! 159: for (i=1; i<=ru; i++)
1.1 noro 160: {
1.2 ! noro 161: p1 = vecmul(b, gmael(z,k,i)); p2 = T2_from_embed_norm(p1,r1);
! 162: if (gcmp(p2,nmax) < 0) { B=p1; nmax=p2; besti=i; bestk = k; continue; }
! 163: p1 = vecmul(b, gmael(z,k,i+ru)); p2 = T2_from_embed_norm(p1,r1);
! 164: if (gcmp(p2,nmax) < 0) { B=p1; nmax=p2; besti=i; bestk =-k; }
1.1 noro 165: }
1.2 ! noro 166: if (!B) break;
! 167: b = B; c[besti] = laddis((GEN)c[besti], bestk);
1.1 noro 168: }
1.2 ! noro 169: if (DEBUGLEVEL) fprintferr("naive reduction mod U^l: unit exp. = %Z\n",c);
! 170: return fix_be(bnfz, be, gmul(ell,c));
1.1 noro 171: }
172:
173: static GEN
1.2 ! noro 174: reduce_mod_Qell(GEN bnfz, GEN be, GEN gell)
1.1 noro 175: {
1.2 ! noro 176: GEN c, fa;
! 177: if (typ(be) != t_COL) be = algtobasis(bnfz, be);
! 178: be = primitive_part(be, &c);
! 179: if (c)
! 180: {
! 181: fa = factor(c);
! 182: fa[2] = (long)FpV_red((GEN)fa[2], gell);
! 183: c = factorback(fa, NULL);
! 184: be = gmul(be, c);
! 185: }
! 186: return be;
1.1 noro 187: }
188:
1.2 ! noro 189: /* return q, q^n r = x, v_pr(r) < n for all pr. Insist q is a genuine n-th
! 190: * root (i.e r = 1) if strict != 0. */
1.1 noro 191: static GEN
1.2 ! noro 192: idealsqrtn(GEN nf, GEN x, GEN gn, int strict)
1.1 noro 193: {
1.2 ! noro 194: long i, l, n = itos(gn);
! 195: GEN fa, q, Ex, Pr;
1.1 noro 196:
1.2 ! noro 197: fa = idealfactor(nf, x);
! 198: Pr = (GEN)fa[1]; l = lg(Pr);
! 199: Ex = (GEN)fa[2]; q = NULL;
! 200: for (i=1; i<l; i++)
! 201: {
! 202: long ex = itos((GEN)Ex[i]);
! 203: GEN e = stoi(ex / n);
! 204: if (strict && ex % n) err(talker,"not an n-th power in idealsqrtn");
! 205: if (q) q = idealmulpowprime(nf, q, (GEN)Pr[i], e);
! 206: else q = idealpow(nf, (GEN)Pr[i], e);
! 207: }
! 208: return q? q: gun;
1.1 noro 209: }
210:
211: static GEN
1.2 ! noro 212: reducebeta(GEN bnfz, GEN be, GEN ell)
1.1 noro 213: {
1.2 ! noro 214: long j,ru, prec = nfgetprec(bnfz);
! 215: GEN emb,z,u,matunit, nf = checknf(bnfz);
1.1 noro 216:
1.2 ! noro 217: if (DEBUGLEVEL>1) fprintferr("reducing beta = %Z\n",be);
! 218: /* reduce mod Q^ell */
! 219: be = reduce_mod_Qell(nf, be, ell);
! 220: /* reduce l-th root */
! 221: z = idealsqrtn(nf, be, ell, 0);
! 222: if (typ(z) == t_MAT && !gcmp1(gcoeff(z,1,1)))
! 223: {
! 224: z = idealred_elt(nf, z);
! 225: be = element_div(nf, be, element_pow(nf, z, ell));
! 226: /* make be integral */
! 227: be = reduce_mod_Qell(nf, be, ell);
! 228: }
! 229: if (DEBUGLEVEL>1) fprintferr("beta reduced via ell-th root = %Z\n",be);
1.1 noro 230:
1.2 ! noro 231: matunit = gmul(greal((GEN)bnfz[3]), ell); /* log. embeddings of fu^ell */
! 232: for (;;)
1.1 noro 233: {
1.2 ! noro 234: z = get_arch_real(nf, be, &emb, prec);
! 235: if (z) break;
! 236: prec = (prec-1)<<1;
! 237: if (DEBUGLEVEL) err(warnprec,"reducebeta",prec);
! 238: nf = nfnewprec(nf,prec);
! 239: }
! 240: z = concatsp(matunit, z);
! 241: u = lllintern(z, 100, 1, prec);
! 242: if (u)
1.1 noro 243: {
1.2 ! noro 244: ru = lg(u);
! 245: for (j=1; j < ru; j++)
! 246: if (gcmp1(gcoeff(u,ru-1,j))) break;
! 247: if (j < ru)
1.1 noro 248: {
1.2 ! noro 249: u = (GEN)u[j]; /* coords on (fu^ell, be) of a small generator */
! 250: ru--; setlg(u, ru);
! 251: be = fix_be(bnfz, be, gmul(ell,u));
1.1 noro 252: }
253: }
1.2 ! noro 254: if (DEBUGLEVEL>1) fprintferr("beta LLL-reduced mod U^l = %Z\n",be);
! 255: return reducebetanaive(bnfz, be, NULL, ell);
! 256: }
! 257:
! 258: static GEN
! 259: tauofalg(GEN x, GEN U) {
! 260: return gsubst(lift(x), varn(U[1]), U);
! 261: }
! 262:
! 263: static tau_s *
! 264: get_tau(tau_s *tau, GEN nf, GEN U)
! 265: {
! 266: GEN bas = (GEN)nf[7], Uzk;
! 267: long i, l = lg(bas);
! 268: Uzk = cgetg(l, t_MAT);
1.1 noro 269: for (i=1; i<l; i++)
1.2 ! noro 270: Uzk[i] = (long)algtobasis(nf, tauofalg((GEN)bas[i], U));
! 271: tau->zk = Uzk;
! 272: tau->x = U; return tau;
! 273: }
! 274:
! 275: static GEN tauoffamat(GEN x, tau_s *tau);
! 276:
! 277: static GEN
! 278: tauofelt(GEN x, tau_s *tau)
! 279: {
! 280: switch(typ(x))
1.1 noro 281: {
1.2 ! noro 282: case t_COL: return gmul(tau->zk, x);
! 283: case t_MAT: return tauoffamat(x, tau);
! 284: default: return tauofalg(x, tau->x);
1.1 noro 285: }
286: }
1.2 ! noro 287: static GEN
! 288: tauofvec(GEN x, tau_s *tau)
! 289: {
! 290: long i, l = lg(x);
! 291: GEN y = cgetg(l, typ(x));
1.1 noro 292:
1.2 ! noro 293: for (i=1; i<l; i++) y[i] = (long)tauofelt((GEN)x[i], tau);
! 294: return y;
! 295: }
! 296: /* [x, tau(x), ..., tau^m(x)] */
1.1 noro 297: static GEN
1.2 ! noro 298: powtau(GEN x, long m, tau_s *tau)
1.1 noro 299: {
1.2 ! noro 300: GEN y = cgetg(m+1, t_VEC);
! 301: long i;
! 302: y[1] = (long)x;
! 303: for (i=2; i<=m; i++) y[i] = (long)tauofelt((GEN)y[i-1], tau);
! 304: return y;
! 305: }
1.1 noro 306:
1.2 ! noro 307: static GEN
! 308: tauoffamat(GEN x, tau_s *tau)
! 309: {
! 310: GEN y = cgetg(3, t_MAT);
! 311: y[1] = (long)tauofvec((GEN)x[1], tau);
! 312: y[2] = x[2]; return y;
1.1 noro 313: }
314:
1.2 ! noro 315: /* TODO: wasteful to reduce to 2-elt form. Compute image directly */
1.1 noro 316: static GEN
1.2 ! noro 317: tauofideal(GEN nfz, GEN id, tau_s *tau)
1.1 noro 318: {
1.2 ! noro 319: GEN I = ideal_two_elt(nfz,id);
! 320: I[2] = (long)tauofelt((GEN)I[2], tau);
! 321: return prime_to_ideal(nfz,I);
1.1 noro 322: }
323:
1.2 ! noro 324: static int
! 325: isprimeidealconj(GEN nfz, GEN pr1, GEN pr2, tau_s *tau)
1.1 noro 326: {
1.2 ! noro 327: GEN p = (GEN)pr1[1];
! 328: GEN x = (GEN)pr1[2];
! 329: GEN b1= (GEN)pr1[5];
! 330: GEN b2= (GEN)pr2[5];
! 331: if (!egalii(p, (GEN)pr2[1])
! 332: || !egalii((GEN)pr1[3], (GEN)pr2[3])
! 333: || !egalii((GEN)pr1[4], (GEN)pr2[4])) return 0;
! 334: if (gegal(x,(GEN)pr2[2])) return 1;
! 335: for(;;)
1.1 noro 336: {
1.2 ! noro 337: if (int_elt_val(nfz,x,p,b2,NULL)) return 1;
! 338: x = FpV_red(tauofelt(x, tau), p);
! 339: if (int_elt_val(nfz,x,p,b1,NULL)) return 0;
1.1 noro 340: }
341: }
342:
1.2 ! noro 343: static int
! 344: isconjinprimelist(GEN nfz, GEN S, GEN pr, tau_s *tau)
1.1 noro 345: {
1.2 ! noro 346: long i, l;
! 347:
! 348: if (!tau) return 0;
! 349: l = lg(S);
! 350: for (i=1; i<l; i++)
! 351: if (isprimeidealconj(nfz, (GEN)S[i],pr,tau)) return 1;
1.1 noro 352: return 0;
353: }
354:
1.2 ! noro 355: static GEN
! 356: downtoK(toK_s *T, GEN x)
1.1 noro 357: {
1.2 ! noro 358: long degKz = lg(T->invexpoteta1) - 1;
! 359: GEN y = gmul(T->invexpoteta1, pol_to_vec(lift(x), degKz));
! 360: return gmodulcp(gtopolyrev(y,varn(T->polnf)), T->polnf);
1.1 noro 361: }
362:
363: static GEN
1.2 ! noro 364: tracetoK(toK_s *T, GEN x)
1.1 noro 365: {
1.2 ! noro 366: GEN p1 = x;
1.1 noro 367: long i;
1.2 ! noro 368: for (i=1; i < T->m; i++) p1 = gadd(x, tauofelt(p1,T->tau));
! 369: return downtoK(T, p1);
1.1 noro 370: }
371:
372: static GEN
1.2 ! noro 373: normtoK(toK_s *T, GEN x)
1.1 noro 374: {
1.2 ! noro 375: GEN p1 = x;
1.1 noro 376: long i;
1.2 ! noro 377: for (i=1; i < T->m; i++) p1 = gmul(x, tauofelt(p1,T->tau));
! 378: return downtoK(T, p1);
! 379: }
1.1 noro 380:
1.2 ! noro 381: static GEN
! 382: no_sol(long all, int i)
! 383: {
! 384: if (!all) err(talker,"bug%d in kummer",i);
! 385: return cgetg(1,t_VEC);
1.1 noro 386: }
387:
388: static GEN
1.2 ! noro 389: get_gell(GEN bnr, GEN subgp, long all)
1.1 noro 390: {
1.2 ! noro 391: GEN gell;
! 392: if (all) gell = stoi(all);
! 393: else if (subgp) gell = det(subgp);
! 394: else gell = det(diagonal(gmael(bnr,5,2)));
! 395: if (typ(gell) != t_INT) err(arither1);
! 396: return gell;
! 397: }
! 398:
! 399: typedef struct {
! 400: GEN Sm, Sml1, Sml2, Sl, ESml2;
! 401: } primlist;
! 402:
! 403: static int
! 404: build_list_Hecke(primlist *L, GEN nfz, GEN fa, GEN gothf, GEN gell, tau_s *tau)
! 405: {
! 406: GEN listpr, listex, pr, p, factell;
! 407: long vd, vp, e, i, l, ell = itos(gell), degKz = degpol(nfz[1]);
1.1 noro 408:
1.2 ! noro 409: if (!fa) fa = idealfactor(nfz, gothf);
! 410: listpr = (GEN)fa[1];
! 411: listex = (GEN)fa[2]; l = lg(listpr);
! 412: L->Sm = cget1(l,t_VEC);
! 413: L->Sml1= cget1(l,t_VEC);
! 414: L->Sml2= cget1(l,t_VEC);
! 415: L->Sl = cget1(l+degKz,t_VEC);
! 416: L->ESml2=cget1(l,t_VECSMALL);
! 417: for (i=1; i<l; i++)
! 418: {
! 419: pr = (GEN)listpr[i]; p = (GEN)pr[1]; e = itos((GEN)pr[3]);
! 420: vp = itos((GEN)listex[i]);
! 421: if (!egalii(p,gell))
! 422: {
! 423: if (vp != 1) return 1;
! 424: if (!isconjinprimelist(nfz, L->Sm,pr,tau)) appendL(L->Sm,pr);
! 425: }
! 426: else
! 427: {
! 428: vd = (vp-1)*(ell-1)-ell*e;
! 429: if (vd > 0) return 4;
! 430: if (vd==0)
! 431: {
! 432: if (!isconjinprimelist(nfz, L->Sml1,pr,tau)) appendL(L->Sml1, pr);
! 433: }
! 434: else
! 435: {
! 436: if (vp==1) return 2;
! 437: if (!isconjinprimelist(nfz, L->Sml2,pr,tau))
! 438: {
! 439: appendL(L->Sml2, pr);
! 440: appendL(L->ESml2,(GEN)vp);
! 441: }
! 442: }
! 443: }
! 444: }
! 445: factell = primedec(nfz,gell); l = lg(factell);
! 446: for (i=1; i<l; i++)
1.1 noro 447: {
1.2 ! noro 448: pr = (GEN)factell[i];
! 449: if (!idealval(nfz,gothf,pr))
! 450: if (!isconjinprimelist(nfz, L->Sl,pr,tau)) appendL(L->Sl, pr);
1.1 noro 451: }
1.2 ! noro 452: return 0; /* OK */
1.1 noro 453: }
454:
455: static GEN
1.2 ! noro 456: logall(GEN nf, GEN vec, long lW, long mginv, long ell, GEN pr, long ex)
1.1 noro 457: {
1.2 ! noro 458: GEN m, M, bid = zidealstarinitgen(nf, idealpows(nf, pr, ex));
! 459: long ellrank, i, l = lg(vec);
1.1 noro 460:
1.2 ! noro 461: ellrank = prank(gmael(bid,2,2), ell);
! 462: M = cgetg(l,t_MAT);
! 463: for (i=1; i<l; i++)
1.1 noro 464: {
1.2 ! noro 465: m = zideallog(nf, (GEN)vec[i], bid);
! 466: setlg(m, ellrank+1);
! 467: if (i < lW) m = gmulsg(mginv, m);
! 468: M[i] = (long)m;
1.1 noro 469: }
1.2 ! noro 470: return M;
1.1 noro 471: }
472:
1.2 ! noro 473: /* compute the u_j (see remark 5.2.15.) */
1.1 noro 474: static GEN
1.2 ! noro 475: get_u(GEN cyc, long rc, GEN gell)
1.1 noro 476: {
1.2 ! noro 477: long i, l = lg(cyc);
! 478: GEN u = cgetg(l,t_VEC);
! 479: for (i=1; i<=rc; i++) u[i] = zero;
! 480: for ( ; i< l; i++) u[i] = lmpinvmod((GEN)cyc[i], gell);
! 481: return u;
1.1 noro 482: }
483:
1.2 ! noro 484: /* alg. 5.2.15. with remark */
1.1 noro 485: static GEN
1.2 ! noro 486: isprincipalell(GEN bnfz, GEN id, GEN cycgen, GEN u, GEN gell, long rc)
1.1 noro 487: {
1.2 ! noro 488: long i, l = lg(cycgen);
! 489: GEN logdisc, b, y = quick_isprincipalgen(bnfz, id);
1.1 noro 490:
1.2 ! noro 491: logdisc = gmod((GEN)y[1], gell);
! 492: b = (GEN)y[2];
! 493: for (i=rc+1; i<l; i++)
1.1 noro 494: {
1.2 ! noro 495: GEN e = modii(mulii((GEN)logdisc[i],(GEN)u[i]), gell);
! 496: if (signe(e)) b = famat_mul(b, famat_pow((GEN)cycgen[i], e));
1.1 noro 497: }
1.2 ! noro 498: y = cgetg(3,t_VEC);
! 499: y[1] = (long)logdisc; setlg(logdisc,rc+1);
! 500: y[2] = (long)b; return y;
1.1 noro 501: }
502:
503: static GEN
1.2 ! noro 504: famat_factorback(GEN v, GEN e)
1.1 noro 505: {
1.2 ! noro 506: long i, l = lg(e);
! 507: GEN V = cgetg(1, t_MAT);
! 508: for (i=1; i<l; i++)
! 509: if (signe(e[i])) V = famat_mul(V, famat_pow((GEN)v[i], (GEN)e[i]));
! 510: return V;
1.1 noro 511: }
512:
513: static GEN
1.2 ! noro 514: compute_beta(GEN X, GEN vecWB, GEN ell, GEN bnfz)
1.1 noro 515: {
1.2 ! noro 516: GEN BE, be;
! 517: BE = famat_reduce(famat_factorback(vecWB, X));
! 518: BE[2] = (long)centermod((GEN)BE[2], ell);
! 519: be = factorbackelt(BE, bnfz, NULL);
! 520: be = reducebeta(bnfz, be, ell);
! 521: if (DEBUGLEVEL>1) fprintferr("beta reduced = %Z\n",be);
! 522: return basistoalg(bnfz, be); /* FIXME */
1.1 noro 523: }
524:
525: static GEN
1.2 ! noro 526: get_Selmer(GEN bnf, GEN cycgen, long rc)
1.1 noro 527: {
1.2 ! noro 528: GEN fu = check_units(bnf,"rnfkummer");
! 529: GEN tu = gmael3(bnf,8,4,2);
! 530: return concatsp(algtobasis(bnf,concatsp(fu,tu)), vecextract_i(cycgen,1,rc));
1.1 noro 531: }
532:
1.2 ! noro 533: /* if all!=0, give all equations of degree 'all'. Assume bnr modulus is the
! 534: * conductor */
1.1 noro 535: static GEN
1.2 ! noro 536: rnfkummersimple(GEN bnr, GEN subgroup, GEN gell, long all)
1.1 noro 537: {
1.2 ! noro 538: long ell, i, j, degK, dK;
! 539: long lSml2, lSl2, lSp, rc, lW;
! 540: long prec;
1.1 noro 541:
1.2 ! noro 542: GEN bnf,nf,bid,ideal,arch,cycgen;
! 543: GEN clgp,cyc;
! 544: GEN Sp,listprSp,matP;
! 545: GEN res,u,M,K,y,vecMsup,vecW,vecWB,vecBp,msign;
! 546: primlist L;
1.1 noro 547:
1.2 ! noro 548: bnf = (GEN)bnr[1];
! 549: nf = (GEN)bnf[7];
! 550: degK = degpol(nf[1]);
! 551:
! 552: bid = (GEN)bnr[2];
! 553: ideal= gmael(bid,1,1);
! 554: arch = gmael(bid,1,2); /* this is the conductor */
! 555: ell = itos(gell);
! 556: i = build_list_Hecke(&L, nf, (GEN)bid[3], ideal, gell, NULL);
! 557: if (i) return no_sol(all,i);
1.1 noro 558:
1.2 ! noro 559: lSml2 = lg(L.Sml2)-1;
! 560: Sp = concatsp(L.Sm, L.Sml1); lSp = lg(Sp)-1;
! 561: listprSp = concatsp(L.Sml2, L.Sl); lSl2 = lg(listprSp)-1;
1.1 noro 562:
1.2 ! noro 563: cycgen = check_and_build_cycgen(bnf);
! 564: clgp = gmael(bnf,8,1);
! 565: cyc = (GEN)clgp[2]; rc = prank(cyc, ell);
1.1 noro 566:
1.2 ! noro 567: vecW = get_Selmer(bnf, cycgen, rc);
! 568: u = get_u(cyc, rc, gell);
1.1 noro 569:
1.2 ! noro 570: vecBp = cgetg(lSp+1, t_VEC);
! 571: matP = cgetg(lSp+1, t_MAT);
! 572: for (j=1; j<=lSp; j++)
! 573: {
! 574: GEN e, a, L;
! 575: L = isprincipalell(bnf,(GEN)Sp[j], cycgen,u,gell,rc);
! 576: e = (GEN)L[1]; matP[j] = (long)e;
! 577: a = (GEN)L[2]; vecBp[j] = (long)a;
! 578: }
! 579: vecWB = concatsp(vecW, vecBp);
! 580:
! 581: prec = DEFAULTPREC +
! 582: ((gexpo(vecWB) + gexpo(gmael(nf,5,1))) >> TWOPOTBYTES_IN_LONG);
! 583: if (nfgetprec(nf) < prec) nf = nfnewprec(nf, prec);
! 584: msign = zsigns(nf, vecWB);
1.1 noro 585:
1.2 ! noro 586: vecMsup = cgetg(lSml2+1,t_VEC);
! 587: M = NULL;
! 588: for (i=1; i<=lSl2; i++)
1.1 noro 589: {
1.2 ! noro 590: GEN pr = (GEN)listprSp[i];
! 591: long e = itos((GEN)pr[3]), z = ell * (e / (ell-1));
1.1 noro 592:
1.2 ! noro 593: if (i <= lSml2)
1.1 noro 594: {
1.2 ! noro 595: z += 1 - L.ESml2[i];
! 596: vecMsup[i] = (long)logall(nf, vecWB, 0,0, ell, pr,z+1);
! 597: }
! 598: M = vconcat(M, logall(nf, vecWB, 0,0, ell, pr,z));
! 599: }
! 600: lW = lg(vecW);
! 601: M = vconcat(M, concatsp(zeromat(rc,lW-1), matP));
! 602:
! 603: K = FpM_ker(M, gell);
! 604: dK = lg(K)-1;
! 605: y = cgetg(dK+1,t_VECSMALL);
! 606: res = cgetg(1,t_VEC); /* in case all = 1 */
! 607: while (dK)
! 608: {
! 609: for (i=1; i<dK; i++) y[i] = 0;
! 610: y[i] = 1; /* y = [0,...,0,1,0,...,0], 1 at dK'th position */
! 611: do
! 612: {
! 613: GEN be, P, X = FpV_red(gmul_mati_smallvec(K, y), gell);
! 614: if (ok_congruence(X, gell, lW, vecMsup) && ok_sign(X, msign, arch))
! 615: {/* be satisfies all congruences, x^ell - be is irreducible, signature
! 616: * and relative discriminant are correct */
! 617: be = compute_beta(X, vecWB, gell, bnf);
! 618: P = gsub(gpowgs(polx[0],ell), be);
! 619: if (!all && gegal(rnfnormgroup(bnr,P),subgroup)) return P; /*DONE*/
! 620: res = concatsp(res, P);
1.1 noro 621: }
1.2 ! noro 622: } while (increment(y, dK, ell));
! 623: y[dK--] = 0;
1.1 noro 624: }
1.2 ! noro 625: if (all) return res;
! 626: return gzero;
1.1 noro 627: }
628:
1.2 ! noro 629: /* alg. 5.3.11 (return only discrete log mod ell) */
1.1 noro 630: static GEN
1.2 ! noro 631: isvirtualunit(GEN bnf, GEN v, GEN cycgen, GEN cyc, GEN gell, long rc)
1.1 noro 632: {
1.2 ! noro 633: GEN L, b, eps, y, q, nf = checknf(bnf);
! 634: long i, l = lg(cycgen);
! 635:
! 636: L = quick_isprincipalgen(bnf, idealsqrtn(nf, v, gell, 1));
! 637: q = (GEN)L[1];
! 638: if (gcmp0(q)) { eps = v; y = q; }
! 639: else
! 640: {
! 641: b = (GEN)L[2];
! 642: y = cgetg(l,t_COL);
! 643: for (i=1; i<l; i++)
! 644: y[i] = (long)diviiexact(mulii(gell,(GEN)q[i]), (GEN)cyc[i]);
! 645: eps = famat_mul(famat_factorback(cycgen, y), famat_pow(b, gell));
! 646: eps = famat_mul(famat_inv(eps), v);
! 647: }
! 648: setlg(y, rc+1);
! 649: b = isunit(bnf,eps);
! 650: if (lg(b) == 1) err(bugparier,"isvirtualunit");
! 651: return concatsp(lift_intern(b), y);
1.1 noro 652: }
653:
1.2 ! noro 654: /* id a vector of elements in nfz = relative extension of nf by polrel,
! 655: * return the Steinitz element associated to the module generated by id */
1.1 noro 656: static GEN
1.2 ! noro 657: steinitzaux(GEN nf, GEN id, GEN polrel)
1.1 noro 658: {
1.2 ! noro 659: long i, degKz = lg(id)-1, degK = degpol(nf[1]);
! 660: GEN V = dummycopy(id),vecid,matid,pseudomat,pid;
! 661:
! 662: vecid = cgetg(degKz+1,t_VEC); matid = idmat(degK);
! 663: for (i=1; i<=degKz; i++) vecid[i] = (long)matid;
! 664: for (i=1; i<=degKz; i++)
! 665: {
! 666: GEN v = (GEN)V[i];
! 667: if (typ(v) == t_POL) { v = dummycopy(v); setvarn(v, 0); }
! 668: V[i] = (long)gmod(v, polrel);
! 669: }
! 670: pseudomat = cgetg(3,t_VEC);
! 671: pseudomat[1] = (long)vecpol_to_mat(V, degpol(polrel));
! 672: pseudomat[2] = (long)vecid;
! 673: pid = (GEN)nfhermite(nf,pseudomat)[2];
! 674: return factorback(pid, nf); /* product */
1.1 noro 675: }
676:
677: static GEN
1.2 ! noro 678: polrelKzK(toK_s *T, GEN x)
1.1 noro 679: {
1.2 ! noro 680: GEN P = roots_to_pol(powtau(x, T->m, T->tau), 0);
! 681: long i, l = lg(P);
! 682: for (i=2; i<l; i++) P[i] = (long)downtoK(T, (GEN)P[i]);
! 683: return P;
1.1 noro 684: }
685:
1.2 ! noro 686: /* N: Cl_m(Kz) --> Cl_m(K), lift subgroup from bnr to bnrz using Algo 4.1.11 */
1.1 noro 687: static GEN
1.2 ! noro 688: invimsubgroup(GEN bnrz, GEN bnr, GEN subgroup, toK_s *T)
1.1 noro 689: {
1.2 ! noro 690: long l, j;
! 691: GEN P,raycycz,rayclgpz,raygenz,U,polrel,steinitzZk;
! 692: GEN nf = checknf(bnr), nfz = checknf(bnrz), polz = (GEN)nfz[1];
1.1 noro 693:
1.2 ! noro 694: polrel = polrelKzK(T, polx[varn(polz)]);
! 695: steinitzZk = steinitzaux(nf, (GEN)nfz[7], polrel);
! 696: rayclgpz = (GEN)bnrz[5];
! 697: raycycz = (GEN)rayclgpz[2]; l = lg(raycycz);
! 698: raygenz = (GEN)rayclgpz[3];
! 699: P = cgetg(l,t_MAT);
! 700: for (j=1; j<l; j++)
! 701: {
! 702: GEN g, id = idealhermite(nfz, (GEN)raygenz[j]);
! 703: g = steinitzaux(nf, gmul((GEN)nfz[7], id), polrel);
! 704: g = idealdiv(nf, g, steinitzZk); /* N_{Kz/K}(gen[j]) */
! 705: P[j] = (long)isprincipalray(bnr, g);
! 706: }
! 707: U = (GEN)hnfall(concatsp(P, subgroup))[2];
! 708: setlg(U, l); for (j=1; j<l; j++) setlg(U[j], l);
! 709: return hnfmod(concatsp(U, diagonal(raycycz)), (GEN)raycycz[1]);
1.1 noro 710: }
711:
1.2 ! noro 712: /* t(b1,...,b_{k-1}) [prop 5.3.9] */
1.1 noro 713: static GEN
1.2 ! noro 714: compute_t(GEN b, GEN r, long m, long ell)
1.1 noro 715: {
1.2 ! noro 716: long z, s, a, i, k = lg(b);
! 717: GEN t = cgetg(m+1, t_COL);
1.1 noro 718:
1.2 ! noro 719: for (a = 0; a < m; a++)
1.1 noro 720: {
1.2 ! noro 721: z = m-1 - a; s = r[1 + z] - ell;
! 722: for (i=1; i < k; i++) s += r[1 + ((z + b[i]) % m)];
! 723: t[1 + a] = lstoi(s / ell);
1.1 noro 724: }
1.2 ! noro 725: return t;
1.1 noro 726: }
727:
1.2 ! noro 728: /* Return multinomial(k-1; m1,...,m_{k-1}) where the mi are the
! 729: * multiplicities of the bi [ assume b1 <= ... <= b_{k-1} ] */
1.1 noro 730: static GEN
1.2 ! noro 731: get_multinomial(GEN b)
1.1 noro 732: {
1.2 ! noro 733: long i, k = lg(b), a, m;
! 734: GEN z = mpfact(k - 1);
1.1 noro 735:
1.2 ! noro 736: a = b[1]; m = 1;
! 737: for (i = 2; i < k; i++)
1.1 noro 738: {
1.2 ! noro 739: if (b[i] == a) m++;
! 740: else
! 741: {
! 742: if (m > 1) z = diviiexact(z, mpfact(m));
! 743: a = b[i]; m = 1;
! 744: }
1.1 noro 745: }
1.2 ! noro 746: if (m > 1) z = diviiexact(z, mpfact(m));
! 747: return z;
! 748: }
! 749:
! 750: /* r[b[1]] + ... + r[b[k-1]] + 1 = 0 mod ell ?*/
! 751: static int
! 752: b_suitable(GEN b, GEN r, long k, long ell)
! 753: {
! 754: long i, s = 1;
! 755: for (i = 1; i < k; i++) s += r[ 1 + b[i] ];
! 756: return (s % ell) == 0;
1.1 noro 757: }
758:
759: static GEN
1.2 ! noro 760: pol_from_Newton(GEN S)
1.1 noro 761: {
1.2 ! noro 762: long i, k, l = lg(S);
! 763: GEN c = cgetg(l, t_VEC);
1.1 noro 764:
1.2 ! noro 765: c[1] = S[1];
! 766: for (k = 2; k < l; k++)
1.1 noro 767: {
1.2 ! noro 768: GEN s = (GEN)S[k];
! 769: for (i = 1; i < k; i++) s = gadd(s, gmul((GEN)S[i], (GEN)c[k-i]));
! 770: c[k] = ldivgs(s, -k);
1.1 noro 771: }
1.2 ! noro 772: return gadd(gpowgs(polx[0], l-1), gtopoly(c, 0));
1.1 noro 773: }
774:
1.2 ! noro 775: /* th. 5.3.5. and prop. 5.3.9. */
1.1 noro 776: static GEN
1.2 ! noro 777: compute_polrel(GEN nfz, toK_s *T, GEN be, long g, long ell)
1.1 noro 778: {
1.2 ! noro 779: long i, k, m = T->m;
! 780: GEN r, powtaubet, S, X = polx[0], e = normtoK(T,be);
! 781:
! 782: switch (ell)
! 783: { /* special-cased for efficiency */
! 784: GEN p1, u;
! 785: case 2: err(bugparier,"rnfkummer (-1 not in nf?)"); break;
! 786: case 3: u = tracetoK(T,be);
! 787: p1 = gsub(gsqr(X), gmulsg(3,e));
! 788: return gsub(gmul(X,p1), gmul(e,u));
! 789: case 5:
! 790: if (m == 2)
1.1 noro 791: {
1.2 ! noro 792: u = tracetoK(T, gpowgs(be,3));
! 793: p1 = gadd(gmulsg(5,gsqr(e)), gmul(gsqr(X), gsub(gsqr(X),gmulsg(5,e))));
! 794: return gsub(gmul(X,p1), gmul(e,u));
! 795: }
! 796: else
! 797: { /* m = 4 */
! 798: GEN be1, be2, u1, u2, u3;
! 799: be1 = tauofelt(be, T->tau);
! 800: be2 = tauofelt(be1,T->tau);
! 801: u1 = tracetoK(T, gmul(be,be1));
! 802: u2 = tracetoK(T, gmul(gmul(be,be2),gsqr(be1)));
! 803: u3 = tracetoK(T, gmul(gmul(gsqr(be),gpowgs(be1,3)),be2));
! 804: p1 = gsub(gsqr(X), gmulsg(10,e));
! 805: p1 = gsub(gmul(X,p1), gmulsg(5,gmul(e,u1)));
! 806: p1 = gadd(gmul(X,p1), gmul(gmulsg(5,e),gsub(e,u2)));
! 807: return gsub(gmul(X,p1), gmul(e,u3));
1.1 noro 808: }
809: }
1.2 ! noro 810: /* general case */
! 811: r = cgetg(m+1,t_VECSMALL); /* r[i+1] = g^i mod ell */
! 812: r[1] = 1;
! 813: for (i=2; i<=m; i++) r[i] = (r[i-1] * g) % ell;
! 814: powtaubet = powtau(be, m, T->tau);
! 815: S = cgetg(ell+1, t_VEC); /* Newton sums */
! 816: S[1] = zero;
! 817: for (k = 2; k <= ell; k++)
! 818: {
! 819: GEN z, g = gzero, b = vecsmall_const(k-1, 0);
! 820: do
! 821: {
! 822: if (! b_suitable(b, r, k, ell)) continue;
! 823: z = factorbackelt(powtaubet, compute_t(b, r, m, ell), nfz);
! 824: if (typ(z) == t_COL) z = basistoalg(nfz, z);
! 825: g = gadd(g, gmul(get_multinomial(b), z));
! 826: } while (increment_inc(b, k, m));
! 827: S[k] = lmul(gmulsg(ell, e), tracetoK(T,g));
! 828: }
! 829: return pol_from_Newton(S);
! 830: }
! 831:
! 832: typedef struct {
! 833: GEN R; /* compositum(P,Q) */
! 834: GEN p; /* Mod(p,R) root of P */
! 835: GEN q; /* Mod(q,R) root of Q */
! 836: GEN k; /* Q[X]/R generated by q + k p */
! 837: GEN rev;
! 838: } compo_s;
! 839:
! 840: static GEN
! 841: lifttoKz(GEN nfz, GEN nf, GEN id, compo_s *C)
! 842: {
! 843: GEN I = ideal_two_elt(nf,id);
! 844: GEN x = gmul((GEN)nf[7], (GEN)I[2]);
! 845: I[2] = (long)algtobasis(nfz, RX_RXQ_compo(x, C->p, C->R));
! 846: return prime_to_ideal(nfz,I);
1.1 noro 847: }
1.2 ! noro 848:
! 849: static void
! 850: compositum_red(compo_s *C, GEN P, GEN Q)
1.1 noro 851: {
1.2 ! noro 852: GEN a, z = (GEN)compositum2(P, Q)[1];
! 853: C->R = (GEN)z[1];
! 854: C->p = (GEN)z[2];
! 855: C->q = (GEN)z[3];
! 856: C->k = (GEN)z[4];
! 857: /* reduce R */
! 858: z = polredabs0(C->R, nf_ORIG|nf_PARTIALFACT);
! 859: C->R = (GEN)z[1];
! 860: if (DEBUGLEVEL>1) fprintferr("polred(compositum) = %Z\n",C->R);
! 861: a = (GEN)z[2];
! 862: C->p = poleval(lift_intern(C->p), a);
! 863: C->q = poleval(lift_intern(C->q), a);
! 864: C->rev = modreverse_i((GEN)a[2], (GEN)a[1]);
1.1 noro 865: }
866:
1.2 ! noro 867: static GEN
! 868: _rnfkummer(GEN bnr, GEN subgroup, long all, long prec)
! 869: {
! 870: long ell, i, j, m, d, dK, dc, rc, ru, rv, g, mginv, degK, degKz, vnf;
! 871: long l, lSp, lSml2, lSl2, lW;
! 872: GEN polnf,bnf,nf,bnfz,nfz,bid,ideal,cycgen,gell,p1,p2,wk,U,vselmer;
! 873: GEN clgp,cyc,gen;
! 874: GEN Q,idealz,gothf;
! 875: GEN res,u,M,K,y,vecMsup,vecW,vecWA,vecWB,vecB,vecC,vecAp,vecBp;
! 876: GEN matP,Sp,listprSp,Tc,Tv,P;
! 877: primlist L;
! 878: toK_s T;
! 879: tau_s _tau, *tau;
! 880: compo_s COMPO;
1.1 noro 881:
882: checkbnrgen(bnr);
883: bnf = (GEN)bnr[1];
1.2 ! noro 884: nf = (GEN)bnf[7];
! 885: polnf = (GEN)nf[1]; vnf = varn(polnf);
1.1 noro 886: if (!vnf) err(talker,"main variable in kummer must not be x");
1.2 ! noro 887: wk = gmael3(bnf,8,4,1);
! 888: /* step 7 */
! 889: if (all) subgroup = NULL;
! 890: p1 = conductor(bnr, subgroup, 2);
! 891: bnr = (GEN)p1[2];
1.1 noro 892: subgroup = (GEN)p1[3];
1.2 ! noro 893: gell = get_gell(bnr,subgroup,all);
! 894: if (gcmp1(gell)) return polx[vnf];
! 895: if (!isprime(gell)) err(impl,"kummer for composite relative degree");
! 896: if (divise(wk,gell)) return rnfkummersimple(bnr, subgroup, gell, all);
! 897:
! 898: bid = (GEN)bnr[2];
! 899: ideal = gmael(bid,1,1);
1.1 noro 900: ell = itos(gell);
1.2 ! noro 901: /* step 1 of alg 5.3.5. */
1.1 noro 902: if (DEBUGLEVEL>2) fprintferr("Step 1\n");
1.2 ! noro 903: compositum_red(&COMPO, polnf, cyclo(ell,vnf));
! 904: /* step 2 */
1.1 noro 905: if (DEBUGLEVEL>2) fprintferr("Step 2\n");
1.2 ! noro 906: degK = degpol(polnf);
! 907: degKz = degpol(COMPO.R);
! 908: m = degKz / degK;
! 909: d = (ell-1) / m;
! 910: g = powuumod(u_gener(ell), d, ell);
! 911: if (powuumod(g, m, ell*ell) == 1) g += ell; /* ord(g)=m in all (Z/ell^k)^* */
! 912: /* step 3 */
1.1 noro 913: if (DEBUGLEVEL>2) fprintferr("Step 3\n");
1.2 ! noro 914: /* could factor disc(R) using th. 2.1.6. */
! 915: bnfz = bnfinit0(COMPO.R,1,NULL,prec);
! 916: cycgen = check_and_build_cycgen(bnfz);
1.1 noro 917: nfz = (GEN)bnfz[7];
918: clgp = gmael(bnfz,8,1);
1.2 ! noro 919: cyc = (GEN)clgp[2]; rc = prank(cyc,ell);
! 920: gen = (GEN)clgp[3]; l = lg(cyc);
! 921: u = get_u(cyc, rc, gell);
! 922:
! 923: vselmer = get_Selmer(bnfz, cycgen, rc);
! 924: ru = (degKz>>1)-1;
! 925: rv = rc+ru+1;
! 926:
! 927: /* compute action of tau */
! 928: U = gadd(gpowgs(COMPO.q, g), gmul(COMPO.k, COMPO.p));
! 929: U = poleval(COMPO.rev, U);
! 930: tau = get_tau(&_tau, nfz, U);
! 931:
! 932: /* step 4 */
1.1 noro 933: if (DEBUGLEVEL>2) fprintferr("Step 4\n");
934: vecB=cgetg(rc+1,t_VEC);
935: Tc=cgetg(rc+1,t_MAT);
936: for (j=1; j<=rc; j++)
937: {
1.2 ! noro 938: p1 = tauofideal(nfz, (GEN)gen[j], tau);
! 939: p1 = isprincipalell(bnfz, p1, cycgen,u,gell,rc);
1.1 noro 940: Tc[j] = p1[1];
941: vecB[j]= p1[2];
942: }
1.2 ! noro 943:
! 944: vecC = cgetg(rc+1,t_VEC);
! 945: for (j=1; j<=rc; j++) vecC[j] = lgetg(1, t_MAT);
! 946: p1 = cgetg(m,t_VEC);
! 947: p1[1] = (long)idmat(rc);
! 948: for (j=2; j<=m-1; j++) p1[j] = lmul((GEN)p1[j-1],Tc);
! 949: p2 = vecB;
1.1 noro 950: for (j=1; j<=m-1; j++)
951: {
1.2 ! noro 952: GEN T = FpM_red(gmulsg((j*d)%ell,(GEN)p1[m-j]), gell);
! 953: p2 = tauofvec(p2, tau);
! 954: for (i=1; i<=rc; i++)
! 955: vecC[i] = (long)famat_mul((GEN)vecC[i], famat_factorback(p2, (GEN)T[i]));
1.1 noro 956: }
1.2 ! noro 957: for (i=1; i<=rc; i++) vecC[i] = (long)famat_reduce((GEN)vecC[i]);
! 958: /* step 5 */
1.1 noro 959: if (DEBUGLEVEL>2) fprintferr("Step 5\n");
960: Tv = cgetg(rv+1,t_MAT);
961: for (j=1; j<=rv; j++)
962: {
1.2 ! noro 963: p1 = tauofelt((GEN)vselmer[j], tau);
! 964: if (typ(p1) == t_MAT) /* famat */
! 965: p1 = factorbackelt((GEN)p1[1], FpV_red((GEN)p1[2],gell), nfz);
! 966: Tv[j] = (long)isvirtualunit(bnfz, p1, cycgen,cyc,gell,rc);
! 967: }
! 968: P = FpM_ker(gsubgs(Tv, g), gell);
! 969: lW = lg(P); vecW = cgetg(lW,t_VEC);
! 970: for (j=1; j<lW; j++) vecW[j] = (long)famat_factorback(vselmer, (GEN)P[j]);
! 971: /* step 6 */
1.1 noro 972: if (DEBUGLEVEL>2) fprintferr("Step 6\n");
1.2 ! noro 973: Q = FpM_ker(gsubgs(gtrans(Tc), g), gell);
! 974: /* step 8 */
! 975: if (DEBUGLEVEL>2) fprintferr("Step 8\n");
! 976: p1 = RXQ_powers(lift_intern(COMPO.p), COMPO.R, degK-1);
! 977: p1 = vecpol_to_mat(p1, degKz);
! 978: T.invexpoteta1 = invmat(p1); /* left inverse */
! 979: T.polnf = polnf;
! 980: T.tau = tau;
! 981: T.m = m;
! 982:
! 983: idealz = lifttoKz(nfz, nf, ideal, &COMPO);
! 984: if (smodis(idealnorm(nf,ideal), ell)) gothf = idealz;
1.1 noro 985: else
1.2 ! noro 986: { /* ell | N(ideal) */
! 987: GEN bnrz = buchrayinitgen(bnfz, idealz);
! 988: GEN subgroupz = invimsubgroup(bnrz, bnr, subgroup, &T);
1.1 noro 989: gothf = conductor(bnrz,subgroupz,0);
990: }
1.2 ! noro 991: /* step 9, 10, 11 */
! 992: if (DEBUGLEVEL>2) fprintferr("Step 9, 10 and 11\n");
! 993: i = build_list_Hecke(&L, nfz, NULL, gothf, gell, tau);
! 994: if (i) return no_sol(all,i);
! 995:
! 996: lSml2 = lg(L.Sml2)-1;
! 997: Sp = concatsp(L.Sm, L.Sml1); lSp = lg(Sp)-1;
! 998: listprSp = concatsp(L.Sml2, L.Sl); lSl2 = lg(listprSp)-1;
! 999:
! 1000: /* step 12 */
1.1 noro 1001: if (DEBUGLEVEL>2) fprintferr("Step 12\n");
1.2 ! noro 1002: vecAp = cgetg(lSp+1, t_VEC);
! 1003: vecBp = cgetg(lSp+1, t_VEC);
! 1004: matP = cgetg(lSp+1, t_MAT);
1.1 noro 1005: for (j=1; j<=lSp; j++)
1006: {
1.2 ! noro 1007: GEN e, a, ap;
! 1008: p1 = isprincipalell(bnfz, (GEN)Sp[j], cycgen,u,gell,rc);
! 1009: e = (GEN)p1[1]; matP[j] = (long)e;
! 1010: a = (GEN)p1[2];
! 1011: p2 = famat_mul(famat_factorback(vecC, gneg(e)), a);
! 1012: vecBp[j] = (long)p2;
! 1013: ap = cgetg(1, t_MAT);
1.1 noro 1014: for (i=0; i<m; i++)
1015: {
1.2 ! noro 1016: ap = famat_mul(ap, famat_pow(p2, utoi(powuumod(g,m-1-i,ell))));
! 1017: if (i < m-1) p2 = tauofelt(p2, tau);
1.1 noro 1018: }
1.2 ! noro 1019: vecAp[j] = (long)ap;
1.1 noro 1020: }
1.2 ! noro 1021: /* step 13 */
1.1 noro 1022: if (DEBUGLEVEL>2) fprintferr("Step 13\n");
1.2 ! noro 1023: vecWA = concatsp(vecW, vecAp);
! 1024: vecWB = concatsp(vecW, vecBp);
! 1025:
! 1026: /* step 14, 15, and 17 */
! 1027: if (DEBUGLEVEL>2) fprintferr("Step 14, 15 and 17\n");
! 1028: mginv = (m * u_invmod(g,ell)) % ell;
! 1029: vecMsup = cgetg(lSml2+1,t_VEC);
! 1030: M = NULL;
! 1031: for (i=1; i<=lSl2; i++)
1.1 noro 1032: {
1.2 ! noro 1033: GEN pr = (GEN)listprSp[i];
1.1 noro 1034: long e = itos((GEN)pr[3]), z = ell * (e / (ell-1));
1.2 ! noro 1035:
! 1036: if (i <= lSml2)
! 1037: {
! 1038: z += 1 - L.ESml2[i];
! 1039: vecMsup[i] = (long)logall(nfz, vecWA,lW,mginv,ell, pr,z+1);
! 1040: }
! 1041: M = vconcat(M, logall(nfz, vecWA,lW,mginv,ell, pr,z));
! 1042: }
! 1043: dc = lg(Q)-1;
! 1044: if (dc)
1.1 noro 1045: {
1.2 ! noro 1046: GEN QtP = gmul(gtrans_i(Q), matP);
! 1047: M = vconcat(M, concatsp(zeromat(dc,lW-1), QtP));
1.1 noro 1048: }
1.2 ! noro 1049: if (!M) M = zeromat(1, lSp + lW - 1);
! 1050: /* step 16 */
1.1 noro 1051: if (DEBUGLEVEL>2) fprintferr("Step 16\n");
1052: K = FpM_ker(M, gell);
1.2 ! noro 1053: /* step 18 & ff */
1.1 noro 1054: if (DEBUGLEVEL>2) fprintferr("Step 18\n");
1.2 ! noro 1055: dK = lg(K)-1;
! 1056: y = cgetg(dK+1,t_VECSMALL);
! 1057: res = cgetg(1, t_VEC); /* in case all = 1 */
! 1058: while (dK)
1.1 noro 1059: {
1060: for (i=1; i<dK; i++) y[i] = 0;
1.2 ! noro 1061: y[i] = 1; /* y = [0,...,0,1,0,...,0], 1 at dK'th position */
! 1062: do
! 1063: { /* cf. algo 5.3.18 */
! 1064: GEN be, P, X = FpV_red(gmul_mati_smallvec(K, y), gell);
! 1065: if (ok_congruence(X, gell, lW, vecMsup))
1.1 noro 1066: {
1.2 ! noro 1067: be = compute_beta(X, vecWB, gell, bnfz);
! 1068: P = compute_polrel(nfz, &T, be, g, ell);
! 1069: if (DEBUGLEVEL>1) fprintferr("polrel(beta) = %Z\n", P);
! 1070: if (!all && gegal(subgroup, rnfnormgroup(bnr, P))) return P; /* DONE */
! 1071: res = concatsp(res, P);
! 1072: }
! 1073: } while (increment(y, dK, ell));
! 1074: y[dK--] = 0;
1.1 noro 1075: }
1.2 ! noro 1076: if (all) return res;
! 1077: return gzero; /* FAIL */
! 1078: }
! 1079:
! 1080: GEN
! 1081: rnfkummer(GEN bnr, GEN subgroup, long all, long prec)
! 1082: {
! 1083: gpmem_t av = avma;
! 1084: return gerepilecopy(av, _rnfkummer(bnr, subgroup, all, prec));
1.1 noro 1085: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to kummer.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / pari-2.2 / src / modules