/*******************************************************************/ /* */ /* KUMMER EXTENSIONS */ /* */ /*******************************************************************/ /* $Id: kummer.c,v 1.1.1.1 1999/09/16 13:48:13 karim Exp $ */ #include "pari.h" static long rc,gc,ell,degK,degKz,m,d,ru,rv,lraycyc,vnf,dv,nbcol,lSml2; static long lSl,lSp,dK,lSl2,dc; static GEN module,matexpoteta1,bnf,nf,raycyc,polnf,phiell,powtaubet,vecMsup; static GEN unmodell,bnfz,nfz,U,uu,gell,cyc,gencyc,vecalpha,R,A1,A2,g,vselmer; static GEN bnrz,polrel,steinitzZk,listmod,listprSp,listbid,listunif,listellrank; static GEN listmodsup,listbidsup,listellranksup,vecw,Sm,Sml1,Sml2,Sl; static GEN ESml2,Sp,vecbetap,vecalphap,matP,gg,mginv; /* row vector B x matrix T : c_j=prod_i (b_i^T_ij) */ static GEN groupproduct(GEN B, GEN T) { long lB,lT,i,j; GEN c,p1; lB=lg(B)-1; lT=lg(T)-1; c=cgetg(lT+1,t_VEC); for (j=1; j<=lT; j++) { p1=gun; for (i=1; i<=lB; i++) p1=gmul(p1,gpui((GEN)B[i],gcoeff(T,i,j),0)); c[j]=(long)p1; } return c; } static GEN grouppows(GEN B, long ex) { long lB,j; GEN c; lB=lg(B)-1; c=cgetg(lB+1,t_VEC); for (j=1; j<=lB; j++) c[j]=(long)gpuigs((GEN)B[j],ex); return c; } static GEN get_listx(GEN arch,GEN msign,GEN munit,GEN vecmunit2,long ell,long lSp,long lSml2,long nbvunit,long r1) { GEN kermat,p2,p3,p4,y,yinit,listx,unmodell = gmodulss(1,ell); long i,j,k,cmpt,lker; kermat=lift(ker(munit)); lker=lg(kermat)-1; if (!lker) return cgetg(1,t_VEC); yinit=cgetg(lker,t_VEC); y=cgetg(lker,t_VEC); for (i=1; i=lg(p4)) break; } if (k>lSml2) { p4=lift(gmul(msign,p3)); j=1; while (j<=r1 && gegal((GEN)p4[j],(GEN)arch[j])) j++; if (j>r1) { p2[1]=(long)p3; listx=concatsp(listx,p2); } } } if (!lSp) { j=1; while (j=lg(p4)) break; } if (k>lSml2) { p4=lift(gmul(msign,p3)); j=1; while (j<=r1 && gegal((GEN)p4[j],(GEN)arch[j])) j++; if (j>r1) { p2[1]=(long)p3; listx=concatsp(listx,p2); } } } } i=lker; do { i--; if (!i) return listx; if (i=0); } } static GEN reducealpha(GEN nf,GEN x,GEN gell) /* etant donne un nombre algebrique x du corps nf -- non necessairement entier -- calcule un entier algebrique de la forme x*g^gell */ { long tx=typ(x),i; GEN den,fa,fac,ep,p1,y; nf=checknf(nf); if ((tx==t_POL)||(tx==t_POLMOD)) y=algtobasis(nf,x); else { y=x; x=basistoalg(nf,y); } den=denom(y); if (gcmp1(den)) return x; fa=decomp(den);fac=(GEN)fa[1];ep=(GEN)fa[2]; p1=gun; for (i=1; i 0) { if (all) return cgetg(1,t_VEC); err(talker,"bug4 in kummer"); } if (vd==0) Sml1=concatsp(Sml1,pp); else { if (vp==1) { if (all) return cgetg(1,t_VEC); err(talker,"bug2 in kummer"); } else { Sml2=concatsp(Sml2,pp); ESml2=concatsp(ESml2,(GEN)expom[i]); } } } } prl=primedec(nf,gell); lprl=lg(prl)-1; for (i=1; i<=lprl; i++) if (!idealval(nf,ideal,(GEN)prl[i])) { pp=cgetg(2,t_VEC); pp[1]=prl[i]; Sl=concatsp(Sl,pp); } lSml2=lg(Sml2)-1; lSl=lg(Sl)-1; Sp=concatsp(Sm,Sml1); lSp=lg(Sp)-1; vecbeta=cgetg(lSp+1,t_VEC); matexpo=cgetg(lSp+1,t_MAT); vecbeta0=cgetg(lSp+1,t_VEC); for (j=1; j<=lSp; j++) { p1=isprincipalgen(bnf,(GEN)Sp[j]); p2=basistoalg(nf,(GEN)p1[2]); for (i=1; i<=lastindex; i++) p2 = gmul(p2,gpui((GEN)listgamma[i],gmael(p1,1,i),0)); p22=p2; for ( ; i<=nbgenclK; i++) { p2 = gmul(p2,gpui((GEN)listgamma[i],gmael(p1,1,i),0)); p22 = gmul(p22,gpui((GEN)listgamma0[i],gmael(p1,1,i),0)); } matexpo[j]=(long)p1[1]; vecbeta[j]=(long)p2; /* attention, ceci sont les beta modifies */ vecbeta0[j]=(long)p22; } matexpo=gmul(unmodell,matexpo); vunit=gmodulcp(concatsp(gmael(bnf,8,5),gmael3(bnf,8,4,2)),polnf); nbvunit0=lg(vunit)-1; for (i=1; i<=lastindex; i++) vunit=concatsp(vunit,(GEN)listalpha[i]); nbvunit=lg(vunit)-1; id=idmat(degnf); for (i=1; i<=lSl; i++) { pr=(GEN)Sl[i]; id=idealmul(nf,idealpow(nf,pr,stoi((ell*itos((GEN)pr[3]))/(ell-1))),id); } vsml2=cgetg(lSml2+1,t_VEC); for (i=1; i<=lSml2; i++) { pr=(GEN)Sml2[i]; v1=itos((GEN)ESml2[i]); kmax=(itos((GEN)pr[3])*ell)/(ell-1)+1-v1; p1=idealpow(nf,pr,stoi(kmax)); id=idealmul(nf,id,p1); p2=idealmul(nf,p1,pr); p3=zidealstarinitgen(nf,p2); vsml2[i]=(long)p3; cycpro=gmael(p3,2,2); for (j=1;j=7"); return gzero; } return NULL; /* not reached */ } /* multiply be by ell-th powers of units as to find "small" L2-norm for new be */ static GEN reducebeta(GEN be) { long i,lu; GEN p1,p2,unitsell,unitsellinv,nmax,ben; unitsell=grouppows(gmodulcp(concatsp(gmael(bnfz,8,5),gmael3(bnfz,8,4,2)),R),ell); unitsellinv=grouppows(unitsell,-1); unitsell=concatsp(unitsell,unitsellinv); p1=unitsell; for (i=2; i<=max((ell>>1),3); i++) p1=concatsp(p1,grouppows(unitsell,i)); unitsell=p1; nmax=gnorml2(algtobasis(nfz,be)); lu=lg(unitsell)-1; ben=be; do { be=ben; for (i=1; i<=lu; i++) { p1=gmul(be,(GEN)unitsell[i]); p2=gnorml2(algtobasis(nfz,p1)); if (gcmp(p2,nmax)<0) { nmax=p2; ben=p1; } } } while (!gegal(be,ben)); return be; } static GEN testx(GEN subgroup, GEN X, long prec) { long i,v; GEN be,polrelbe,p1; /* in alg. 5.3.18., C=nbcol */ X=gmul(unmodell,X); if (gcmp0(X)) return gzero; for (i=dv+1; i<=nbcol; i++) if (gcmp0((GEN)X[i])) return gzero; for (i=1; i<=lSml2; i++) if (gcmp0(gmul((GEN)vecMsup[i],X))) return gzero; be=gun; for (i=1; i<=nbcol; i++) be=gmul(be,gpui((GEN)vecw[i],lift((GEN)X[i]),0)); if (DEBUGLEVEL>=2) { fprintferr("reducing beta = "); outerr(be); } be=reducebeta(be); if (DEBUGLEVEL>=2) { fprintferr("beta reduced = "); outerr(be); } polrelbe=computepolrelbeta(be); v=varn(polrelbe); p1=unifpol((GEN)bnf[7],polrelbe,0); p1=denom(gtovec(p1)); polrelbe=gsubst(polrelbe,v,gdiv(polx[v],p1)); polrelbe=gmul(polrelbe,gpuigs(p1,degree(polrelbe))); if (DEBUGLEVEL>=2) { fprintferr("polrelbe = "); outerr(polrelbe); } p1=rnfconductor(bnf,polrelbe,prec); if (!gegal((GEN)p1[1],module)) return gzero; if (!gegal((GEN)p1[3],subgroup)) return gzero; return polrelbe; } GEN rnfkummer(GEN bnr, GEN subgroup, long all, long prec) { long i,j,av=avma,tetpil,llistpr,lfactell,e,vp,vd,ind; GEN p1,p2,p3,p4,wk; GEN rayclgp,bid,ideal; GEN kk,clgp,fununits,torsunit,vecB,vecC,Tc,Tv,P; GEN Q,Qt,idealz,gothf,factgothf,listpr,listex,factell,pp,p,pr,z,vecnul; GEN M,al,K,Msup,X,finalresult,y,cycpro; checkbnrgen(bnr); wk=gmael4(bnr,1,8,4,1); if (all) gell=stoi(all); else { if (!gcmp0(subgroup)) gell=det(subgroup); else gell=det(diagonal(gmael(bnr,5,2))); } if (gcmp1(gell)) { avma = av; return polx[varn(gmael3(bnr,1,7,1))]; } if (!isprime(gell)) err(impl,"kummer for composite relative degree"); if (divise(wk,gell)) return gerepileupto(av,rnfkummersimple(bnr,subgroup,all,prec)); if (all && gcmp0(subgroup)) err(talker,"kummer when zeta not in K requires a specific subgroup"); bnf=(GEN)bnr[1]; nf=(GEN)bnf[7]; polnf=(GEN)nf[1]; vnf=varn(polnf); degK=degree(polnf); if (!vnf) err(talker,"main variable in kummer must not be x"); /* step 7 */ p1=conductor(bnr,subgroup,2,prec); /* fin step 7 */ bnr=(GEN)p1[2]; rayclgp=(GEN)bnr[5]; raycyc=(GEN)rayclgp[2]; lraycyc=lg(raycyc)-1; bid=(GEN)bnr[2]; module=(GEN)bid[1]; ideal=(GEN)module[1]; if (gcmp0(subgroup)) subgroup = diagonal(raycyc); ell=itos(gell); unmodell=gmodulss(1,ell); /* step 1 of alg 5.3.5. */ if (DEBUGLEVEL>=3) { fprintferr("Step 1\n"); flusherr(); } phiell=cyclo(ell,vnf); p1=(GEN)compositum2(polnf,phiell)[1]; kk=(GEN)p1[4]; R=(GEN)p1[1]; A1=(GEN)p1[2]; A2=(GEN)p1[3]; if (signe(leadingcoeff(R))<0) { R=gneg_i(R); A1=gmodulcp(lift(A1),R); A2=gmodulcp(lift(A2),R); } /* step 2 */ if (DEBUGLEVEL>=3) { fprintferr("Step 2\n"); flusherr(); } degKz=degree(R); m=degKz/degK; d=(ell-1)/m; g=lift(gpuigs(gener(gell),d)); if (gcmp1(lift(gpuigs(gmodulcp(g,stoi(ell*ell)),m)))) g=addsi(ell,g); /* step reduction of R */ if (degKz<=20) { GEN A3,A3rev; if (DEBUGLEVEL>=3) { fprintferr("Step reduction\n"); flusherr(); } p1=polredabs2(R,prec); if (DEBUGLEVEL>=3) { fprintferr("polredabs = ");outerr((GEN)p1[1]); } R=(GEN)p1[1]; A3=(GEN)p1[2]; A1=gsubst(lift(A1),vnf,A3); A2=gsubst(lift(A2),vnf,A3); A3rev=polymodrecip(A3); U=gadd(gpui(A2,g,0),gmul(kk,A1)); U=gsubst(lift(A3rev),vnf,U); } else U=gadd(gpui(A2,g,0),gmul(kk,A1)); /* step 3 */ /* on peut factoriser disc(R) avec th. 2.1.6. */ if (DEBUGLEVEL>=3) { fprintferr("Step 3\n"); flusherr(); } bnfz=bnfinit0(R,0,NULL,prec); nfz=(GEN)bnfz[7]; clgp=gmael(bnfz,8,1); cyc=(GEN)clgp[2]; gc=lg(cyc)-1; gencyc=(GEN)clgp[3]; for (j=1; j<=gc && divise((GEN)cyc[j],gell); j++); rc=j-1; vecalpha=cgetg(gc+1,t_VEC); for (j=1; j<=gc; j++) { p1 = idealpow(nfz,(GEN)gencyc[j],(GEN)cyc[j]); p1 = (GEN)isprincipalgenforce(bnfz, p1)[2]; vecalpha[j] = (long)basistoalg(nfz, p1); } fununits = check_units(bnfz,"rnfkummer"); torsunit = gmael3(bnfz,8,4,2); ru=(degKz>>1)-1; rv=rc+ru+1; vselmer=cgetg(rv+1,t_VEC); for (j=1; j<=rc; j++) vselmer[j]=vecalpha[j]; for ( ; j=3) { fprintferr("Step 4\n"); flusherr(); } vecB=cgetg(rc+1,t_VEC); Tc=cgetg(rc+1,t_MAT); for (j=1; j<=rc; j++) { p1=isprincipalell(tauofideal((GEN)gencyc[j])); vecB[j]=p1[2]; Tc[j]=p1[1]; } p1=cgetg(m,t_VEC); p1[1]=(long)idmat(rc); for (j=2; j<=m-1; j++) p1[j]=lmul((GEN)p1[j-1],Tc); p2=cgetg(rc+1,t_VEC); for (j=1; j<=rc; j++) p2[j]=un; p3=vecB; for (j=1; j<=m-1; j++) { p3=gsubst(lift(p3),vnf,U); p4=groupproduct(grouppows(p3,(j*d)%ell),(GEN)p1[m-j]); for (i=1; i<=rc; i++) p2[i]=lmul((GEN)p2[i],(GEN)p4[i]); } vecC=p2; /* step 5 */ if (DEBUGLEVEL>=3) { fprintferr("Step 5\n"); flusherr(); } Tv=cgetg(rv+1,t_MAT); for (j=1; j<=rv; j++) { Tv[j]=isvirtualunit(gsubst(lift((GEN)vselmer[j]),vnf,U))[1]; if (DEBUGLEVEL>=3) { fprintferr(" %ld\n",j); flusherr(); } } P=lift(ker(gmul(unmodell,gsub(Tv,gmul(g,idmat(rv)))))); dv=lg(P)-1; vecw=cgetg(dv+1,t_VEC); for (j=1; j<=dv; j++) { p1=gun; for (i=1; i<=rv; i++) p1=gmul(p1,gpui((GEN)vselmer[i],gcoeff(P,i,j),0)); vecw[j]=(long)p1; } /* step 6 */ if (DEBUGLEVEL>=3) { fprintferr("Step 6\n"); flusherr(); } Q=ker(gmul(unmodell,gsub(gtrans(Tc),gmul(g,idmat(rc))))); Qt=gtrans(Q); dc=lg(Q)-1; /* step 7 done above */ /* step 8 */ if (DEBUGLEVEL>=3) { fprintferr("Step 7 and 8\n"); flusherr(); } idealz=lifttokz(ideal); computematexpoteta1(); if (!divise(idealnorm(nf,ideal),gell)) gothf=idealz; else { GEN subgroupz; polrel=computepolrel(); steinitzZk=steinitzaux(idmat(degKz)); subgroupz=invimsubgroup(bnr,subgroup,idealz,prec); gothf=conductor(bnrz,subgroupz,0,prec); } /* step 9 */ if (DEBUGLEVEL>=3) { fprintferr("Step 9\n"); flusherr(); } factgothf=idealfactor(nfz,gothf); listpr=(GEN)factgothf[1]; listex=(GEN)factgothf[2]; llistpr=lg(listpr)-1; factell=primedec(nfz,gell); lfactell=lg(factell)-1; /* step 10 and step 11 */ if (DEBUGLEVEL>=3) { fprintferr("Step 10 and 11\n"); flusherr(); } Sm=cgetg(1,t_VEC);Sml1=cgetg(1,t_VEC);Sml2=cgetg(1,t_VEC);Sl=cgetg(1,t_VEC); ESml2=cgetg(1,t_VEC); for (i=1; i<=llistpr; i++) { pp=cgetg(2,t_VEC); pp[1]=listpr[i]; p=gmael(pp,1,1); e=itos(gmael(pp,1,3)); if (!gegal(p,gell)) { if (!gcmp1((GEN)listex[i])) { avma=av; return gzero; } if (!isconjinprimelist(Sm,(GEN)pp[1])) Sm=concatsp(Sm,pp); } else { vp=itos((GEN)listex[i]); vd=(vp-1)*(ell-1)-ell*e; if (vd > 0) { avma=av; return gzero; } if (vd==0) { if (!isconjinprimelist(Sml1,(GEN)pp[1])) Sml1=concatsp(Sml1,pp); } else { if (vp==1) { avma=av; return gzero; } if (!isconjinprimelist(Sml2,(GEN)pp[1])) { Sml2=concatsp(Sml2,pp); ESml2=concatsp(ESml2,(GEN)listex[i]); } } } } for (i=1; i<=lfactell; i++) if (!idealval(nfz,gothf,(GEN)factell[i])) { pp=cgetg(2,t_VEC); pp[1]=factell[i]; if (!isconjinprimelist(Sl,(GEN)pp[1])) Sl=concatsp(Sl,pp); } lSml2=lg(Sml2)-1; lSl=lg(Sl)-1; lSl2=lSml2+lSl; Sp=concatsp(Sm,Sml1); lSp=lg(Sp)-1; /* step 12 */ if (DEBUGLEVEL>=3) { fprintferr("Step 12\n"); flusherr(); } vecbetap=cgetg(lSp+1,t_VEC); vecalphap=cgetg(lSp+1,t_VEC); matP=cgetg(lSp+1,t_MAT); gg=gmodulcp(g,gell); for (j=1; j<=lSp; j++) { p1=isprincipalell((GEN)Sp[j]); matP[j]=p1[1]; p2=gun; for (i=1; i<=rc; i++) p2=gmul(p2,gpui((GEN)vecC[i],gmael(p1,1,i),0)); p3=gdiv((GEN)p1[2],p2); vecbetap[j]=(long)p3; p2=gun; for (i=0; i=3) { fprintferr("Step 13\n"); flusherr(); } nbcol=lSp+dv; vecw=concatsp(vecw,vecbetap); listmod=cgetg(lSl2+1,t_VEC); listunif=cgetg(lSl2+1,t_VEC); listprSp=cgetg(lSl2+1,t_VEC); for (j=1; j<=lSml2; j++) { pr=(GEN)Sml2[j]; z=addsi(1,mulsi(ell,divis((GEN)pr[3],ell-1))); listmod[j]=(long)idealpow(nfz,pr,gsub(z,(GEN)ESml2[j])); listunif[j]=(long)basistoalg(nfz,gdiv((GEN)pr[5],(GEN)pr[1])); listprSp[j]=(long)pr; } for ( ; j<=lSl2; j++) { pr=(GEN)Sl[j-lSml2]; z=mulsi(ell,divis((GEN)pr[3],ell-1)); listmod[j]=(long)idealpow(nfz,pr,z); listunif[j]=(long)basistoalg(nfz,gdiv((GEN)pr[5],(GEN)pr[1])); listprSp[j]=(long)pr; } /* step 14 and step 15 */ if (DEBUGLEVEL>=3) { fprintferr("Step 14 and 15\n"); flusherr(); } listbid=cgetg(lSl2+1,t_VEC); listellrank=cgetg(lSl2+1,t_VEC); for (i=1; i<=lSl2; i++) { listbid[i]=(long)zidealstarinitgen(nfz,(GEN)listmod[i]); cycpro=gmael3(listbid,i,2,2); for (j=1; (j=3) { fprintferr("Step 16\n"); flusherr(); } K=ker(M); dK=lg(K)-1; if (!dK) { avma=av; return gzero; } /* step 17 */ if (DEBUGLEVEL>=3) { fprintferr("Step 17\n"); flusherr(); } listmodsup=cgetg(lSml2+1,t_VEC); listbidsup=cgetg(lSml2+1,t_VEC); listellranksup=cgetg(lSml2+1,t_VEC); for (j=1; j<=lSml2; j++) { listmodsup[j]=(long)idealmul(nfz,(GEN)listprSp[j],(GEN)listmod[j]); listbidsup[j]=(long)zidealstarinitgen(nfz,(GEN)listmodsup[j]); cycpro=gmael3(listbidsup,j,2,2); for (i=1; (i=3) { fprintferr("Step 18\n"); flusherr(); } do { y=cgetg(dK,t_VEC); for (i=1; i= 0) goto LAB21; else goto LAB19; } dK--; } while (dK); avma=av; return gzero; }