Attachment 'ellQ2.gp.c'
Download 1 /*-*- compile-command: "/usr/bin/gcc -c -o ellQ2.gp.o -O3 -Wall -fno-strict-aliasing -fomit-frame-pointer -fPIC -I"/usr/local/include" ellQ2.gp.c && /usr/bin/gcc -o ellQ2.gp.so -shared -O3 -Wall -fno-strict-aliasing -fomit-frame-pointer -fPIC -Wl,-shared ellQ2.gp.o -lc -lm -L"/usr/local/lib" -lpari"; -*-*/
2 #include <pari/pari.h>
3 /*
4 GP;install("init_ellQ2","v","init_ellQ2","./ellQ2.gp.so");
5 GP;install("QfbReduce","D0,G,p","QfbReduce","./ellQ2.gp.so");
6 GP;install("IndefiniteLLL","D0,G,DGDGp","IndefiniteLLL","./ellQ2.gp.so");
7 GP;install("IndefiniteLLL2","D0,G,DGDGp","IndefiniteLLL2","./ellQ2.gp.so");
8 GP;install("kermodp","D0,G,D0,G,","kermodp","./ellQ2.gp.so");
9 GP;install("Qfparam","D0,G,D0,G,DGp","Qfparam","./ellQ2.gp.so");
10 GP;install("LLLgoon3","D0,G,DGp","LLLgoon3","./ellQ2.gp.so");
11 GP;install("completebasis","D0,G,DG","completebasis","./ellQ2.gp.so");
12 GP;install("LLLgoon","D0,G,DGp","LLLgoon","./ellQ2.gp.so");
13 GP;install("QfWittinvariant","D0,G,D0,G,","QfWittinvariant","./ellQ2.gp.so");
14 GP;install("Qflisteinvariants","D0,G,DGp","Qflisteinvariants","./ellQ2.gp.so");
15 GP;install("Qfsolvemodp","D0,G,D0,G,p","Qfsolvemodp","./ellQ2.gp.so");
16 GP;install("Qfminim","D0,G,DGp","Qfminim","./ellQ2.gp.so");
17 GP;install("mymat","D0,G,","mymat","./ellQ2.gp.so");
18 GP;install("Qfbsqrtgauss","D0,G,D0,G,p","Qfbsqrtgauss","./ellQ2.gp.so");
19 GP;install("class2","D0,G,D0,G,D0,G,D0,G,p","class2","./ellQ2.gp.so");
20 GP;install("Qfsolve","D0,G,D0,G,p","Qfsolve","./ellQ2.gp.so");
21 GP;install("matdiagonalblock","D0,G,","matdiagonalblock","./ellQ2.gp.so");
22 GP;install("ellchangecurveinverse","D0,G,D0,G,","ellchangecurveinverse","./ellQ2.gp.so");
23 GP;install("ellchangepointinverse","D0,G,D0,G,","ellchangepointinverse","./ellQ2.gp.so");
24 GP;install("ellcomposeurst","D0,G,D0,G,","ellcomposeurst","./ellQ2.gp.so");
25 GP;install("ellinverturst","D0,G,","ellinverturst","./ellQ2.gp.so");
26 GP;install("mysubst","D0,G,D0,G,","mysubst","./ellQ2.gp.so");
27 GP;install("degre","D0,G,","degre","./ellQ2.gp.so");
28 GP;install("nfissquare","lD0,G,D0,G,p","nfissquare","./ellQ2.gp.so");
29 GP;install("nfsqrt","D0,G,D0,G,p","nfsqrt","./ellQ2.gp.so");
30 GP;install("sqrtrat","D0,G,","sqrtrat","./ellQ2.gp.so");
31 GP;install("polratroots","D0,G,","polratroots","./ellQ2.gp.so");
32 GP;addhelp(polratroots, "polratroots(pol): rational roots of the polynomial pol, according to the field of definition of its coefficients (Q, R, Qp, Fp).");
33 GP;install("ratpoint","D0,G,DGDGp","ratpoint","./ellQ2.gp.so");
34 GP;install("ratpoint2","D0,G,DGDGDGp","ratpoint2","./ellQ2.gp.so");
35 GP;install("listratpoint","D0,G,DGp","listratpoint","./ellQ2.gp.so");
36 GP;install("redquartic","D0,G,p","redquartic","./ellQ2.gp.so");
37 GP;addhelp(redquartic, "redquartic(pol): reduction of the quartic pol using Cremona-Stoll algorithm. Returns [p,M], where p is the reduced quartic and M is the GL2(Z) transformation. Also works with other degree polynomials.");
38 GP;install("polrealrootsisolate","D0,G,","polrealrootsisolate","./ellQ2.gp.so");
39 GP;install("polrealrootsimprove","D0,G,D0,G,","polrealrootsimprove","./ellQ2.gp.so");
40 GP;addhelp(polrealrootsimprove, "ratpoint(pol,lim=1,singlepoint=1): search for rational points on y^2=pol(x), for about within the bounds given by lim. The coefficients of pol must be integral. If singlepoint=1, returns at most one point, otherwise as many as possible.");
41 GP;install("polrootsmodpn","D0,G,D0,G,p","polrootsmodpn","./ellQ2.gp.so");
42 GP;install("ppinit","D0,G,D0,G,","ppinit","./ellQ2.gp.so");
43 GP;install("nfpsquareoddQ","lD0,G,D0,G,D0,G,p","nfpsquareoddQ","./ellQ2.gp.so");
44 GP;install("psquare","lD0,G,D0,G,p","psquare","./ellQ2.gp.so");
45 GP;install("lemma6","lD0,G,D0,G,D0,G,D0,G,p","lemma6","./ellQ2.gp.so");
46 GP;install("lemma7","lD0,G,D0,G,D0,G,p","lemma7","./ellQ2.gp.so");
47 GP;install("zpsoluble","lD0,G,D0,G,D0,G,D0,G,D0,G,D0,G,p","zpsoluble","./ellQ2.gp.so");
48 GP;install("qpsoluble","lD0,G,D0,G,p","qpsoluble","./ellQ2.gp.so");
49 GP;install("locallysoluble","lD0,G,p","locallysoluble","./ellQ2.gp.so");
50 GP;addhelp(locallysoluble, "locallysoluble(pol): returns 1 if y^2=pol(x) is everywhere locally soluble, 0 otherwise.");
51 GP;install("LS2localimage","D0,G,D0,G,D0,G,p","LS2localimage","./ellQ2.gp.so");
52 GP;install("ellhalf","D0,G,D0,G,p","ellhalf","./ellQ2.gp.so");
53 GP;addhelp(ellhalf, "ellhalf(E,P): returns the vector of all points Q on the elliptic curve E such that 2Q = P");
54 GP;install("elltors2","D0,G,p","elltors2","./ellQ2.gp.so");
55 GP;addhelp(elltors2, "elltors2(E): for an elliptic curve E, returns the group E(K)[2], where K is the field of definition of the coefficients of E (Q, R, Qp or Fp).");
56 GP;install("elltorseven","D0,G,p","elltorseven","./ellQ2.gp.so");
57 GP;addhelp(elltorseven, "elltorseven(E): for an elliptic curve E, returns 2-Sylow subgroup of E(K)_tors, where K is the field of definition of the coefficients of E: (Q, R, Qp or Fp).");
58 GP;install("ellsort","D0,G,p","ellsort","./ellQ2.gp.so");
59 GP;addhelp(ellsort, "ellsort(v): v being a vector of points on some elliptic curve, returns the vector v sorted according to the naive height.");
60 GP;install("ellremovetorsion","D0,G,D0,G,","ellremovetorsion","./ellQ2.gp.so");
61 GP;install("ellredgen","D0,G,D0,G,DGp","ellredgen","./ellQ2.gp.so");
62 GP;addhelp(ellredgen, "ellredgen(E,v): returns a vector of smallest possible points on the elliptic curve E generating the same subgroup as v, up to torsion.");
63 GP;install("reducemodsquares","D0,G,D0,G,p","reducemodsquares","./ellQ2.gp.so");
64 GP;addhelp(reducemodsquares, "reducemodsquares(delta,d): delta being a t_POLMOD, returns another delta'=delta*z^2, such that delta' has a small coefficient in x^d.");
65 GP;install("bnfpSelmer","D0,G,DGD0,G,p","bnfpSelmer","./ellQ2.gp.so");
66 GP;addhelp(bnfpSelmer, "bnfpSelmer(K,S,p): K being a number field given by bnfinit, S an ideal of K, and p a prime number, computes a set of generators of the group K(S,p) = { x in K^/K^p, v_P(x) = 0 (mod p) for all P coprime to S}");
67 GP;install("kersign","D0,G,D0,G,","kersign","./ellQ2.gp.so");
68 GP;install("kernorm","D0,G,D0,G,D0,G,","kernorm","./ellQ2.gp.so");
69 GP;install("elllocalimage","D0,G,D0,G,DGp","elllocalimage","./ellQ2.gp.so");
70 GP;install("ell2descent_gen","D0,G,D0,G,DGDGDGp","ell2descent_gen","./ellQ2.gp.so");
71 GP;addhelp(ell2descent_gen, "ell2descent_gen((E,bnf,k=1,help=[]): E is a vector of the form [0,A,0,B,C], (or the result of ellinit of such a vector) A,B,C integers such that x^3+A*x^2+B*x+C; bnf is the corresponding bnfinit(,1); Performs 2-descent on the elliptic curve Ek : k*y^2=x^3+A*x^2+B*x+C. See ?ellrank for the format of the output.");
72 GP;install("afficheselmer","vD0,G,D0,G,D0,G,","afficheselmer","./ellQ2.gp.so");
73 GP;install("ellrankdebug","D0,G,D0,G,DGp","ellrankdebug","./ellQ2.gp.so");
74 GP;install("ellrank","D0,G,DGp","ellrank","./ellQ2.gp.so");
75 GP;addhelp(ellrank, "ellrank(E,help=[]): E is any elliptic curve defined over Q. Returns a vector [r,s,v], where r is a lower bound for the rank of E, s is the rank of its 2-Selmer group and v is a list of independant points in E(Q)/2E(Q). If help is a vector of nontrivial points on E, the result might be faster. This function might be used in conjunction with elltors2(E)");
76 GP;install("ell2descent_complete","D0,G,D0,G,D0,G,D0,G,p","ell2descent_complete","./ellQ2.gp.so");
77 GP;addhelp(ell2descent_complete, "ell2descent_complete(e1,e2,e3): Performs a complete 2-descent on the elliptic curve y^2 = (x-e1)*(x-e2)*(x-e3). See ?ellrank for the format of the output.");
78 GP;install("ellcount","D0,G,D0,G,D0,G,DGp","ellcount","./ellQ2.gp.so");
79 GP;install("ell2descent_viaisog","D0,G,DGp","ell2descent_viaisog","./ellQ2.gp.so");
80 GP;addhelp(ell2descent_viaisog, "ell2descent_viaisog(E,help=[]): E is an elliptic curve of the form [0,a,0,b,0], with a, b integers. Performs a 2-descent via isogeny on E. See ?ellrank for the format of the output.");
81 GP;install("nfsign_s","lD0,G,D0,G,D0,G,p","nfsign_s","./ellQ2.gp.so");
82 GP;install("nfpolratroots","D0,G,D0,G,","nfpolratroots","./ellQ2.gp.so");
83 GP;install("nfmodid2","D0,G,D0,G,D0,G,","nfmodid2","./ellQ2.gp.so");
84 GP;install("nfhilb2","D0,G,D0,G,D0,G,D0,G,p","nfhilb2","./ellQ2.gp.so");
85 GP;install("mynfhilbertp","D0,G,D0,G,D0,G,D0,G,p","mynfhilbertp","./ellQ2.gp.so");
86 GP;install("ideallistfactor","D0,G,D0,G,","ideallistfactor","./ellQ2.gp.so");
87 GP;install("mynfhilbert","lD0,G,D0,G,D0,G,p","mynfhilbert","./ellQ2.gp.so");
88 GP;install("initp","D0,G,D0,G,p","initp","./ellQ2.gp.so");
89 GP;install("deno","D0,G,","deno","./ellQ2.gp.so");
90 GP;install("nfratpoint","D0,G,D0,G,D0,G,DGp","nfratpoint","./ellQ2.gp.so");
91 GP;install("repres","D0,G,D0,G,p","repres","./ellQ2.gp.so");
92 GP;install("val","D0,G,D0,G,D0,G,","val","./ellQ2.gp.so");
93 GP;install("nfissquarep","D0,G,D0,G,D0,G,D0,G,p","nfissquarep","./ellQ2.gp.so");
94 GP;install("nfpsquareodd","lD0,G,D0,G,D0,G,p","nfpsquareodd","./ellQ2.gp.so");
95 GP;install("nfpsquare","lD0,G,D0,G,D0,G,D0,G,p","nfpsquare","./ellQ2.gp.so");
96 GP;install("nfpsquareq","lD0,G,D0,G,D0,G,D0,G,p","nfpsquareq","./ellQ2.gp.so");
97 GP;install("nflemma6","lD0,G,D0,G,D0,G,D0,G,D0,G,p","nflemma6","./ellQ2.gp.so");
98 GP;install("nflemma7","lD0,G,D0,G,D0,G,D0,G,D0,G,D0,G,p","nflemma7","./ellQ2.gp.so");
99 GP;install("nfzpsoluble","lD0,G,D0,G,D0,G,D0,G,D0,G,D0,G,p","nfzpsoluble","./ellQ2.gp.so");
100 GP;install("mynfeltmod","D0,G,D0,G,D0,G,","mynfeltmod","./ellQ2.gp.so");
101 GP;install("mynfeltreduce","D0,G,D0,G,D0,G,","mynfeltreduce","./ellQ2.gp.so");
102 GP;install("nfrandintmodid","D0,G,D0,G,","nfrandintmodid","./ellQ2.gp.so");
103 GP;install("nfrandint","D0,G,D0,G,","nfrandint","./ellQ2.gp.so");
104 GP;install("nfqpsolublebig","lD0,G,D0,G,D0,G,DGDGp","nfqpsolublebig","./ellQ2.gp.so");
105 GP;install("nfpolrootsmod","D0,G,D0,G,D0,G,","nfpolrootsmod","./ellQ2.gp.so");
106 GP;install("nfqpsoluble","lD0,G,D0,G,D0,G,p","nfqpsoluble","./ellQ2.gp.so");
107 GP;install("nflocallysoluble","lD0,G,D0,G,DGDGDGp","nflocallysoluble","./ellQ2.gp.so");
108 GP;install("nfellcount","D0,G,D0,G,D0,G,D0,G,D0,G,p","nfellcount","./ellQ2.gp.so");
109 GP;install("gettufu","D0,G,","gettufu","./ellQ2.gp.so");
110 GP;install("getfutu","D0,G,","getfutu","./ellQ2.gp.so");
111 GP;install("bnfell2descent_viaisog","D0,G,D0,G,p","bnfell2descent_viaisog","./ellQ2.gp.so");
112 GP;install("nfchinremain","D0,G,D0,G,D0,G,","nfchinremain","./ellQ2.gp.so");
113 GP;install("bnfqfsolve2","D0,G,D0,G,D0,G,DGp","bnfqfsolve2","./ellQ2.gp.so");
114 GP;install("bnfqfsolve","D0,G,D0,G,D0,G,D0,G,DGp","bnfqfsolve","./ellQ2.gp.so");
115 GP;install("bnfredquartique2","D0,G,D0,G,D0,G,D0,G,D0,G,","bnfredquartique2","./ellQ2.gp.so");
116 GP;install("bnfell2descent_gen","D0,G,D0,G,D0,G,DGDGDGDGp","bnfell2descent_gen","./ellQ2.gp.so");
117 GP;install("bnfellrank","D0,G,D0,G,DGDGDGp","bnfellrank","./ellQ2.gp.so");
118 GP;install("bnfell2descent_complete","D0,G,D0,G,D0,G,D0,G,DGDGp","bnfell2descent_complete","./ellQ2.gp.so");
119 */
120 void init_ellQ2(void);
121 GEN QfbReduce(GEN M, long prec);
122 GEN IndefiniteLLL(GEN G, GEN c, GEN base, long prec);
123 GEN IndefiniteLLL2(GEN G, GEN c, GEN base, long prec);
124 GEN kermodp(GEN M, GEN p);
125 GEN Qfparam(GEN G, GEN sol, GEN fl, long prec);
126 GEN LLLgoon3(GEN G, GEN c, long prec);
127 GEN completebasis(GEN v, GEN redflag);
128 GEN LLLgoon(GEN G, GEN c, long prec);
129 GEN QfWittinvariant(GEN G, GEN p);
130 GEN Qflisteinvariants(GEN G, GEN fa, long prec);
131 GEN Qfsolvemodp(GEN G, GEN p, long prec);
132 GEN Qfminim(GEN G, GEN factdetG, long prec);
133 GEN mymat(GEN qfb);
134 GEN Qfbsqrtgauss(GEN G, GEN factdetG, long prec);
135 GEN class2(GEN D, GEN factdetG, GEN Winvariants, GEN U2, long prec);
136 GEN Qfsolve(GEN G, GEN factD, long prec);
137 GEN matdiagonalblock(GEN v);
138 GEN ellchangecurveinverse(GEN ell, GEN v);
139 GEN ellchangepointinverse(GEN pt, GEN v);
140 GEN ellcomposeurst(GEN urst1, GEN urst2);
141 GEN ellinverturst(GEN urst);
142 GEN mysubst(GEN polsu, GEN subsx);
143 GEN degre(GEN idegre);
144 long nfissquare(GEN nf, GEN a, long prec);
145 GEN nfsqrt(GEN nf, GEN a, long prec);
146 GEN sqrtrat(GEN a);
147 GEN polratroots(GEN pol);
148 GEN ratpoint(GEN pol, GEN lim, GEN singlepoint, long prec);
149 GEN ratpoint2(GEN pol, GEN lim, GEN singlepoint, GEN redflag, long prec);
150 GEN listratpoint(GEN pol, GEN redflag, long prec);
151 GEN redquartic(GEN pol, long prec);
152 GEN polrealrootsisolate(GEN pol);
153 GEN polrealrootsimprove(GEN pol, GEN v);
154 GEN polrootsmodpn(GEN pol, GEN p, long prec);
155 GEN ppinit(GEN nf, GEN p);
156 long nfpsquareoddQ(GEN nf, GEN a, GEN pr, long prec);
157 long psquare(GEN a, GEN p, long prec);
158 long lemma6(GEN pol, GEN p, GEN nu, GEN xx, long prec);
159 long lemma7(GEN pol, GEN nu, GEN xx, long prec);
160 long zpsoluble(GEN pol, GEN p, GEN nu, GEN pnu, GEN x0, GEN pnup, long prec);
161 long qpsoluble(GEN pol, GEN p, long prec);
162 long locallysoluble(GEN pol, long prec);
163 GEN LS2localimage(GEN nf, GEN gen, GEN pp, long prec);
164 GEN ellhalf(GEN ell, GEN P, long prec);
165 GEN elltors2(GEN ell, long prec);
166 GEN elltorseven(GEN ell, long prec);
167 GEN ellsort(GEN listpts, long prec);
168 GEN ellremovetorsion(GEN ell, GEN listgen);
169 GEN ellredgen(GEN ell0, GEN listgen, GEN K, long prec);
170 GEN reducemodsquares(GEN delta, GEN d, long prec);
171 GEN bnfpSelmer(GEN bnf, GEN S, GEN p, long prec);
172 GEN kersign(GEN gen, GEN rootapprox);
173 GEN kernorm(GEN gen, GEN S, GEN p);
174 GEN elllocalimage(GEN nf, GEN pp, GEN K, long prec);
175 GEN ell2descent_gen(GEN ell, GEN bnf, GEN K, GEN help, GEN redflag, long prec);
176 void afficheselmer(GEN m1, GEN m2, GEN tors2);
177 GEN ellrankdebug(GEN ell, GEN lev, GEN help, long prec);
178 GEN ellrank(GEN ell, GEN help, long prec);
179 GEN ell2descent_complete(GEN e1, GEN e2, GEN e3, GEN help, long prec);
180 GEN ellcount(GEN c, GEN d, GEN KS2gen, GEN listpointstriv, long prec);
181 GEN ell2descent_viaisog(GEN ell, GEN help, long prec);
182 long nfsign_s(GEN nf, GEN a, GEN i, long prec);
183 GEN nfpolratroots(GEN nf, GEN pol);
184 GEN nfmodid2(GEN nf, GEN a, GEN ideal);
185 GEN nfhilb2(GEN nf, GEN a, GEN b, GEN p, long prec);
186 GEN mynfhilbertp(GEN nf, GEN a, GEN b, GEN p, long prec);
187 GEN ideallistfactor(GEN nf, GEN listfact);
188 long mynfhilbert(GEN nf, GEN a, GEN b, long prec);
189 GEN initp(GEN nf, GEN p, long prec);
190 GEN deno(GEN num);
191 GEN nfratpoint(GEN nf, GEN pol, GEN lim, GEN singlepoint, long prec);
192 GEN repres(GEN nf, GEN p, long prec);
193 GEN val(GEN nf, GEN num, GEN p);
194 GEN nfissquarep(GEN nf, GEN a, GEN p, GEN q, long prec);
195 long nfpsquareodd(GEN nf, GEN a, GEN p, long prec);
196 long nfpsquare(GEN nf, GEN a, GEN p, GEN zinit, long prec);
197 long nfpsquareq(GEN nf, GEN a, GEN p, GEN q, long prec);
198 long nflemma6(GEN nf, GEN pol, GEN p, GEN nu, GEN xx, long prec);
199 long nflemma7(GEN nf, GEN pol, GEN p, GEN nu, GEN xx, GEN zinit, long prec);
200 long nfzpsoluble(GEN nf, GEN pol, GEN p, GEN nu, GEN pnu, GEN x0, long prec);
201 GEN mynfeltmod(GEN nf, GEN a, GEN b);
202 GEN mynfeltreduce(GEN nf, GEN a, GEN id);
203 GEN nfrandintmodid(GEN nf, GEN id);
204 GEN nfrandint(GEN nf, GEN borne);
205 long nfqpsolublebig(GEN nf, GEN pol, GEN p, GEN ap, GEN b, long prec);
206 GEN nfpolrootsmod(GEN nf, GEN pol, GEN p);
207 long nfqpsoluble(GEN nf, GEN pol, GEN p, long prec);
208 long nflocallysoluble(GEN nf, GEN pol, GEN r, GEN a, GEN b, long prec);
209 GEN nfellcount(GEN nf, GEN c, GEN d, GEN KS2gen, GEN pointstriv, long prec);
210 GEN gettufu(GEN bnf);
211 GEN getfutu(GEN bnf);
212 GEN bnfell2descent_viaisog(GEN bnf, GEN ell, long prec);
213 GEN nfchinremain(GEN nf, GEN b, GEN fact);
214 GEN bnfqfsolve2(GEN bnf, GEN aleg, GEN bleg, GEN auto_s, long prec);
215 GEN bnfqfsolve(GEN bnf, GEN aleg, GEN bleg, GEN flag3, GEN auto_s, long prec);
216 GEN bnfredquartique2(GEN bnf, GEN pol, GEN r, GEN a, GEN b);
217 GEN bnfell2descent_gen(GEN bnf, GEN ell, GEN ext, GEN help, GEN bigflag, GEN flag3, GEN auto_s, long prec);
218 GEN bnfellrank(GEN bnf, GEN ell, GEN help, GEN bigflag, GEN flag3, long prec);
219 GEN bnfell2descent_complete(GEN bnf, GEN e1, GEN e2, GEN e3, GEN flag3, GEN auto_s, long prec);
220 /*End of prototype*/
221
222 static GEN DEBUGLEVEL_qfsolve;
223 static GEN DEBUGLEVEL_ell;
224 static GEN LIM1;
225 static GEN LIM3;
226 static GEN LIMTRIV;
227 static GEN COMPLETE;
228 static GEN MAXPROB;
229 static GEN LIMBIGPRIME;
230 static GEN ELLREDGENFLAG;
231 static GEN BIGINT;
232 static GEN NBIDEAUX;
233 /*End of global vars*/
234
235 void
236 init_ellQ2(void) /* void */
237 {
238 pari_sp ltop = avma;
239 DEBUGLEVEL_qfsolve = pol_x(fetch_user_var("DEBUGLEVEL_qfsolve"));
240 DEBUGLEVEL_ell = pol_x(fetch_user_var("DEBUGLEVEL_ell"));
241 LIM1 = pol_x(fetch_user_var("LIM1"));
242 LIM3 = pol_x(fetch_user_var("LIM3"));
243 LIMTRIV = pol_x(fetch_user_var("LIMTRIV"));
244 COMPLETE = pol_x(fetch_user_var("COMPLETE"));
245 MAXPROB = pol_x(fetch_user_var("MAXPROB"));
246 LIMBIGPRIME = pol_x(fetch_user_var("LIMBIGPRIME"));
247 ELLREDGENFLAG = pol_x(fetch_user_var("ELLREDGENFLAG"));
248 BIGINT = pol_x(fetch_user_var("BIGINT"));
249 NBIDEAUX = pol_x(fetch_user_var("NBIDEAUX"));
250 /*\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
251 /* Copyright (C) 2011 Denis Simon */
252 /* */
253 /* Distributed under the terms of the GNU General Public License (GPL) */
254 /* */
255 /* This code is distributed in the hope that it will be useful, */
256 /* but WITHOUT ANY WARRANTY; without even the implied warranty of */
257 /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU */
258 /* General Public License for more details. */
259 /* */
260 /* The full text of the GPL is available at: */
261 /* */
262 /* http://www.gnu.org/licenses/ */
263 /*\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
264
265 /*
266 Auteur :
267 Denis SIMON -> [email protected]
268 adresse du fichier :
269 www.math.unicaen.fr/~simon/ellQ.gp
270
271 *********************************************
272 * VERSION 24/01/2011 *
273 *********************************************
274
275
276 \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
277 \\ English \\
278 \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
279
280 This package provides functions to compute the rank of elliptic
281 curves over Q using 2-descent.
282 This package requires the other package qfsolve.gp downloadable at
283 www.math.unicaen.fr/~simon/qfsolve.gp
284 They can be run under GP by the commands
285 gp > \r qfsolve.gp
286 gp > \r ellQ.gp
287
288 The main function is ellrank(), which takes as an argument
289 any elliptic curve in the form [a1,a2,a3,a4,a6]
290 the result is a vector [r,s,v], where
291 r is a lower bound for the rank,
292 s is the rank of the 2-Selmer group
293 v is a set of independant points in E(Q)/2E(Q).
294
295 Example:
296
297 gp > ell = [1,2,3,4,5];
298 gp > ellrank(ell)
299 %1 = [1, 1, [[1,2]]
300 In this example, the rank is exactly 1, and [1,2] has infinite order.
301
302 more details on the computations may be obtained by setting
303 DEBUGLEVEL_ell = 1 (the higher value, the more details)
304
305 Other functions:
306
307 ell2descent_complete, ell2descent_gen, ell2descent_viaisog,
308 ellhalf, ellredgen, ellsort, elltors2, elltorseven,
309 locallysoluble, polratroots, ratpoint, redquartic,
310 bnfpSelmer, reducemodsquares
311
312 Quick information is obtained by typing
313 gp > ?NameOfTheFunction
314
315 \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
316 \\ Comment utiliser ce programme ? \\
317 \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
318
319 Programme de calcul du rang des courbes elliptiques sur Q.
320 langage : GP
321 pour l'utiliser, lancer gp, puis taper
322 \r ellQ.gp
323
324 Ce programme utilise le module de resolution des formes quadratiques
325 situe a l'adresse
326 www.math.unicaen.fr/~simon/qfsolve.gp
327 Il faut donc aussi taper :
328 \r qfsolve.gp
329
330
331 \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
332 \\ Description des principales fonctions \\
333 \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
334
335 Explications succintes :
336 La fonction ellrank() accepte toutes les courbes sous la forme
337 [a1,a2,a3,a4,a6]
338 Les coefficients peuvent etre entiers ou non.
339 L'algorithme utilise est celui de la 2-descente.
340 La 2-torsion peut etre quelconque.
341 Il suffit de taper :
342
343 gp > ell = [a1,a2,a3,a4,a6];
344 gp > ellrank(ell)
345
346 Retourne un vecteur [r,s,v] ou
347 r est le rang probable (c'est toujours une minoration du rang),
348 s est le 2-rang du groupe de Selmer,
349 v est une liste de points independants dans E(Q)/2E(Q).
350
351 Exemple :
352
353 gp > ell = [1,2,3,4,5];
354 gp > ellrank(ell)
355 %1 = [1, 1, [[1,2]]
356 Ici, le rang est exactement 1, et le point [1,2] est d'ordre infini.
357
358 Courbes de la forme : k*y^2 = x^3+A*x^2+B*x+C
359 sans 2-torsion, A,B,C entiers.
360 gp > bnf = bnfinit(x^3+A*x^2+B*x+C);
361 gp > ell = ellinit([0,A,0,B,C],1);
362 gp > rank = ell2descent_gen(ell,bnf,k);
363
364 Courbes avec #E[2](Q) >= 2 :
365 ell doit etre sous la forme
366 y^2 = x^3 + A*^2 + B*x
367 avec A et B entiers.
368 gp > ell = [0,A,0,B,0]
369 gp > ell2descent_viaisog(ell)
370 = algorithme de la 2-descente par isogenies
371 Attention A et B doivent etre entiers
372
373 Courbes avec #E[2](Q) = 4 : y^2 = (x-e1)*(x-e2)*(x-e3)
374 gp > ell2descent_complete(e1,e2,e3)
375 = algorithme de la 2-descente complete
376 Attention : les ei doivent etre entiers.
377
378 \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
379 \\ Autres fonctions utiles \\
380 \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
381
382 elltors2(E) : determine le groupe E[2](Q)
383 elltorseven(E) : determine le groupe E[2^*](Q)
384 ellhalf(E,P) : liste les points Q tels que 2Q = P
385 ellredgen(E,v) : reduction des points de v sur E
386
387 locallysoluble(pol): teste si y^2=pol(x) est ELS
388 ratpoint(pol,lim): cherche un point sur y^2=pol(x)
389 redquartic(pol): reduction de la quartique pol
390 polratroots(pol) : liste les solutions rationnelles de pol
391
392
393 Aide en ligne :
394 ?NomDeLaFonction
395
396
397 \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
398 \\ Affichage des calculs \\
399 \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
400
401 On peut avoir plus ou moins de details de calculs avec
402 DEBUGLEVEL_ell = 0;
403 DEBUGLEVEL_ell = 1; 2; 3;...
404
405 */
406
407 /*\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
408 /* Copyright (C) 2011 Denis Simon */
409 /* */
410 /* Distributed under the terms of the GNU General Public License (GPL) */
411 /* */
412 /* This code is distributed in the hope that it will be useful, */
413 /* but WITHOUT ANY WARRANTY; without even the implied warranty of */
414 /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU */
415 /* General Public License for more details. */
416 /* */
417 /* The full text of the GPL is available at: */
418 /* */
419 /* http://www.gnu.org/licenses/ */
420 /*\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
421
422 /*
423 Author:
424 Denis SIMON -> [email protected]
425 address of the file:
426 www.math.unicaen.fr/~simon/qfsolve.gp
427
428 *********************************************
429 * VERSION 21/02/2011 *
430 *********************************************
431
432 \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
433 \\ English help \\
434 \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
435
436 This package provides functions to solve quadratic equations over Q.
437 language: GP
438 It can be run under GP by the command
439 gp > \r qfsolve.gp
440
441 This package contains 4 main functions:
442
443 - Qfsolve(G,factD): solve over Q the quadratic equation X~*G*X = 0.
444 G must be a symmetric matrix n*n, with coefficients in Z.
445 If no solution exists, the output is a prime number
446 indicating that there is no solution in the local field Q_p
447 (-1 for the reals).
448 This algorithm requires the factorization of -abs(2*matdet(G)).
449 If this factorization is known, one can give it as factD (the second
450 argument of the function) and save a lot of time.
451
452 - Qfparam(G,sol,fl): parametrization by quadratic forms of the
453 solutions of the ternary quadratic form G, using the particular
454 solution sol.
455 If fl>0, then the 'fl'th form is reduced.
456
457 - IndefiniteLLL(G,c): Solve or reduce the quadratic form G with
458 integral coefficients. G might be definite or indefinite.
459 This is an LLL-type algorithm with a constant 1/4<c<1.
460
461 - class2(d,factd): computes the 2-Sylow of the (narrow) class group
462 of discriminant d. d must be a fondamental discriminant.
463 This algorithm requires the factorization of abs(2*d).
464 If this factorization is known, one can give it as factd (the second
465 argument of the function) and the algorithm runs in polynomial time.
466
467 \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
468 \\ Description des fonctions \\
469 \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
470
471 Programme de resolution des equations quadratiques
472 langage: GP
473 pour l'utiliser, lancer gp, puis taper
474 \r qfsolve.gp
475
476 Ce fichier contient 4 principales fonctions:
477
478 - Qfsolve(G,factD): pour resoudre l'equation quadratique X^t*G*X = 0
479 G doit etre une matrice symetrique n*n, a coefficients dans Z.
480 S'il n'existe pas de solution, la reponse est un entier
481 indiquant un corps local dans lequel aucune solution n'existe
482 (-1 pour les reels, p pour Q_p).
483 Si on connait la factorisation de -abs(2*matdet(G)),
484 on peut la passer par le parametre factD pour gagner du temps.
485
486 - Qfparam(G,sol,fl): pour parametrer les solutions de la forme
487 quadratique ternaire G, en utilisant la solution particuliere sol.
488 si fl>0, la 'fl'eme forme quadratique est reduite.
489
490 - IndefiniteLLL(G,c): pour resoudre ou reduire la forme quadratique
491 G a coefficients entiers. Il s'agit d'un algorithme type LLL, avec la
492 constante 1/4<c<1.
493
494 - class2(d,factd): determine le 2-Sylow du (narrow) groupe de classes de
495 discriminant d, ou d est un discriminant fondamental.
496 Si on connait la factorisation de abs(2*d),
497 on peut la donner dans factd, et dans ce cas le reste
498 de l'algorithme est polynomial.
499
500 */
501
502 /* */
503 /* Usual global variables */
504 /* */
505
506 DEBUGLEVEL_qfsolve = gen_0;
507 /* */
508 /* Usual global variables */
509 /* */
510
511 DEBUGLEVEL_ell = gen_0;
512 /* From 0 to 5 : choose a higher value to have */
513 /* more details printed. */
514 LIM1 = stoi(5);
515 /* Limit for the search of trivial points on quartics */
516 LIM3 = stoi(50);
517 /* Limit for the search of points on ELS quartics */
518 LIMTRIV = stoi(3);
519 /* Limit for the search of trivial points on the elliptic curve */
520 COMPLETE = gen_1;
521 /* Use Complete 2-descent when full 2-torsion, */
522 /* otherwise 2-descent via isogenies. */
523
524 /* */
525 /* Technical global variables */
526 /* */
527
528 MAXPROB = stoi(20);
529 LIMBIGPRIME = stoi(30);
530 /* for primes larger than this limit, */
531 /* use a probabilistic test */
532 /* LIMBIGPRIME = 0 means only deterministic tests */
533 ELLREDGENFLAG = gen_1;
534 /* to reduce the generators at the end */
535 /* \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
536 /* SCRIPT \\ */
537 /* \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
538
539 /* \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
540 /* COMMON FUNCTIONS TO ell.gp AND ellQ.gp \\ */
541 /* \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
542
543 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
544 pari_printf("ellchangecurveinverse\n");
545 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
546 pari_printf("ellchangepointinverse\n");
547 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
548 pari_printf("ellcomposeurst\n");
549 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
550 pari_printf("ellinverturst\n");
551 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
552 pari_printf("mysubst\n");
553 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
554 pari_printf("degre\n");
555 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
556 pari_printf("nfissquare\n");
557 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
558 pari_printf("nfsqrt\n");
559 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
560 pari_printf("sqrtrat\n");
561 /* \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
562 /* FUNCTIONS SPECIFIC TO ellQ.gp \\ */
563 /* \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
564
565 /* \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
566 /* FUNCTIONS FOR POLYNOMIALS \\ */
567 /* \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
568
569 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
570 pari_printf("polratroots\n");
571 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
572 pari_printf("ratpoint\n");
573 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
574 pari_printf("ratpoint2\n");
575 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
576 pari_printf("listratpoint\n");
577 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
578 pari_printf("redquartic\n");
579 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
580 pari_printf("polrealrootsisolate\n");
581 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
582 pari_printf("polrealrootsimprove\n");
583 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
584 pari_printf("polrootsmodpn\n");
585 /* \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
586 /* FUNCTIONS FOR LOCAL COMPUTATIONS \\ */
587 /* \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
588
589 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
590 pari_printf("ppinit\n");
591 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
592 pari_printf("nfpsquareoddQ\n");
593 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
594 pari_printf("psquare\n");
595 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
596 pari_printf("lemma6\n");
597 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
598 pari_printf("lemma7\n");
599 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
600 pari_printf("zpsoluble\n");
601 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
602 pari_printf("qpsoluble\n");
603 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
604 pari_printf("locallysoluble\n");
605 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
606 pari_printf("LS2localimage\n");
607 /* \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
608 /* GENERIC FUNCTIONS FOR ELLIPTIC CURVES \\ */
609 /* \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
610
611 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
612 pari_printf("ellhalf\n");
613 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
614 pari_printf("elltors2\n");
615 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
616 pari_printf("elltorseven\n");
617 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
618 pari_printf("ellsort\n");
619 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
620 pari_printf("ellremovetorsion\n");
621 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
622 pari_printf("ellredgen\n");
623 /* \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
624 /* FUNCTIONS FOR NUMBER FIELDS \\ */
625 /* \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
626
627 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
628 pari_printf("reducemodsquares\n");
629 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
630 pari_printf("bnfpSelmer\n");
631 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
632 pari_printf("kersign\n");
633 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
634 pari_printf("kernorm\n");
635 /* \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
636 /* FUNCTIONS FOR 2-DESCENT \\ */
637 /* \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
638
639 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
640 pari_printf("elllocalimage\n");
641 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
642 pari_printf("ell2descent_gen\n");
643 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
644 pari_printf("afficheselmer\n");
645 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
646 pari_printf("ellrank\n");
647 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
648 pari_printf("ell2descent_complete\n");
649 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
650 pari_printf("ellcount\n");
651 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
652 pari_printf("ell2descent_viaisog\n");
653 /* \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
654 /* HELP MESSAGES \\ */
655 /* \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
656
657 /* functions for elliptic curves */
658 /* functions for polynomials */
659 /* functions for number fields */
660 /* others */
661 /*\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
662 /* Copyright (C) 2007 Denis Simon */
663 /* */
664 /* Distributed under the terms of the GNU General Public License (GPL) */
665 /* */
666 /* This code is distributed in the hope that it will be useful, */
667 /* but WITHOUT ANY WARRANTY; without even the implied warranty of */
668 /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU */
669 /* General Public License for more details. */
670 /* */
671 /* The full text of the GPL is available at: */
672 /* */
673 /* http://www.gnu.org/licenses/ */
674 /*\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
675
676 /* */
677 /* Auteur: */
678 /* Denis SIMON -> [email protected] */
679 /* adresse du fichier: */
680 /* www.math.unicaen.fr/~simon/ell.gp */
681 /* */
682 /* ********************************************* */
683 /* * VERSION 25/03/2009 * */
684 /* ********************************************* */
685 /* */
686 /* Programme de calcul du rang des courbes elliptiques */
687 /* dans les corps de nombres. */
688 /* langage: GP */
689 /* pour l'utiliser, lancer gp, puis taper */
690 /* \r ell.gp */
691 /* */
692 /* */
693 /* Explications succintes : */
694 /* definition du corps : */
695 /* bnf=bnfinit(y^2+1); */
696 /* (il est indispensable que la variable soit y). */
697 /* on peut ensuite poser : */
698 /* X = Mod(y,bnf.pol); */
699 /* */
700 /* La fonction bnfellrank() accepte toutes les courbes sous la forme */
701 /* [a1,a2,a3,a4,a6] */
702 /* Les coefficients peuvent etre entiers ou non. */
703 /* L'algorithme utilise est celui de la 2-descente. */
704 /* La 2-torsion peut etre quelconque. */
705 /* Il suffit de taper : */
706 /* */
707 /* gp > ell = [a1,a2,a3,a4,a6]; */
708 /* gp > bnfellrank(bnf,ell) */
709 /* */
710 /* Retourne un vecteur [r,s,vec] */
711 /* ou r est le rang probable (c'est toujours une minoration du rang), */
712 /* s est le 2-rang du groupe de Selmer, */
713 /* vec est une liste de points dans E(K)/2E(K). */
714 /* */
715 /* Courbes avec #E[2](K) >= 2: */
716 /* ell doit etre sous la forme */
717 /* y^2 = x^3 + A*^2 + B*x */
718 /* avec A et B entiers algebriques */
719 /* gp > ell = [0,A,0,B,0] */
720 /* gp > bnfell2descent_viaisog(ell) */
721 /* = algorithme de la 2-descente par isogenies */
722 /* Attention A et B doivent etre entiers */
723 /* */
724 /* Courbes avec #E[2](K) = 4: y^2 = (x-e1)*(x-e2)*(x-e3) */
725 /* -> bnfell2descent_complete(bnf,e1,e2,e3); */
726 /* = algorithme de la 2-descente complete */
727 /* Attention: les ei doivent etre entiers algebriques. */
728 /* */
729 /* */
730 /* On peut avoir plus ou moins de details de calculs avec */
731 /* DEBUGLEVEL_ell = 0; */
732 /* DEBUGLEVEL_ell = 1; 2; 3;... */
733 /* */
734
735 /* */
736 /* Variables globales usuelles */
737 /* */
738
739 DEBUGLEVEL_ell = gen_1;
740 /* pour avoir plus ou moins de details */
741 LIM1 = gen_2;
742 /* limite des points triviaux sur les quartiques */
743 LIM3 = stoi(4);
744 /* limite des points sur les quartiques ELS */
745 LIMTRIV = gen_2;
746 /* limite des points triviaux sur la courbe elliptique */
747
748 /* */
749 /* Variables globales techniques */
750 /* */
751
752 BIGINT = stoi(32000);
753 /* l'infini */
754 MAXPROB = stoi(20);
755 LIMBIGPRIME = stoi(30);
756 /* pour distinguer un petit nombre premier d'un grand */
757 /* utilise un test probabiliste pour les grands */
758 /* si LIMBIGPRIME = 0, n'utilise aucun test probabiliste */
759 NBIDEAUX = stoi(10);
760 /* */
761 /* Programmes */
762 /* */
763
764 /* */
765 /* Fonctions communes ell.gp et ellQ.gp */
766 /* */
767 /*
768 {
769 ellinverturst(urst) =
770 local(u = urst[1], r = urst[2], s = urst[3], t = urst[4]);
771 [1/u,-r/u^2,-s/u,(r*s-t)/u^3];
772 }
773 */
774 /*
775 {
776 ellchangecurveinverse(ell,v) = ellchangecurve(ell,ellinverturst(v));
777 }
778 {
779 ellchangepointinverse(pt,v) = ellchangepoint(pt,ellinverturst(v));
780 }
781 */
782 /*
783 {
784 ellcomposeurst(urst1,urst2) =
785 local(u1 = urst1[1], r1 = urst1[2], s1 = urst1[3], t1 = urst1[4],
786 u2 = urst2[1], r2 = urst2[2], s2 = urst2[3], t2 = urst2[4]);
787 [u1*u2,u1^2*r2+r1,u1*s2+s1,u1^3*t2+s1*u1^2*r2+t1];
788 }
789 */
790 /*
791 if( DEBUGLEVEL_ell >= 4, print("mysubst"));
792 {
793 mysubst(polsu,subsx) =
794 if( type(lift(polsu)) == "t_POL",
795 return(simplify(subst(lift(polsu),variable(lift(polsu)),subsx)) )
796 , return(simplify(lift(polsu))));
797 }
798 */
799
800 /* MODI nfsign is a GP function, must modify */
801
802 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
803 pari_printf("nfsign_s\n");
804 /*
805 if( DEBUGLEVEL_ell >= 4, print("degre"));
806 {
807 degre(idegre) =
808 local(ideg = idegre, jdeg = 0);
809
810 while( ideg >>= 1, jdeg++);
811 return(jdeg);
812 }
813 */
814 /*
815 if( DEBUGLEVEL_ell >= 4, print("nfissquare"));
816 {
817 nfissquare(nf, a) = #nfsqrt(nf,a) > 0;
818 }
819 if( DEBUGLEVEL_ell >= 4, print("nfsqrt"));
820 {
821 nfsqrt( nf, a) =
822 \\ si a est un carre, renvoie [sqrt(a)], sinon [].
823 local(alift,ta,res,pfact);
824
825 if( DEBUGLEVEL_ell >= 5, print("entree dans nfsqrt ",a));
826 if( a==0 || a==1,
827 if( DEBUGLEVEL_ell >= 5, print("fin de nfsqrt"));
828 return([a]));
829
830 alift = lift(a);
831 ta = type(a);
832 if( !poldegree(alift), alift = polcoeff(alift,0));
833
834 if( type(alift) != "t_POL",
835 if( issquare(alift),
836 if( DEBUGLEVEL_ell >= 5, print("fin de nfsqrt"));
837 return([sqrtrat(alift)])));
838
839 if( poldegree(nf.pol) <= 1,
840 if( DEBUGLEVEL_ell >= 5, print("fin de nfsqrt"));
841 return([]));
842 if( ta == "t_POL", a = Mod(a,nf.pol));
843
844 \\ tous les plgements reels doivent etre >0
845
846 for( i = 1, nf.r1,
847 if( nfsign_s(nf,a,i) < 0,
848 if( DEBUGLEVEL_ell >= 5, print("fin de nfsqrt"));
849 return([])));
850
851 \\ factorisation sur K du polynome X^2-a :
852
853 if( variable(nf.pol) == x,
854 py = subst(nf.pol,x,y);
855 pfact = lift(factornf(x^2-mysubst(alift,Mod(y,py)),py)[1,1])
856 ,
857 pfact = lift(factornf(x^2-a,nf.pol)[1,1]));
858 if( poldegree(pfact) == 2,
859 if( DEBUGLEVEL_ell >= 5, print("fin de nfsqrt"));
860 return([]));
861 if( DEBUGLEVEL_ell >= 5, print("fin de nfsqrt"));
862 return([subst(polcoeff(pfact,0),y,Mod(variable(nf.pol),nf.pol))]);
863 }
864 */
865 /*
866 if( DEBUGLEVEL_ell >= 4, print("sqrtrat"));
867 {
868 sqrtrat(a) =
869 sqrtint(numerator(a))/sqrtint(denominator(a));
870 }
871 */
872
873 /* */
874 /* Fonctions propres a ell.gp */
875 /* */
876
877 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
878 pari_printf("nfpolratroots\n");
879 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
880 pari_printf("nfmodid2\n");
881 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
882 pari_printf("nfhilb2\n");
883 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
884 pari_printf("mynfhilbertp\n");
885 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
886 pari_printf("ideallistfactor\n");
887 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
888 pari_printf("mynfhilbert\n");
889 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
890 pari_printf("initp\n");
891 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
892 pari_printf("deno\n");
893 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
894 pari_printf("nfratpoint\n");
895 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
896 pari_printf("repres\n");
897 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
898 pari_printf("val\n");
899 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
900 pari_printf("nfissquarep\n");
901 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
902 pari_printf("nfpsquareodd\n");
903 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
904 pari_printf("nfpsquare\n");
905 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
906 pari_printf("nfpsquareq\n");
907 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
908 pari_printf("nflemma6\n");
909 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
910 pari_printf("nflemma7\n");
911 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
912 pari_printf("nfzpsoluble\n");
913 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
914 pari_printf("mynfeltmod\n");
915 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
916 pari_printf("mynfeltreduce\n");
917 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
918 pari_printf("nfrandintmodid\n");
919 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
920 pari_printf("nfrandint\n");
921 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
922 pari_printf("nfqpsolublebig\n");
923 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
924 pari_printf("nfpolrootsmod\n");
925 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
926 pari_printf("nfqpsoluble\n");
927 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
928 pari_printf("nflocallysoluble\n");
929 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
930 pari_printf("nfellcount\n");
931 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
932 pari_printf("bnfell2descent_viaisog\n");
933 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
934 pari_printf("nfchinremain\n");
935 /* MODI must change auto to auto_s: reserved C */
936
937 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
938 pari_printf("bnfqfsolve2\n");
939 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
940 pari_printf("bnfqfsolve\n");
941 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
942 pari_printf("bnfredquartique2\n");
943 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
944 pari_printf("bnfell2descent_gen\n");
945 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
946 pari_printf("bnfellrank\n");
947 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
948 pari_printf("bnfell2descent_complete\n");
949 gerepileall(ltop, 11, &DEBUGLEVEL_qfsolve, &DEBUGLEVEL_ell, &LIM1, &LIM3, &LIMTRIV, &COMPLETE, &MAXPROB, &LIMBIGPRIME, &ELLREDGENFLAG, &BIGINT, &NBIDEAUX);
950 return;
951 }
952
953 /* \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
954 /* SCRIPT \\ */
955 /* \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
956
957 GEN
958 QfbReduce(GEN M, long prec)
959 {
960 pari_sp ltop = avma;
961 GEN a = gen_0, b = gen_0, c = gen_0, H = gen_0, test = gen_0, di = gen_0, q = gen_0, r = gen_0, nexta = gen_0, nextb = gen_0, nextc = gen_0, aux = gen_0;
962 if (gcmpgs(DEBUGLEVEL_qfsolve, 5) >= 0)
963 pari_printf(" starting QfbReduce with %Ps\n", M);
964 a = gcopy(gcoeff(M, 1, 1));
965 b = gcopy(gcoeff(M, 1, 2));
966 c = gcopy(gcoeff(M, 2, 2));
967 H = matid(2);
968 test = gen_1;
969 {
970 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
971 while (!gequal0(test) && !gequal0(a))
972 {
973 di = divrem(b, a, -1);
974 q = gcopy(gel(di, 1));
975 r = gcopy(gel(di, 2));
976 if (gcmp(gmulsg(2, r), gabs(a, prec)) > 0)
977 {
978 r = gsub(r, gabs(a, prec));
979 q = gaddgs(q, gsigne(a));
980 }
981 gel(H, 2) = gsub(gel(H, 2), gmul(q, gel(H, 1)));
982 nextc = a;
983 nextb = gneg(r);
984 nexta = gadd(gmul(gsub(nextb, b), q), c);
985 if (!gequal0(test = stoi(gcmp(gabs(nexta, prec), gabs(a, prec)) < 0)))
986 {
987 c = nextc;
988 b = nextb;
989 a = nexta;
990 aux = gcopy(gel(H, 1));
991 gel(H, 1) = gneg(gel(H, 2));
992 gel(H, 2) = gcopy(aux);
993 }
994 if (low_stack(st_lim, stack_lim(btop, 1)))
995 gerepileall(btop, 12, &di, &q, &r, &H, &nextc, &nextb, &nexta, &test, &c, &b, &a, &aux);
996 }
997 }
998 if (gcmpgs(DEBUGLEVEL_qfsolve, 5) >= 0)
999 pari_printf(" end of QfbReduce with %Ps\n", H);
1000 H = gerepilecopy(ltop, H);
1001 return H;
1002 }
1003
1004 GEN
1005 IndefiniteLLL(GEN G, GEN c, GEN base, long prec)
1006 {
1007 pari_sp ltop = avma;
1008 GEN n = gen_0, M = gen_0, QD = gen_0, M1 = gen_0, S = gen_0, red = gen_0, p1 = gen_0, p2 = gen_0;
1009 GEN p3 = gen_0, p4 = gen_0; /* vec */
1010 if (!c)
1011 c = gen_1;
1012 if (!base)
1013 base = gen_0;
1014 n = stoi(glength(G));
1015 M = matid(gtos(n));
1016 QD = gcopy(G);
1017 p1 = gsubgs(n, 1);
1018 {
1019 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
1020 GEN i = gen_0, p5 = gen_0;
1021 long l6; /* lg */
1022 long l7;
1023 GEN p8 = gen_0; /* vec */
1024 for (i = gen_1; gcmp(i, p1) <= 0; i = gaddgs(i, 1))
1025 {
1026 if (gequal0(gcoeff(QD, gtos(i), gtos(i))))
1027 {
1028 p5 = IndefiniteLLL2(G, c, base, prec);
1029 p5 = gerepilecopy(ltop, p5);
1030 return p5;
1031 }
1032 M1 = matid(gtos(n));
1033 p8 = gdiv(gneg(rowcopy(QD, gtos(i))), gcoeff(QD, gtos(i), gtos(i)));
1034 l6 = lg(M1);
1035 for (l7 = 1; l7 < l6; ++l7)
1036 gcoeff(M1, gtos(i), l7) = gcopy(gel(p8, l7));
1037 gcoeff(M1, gtos(i), gtos(i)) = gen_1;
1038 M = gmul(M, M1);
1039 QD = gmul(gmul(gtrans(M1), QD), M1);
1040 if (low_stack(st_lim, stack_lim(btop, 1)))
1041 gerepileall(btop, 6, &i, &p5, &M1, &p8, &M, &QD);
1042 }
1043 }
1044 M = ginv(M);
1045 QD = gmul(gmul(gtrans(M), gabs(QD, prec)), M);
1046 S = qflllgram0(gdiv(QD, content(QD)), 0);
1047 red = IndefiniteLLL2(gmul(gmul(gtrans(S), G), S), c, base, prec);
1048 if (typ(red) == t_COL)
1049 {
1050 p2 = gmul(S, red);
1051 p2 = gerepilecopy(ltop, p2);
1052 return p2;
1053 }
1054 if (glength(red) == 3)
1055 {
1056 p3 = cgetg(4, t_VEC);
1057 gel(p3, 1) = gcopy(gel(red, 1));
1058 gel(p3, 2) = gmul(S, gel(red, 2));
1059 gel(p3, 3) = gmul(S, gel(red, 3));
1060 p3 = gerepilecopy(ltop, p3);
1061 return p3;
1062 }
1063 p4 = cgetg(3, t_VEC);
1064 gel(p4, 1) = gcopy(gel(red, 1));
1065 gel(p4, 2) = gmul(S, gel(red, 2));
1066 p4 = gerepilecopy(ltop, p4);
1067 return p4;
1068 }
1069
1070 GEN
1071 IndefiniteLLL2(GEN G, GEN c, GEN base, long prec)
1072 {
1073 pari_sp ltop = avma;
1074 GEN n = gen_0, H = gen_0, M = gen_0, A = gen_0, aux = gen_0, sol = gen_0, k = gen_0, nextk = gen_0, swap = gen_0, q = gen_0, di = gen_0, HM = gen_0, aux1 = gen_0, aux2 = gen_0, Mkk1 = gen_0, bk1new = gen_0, Mkk1new = gen_0, newG = gen_0;
1075 GEN p1 = gen_0, p2 = gen_0, p3 = gen_0; /* vec */
1076 if (!c)
1077 c = gen_1;
1078 if (!base)
1079 base = gen_0;
1080 n = stoi(glength(G));
1081 if (gcmpgs(DEBUGLEVEL_qfsolve, 3) >= 0)
1082 pari_printf(" LLL dim %Ps avec |G| = %Ps\n", n, gdiv(glog(vecmax(gabs(G, prec)), prec), glog(stoi(10), prec)));
1083 if (gcmpgs(DEBUGLEVEL_qfsolve, 4) >= 0)
1084 {
1085 pari_printf(" LLL with \n");
1086 pari_printf("%Ps\n", G);
1087 }
1088 /* MODI2.1 */
1089
1090 if (gcmpgs(n, 1) <= 0)
1091 {
1092 p1 = cgetg(3, t_VEC);
1093 gel(p1, 1) = gcopy(G);
1094 gel(p1, 2) = matid(gtos(n));
1095 p1 = gerepilecopy(ltop, p1);
1096 return p1;
1097 }
1098 H = gcopy(M = matid(gtos(n)));
1099 {
1100 long l4, l5;
1101 p2 = cgetg(gtos(n)+1, t_MAT);
1102 for (l5 = 1; gcmpsg(l5, n) <= 0; ++l5)
1103 {
1104 gel(p2, l5) = cgetg(gtos(n)+1, t_COL);
1105 for (l4 = 1; gcmpsg(l4, n) <= 0; ++l4)
1106 gcoeff(p2, l4, l5) = gen_0;
1107 }
1108 }
1109 A = p2;
1110 /* compute Gram-Schmidt */
1111
1112 {
1113 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
1114 GEN i = gen_0;
1115 GEN p6 = gen_0; /* vec */
1116 GEN p7 = gen_0, p8 = gen_0;
1117 for (i = gen_1; gcmp(i, n) <= 0; i = gaddgs(i, 1))
1118 {
1119 if (gequal0(gcoeff(A, gtos(i), gtos(i)) = gcopy(gcoeff(G, gtos(i), gtos(i)))))
1120 {
1121 if (!gequal0(base))
1122 {
1123 aux = gcopy(gel(H, 1));
1124 gel(H, 1) = gcopy(gel(H, gtos(i)));
1125 gel(H, gtos(i)) = gneg(aux);
1126 p6 = cgetg(4, t_VEC);
1127 gel(p6, 1) = gmul(gmul(gtrans(H), G), H);
1128 gel(p6, 2) = gcopy(H);
1129 gel(p6, 3) = gcopy(gel(H, 1));
1130 p6 = gerepilecopy(ltop, p6);
1131 return p6;
1132 }
1133 else
1134 {
1135 p7 = gcopy(gel(M, gtos(i)));
1136 p7 = gerepilecopy(ltop, p7);
1137 return p7;
1138 }
1139 }
1140 p8 = gsubgs(i, 1);
1141 {
1142 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
1143 GEN j = gen_0, p9 = gen_0, p10 = gen_0;
1144 GEN p11 = gen_0; /* vec */
1145 for (j = gen_1; gcmp(j, p8) <= 0; j = gaddgs(j, 1))
1146 {
1147 p9 = gsubgs(j, 1);
1148 {
1149 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
1150 GEN k = gen_0;
1151 p10 = gen_0;
1152 for (k = gen_1; gcmp(k, p9) <= 0; k = gaddgs(k, 1))
1153 {
1154 p10 = gadd(p10, gmul(gcoeff(M, gtos(j), gtos(k)), gcoeff(A, gtos(i), gtos(k))));
1155 if (low_stack(st_lim, stack_lim(btop, 1)))
1156 gerepileall(btop, 2, &p10, &k);
1157 }
1158 }
1159 gcoeff(A, gtos(i), gtos(j)) = gsub(gcoeff(G, gtos(i), gtos(j)), p10);
1160 gcoeff(M, gtos(i), gtos(j)) = gdiv(gcoeff(A, gtos(i), gtos(j)), gcoeff(A, gtos(j), gtos(j)));
1161 gcoeff(A, gtos(i), gtos(i)) = gsub(gcoeff(A, gtos(i), gtos(i)), gmul(gcoeff(M, gtos(i), gtos(j)), gcoeff(A, gtos(i), gtos(j))));
1162 if (gequal0(gcoeff(A, gtos(i), gtos(i))))
1163 {
1164 sol = gcopy(gel(gtrans(ginv(M)), gtos(i)));
1165 sol = gdiv(sol, content(sol));
1166 if (!gequal0(base))
1167 {
1168 H = completebasis(sol, NULL);
1169 aux = gcopy(gel(H, 1));
1170 gel(H, 1) = gcopy(gel(H, gtos(n)));
1171 gel(H, gtos(n)) = gneg(aux);
1172 p11 = cgetg(4, t_VEC);
1173 gel(p11, 1) = gmul(gmul(gtrans(H), G), H);
1174 gel(p11, 2) = gcopy(H);
1175 gel(p11, 3) = gcopy(gel(H, 1));
1176 p11 = gerepilecopy(ltop, p11);
1177 return p11;
1178 }
1179 else
1180 {
1181 sol = gerepilecopy(ltop, sol);
1182 return sol;
1183 }
1184 }
1185 if (low_stack(st_lim, stack_lim(btop, 1)))
1186 gerepileall(btop, 9, &j, &p9, &p10, &A, &M, &sol, &H, &aux, &p11);
1187 }
1188 }
1189 if (low_stack(st_lim, stack_lim(btop, 1)))
1190 gerepileall(btop, 9, &i, &A, &aux, &H, &p6, &p7, &p8, &M, &sol);
1191 }
1192 }
1193 /* LLL loop */
1194
1195 k = gen_2;
1196 nextk = gen_1;
1197 {
1198 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
1199 GEN p12 = gen_0;
1200 while (gcmp(k, n) <= 0)
1201 {
1202 swap = gen_1;
1203 {
1204 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
1205 GEN p13 = gen_0;
1206 long l14;
1207 GEN p15 = gen_0; /* vec */
1208 GEN p16 = gen_0, p17 = gen_0, p18 = gen_0;
1209 GEN p19 = gen_0; /* vec */
1210 while (!gequal0(swap))
1211 {
1212 swap = gen_0;
1213 /* red(k,k-1); */
1214 if (!gequal0(q = ground(gcoeff(M, gtos(k), gtos(gsubgs(k, 1))))))
1215 {
1216 p13 = gsubgs(k, 2);
1217 {
1218 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
1219 GEN i = gen_0;
1220 long l20;
1221 for (i = gen_1; gcmp(i, p13) <= 0; i = gaddgs(i, 1))
1222 {
1223 l20 = gtos(gsubgs(k, 1));
1224 gcoeff(M, gtos(k), gtos(i)) = gsub(gcoeff(M, gtos(k), gtos(i)), gmul(q, gcoeff(M, l20, gtos(i))));
1225 if (low_stack(st_lim, stack_lim(btop, 1)))
1226 gerepileall(btop, 2, &i, &M);
1227 }
1228 }
1229 l14 = gtos(gsubgs(k, 1));
1230 gcoeff(M, gtos(k), l14) = gsub(gcoeff(M, gtos(k), l14), q);
1231 {
1232 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
1233 GEN i = gen_0;
1234 long l21, l22;
1235 for (i = gen_1; gcmp(i, n) <= 0; i = gaddgs(i, 1))
1236 {
1237 l21 = gtos(gsubgs(k, 1));
1238 gcoeff(A, gtos(k), gtos(i)) = gsub(gcoeff(A, gtos(k), gtos(i)), gmul(q, gcoeff(A, l21, gtos(i))));
1239 l22 = gtos(gsubgs(k, 1));
1240 gcoeff(H, gtos(i), gtos(k)) = gsub(gcoeff(H, gtos(i), gtos(k)), gmul(q, gcoeff(H, gtos(i), l22)));
1241 if (low_stack(st_lim, stack_lim(btop, 1)))
1242 gerepileall(btop, 3, &i, &A, &H);
1243 }
1244 }
1245 }
1246 /* preparation of swap(k,k-1) */
1247
1248 if (!gequal0(gissquare(di = gmul(gneg(gcoeff(A, gtos(gsubgs(k, 1)), gtos(gsubgs(k, 1)))), gcoeff(A, gtos(k), gtos(k))))))
1249 {
1250 /* di is the determinant of matr */
1251 /* We find a solution */
1252 HM = gtrans(ginv(M));
1253 aux1 = sqrtint(numer(di));
1254 aux2 = sqrtint(denom(di));
1255 sol = gadd(gmul(aux1, gel(HM, gtos(gsubgs(k, 1)))), gmul(gmul(aux2, gcoeff(A, gtos(gsubgs(k, 1)), gtos(gsubgs(k, 1)))), gel(HM, gtos(k))));
1256 sol = gdiv(sol, content(sol));
1257 if (!gequal0(base))
1258 {
1259 H = gmul(H, completebasis(sol, gen_1));
1260 aux = gcopy(gel(H, 1));
1261 gel(H, 1) = gcopy(gel(H, gtos(n)));
1262 gel(H, gtos(n)) = gneg(aux);
1263 p15 = cgetg(4, t_VEC);
1264 gel(p15, 1) = gmul(gmul(gtrans(H), G), H);
1265 gel(p15, 2) = gcopy(H);
1266 gel(p15, 3) = gcopy(gel(H, 1));
1267 p15 = gerepilecopy(ltop, p15);
1268 return p15;
1269 }
1270 else
1271 {
1272 p16 = gmul(H, sol);
1273 p16 = gerepilecopy(ltop, p16);
1274 return p16;
1275 }
1276 }
1277 /* Reduction [k,k-1]. */
1278 Mkk1 = gcopy(gcoeff(M, gtos(k), gtos(gsubgs(k, 1))));
1279 bk1new = gadd(gmul(gsqr(Mkk1), gcoeff(A, gtos(gsubgs(k, 1)), gtos(gsubgs(k, 1)))), gcoeff(A, gtos(k), gtos(k)));
1280 if (!gequal0(swap = stoi(gcmp(gabs(bk1new, prec), gmul(c, gabs(gcoeff(A, gtos(gsubgs(k, 1)), gtos(gsubgs(k, 1))), prec))) < 0)))
1281 Mkk1new = gdiv(gmul(gneg(Mkk1), gcoeff(A, gtos(gsubgs(k, 1)), gtos(gsubgs(k, 1)))), bk1new);
1282 /* Update the matrices after the swap. */
1283 if (!gequal0(swap))
1284 {
1285 {
1286 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
1287 GEN j = gen_0;
1288 for (j = gen_1; gcmp(j, n) <= 0; j = gaddgs(j, 1))
1289 {
1290 aux = gcopy(gcoeff(H, gtos(j), gtos(gsubgs(k, 1))));
1291 gcoeff(H, gtos(j), gtos(gsubgs(k, 1))) = gcopy(gcoeff(H, gtos(j), gtos(k)));
1292 gcoeff(H, gtos(j), gtos(k)) = gneg(aux);
1293 if (low_stack(st_lim, stack_lim(btop, 1)))
1294 gerepileall(btop, 3, &j, &aux, &H);
1295 }
1296 }
1297 p17 = gsubgs(k, 2);
1298 {
1299 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
1300 GEN j = gen_0;
1301 for (j = gen_1; gcmp(j, p17) <= 0; j = gaddgs(j, 1))
1302 {
1303 aux = gcopy(gcoeff(M, gtos(gsubgs(k, 1)), gtos(j)));
1304 gcoeff(M, gtos(gsubgs(k, 1)), gtos(j)) = gcopy(gcoeff(M, gtos(k), gtos(j)));
1305 gcoeff(M, gtos(k), gtos(j)) = gneg(aux);
1306 if (low_stack(st_lim, stack_lim(btop, 1)))
1307 gerepileall(btop, 3, &j, &aux, &M);
1308 }
1309 }
1310 p18 = gaddgs(k, 1);
1311 {
1312 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
1313 GEN j = gen_0;
1314 for (j = p18; gcmp(j, n) <= 0; j = gaddgs(j, 1))
1315 {
1316 aux = gcopy(gcoeff(M, gtos(j), gtos(k)));
1317 gcoeff(M, gtos(j), gtos(k)) = gadd(gneg(gcoeff(M, gtos(j), gtos(gsubgs(k, 1)))), gmul(Mkk1, aux));
1318 gcoeff(M, gtos(j), gtos(gsubgs(k, 1))) = gadd(aux, gmul(Mkk1new, gcoeff(M, gtos(j), gtos(k))));
1319 if (low_stack(st_lim, stack_lim(btop, 1)))
1320 gerepileall(btop, 3, &j, &aux, &M);
1321 }
1322 }
1323 {
1324 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
1325 GEN j = gen_0;
1326 for (j = gen_1; gcmp(j, n) <= 0; j = gaddgs(j, 1))
1327 {
1328 if (!gequal(j, k) && !gequal(j, gsubgs(k, 1)))
1329 {
1330 aux = gcopy(gcoeff(A, gtos(gsubgs(k, 1)), gtos(j)));
1331 gcoeff(A, gtos(gsubgs(k, 1)), gtos(j)) = gcopy(gcoeff(A, gtos(k), gtos(j)));
1332 gcoeff(A, gtos(k), gtos(j)) = gneg(aux);
1333 aux = gcopy(gcoeff(A, gtos(j), gtos(gsubgs(k, 1))));
1334 gcoeff(A, gtos(j), gtos(gsubgs(k, 1))) = gadd(gmul(Mkk1, aux), gcoeff(A, gtos(j), gtos(k)));
1335 gcoeff(A, gtos(j), gtos(k)) = gsub(gneg(aux), gmul(Mkk1new, gcoeff(A, gtos(j), gtos(gsubgs(k, 1)))));
1336 }
1337 if (low_stack(st_lim, stack_lim(btop, 1)))
1338 gerepileall(btop, 3, &j, &aux, &A);
1339 }
1340 }
1341 aux1 = gcopy(gcoeff(A, gtos(gsubgs(k, 1)), gtos(gsubgs(k, 1))));
1342 aux2 = gcopy(gcoeff(A, gtos(k), gtos(gsubgs(k, 1))));
1343 gcoeff(A, gtos(k), gtos(gsubgs(k, 1))) = gsub(gneg(gcoeff(A, gtos(gsubgs(k, 1)), gtos(k))), gmul(Mkk1, aux1));
1344 gcoeff(A, gtos(gsubgs(k, 1)), gtos(gsubgs(k, 1))) = gadd(gcoeff(A, gtos(k), gtos(k)), gmul(Mkk1, aux2));
1345 gcoeff(A, gtos(k), gtos(k)) = gsub(aux1, gmul(Mkk1new, gcoeff(A, gtos(k), gtos(gsubgs(k, 1)))));
1346 gcoeff(A, gtos(gsubgs(k, 1)), gtos(k)) = gsub(gneg(aux2), gmul(Mkk1new, gcoeff(A, gtos(gsubgs(k, 1)), gtos(gsubgs(k, 1)))));
1347 gcoeff(M, gtos(k), gtos(gsubgs(k, 1))) = gcopy(Mkk1new);
1348 if (gcmpgs(DEBUGLEVEL_qfsolve, 4) >= 0)
1349 {
1350 newG = gmul(gmul(gtrans(H), G), H);
1351 {
1352 long i;
1353 p19 = cgetg(gtos(n)+1, t_VEC);
1354 for (i = 1; gcmpsg(i, n) <= 0; ++i)
1355 gel(p19, i) = det(extract0(newG, subis(shifti(gen_1, i), 1), subis(shifti(gen_1, i), 1)));
1356 }
1357 pari_printf("%Ps\n", p19);
1358 }
1359 if (!gequalgs(k, 2))
1360 k = gsubgs(k, 1);
1361 }
1362 if (low_stack(st_lim, stack_lim(btop, 1)))
1363 gerepileall(btop, 22, &swap, &q, &p13, &M, &A, &H, &di, &HM, &aux1, &aux2, &sol, &aux, &p15, &p16, &Mkk1, &bk1new, &Mkk1new, &p17, &p18, &newG, &p19, &k);
1364 }
1365 }
1366 p12 = gsubgs(k, 2);
1367 {
1368 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
1369 GEN l = gen_0;
1370 long l23 = -1 > 0; /* bool */
1371 GEN p24 = gen_0;
1372 for (l = p12; l23?gcmpgs(l, 1) <= 0:gcmpgs(l, 1) >= 0; l = gaddgs(l, -1))
1373 {
1374 /* red(k,l) */
1375 if (!gequal0(q = ground(gcoeff(M, gtos(k), gtos(l)))))
1376 {
1377 p24 = gsubgs(l, 1);
1378 {
1379 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
1380 GEN i = gen_0;
1381 for (i = gen_1; gcmp(i, p24) <= 0; i = gaddgs(i, 1))
1382 {
1383 gcoeff(M, gtos(k), gtos(i)) = gsub(gcoeff(M, gtos(k), gtos(i)), gmul(q, gcoeff(M, gtos(l), gtos(i))));
1384 if (low_stack(st_lim, stack_lim(btop, 1)))
1385 gerepileall(btop, 2, &i, &M);
1386 }
1387 }
1388 gcoeff(M, gtos(k), gtos(l)) = gsub(gcoeff(M, gtos(k), gtos(l)), q);
1389 {
1390 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
1391 GEN i = gen_0;
1392 for (i = gen_1; gcmp(i, n) <= 0; i = gaddgs(i, 1))
1393 {
1394 gcoeff(A, gtos(k), gtos(i)) = gsub(gcoeff(A, gtos(k), gtos(i)), gmul(q, gcoeff(A, gtos(l), gtos(i))));
1395 gcoeff(H, gtos(i), gtos(k)) = gsub(gcoeff(H, gtos(i), gtos(k)), gmul(q, gcoeff(H, gtos(i), gtos(l))));
1396 if (low_stack(st_lim, stack_lim(btop, 1)))
1397 gerepileall(btop, 3, &i, &A, &H);
1398 }
1399 }
1400 }
1401 if (low_stack(st_lim, stack_lim(btop, 1)))
1402 gerepileall(btop, 6, &l, &q, &p24, &M, &A, &H);
1403 }
1404 }
1405 k = gaddgs(k, 1);
1406 if (low_stack(st_lim, stack_lim(btop, 1)))
1407 gerepileall(btop, 17, &swap, &q, &M, &A, &H, &di, &HM, &aux1, &aux2, &sol, &aux, &Mkk1, &bk1new, &Mkk1new, &newG, &k, &p12);
1408 }
1409 }
1410 p3 = cgetg(3, t_VEC);
1411 gel(p3, 1) = gmul(gmul(gtrans(H), G), H);
1412 gel(p3, 2) = gcopy(H);
1413 p3 = gerepilecopy(ltop, p3);
1414 return p3;
1415 }
1416
1417 GEN
1418 kermodp(GEN M, GEN p) /* vec */
1419 {
1420 pari_sp ltop = avma;
1421 GEN n = gen_0, U = gen_0, d = gen_0;
1422 GEN p1 = gen_0, p2 = gen_0; /* vec */
1423 n = stoi(glength(M));
1424 U = centerlift(matker0(gmul(M, gmodulsg(1, p)), 0));
1425 d = stoi(glength(U));
1426 U = completebasis(U, NULL);
1427 {
1428 long i, j;
1429 p1 = cgetg(gtos(n)+1, t_MAT);
1430 for (j = 1; gcmpsg(j, n) <= 0; ++j)
1431 {
1432 gel(p1, j) = cgetg(gtos(n)+1, t_COL);
1433 for (i = 1; gcmpsg(i, n) <= 0; ++i)
1434 gcoeff(p1, i, j) = gcopy(gcoeff(U, i, gtos(gsubgs(gaddgs(n, 1), j))));
1435 }
1436 }
1437 U = p1;
1438 p2 = cgetg(3, t_VEC);
1439 gel(p2, 1) = gcopy(d);
1440 gel(p2, 2) = gcopy(U);
1441 p2 = gerepilecopy(ltop, p2);
1442 return p2;
1443 }
1444
1445 GEN
1446 Qfparam(GEN G, GEN sol, GEN fl, long prec)
1447 {
1448 pari_sp ltop = avma;
1449 GEN U = gen_0, G1 = gen_0, G2 = gen_0;
1450 GEN p1 = gen_0, p2 = gen_0, p3 = gen_0; /* vec */
1451 if (!fl)
1452 fl = stoi(3);
1453 if (gcmpgs(DEBUGLEVEL_qfsolve, 5) >= 0)
1454 pari_printf(" starting Qfparam\n");
1455 sol = gdiv(sol, content(sol));
1456 /* build U such that U[,3] = sol, and det(U) = +-1 */
1457 U = completebasis(sol, gen_1);
1458 G1 = gmul(gmul(gtrans(U), G), U);
1459 p1 = cgetg(4, t_MAT);
1460 gel(p1, 1) = cgetg(4, t_COL);
1461 gel(p1, 2) = cgetg(4, t_COL);
1462 gel(p1, 3) = cgetg(4, t_COL);
1463 gcoeff(p1, 1, 1) = gmulsg(-2, gcoeff(G1, 1, 3));
1464 gcoeff(p1, 1, 2) = gmulsg(-2, gcoeff(G1, 2, 3));
1465 gcoeff(p1, 1, 3) = gen_0;
1466 gcoeff(p1, 2, 1) = gen_0;
1467 gcoeff(p1, 2, 2) = gmulsg(-2, gcoeff(G1, 1, 3));
1468 gcoeff(p1, 2, 3) = gmulsg(-2, gcoeff(G1, 2, 3));
1469 gcoeff(p1, 3, 1) = gcopy(gcoeff(G1, 1, 1));
1470 gcoeff(p1, 3, 2) = gmulsg(2, gcoeff(G1, 1, 2));
1471 gcoeff(p1, 3, 3) = gcopy(gcoeff(G1, 2, 2));
1472 /* G1 has a 0 at the bottom right corner */
1473 G2 = p1;
1474 sol = gmul(U, G2);
1475 p2 = cgetg(3, t_MAT);
1476 gel(p2, 1) = cgetg(3, t_COL);
1477 gel(p2, 2) = cgetg(3, t_COL);
1478 gcoeff(p2, 1, 1) = gcopy(gcoeff(sol, gtos(fl), 1));
1479 gcoeff(p2, 1, 2) = gdivgs(gcoeff(sol, gtos(fl), 2), 2);
1480 gcoeff(p2, 2, 1) = gdivgs(gcoeff(sol, gtos(fl), 2), 2);
1481 gcoeff(p2, 2, 2) = gcopy(gcoeff(sol, gtos(fl), 3));
1482 if (!gequal0(fl) && (gequal0(gissquare(gneg(det(U = p2))))))
1483 {
1484 U = QfbReduce(U, prec);
1485 p3 = cgetg(4, t_MAT);
1486 gel(p3, 1) = cgetg(4, t_COL);
1487 gel(p3, 2) = cgetg(4, t_COL);
1488 gel(p3, 3) = cgetg(4, t_COL);
1489 gcoeff(p3, 1, 1) = gsqr(gcoeff(U, 1, 1));
1490 gcoeff(p3, 1, 2) = gmul(gmulsg(2, gcoeff(U, 1, 2)), gcoeff(U, 1, 1));
1491 gcoeff(p3, 1, 3) = gsqr(gcoeff(U, 1, 2));
1492 gcoeff(p3, 2, 1) = gmul(gcoeff(U, 2, 1), gcoeff(U, 1, 1));
1493 gcoeff(p3, 2, 2) = gadd(gmul(gcoeff(U, 2, 2), gcoeff(U, 1, 1)), gmul(gcoeff(U, 2, 1), gcoeff(U, 1, 2)));
1494 gcoeff(p3, 2, 3) = gmul(gcoeff(U, 1, 2), gcoeff(U, 2, 2));
1495 gcoeff(p3, 3, 1) = gsqr(gcoeff(U, 2, 1));
1496 gcoeff(p3, 3, 2) = gmul(gmulsg(2, gcoeff(U, 2, 1)), gcoeff(U, 2, 2));
1497 gcoeff(p3, 3, 3) = gsqr(gcoeff(U, 2, 2));
1498 U = p3;
1499 sol = gmul(sol, U);
1500 }
1501 if (gcmpgs(DEBUGLEVEL_qfsolve, 5) >= 0)
1502 pari_printf(" end of Qfparam\n");
1503 sol = gerepilecopy(ltop, sol);
1504 return sol;
1505 }
1506
1507 GEN
1508 LLLgoon3(GEN G, GEN c, long prec) /* vec */
1509 {
1510 pari_sp ltop = avma;
1511 GEN red = gen_0, U1 = gen_0, G2 = gen_0, bez = gen_0, U2 = gen_0, G3 = gen_0, cc = gen_0, U3 = gen_0;
1512 GEN p1 = gen_0, p2 = gen_0, p3 = gen_0, p4 = gen_0; /* vec */
1513 if (!c)
1514 c = gen_1;
1515 red = IndefiniteLLL(G, c, gen_1, prec);
1516 p1 = cgetg(4, t_MAT);
1517 gel(p1, 1) = cgetg(4, t_COL);
1518 gel(p1, 2) = cgetg(4, t_COL);
1519 gel(p1, 3) = cgetg(4, t_COL);
1520 gcoeff(p1, 1, 1) = gen_0;
1521 gcoeff(p1, 1, 2) = gen_0;
1522 gcoeff(p1, 1, 3) = gen_1;
1523 gcoeff(p1, 2, 1) = gen_0;
1524 gcoeff(p1, 2, 2) = gen_1;
1525 gcoeff(p1, 2, 3) = gen_0;
1526 gcoeff(p1, 3, 1) = gen_1;
1527 gcoeff(p1, 3, 2) = gen_0;
1528 gcoeff(p1, 3, 3) = gen_0;
1529 /* We always find an isotropic vector. */
1530 U1 = p1;
1531 G2 = gmul(gmul(gtrans(U1), gel(red, 1)), U1);
1532 /* G2 has a 0 at the bottom right corner. */
1533 bez = vecbezout(gcoeff(G2, 3, 1), gcoeff(G2, 3, 2));
1534 p2 = cgetg(4, t_MAT);
1535 gel(p2, 1) = cgetg(4, t_COL);
1536 gel(p2, 2) = cgetg(4, t_COL);
1537 gel(p2, 3) = cgetg(4, t_COL);
1538 gcoeff(p2, 1, 1) = gcopy(gel(bez, 1));
1539 gcoeff(p2, 1, 2) = gdiv(gcoeff(G2, 3, 2), gel(bez, 3));
1540 gcoeff(p2, 1, 3) = gen_0;
1541 gcoeff(p2, 2, 1) = gcopy(gel(bez, 2));
1542 gcoeff(p2, 2, 2) = gdiv(gneg(gcoeff(G2, 3, 1)), gel(bez, 3));
1543 gcoeff(p2, 2, 3) = gen_0;
1544 gcoeff(p2, 3, 1) = gen_0;
1545 gcoeff(p2, 3, 2) = gen_0;
1546 gcoeff(p2, 3, 3) = gen_m1;
1547 U2 = p2;
1548 G3 = gmul(gmul(gtrans(U2), G2), U2);
1549 /* G3 has 0 under the co-diagonal. */
1550 cc = gmodgs(gcoeff(G3, 1, 1), 2);
1551 p3 = cgetg(4, t_MAT);
1552 gel(p3, 1) = cgetg(4, t_COL);
1553 gel(p3, 2) = cgetg(4, t_COL);
1554 gel(p3, 3) = cgetg(4, t_COL);
1555 gcoeff(p3, 1, 1) = gen_1;
1556 gcoeff(p3, 1, 2) = gen_0;
1557 gcoeff(p3, 1, 3) = gen_0;
1558 gcoeff(p3, 2, 1) = gcopy(cc);
1559 gcoeff(p3, 2, 2) = gen_1;
1560 gcoeff(p3, 2, 3) = gen_0;
1561 gcoeff(p3, 3, 1) = ground(gdiv(gdivgs(gneg(gadd(gcoeff(G3, 1, 1), gmul(cc, gadd(gmulsg(2, gcoeff(G3, 1, 2)), gmul(gcoeff(G3, 2, 2), cc))))), 2), gcoeff(G3, 1, 3)));
1562 gcoeff(p3, 3, 2) = ground(gdiv(gneg(gadd(gcoeff(G3, 1, 2), gmul(cc, gcoeff(G3, 2, 2)))), gcoeff(G3, 1, 3)));
1563 gcoeff(p3, 3, 3) = gen_1;
1564 U3 = p3;
1565 p4 = cgetg(3, t_VEC);
1566 gel(p4, 1) = gmul(gmul(gtrans(U3), G3), U3);
1567 gel(p4, 2) = gmul(gmul(gmul(gel(red, 2), U1), U2), U3);
1568 p4 = gerepilecopy(ltop, p4);
1569 return p4;
1570 }
1571
1572 GEN
1573 completebasis(GEN v, GEN redflag)
1574 {
1575 pari_sp ltop = avma;
1576 GEN U = gen_0, n = gen_0, re = gen_0;
1577 GEN p1 = gen_0; /* vec */
1578 GEN p2 = gen_0;
1579 if (!redflag)
1580 redflag = gen_0;
1581 v = gtomat(v);
1582 n = stoi(glength(gtrans(v)));
1583 if (gequalgs(n, glength(v)))
1584 {
1585 v = gerepilecopy(ltop, v);
1586 return v;
1587 }
1588 U = ginv(gtrans(gel(mathnf0(gtrans(v), 1), 2)));
1589 if (gequal1(n) || (gequal0(redflag)))
1590 {
1591 U = gerepilecopy(ltop, U);
1592 return U;
1593 }
1594 re = lll(extract0(U, subis(shifti(gen_1, gtos(n)), 1), subis(shifti(gen_1, gtos(gsubgs(n, glength(v)))), 1)));
1595 p1 = cgetg(3, t_VEC);
1596 gel(p1, 1) = gcopy(re);
1597 gel(p1, 2) = matid(glength(v));
1598 p2 = gmul(U, matdiagonalblock(p1));
1599 p2 = gerepilecopy(ltop, p2);
1600 return p2;
1601 }
1602
1603 GEN
1604 LLLgoon(GEN G, GEN c, long prec)
1605 {
1606 pari_sp ltop = avma;
1607 GEN red = gen_0, U1 = gen_0, G2 = gen_0, U2 = gen_0, G3 = gen_0, n = gen_0, U3 = gen_0, G4 = gen_0, U = gen_0, V = gen_0, B = gen_0, U4 = gen_0, G5 = gen_0, U5 = gen_0, G6 = gen_0;
1608 GEN p1 = gen_0, p2 = gen_0, p3 = gen_0, p4 = gen_0; /* vec */
1609 GEN p5 = gen_0;
1610 GEN p6 = gen_0; /* vec */
1611 GEN p7 = gen_0, p8 = gen_0;
1612 GEN p9 = gen_0, p10 = gen_0, p11 = gen_0; /* vec */
1613 if (!c)
1614 c = gen_1;
1615 red = IndefiniteLLL(G, c, gen_1, prec);
1616 /* If no isotropic vector is found, nothing to do. */
1617 if (glength(red) == 2)
1618 {
1619 red = gerepilecopy(ltop, red);
1620 return red;
1621 }
1622 /* otherwise: */
1623 U1 = gcopy(gel(red, 2));
1624 G2 = gcopy(gel(red, 1));
1625 /* On a G2[1,1] = 0 */
1626 U2 = gcopy(gel(mathnf0(gtomat(rowcopy(G2, 1)), 4), 2));
1627 G3 = gmul(gmul(gtrans(U2), G2), U2);
1628 /* The first line of the matrix G3 only contains 0, */
1629 /* except some 'g' on the right, where g^2| det G. */
1630 n = stoi(glength(G));
1631 U3 = matid(gtos(n));
1632 gcoeff(U3, 1, gtos(n)) = ground(gdivgs(gdiv(gneg(gcoeff(G3, gtos(n), gtos(n))), gcoeff(G3, 1, gtos(n))), 2));
1633 G4 = gmul(gmul(gtrans(U3), G3), U3);
1634 p1 = cgetg(3, t_VEC);
1635 gel(p1, 1) = gen_1;
1636 gel(p1, 2) = gcopy(n);
1637 p2 = cgetg(3, t_VEC);
1638 gel(p2, 1) = gen_1;
1639 gel(p2, 2) = gcopy(n);
1640 /* The coeff G4[n,n] is reduced modulo 2g */
1641 U = extract0(G4, p1, p2);
1642 if (gequalgs(n, 2))
1643 {
1644 {
1645 long l12, l13;
1646 p3 = cgetg(1, t_MAT);
1647 for (l13 = 1; l13 <= 0; ++l13)
1648 {
1649 gel(p3, l13) = cgetg(3, t_COL);
1650 for (l12 = 1; l12 <= 2; ++l12)
1651 gcoeff(p3, l12, l13) = gen_0;
1652 }
1653 }
1654 V = p3;
1655 }
1656 else
1657 {
1658 p4 = cgetg(3, t_VEC);
1659 gel(p4, 1) = gen_1;
1660 gel(p4, 2) = gcopy(n);
1661 V = extract0(G4, p4, subis(shifti(gen_1, gtos(gsubgs(n, 1))), 2));
1662 }
1663 B = ground(gmul(gneg(ginv(U)), V));
1664 U4 = matid(gtos(n));
1665 p5 = gsubgs(n, 1);
1666 {
1667 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
1668 GEN j = gen_0;
1669 for (j = gen_2; gcmp(j, p5) <= 0; j = gaddgs(j, 1))
1670 {
1671 gcoeff(U4, 1, gtos(j)) = gcopy(gcoeff(B, 1, gtos(gsubgs(j, 1))));
1672 gcoeff(U4, gtos(n), gtos(j)) = gcopy(gcoeff(B, 2, gtos(gsubgs(j, 1))));
1673 if (low_stack(st_lim, stack_lim(btop, 1)))
1674 gerepileall(btop, 2, &j, &U4);
1675 }
1676 }
1677 G5 = gmul(gmul(gtrans(U4), G4), U4);
1678 /* The last column of G5 is reduced */
1679 if (gcmpgs(n, 4) < 0)
1680 {
1681 p6 = cgetg(3, t_VEC);
1682 gel(p6, 1) = gcopy(G5);
1683 gel(p6, 2) = gmul(gmul(gmul(U1, U2), U3), U4);
1684 p6 = gerepilecopy(ltop, p6);
1685 return p6;
1686 }
1687 p7 = gsubgs(n, 2);
1688 p8 = gsubgs(n, 2);
1689 {
1690 long i, j;
1691 p9 = cgetg(gtos(p7)+1, t_MAT);
1692 for (j = 1; gcmpsg(j, p7) <= 0; ++j)
1693 {
1694 gel(p9, j) = cgetg(gtos(p8)+1, t_COL);
1695 for (i = 1; gcmpsg(i, p8) <= 0; ++i)
1696 gcoeff(p9, i, j) = gcopy(gcoeff(G5, i + 1, j + 1));
1697 }
1698 }
1699 red = LLLgoon(p9, c, prec);
1700 p10 = cgetg(4, t_VEC);
1701 gel(p10, 1) = gtomat(gen_1);
1702 gel(p10, 2) = gcopy(gel(red, 2));
1703 gel(p10, 3) = gtomat(gen_1);
1704 U5 = matdiagonalblock(p10);
1705 G6 = gmul(gmul(gtrans(U5), G5), U5);
1706 p11 = cgetg(3, t_VEC);
1707 gel(p11, 1) = gcopy(G6);
1708 gel(p11, 2) = gmul(gmul(gmul(gmul(U1, U2), U3), U4), U5);
1709 p11 = gerepilecopy(ltop, p11);
1710 return p11;
1711 }
1712
1713 GEN
1714 QfWittinvariant(GEN G, GEN p)
1715 {
1716 pari_sp ltop = avma;
1717 GEN n = gen_0, det_s = gen_0, diag = gen_0, c = gen_0, p1 = gen_0;
1718 GEN p2 = gen_0, p3 = gen_0; /* vec */
1719 GEN p4 = gen_0;
1720 n = stoi(glength(G));
1721 p1 = gaddgs(n, 1);
1722 {
1723 long i, l5, l6;
1724 GEN p7 = gen_0; /* vec */
1725 p2 = cgetg(gtos(p1)+1, t_VEC);
1726 for (i = 1; gcmpsg(i, p1) <= 0; ++i)
1727 {
1728 l5 = i - 1;
1729 l6 = i - 1;
1730 {
1731 long j, k;
1732 p7 = cgetg(l5+1, t_MAT);
1733 for (k = 1; k <= l5; ++k)
1734 {
1735 gel(p7, k) = cgetg(l6+1, t_COL);
1736 for (j = 1; j <= l6; ++j)
1737 gcoeff(p7, j, k) = gcopy(gcoeff(G, j, k));
1738 }
1739 }
1740 gel(p2, i) = det(p7);
1741 }
1742 }
1743 /* Diagonalize G first. */
1744 det_s = p2;
1745 {
1746 long i;
1747 p3 = cgetg(gtos(n)+1, t_VEC);
1748 for (i = 1; gcmpsg(i, n) <= 0; ++i)
1749 gel(p3, i) = gdiv(gel(det_s, i + 1), gel(det_s, i));
1750 }
1751 diag = p3;
1752 {
1753 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
1754 GEN i = gen_0, p8 = gen_0, p9 = gen_0;
1755 p4 = gen_1;
1756 for (i = gen_1; gcmp(i, n) <= 0; i = gaddgs(i, 1))
1757 {
1758 p8 = gaddgs(i, 1);
1759 {
1760 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
1761 GEN j = gen_0;
1762 p9 = gen_1;
1763 for (j = p8; gcmp(j, n) <= 0; j = gaddgs(j, 1))
1764 {
1765 p9 = gmulgs(p9, hilbert(gel(diag, gtos(i)), gel(diag, gtos(j)), p));
1766 if (low_stack(st_lim, stack_lim(btop, 1)))
1767 gerepileall(btop, 2, &p9, &j);
1768 }
1769 }
1770 p4 = gmul(p4, p9);
1771 if (low_stack(st_lim, stack_lim(btop, 1)))
1772 gerepileall(btop, 4, &p4, &i, &p8, &p9);
1773 }
1774 }
1775 /* Then compute Hilbert symbols */
1776 c = p4;
1777 c = gerepilecopy(ltop, c);
1778 return c;
1779 }
1780
1781 GEN
1782 Qflisteinvariants(GEN G, GEN fa, long prec) /* vec */
1783 {
1784 pari_sp ltop = avma;
1785 GEN l = gen_0, sol = gen_0, n = gen_0, det_s = gen_0;
1786 GEN p1 = gen_0; /* vec */
1787 long l2;
1788 GEN p3 = gen_0, p4 = gen_0; /* vec */
1789 long l5;
1790 GEN p6 = gen_0, p7 = gen_0; /* vec */
1791 if (!fa)
1792 fa = cgetg(1, t_VEC);
1793 G = gcopy(G);
1794 if (gcmpgs(DEBUGLEVEL_qfsolve, 4) >= 0)
1795 pari_printf(" starting Qflisteinvariants %Ps\n", G);
1796 if (typ(G) != t_VEC)
1797 {
1798 p1 = cgetg(2, t_VEC);
1799 gel(p1, 1) = gcopy(G);
1800 G = p1;
1801 }
1802 l = stoi(glength(G));
1803 {
1804 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
1805 GEN j = gen_0;
1806 for (j = gen_1; gcmp(j, l) <= 0; j = gaddgs(j, 1))
1807 {
1808 if ((typ(gel(G, gtos(j))) == t_QFI) || (typ(gel(G, gtos(j))) == t_QFR))
1809 gel(G, gtos(j)) = mymat(gel(G, gtos(j)));
1810 if (low_stack(st_lim, stack_lim(btop, 1)))
1811 gerepileall(btop, 2, &j, &G);
1812 }
1813 }
1814 if (!glength(fa))
1815 fa = gcopy(gel(factor(gneg(gabs(gmulsg(2, det(gel(G, 1))), prec))), 1));
1816 if (glength(gel(G, 1)) == 2)
1817 {
1818 /* In dimension 2, each invariant is a single Hilbert symbol. */
1819 det_s = gneg(det(gel(G, 1)));
1820 l2 = glength(fa);
1821 {
1822 long i, j;
1823 p3 = cgetg(gtos(l)+1, t_MAT);
1824 for (j = 1; gcmpsg(j, l) <= 0; ++j)
1825 {
1826 gel(p3, j) = cgetg(l2+1, t_COL);
1827 for (i = 1; i <= l2; ++i)
1828 gcoeff(p3, i, j) = stoi(hilbert(gcoeff(gel(G, j), 1, 1), det_s, gel(fa, i)) < 0);
1829 }
1830 }
1831 sol = p3;
1832 if (gcmpgs(DEBUGLEVEL_qfsolve, 4) >= 0)
1833 pari_printf(" end of Qflisteinvariants\n");
1834 p4 = cgetg(3, t_VEC);
1835 gel(p4, 1) = gcopy(fa);
1836 gel(p4, 2) = gcopy(sol);
1837 p4 = gerepilecopy(ltop, p4);
1838 return p4;
1839 }
1840 l5 = glength(fa);
1841 {
1842 long l8, l9;
1843 p6 = cgetg(gtos(l)+1, t_MAT);
1844 for (l9 = 1; gcmpsg(l9, l) <= 0; ++l9)
1845 {
1846 gel(p6, l9) = cgetg(l5+1, t_COL);
1847 for (l8 = 1; l8 <= l5; ++l8)
1848 gcoeff(p6, l8, l9) = gen_0;
1849 }
1850 }
1851 sol = p6;
1852 {
1853 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
1854 GEN j = gen_0, p10 = gen_0;
1855 GEN p11 = gen_0; /* vec */
1856 long l12;
1857 for (j = gen_1; gcmp(j, l) <= 0; j = gaddgs(j, 1))
1858 {
1859 n = stoi(glength(gel(G, gtos(j))));
1860 p10 = gaddgs(n, 1);
1861 {
1862 long i, l13, l14;
1863 GEN p15 = gen_0; /* vec */
1864 p11 = cgetg(gtos(p10)+1, t_VEC);
1865 for (i = 1; gcmpsg(i, p10) <= 0; ++i)
1866 {
1867 l13 = i - 1;
1868 l14 = i - 1;
1869 {
1870 long k, m;
1871 p15 = cgetg(l13+1, t_MAT);
1872 for (m = 1; m <= l13; ++m)
1873 {
1874 gel(p15, m) = cgetg(l14+1, t_COL);
1875 for (k = 1; k <= l14; ++k)
1876 gcoeff(p15, k, m) = gcopy(gcoeff(gel(G, gtos(j)), k, m));
1877 }
1878 }
1879 gel(p11, i) = det(p15);
1880 }
1881 }
1882 /* In dimension n, we need to compute a product of n Hilbert symbols. */
1883 det_s = p11;
1884 l12 = glength(fa);
1885 {
1886 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
1887 long i;
1888 GEN p16 = gen_0, p17 = gen_0;
1889 for (i = 1; i <= l12; ++i)
1890 {
1891 p16 = gsubgs(n, 1);
1892 {
1893 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
1894 GEN k = gen_0;
1895 long l18;
1896 p17 = gen_1;
1897 for (k = gen_1; gcmp(k, p16) <= 0; k = gaddgs(k, 1))
1898 {
1899 l18 = gtos(gaddgs(k, 1));
1900 p17 = gmulgs(p17, hilbert(gneg(gel(det_s, gtos(k))), gel(det_s, l18), gel(fa, i)));
1901 if (low_stack(st_lim, stack_lim(btop, 1)))
1902 gerepileall(btop, 2, &p17, &k);
1903 }
1904 }
1905 gcoeff(sol, i, gtos(j)) = stoi(gcmpgs(gmulgs(p17, hilbert(gel(det_s, gtos(n)), gel(det_s, gtos(gaddgs(n, 1))), gel(fa, i))), 0) < 0);
1906 if (low_stack(st_lim, stack_lim(btop, 1)))
1907 gerepileall(btop, 3, &p16, &p17, &sol);
1908 }
1909 }
1910 if (low_stack(st_lim, stack_lim(btop, 1)))
1911 gerepileall(btop, 6, &j, &n, &p10, &p11, &det_s, &sol);
1912 }
1913 }
1914 if (gcmpgs(DEBUGLEVEL_qfsolve, 4) >= 0)
1915 pari_printf(" end of Qflisteinvariants\n");
1916 p7 = cgetg(3, t_VEC);
1917 gel(p7, 1) = gcopy(fa);
1918 gel(p7, 2) = gcopy(sol);
1919 p7 = gerepilecopy(ltop, p7);
1920 return p7;
1921 }
1922
1923 GEN
1924 Qfsolvemodp(GEN G, GEN p, long prec)
1925 {
1926 pari_sp ltop = avma;
1927 GEN n = gen_0, vdet = gen_0, G2 = gen_0, sol = gen_0, x1 = gen_0, x2 = gen_0, x3 = gen_0, N1 = gen_0, N2 = gen_0, N3 = gen_0, s = gen_0, r = gen_0;
1928 GEN p1 = gen_0, p2 = gen_0, p3 = gen_0, p4 = gen_0, p5 = gen_0; /* vec */
1929 n = stoi(glength(G));
1930 p1 = cgetg(4, t_VEC);
1931 gel(p1, 1) = gen_0;
1932 gel(p1, 2) = gen_0;
1933 gel(p1, 3) = gen_0;
1934 vdet = p1;
1935 {
1936 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
1937 long i;
1938 GEN p6 = gen_0; /* vec */
1939 for (i = 1; i <= 3; ++i)
1940 {
1941 G2 = gmul(extract0(G, subis(shifti(gen_1, i), 1), subis(shifti(gen_1, i), 1)), gmodulsg(1, p));
1942 if (gequal0(gel(vdet, i) = det(G2)))
1943 {
1944 sol = gcopy(gel(gel(kermodp(lift(G2), p), 2), 1));
1945 {
1946 long j;
1947 GEN p7 = gen_0;
1948 p6 = cgetg(gtos(n)+1, t_COL);
1949 for (j = 1; gcmpsg(j, n) <= 0; ++j)
1950 {
1951 if (j <= i)
1952 p7 = gcopy(gel(sol, j));
1953 gel(p6, j) = p7;
1954 }
1955 }
1956 sol = p6;
1957 sol = gerepilecopy(ltop, sol);
1958 return sol;
1959 }
1960 if (low_stack(st_lim, stack_lim(btop, 1)))
1961 gerepileall(btop, 4, &G2, &vdet, &sol, &p6);
1962 }
1963 }
1964 p2 = cgetg(4, t_COL);
1965 gel(p2, 1) = gen_1;
1966 gel(p2, 2) = gen_0;
1967 gel(p2, 3) = gen_0;
1968 /* now, solve in dimension 3... */
1969 /* reduction to the diagonal case: */
1970 x1 = p2;
1971 p3 = cgetg(4, t_COL);
1972 gel(p3, 1) = gneg(gcoeff(G2, 1, 2));
1973 gel(p3, 2) = gcopy(gcoeff(G2, 1, 1));
1974 gel(p3, 3) = gen_0;
1975 x2 = p3;
1976 p4 = cgetg(4, t_COL);
1977 gel(p4, 1) = gsub(gmul(gcoeff(G2, 2, 2), gcoeff(G2, 1, 3)), gmul(gcoeff(G2, 2, 3), gcoeff(G2, 1, 2)));
1978 gel(p4, 2) = gsub(gmul(gcoeff(G2, 1, 1), gcoeff(G2, 2, 3)), gmul(gcoeff(G2, 1, 3), gcoeff(G2, 1, 2)));
1979 gel(p4, 3) = gsub(gsqr(gcoeff(G2, 1, 2)), gmul(gcoeff(G2, 1, 1), gcoeff(G2, 2, 2)));
1980 x3 = p4;
1981 {
1982 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
1983 while (1)
1984 {
1985 if (!gequal0(gissquare(N1 = gneg(gel(vdet, 2)))))
1986 {
1987 s = gsqrt(N1, prec);
1988 sol = gadd(gmul(s, x1), x2);
1989 break;
1990 }
1991 if (!gequal0(gissquare(N2 = gdiv(gneg(gel(vdet, 3)), gel(vdet, 1)))))
1992 {
1993 s = gsqrt(N2, prec);
1994 sol = gadd(gmul(s, x2), x3);
1995 break;
1996 }
1997 if (!gequal0(gissquare(N3 = gdiv(gmul(gneg(gel(vdet, 2)), gel(vdet, 3)), gel(vdet, 1)))))
1998 {
1999 s = gsqrt(N3, prec);
2000 sol = gadd(gmul(s, x1), x3);
2001 break;
2002 }
2003 r = gen_1;
2004 {
2005 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
2006 while (gequal0(gissquare(s = gdiv(gsubsg(1, gmul(N1, gsqr(r))), N3))))
2007 {
2008 r = genrand(p);
2009 if (low_stack(st_lim, stack_lim(btop, 1)))
2010 gerepileall(btop, 2, &s, &r);
2011 }
2012 }
2013 s = gsqrt(s, prec);
2014 sol = gadd(gadd(x1, gmul(r, x2)), gmul(s, x3));
2015 break;
2016 if (low_stack(st_lim, stack_lim(btop, 1)))
2017 gerepileall(btop, 6, &N1, &s, &sol, &N2, &N3, &r);
2018 }
2019 }
2020 {
2021 long j;
2022 GEN p8 = gen_0;
2023 p5 = cgetg(gtos(n)+1, t_COL);
2024 for (j = 1; gcmpsg(j, n) <= 0; ++j)
2025 {
2026 if (j <= 3)
2027 p8 = gcopy(gel(sol, j));
2028 gel(p5, j) = p8;
2029 }
2030 }
2031 sol = p5;
2032 sol = gerepilecopy(ltop, sol);
2033 return sol;
2034 }
2035
2036 GEN
2037 Qfminim(GEN G, GEN factdetG, long prec)
2038 {
2039 pari_sp ltop = avma;
2040 GEN n = gen_0, factd = gen_0, detG = gen_0, i = gen_0, U = gen_0, vp = gen_0, Ker = gen_0, dimKer = gen_0, Ker2 = gen_0, dimKer2 = gen_0, sol = gen_0, aux = gen_0, p = gen_0, di = gen_0, m = gen_0;
2041 GEN p1 = gen_0, p2 = gen_0; /* vec */
2042 if (!factdetG)
2043 factdetG = gen_0;
2044 factdetG = gcopy(factdetG);
2045 n = stoi(glength(G));
2046 {
2047 long l3, l4;
2048 p1 = cgetg(3, t_MAT);
2049 for (l4 = 1; l4 <= 2; ++l4)
2050 {
2051 gel(p1, l4) = cgetg(1, t_COL);
2052 for (l3 = 1; l3 <= 0; ++l3)
2053 gcoeff(p1, l3, l4) = gen_0;
2054 }
2055 }
2056 factd = p1;
2057 if (gequal0(factdetG))
2058 {
2059 detG = det(G);
2060 factdetG = factor(detG);
2061 }
2062 i = gen_1;
2063 U = matid(gtos(n));
2064 {
2065 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
2066 GEN p5 = gen_0, p6 = gen_0, p7 = gen_0, p8 = gen_0, p9 = gen_0, p10 = gen_0, p11 = gen_0; /* vec */
2067 GEN p12 = gen_0;
2068 GEN p13 = gen_0; /* vec */
2069 while (gcmpgs(i, glength(gel(factdetG, 1))) <= 0)
2070 {
2071 p = gcopy(gcoeff(factdetG, gtos(i), 1));
2072 if (gequalm1(p))
2073 {
2074 i = gaddgs(i, 1);
2075 continue;
2076 }
2077 vp = gcopy(gcoeff(factdetG, gtos(i), 2));
2078 if (gcmpgs(DEBUGLEVEL_qfsolve, 4) >= 0)
2079 pari_printf(" p = %Ps^%Ps\n", p, vp);
2080 if (gequal0(vp))
2081 {
2082 i = gaddgs(i, 1);
2083 continue;
2084 }
2085 /* The case vp = 1 can be minimized only if n is odd. */
2086 if (gequal1(vp) && gequal0(gmodgs(n, 2)))
2087 {
2088 p5 = cgetg(3, t_VEC);
2089 gel(p5, 1) = gcopy(p);
2090 gel(p5, 2) = gen_1;
2091 factd = gtrans(concat(gtrans(factd), gtrans(gtomat(p5))));
2092 i = gaddgs(i, 1);
2093 continue;
2094 }
2095 Ker = kermodp(G, p);
2096 dimKer = gcopy(gel(Ker, 1));
2097 Ker = gcopy(gel(Ker, 2));
2098 /* Rem: we must have dimKer <= vp */
2099 if (gcmpgs(DEBUGLEVEL_qfsolve, 4) >= 0)
2100 pari_printf(" dimKer = %Ps\n", dimKer);
2101 /* trivial case: dimKer = n */
2102 if (gequal(dimKer, n))
2103 {
2104 if (gcmpgs(DEBUGLEVEL_qfsolve, 4) >= 0)
2105 pari_printf(" case 0: dimKer = n\n");
2106 G = gdiv(G, p);
2107 gcoeff(factdetG, gtos(i), 2) = gsub(gcoeff(factdetG, gtos(i), 2), n);
2108 continue;
2109 }
2110 G = gmul(gmul(gtrans(Ker), G), Ker);
2111 U = gmul(U, Ker);
2112 /* 1st case: dimKer < vp */
2113 /* then the kernel mod p contains a kernel mod p^2 */
2114 if (gcmp(dimKer, vp) < 0)
2115 {
2116 if (gcmpgs(DEBUGLEVEL_qfsolve, 4) >= 0)
2117 pari_printf(" case 1: dimker < vp\n");
2118 {
2119 long j, k;
2120 p6 = cgetg(gtos(dimKer)+1, t_MAT);
2121 for (k = 1; gcmpsg(k, dimKer) <= 0; ++k)
2122 {
2123 gel(p6, k) = cgetg(gtos(dimKer)+1, t_COL);
2124 for (j = 1; gcmpsg(j, dimKer) <= 0; ++j)
2125 gcoeff(p6, j, k) = gdiv(gcoeff(G, j, k), p);
2126 }
2127 }
2128 Ker2 = kermodp(p6, p);
2129 dimKer2 = gcopy(gel(Ker2, 1));
2130 Ker2 = gcopy(gel(Ker2, 2));
2131 {
2132 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
2133 GEN j = gen_0;
2134 for (j = gen_1; gcmp(j, dimKer2) <= 0; j = gaddgs(j, 1))
2135 {
2136 gel(Ker2, gtos(j)) = gdiv(gel(Ker2, gtos(j)), p);
2137 if (low_stack(st_lim, stack_lim(btop, 1)))
2138 gerepileall(btop, 2, &j, &Ker2);
2139 }
2140 }
2141 p7 = cgetg(3, t_VEC);
2142 gel(p7, 1) = gcopy(Ker2);
2143 gel(p7, 2) = matid(gtos(gsub(n, dimKer)));
2144 Ker2 = matdiagonalblock(p7);
2145 G = gmul(gmul(gtrans(Ker2), G), Ker2);
2146 U = gmul(U, Ker2);
2147 gcoeff(factdetG, gtos(i), 2) = gsub(gcoeff(factdetG, gtos(i), 2), gmulsg(2, dimKer2));
2148 if (gcmpgs(DEBUGLEVEL_qfsolve, 4) >= 0)
2149 pari_printf(" end of case 1\n");
2150 continue;
2151 }
2152 /* Now, we have vp = dimKer */
2153 /* 2nd case: the dimension of the kernel is >=2 */
2154 /* and contains an element of norm 0 mod p^2 */
2155 if ((gcmpgs(dimKer, 2) > 0) || (gequalgs(dimKer, 2) && !gequal0(gissquare(di = gmodulo(gdiv(gsub(gsqr(gcoeff(G, 1, 2)), gmul(gcoeff(G, 1, 1), gcoeff(G, 2, 2))), gsqr(p)), p)))))
2156 {
2157 /* search for an element of norm p^2... in the kernel */
2158 if (gcmpgs(dimKer, 2) > 0)
2159 {
2160 if (gcmpgs(DEBUGLEVEL_qfsolve, 4) >= 0)
2161 pari_printf(" case 2.1\n");
2162 dimKer = stoi(3);
2163 {
2164 long j, k;
2165 p8 = cgetg(4, t_MAT);
2166 for (k = 1; k <= 3; ++k)
2167 {
2168 gel(p8, k) = cgetg(4, t_COL);
2169 for (j = 1; j <= 3; ++j)
2170 gcoeff(p8, j, k) = gdiv(gcoeff(G, j, k), p);
2171 }
2172 }
2173 sol = Qfsolvemodp(p8, p, prec);
2174 }
2175 else
2176 {
2177 if (gcmpgs(DEBUGLEVEL_qfsolve, 4) >= 0)
2178 pari_printf(" case 2.2\n");
2179 if (gequal0(gmod(gcoeff(G, 1, 1), gsqr(p))))
2180 {
2181 p9 = cgetg(3, t_COL);
2182 gel(p9, 1) = gen_1;
2183 gel(p9, 2) = gen_0;
2184 sol = p9;
2185 }
2186 else
2187 {
2188 p10 = cgetg(3, t_COL);
2189 gel(p10, 1) = gadd(gdiv(gneg(gcoeff(G, 1, 2)), p), gsqrt(di, prec));
2190 gel(p10, 2) = gmodulo(gdiv(gcoeff(G, 1, 1), p), p);
2191 sol = p10;
2192 }
2193 }
2194 sol = centerlift(sol);
2195 sol = gdiv(sol, content(sol));
2196 if (gcmpgs(DEBUGLEVEL_qfsolve, 4) >= 0)
2197 pari_printf(" sol = %Ps\n", sol);
2198 {
2199 long j;
2200 GEN p14 = gen_0;
2201 p11 = cgetg(gtos(n)+1, t_COL);
2202 for (j = 1; gcmpsg(j, n) <= 0; ++j)
2203 {
2204 if (gcmpsg(j, dimKer) <= 0)
2205 p14 = gcopy(gel(sol, j));
2206 else
2207 p14 = gen_0;
2208 gel(p11, j) = p14;
2209 }
2210 }
2211 Ker = p11;
2212 /* fill with 0's */
2213 Ker = completebasis(Ker, gen_1);
2214 gel(Ker, gtos(n)) = gdiv(gel(Ker, gtos(n)), p);
2215 G = gmul(gmul(gtrans(Ker), G), Ker);
2216 U = gmul(U, Ker);
2217 gcoeff(factdetG, gtos(i), 2) = gsubgs(gcoeff(factdetG, gtos(i), 2), 2);
2218 if (gcmpgs(DEBUGLEVEL_qfsolve, 4) >= 0)
2219 pari_printf(" end of case 2\n");
2220 continue;
2221 }
2222 /* Now, we have vp = dimKer <= 2 */
2223 /* and the kernel contains no vector with norm p^2... */
2224
2225 /* In some cases, exchanging the kernel and the image */
2226 /* makes the minimization easy. */
2227
2228 m = gsubgs(gdiventgs(gsubgs(n, 1), 2), 1);
2229 if (((gequal1(vp) && !gequal0(gissquare(gmodulo(gdiv(gmul(gneg(gpow(gen_m1, m, prec)), det(G)), gcoeff(G, 1, 1)), p)))) || ((gequalgs(vp, 2) && gequal1(gmodgs(n, 2))) && (gcmpgs(n, 5) >= 0))) || ((gequalgs(vp, 2) && gequal0(gmodgs(n, 2))) && (gequal0(gissquare(gmodulo(gdiv(gmul(gpow(gen_m1, m, prec), det(G)), gsqr(p)), p))))))
2230 {
2231 if (gcmpgs(DEBUGLEVEL_qfsolve, 4) >= 0)
2232 pari_printf(" case 3\n");
2233 Ker = matid(gtos(n));
2234 p12 = gaddgs(dimKer, 1);
2235 {
2236 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
2237 GEN j = gen_0;
2238 for (j = p12; gcmp(j, n) <= 0; j = gaddgs(j, 1))
2239 {
2240 gcoeff(Ker, gtos(j), gtos(j)) = gcopy(p);
2241 if (low_stack(st_lim, stack_lim(btop, 1)))
2242 gerepileall(btop, 2, &j, &Ker);
2243 }
2244 }
2245 G = gdiv(gmul(gmul(gtrans(Ker), G), Ker), p);
2246 U = gmul(U, Ker);
2247 gcoeff(factdetG, gtos(i), 2) = gsub(gcoeff(factdetG, gtos(i), 2), gsub(gmulsg(2, dimKer), n));
2248 if (gcmpgs(DEBUGLEVEL_qfsolve, 4) >= 0)
2249 pari_printf(" end of case 3\n");
2250 continue;
2251 }
2252 /* Minimization was not possible se far. */
2253 /* If n == 3 or 4, this proves the local non-solubility at p. */
2254 if (gequalgs(n, 3) || gequalgs(n, 4))
2255 {
2256 if (gcmpgs(DEBUGLEVEL_qfsolve, 1) >= 0)
2257 pari_printf(" no local solution at %Ps\n", p);
2258 p = gerepilecopy(ltop, p);
2259 return p;
2260 }
2261 if (gcmpgs(DEBUGLEVEL_qfsolve, 4) >= 0)
2262 pari_printf(" prime %Ps finished\n", p);
2263 p13 = cgetg(3, t_VEC);
2264 gel(p13, 1) = gcopy(p);
2265 gel(p13, 2) = gcopy(vp);
2266 factd = gtrans(concat(gtrans(factd), gtrans(gtomat(p13))));
2267 i = gaddgs(i, 1);
2268 if (low_stack(st_lim, stack_lim(btop, 1)))
2269 gerepileall(btop, 23, &p, &i, &vp, &p5, &factd, &Ker, &dimKer, &G, &factdetG, &U, &p6, &Ker2, &dimKer2, &p7, &di, &p8, &sol, &p9, &p10, &p11, &m, &p12, &p13);
2270 }
2271 }
2272 /* apply LLL to avoid coefficients explosion */
2273 aux = lll(U);
2274 p2 = cgetg(4, t_VEC);
2275 gel(p2, 1) = gmul(gmul(gtrans(aux), G), aux);
2276 gel(p2, 2) = gmul(U, aux);
2277 gel(p2, 3) = gcopy(factd);
2278 p2 = gerepilecopy(ltop, p2);
2279 return p2;
2280 }
2281
2282 GEN
2283 mymat(GEN qfb) /* vec */
2284 {
2285 pari_sp ltop = avma;
2286 GEN p1 = gen_0; /* vec */
2287 qfb = gtovec(qfb);
2288 p1 = cgetg(3, t_MAT);
2289 gel(p1, 1) = cgetg(3, t_COL);
2290 gel(p1, 2) = cgetg(3, t_COL);
2291 gcoeff(p1, 1, 1) = gcopy(gel(qfb, 1));
2292 gcoeff(p1, 1, 2) = gdivgs(gel(qfb, 2), 2);
2293 gcoeff(p1, 2, 1) = gdivgs(gel(qfb, 2), 2);
2294 gcoeff(p1, 2, 2) = gcopy(gel(qfb, 3));
2295 p1 = gerepilecopy(ltop, p1);
2296 return p1;
2297 }
2298
2299 GEN
2300 Qfbsqrtgauss(GEN G, GEN factdetG, long prec)
2301 {
2302 pari_sp ltop = avma;
2303 GEN a = gen_0, b = gen_0, c = gen_0, d = gen_0, m = gen_0, n = gen_0, p = gen_0, aux = gen_0, Q1 = gen_0, M = gen_0;
2304 long l1;
2305 GEN p2 = gen_0; /* vec */
2306 GEN p3 = gen_0, p4 = gen_0;
2307 factdetG = gcopy(factdetG);
2308 if (gcmpgs(DEBUGLEVEL_qfsolve, 3) >= 0)
2309 pari_printf(" starting Qfbsqrtgauss with %Ps%Ps\n", G, factdetG);
2310 G = gtovec(G);
2311 a = gcopy(gel(G, 1));
2312 b = gdivgs(gel(G, 2), 2);
2313 c = gcopy(gel(G, 3));
2314 d = gsub(gmul(a, c), gsqr(b));
2315 /* 1st step: solve m^2 = a (d), m*n = -b (d), n^2 = c (d) */
2316 m = n = gmodulss(1, 1);
2317 gcoeff(factdetG, 1, 2) = gsubgs(gcoeff(factdetG, 1, 2), 3);
2318 l1 = glength(gel(factdetG, 1));
2319 {
2320 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
2321 long i;
2322 for (i = 1; i <= l1; ++i)
2323 {
2324 if (gequal0(gcoeff(factdetG, i, 2)))
2325 continue;
2326 p = gcopy(gcoeff(factdetG, i, 1));
2327 if (gequal1(ggcd(a, p)))
2328 {
2329 aux = gsqrt(gmodulo(a, p), prec);
2330 m = chinese(m, aux);
2331 n = chinese(n, gdiv(gneg(b), aux));
2332 }
2333 else
2334 {
2335 aux = gsqrt(gmodulo(c, p), prec);
2336 n = chinese(n, aux);
2337 m = chinese(m, gdiv(gneg(b), aux));
2338 }
2339 if (low_stack(st_lim, stack_lim(btop, 1)))
2340 gerepileall(btop, 4, &p, &aux, &m, &n);
2341 }
2342 }
2343 m = centerlift(m);
2344 n = centerlift(n);
2345 if (gcmpgs(DEBUGLEVEL_qfsolve, 4) >= 0)
2346 {
2347 pari_printf(" m = %Ps\n", m);
2348 pari_printf(" n = %Ps\n", n);
2349 }
2350 p2 = cgetg(4, t_MAT);
2351 gel(p2, 1) = cgetg(4, t_COL);
2352 gel(p2, 2) = cgetg(4, t_COL);
2353 gel(p2, 3) = cgetg(4, t_COL);
2354 gcoeff(p2, 1, 1) = gdiv(gsub(gsqr(n), c), d);
2355 gcoeff(p2, 1, 2) = gdiv(gadd(gmul(m, n), b), d);
2356 gcoeff(p2, 1, 3) = gcopy(n);
2357 gcoeff(p2, 2, 1) = gdiv(gadd(gmul(m, n), b), d);
2358 gcoeff(p2, 2, 2) = gdiv(gsub(gsqr(m), a), d);
2359 gcoeff(p2, 2, 3) = gcopy(m);
2360 gcoeff(p2, 3, 1) = gcopy(n);
2361 gcoeff(p2, 3, 2) = gcopy(m);
2362 gcoeff(p2, 3, 3) = gcopy(d);
2363 /* 2nd step: build Q1, with det=-1 such that Q1(x,y,0) = G(x,y) */
2364 Q1 = p2;
2365 Q1 = gneg(matadjoint0(Q1, 0));
2366 /* 3rd step: reduce Q1 to [0,0,-1;0,1,0;-1,0,0] */
2367 M = rowcopy(gel(LLLgoon3(Q1, NULL, prec), 2), 3);
2368 if (gcmpgs(gel(M, 1), 0) < 0)
2369 M = gneg(M);
2370 if (gcmpgs(DEBUGLEVEL_qfsolve, 3) >= 0)
2371 pari_printf(" end of Qfbsqrtgauss\n");
2372 if (!gequal0(gmodgs(gel(M, 1), 2)))
2373 {
2374 p3 = Qfb0(gel(M, 1), gmulsg(2, gel(M, 2)), gmulsg(2, gel(M, 3)), NULL, prec);
2375 p3 = gerepilecopy(ltop, p3);
2376 return p3;
2377 }
2378 else
2379 {
2380 p4 = Qfb0(gel(M, 3), gmulsg(-2, gel(M, 2)), gmulsg(2, gel(M, 1)), NULL, prec);
2381 p4 = gerepilecopy(ltop, p4);
2382 return p4;
2383 }
2384 avma = ltop;
2385 return gen_0;
2386 }
2387
2388 GEN
2389 class2(GEN D, GEN factdetG, GEN Winvariants, GEN U2, long prec) /* vec */
2390 {
2391 pari_sp ltop = avma;
2392 GEN factD = gen_0, n = gen_0, rang = gen_0, m = gen_0, listgen = gen_0, vD = gen_0, p = gen_0, vp = gen_0, aux = gen_0, invgen = gen_0, im = gen_0, Ker = gen_0, Kerim = gen_0, listgen2 = gen_0, G2 = gen_0, struct_s = gen_0, E = gen_0, red = gen_0;
2393 GEN p1 = gen_0, p2 = gen_0, p3 = gen_0, p4 = gen_0, p5 = gen_0, p6 = gen_0, p7 = gen_0, p8 = gen_0, p9 = gen_0, p10 = gen_0, p11 = gen_0, p12 = gen_0, p13 = gen_0, p14 = gen_0, p15 = gen_0, p16 = gen_0, p17 = gen_0; /* vec */
2394 factdetG = gcopy(factdetG);
2395 /* MODI change struct to struct_s */
2396 /* remove compteur */
2397
2398 if (gcmpgs(DEBUGLEVEL_qfsolve, 1) >= 0)
2399 pari_printf(" Construction of the 2-class group of discriminant %Ps\n", D);
2400 if (gequalgs(gmodgs(D, 4), 2) || gequalgs(gmodgs(D, 4), 3))
2401 pari_err(user, "class2: Discriminant not congruent to 0,1 mod 4");
2402 if (gequalgs(D, -4))
2403 {
2404 p1 = cgetg(3, t_VEC);
2405 p2 = cgetg(2, t_VEC);
2406 gel(p2, 1) = gen_1;
2407 gel(p1, 1) = p2;
2408 p3 = cgetg(2, t_VEC);
2409 gel(p3, 1) = Qfb0(gen_1, gen_0, gen_1, NULL, prec);
2410 gel(p1, 2) = p3;
2411 p1 = gerepilecopy(ltop, p1);
2412 return p1;
2413 }
2414 if (gequal0(factdetG))
2415 factdetG = factor(gmulsg(2, gabs(D, prec)));
2416 p4 = cgetg(2, t_VEC);
2417 gel(p4, 1) = gen_m1;
2418 factD = concat(p4, gtrans(gel(factdetG, 1)));
2419 if (gequal1(gmodgs(D, 4)))
2420 {
2421 D = gmulgs(D, 4);
2422 gcoeff(factdetG, 1, 2) = gaddgs(gcoeff(factdetG, 1, 2), 2);
2423 }
2424 n = stoi(glength(factD));
2425 rang = gsubgs(n, 3);
2426 if (gcmpgs(D, 0) > 0)
2427 m = gaddgs(rang, 1);
2428 else
2429 m = rang;
2430 if (gcmpgs(m, 0) < 0)
2431 m = gen_0;
2432 if (gcmpgs(DEBUGLEVEL_qfsolve, 3) >= 0)
2433 pari_printf(" factD = %Ps\n", factD);
2434 {
2435 long l18;
2436 p5 = cgetg(gtos(m)+1, t_VEC);
2437 for (l18 = 1; gcmpsg(l18, m) <= 0; ++l18)
2438 gel(p5, l18) = gen_0;
2439 }
2440 listgen = p5;
2441 if (!gequal0(vD = stoi(ggval(D, gen_2))))
2442 E = Qfb0(gen_1, gen_0, gdivgs(gneg(D), 4), NULL, prec);
2443 else
2444 E = Qfb0(gen_1, gen_1, gdivgs(gsubsg(1, D), 4), NULL, prec);
2445 if (gcmpgs(DEBUGLEVEL_qfsolve, 3) >= 0)
2446 pari_printf(" E = %Ps\n", E);
2447 if ((typ(Winvariants) == t_COL) && (gequal0(Winvariants) || (glength(inverseimage(gmul(U2, gmodulss(1, 2)), Winvariants)) > 0)))
2448 {
2449 p6 = cgetg(3, t_VEC);
2450 p7 = cgetg(2, t_VEC);
2451 gel(p7, 1) = gen_1;
2452 gel(p6, 1) = p7;
2453 p8 = cgetg(2, t_VEC);
2454 gel(p8, 1) = gcopy(E);
2455 gel(p6, 2) = p8;
2456 p6 = gerepilecopy(ltop, p6);
2457 return p6;
2458 }
2459 {
2460 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
2461 GEN i = gen_0;
2462 for (i = gen_1; gcmp(i, m) <= 0; i = gaddgs(i, 1))
2463 {
2464 /* no need to look at factD[1]=-1, nor factD[2]=2 */
2465 p = gcopy(gel(factD, gtos(gaddgs(i, 2))));
2466 vp = stoi(ggval(D, p));
2467 aux = gpow(p, vp, prec);
2468 if (!gequal0(vD))
2469 gel(listgen, gtos(i)) = Qfb0(aux, gen_0, gdiv(gdivgs(gneg(D), 4), aux), NULL, prec);
2470 else
2471 gel(listgen, gtos(i)) = Qfb0(aux, aux, gdivgs(gsub(aux, gdiv(D, aux)), 4), NULL, prec);
2472 if (low_stack(st_lim, stack_lim(btop, 1)))
2473 gerepileall(btop, 5, &i, &p, &vp, &aux, &listgen);
2474 }
2475 }
2476 if (gequalgs(vD, 2) && !gequalgs(gmodgs(D, 16), 4))
2477 {
2478 m = gaddgs(m, 1);
2479 rang = gaddgs(rang, 1);
2480 p9 = cgetg(2, t_VEC);
2481 gel(p9, 1) = Qfb0(gen_2, gen_2, gdivgs(gsubsg(4, D), 8), NULL, prec);
2482 listgen = concat(listgen, p9);
2483 }
2484 if (gequalgs(vD, 3))
2485 {
2486 m = gaddgs(m, 1);
2487 rang = gaddgs(rang, 1);
2488 p10 = cgetg(2, t_VEC);
2489 gel(p10, 1) = Qfb0(gpow(gen_2, gsubgs(vD, 2), prec), gen_0, gdiv(gneg(D), gpow(gen_2, vD, prec)), NULL, prec);
2490 listgen = concat(listgen, p10);
2491 }
2492 if (gcmpgs(DEBUGLEVEL_qfsolve, 3) >= 0)
2493 pari_printf(" listgen = %Ps\n", listgen);
2494 if (gcmpgs(DEBUGLEVEL_qfsolve, 2) >= 0)
2495 pari_printf(" rank = %Ps\n", rang);
2496 if (gequal0(rang))
2497 {
2498 p11 = cgetg(3, t_VEC);
2499 p12 = cgetg(2, t_VEC);
2500 gel(p12, 1) = gen_1;
2501 gel(p11, 1) = p12;
2502 p13 = cgetg(2, t_VEC);
2503 gel(p13, 1) = gcopy(E);
2504 gel(p11, 2) = p13;
2505 p11 = gerepilecopy(ltop, p11);
2506 return p11;
2507 }
2508 invgen = gmul(gel(Qflisteinvariants(listgen, factD, prec), 2), gmodulss(1, 2));
2509 if (gcmpgs(DEBUGLEVEL_qfsolve, 3) >= 0)
2510 pari_printf(" invgen = %Ps\n", lift(invgen));
2511 {
2512 long i;
2513 p14 = cgetg(gtos(m)+1, t_VEC);
2514 for (i = 1; gcmpsg(i, m) <= 0; ++i)
2515 gel(p14, i) = gen_2;
2516 }
2517 /* MODI2.1 */
2518
2519 struct_s = p14;
2520 im = lift(inverseimage(invgen, matimage0(invgen, 0)));
2521 {
2522 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
2523 GEN p19 = gen_0; /* vec */
2524 long l20;
2525 while ((gcmpsg(glength(im), rang) < 0) || ((typ(Winvariants) == t_COL) && glength(stoi(gequal0(inverseimage(concat(invgen, U2), Winvariants))))))
2526 {
2527 Ker = lift(matker0(invgen, 0));
2528 Kerim = concat(Ker, im);
2529 {
2530 long l21;
2531 p19 = cgetg(gtos(m)+1, t_VEC);
2532 for (l21 = 1; gcmpsg(l21, m) <= 0; ++l21)
2533 gel(p19, l21) = gen_0;
2534 }
2535 listgen2 = p19;
2536 {
2537 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
2538 GEN i = gen_0;
2539 for (i = gen_1; gcmp(i, m) <= 0; i = gaddgs(i, 1))
2540 {
2541 gel(listgen2, gtos(i)) = gcopy(E);
2542 {
2543 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
2544 GEN j = gen_0;
2545 for (j = gen_1; gcmp(j, m) <= 0; j = gaddgs(j, 1))
2546 {
2547 if (!gequal0(gcoeff(Kerim, gtos(j), gtos(i))))
2548 gel(listgen2, gtos(i)) = qfbcompraw(gel(listgen2, gtos(i)), gel(listgen, gtos(j)));
2549 if (low_stack(st_lim, stack_lim(btop, 1)))
2550 gerepileall(btop, 2, &j, &listgen2);
2551 }
2552 }
2553 if (gcmpgs(gnorml2(gel(Kerim, gtos(i))), 1) > 0)
2554 {
2555 red = QfbReduce(aux = mymat(gel(listgen2, gtos(i))), prec);
2556 aux = gmul(gmul(gtrans(red), aux), red);
2557 gel(listgen2, gtos(i)) = Qfb0(gcoeff(aux, 1, 1), gmulsg(2, gcoeff(aux, 1, 2)), gcoeff(aux, 2, 2), NULL, prec);
2558 }
2559 if (low_stack(st_lim, stack_lim(btop, 1)))
2560 gerepileall(btop, 4, &i, &listgen2, &aux, &red);
2561 }
2562 }
2563 listgen = gcopy(listgen2);
2564 invgen = gmul(invgen, Kerim);
2565 if (gcmpgs(DEBUGLEVEL_qfsolve, 4) >= 0)
2566 pari_printf(" listgen = %Ps\n", listgen);
2567 if (gcmpgs(DEBUGLEVEL_qfsolve, 4) >= 0)
2568 pari_printf(" invgen = %Ps\n", lift(invgen));
2569 /* MODI2.1 */
2570
2571 l20 = glength(Ker);
2572 {
2573 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
2574 long i;
2575 for (i = 1; i <= l20; ++i)
2576 {
2577 G2 = Qfbsqrtgauss(gel(listgen, i), factdetG, prec);
2578 gel(struct_s, i) = gshift(gel(struct_s, i), 1);
2579 gel(listgen, i) = gcopy(G2);
2580 gel(invgen, i) = gmul(gel(gel(Qflisteinvariants(G2, factD, prec), 2), 1), gmodulss(1, 2));
2581 if (low_stack(st_lim, stack_lim(btop, 1)))
2582 gerepileall(btop, 4, &G2, &struct_s, &listgen, &invgen);
2583 }
2584 }
2585 if (gcmpgs(DEBUGLEVEL_qfsolve, 3) >= 0)
2586 pari_printf(" listgen = %Ps\n", listgen);
2587 if (gcmpgs(DEBUGLEVEL_qfsolve, 3) >= 0)
2588 pari_printf(" invgen = %Ps\n", lift(invgen));
2589 if (gcmpgs(DEBUGLEVEL_qfsolve, 3) >= 0)
2590 pari_printf(" struct = %Ps\n", struct_s);
2591 /* MODI2.1 */
2592
2593 im = lift(inverseimage(invgen, matimage0(invgen, 0)));
2594 if (low_stack(st_lim, stack_lim(btop, 1)))
2595 gerepileall(btop, 11, &Ker, &Kerim, &p19, &listgen2, &aux, &red, &listgen, &invgen, &G2, &struct_s, &im);
2596 }
2597 }
2598 {
2599 long l22;
2600 p15 = cgetg(gtos(rang)+1, t_VEC);
2601 for (l22 = 1; gcmpsg(l22, rang) <= 0; ++l22)
2602 gel(p15, l22) = gen_0;
2603 }
2604 listgen2 = p15;
2605 {
2606 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
2607 GEN i = gen_0;
2608 for (i = gen_1; gcmp(i, rang) <= 0; i = gaddgs(i, 1))
2609 {
2610 gel(listgen2, gtos(i)) = gcopy(E);
2611 {
2612 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
2613 GEN j = gen_0;
2614 for (j = gen_1; gcmp(j, m) <= 0; j = gaddgs(j, 1))
2615 {
2616 if (!gequal0(gcoeff(im, gtos(j), gtos(i))))
2617 gel(listgen2, gtos(i)) = qfbcompraw(gel(listgen2, gtos(i)), gel(listgen, gtos(j)));
2618 if (low_stack(st_lim, stack_lim(btop, 1)))
2619 gerepileall(btop, 2, &j, &listgen2);
2620 }
2621 }
2622 if (gcmpgs(gnorml2(gel(im, gtos(i))), 1) > 0)
2623 {
2624 red = QfbReduce(aux = mymat(gel(listgen2, gtos(i))), prec);
2625 aux = gmul(gmul(gtrans(red), aux), red);
2626 gel(listgen2, gtos(i)) = Qfb0(gcoeff(aux, 1, 1), gmulsg(2, gcoeff(aux, 1, 2)), gcoeff(aux, 2, 2), NULL, prec);
2627 }
2628 if (low_stack(st_lim, stack_lim(btop, 1)))
2629 gerepileall(btop, 4, &i, &listgen2, &aux, &red);
2630 }
2631 }
2632 listgen = gcopy(listgen2);
2633 {
2634 long i;
2635 p16 = cgetg(gtos(rang)+1, t_VEC);
2636 for (i = 1; gcmpsg(i, rang) <= 0; ++i)
2637 gel(p16, i) = gcopy(gel(struct_s, gtos(gaddgs(gsub(m, rang), i))));
2638 }
2639 /* listgen = vector(rang,i,listgen[m-rang+i]); */
2640 struct_s = p16;
2641 if (gcmpgs(DEBUGLEVEL_qfsolve, 2) >= 0)
2642 pari_printf(" listgen = %Ps\n", listgen);
2643 if (gcmpgs(DEBUGLEVEL_qfsolve, 2) >= 0)
2644 pari_printf(" struct = %Ps\n", struct_s);
2645 p17 = cgetg(3, t_VEC);
2646 gel(p17, 1) = gcopy(struct_s);
2647 gel(p17, 2) = gcopy(listgen);
2648 p17 = gerepilecopy(ltop, p17);
2649 return p17;
2650 }
2651
2652 GEN
2653 Qfsolve(GEN G, GEN factD, long prec)
2654 {
2655 pari_sp ltop = avma;
2656 GEN n = gen_0, M = gen_0, signG = gen_0, d = gen_0, Min = gen_0, U = gen_0, codim = gen_0, aux = gen_0, G1 = gen_0, detG1 = gen_0, M1 = gen_0, subspace1 = gen_0, G2 = gen_0, subspace2 = gen_0, M2 = gen_0, solG2 = gen_0, Winvariants = gen_0, dQ = gen_0, factd = gen_0, U2 = gen_0, clgp2 = gen_0, V = gen_0, detG2 = gen_0, dimseti = gen_0, solG1 = gen_0, sol = gen_0, Q = gen_0, p1 = gen_0;
2657 GEN p2 = gen_0; /* vec */
2658 GEN p3 = gen_0, p4 = gen_0, p5 = gen_0;
2659 GEN p6 = gen_0; /* vec */
2660 long l7;
2661 GEN p8 = gen_0;
2662 GEN p9 = gen_0; /* vec */
2663 GEN p10 = gen_0;
2664 GEN p11 = gen_0; /* vec */
2665 GEN p12 = gen_0, p13 = gen_0;
2666 GEN p14 = gen_0, p15 = gen_0; /* vec */
2667 long l16;
2668 GEN p17 = gen_0; /* vec */
2669 long l18, l19, l20;
2670 GEN p21 = gen_0;
2671 long l22;
2672 GEN p23 = gen_0; /* vec */
2673 long l24;
2674 long l25; /* bool */
2675 long l26;
2676 GEN p27 = gen_0; /* vec */
2677 long l28;
2678 GEN p29 = gen_0; /* vec */
2679 long l30;
2680 GEN p31 = gen_0; /* vec */
2681 long l32;
2682 GEN p33 = gen_0, p34 = gen_0;
2683 GEN p35 = gen_0; /* vec */
2684 long l36;
2685 GEN p37 = gen_0; /* vec */
2686 factD = gcopy(factD);
2687 if (gcmpgs(DEBUGLEVEL_qfsolve, 1) >= 0)
2688 pari_printf(" starting Qfsolve\n");
2689 /* */
2690 /* 1st reduction of the coefficients of G */
2691 /* */
2692
2693 n = stoi(glength(G));
2694 d = det(G);
2695 if (gequal0(d))
2696 {
2697 p1 = gcopy(gel(matker0(G, 0), 1));
2698 p1 = gerepilecopy(ltop, p1);
2699 return p1;
2700 }
2701 M = IndefiniteLLL(G, NULL, NULL, prec);
2702 if (typ(M) == t_COL)
2703 {
2704 if (gcmpgs(DEBUGLEVEL_qfsolve, 1) >= 0)
2705 pari_printf(" solution %Ps\n", M);
2706 if (gcmpgs(DEBUGLEVEL_qfsolve, 1) >= 0)
2707 pari_printf(" end of Qfsolve\n");
2708 M = gerepilecopy(ltop, M);
2709 return M;
2710 }
2711 G = gcopy(gel(M, 1));
2712 M = gcopy(gel(M, 2));
2713 /* Real solubility */
2714 signG = qfsign(G);
2715 if (gequal0(gel(signG, 1)) || gequal0(gel(signG, 2)))
2716 {
2717 if (gcmpgs(DEBUGLEVEL_qfsolve, 1) >= 0)
2718 pari_printf(" no real solution\n");
2719 if (gcmpgs(DEBUGLEVEL_qfsolve, 1) >= 0)
2720 pari_printf(" end of Qfsolve\n");
2721 avma = ltop;
2722 return gen_m1;
2723 }
2724 if (gcmp(gel(signG, 1), gel(signG, 2)) < 0)
2725 {
2726 G = gneg(G);
2727 p2 = cgetg(3, t_MAT);
2728 gel(p2, 1) = cgetg(3, t_COL);
2729 gel(p2, 2) = cgetg(3, t_COL);
2730 gcoeff(p2, 1, 1) = gen_0;
2731 gcoeff(p2, 1, 2) = gen_1;
2732 gcoeff(p2, 2, 1) = gen_1;
2733 gcoeff(p2, 2, 2) = gen_0;
2734 signG = gmul(signG, p2);
2735 }
2736 /* Factorization of the determinant */
2737 if (gequal0(factD))
2738 {
2739 if (gcmpgs(DEBUGLEVEL_qfsolve, 1) >= 0)
2740 pari_printf(" factorization of the determinant\n");
2741 factD = factor(gneg(gabs(gmulsg(2, d), prec)));
2742 if (gcmpgs(DEBUGLEVEL_qfsolve, 1) >= 0)
2743 pari_printf("%Ps\n", factD);
2744 }
2745 gcoeff(factD, 1, 2) = gen_0;
2746 gcoeff(factD, 2, 2) = gsubgs(gcoeff(factD, 2, 2), 1);
2747 /* */
2748 /* Minimization and local solubility */
2749 /* */
2750
2751 if (gcmpgs(DEBUGLEVEL_qfsolve, 1) >= 0)
2752 pari_printf(" minimization of the determinant\n");
2753 Min = Qfminim(G, factD, prec);
2754 if (typ(Min) == t_INT)
2755 {
2756 if (gcmpgs(DEBUGLEVEL_qfsolve, 1) >= 0)
2757 pari_printf(" no local solution at %Ps\n", Min);
2758 if (gcmpgs(DEBUGLEVEL_qfsolve, 1) >= 0)
2759 pari_printf(" end of Qfsolve\n");
2760 Min = gerepilecopy(ltop, Min);
2761 return Min;
2762 }
2763 M = gmul(M, gel(Min, 2));
2764 G = gcopy(gel(Min, 1));
2765 /* Min[3] contains the factorization of abs(matdet(G)); */
2766
2767 if (gcmpgs(DEBUGLEVEL_qfsolve, 4) >= 0)
2768 pari_printf(" G minim = %Ps\n", G);
2769 if (gcmpgs(DEBUGLEVEL_qfsolve, 4) >= 0)
2770 pari_printf(" d = %Ps\n", d);
2771 /* Now, we know that local solutions exist */
2772 /* (except maybe at 2 if n==4), */
2773 /* if n==3, det(G) = +-1 */
2774 /* if n==4, or n is odd, det(G) is squarefree. */
2775 /* if n>=6, det(G) has all its valuations <=2. */
2776
2777 /* Reduction of G and search for trivial solutions. */
2778 /* When det G=+-1, such trivial solutions always exist. */
2779
2780 if (gcmpgs(DEBUGLEVEL_qfsolve, 1) >= 0)
2781 pari_printf(" reduction\n");
2782 U = IndefiniteLLL(G, NULL, NULL, prec);
2783 if (typ(U) == t_COL)
2784 {
2785 if (gcmpgs(DEBUGLEVEL_qfsolve, 1) >= 0)
2786 pari_printf(" solution = %Ps\n", gmul(M, U));
2787 if (gcmpgs(DEBUGLEVEL_qfsolve, 1) >= 0)
2788 pari_printf(" end of Qfsolve\n");
2789 p3 = gmul(M, U);
2790 p3 = gerepilecopy(ltop, p3);
2791 return p3;
2792 }
2793 G = gcopy(gel(U, 1));
2794 M = gmul(M, gel(U, 2));
2795 /* */
2796 /* If n >= 6 is even, need to increment the dimension by 1 */
2797 /* to suppress all the squares of det(G). */
2798 /* */
2799
2800 if (((gcmpgs(n, 6) >= 0) && gequal0(gmodgs(n, 2))) && !gequalgs(gel(matsize(gel(Min, 3)), 1), 0))
2801 {
2802 if (gcmpgs(DEBUGLEVEL_qfsolve, 1) >= 0)
2803 pari_printf(" increase the dimension by 1 = %Ps\n", gaddgs(n, 1));
2804 codim = gen_1;
2805 n = gaddgs(n, 1);
2806 p4 = gcopy(gel(matsize(gel(Min, 3)), 1));
2807 {
2808 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
2809 GEN i = gen_0, p38 = gen_0;
2810 p5 = gen_1;
2811 for (i = gen_1; gcmp(i, p4) <= 0; i = gaddgs(i, 1))
2812 {
2813 if (gequalgs(gcoeff(gel(Min, 3), gtos(i), 1), 2))
2814 p38 = gcopy(gcoeff(gel(Min, 3), gtos(i), 1));
2815 else
2816 p38 = gen_1;
2817 p5 = gmul(p5, p38);
2818 if (low_stack(st_lim, stack_lim(btop, 1)))
2819 gerepileall(btop, 3, &p38, &p5, &i);
2820 }
2821 }
2822 /* largest square divisor of d. */
2823 aux = p5;
2824 /* Choose the sign of aux such that the signature of G1 */
2825 /* is as balanced as possible */
2826 if (gcmp(gel(signG, 1), gel(signG, 2)) > 0)
2827 {
2828 gel(signG, 2) = gaddgs(gel(signG, 2), 1);
2829 aux = gneg(aux);
2830 }
2831 else
2832 gel(signG, 1) = gaddgs(gel(signG, 1), 1);
2833 p6 = cgetg(3, t_VEC);
2834 gel(p6, 1) = gcopy(G);
2835 gel(p6, 2) = gtomat(aux);
2836 G1 = matdiagonalblock(p6);
2837 detG1 = gmulsg(2, det(G1));
2838 l7 = glength(gel(factD, 1));
2839 {
2840 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
2841 long i;
2842 for (i = 2; i <= l7; ++i)
2843 {
2844 gcoeff(factD, i, 2) = stoi(ggval(detG1, gcoeff(factD, i, 1)));
2845 if (low_stack(st_lim, stack_lim(btop, 1)))
2846 factD = gerepilecopy(btop, factD);
2847 }
2848 }
2849 gcoeff(factD, 2, 2) = gsubgs(gcoeff(factD, 2, 2), 1);
2850 Min = Qfminim(G1, factD, prec);
2851 G1 = gcopy(gel(Min, 1));
2852 M1 = gcopy(gel(Min, 2));
2853 p8 = gsubgs(n, 1);
2854 {
2855 long i, j;
2856 p9 = cgetg(gtos(p8)+1, t_MAT);
2857 for (j = 1; gcmpsg(j, p8) <= 0; ++j)
2858 {
2859 gel(p9, j) = cgetg(gtos(n)+1, t_COL);
2860 for (i = 1; gcmpsg(i, n) <= 0; ++i)
2861 gcoeff(p9, i, j) = stoi(i == j);
2862 }
2863 }
2864 subspace1 = p9;
2865 }
2866 else
2867 {
2868 codim = gen_0;
2869 G1 = gcopy(G);
2870 subspace1 = M1 = matid(gtos(n));
2871 }
2872 /* Now, d is squarefree */
2873
2874 /* */
2875 /* If d is not +-1, need to increment the dimension by 2 */
2876 /* */
2877
2878 if (gequal0(gel(matsize(gel(Min, 3)), 1)))
2879 {
2880 /* if( abs(d) == 1, */
2881 if (gcmpgs(DEBUGLEVEL_qfsolve, 2) >= 0)
2882 pari_printf(" detG2 = 1\n");
2883 G2 = G1;
2884 subspace2 = M2 = matid(gtos(n));
2885 solG2 = LLLgoon(G2, gen_1, prec);
2886 }
2887 else
2888 {
2889 if (gcmpgs(DEBUGLEVEL_qfsolve, 1) >= 0)
2890 pari_printf(" increase the dimension by 2 = %Ps\n", gaddgs(n, 2));
2891 codim = gaddgs(codim, 2);
2892 p10 = gaddgs(n, 2);
2893 {
2894 long i, j;
2895 p11 = cgetg(gtos(n)+1, t_MAT);
2896 for (j = 1; gcmpsg(j, n) <= 0; ++j)
2897 {
2898 gel(p11, j) = cgetg(gtos(p10)+1, t_COL);
2899 for (i = 1; gcmpsg(i, p10) <= 0; ++i)
2900 gcoeff(p11, i, j) = stoi(i == j);
2901 }
2902 }
2903 subspace2 = p11;
2904 p12 = gcopy(gel(matsize(gel(Min, 3)), 1));
2905 {
2906 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
2907 GEN i = gen_0;
2908 p13 = gen_1;
2909 for (i = gen_1; gcmp(i, p12) <= 0; i = gaddgs(i, 1))
2910 {
2911 p13 = gmul(p13, gcoeff(gel(Min, 3), gtos(i), 1));
2912 if (low_stack(st_lim, stack_lim(btop, 1)))
2913 gerepileall(btop, 2, &p13, &i);
2914 }
2915 }
2916 d = p13;
2917 /* d = abs(matdet(G1)); */
2918 if (gequal1(gmodgs(gel(signG, 2), 2)))
2919 d = gneg(d);
2920 /* d = matdet(G1); */
2921 if (gequalgs(gcoeff(gel(Min, 3), 1, 1), 2))
2922 {
2923 p14 = cgetg(2, t_VEC);
2924 gel(p14, 1) = gen_m1;
2925 factD = p14;
2926 }
2927 else
2928 {
2929 p15 = cgetg(3, t_VEC);
2930 gel(p15, 1) = gen_m1;
2931 gel(p15, 2) = gen_2;
2932 factD = p15;
2933 }
2934 /* if d is even ... */
2935 factD = concat(factD, gtrans(gel(gel(Min, 3), 1)));
2936 if (gcmpgs(DEBUGLEVEL_qfsolve, 4) >= 0)
2937 pari_printf(" factD = %Ps\n", factD);
2938 /* Solubility at 2 (this is the only remaining bad prime). */
2939 if (gequalgs(n, 4) && gequal1(gmodgs(d, 8)))
2940 if (gequal1(QfWittinvariant(G, gen_2)))
2941 {
2942 if (gcmpgs(DEBUGLEVEL_qfsolve, 1) >= 0)
2943 pari_printf(" no local solution at 2\n");
2944 if (gcmpgs(DEBUGLEVEL_qfsolve, 1) >= 0)
2945 pari_printf(" end of Qfsolve\n");
2946 avma = ltop;
2947 return gen_2;
2948 }
2949 l16 = glength(factD);
2950 {
2951 long l39;
2952 p17 = cgetg(l16+1, t_COL);
2953 for (l39 = 1; l39 <= l16; ++l39)
2954 gel(p17, l39) = gen_0;
2955 }
2956 /* */
2957 /* Build a binary quadratic form with given invariants */
2958 /* */
2959 Winvariants = p17;
2960 /* choose the signature of Q. */
2961 /* (real invariant and sign of the discriminant) */
2962 dQ = gabs(d, prec);
2963 if (gequal(gel(signG, 1), gel(signG, 2)))
2964 {
2965 dQ = dQ;
2966 gel(Winvariants, 1) = gen_0;
2967 }
2968 /* signQ = [1,1]; */
2969 if (gcmp(gel(signG, 1), gel(signG, 2)) > 0)
2970 {
2971 dQ = gneg(dQ);
2972 gel(Winvariants, 1) = gen_0;
2973 }
2974 /* signQ = [2,0]; */
2975 if (gequalgs(n, 4) && !gequalgs(gmodgs(dQ, 4), 1))
2976 dQ = gmulgs(dQ, 4);
2977 if (gcmpgs(n, 5) >= 0)
2978 dQ = gmulgs(dQ, 8);
2979 /* p-adic invariants */
2980 /* for p = 2, the choice is fixed from the product formula */
2981 if (gequalgs(n, 4))
2982 {
2983 if (gcmpgs(DEBUGLEVEL_qfsolve, 1) >= 0)
2984 pari_printf(" compute the local invariants of G1\n");
2985 aux = gcopy(gel(gel(Qflisteinvariants(gneg(G1), factD, prec), 2), 1));
2986 l18 = glength(factD);
2987 {
2988 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
2989 long i;
2990 for (i = 3; i <= l18; ++i)
2991 {
2992 gel(Winvariants, i) = gcopy(gel(aux, i));
2993 if (low_stack(st_lim, stack_lim(btop, 1)))
2994 Winvariants = gerepilecopy(btop, Winvariants);
2995 }
2996 }
2997 }
2998 else
2999 {
3000 aux = gdiv(gmul(gpow(gen_m1, gdivgs(gsubgs(n, 3), 2), prec), dQ), d);
3001 /* ici aux = 8 ou -8 */
3002 l19 = glength(factD);
3003 {
3004 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
3005 long i;
3006 for (i = 3; i <= l19; ++i)
3007 {
3008 gel(Winvariants, i) = stoi(hilbert(aux, gel(factD, i), gel(factD, i)) > 0);
3009 if (low_stack(st_lim, stack_lim(btop, 1)))
3010 Winvariants = gerepilecopy(btop, Winvariants);
3011 }
3012 }
3013 }
3014 l20 = glength(factD);
3015 {
3016 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
3017 long i;
3018 p21 = gen_0;
3019 for (i = 1; i <= l20; ++i)
3020 {
3021 p21 = gadd(p21, gel(Winvariants, i));
3022 if (low_stack(st_lim, stack_lim(btop, 1)))
3023 p21 = gerepilecopy(btop, p21);
3024 }
3025 }
3026 gel(Winvariants, 2) = gmodgs(p21, 2);
3027 if (gcmpgs(DEBUGLEVEL_qfsolve, 1) >= 0)
3028 {
3029 pari_printf(" Search for a binary quadrativ form of discriminant = %Ps\n", dQ);
3030 pari_printf(" and Witt invariants = %Ps\n", Winvariants);
3031 }
3032 l22 = glength(factD) - 1;
3033 {
3034 long l40, l41;
3035 p23 = cgetg(3, t_MAT);
3036 for (l41 = 1; l41 <= 2; ++l41)
3037 {
3038 gel(p23, l41) = cgetg(l22+1, t_COL);
3039 for (l40 = 1; l40 <= l22; ++l40)
3040 gcoeff(p23, l40, l41) = gen_0;
3041 }
3042 }
3043 /* Construction of the 2-class group of discriminant dQ */
3044 /* until some product of the generators gives the desired invariants. */
3045 /* In dim 4, need to look among the form of the type q or 2*q */
3046 /* because Q might be imprimitive. */
3047
3048 factd = p23;
3049 l24 = glength(factD) - 1;
3050 {
3051 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
3052 GEN i = gen_0;
3053 for (i = gen_1; gcmpgs(i, l24) <= 0; i = gaddgs(i, 1))
3054 {
3055 gcoeff(factd, gtos(i), 1) = gcopy(gel(factD, gtos(gaddgs(i, 1))));
3056 gcoeff(factd, gtos(i), 2) = stoi(ggval(dQ, gcoeff(factd, gtos(i), 1)));
3057 if (low_stack(st_lim, stack_lim(btop, 1)))
3058 gerepileall(btop, 2, &i, &factd);
3059 }
3060 }
3061 gcoeff(factd, 1, 2) = gaddgs(gcoeff(factd, 1, 2), 1);
3062 l25 = gequalgs(n, 4);
3063 l26 = glength(factD);
3064 {
3065 long i, j;
3066 p27 = cgetg(l25+1, t_MAT);
3067 for (j = 1; j <= l25; ++j)
3068 {
3069 gel(p27, j) = cgetg(l26+1, t_COL);
3070 for (i = 1; i <= l26; ++i)
3071 gcoeff(p27, i, j) = stoi(hilbert(gen_2, dQ, gel(factD, i)) < 0);
3072 }
3073 }
3074 U2 = p27;
3075 clgp2 = class2(dQ, factd, Winvariants, U2, prec);
3076 if (gcmpgs(DEBUGLEVEL_qfsolve, 4) >= 0)
3077 pari_printf(" clgp2 = %Ps\n", clgp2);
3078 clgp2 = gcopy(gel(clgp2, 2));
3079 U = gcopy(gel(Qflisteinvariants(clgp2, factD, prec), 2));
3080 if (gequalgs(n, 4))
3081 U = concat(U, U2);
3082 if (gcmpgs(DEBUGLEVEL_qfsolve, 4) >= 0)
3083 pari_printf(" U = %Ps\n", U);
3084 /* MODI2.1 */
3085
3086 V = lift(inverseimage(gmul(U, gmodulss(1, 2)), gmul(Winvariants, gmodulss(1, 2))));
3087 /* if( !length(V), next); */ /* MODI 1 */
3088 if (gcmpgs(DEBUGLEVEL_qfsolve, 4) >= 0)
3089 pari_printf(" V = %Ps\n", V);
3090 if (gequal1(gmodgs(dQ, 2)))
3091 Q = primeform(gmulsg(4, dQ), gen_1, prec);
3092 else
3093 Q = primeform(dQ, gen_1, prec);
3094 l28 = glength(clgp2);
3095 {
3096 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
3097 long i;
3098 for (i = 1; i <= l28; ++i)
3099 {
3100 if (!gequal0(gel(V, i)))
3101 Q = qfbcompraw(Q, gel(clgp2, i));
3102 if (low_stack(st_lim, stack_lim(btop, 1)))
3103 Q = gerepilecopy(btop, Q);
3104 }
3105 }
3106 Q = mymat(Q);
3107 if (gcmpgs(gnorml2(V), 1) > 0)
3108 {
3109 aux = QfbReduce(Q, prec);
3110 Q = gmul(gmul(gtrans(aux), Q), aux);
3111 }
3112 if (gequalgs(n, 4) && !gequal0(gel(V, glength(V))))
3113 Q = gmulgs(Q, 2);
3114 if (gcmpgs(DEBUGLEVEL_qfsolve, 2) >= 0)
3115 pari_printf(" Q = %Ps\n", Q);
3116 if (gcmpgs(DEBUGLEVEL_qfsolve, 3) >= 0)
3117 pari_printf(" Witt invariants of Q = %Ps\n", Qflisteinvariants(Q, factD, prec));
3118 p29 = cgetg(3, t_VEC);
3119 gel(p29, 1) = gcopy(G1);
3120 gel(p29, 2) = gneg(Q);
3121 /* */
3122 /* Build a form of dim=n+2 potentially unimodular */
3123 /* */
3124
3125 G2 = matdiagonalblock(p29);
3126 if (gcmpgs(DEBUGLEVEL_qfsolve, 4) >= 0)
3127 pari_printf(" G2 = %Ps\n", G2);
3128 if (gcmpgs(DEBUGLEVEL_qfsolve, 2) >= 0)
3129 pari_printf(" minimization of the form of dimension %ld\n", glength(G2));
3130 /* Minimization of G2 */
3131 detG2 = det(G2);
3132 l30 = glength(factD) - 1;
3133 {
3134 long l42, l43;
3135 p31 = cgetg(3, t_MAT);
3136 for (l43 = 1; l43 <= 2; ++l43)
3137 {
3138 gel(p31, l43) = cgetg(l30+1, t_COL);
3139 for (l42 = 1; l42 <= l30; ++l42)
3140 gcoeff(p31, l42, l43) = gen_0;
3141 }
3142 }
3143 factd = p31;
3144 l32 = glength(factD) - 1;
3145 {
3146 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
3147 GEN i = gen_0;
3148 for (i = gen_1; gcmpgs(i, l32) <= 0; i = gaddgs(i, 1))
3149 {
3150 gcoeff(factd, gtos(i), 2) = stoi(ggval(detG2, gcoeff(factd, gtos(i), 1) = gcopy(gel(factD, gtos(gaddgs(i, 1))))));
3151 if (low_stack(st_lim, stack_lim(btop, 1)))
3152 gerepileall(btop, 2, &i, &factd);
3153 }
3154 }
3155 if (gcmpgs(DEBUGLEVEL_qfsolve, 3) >= 0)
3156 pari_printf(" det(G2) = %Ps\n", factd);
3157 Min = Qfminim(G2, factd, prec);
3158 M2 = gcopy(gel(Min, 2));
3159 G2 = gcopy(gel(Min, 1));
3160 if (gcmpgs(gabs(det(G2), prec), 2) > 0)
3161 pari_err(user, "Qfsolve: det(G2) <> +-1 *******");
3162 if (gcmpgs(DEBUGLEVEL_qfsolve, 4) >= 0)
3163 pari_printf(" G2 = %Ps\n", G2);
3164 /* Now, we have det(G2) = +-1 */
3165
3166 /* Find a seti for G2 (Totally isotropic subspace, Sous-Espace Totalement Isotrope) */
3167 if (gcmpgs(DEBUGLEVEL_qfsolve, 2) >= 0)
3168 pari_printf(" Search a subspace of solutions for G2\n");
3169 solG2 = LLLgoon(G2, gen_1, prec);
3170 p33 = gaddgs(codim, 1);
3171 p34 = gaddgs(codim, 1);
3172 {
3173 long i, j;
3174 p35 = cgetg(gtos(p33)+1, t_MAT);
3175 for (j = 1; gcmpsg(j, p33) <= 0; ++j)
3176 {
3177 gel(p35, j) = cgetg(gtos(p34)+1, t_COL);
3178 for (i = 1; gcmpsg(i, p34) <= 0; ++i)
3179 gcoeff(p35, i, j) = gcopy(gcoeff(gel(solG2, 1), i, j));
3180 }
3181 }
3182 if (!gequalgs(p35, 0))
3183 pari_err(user, "Qfsolve: not enough solutions in G2");
3184 }
3185 /* G2 must have a subspace of solutions of dimension > codim */
3186 dimseti = gen_0;
3187 {
3188 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
3189 GEN p44 = gen_0, p45 = gen_0;
3190 GEN p46 = gen_0; /* vec */
3191 for(;;)
3192 {
3193 p44 = gaddgs(dimseti, 1);
3194 p45 = gaddgs(dimseti, 1);
3195 {
3196 long i, j;
3197 p46 = cgetg(gtos(p44)+1, t_MAT);
3198 for (j = 1; gcmpsg(j, p44) <= 0; ++j)
3199 {
3200 gel(p46, j) = cgetg(gtos(p45)+1, t_COL);
3201 for (i = 1; gcmpsg(i, p45) <= 0; ++i)
3202 gcoeff(p46, i, j) = gcopy(gcoeff(gel(solG2, 1), i, j));
3203 }
3204 }
3205 if (!gequal0(p46))
3206 break;
3207 dimseti = gaddgs(dimseti, 1);
3208 if (low_stack(st_lim, stack_lim(btop, 1)))
3209 gerepileall(btop, 4, &p44, &p45, &p46, &dimseti);
3210 }
3211 }
3212 if (gcmp(dimseti, codim) <= 0)
3213 pari_err(user, "Qfsolve: not enough solutions for G2");
3214 l36 = glength(G2);
3215 {
3216 long i, j;
3217 p37 = cgetg(gtos(dimseti)+1, t_MAT);
3218 for (j = 1; gcmpsg(j, dimseti) <= 0; ++j)
3219 {
3220 gel(p37, j) = cgetg(l36+1, t_COL);
3221 for (i = 1; i <= l36; ++i)
3222 gcoeff(p37, i, j) = gcopy(gcoeff(gel(solG2, 2), i, j));
3223 }
3224 }
3225 solG2 = p37;
3226 if (gcmpgs(DEBUGLEVEL_qfsolve, 3) >= 0)
3227 pari_printf(" solG2 = %Ps\n", solG2);
3228 /* The solution of G1 is simultaneously in solG2 and subspace2 */
3229 if (gcmpgs(DEBUGLEVEL_qfsolve, 1) >= 0)
3230 pari_printf(" Reconstruction of a solution of G1\n");
3231 solG1 = intersect(subspace2, gmul(M2, solG2));
3232 solG1 = gmul(gtrans(subspace2), solG1);
3233 if (gcmpgs(DEBUGLEVEL_qfsolve, 3) >= 0)
3234 pari_printf(" solG1 = %Ps\n", solG1);
3235 /* The solution of G is simultaneously in solG and subspace1 */
3236 if (gcmpgs(DEBUGLEVEL_qfsolve, 1) >= 0)
3237 pari_printf(" Reconstruction of a solution of G\n");
3238 sol = intersect(subspace1, gmul(M1, solG1));
3239 sol = gmul(gtrans(subspace1), sol);
3240 sol = gmul(M, sol);
3241 sol = gdiv(sol, content(sol));
3242 if (glength(sol) == 1)
3243 sol = gcopy(gel(sol, 1));
3244 if (gcmpgs(DEBUGLEVEL_qfsolve, 3) >= 0)
3245 pari_printf(" sol = %Ps\n", sol);
3246 if (gcmpgs(DEBUGLEVEL_qfsolve, 1) >= 0)
3247 pari_printf(" end of Qfsolve\n");
3248 sol = gerepilecopy(ltop, sol);
3249 return sol;
3250 }
3251
3252 GEN
3253 matdiagonalblock(GEN v)
3254 {
3255 pari_sp ltop = avma;
3256 GEN lv = gen_0, lt = gen_0, M = gen_0, p1 = gen_0;
3257 GEN p2 = gen_0; /* vec */
3258 lv = stoi(glength(v));
3259 {
3260 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
3261 GEN i = gen_0;
3262 p1 = gen_0;
3263 for (i = gen_1; gcmp(i, lv) <= 0; i = gaddgs(i, 1))
3264 {
3265 p1 = gaddgs(p1, glength(gel(v, gtos(i))));
3266 if (low_stack(st_lim, stack_lim(btop, 1)))
3267 gerepileall(btop, 2, &p1, &i);
3268 }
3269 }
3270 lt = p1;
3271 {
3272 long l3, l4;
3273 p2 = cgetg(gtos(lt)+1, t_MAT);
3274 for (l4 = 1; gcmpsg(l4, lt) <= 0; ++l4)
3275 {
3276 gel(p2, l4) = cgetg(gtos(lt)+1, t_COL);
3277 for (l3 = 1; gcmpsg(l3, lt) <= 0; ++l3)
3278 gcoeff(p2, l3, l4) = gen_0;
3279 }
3280 }
3281 M = p2;
3282 lt = gen_0;
3283 {
3284 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
3285 GEN i = gen_0;
3286 long l5;
3287 for (i = gen_1; gcmp(i, lv) <= 0; i = gaddgs(i, 1))
3288 {
3289 l5 = glength(gel(v, gtos(i)));
3290 {
3291 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
3292 long j, l6;
3293 for (j = 1; j <= l5; ++j)
3294 {
3295 l6 = glength(gel(v, gtos(i)));
3296 {
3297 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
3298 long k;
3299 for (k = 1; k <= l6; ++k)
3300 {
3301 gcoeff(M, gtos(gaddgs(lt, j)), gtos(gaddgs(lt, k))) = gcopy(gcoeff(gel(v, gtos(i)), j, k));
3302 if (low_stack(st_lim, stack_lim(btop, 1)))
3303 M = gerepilecopy(btop, M);
3304 }
3305 }
3306 if (low_stack(st_lim, stack_lim(btop, 1)))
3307 M = gerepilecopy(btop, M);
3308 }
3309 }
3310 lt = gaddgs(lt, glength(gel(v, gtos(i))));
3311 if (low_stack(st_lim, stack_lim(btop, 1)))
3312 gerepileall(btop, 3, &i, &M, <);
3313 }
3314 }
3315 M = gerepilecopy(ltop, M);
3316 return M;
3317 }
3318
3319 GEN
3320 ellchangecurveinverse(GEN ell, GEN v) /* ell */
3321 {
3322 pari_sp ltop = avma;
3323 GEN p1 = gen_0; /* ell */
3324 p1 = ellchangecurve(ell, ellinverturst(v));
3325 p1 = gerepilecopy(ltop, p1);
3326 return p1;
3327 }
3328
3329 GEN
3330 ellchangepointinverse(GEN pt, GEN v)
3331 {
3332 pari_sp ltop = avma;
3333 GEN p1 = gen_0;
3334 p1 = ellchangepoint(pt, ellinverturst(v));
3335 p1 = gerepilecopy(ltop, p1);
3336 return p1;
3337 }
3338
3339 GEN
3340 ellcomposeurst(GEN urst1, GEN urst2) /* vec */
3341 {
3342 pari_sp ltop = avma;
3343 GEN u1 = gen_0, r1 = gen_0, s1 = gen_0, t1 = gen_0, u2 = gen_0, r2 = gen_0, s2 = gen_0, t2 = gen_0;
3344 GEN p1 = gen_0; /* vec */
3345 t2 = gcopy(gel(urst2, 4));
3346 s2 = gcopy(gel(urst2, 3));
3347 r2 = gcopy(gel(urst2, 2));
3348 u2 = gcopy(gel(urst2, 1));
3349 t1 = gcopy(gel(urst1, 4));
3350 s1 = gcopy(gel(urst1, 3));
3351 r1 = gcopy(gel(urst1, 2));
3352 u1 = gcopy(gel(urst1, 1));
3353 p1 = cgetg(5, t_VEC);
3354 gel(p1, 1) = gmul(u1, u2);
3355 gel(p1, 2) = gadd(gmul(gsqr(u1), r2), r1);
3356 gel(p1, 3) = gadd(gmul(u1, s2), s1);
3357 gel(p1, 4) = gadd(gadd(gmul(gpowgs(u1, 3), t2), gmul(gmul(s1, gsqr(u1)), r2)), t1);
3358 p1 = gerepilecopy(ltop, p1);
3359 return p1;
3360 }
3361
3362 GEN
3363 ellinverturst(GEN urst) /* vec */
3364 {
3365 pari_sp ltop = avma;
3366 GEN u = gen_0, r = gen_0, s = gen_0, t = gen_0;
3367 GEN p1 = gen_0; /* vec */
3368 t = gcopy(gel(urst, 4));
3369 s = gcopy(gel(urst, 3));
3370 r = gcopy(gel(urst, 2));
3371 u = gcopy(gel(urst, 1));
3372 p1 = cgetg(5, t_VEC);
3373 gel(p1, 1) = ginv(u);
3374 gel(p1, 2) = gdiv(gneg(r), gsqr(u));
3375 gel(p1, 3) = gdiv(gneg(s), u);
3376 gel(p1, 4) = gdiv(gsub(gmul(r, s), t), gpowgs(u, 3));
3377 p1 = gerepilecopy(ltop, p1);
3378 return p1;
3379 }
3380
3381 GEN
3382 mysubst(GEN polsu, GEN subsx)
3383 {
3384 pari_sp ltop = avma;
3385 GEN p1 = gen_0, p2 = gen_0;
3386 if (typ(lift(polsu)) == t_POL)
3387 {
3388 p1 = simplify(gsubst(lift(polsu), gvar(gpolvar(lift(polsu))), subsx));
3389 p1 = gerepilecopy(ltop, p1);
3390 return p1;
3391 }
3392 else
3393 {
3394 p2 = simplify(lift(polsu));
3395 p2 = gerepilecopy(ltop, p2);
3396 return p2;
3397 }
3398 avma = ltop;
3399 return gen_0;
3400 }
3401
3402 GEN
3403 degre(GEN idegre)
3404 {
3405 pari_sp ltop = avma;
3406 GEN ideg = gen_0, jdeg = gen_0;
3407 ideg = gcopy(idegre);
3408 {
3409 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
3410 while (signe(ideg = gshift(ideg, -1)))
3411 {
3412 jdeg = gaddgs(jdeg, 1);
3413 if (low_stack(st_lim, stack_lim(btop, 1)))
3414 gerepileall(btop, 2, &ideg, &jdeg);
3415 }
3416 }
3417 jdeg = gerepilecopy(ltop, jdeg);
3418 return jdeg;
3419 }
3420
3421 long
3422 nfissquare(GEN nf, GEN a, long prec) /* bool */
3423 {
3424 pari_sp ltop = avma;
3425 long l1; /* bool */
3426 l1 = (lg(nfsqrt(nf, a, prec))-1) > 0;
3427 avma = ltop;
3428 return l1;
3429 }
3430
3431 GEN
3432 nfsqrt(GEN nf, GEN a, long prec) /* vec */
3433 {
3434 pari_sp ltop = avma;
3435 GEN alift = gen_0, ta = gen_0, py = gen_0, pfact = gen_0;
3436 GEN p1 = gen_0, p2 = gen_0, p3 = gen_0; /* vec */
3437 GEN p4 = gen_0; /* int */
3438 GEN x = pol_x(fetch_user_var("x")), y = pol_x(fetch_user_var("y"));
3439 GEN p5 = gen_0, p6 = gen_0; /* vec */
3440 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
3441 pari_printf(" starting nfsqrt %Ps\n", a);
3442 if (gequal0(a) || gequal1(a))
3443 {
3444 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
3445 pari_printf(" end of nfsqrt %Ps\n", a);
3446 p1 = cgetg(2, t_VEC);
3447 gel(p1, 1) = gcopy(a);
3448 p1 = gerepilecopy(ltop, p1);
3449 return p1;
3450 }
3451 alift = lift(a);
3452 ta = strtoGENstr(type_name(typ(a)));
3453 if (!degree(alift))
3454 alift = polcoeff0(alift, 0, -1);
3455 if (typ(alift) != t_POL)
3456 if (!gequal0(gissquare(alift)))
3457 {
3458 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
3459 pari_printf(" end of nfsqrt %Ps\n", sqrtrat(alift));
3460 p2 = cgetg(2, t_VEC);
3461 gel(p2, 1) = sqrtrat(alift);
3462 p2 = gerepilecopy(ltop, p2);
3463 return p2;
3464 }
3465 if (degree(member_pol(nf)) <= 1)
3466 {
3467 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
3468 pari_printf(" end of nfsqrt %Ps\n", cgetg(1, t_VEC));
3469 p3 = cgetg(1, t_VEC);
3470 p3 = gerepilecopy(ltop, p3);
3471 return p3;
3472 }
3473 if (gequal(ta, strtoGENstr("t_POL")))
3474 a = gmodulo(a, member_pol(nf));
3475 /* the real embeddings must all be >0 */
3476
3477 p4 = icopy(member_r1(nf));
3478 {
3479 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
3480 GEN i = gen_0;
3481 GEN p7 = gen_0; /* vec */
3482 for (i = gen_1; gcmp(i, p4) <= 0; i = gaddgs(i, 1))
3483 {
3484 /* MODI: in ell.gp, nfsign_s(nf,a,i) < 0 so replaced. Both correct
3485 or only one ? */
3486 /* py = mysubst(alift,nf.roots[i]);
3487 if( sign(py) < 0, */
3488 if (nfsign_s(nf, a, i, prec) < 0)
3489 {
3490 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
3491 pari_printf(" end of nfsqrt %Ps\n", cgetg(1, t_VEC));
3492 p7 = cgetg(1, t_VEC);
3493 p7 = gerepilecopy(ltop, p7);
3494 return p7;
3495 }
3496 if (low_stack(st_lim, stack_lim(btop, 1)))
3497 gerepileall(btop, 2, &i, &p7);
3498 }
3499 }
3500 /* factorization over nf of the polynomial X^2-a */
3501
3502 if (gequal(gpolvar(member_pol(nf)), x))
3503 {
3504 py = gsubst(member_pol(nf), gvar(x), y);
3505 pfact = lift(gcoeff(polfnf(gsub(gsqr(x), mysubst(alift, gmodulo(y, py))), py), 1, 1));
3506 }
3507 else
3508 pfact = lift(gcoeff(polfnf(gsub(gsqr(x), a), member_pol(nf)), 1, 1));
3509 if (degree(pfact) == 2)
3510 {
3511 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
3512 pari_printf(" end of nfsqrt %Ps\n", cgetg(1, t_VEC));
3513 p5 = cgetg(1, t_VEC);
3514 p5 = gerepilecopy(ltop, p5);
3515 return p5;
3516 }
3517 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
3518 pari_printf(" end of nfsqrt %Ps\n", pfact);
3519 p6 = cgetg(2, t_VEC);
3520 gel(p6, 1) = gsubst(polcoeff0(pfact, 0, -1), gvar(y), gmodulo(gpolvar(member_pol(nf)), member_pol(nf)));
3521 p6 = gerepilecopy(ltop, p6);
3522 return p6;
3523 }
3524
3525 GEN
3526 sqrtrat(GEN a)
3527 {
3528 pari_sp ltop = avma;
3529 GEN p1 = gen_0;
3530 p1 = gdiv(sqrtint(numer(a)), sqrtint(denom(a)));
3531 p1 = gerepilecopy(ltop, p1);
3532 return p1;
3533 }
3534
3535 GEN
3536 polratroots(GEN pol)
3537 {
3538 pari_sp ltop = avma;
3539 GEN f = gen_0, ans = gen_0;
3540 long l1;
3541 f = gcopy(gel(factor(pol), 1));
3542 ans = cgetg(1, t_VEC);
3543 l1 = glength(f);
3544 {
3545 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
3546 long j;
3547 GEN p2 = gen_0; /* vec */
3548 for (j = 1; j <= l1; ++j)
3549 {
3550 if (degree(gel(f, j)) == 1)
3551 {
3552 p2 = cgetg(2, t_VEC);
3553 gel(p2, 1) = gdiv(gneg(polcoeff0(gel(f, j), 0, -1)), polcoeff0(gel(f, j), 1, -1));
3554 ans = concat(ans, p2);
3555 }
3556 if (low_stack(st_lim, stack_lim(btop, 1)))
3557 gerepileall(btop, 2, &p2, &ans);
3558 }
3559 }
3560 ans = gerepilecopy(ltop, ans);
3561 return ans;
3562 }
3563
3564 GEN
3565 ratpoint(GEN pol, GEN lim, GEN singlepoint, long prec)
3566 {
3567 pari_sp ltop = avma;
3568 GEN listpoints = gen_0, point1 = gen_0, odd = gen_0, deg4 = gen_0, pol16 = gen_0, tab16 = gen_0, pol9 = gen_0, tab9 = gen_0, pol5 = gen_0, tab5 = gen_0, pol0 = gen_0, vecz = gen_0, vecx = gen_0, lead = gen_0, zz = gen_0, xx = gen_0, evpol = gen_0, iz = gen_0, factpol = gen_0, deg = gen_0, vz = gen_0;
3569 GEN p1 = gen_0, p2 = gen_0, p3 = gen_0, p4 = gen_0, p5 = gen_0; /* vec */
3570 long l6;
3571 GEN p7 = gen_0, p8 = gen_0; /* vec */
3572 long l9;
3573 GEN p10 = gen_0; /* vec */
3574 long l11;
3575 GEN p12 = gen_0; /* vec */
3576 long l13;
3577 GEN p14 = gen_0, p15 = gen_0, p16 = gen_0, p17 = gen_0; /* vec */
3578 GEN p18 = gen_0, x = pol_x(fetch_user_var("x"));
3579 GEN p19 = gen_0; /* vec */
3580 if (!lim)
3581 lim = gen_1;
3582 if (!singlepoint)
3583 singlepoint = gen_1;
3584 /* MODI: added deg, vz */
3585
3586 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
3587 {
3588 pari_printf(" Starting ratpoint with pol = %Ps\n", pol);
3589 pari_printf(" lim = %Ps\n", lim);
3590 }
3591 if (gequal0(singlepoint))
3592 listpoints = cgetg(1, t_VEC);
3593 point1 = cgetg(1, t_VEC);
3594 /* */
3595 /* trivial solutions */
3596 /* */
3597
3598 /* the leading coeff is a square */
3599 if (!gequal0(gissquare(pollead(pol, -1))))
3600 {
3601 p1 = cgetg(4, t_VEC);
3602 gel(p1, 1) = gen_1;
3603 gel(p1, 2) = sqrtrat(pollead(pol, -1));
3604 gel(p1, 3) = gen_0;
3605 point1 = p1;
3606 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
3607 pari_printf(" trivial solution: lead(pol) is a square\n");
3608 if (!gequal0(singlepoint))
3609 {
3610 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
3611 pari_printf(" end of ratpoint\n");
3612 point1 = gerepilecopy(ltop, point1);
3613 return point1;
3614 }
3615 p2 = cgetg(2, t_VEC);
3616 gel(p2, 1) = gcopy(point1);
3617 listpoints = concat(listpoints, p2);
3618 }
3619 /* the constant coeff is a square */
3620 if (!gequal0(gissquare(polcoeff0(pol, 0, -1))))
3621 {
3622 p3 = cgetg(3, t_VEC);
3623 gel(p3, 1) = gen_0;
3624 gel(p3, 2) = sqrtrat(polcoeff0(pol, 0, -1));
3625 point1 = p3;
3626 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
3627 pari_printf(" trivial solution: pol(0) is a square\n");
3628 if (!gequal0(singlepoint))
3629 {
3630 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
3631 pari_printf(" end of ratpoint\n");
3632 point1 = gerepilecopy(ltop, point1);
3633 return point1;
3634 }
3635 p4 = cgetg(2, t_VEC);
3636 gel(p4, 1) = gcopy(point1);
3637 listpoints = concat(listpoints, p4);
3638 }
3639 odd = stoi(smodss(degree(pol), 2));
3640 /* roots of pol ? */
3641 factpol = polratroots(pol);
3642 if (glength(factpol))
3643 {
3644 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
3645 pari_printf(" trivial solution: roots of pol%Ps\n", factpol);
3646 if (!gequal0(singlepoint))
3647 {
3648 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
3649 pari_printf(" end of ratpoint\n");
3650 p5 = cgetg(3, t_VEC);
3651 gel(p5, 1) = gcopy(gel(factpol, 1));
3652 gel(p5, 2) = gen_0;
3653 p5 = gerepilecopy(ltop, p5);
3654 return p5;
3655 }
3656 l6 = glength(factpol);
3657 {
3658 long i;
3659 GEN p20 = gen_0; /* vec */
3660 p7 = cgetg(l6+1, t_VEC);
3661 for (i = 1; i <= l6; ++i)
3662 {
3663 p20 = cgetg(3, t_VEC);
3664 gel(p20, 1) = gcopy(gel(factpol, i));
3665 gel(p20, 2) = gen_0;
3666 gel(p7, i) = p20;
3667 }
3668 }
3669 listpoints = concat(listpoints, p7);
3670 }
3671 /* */
3672 /* Sieve */
3673 /* */
3674
3675 /* initialisation of the sieve modulo 16, 9 and 5 */
3676 /* used only with even degree when lim is large */
3677
3678 deg = stoi(degree(pol));
3679 deg4 = stoi((gequal0(odd)) && (gcmpgs(lim, 20) > 0));
3680 if (!gequal0(deg4))
3681 {
3682 pol16 = gtrans(gmul(gtovec(pol), gmodulss(1, 16)));
3683 {
3684 long l21, l22;
3685 p8 = cgetg(17, t_MAT);
3686 for (l22 = 1; l22 <= 16; ++l22)
3687 {
3688 gel(p8, l22) = cgetg(17, t_COL);
3689 for (l21 = 1; l21 <= 16; ++l21)
3690 gcoeff(p8, l21, l22) = gen_0;
3691 }
3692 }
3693 tab16 = p8;
3694 l9 = 16 - 1;
3695 {
3696 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
3697 GEN xx = gen_0;
3698 long l23;
3699 for (xx = gen_0; gcmpgs(xx, l9) <= 0; xx = gaddgs(xx, 1))
3700 {
3701 l23 = 16 - 1;
3702 {
3703 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
3704 GEN zz = gen_0, p24 = gen_0;
3705 GEN p25 = gen_0; /* vec */
3706 for (zz = gen_0; gcmpgs(zz, l23) <= 0; zz = gaddgs(zz, 1))
3707 {
3708 p24 = gaddgs(deg, 1);
3709 {
3710 long i;
3711 p25 = cgetg(gtos(p24)+1, t_VEC);
3712 for (i = 1; gcmpsg(i, p24) <= 0; ++i)
3713 gel(p25, i) = gmul(gpow(xx, gsubgs(gaddgs(deg, 1), i), prec), gpowgs(zz, i - 1));
3714 }
3715 gcoeff(tab16, gtos(gaddgs(xx, 1)), gtos(gaddgs(zz, 1))) = stoi(gequal0(gissquare(gmul(p25, pol16))));
3716 if (low_stack(st_lim, stack_lim(btop, 1)))
3717 gerepileall(btop, 4, &zz, &p24, &p25, &tab16);
3718 }
3719 }
3720 if (low_stack(st_lim, stack_lim(btop, 1)))
3721 gerepileall(btop, 2, &xx, &tab16);
3722 }
3723 }
3724 pol9 = gmul(gtrans(gtovec(pol)), gmodulss(1, 9));
3725 {
3726 long l26, l27;
3727 p10 = cgetg(10, t_MAT);
3728 for (l27 = 1; l27 <= 9; ++l27)
3729 {
3730 gel(p10, l27) = cgetg(10, t_COL);
3731 for (l26 = 1; l26 <= 9; ++l26)
3732 gcoeff(p10, l26, l27) = gen_0;
3733 }
3734 }
3735 tab9 = p10;
3736 l11 = 9 - 1;
3737 {
3738 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
3739 GEN xx = gen_0;
3740 long l28;
3741 for (xx = gen_0; gcmpgs(xx, l11) <= 0; xx = gaddgs(xx, 1))
3742 {
3743 l28 = 9 - 1;
3744 {
3745 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
3746 GEN zz = gen_0, p29 = gen_0;
3747 GEN p30 = gen_0; /* vec */
3748 for (zz = gen_0; gcmpgs(zz, l28) <= 0; zz = gaddgs(zz, 1))
3749 {
3750 p29 = gaddgs(deg, 1);
3751 {
3752 long i;
3753 p30 = cgetg(gtos(p29)+1, t_VEC);
3754 for (i = 1; gcmpsg(i, p29) <= 0; ++i)
3755 gel(p30, i) = gmul(gpow(xx, gsubgs(gaddgs(deg, 1), i), prec), gpowgs(zz, i - 1));
3756 }
3757 gcoeff(tab9, gtos(gaddgs(xx, 1)), gtos(gaddgs(zz, 1))) = stoi(gequal0(gissquare(gmul(p30, pol9))));
3758 if (low_stack(st_lim, stack_lim(btop, 1)))
3759 gerepileall(btop, 4, &zz, &p29, &p30, &tab9);
3760 }
3761 }
3762 if (low_stack(st_lim, stack_lim(btop, 1)))
3763 gerepileall(btop, 2, &xx, &tab9);
3764 }
3765 }
3766 pol5 = gmul(gtrans(gtovec(pol)), gmodulss(1, 5));
3767 {
3768 long l31, l32;
3769 p12 = cgetg(6, t_MAT);
3770 for (l32 = 1; l32 <= 5; ++l32)
3771 {
3772 gel(p12, l32) = cgetg(6, t_COL);
3773 for (l31 = 1; l31 <= 5; ++l31)
3774 gcoeff(p12, l31, l32) = gen_0;
3775 }
3776 }
3777 tab5 = p12;
3778 l13 = 5 - 1;
3779 {
3780 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
3781 GEN xx = gen_0;
3782 long l33;
3783 for (xx = gen_0; gcmpgs(xx, l13) <= 0; xx = gaddgs(xx, 1))
3784 {
3785 l33 = 5 - 1;
3786 {
3787 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
3788 GEN zz = gen_0, p34 = gen_0;
3789 GEN p35 = gen_0; /* vec */
3790 for (zz = gen_0; gcmpgs(zz, l33) <= 0; zz = gaddgs(zz, 1))
3791 {
3792 p34 = gaddgs(deg, 1);
3793 {
3794 long i;
3795 p35 = cgetg(gtos(p34)+1, t_VEC);
3796 for (i = 1; gcmpsg(i, p34) <= 0; ++i)
3797 gel(p35, i) = gmul(gpow(xx, gsubgs(gaddgs(deg, 1), i), prec), gpowgs(zz, i - 1));
3798 }
3799 gcoeff(tab5, gtos(gaddgs(xx, 1)), gtos(gaddgs(zz, 1))) = stoi(gequal0(gissquare(gmul(p35, pol5))));
3800 if (low_stack(st_lim, stack_lim(btop, 1)))
3801 gerepileall(btop, 4, &zz, &p34, &p35, &tab5);
3802 }
3803 }
3804 if (low_stack(st_lim, stack_lim(btop, 1)))
3805 gerepileall(btop, 2, &xx, &tab5);
3806 }
3807 }
3808 }
3809 /* if the degree is odd, search only for square denominators */
3810 if (!gequal0(odd))
3811 {
3812 {
3813 long i;
3814 p14 = cgetg(gtos(lim)+1, t_VEC);
3815 for (i = 1; gcmpsg(i, lim) <= 0; ++i)
3816 gel(p14, i) = sqri(stoi(i));
3817 }
3818 vecz = p14;
3819 }
3820 else
3821 {
3822 /* if the degree is even, the leading coeff must be */
3823 /* a square modulo zz. */
3824 lead = pollead(pol, -1);
3825 {
3826 long l36;
3827 p15 = cgetg(gtos(lim)+1, t_VEC);
3828 for (l36 = 1; gcmpsg(l36, lim) <= 0; ++l36)
3829 gel(p15, l36) = gen_0;
3830 }
3831 vecz = p15;
3832 zz = gen_0;
3833 {
3834 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
3835 GEN i = gen_0;
3836 for (i = gen_1; gcmp(i, lim) <= 0; i = gaddgs(i, 1))
3837 {
3838 zz = gaddgs(zz, 1);
3839 {
3840 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
3841 while (gequal0(gissquare(gmodulo(lead, zz))))
3842 {
3843 zz = gaddgs(zz, 1);
3844 if (low_stack(st_lim, stack_lim(btop, 1)))
3845 zz = gerepilecopy(btop, zz);
3846 }
3847 }
3848 gel(vecz, gtos(i)) = gcopy(zz);
3849 if (low_stack(st_lim, stack_lim(btop, 1)))
3850 gerepileall(btop, 3, &i, &zz, &vecz);
3851 }
3852 }
3853 }
3854 /* the constant coeff must be a square modulo xx. */
3855 pol0 = polcoeff0(pol, 0, -1);
3856 {
3857 long l37;
3858 p16 = cgetg(gtos(lim)+1, t_VEC);
3859 for (l37 = 1; gcmpsg(l37, lim) <= 0; ++l37)
3860 gel(p16, l37) = gen_0;
3861 }
3862 vecx = p16;
3863 xx = gen_0;
3864 {
3865 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
3866 GEN i = gen_0;
3867 for (i = gen_1; gcmp(i, lim) <= 0; i = gaddgs(i, 1))
3868 {
3869 xx = gaddgs(xx, 1);
3870 {
3871 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
3872 while (gequal0(gissquare(gmodulo(pol0, xx))))
3873 {
3874 xx = gaddgs(xx, 1);
3875 if (low_stack(st_lim, stack_lim(btop, 1)))
3876 xx = gerepilecopy(btop, xx);
3877 }
3878 }
3879 gel(vecx, gtos(i)) = gcopy(xx);
3880 if (low_stack(st_lim, stack_lim(btop, 1)))
3881 gerepileall(btop, 3, &i, &xx, &vecx);
3882 }
3883 }
3884 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
3885 pari_printf(" xmax = %Ps\n", gel(vecx, gtos(lim)));
3886 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
3887 pari_printf(" zmax = %Ps\n", gel(vecz, gtos(lim)));
3888 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
3889 pari_printf(" vecx = %Ps\n", vecx);
3890 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
3891 pari_printf(" vecz = %Ps\n", vecz);
3892 if (!gequal0(deg4))
3893 {
3894 {
3895 long i;
3896 GEN p38 = gen_0;
3897 GEN p39 = gen_0; /* vec */
3898 p17 = cgetg(gtos(lim)+1, t_VEC);
3899 for (i = 1; gcmpsg(i, lim) <= 0; ++i)
3900 {
3901 p38 = gaddgs(deg, 1);
3902 {
3903 long j;
3904 p39 = cgetg(gtos(p38)+1, t_VEC);
3905 for (j = 1; gcmpsg(j, p38) <= 0; ++j)
3906 gel(p39, j) = gmul(polcoeff0(pol, gtos(gsubgs(gaddgs(deg, 1), j)), -1), gpowgs(gel(vecz, i), j - 1));
3907 }
3908 gel(p17, i) = gtopoly(p39, -1);
3909 }
3910 }
3911 vz = p17;
3912 }
3913 /* loop over x = xx/zz */
3914 /* the loop on [xx,zz] is done diagonally */
3915 /* to start with the smallest values of both xx and zz. */
3916 p18 = gmulsg(2, lim);
3917 {
3918 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
3919 GEN somme = gen_0, p40 = gen_0, p41 = gen_0;
3920 for (somme = gen_2; gcmp(somme, p18) <= 0; somme = gaddgs(somme, 1))
3921 {
3922 p40 = gmaxsg(1, gsub(somme, lim));
3923 p41 = gmin(lim, gsubgs(somme, 1));
3924 {
3925 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
3926 GEN ix = gen_0;
3927 for (ix = p40; gcmp(ix, p41) <= 0; ix = gaddgs(ix, 1))
3928 {
3929 xx = gcopy(gel(vecx, gtos(ix)));
3930 iz = gsub(somme, ix);
3931 zz = gcopy(gel(vecz, gtos(iz)));
3932 if (!gequalgs(ggcd(zz, xx), 1))
3933 continue;
3934 {
3935 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
3936 long eps;
3937 GEN p42 = gen_0, p43 = gen_0; /* vec */
3938 for (eps = 1; eps <= 2; ++eps)
3939 {
3940 /* when eps = 1, xx > 0; when eps = 2, xx < 0. */
3941 if (!gequal0(deg4))
3942 {
3943 if (!gequal0(gcoeff(tab16, gtos(gaddgs(gmodgs(xx, 16), 1)), gtos(gaddgs(gmodgs(zz, 16), 1)))))
3944 {
3945 xx = gneg(xx);
3946 continue;
3947 }
3948 if (!gequal0(gcoeff(tab9, gtos(gaddgs(gmodgs(xx, 9), 1)), gtos(gaddgs(gmodgs(zz, 9), 1)))))
3949 {
3950 xx = gneg(xx);
3951 continue;
3952 }
3953 if (!gequal0(gcoeff(tab5, gtos(gaddgs(gmodgs(xx, 5), 1)), gtos(gaddgs(gmodgs(zz, 5), 1)))))
3954 {
3955 xx = gneg(xx);
3956 continue;
3957 }
3958 evpol = gsubst(gel(vz, gtos(iz)), gvar(x), xx);
3959 }
3960 else
3961 evpol = gsubst(pol, gvar(gpolvar(pol)), gdiv(xx, zz));
3962 if (!gequal0(gissquare(evpol)))
3963 {
3964 p42 = cgetg(3, t_VEC);
3965 gel(p42, 1) = gdiv(xx, zz);
3966 gel(p42, 2) = sqrtrat(gsubst(pol, gvar(gpolvar(pol)), gdiv(xx, zz)));
3967 point1 = p42;
3968 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
3969 pari_printf(" point found by ratpoint = %Ps\n", point1);
3970 if (!gequal0(singlepoint))
3971 goto label1;
3972 p43 = cgetg(2, t_VEC);
3973 gel(p43, 1) = gcopy(point1);
3974 listpoints = concat(listpoints, p43);
3975 }
3976 xx = gneg(xx);
3977 if (low_stack(st_lim, stack_lim(btop, 1)))
3978 gerepileall(btop, 6, &xx, &evpol, &p42, &point1, &p43, &listpoints);
3979 }
3980 }
3981 if (low_stack(st_lim, stack_lim(btop, 1)))
3982 gerepileall(btop, 7, &ix, &xx, &iz, &zz, &evpol, &point1, &listpoints);
3983 }
3984 }
3985 if (low_stack(st_lim, stack_lim(btop, 1)))
3986 gerepileall(btop, 9, &somme, &p40, &p41, &xx, &iz, &zz, &evpol, &point1, &listpoints);
3987 }
3988 label1:;
3989 }
3990 if (!gequal(point1, cgetg(1, t_VEC)))
3991 {
3992 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
3993 pari_printf(" point found by ratpoint = %Ps\n", point1);
3994 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
3995 pari_printf(" end of ratpoint \n");
3996 if (!gequal0(singlepoint))
3997 {
3998 point1 = gerepilecopy(ltop, point1);
3999 return point1;
4000 }
4001 else
4002 {
4003 listpoints = gerepilecopy(ltop, listpoints);
4004 return listpoints;
4005 }
4006 }
4007 p19 = cgetg(1, t_VEC);
4008 p19 = gerepilecopy(ltop, p19);
4009 return p19;
4010 }
4011
4012 GEN
4013 ratpoint2(GEN pol, GEN lim, GEN singlepoint, GEN redflag, long prec)
4014 {
4015 pari_sp ltop = avma;
4016 GEN listpoints = gen_0, list = gen_0, rr = gen_0, y2 = gen_0, aux = gen_0;
4017 long l1;
4018 if (!lim)
4019 lim = gen_1;
4020 if (!singlepoint)
4021 singlepoint = gen_1;
4022 if (!redflag)
4023 redflag = gen_0;
4024 listpoints = cgetg(1, t_VEC);
4025 list = listratpoint(pol, redflag, prec);
4026 l1 = glength(list);
4027 {
4028 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
4029 long i;
4030 GEN p2 = gen_0; /* vec */
4031 long l3;
4032 GEN p4 = gen_0;
4033 for (i = 1; i <= l1; ++i)
4034 {
4035 rr = ratpoint(gel(gel(list, i), 1), lim, singlepoint, prec);
4036 if (!gequal0(singlepoint) && glength(rr))
4037 {
4038 p2 = cgetg(2, t_VEC);
4039 gel(p2, 1) = gcopy(rr);
4040 rr = p2;
4041 }
4042 l3 = glength(rr);
4043 {
4044 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
4045 long j;
4046 GEN p5 = gen_0, p6 = gen_0, p7 = gen_0, p8 = gen_0; /* vec */
4047 for (j = 1; j <= l3; ++j)
4048 {
4049 y2 = gmul(gel(gel(rr, j), 2), gel(gel(list, i), 4));
4050 if (glength(gel(rr, j)) == 2)
4051 {
4052 p5 = cgetg(3, t_COL);
4053 gel(p5, 1) = gcopy(gel(gel(rr, j), 1));
4054 gel(p5, 2) = gen_1;
4055 aux = p5;
4056 }
4057 else
4058 {
4059 p6 = cgetg(3, t_COL);
4060 gel(p6, 1) = gcopy(gel(gel(rr, j), 1));
4061 gel(p6, 2) = gcopy(gel(gel(rr, j), 3));
4062 aux = p6;
4063 }
4064 aux = gmul(gel(gel(list, i), 2), aux);
4065 if (gequal0(gel(aux, 2)))
4066 {
4067 p7 = cgetg(4, t_VEC);
4068 gel(p7, 1) = gcopy(gel(aux, 1));
4069 gel(p7, 2) = gcopy(y2);
4070 gel(p7, 3) = gen_0;
4071 gel(rr, j) = p7;
4072 }
4073 else
4074 {
4075 p8 = cgetg(3, t_VEC);
4076 gel(p8, 1) = gdiv(gel(aux, 1), gel(aux, 2));
4077 gel(p8, 2) = gdiv(y2, gpowgs(gel(aux, 2), degree(pol)/2));
4078 gel(rr, j) = p8;
4079 }
4080 if (low_stack(st_lim, stack_lim(btop, 1)))
4081 gerepileall(btop, 7, &y2, &p5, &aux, &p6, &p7, &rr, &p8);
4082 }
4083 }
4084 if (!gequal0(singlepoint) && glength(rr))
4085 {
4086 p4 = gcopy(gel(rr, 1));
4087 p4 = gerepilecopy(ltop, p4);
4088 return p4;
4089 }
4090 listpoints = concat(listpoints, rr);
4091 if (low_stack(st_lim, stack_lim(btop, 1)))
4092 gerepileall(btop, 6, &rr, &p2, &y2, &aux, &p4, &listpoints);
4093 }
4094 }
4095 listpoints = vecsort0(listpoints, NULL, 2);
4096 listpoints = gerepilecopy(ltop, listpoints);
4097 return listpoints;
4098 }
4099
4100 GEN
4101 listratpoint(GEN pol, GEN redflag, long prec)
4102 {
4103 pari_sp ltop = avma;
4104 GEN list = gen_0, i = gen_0, K = gen_0, ff = gen_0, C = gen_0, p = gen_0, M = gen_0, U = gen_0, newpol = gen_0, factpol = gen_0, ll = gen_0, listf = gen_0, rr = gen_0;
4105 GEN p1 = gen_0, p2 = gen_0; /* vec */
4106 GEN x = pol_x(fetch_user_var("x"));
4107 long l3;
4108 GEN p4 = gen_0;
4109 GEN p5 = gen_0; /* vec */
4110 long l6, l7;
4111 if (!redflag)
4112 redflag = gen_0;
4113 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
4114 pari_printf(" Starting listratpoint with %Ps\n", pol);
4115 p1 = cgetg(2, t_VEC);
4116 p2 = cgetg(5, t_VEC);
4117 gel(p2, 1) = gcopy(pol);
4118 gel(p2, 2) = matid(2);
4119 gel(p2, 3) = gen_1;
4120 gel(p2, 4) = gen_1;
4121 gel(p1, 1) = p2;
4122 list = p1;
4123 i = gen_1;
4124 {
4125 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
4126 GEN p8 = gen_0, p9 = gen_0, p10 = gen_0; /* vec */
4127 long l11;
4128 while (gcmpgs(i, glength(list)) <= 0)
4129 {
4130 pol = gcopy(gel(gel(list, gtos(i)), 1));
4131 K = gabs(content(pol), prec);
4132 if (!gequalgs(K, 1))
4133 {
4134 pol = gel(gel(list, gtos(i)), 1) = gdiv(gel(gel(list, gtos(i)), 1), K);
4135 gel(gel(list, gtos(i)), 3) = gmul(gel(gel(list, gtos(i)), 3), K);
4136 }
4137 K = gcopy(gel(gel(list, gtos(i)), 3));
4138 if (gequal1(K))
4139 {
4140 i = gaddgs(i, 1);
4141 continue;
4142 }
4143 ff = factor(K);
4144 if (gcmpgs(vecmax(gel(ff, 2)), 1) > 0)
4145 {
4146 gel(ff, 2) = gdivent(gel(ff, 2), gen_2);
4147 C = factorback(ff);
4148 gel(gel(list, gtos(i)), 4) = gmul(gel(gel(list, gtos(i)), 4), C);
4149 K = gel(gel(list, gtos(i)), 3) = gdiv(gel(gel(list, gtos(i)), 3), gsqr(C));
4150 if (gequal1(K))
4151 {
4152 i = gaddgs(i, 1);
4153 continue;
4154 }
4155 ff = factor(K);
4156 }
4157 p = gcopy(gcoeff(ff, 1, 1));
4158 M = gcopy(gel(gel(list, gtos(i)), 2));
4159 C = gcopy(gel(gel(list, gtos(i)), 4));
4160 if (gequal0(gmod(pollead(pol, -1), p)))
4161 {
4162 p8 = cgetg(3, t_MAT);
4163 gel(p8, 1) = cgetg(3, t_COL);
4164 gel(p8, 2) = cgetg(3, t_COL);
4165 gcoeff(p8, 1, 1) = gen_1;
4166 gcoeff(p8, 1, 2) = gen_0;
4167 gcoeff(p8, 2, 1) = gen_0;
4168 gcoeff(p8, 2, 2) = gcopy(p);
4169 U = gmul(M, p8);
4170 if (gequal1(content(U)))
4171 {
4172 newpol = gmul(gsubst(pol, gvar(x), gdiv(x, p)), gpowgs(p, degree(pol) - 1));
4173 p9 = cgetg(2, t_VEC);
4174 p10 = cgetg(5, t_VEC);
4175 gel(p10, 1) = gcopy(newpol);
4176 gel(p10, 2) = gcopy(U);
4177 gel(p10, 3) = gdiv(K, p);
4178 gel(p10, 4) = gmul(C, p);
4179 gel(p9, 1) = p10;
4180 list = concat(list, p9);
4181 }
4182 }
4183 factpol = centerlift(rootmod(pol, p));
4184 l11 = glength(factpol);
4185 {
4186 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
4187 long j;
4188 GEN p12 = gen_0, p13 = gen_0, p14 = gen_0; /* vec */
4189 for (j = 1; j <= l11; ++j)
4190 {
4191 p12 = cgetg(3, t_MAT);
4192 gel(p12, 1) = cgetg(3, t_COL);
4193 gel(p12, 2) = cgetg(3, t_COL);
4194 gcoeff(p12, 1, 1) = gcopy(p);
4195 gcoeff(p12, 1, 2) = gcopy(gel(factpol, j));
4196 gcoeff(p12, 2, 1) = gen_0;
4197 gcoeff(p12, 2, 2) = gen_1;
4198 U = gmul(M, p12);
4199 if (gequal1(content(U)))
4200 {
4201 newpol = gdiv(gsubst(pol, gvar(x), gadd(gmul(p, x), gel(factpol, j))), p);
4202 p13 = cgetg(2, t_VEC);
4203 p14 = cgetg(5, t_VEC);
4204 gel(p14, 1) = gcopy(newpol);
4205 gel(p14, 2) = gcopy(U);
4206 gel(p14, 3) = gdiv(K, p);
4207 gel(p14, 4) = gmul(C, p);
4208 gel(p13, 1) = p14;
4209 list = concat(list, p13);
4210 }
4211 if (low_stack(st_lim, stack_lim(btop, 1)))
4212 gerepileall(btop, 6, &p12, &U, &newpol, &p14, &p13, &list);
4213 }
4214 }
4215 i = gaddgs(i, 1);
4216 if (low_stack(st_lim, stack_lim(btop, 1)))
4217 gerepileall(btop, 14, &pol, &K, &list, &i, &ff, &C, &p, &M, &p8, &U, &newpol, &p10, &p9, &factpol);
4218 }
4219 }
4220 l3 = glength(list);
4221 {
4222 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
4223 long i;
4224 p4 = gen_0;
4225 for (i = 1; i <= l3; ++i)
4226 {
4227 p4 = gaddgs(p4, gequal1(gel(gel(list, i), 3)));
4228 if (low_stack(st_lim, stack_lim(btop, 1)))
4229 p4 = gerepilecopy(btop, p4);
4230 }
4231 }
4232 ll = p4;
4233 {
4234 long l15;
4235 p5 = cgetg(gtos(ll)+1, t_VEC);
4236 for (l15 = 1; gcmpsg(l15, ll) <= 0; ++l15)
4237 gel(p5, l15) = gen_0;
4238 }
4239 listf = p5;
4240 i = gen_1;
4241 l6 = glength(list);
4242 {
4243 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
4244 long j;
4245 for (j = 1; j <= l6; ++j)
4246 {
4247 if (gequal1(gel(gel(list, j), 3)))
4248 {
4249 gel(listf, gtos(i)) = gcopy(gel(list, j));
4250 i = gaddgs(i, 1);
4251 }
4252 if (low_stack(st_lim, stack_lim(btop, 1)))
4253 gerepileall(btop, 2, &listf, &i);
4254 }
4255 }
4256 if (!gequal0(redflag))
4257 {
4258 l7 = glength(listf);
4259 {
4260 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
4261 long i;
4262 for (i = 1; i <= l7; ++i)
4263 {
4264 rr = redquartic(gel(gel(listf, i), 1), prec);
4265 gel(gel(listf, i), 1) = gcopy(gel(rr, 1));
4266 gel(gel(listf, i), 2) = gmul(gel(gel(listf, i), 2), gel(rr, 2));
4267 if (low_stack(st_lim, stack_lim(btop, 1)))
4268 gerepileall(btop, 2, &rr, &listf);
4269 }
4270 }
4271 }
4272 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
4273 pari_printf(" Output of listratpoint = %Ps\n", listf);
4274 listf = gerepilecopy(ltop, listf);
4275 return listf;
4276 }
4277
4278 GEN
4279 redquartic(GEN pol, long prec) /* vec */
4280 {
4281 pari_sp ltop = avma;
4282 GEN prec_s = gen_0, prec0 = gen_0, d = gen_0, disc2 = gen_0, test = gen_0, r = gen_0, normderiv = gen_0, disc2v = gen_0, q = gen_0, M = gen_0, p1 = gen_0, x = pol_x(fetch_user_var("x"));
4283 GEN p2 = gen_0, p3 = gen_0; /* vec */
4284 /* MODI change prec into prec_s */
4285
4286 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
4287 pari_printf(" starting redquartic\n");
4288 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
4289 pari_printf(" reduction of the quartic %Ps\n", pol);
4290 /* choice of the real precision used in the computation */
4291 prec_s = prec0 = stoi(getrealprecision());
4292 d = stoi(degree(pol));
4293 disc2 = gsqr(poldisc0(pol, -1));
4294 test = gen_0;
4295 {
4296 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
4297 GEN p4 = gen_0; /* vec */
4298 GEN p5 = gen_0;
4299 while (gequal0(test))
4300 {
4301 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
4302 pari_printf(" precision = %Ps\n", prec_s);
4303 r = roots0(pol, 0, prec);
4304 {
4305 long i;
4306 p4 = cgetg(gtos(d)+1, t_VEC);
4307 for (i = 1; gcmpsg(i, d) <= 0; ++i)
4308 gel(p4, i) = gnorm(gsubst(deriv(pol,-1), gvar(gpolvar(pol)), gel(r, i)));
4309 }
4310 normderiv = p4;
4311 {
4312 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
4313 GEN i = gen_0;
4314 p5 = gen_1;
4315 for (i = gen_1; gcmp(i, d) <= 0; i = gaddgs(i, 1))
4316 {
4317 p5 = gmul(p5, gel(normderiv, gtos(i)));
4318 if (low_stack(st_lim, stack_lim(btop, 1)))
4319 gerepileall(btop, 2, &p5, &i);
4320 }
4321 }
4322 disc2v = gmul(p5, gpow(pollead(pol, -1), gsubgs(gmulsg(2, d), 4), prec));
4323 test = stoi(gcmp(gabs(gsub(disc2v, disc2), prec), gpow(stoi(10), gdiventgs(gneg(prec_s), 2), prec)) < 0);
4324 if (gequal0(test))
4325 setrealprecision(gtos(prec_s = gmulgs(prec_s, 2)), &prec);
4326 if (low_stack(st_lim, stack_lim(btop, 1)))
4327 gerepileall(btop, 7, &r, &p4, &normderiv, &p5, &disc2v, &test, &prec_s);
4328 }
4329 }
4330 {
4331 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
4332 GEN i = gen_0;
4333 p1 = gen_0;
4334 for (i = gen_1; gcmp(i, d) <= 0; i = gaddgs(i, 1))
4335 {
4336 p1 = gadd(p1, gdiv(gnorm(gsub(x, gel(r, gtos(i)))), gpow(gel(normderiv, gtos(i)), ginv(gsubgs(d, 2)), prec)));
4337 if (low_stack(st_lim, stack_lim(btop, 1)))
4338 gerepileall(btop, 2, &p1, &i);
4339 }
4340 }
4341 /* former choice of the quadratic form */
4342 /* q = Vec(sum( i = 1, d, norm(x-r[i]))); */
4343 /* Now, uses the quadratic form normalized as in Cremona-Stoll */
4344 q = gtovec(p1);
4345 p2 = cgetg(3, t_MAT);
4346 gel(p2, 1) = cgetg(3, t_COL);
4347 gel(p2, 2) = cgetg(3, t_COL);
4348 gcoeff(p2, 1, 1) = gcopy(gel(q, 1));
4349 gcoeff(p2, 1, 2) = gdivgs(gel(q, 2), 2);
4350 gcoeff(p2, 2, 1) = gdivgs(gel(q, 2), 2);
4351 gcoeff(p2, 2, 2) = gcopy(gel(q, 3));
4352 M = QfbReduce(p2, prec);
4353 pol = gmul(gsubst(pol, gvar(gpolvar(pol)), gdiv(gtopoly(rowcopy(M, 1), -1), gtopoly(rowcopy(M, 2), -1))), gpowgs(gtopoly(rowcopy(M, 2), -1), degree(pol)));
4354 if (!gequal(prec_s, prec0))
4355 setrealprecision(gtos(prec0), &prec);
4356 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
4357 pari_printf(" reduced quartic = %Ps\n", pol);
4358 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
4359 pari_printf(" end of redquartic\n");
4360 p3 = cgetg(3, t_VEC);
4361 gel(p3, 1) = gcopy(pol);
4362 gel(p3, 2) = gcopy(M);
4363 p3 = gerepilecopy(ltop, p3);
4364 return p3;
4365 }
4366
4367 GEN
4368 polrealrootsisolate(GEN pol)
4369 {
4370 pari_sp ltop = avma;
4371 GEN st = gen_0, a = gen_0, res = gen_0, ind = gen_0, b = gen_0, c = gen_0, stab = gen_0, stac = gen_0;
4372 GEN p1 = gen_0, p2 = gen_0, p3 = gen_0, p4 = gen_0; /* vec */
4373 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
4374 pari_printf(" starting polrealrootsisolate with pol = %Ps\n", pol);
4375 st = stoi(sturmpart(pol, NULL, NULL));
4376 if (gequal0(st))
4377 {
4378 p1 = cgetg(1, t_VEC);
4379 p1 = gerepilecopy(ltop, p1);
4380 return p1;
4381 }
4382 a = gen_1;
4383 {
4384 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
4385 while (gcmpsg(sturmpart(pol, gneg(a), a), st) < 0)
4386 {
4387 a = gshift(a, 1);
4388 if (low_stack(st_lim, stack_lim(btop, 1)))
4389 a = gerepilecopy(btop, a);
4390 }
4391 }
4392 p2 = cgetg(2, t_VEC);
4393 p3 = cgetg(4, t_VEC);
4394 gel(p3, 1) = gneg(a);
4395 gel(p3, 2) = gcopy(a);
4396 gel(p3, 3) = gcopy(st);
4397 gel(p2, 1) = p3;
4398 res = p2;
4399 ind = gen_1;
4400 {
4401 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
4402 GEN p5 = gen_0, p6 = gen_0, p7 = gen_0; /* vec */
4403 while (gcmpsg(glength(res), st) < 0)
4404 {
4405 {
4406 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
4407 while (gequal1(gel(gel(res, gtos(ind)), 3)))
4408 {
4409 ind = gaddgs(ind, 1);
4410 if (low_stack(st_lim, stack_lim(btop, 1)))
4411 ind = gerepilecopy(btop, ind);
4412 }
4413 }
4414 a = gcopy(gel(gel(res, gtos(ind)), 1));
4415 b = gcopy(gel(gel(res, gtos(ind)), 2));
4416 stab = gcopy(gel(gel(res, gtos(ind)), 3));
4417 c = gdivgs(gadd(a, b), 2);
4418 stac = stoi(sturmpart(pol, a, c));
4419 if (gequal0(stac))
4420 {
4421 gel(gel(res, gtos(ind)), 1) = gcopy(c);
4422 continue;
4423 }
4424 if (gequal(stac, stab))
4425 {
4426 gel(gel(res, gtos(ind)), 2) = gcopy(c);
4427 continue;
4428 }
4429 p5 = cgetg(4, t_VEC);
4430 gel(p5, 1) = gcopy(a);
4431 gel(p5, 2) = gcopy(c);
4432 gel(p5, 3) = gcopy(stac);
4433 gel(res, gtos(ind)) = p5;
4434 p6 = cgetg(2, t_VEC);
4435 p7 = cgetg(4, t_VEC);
4436 gel(p7, 1) = gcopy(c);
4437 gel(p7, 2) = gcopy(b);
4438 gel(p7, 3) = gsub(stab, stac);
4439 gel(p6, 1) = p7;
4440 res = concat(res, p6);
4441 if (low_stack(st_lim, stack_lim(btop, 1)))
4442 gerepileall(btop, 10, &ind, &a, &b, &stab, &c, &stac, &res, &p5, &p7, &p6);
4443 }
4444 }
4445 {
4446 long i;
4447 GEN p8 = gen_0; /* vec */
4448 p4 = cgetg(gtos(st)+1, t_VEC);
4449 for (i = 1; gcmpsg(i, st) <= 0; ++i)
4450 {
4451 p8 = cgetg(3, t_VEC);
4452 gel(p8, 1) = gcopy(gel(gel(res, i), 1));
4453 gel(p8, 2) = gcopy(gel(gel(res, i), 2));
4454 gel(p4, i) = p8;
4455 }
4456 }
4457 res = p4;
4458 res = vecsort0(res, gen_1, 0);
4459 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
4460 pari_printf(" end of polrealrootsisolate with res = %Ps\n", res);
4461 res = gerepilecopy(ltop, res);
4462 return res;
4463 }
4464
4465 GEN
4466 polrealrootsimprove(GEN pol, GEN v)
4467 {
4468 pari_sp ltop = avma;
4469 GEN c = gen_0, v2 = gen_0, vc = gen_0;
4470 GEN p1 = gen_0; /* vec */
4471 v = gcopy(v);
4472 c = gdivgs(gadd(gel(v, 1), gel(v, 2)), 2);
4473 v2 = gsubst(pol, gvar(gpolvar(pol)), gel(v, 2));
4474 if (gequal0(v2))
4475 {
4476 p1 = cgetg(3, t_VEC);
4477 gel(p1, 1) = gcopy(c);
4478 gel(p1, 2) = gcopy(gel(v, 2));
4479 p1 = gerepilecopy(ltop, p1);
4480 return p1;
4481 }
4482 vc = gsubst(pol, gvar(gpolvar(pol)), c);
4483 if (gcmpgs(gmul(v2, vc), 0) >= 0)
4484 gel(v, 2) = gcopy(c);
4485 else
4486 gel(v, 1) = gcopy(c);
4487 v = gerepilecopy(ltop, v);
4488 return v;
4489 }
4490
4491 GEN
4492 polrootsmodpn(GEN pol, GEN p, long prec)
4493 {
4494 pari_sp ltop = avma;
4495 GEN vd = gen_0, rac = gen_0, i = gen_0, pol2 = gen_0, r = gen_0, newrac = gen_0;
4496 GEN p1 = gen_0, p2 = gen_0; /* vec */
4497 GEN x = pol_x(fetch_user_var("x"));
4498 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
4499 pari_printf(" starting polrootsmodpn %Ps:%Ps\n", p, pol);
4500 vd = stoi(ggval(poldisc0(pol, -1), p));
4501 p1 = cgetg(2, t_VEC);
4502 p2 = cgetg(3, t_VEC);
4503 gel(p2, 1) = gen_0;
4504 gel(p2, 2) = gen_0;
4505 gel(p1, 1) = p2;
4506 rac = p1;
4507 i = gen_1;
4508 {
4509 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
4510 long l3;
4511 GEN p4 = gen_0; /* vec */
4512 long l5;
4513 GEN p6 = gen_0; /* vec */
4514 while (gcmpgs(i, glength(rac)) <= 0)
4515 {
4516 /* if( rac[i][2] > vd, i++; next); */
4517 if (gcmp(gel(gel(rac, gtos(i)), 2), vd) >= 0)
4518 {
4519 i = gaddgs(i, 1);
4520 continue;
4521 }
4522 pol2 = gsubst(pol, gvar(x), gadd(gel(gel(rac, gtos(i)), 1), gmul(x, gpow(p, gel(gel(rac, gtos(i)), 2), prec))));
4523 pol2 = gdiv(pol2, content(pol2));
4524 r = lift(polratroots(gmul(pol2, gmodulsg(1, p))));
4525 if (glength(r) == 0)
4526 {
4527 i = gaddgs(i, 1);
4528 continue;
4529 }
4530 l3 = glength(r);
4531 {
4532 long j;
4533 GEN p7 = gen_0; /* vec */
4534 p4 = cgetg(l3+1, t_VEC);
4535 for (j = 1; j <= l3; ++j)
4536 {
4537 p7 = cgetg(3, t_VEC);
4538 gel(p7, 1) = gadd(gel(gel(rac, gtos(i)), 1), gmul(gpow(p, gel(gel(rac, gtos(i)), 2), prec), gel(r, j)));
4539 gel(p7, 2) = gaddgs(gel(gel(rac, gtos(i)), 2), 1);
4540 gel(p4, j) = p7;
4541 }
4542 }
4543 newrac = p4;
4544 l5 = glength(r) - 1;
4545 {
4546 long j;
4547 p6 = cgetg(l5+1, t_VEC);
4548 for (j = 1; j <= l5; ++j)
4549 gel(p6, j) = gcopy(gel(newrac, j + 1));
4550 }
4551 rac = concat(rac, p6);
4552 gel(rac, gtos(i)) = gcopy(gel(newrac, 1));
4553 if (low_stack(st_lim, stack_lim(btop, 1)))
4554 gerepileall(btop, 7, &i, &pol2, &r, &p4, &newrac, &p6, &rac);
4555 }
4556 }
4557 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
4558 pari_printf(" end of polrootsmodpn %Ps\n", rac);
4559 rac = gerepilecopy(ltop, rac);
4560 return rac;
4561 }
4562
4563 GEN
4564 ppinit(GEN nf, GEN p)
4565 {
4566 pari_sp ltop = avma;
4567 GEN pdec = gen_0, pp = gen_0;
4568 long l1;
4569 GEN p2 = gen_0; /* vec */
4570 pdec = idealprimedec(nf, p);
4571 l1 = glength(pdec);
4572 {
4573 long i;
4574 GEN p3 = gen_0; /* vec */
4575 GEN p4 = gen_0;
4576 p2 = cgetg(l1+1, t_VEC);
4577 for (i = 1; i <= l1; ++i)
4578 {
4579 p3 = cgetg(5, t_VEC);
4580 gel(p3, 1) = gcopy(gel(pdec, i));
4581 gel(p3, 2) = basistoalg(nf, gel(gel(pdec, i), 2));
4582 if (gequalgs(p, 2))
4583 p4 = idealstar0(nf, idealpow0(nf, gel(pdec, i), stoi(1 + (2*pr_get_e(gel(pdec, i)))), 0), 1);
4584 gel(p3, 3) = p4;
4585 gel(p3, 4) = nfmodprinit(nf, gel(pdec, i));
4586 gel(p2, i) = p3;
4587 }
4588 }
4589 pp = p2;
4590 pp = gerepilecopy(ltop, pp);
4591 return pp;
4592 }
4593
4594 long
4595 nfpsquareoddQ(GEN nf, GEN a, GEN pr, long prec)
4596 {
4597 pari_sp ltop = avma;
4598 GEN p = gen_0, v = gen_0, ap = gen_0, den = gen_0, norme = gen_0;
4599 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
4600 pari_printf(" starting nfpsquareoddQ(%Ps,%Ps\n", a, pr);
4601 if (gequal0(a))
4602 {
4603 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
4604 pari_printf(" end of nfpsquareoddQ\n");
4605 avma = ltop;
4606 return 1;
4607 }
4608 p = gcopy(gel(pr, 3));
4609 v = stoi(idealval(nf, lift(a), p));
4610 if (!gequal0(gmodgs(v, 2)))
4611 {
4612 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
4613 pari_printf(" end of nfpsquareoddQ\n");
4614 avma = ltop;
4615 return 0;
4616 }
4617 ap = algtobasis(nf, gdiv(a, gpow(basistoalg(nf, gel(p, 2)), v, prec)));
4618 den = stoi(ggval(denom(content(ap)), member_p(p)));
4619 if (!gequal0(den))
4620 {
4621 den = gadd(den, gmodgs(den, 2));
4622 ap = gmul(gpow(member_p(p), den, prec), nfmul(nf, ap, nfpow(nf, gel(p, 2), gmulgs(gneg(den), pr_get_e(p)))));
4623 }
4624 norme = gdivgs(gsubgs(gpowgs(member_p(p), pr_get_f(p)), 1), 2);
4625 ap = nfpowmodpr(nf, ap, norme, pr);
4626 gel(ap, 1) = gsubgs(gel(ap, 1), 1);
4627 if (gequal0(ap))
4628 {
4629 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
4630 pari_printf(" end of nfpsquareoddQ\n");
4631 avma = ltop;
4632 return 1;
4633 }
4634 if (idealval(nf, ap, p) > 0)
4635 {
4636 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
4637 pari_printf(" end of nfpsquareoddQ\n");
4638 avma = ltop;
4639 return 1;
4640 }
4641 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
4642 pari_printf(" end of nfpsquareoddQ\n");
4643 avma = ltop;
4644 return 0;
4645 }
4646
4647 long
4648 psquare(GEN a, GEN p, long prec)
4649 {
4650 pari_sp ltop = avma;
4651 GEN v = gen_0, ap = gen_0;
4652 GEN p1 = gen_0; /* vec */
4653 long l2; /* bool */
4654 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
4655 {
4656 p1 = cgetg(3, t_VEC);
4657 gel(p1, 1) = gcopy(a);
4658 gel(p1, 2) = gcopy(p);
4659 pari_printf(" starting psquare %Ps\n", p1);
4660 }
4661 if (gequal0(a))
4662 {
4663 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
4664 pari_printf(" end of psquare 1\n");
4665 avma = ltop;
4666 return 1;
4667 }
4668 v = stoi(ggval(a, p));
4669 if (!gequal0(gmodgs(v, 2)))
4670 {
4671 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
4672 pari_printf(" end of psquare 0\n");
4673 avma = ltop;
4674 return 0;
4675 }
4676 if (gequalgs(p, 2))
4677 ap = gsubgs(gmodgs(gshift(a, -gtos(v)), 8), 1);
4678 else
4679 ap = gsubgs(gkronecker(gdiv(a, gpow(p, v, prec)), p), 1);
4680 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
4681 pari_printf(" end of psquare %ld\n", gequal0(ap));
4682 l2 = gequal0(ap);
4683 avma = ltop;
4684 return l2;
4685 }
4686
4687 long
4688 lemma6(GEN pol, GEN p, GEN nu, GEN xx, long prec)
4689 {
4690 pari_sp ltop = avma;
4691 GEN gx = gen_0, gpx = gen_0, lambda = gen_0, mu = gen_0;
4692 gx = gsubst(pol, gvar(gpolvar(pol)), xx);
4693 if (psquare(gx, p, prec))
4694 {
4695 avma = ltop;
4696 return 1;
4697 }
4698 gpx = gsubst(deriv(pol,-1), gvar(gpolvar(pol)), xx);
4699 lambda = stoi(ggval(gx, p));
4700 mu = stoi(ggval(gpx, p));
4701 if (gcmp(lambda, gmulsg(2, mu)) > 0)
4702 {
4703 avma = ltop;
4704 return 1;
4705 }
4706 /* if( (lambda >= mu+nu) && (nu > mu), return(1)); */
4707 if ((gcmp(lambda, gmulsg(2, nu)) >= 0) && (gcmp(mu, nu) >= 0))
4708 {
4709 avma = ltop;
4710 return 0;
4711 }
4712 avma = ltop;
4713 return -1;
4714 }
4715
4716 long
4717 lemma7(GEN pol, GEN nu, GEN xx, long prec)
4718 {
4719 pari_sp ltop = avma;
4720 GEN gx = gen_0, gpx = gen_0, lambda = gen_0, mu = gen_0, q = gen_0;
4721 gx = gsubst(pol, gvar(gpolvar(pol)), xx);
4722 if (psquare(gx, gen_2, prec))
4723 {
4724 avma = ltop;
4725 return 1;
4726 }
4727 gpx = gsubst(deriv(pol,-1), gvar(gpolvar(pol)), xx);
4728 lambda = stoi(ggval(gx, gen_2));
4729 mu = stoi(ggval(gpx, gen_2));
4730 if (gcmp(lambda, gmulsg(2, mu)) > 0)
4731 {
4732 avma = ltop;
4733 return 1;
4734 }
4735 if (gcmp(nu, mu) > 0)
4736 {
4737 if (!gequal0(gmodgs(lambda, 2)))
4738 {
4739 avma = ltop;
4740 return -1;
4741 }
4742 q = gsub(gadd(mu, nu), lambda);
4743 if (gequal1(q))
4744 {
4745 avma = ltop;
4746 return 1;
4747 }
4748 if (gequalgs(q, 2) && gequal1(gmodgs(gshift(gx, -gtos(lambda)), 4)))
4749 {
4750 avma = ltop;
4751 return 1;
4752 }
4753 avma = ltop;
4754 return -1;
4755 }
4756 q = gsub(lambda, gmulsg(2, nu));
4757 if (gcmpgs(q, 0) >= 0)
4758 {
4759 avma = ltop;
4760 return 0;
4761 }
4762 if (gequalgs(q, -2) && gequal1(gmodgs(gshift(gx, -gtos(lambda)), 4)))
4763 {
4764 avma = ltop;
4765 return 0;
4766 }
4767 avma = ltop;
4768 return -1;
4769 }
4770
4771 long
4772 zpsoluble(GEN pol, GEN p, GEN nu, GEN pnu, GEN x0, GEN pnup, long prec)
4773 {
4774 pari_sp ltop = avma;
4775 GEN result = gen_0, pol2 = gen_0, fact = gen_0, x1 = gen_0;
4776 GEN p1 = gen_0; /* vec */
4777 GEN p2 = gen_0;
4778 long l3;
4779 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
4780 {
4781 p1 = cgetg(5, t_VEC);
4782 gel(p1, 1) = gcopy(pol);
4783 gel(p1, 2) = gcopy(p);
4784 gel(p1, 3) = gcopy(x0);
4785 gel(p1, 4) = gcopy(nu);
4786 pari_printf(" starting zpsoluble %Ps\n", p1);
4787 }
4788 if (gequalgs(p, 2))
4789 result = stoi(lemma7(pol, nu, x0, prec));
4790 else
4791 result = stoi(lemma6(pol, p, nu, x0, prec));
4792 if (gequalgs(result, 1))
4793 {
4794 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
4795 pari_printf(" end of zpsoluble 1 lemma\n");
4796 avma = ltop;
4797 return 1;
4798 }
4799 if (gequalm1(result))
4800 {
4801 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
4802 pari_printf(" end of zpsoluble 0 lemma\n");
4803 avma = ltop;
4804 return 0;
4805 }
4806 pnup = gmul(pnu, p);
4807 nu = gaddgs(nu, 1);
4808 if ((gcmp(p, LIMBIGPRIME) < 0) || (gequal0(LIMBIGPRIME)))
4809 {
4810 p2 = gsubgs(p, 1);
4811 {
4812 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
4813 GEN i = gen_0;
4814 for (i = gen_0; gcmp(i, p2) <= 0; i = gaddgs(i, 1))
4815 {
4816 if (zpsoluble(pol, p, nu, pnup, gadd(x0, gmul(pnu, i)), gen_0, prec))
4817 {
4818 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
4819 pari_printf(" end of zpsoluble\n");
4820 avma = ltop;
4821 return 1;
4822 }
4823 if (low_stack(st_lim, stack_lim(btop, 1)))
4824 i = gerepilecopy(btop, i);
4825 }
4826 }
4827 }
4828 else
4829 {
4830 pol2 = gsubst(pol, gvar(gpolvar(pol)), gadd(x0, gmul(pnu, gpolvar(pol))));
4831 pol2 = gdiv(pol2, content(pol2));
4832 pol2 = gmul(pol2, gmodulsg(1, p));
4833 if (!degree(pol2))
4834 {
4835 avma = ltop;
4836 return 0;
4837 }
4838 fact = gcopy(gel(factormod0(pol2, p, 0), 1));
4839 l3 = glength(fact);
4840 {
4841 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
4842 long i;
4843 for (i = 1; i <= l3; ++i)
4844 {
4845 x1 = gneg(centerlift(polcoeff0(gel(fact, i), 0, -1)));
4846 if (zpsoluble(pol, p, nu, pnup, gadd(x0, gmul(pnu, x1)), gen_0, prec))
4847 {
4848 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
4849 pari_printf(" end of zpsoluble\n");
4850 avma = ltop;
4851 return 1;
4852 }
4853 if (low_stack(st_lim, stack_lim(btop, 1)))
4854 x1 = gerepilecopy(btop, x1);
4855 }
4856 }
4857 {
4858 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
4859 GEN i = gen_0;
4860 for (i = gen_1; gcmp(i, MAXPROB) <= 0; i = gaddgs(i, 1))
4861 {
4862 x1 = genrand(p);
4863 if (zpsoluble(pol, p, nu, pnup, gadd(x0, gmul(pnu, x1)), gen_0, prec))
4864 {
4865 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
4866 pari_printf(" end of zpsoluble\n");
4867 avma = ltop;
4868 return 1;
4869 }
4870 if (low_stack(st_lim, stack_lim(btop, 1)))
4871 gerepileall(btop, 2, &i, &x1);
4872 }
4873 }
4874 }
4875 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
4876 if (gcmp(p, LIMBIGPRIME) >= 0)
4877 pari_printf(" ******* probabilistic test at p = %Ps*******\n", p);
4878 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
4879 pari_printf(" end of zpsoluble\n");
4880 avma = ltop;
4881 return 0;
4882 }
4883
4884 long
4885 qpsoluble(GEN pol, GEN p, long prec)
4886 {
4887 pari_sp ltop = avma;
4888 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
4889 {
4890 pari_printf(" starting qpsoluble %Ps\n", p);
4891 pari_printf(" pol = %Ps\n", pol);
4892 }
4893 if (psquare(pollead(pol, -1), p, prec))
4894 {
4895 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
4896 pari_printf(" end of qpsoluble 1\n");
4897 avma = ltop;
4898 return 1;
4899 }
4900 if (psquare(polcoeff0(pol, 0, -1), p, prec))
4901 {
4902 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
4903 pari_printf(" end of qpsoluble 1\n");
4904 avma = ltop;
4905 return 1;
4906 }
4907 if (zpsoluble(pol, p, gen_0, gen_1, gen_0, gen_0, prec))
4908 {
4909 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
4910 pari_printf(" end of qpsoluble 1\n");
4911 avma = ltop;
4912 return 1;
4913 }
4914 if (zpsoluble(polrecip(pol), p, gen_1, p, gen_0, gen_0, prec))
4915 {
4916 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
4917 pari_printf(" end of qpsoluble 1\n");
4918 avma = ltop;
4919 return 1;
4920 }
4921 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
4922 pari_printf(" end of qpsoluble 0\n");
4923 avma = ltop;
4924 return 0;
4925 }
4926
4927 long
4928 locallysoluble(GEN pol, long prec)
4929 {
4930 pari_sp ltop = avma;
4931 GEN c = gen_0, disc0 = gen_0, plist = gen_0, p = gen_0, vc = gen_0;
4932 long l1;
4933 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
4934 pari_printf(" starting locallysoluble :%Ps\n", pol);
4935 /* real place */
4936 if ((((!smodss(degree(pol), 2)) && (gsigne(pollead(pol, -1)) < 0)) && (gsigne(polcoeff0(pol, 0, -1)) < 0)) && (sturmpart(pol, NULL, NULL) == 0))
4937 {
4938 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
4939 pari_printf(" not ELS at infinity\n");
4940 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
4941 pari_printf(" end of locallysoluble\n");
4942 avma = ltop;
4943 return 0;
4944 }
4945 /* */
4946 /* finite places */
4947 /* */
4948 pol = gmul(/* */
4949 /* finite places */
4950 /* */
4951 pol, gsqr(denom(content(pol))));
4952 c = content(pol);
4953 disc0 = poldisc0(pol, -1);
4954 plist = factor(gabs(gmulsg(2, disc0), prec));
4955 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
4956 pari_printf(" list of bad primes = %Ps\n", plist);
4957 l1 = glength(gel(plist, 1));
4958 {
4959 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
4960 long i;
4961 for (i = 1; i <= l1; ++i)
4962 {
4963 p = gcopy(gcoeff(plist, i, 1));
4964 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
4965 pari_printf(" p = %Ps\n", p);
4966 vc = stoi(ggval(c, p));
4967 if (gcmpgs(vc, 2) >= 0)
4968 {
4969 pol = gdiv(pol, gpow(p, gmulsg(2, gdiventgs(vc, 2)), prec));
4970 gcoeff(plist, i, 2) = gsub(gcoeff(plist, i, 2), gmulgs(gmulsg(2, gdiventgs(vc, 2)), (2*degree(pol)) - 2));
4971 }
4972 if (((degree(pol) == 4) && !gequalgs(p, 2)) && (gcmpgs(gcoeff(plist, i, 2), 2) < 0))
4973 continue;
4974 if (!qpsoluble(pol, p, prec))
4975 {
4976 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
4977 pari_printf(" not ELS at %Ps\n", p);
4978 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
4979 pari_printf(" end of locallysoluble\n");
4980 avma = ltop;
4981 return 0;
4982 }
4983 if (low_stack(st_lim, stack_lim(btop, 1)))
4984 gerepileall(btop, 4, &p, &vc, &pol, &plist);
4985 }
4986 }
4987 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
4988 pari_printf(" quartic ELS : Y^2 = %Ps\n", pol);
4989 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
4990 pari_printf(" end of locallysoluble\n");
4991 avma = ltop;
4992 return 1;
4993 }
4994
4995 GEN
4996 LS2localimage(GEN nf, GEN gen, GEN pp, long prec)
4997 {
4998 pari_sp ltop = avma;
4999 GEN p = gen_0, LS2image = gen_0, ph = gen_0, ival = gen_0, delta = gen_0;
5000 long l1;
5001 GEN p2 = gen_0;
5002 long l3;
5003 GEN p4 = gen_0;
5004 GEN p5 = gen_0; /* vec */
5005 long l6;
5006 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
5007 pari_printf(" starting LS2localimage\n");
5008 p = icopy(member_p(gel(gel(pp, 1), 1)));
5009 l1 = glength(gen);
5010 if (gequalgs(p, 2))
5011 {
5012 l3 = glength(pp);
5013 {
5014 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
5015 long i;
5016 p4 = gen_0;
5017 for (i = 1; i <= l3; ++i)
5018 {
5019 p4 = gaddgs(p4, (1 + lg(member_cyc(gel(gel(pp, i), 3))))-1);
5020 if (low_stack(st_lim, stack_lim(btop, 1)))
5021 p4 = gerepilecopy(btop, p4);
5022 }
5023 }
5024 p2 = p4;
5025 }
5026 else
5027 p2 = stoi(2*glength(pp));
5028 {
5029 long l7, l8;
5030 p5 = cgetg(l1+1, t_MAT);
5031 for (l8 = 1; l8 <= l1; ++l8)
5032 {
5033 gel(p5, l8) = cgetg(gtos(p2)+1, t_COL);
5034 for (l7 = 1; gcmpsg(l7, p2) <= 0; ++l7)
5035 gcoeff(p5, l7, l8) = gen_0;
5036 }
5037 }
5038 LS2image = p5;
5039 l6 = glength(gen);
5040 {
5041 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
5042 long j, l9;
5043 for (j = 1; j <= l6; ++j)
5044 {
5045 ph = cgetg(1, t_VEC);
5046 l9 = glength(pp);
5047 {
5048 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
5049 long i;
5050 GEN p10 = gen_0, p11 = gen_0; /* vec */
5051 for (i = 1; i <= l9; ++i)
5052 {
5053 ival = stoi(idealval(nf, gel(gen, j), gel(gel(pp, i), 1)));
5054 p10 = cgetg(2, t_VEC);
5055 gel(p10, 1) = gcopy(ival);
5056 ph = concat(ph, p10);
5057 delta = gdiv(gel(gen, j), gpow(gel(gel(pp, i), 2), ival, prec));
5058 if (gequalgs(p, 2))
5059 ph = concat(ph, gtrans(ideallog(nf, delta, gel(gel(pp, i), 3))));
5060 else
5061 {
5062 p11 = cgetg(2, t_VEC);
5063 gel(p11, 1) = stoi(1 - nfpsquareoddQ(nf, delta, gel(gel(pp, i), 4), prec));
5064 ph = concat(ph, p11);
5065 }
5066 if (low_stack(st_lim, stack_lim(btop, 1)))
5067 gerepileall(btop, 5, &ival, &p10, &ph, &delta, &p11);
5068 }
5069 }
5070 gel(LS2image, j) = gtrans(ph);
5071 if (low_stack(st_lim, stack_lim(btop, 1)))
5072 gerepileall(btop, 4, &ph, &ival, &delta, &LS2image);
5073 }
5074 }
5075 LS2image = gmul(LS2image, gmodulss(1, 2));
5076 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
5077 pari_printf(" LS2image = %Ps\n", lift(LS2image));
5078 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
5079 pari_printf(" end of LS2localimage\n");
5080 LS2image = gerepilecopy(ltop, LS2image);
5081 return LS2image;
5082 }
5083
5084 GEN
5085 ellhalf(GEN ell, GEN P, long prec)
5086 {
5087 pari_sp ltop = avma;
5088 GEN pol2 = gen_0, ratroots = gen_0, half = gen_0, x2 = gen_0, y2 = gen_0, P2 = gen_0;
5089 GEN p1 = gen_0, p2 = gen_0; /* vec */
5090 long l3;
5091 GEN p4 = gen_0, p5 = gen_0, p6 = gen_0, p7 = gen_0; /* vec */
5092 long l8;
5093 if (glength(ell) < 13)
5094 ell = smallellinit(ell);
5095 p1 = cgetg(5, t_VEC);
5096 gel(p1, 1) = stoi(4);
5097 gel(p1, 2) = gcopy(ell_get_b2(ell));
5098 gel(p1, 3) = gmulsg(2, ell_get_b4(ell));
5099 gel(p1, 4) = gcopy(ell_get_b6(ell));
5100 pol2 = gtopoly(p1, -1);
5101 /* 2-division polynomial */
5102
5103 p2 = cgetg(2, t_VEC);
5104 gel(p2, 1) = gen_0;
5105 if (gequal(P, p2))
5106 {
5107 ratroots = polratroots(pol2);
5108 l3 = glength(ratroots);
5109 {
5110 long i;
5111 GEN p9 = gen_0; /* vec */
5112 p4 = cgetg(l3+1, t_VEC);
5113 for (i = 1; i <= l3; ++i)
5114 {
5115 p9 = cgetg(3, t_VEC);
5116 gel(p9, 1) = gcopy(gel(ratroots, i));
5117 gel(p9, 2) = gdivgs(gneg(gadd(gmul(ell_get_a1(ell), gel(ratroots, i)), ell_get_a3(ell))), 2);
5118 gel(p4, i) = p9;
5119 }
5120 }
5121 half = p4;
5122 p5 = cgetg(2, t_VEC);
5123 p6 = cgetg(2, t_VEC);
5124 gel(p6, 1) = gen_0;
5125 gel(p5, 1) = p6;
5126 half = concat(p5, half);
5127 half = gerepilecopy(ltop, half);
5128 return half;
5129 }
5130 p7 = cgetg(6, t_VEC);
5131 gel(p7, 1) = gen_1;
5132 gel(p7, 2) = gen_0;
5133 gel(p7, 3) = gneg(ell_get_b4(ell));
5134 gel(p7, 4) = gmulsg(-2, ell_get_b6(ell));
5135 gel(p7, 5) = gneg(ell_get_b8(ell));
5136 x2 = gtopoly(p7, -1);
5137 /* x(2P) = x2/pol2 */
5138
5139 half = cgetg(1, t_VEC);
5140 ratroots = polratroots(gsub(x2, gmul(gel(P, 1), pol2)));
5141 if (glength(ratroots) == 0)
5142 {
5143 half = gerepilecopy(ltop, half);
5144 return half;
5145 }
5146 l8 = glength(ratroots);
5147 {
5148 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
5149 long i, l10;
5150 for (i = 1; i <= l8; ++i)
5151 {
5152 y2 = ellordinate(ell, gel(ratroots, i), prec);
5153 l10 = glength(y2);
5154 {
5155 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
5156 long j;
5157 GEN p11 = gen_0, p12 = gen_0; /* vec */
5158 for (j = 1; j <= l10; ++j)
5159 {
5160 p11 = cgetg(3, t_VEC);
5161 gel(p11, 1) = gcopy(gel(ratroots, i));
5162 gel(p11, 2) = gcopy(gel(y2, j));
5163 P2 = p11;
5164 if (gequal(powell(ell, P2, gen_2), P))
5165 {
5166 p12 = cgetg(2, t_VEC);
5167 gel(p12, 1) = gcopy(P2);
5168 half = concat(half, p12);
5169 }
5170 if (low_stack(st_lim, stack_lim(btop, 1)))
5171 gerepileall(btop, 4, &p11, &P2, &p12, &half);
5172 }
5173 }
5174 if (low_stack(st_lim, stack_lim(btop, 1)))
5175 gerepileall(btop, 3, &y2, &P2, &half);
5176 }
5177 }
5178 half = gerepilecopy(ltop, half);
5179 return half;
5180 }
5181
5182 GEN
5183 elltors2(GEN ell, long prec)
5184 {
5185 pari_sp ltop = avma;
5186 GEN tors2 = gen_0;
5187 GEN p1 = gen_0, p2 = gen_0, p3 = gen_0, p4 = gen_0, p5 = gen_0, p6 = gen_0, p7 = gen_0, p8 = gen_0; /* vec */
5188 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
5189 pari_printf(" computing the 2-torsion\n");
5190 p1 = cgetg(2, t_VEC);
5191 gel(p1, 1) = gen_0;
5192 tors2 = ellhalf(ell, p1, prec);
5193 if (glength(tors2) == 1)
5194 {
5195 p2 = cgetg(4, t_VEC);
5196 gel(p2, 1) = gen_1;
5197 gel(p2, 2) = cgetg(1, t_VEC);
5198 gel(p2, 3) = cgetg(1, t_VEC);
5199 tors2 = p2;
5200 }
5201 else
5202 {
5203 if (glength(tors2) == 2)
5204 {
5205 p3 = cgetg(4, t_VEC);
5206 gel(p3, 1) = gen_2;
5207 p4 = cgetg(2, t_VEC);
5208 gel(p4, 1) = gen_2;
5209 gel(p3, 2) = p4;
5210 p5 = cgetg(2, t_VEC);
5211 gel(p5, 1) = gcopy(gel(tors2, 2));
5212 gel(p3, 3) = p5;
5213 tors2 = p3;
5214 }
5215 else
5216 {
5217 p6 = cgetg(4, t_VEC);
5218 gel(p6, 1) = stoi(4);
5219 p7 = cgetg(3, t_VEC);
5220 gel(p7, 1) = gen_2;
5221 gel(p7, 2) = gen_2;
5222 gel(p6, 2) = p7;
5223 p8 = cgetg(3, t_VEC);
5224 gel(p8, 1) = gcopy(gel(tors2, 2));
5225 gel(p8, 2) = gcopy(gel(tors2, 3));
5226 gel(p6, 3) = p8;
5227 tors2 = p6;
5228 }
5229 }
5230 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
5231 pari_printf(" E[2] = %Ps\n", tors2);
5232 tors2 = gerepilecopy(ltop, tors2);
5233 return tors2;
5234 }
5235
5236 GEN
5237 elltorseven(GEN ell, long prec)
5238 {
5239 pari_sp ltop = avma;
5240 GEN torseven = gen_0, P2 = gen_0;
5241 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
5242 pari_printf(" computing the 2^n-torsion\n");
5243 if (glength(ell) < 13)
5244 ell = smallellinit(ell);
5245 torseven = elltors2(ell, prec);
5246 {
5247 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
5248 while (!gequalgs(gel(torseven, 1), 1))
5249 {
5250 P2 = ellhalf(ell, gel(gel(torseven, 3), 1), prec);
5251 if (glength(P2) > 0)
5252 {
5253 gel(torseven, 1) = gmulgs(gel(torseven, 1), 2);
5254 gel(gel(torseven, 2), 1) = gmulgs(gel(gel(torseven, 2), 1), 2);
5255 gel(gel(torseven, 3), 1) = gcopy(gel(P2, 1));
5256 continue;
5257 }
5258 if (glength(gel(torseven, 3)) == 1)
5259 break;
5260 P2 = ellhalf(ell, gel(gel(torseven, 3), 2), prec);
5261 if (glength(P2) > 0)
5262 {
5263 gel(torseven, 1) = gmulgs(gel(torseven, 1), 2);
5264 gel(gel(torseven, 2), 2) = gmulgs(gel(gel(torseven, 2), 2), 2);
5265 gel(gel(torseven, 3), 2) = gcopy(gel(P2, 1));
5266 continue;
5267 }
5268 P2 = ellhalf(ell, addell(ell, gel(gel(torseven, 3), 1), gel(gel(torseven, 3), 2)), prec);
5269 if (glength(P2) > 0)
5270 {
5271 gel(torseven, 1) = gmulgs(gel(torseven, 1), 2);
5272 gel(gel(torseven, 2), 1) = gmulgs(gel(gel(torseven, 2), 1), 2);
5273 gel(gel(torseven, 3), 1) = gcopy(gel(P2, 1));
5274 continue;
5275 }
5276 break;
5277 if (low_stack(st_lim, stack_lim(btop, 1)))
5278 gerepileall(btop, 2, &P2, &torseven);
5279 }
5280 }
5281 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
5282 pari_printf(" E[2^n] = %Ps\n", torseven);
5283 torseven = gerepilecopy(ltop, torseven);
5284 return torseven;
5285 }
5286
5287 GEN
5288 ellsort(GEN listpts, long prec) /* vec */
5289 {
5290 pari_sp ltop = avma;
5291 GEN n = gen_0, v = gen_0, aux = gen_0, ord = gen_0, p1 = gen_0;
5292 GEN p2 = gen_0, p3 = gen_0; /* vec */
5293 p1 = n = stoi(glength(listpts));
5294 {
5295 long l4;
5296 p2 = cgetg(gtos(p1)+1, t_VEC);
5297 for (l4 = 1; gcmpsg(l4, p1) <= 0; ++l4)
5298 gel(p2, l4) = gen_0;
5299 }
5300 v = p2;
5301 {
5302 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
5303 GEN i = gen_0;
5304 GEN p5 = gen_0, p6 = gen_0, p7 = gen_0; /* vec */
5305 for (i = gen_1; gcmp(i, n) <= 0; i = gaddgs(i, 1))
5306 {
5307 p5 = cgetg(2, t_VEC);
5308 gel(p5, 1) = gen_0;
5309 if (gequal(gel(listpts, gtos(i)), p5))
5310 {
5311 p6 = cgetg(4, t_VEC);
5312 gel(p6, 1) = gen_0;
5313 gel(p6, 2) = gen_0;
5314 gel(p6, 3) = gen_0;
5315 gel(v, gtos(i)) = p6;
5316 continue;
5317 }
5318 aux = gdiv(denom(gel(gel(listpts, gtos(i)), 2)), denom(gel(gel(listpts, gtos(i)), 1)));
5319 p7 = cgetg(4, t_VEC);
5320 gel(p7, 1) = gmul(gel(gel(listpts, gtos(i)), 1), gsqr(aux));
5321 gel(p7, 2) = gmul(gel(gel(listpts, gtos(i)), 2), gpowgs(aux, 3));
5322 gel(p7, 3) = gcopy(aux);
5323 gel(v, gtos(i)) = vecsort0(gabs(p7, prec), NULL, 4);
5324 if (low_stack(st_lim, stack_lim(btop, 1)))
5325 gerepileall(btop, 6, &i, &p5, &p6, &v, &aux, &p7);
5326 }
5327 }
5328 ord = gtovec(vecsort0(v, NULL, 3));
5329 /* MODI Needed for gp2c */
5330 {
5331 long i;
5332 p3 = cgetg(gtos(n)+1, t_VEC);
5333 for (i = 1; gcmpsg(i, n) <= 0; ++i)
5334 gel(p3, i) = gcopy(gel(listpts, gtos(gel(ord, i))));
5335 }
5336 p3 = gerepilecopy(ltop, p3);
5337 return p3;
5338 }
5339
5340 GEN
5341 ellremovetorsion(GEN ell, GEN listgen)
5342 {
5343 pari_sp ltop = avma;
5344 GEN d = gen_0, extra = gen_0;
5345 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
5346 pari_printf(" removing torsion from %Ps\n", listgen);
5347 d = stoi(glength(listgen));
5348 extra = gen_0;
5349 {
5350 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
5351 GEN i = gen_0;
5352 GEN p1 = gen_0, p2 = gen_0; /* vec */
5353 for (i = gen_1; gcmp(i, d) <= 0; i = gaddgs(i, 1))
5354 {
5355 /* points of order 1 or 2 */
5356 p1 = cgetg(2, t_VEC);
5357 gel(p1, 1) = gen_0;
5358 if (gequal(gel(listgen, gtos(i)), p1) || gequal(gel(listgen, gtos(i)), powell(ell, gel(listgen, gtos(i)), gen_m1)))
5359 {
5360 extra = gadd(extra, shifti(gen_1, gtos(gsubgs(i, 1))));
5361 continue;
5362 }
5363 /* detection of infinite order points by looking at */
5364 /* 8*9*5*7*P modulo the prime 1048583 */
5365 p2 = cgetg(2, t_VEC);
5366 gel(p2, 1) = gen_0;
5367 if ((!gequalgs(gmodgs(member_disc(ell), 1048583), 0) && !gequalgs(gmodgs(denom(gel(listgen, gtos(i))), 1048583), 0)) && !gequal(powell(ell, gmul(gel(listgen, gtos(i)), gmodulss(1, 1048583)), stoi(2520)), p2))
5368 continue;
5369 /* detection of torsion points by ellorder() */
5370 if (!gequal0(ellorder(ell, gel(listgen, gtos(i)), NULL)))
5371 extra = gadd(extra, shifti(gen_1, gtos(gsubgs(i, 1))));
5372 if (low_stack(st_lim, stack_lim(btop, 1)))
5373 gerepileall(btop, 4, &i, &p1, &extra, &p2);
5374 }
5375 }
5376 if (!gequal0(extra))
5377 listgen = extract0(listgen, gsub(subis(shifti(gen_1, glength(listgen)), 1), extra), NULL);
5378 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
5379 pari_printf(" without torsion = %Ps\n", listgen);
5380 listgen = gerepilecopy(ltop, listgen);
5381 return listgen;
5382 }
5383
5384 GEN
5385 ellredgen(GEN ell0, GEN listgen, GEN K, long prec)
5386 {
5387 pari_sp ltop = avma;
5388 GEN d = gen_0, ell = gen_0, sqrtK = gen_0, urst = gen_0, extra = gen_0, M = gen_0, U = gen_0, listgen2 = gen_0, tors2 = gen_0, vt = gen_0;
5389 GEN p1 = gen_0, p2 = gen_0, p3 = gen_0, p4 = gen_0, p5 = gen_0; /* vec */
5390 GEN p6 = gen_0;
5391 GEN p7 = gen_0; /* vec */
5392 long l8;
5393 GEN p9 = gen_0; /* vec */
5394 if (!K)
5395 K = gen_1;
5396 listgen = gcopy(listgen);
5397 ell = gcopy(ell0);
5398 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
5399 pari_printf(" Reduction of the generators %Ps\n", listgen);
5400 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
5401 pari_printf(" ell=%Ps\n", ell);
5402 d = stoi(glength(listgen));
5403 if (gequal0(d))
5404 {
5405 p1 = cgetg(1, t_VEC);
5406 p1 = gerepilecopy(ltop, p1);
5407 return p1;
5408 }
5409 /* removing torsion points from listgen */
5410 listgen = ellremovetorsion(ell0, listgen);
5411 d = stoi(glength(listgen));
5412 if (gequal0(d))
5413 {
5414 p2 = cgetg(1, t_VEC);
5415 p2 = gerepilecopy(ltop, p2);
5416 return p2;
5417 }
5418 if (glength(ell) < 13)
5419 ell = smallellinit(ell);
5420 if (!gequalgs(K, 1))
5421 {
5422 if (!gequalgs(ell_get_a1(ell), 0) || !gequalgs(ell_get_a3(ell), 0))
5423 pari_err(user, " ellredgen : a1*a3 != 0");
5424 gel(ell, 2) = gmul(gel(ell, 2), K);
5425 gel(ell, 4) = gmul(gel(ell, 4), gsqr(K));
5426 gel(ell, 5) = gmul(gel(ell, 5), gpowgs(K, 3));
5427 gel(ell, 6) = gmul(gel(ell, 6), K);
5428 gel(ell, 7) = gmul(gel(ell, 7), gsqr(K));
5429 gel(ell, 8) = gmul(gel(ell, 8), gpowgs(K, 3));
5430 gel(ell, 9) = gmul(gel(ell, 9), gpowgs(K, 4));
5431 gel(ell, 10) = gmul(gel(ell, 10), gsqr(K));
5432 gel(ell, 11) = gmul(gel(ell, 11), gpowgs(K, 3));
5433 gel(ell, 12) = gmul(gel(ell, 12), gpowgs(K, 6));
5434 sqrtK = gsqrt(K, prec);
5435 if (glength(ell) == 19)
5436 {
5437 gel(ell, 14) = gmul(gel(ell, 14), K);
5438 gel(ell, 15) = gdiv(gel(ell, 15), sqrtK);
5439 gel(ell, 16) = gdiv(gel(ell, 16), sqrtK);
5440 gel(ell, 17) = gmul(gel(ell, 17), sqrtK);
5441 gel(ell, 18) = gmul(gel(ell, 18), sqrtK);
5442 gel(ell, 19) = gdiv(gel(ell, 19), K);
5443 }
5444 {
5445 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
5446 GEN i = gen_0;
5447 long l10;
5448 for (i = gen_1; gcmp(i, d) <= 0; i = gaddgs(i, 1))
5449 {
5450 l10 = glength(gel(listgen, gtos(i)));
5451 {
5452 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
5453 long j;
5454 for (j = 1; j <= l10; ++j)
5455 {
5456 gel(gel(listgen, gtos(i)), j) = gmul(gel(gel(listgen, gtos(i)), j), gpowgs(K, j));
5457 if (low_stack(st_lim, stack_lim(btop, 1)))
5458 listgen = gerepilecopy(btop, listgen);
5459 }
5460 }
5461 if (low_stack(st_lim, stack_lim(btop, 1)))
5462 gerepileall(btop, 2, &i, &listgen);
5463 }
5464 }
5465 }
5466 if (gequal1(d))
5467 {
5468 p3 = cgetg(5, t_VEC);
5469 gel(p3, 1) = gen_1;
5470 gel(p3, 2) = gen_0;
5471 gel(p3, 3) = gen_0;
5472 gel(p3, 4) = gen_0;
5473 urst = p3;
5474 }
5475 else
5476 {
5477 if (glength(ell) < 19)
5478 ell = ellinit(ell, prec);
5479 ell = ellminimalmodel(ell, &urst);
5480 listgen = ellchangepoint(listgen, urst);
5481 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
5482 pari_printf(" ell = %Ps\n", ell);
5483 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
5484 pari_printf(" listgen = %Ps\n", listgen);
5485 /* Looking for relations between the points in listgen */
5486 /* using LLL on the height matrix */
5487
5488 extra = gen_1;
5489 {
5490 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
5491 GEN p11 = gen_0; /* vec */
5492 while (!gequal0(extra))
5493 {
5494 M = mathell(ell, listgen, prec);
5495 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
5496 pari_printf(" height matrix = %Ps\n", M);
5497 if (gcmp(gabs(det(M), prec), gpowgs(stoi(10), (-getrealprecision()) + 10)) > 0)
5498 break;
5499 U = lllkerim(ground(gmul(M, gpowgs(stoi(10), getrealprecision() - 10))));
5500 U = concat(gel(U, 1), gel(U, 2));
5501 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
5502 pari_printf(" change of basis proposed by LLL = %Ps\n", U);
5503 /* the columns of U that have very small coefficients */
5504 /* are either exact relations or reductions (coeff <= 20) */
5505 /* the other ones are irrelevant. */
5506 extra = gen_0;
5507 {
5508 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
5509 GEN i = gen_0;
5510 for (i = gen_1; gcmp(i, d) <= 0; i = gaddgs(i, 1))
5511 {
5512 if (gcmpgs(vecmax(gabs(gel(U, gtos(i)), prec)), 20) > 0)
5513 extra = gadd(extra, shifti(gen_1, gtos(gsubgs(i, 1))));
5514 if (low_stack(st_lim, stack_lim(btop, 1)))
5515 gerepileall(btop, 2, &i, &extra);
5516 }
5517 }
5518 U = extract0(U, gsub(subis(shifti(gen_1, gtos(d)), 1), extra), NULL);
5519 U = completebasis(U, NULL);
5520 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
5521 pari_printf(" change of basis 1 = %Ps\n", U);
5522 {
5523 long l12;
5524 p11 = cgetg(gtos(d)+1, t_VEC);
5525 for (l12 = 1; gcmpsg(l12, d) <= 0; ++l12)
5526 gel(p11, l12) = gen_0;
5527 }
5528 listgen2 = p11;
5529 {
5530 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
5531 GEN i = gen_0;
5532 GEN p13 = gen_0; /* vec */
5533 for (i = gen_1; gcmp(i, d) <= 0; i = gaddgs(i, 1))
5534 {
5535 p13 = cgetg(2, t_VEC);
5536 gel(p13, 1) = gen_0;
5537 gel(listgen2, gtos(i)) = p13;
5538 {
5539 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
5540 GEN j = gen_0;
5541 for (j = gen_1; gcmp(j, d) <= 0; j = gaddgs(j, 1))
5542 {
5543 gel(listgen2, gtos(i)) = addell(ell, gel(listgen2, gtos(i)), powell(ell, gel(listgen, gtos(j)), gcoeff(U, gtos(j), gtos(i))));
5544 if (low_stack(st_lim, stack_lim(btop, 1)))
5545 gerepileall(btop, 2, &j, &listgen2);
5546 }
5547 }
5548 if (low_stack(st_lim, stack_lim(btop, 1)))
5549 gerepileall(btop, 3, &i, &p13, &listgen2);
5550 }
5551 }
5552 listgen = gcopy(listgen2);
5553 if (low_stack(st_lim, stack_lim(btop, 1)))
5554 gerepileall(btop, 6, &M, &U, &extra, &p11, &listgen2, &listgen);
5555 }
5556 }
5557 /* Extracting the points of infinite order */
5558
5559 /* removing torsion points from listgen */
5560 listgen = ellremovetorsion(ell, listgen);
5561 d = stoi(glength(listgen));
5562 if (gequal0(d))
5563 {
5564 p4 = cgetg(1, t_VEC);
5565 p4 = gerepilecopy(ltop, p4);
5566 return p4;
5567 }
5568 }
5569 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
5570 pari_printf(" infinite order points = %Ps\n", listgen);
5571 /* Now, the points should be of infinite order and independant */
5572 /* Reducing the points of infinite order */
5573
5574 if (gcmpgs(d, 1) > 0)
5575 {
5576 M = mathell(ell, listgen, prec);
5577 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
5578 pari_printf(" height matrix = %Ps\n", M);
5579 U = qflllgram0(M, 0);
5580 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
5581 pari_printf(" change of basis 2 = %Ps\n", U);
5582 {
5583 long l14;
5584 p5 = cgetg(gtos(d)+1, t_VEC);
5585 for (l14 = 1; gcmpsg(l14, d) <= 0; ++l14)
5586 gel(p5, l14) = gen_0;
5587 }
5588 listgen2 = p5;
5589 {
5590 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
5591 GEN i = gen_0;
5592 GEN p15 = gen_0; /* vec */
5593 for (i = gen_1; gcmp(i, d) <= 0; i = gaddgs(i, 1))
5594 {
5595 p15 = cgetg(2, t_VEC);
5596 gel(p15, 1) = gen_0;
5597 gel(listgen2, gtos(i)) = p15;
5598 {
5599 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
5600 GEN j = gen_0;
5601 for (j = gen_1; gcmp(j, d) <= 0; j = gaddgs(j, 1))
5602 {
5603 gel(listgen2, gtos(i)) = addell(ell, gel(listgen2, gtos(i)), powell(ell, gel(listgen, gtos(j)), gcoeff(U, gtos(j), gtos(i))));
5604 if (low_stack(st_lim, stack_lim(btop, 1)))
5605 gerepileall(btop, 2, &j, &listgen2);
5606 }
5607 }
5608 if (low_stack(st_lim, stack_lim(btop, 1)))
5609 gerepileall(btop, 3, &i, &p15, &listgen2);
5610 }
5611 }
5612 listgen = gcopy(listgen2);
5613 }
5614 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
5615 pari_printf(" infinite order points = %Ps\n", listgen);
5616 listgen = ellchangepointinverse(listgen, urst);
5617 /* Reducing modulo the 2-torsion */
5618
5619 tors2 = elltorseven(ell0, prec);
5620 if (gcmpgs(gel(tors2, 1), 1) > 0)
5621 {
5622 p6 = gcopy(gel(gel(tors2, 2), 1));
5623 {
5624 long j;
5625 p7 = cgetg(gtos(p6)+1, t_VEC);
5626 for (j = 1; gcmpsg(j, p6) <= 0; ++j)
5627 gel(p7, j) = powell(ell0, gel(gel(tors2, 3), 1), stoi(j - 1));
5628 }
5629 vt = p7;
5630 if (glength(gel(tors2, 2)) == 2)
5631 {
5632 l8 = glength(vt);
5633 {
5634 long j;
5635 p9 = cgetg(l8+1, t_VEC);
5636 for (j = 1; j <= l8; ++j)
5637 gel(p9, j) = addell(ell0, gel(vt, j), gel(gel(tors2, 3), 2));
5638 }
5639 vt = concat(vt, p9);
5640 }
5641 {
5642 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
5643 GEN i = gen_0;
5644 long l16;
5645 GEN p17 = gen_0; /* vec */
5646 for (i = gen_1; gcmp(i, d) <= 0; i = gaddgs(i, 1))
5647 {
5648 l16 = glength(vt);
5649 {
5650 long j;
5651 p17 = cgetg(l16+1, t_VEC);
5652 for (j = 1; j <= l16; ++j)
5653 gel(p17, j) = addell(ell0, gel(listgen, gtos(i)), gel(vt, j));
5654 }
5655 gel(listgen, gtos(i)) = gcopy(gel(ellsort(p17, prec), 1));
5656 if (low_stack(st_lim, stack_lim(btop, 1)))
5657 gerepileall(btop, 3, &i, &p17, &listgen);
5658 }
5659 }
5660 }
5661 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
5662 pari_printf(" infinite order points = %Ps\n", listgen);
5663 if (!gequalgs(K, 1))
5664 {
5665 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
5666 GEN i = gen_0;
5667 for (i = gen_1; gcmp(i, d) <= 0; i = gaddgs(i, 1))
5668 {
5669 {
5670 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
5671 long j;
5672 for (j = 1; j <= 2; ++j)
5673 {
5674 gel(gel(listgen, gtos(i)), j) = gdiv(gel(gel(listgen, gtos(i)), j), gpowgs(K, j));
5675 if (low_stack(st_lim, stack_lim(btop, 1)))
5676 listgen = gerepilecopy(btop, listgen);
5677 }
5678 }
5679 if (low_stack(st_lim, stack_lim(btop, 1)))
5680 gerepileall(btop, 2, &i, &listgen);
5681 }
5682 }
5683 /* keep only the points (x,y) with y >= 0 */
5684
5685 if (gequal0(ell_get_a1(ell0)) && gequal0(ell_get_a3(ell0)))
5686 {
5687 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
5688 GEN i = gen_0;
5689 for (i = gen_1; gcmp(i, d) <= 0; i = gaddgs(i, 1))
5690 {
5691 if (glength(gel(listgen, gtos(i))) == 2)
5692 gel(gel(listgen, gtos(i)), 2) = gabs(gel(gel(listgen, gtos(i)), 2), prec);
5693 if (low_stack(st_lim, stack_lim(btop, 1)))
5694 gerepileall(btop, 2, &i, &listgen);
5695 }
5696 }
5697 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
5698 pari_printf(" reduced generators = %Ps\n", listgen);
5699 listgen = gerepilecopy(ltop, listgen);
5700 return listgen;
5701 }
5702
5703 GEN
5704 reducemodsquares(GEN delta, GEN d, long prec)
5705 {
5706 pari_sp ltop = avma;
5707 GEN deg = gen_0, xx = gen_0, z = gen_0, qd = gen_0, Qd = gen_0, reduc = gen_0, x = pol_x(fetch_user_var("x"));
5708 GEN p1 = gen_0, p2 = gen_0; /* vec */
5709 GEN p3 = gen_0;
5710 deg = stoi(degree(compo(delta, 1)));
5711 /* MODI to make gp2c happy */
5712 xx = gmodulo(x, compo(delta, 1));
5713 {
5714 long i;
5715 p1 = cgetg(gtos(deg)+1, t_VEC);
5716 for (i = 1; gcmpsg(i, deg) <= 0; ++i)
5717 gel(p1, i) = geval(concat(strtoGENstr("a"), stoi(i)));
5718 }
5719 z = gsubst(gtopoly(p1, -1), gvar(x), xx);
5720 qd = polcoeff0(lift(gmul(delta, gsqr(z))), gtos(d), gvar(x));
5721 {
5722 long i, j;
5723 p2 = cgetg(gtos(deg)+1, t_MAT);
5724 for (j = 1; gcmpsg(j, deg) <= 0; ++j)
5725 {
5726 gel(p2, j) = cgetg(gtos(deg)+1, t_COL);
5727 for (i = 1; gcmpsg(i, deg) <= 0; ++i)
5728 gcoeff(p2, i, j) = gdivgs(deriv(deriv(qd, gvar(geval(concat(strtoGENstr("a"), stoi(i))))), gvar(geval(concat(strtoGENstr("a"), stoi(j))))), 2);
5729 }
5730 }
5731 Qd = simplify(p2);
5732 reduc = IndefiniteLLL(Qd, NULL, NULL, prec);
5733 if (glength(reduc) == 2)
5734 reduc = gcopy(gel(gel(reduc, 2), 1));
5735 p3 = gmul(delta, gsqr(gsubst(gtopoly(reduc, -1), gvar(x), xx)));
5736 p3 = gerepilecopy(ltop, p3);
5737 return p3;
5738 }
5739
5740 GEN
5741 bnfpSelmer(GEN bnf, GEN S, GEN p, long prec) /* vec */
5742 {
5743 pari_sp ltop = avma;
5744 GEN S1 = gen_0, oddclass = gen_0, multS = gen_0, Slist = gen_0, LS2gen = gen_0, newprimes = gen_0, newprimesval = gen_0, kerval = gen_0;
5745 long l1, l2, l3;
5746 GEN p4 = gen_0; /* vec */
5747 long l5;
5748 GEN p6 = gen_0, p7 = gen_0, p8 = gen_0; /* vec */
5749 if (!S)
5750 S = gen_1;
5751 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
5752 pari_printf(" Constructing the field Selmer group : L(S,%Ps)\n", p);
5753 S1 = idealhnf0(bnf, S, NULL);
5754 oddclass = gen_0;
5755 multS = gen_1;
5756 {
5757 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
5758 while (gequal0(oddclass))
5759 {
5760 if (!gequalgs(multS, 1))
5761 S1 = idealmul(bnf, S1, multS);
5762 Slist = gtrans(gel(idealfactor(bnf, S1), 1));
5763 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
5764 pari_printf(" constructing the S-units \n");
5765 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
5766 pari_printf(" S1 = %Ps\n", Slist);
5767 LS2gen = bnfsunit(bnf, Slist, prec);
5768 /* If the class group is divisible by p, */
5769 /* need to enlarge S1. */
5770 oddclass = gmod(member_no(gel(LS2gen, 5)), p);
5771 if (gequal0(oddclass))
5772 {
5773 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
5774 pari_printf(" class group divisible by p = %Ps\n", member_no(gel(LS2gen, 5)));
5775 multS = idealmul(bnf, S, gel(member_gen(gel(LS2gen, 5)), 1));
5776 }
5777 if (low_stack(st_lim, stack_lim(btop, 1)))
5778 gerepileall(btop, 5, &S1, &Slist, &LS2gen, &oddclass, &multS);
5779 }
5780 }
5781 LS2gen = gmodulo(gel(LS2gen, 1), member_pol(bnf));
5782 /* The valuation of the generators must be divisible by p outside S. */
5783 newprimes = cgetg(1, t_VEC);
5784 l1 = glength(Slist);
5785 {
5786 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
5787 long i;
5788 GEN p9 = gen_0; /* vec */
5789 for (i = 1; i <= l1; ++i)
5790 {
5791 if (gequal1(idealadd(bnf, S, gel(Slist, i))))
5792 {
5793 p9 = cgetg(2, t_VEC);
5794 gel(p9, 1) = gcopy(gel(Slist, i));
5795 newprimes = concat(newprimes, p9);
5796 }
5797 if (low_stack(st_lim, stack_lim(btop, 1)))
5798 gerepileall(btop, 2, &p9, &newprimes);
5799 }
5800 }
5801 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
5802 pari_printf(" newprimes = %Ps\n", newprimes);
5803 l2 = glength(LS2gen);
5804 l3 = glength(newprimes);
5805 {
5806 long i, j;
5807 p4 = cgetg(l2+1, t_MAT);
5808 for (j = 1; j <= l2; ++j)
5809 {
5810 gel(p4, j) = cgetg(l3+1, t_COL);
5811 for (i = 1; i <= l3; ++i)
5812 gcoeff(p4, i, j) = stoi(idealval(bnf, gel(LS2gen, j), gel(newprimes, i)));
5813 }
5814 }
5815 newprimesval = p4;
5816 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
5817 pari_printf(" newprimesval = %Ps\n", newprimesval);
5818 kerval = lift(matker0(gmul(newprimesval, gmodulsg(1, p)), 0));
5819 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
5820 pari_printf(" kerval = %Ps\n", kerval);
5821 l5 = glength(kerval);
5822 {
5823 long i, l10;
5824 GEN p11 = gen_0;
5825 p6 = cgetg(l5+1, t_VEC);
5826 for (i = 1; i <= l5; ++i)
5827 {
5828 l10 = glength(LS2gen);
5829 {
5830 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
5831 long j;
5832 p11 = gen_1;
5833 for (j = 1; j <= l10; ++j)
5834 {
5835 p11 = gmul(p11, gpow(gel(LS2gen, j), gcoeff(kerval, j, i), prec));
5836 if (low_stack(st_lim, stack_lim(btop, 1)))
5837 p11 = gerepilecopy(btop, p11);
5838 }
5839 }
5840 gel(p6, i) = p11;
5841 }
5842 }
5843 LS2gen = p6;
5844 /* Add the units */
5845 LS2gen = concat(member_fu(bnf), LS2gen);
5846 /* Add also the torsion unit if its order is divisible by p. */
5847 if (gequal0(gmod(gel(member_tu(bnf), 1), p)))
5848 {
5849 p7 = cgetg(2, t_VEC);
5850 gel(p7, 1) = gcopy(gel(member_tu(bnf), 2));
5851 LS2gen = concat(p7, LS2gen);
5852 }
5853 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
5854 pari_printf(" #LS2gen = %ld\n", glength(LS2gen));
5855 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
5856 pari_printf(" LS2gen = %Ps\n", LS2gen);
5857 p8 = cgetg(3, t_VEC);
5858 gel(p8, 1) = gcopy(LS2gen);
5859 gel(p8, 2) = gcopy(Slist);
5860 p8 = gerepilecopy(ltop, p8);
5861 return p8;
5862 }
5863
5864 GEN
5865 kersign(GEN gen, GEN rootapprox)
5866 {
5867 pari_sp ltop = avma;
5868 GEN signs = gen_0, elt = gen_0, elt2 = gen_0, d = gen_0, st = gen_0, kers = gen_0, compt = gen_0;
5869 long l1;
5870 GEN p2 = gen_0; /* vec */
5871 long l3;
5872 gen = gcopy(gen);
5873 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
5874 pari_printf(" Computing the kernel of the sign %Ps\n", rootapprox);
5875 l1 = glength(gen);
5876 {
5877 long l4;
5878 p2 = cgetg(l1+1, t_VEC);
5879 for (l4 = 1; l4 <= l1; ++l4)
5880 gel(p2, l4) = gen_0;
5881 }
5882 /* determination of the signs */
5883 signs = p2;
5884 l3 = glength(gen);
5885 {
5886 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
5887 long i;
5888 GEN p5 = gen_0;
5889 for (i = 1; i <= l3; ++i)
5890 {
5891 elt = lift(gel(gen, i));
5892 if (degree(elt) == 0)
5893 {
5894 gel(signs, i) = stoi(gsigne(simplify(elt)) < 0);
5895 continue;
5896 }
5897 d = poldisc0(elt, -1);
5898 if (degree(elt) == 2)
5899 if (gcmpgs(d, 0) <= 0)
5900 {
5901 gel(signs, i) = stoi(gsigne(pollead(elt, -1)) < 0);
5902 continue;
5903 }
5904 if (gequal0(d))
5905 p5 = gdiv(elt, ggcd(elt, deriv(elt,-1)));
5906 else
5907 p5 = elt;
5908 elt2 = p5;
5909 st = gen_1;
5910 compt = gen_0;
5911 {
5912 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
5913 while (!gequal0(st))
5914 {
5915 st = stoi(sturmpart(elt2, gel(rootapprox, 1), gel(rootapprox, 2)));
5916 if (!gequal0(st))
5917 {
5918 rootapprox = polrealrootsimprove(compo(gel(gen, i), 1), rootapprox);
5919 /* MODI to make gp2c happy */
5920 /* if the sign of elt is too difficult to determine, */
5921 /* try the sign of 1/elt. */
5922 if (gequal0(gmodgs(compt = gaddgs(compt, 1), 5)))
5923 {
5924 gel(gen, i) = ginv(gel(gen, i));
5925 --i;
5926 goto label2;
5927 }
5928 }
5929 if (low_stack(st_lim, stack_lim(btop, 1)))
5930 gerepileall(btop, 4, &st, &rootapprox, &compt, &gen);
5931 }
5932 }
5933 gel(signs, i) = stoi(gsigne(gsubst(elt, gvar(gpolvar(elt)), gel(rootapprox, 2))) < 0);
5934 label2:;
5935 if (low_stack(st_lim, stack_lim(btop, 1)))
5936 gerepileall(btop, 9, &p5, &elt, &signs, &d, &elt2, &st, &compt, &rootapprox, &gen);
5937 }
5938 }
5939 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
5940 pari_printf(" signs = %Ps\n", signs);
5941 /* construction of the kernel */
5942 kers = gmul(matker0(gtomat(gmul(signs, gmodulss(1, 2))), 0), gmodulss(1, 2));
5943 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
5944 pari_printf(" kers = %Ps\n", lift(kers));
5945 kers = gerepilecopy(ltop, kers);
5946 return kers;
5947 }
5948
5949 GEN
5950 kernorm(GEN gen, GEN S, GEN p)
5951 {
5952 pari_sp ltop = avma;
5953 GEN normgen = gen_0, normmap = gen_0, kern = gen_0;
5954 GEN p1 = gen_0; /* vec */
5955 long l2, l3;
5956 GEN p4 = gen_0; /* vec */
5957 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
5958 pari_printf(" Computing the kernel of the norm map\n");
5959 if (gequalgs(p, 2))
5960 {
5961 p1 = cgetg(2, t_VEC);
5962 gel(p1, 1) = gen_m1;
5963 S = concat(p1, S);
5964 }
5965 normgen = gnorm(gen);
5966 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
5967 pari_printf(" normgen = %Ps\n", normgen);
5968 l2 = glength(normgen);
5969 l3 = glength(S);
5970 {
5971 long i, j, l5 = 0;
5972 p4 = cgetg(l2+1, t_MAT);
5973 for (j = 1; j <= l2; ++j)
5974 {
5975 gel(p4, j) = cgetg(l3+1, t_COL);
5976 for (i = 1; i <= l3; ++i)
5977 {
5978 if ((i == 1) && gequalgs(p, 2))
5979 l5 = gsigne(gel(normgen, j)) < 0;
5980 else
5981 l5 = ggval(gel(normgen, j), gel(S, i));
5982 gcoeff(p4, i, j) = stoi(l5);
5983 }
5984 }
5985 }
5986 /* matrix of the norm map */
5987 normmap = p4;
5988 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
5989 pari_printf(" normmap = %Ps\n", normmap);
5990 /* construction of the kernel */
5991 kern = gmul(matker0(gmul(normmap, gmodulsg(1, p)), 0), gmodulsg(1, p));
5992 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
5993 pari_printf(" ker = %Ps\n", lift(kern));
5994 kern = gerepilecopy(ltop, kern);
5995 return kern;
5996 }
5997
5998 GEN
5999 elllocalimage(GEN nf, GEN pp, GEN K, long prec)
6000 {
6001 pari_sp ltop = avma;
6002 GEN X = gen_0, p = gen_0, prank = gen_0, rac = gen_0, pts = gen_0, bound = gen_0, essai = gen_0, mrank = gen_0, r = gen_0, xx = gen_0, delta = gen_0, ph = gen_0, delta2 = gen_0, prec_s = gen_0, ival = gen_0, x = pol_x(fetch_user_var("x"));
6003 GEN p1 = gen_0; /* vec */
6004 if (!K)
6005 K = gen_1;
6006 /* MODI add prec_s, ival */
6007
6008 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
6009 pari_printf(" starting elllocalimage\n");
6010 X = gmodulo(x, member_pol(nf));
6011 p = gcopy(gel(gel(gel(pp, 1), 1), 1));
6012 prank = stoi(glength(pp) - !gequalgs(p, 2));
6013 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
6014 pari_printf(" prank = %Ps\n", prank);
6015 rac = polrootsmodpn(gmul(K, member_pol(nf)), p, prec);
6016 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
6017 pari_printf(" rac = %Ps\n", rac);
6018 {
6019 long l2, l3;
6020 p1 = cgetg(1, t_MAT);
6021 for (l3 = 1; l3 <= 0; ++l3)
6022 {
6023 gel(p1, l3) = cgetg(1, t_COL);
6024 for (l2 = 1; l2 <= 0; ++l2)
6025 gcoeff(p1, l2, l3) = gen_0;
6026 }
6027 }
6028 pts = p1;
6029 bound = gaddgs(p, 6);
6030 essai = gen_0;
6031 mrank = gen_0;
6032 {
6033 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
6034 long l4;
6035 while (gcmp(mrank, prank) < 0)
6036 {
6037 essai = gaddgs(essai, 1);
6038 if (gequal0(gmodgs(essai, 16)))
6039 {
6040 pts = matimage0(pts, 0);
6041 bound = gmul(bound, p);
6042 }
6043 r = gaddgs(genrand(stoi(glength(rac))), 1);
6044 prec_s = gsubgs(genrand(gaddgs(gel(gel(rac, gtos(r)), 2), 3)), 2);
6045 xx = gadd(gel(gel(rac, gtos(r)), 1), gmul(gpow(p, prec_s, prec), genrand(bound)));
6046 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
6047 pari_printf(" xx = %Ps\n", xx);
6048 delta = gmul(K, gsub(xx, X));
6049 /* rem : K*pol(xx) = norm(delta) ( = y^2 for a point on the elliptic curve) */
6050 if (!psquare(gmul(K, gsubst(member_pol(nf), gvar(x), xx)), p, prec))
6051 continue;
6052 ph = cgetg(1, t_VEC);
6053 l4 = glength(pp);
6054 {
6055 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
6056 long i;
6057 GEN p5 = gen_0, p6 = gen_0; /* vec */
6058 for (i = 1; i <= l4; ++i)
6059 {
6060 p5 = cgetg(2, t_VEC);
6061 gel(p5, 1) = gcopy(ival = stoi(idealval(nf, delta, gel(gel(pp, i), 1))));
6062 ph = concat(ph, p5);
6063 delta2 = gdiv(delta, gpow(gel(gel(pp, i), 2), ival, prec));
6064 if (gequalgs(p, 2))
6065 ph = concat(ph, gtrans(ideallog(nf, delta2, gel(gel(pp, i), 3))));
6066 else
6067 {
6068 p6 = cgetg(2, t_VEC);
6069 gel(p6, 1) = stoi(1 - nfpsquareoddQ(nf, delta2, gel(gel(pp, i), 4), prec));
6070 ph = concat(ph, p6);
6071 }
6072 if (low_stack(st_lim, stack_lim(btop, 1)))
6073 gerepileall(btop, 5, &ival, &p5, &ph, &delta2, &p6);
6074 }
6075 }
6076 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
6077 pari_printf(" ph = %Ps\n", ph);
6078 pts = concat(pts, gmul(gtrans(ph), gmodulss(1, 2)));
6079 mrank = stoi(rank(gmul(pts, gmodulss(1, 2))));
6080 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
6081 pari_printf(" pts = %Ps\n", lift(pts));
6082 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
6083 pari_printf(" matrank = %Ps\n", mrank);
6084 if (low_stack(st_lim, stack_lim(btop, 1)))
6085 gerepileall(btop, 11, &essai, &pts, &bound, &r, &prec_s, &xx, &delta, &ph, &ival, &delta2, &mrank);
6086 }
6087 }
6088 pts = matimage0(pts, 0);
6089 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
6090 pari_printf(" essai = %Ps\n", essai);
6091 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
6092 pari_printf(" end of elllocalimage\n");
6093 pts = gerepilecopy(ltop, pts);
6094 return pts;
6095 }
6096
6097 GEN
6098 ell2descent_gen(GEN ell, GEN bnf, GEN K, GEN help, GEN redflag, long prec) /* vec */
6099 {
6100 pari_sp ltop = avma;
6101 GEN A = gen_0, B = gen_0, C = gen_0, polrel = gen_0, polprime = gen_0, ttheta = gen_0, badprimes = gen_0, S = gen_0, LS2 = gen_0, selmer = gen_0, rootapprox = gen_0, p = gen_0, pp = gen_0, locimage = gen_0, LS2image = gen_0, listpointstriv = gen_0, listpoints = gen_0, iwhile = gen_0, expo = gen_0, zc = gen_0, liftzc = gen_0, den = gen_0, point = gen_0, idealfactorzc = gen_0, idealzc = gen_0, baseidealzc = gen_0, q2 = gen_0, sol = gen_0, param = gen_0, q1 = gen_0, pol = gen_0, redq = gen_0, q0 = gen_0, pointxx = gen_0, point2 = gen_0, rang = gen_0;
6102 GEN p1 = gen_0; /* vec */
6103 GEN x = pol_x(fetch_user_var("x"));
6104 long l2;
6105 GEN p3 = gen_0; /* vec */
6106 long l4, l5;
6107 GEN y = pol_x(fetch_user_var("y"));
6108 long l6;
6109 GEN p7 = gen_0; /* vec */
6110 if (!K)
6111 K = gen_1;
6112 if (!help)
6113 help = cgetg(1, t_VEC);
6114 if (!redflag)
6115 redflag = gen_0;
6116 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
6117 pari_printf(" starting ell2descent_gen\n");
6118 if (glength(ell) < 13)
6119 ell = smallellinit(ell);
6120 if (!gequalgs(ell_get_a1(ell), 0) || !gequalgs(ell_get_a3(ell), 0))
6121 pari_err(user, " ell2descent_gen : the curve is not of the form [0,a,0,b,c]");
6122 if (((gcmpgs(denom(ell_get_a2(ell)), 1) > 0) || (gcmpgs(denom(ell_get_a4(ell)), 1) > 0)) || (gcmpgs(denom(ell_get_a6(ell)), 1) > 0))
6123 pari_err(user, " ell2descent_gen : non integral coefficients");
6124 A = gcopy(ell_get_a2(ell));
6125 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
6126 pari_printf(" A = %Ps\n", A);
6127 B = gcopy(ell_get_a4(ell));
6128 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
6129 pari_printf(" B = %Ps\n", B);
6130 C = gcopy(ell_get_a6(ell));
6131 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
6132 pari_printf(" C = %Ps\n", C);
6133 /* \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
6134 /* Construction of L(S,2) \\ */
6135 /* \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
6136
6137 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
6138 {
6139 pari_printf("\n");
6140 pari_printf(" Computing L(S,2)\n");
6141 }
6142 p1 = cgetg(5, t_VEC);
6143 gel(p1, 1) = gen_1;
6144 gel(p1, 2) = gcopy(A);
6145 gel(p1, 3) = gcopy(B);
6146 gel(p1, 4) = gcopy(C);
6147 polrel = gtopoly(p1, -1);
6148 polprime = deriv(polrel,-1);
6149 ttheta = gmodulo(x, polrel);
6150 if (gequal0(bnf))
6151 {
6152 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
6153 pari_printf(" bnfinit(%Ps)\n", polrel);
6154 bnf = Buchall(polrel, nf_FORCE, prec);
6155 }
6156 badprimes = gabs(gmul(K, idealadd(bnf, polprime, member_index(bnf))), prec);
6157 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
6158 pari_printf(" badprimes = %Ps\n", gcoeff(badprimes, 1, 1));
6159 S = bnfpSelmer(bnf, badprimes, gen_2, prec);
6160 LS2 = gcopy(gel(S, 1));
6161 S = gcopy(gel(S, 2));
6162 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
6163 pari_printf(" L(S,2) = %Ps\n", LS2);
6164 /* \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
6165 /* Construction of the Selmer group \\ */
6166 /* \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
6167
6168 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
6169 {
6170 pari_printf("\n");
6171 pari_printf(" Computing the Selmer group\n");
6172 }
6173 l2 = glength(S);
6174 {
6175 long i;
6176 p3 = cgetg(l2+1, t_VEC);
6177 for (i = 1; i <= l2; ++i)
6178 gel(p3, i) = icopy(member_p(gel(S, i)));
6179 }
6180 /* elements with square norm */
6181 selmer = kernorm(LS2, p3, gen_2);
6182 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
6183 pari_printf(" selmer = %Ps\n", lift(selmer));
6184 /* the first real embedding must be > 0 */
6185 /* since the norm is a square, this is automatic */
6186 /* if there is a single real embedding. */
6187 if (cmpis(member_r1(bnf), 3) == 0)
6188 {
6189 rootapprox = gcopy(gel(polrealrootsisolate(polrel), 1));
6190 selmer = gmul(intersect(selmer, kersign(LS2, rootapprox)), gmodulss(1, 2));
6191 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
6192 pari_printf(" selmer = %Ps\n", lift(selmer));
6193 }
6194 /* p-adic points */
6195 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
6196 pari_printf(" p-adic points\n");
6197 badprimes = gcopy(gel(factorint(gmulgs(gcoeff(badprimes, 1, 1), 2), 0), 1));
6198 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
6199 pari_printf(" badprimes = %Ps\n", badprimes);
6200 l4 = glength(badprimes);
6201 {
6202 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
6203 long i;
6204 for (i = 1; i <= l4; ++i)
6205 {
6206 p = gcopy(gel(badprimes, i));
6207 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
6208 pari_printf(" p = %Ps\n", p);
6209 pp = ppinit(member_nf(bnf), p);
6210 locimage = elllocalimage(member_nf(bnf), pp, K, prec);
6211 LS2image = LS2localimage(member_nf(bnf), LS2, pp, prec);
6212 locimage = intersect(LS2image, locimage);
6213 selmer = intersect(selmer, concat(matker0(LS2image, 0), gmul(inverseimage(LS2image, locimage), gmodulss(1, 2))));
6214 selmer = matimage0(gmul(selmer, gmodulss(1, 2)), 0);
6215 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
6216 pari_printf(" selmer = %Ps\n", selmer);
6217 if (!glength(selmer))
6218 break;
6219 if (low_stack(st_lim, stack_lim(btop, 1)))
6220 gerepileall(btop, 5, &p, &pp, &locimage, &LS2image, &selmer);
6221 }
6222 }
6223 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
6224 pari_printf(" selmer = %Ps\n", lift(selmer));
6225 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
6226 pari_printf(" Selmer rank = %ld\n", glength(selmer));
6227 /* \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
6228 /* Search for trivial points \\ */
6229 /* \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
6230
6231 if (glength(selmer))
6232 {
6233 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
6234 {
6235 pari_printf("\n");
6236 pari_printf(" Search for trivial points on the curve\n");
6237 }
6238 listpointstriv = ratpoint(gmul(gpowgs(K, 3), gsubst(polrel, gvar(x), gdiv(x, K))), LIMTRIV, gen_0, prec);
6239 l5 = glength(listpointstriv);
6240 {
6241 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
6242 long i;
6243 GEN p8 = gen_0; /* vec */
6244 for (i = 1; i <= l5; ++i)
6245 {
6246 if (glength(gel(listpointstriv, i)) == 3)
6247 {
6248 p8 = cgetg(2, t_VEC);
6249 gel(p8, 1) = gen_0;
6250 gel(listpointstriv, i) = p8;
6251 }
6252 else
6253 {
6254 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
6255 long j;
6256 for (j = 1; j <= 2; ++j)
6257 {
6258 gel(gel(listpointstriv, i), j) = gdiv(gel(gel(listpointstriv, i), j), gpowgs(K, j));
6259 if (low_stack(st_lim, stack_lim(btop, 1)))
6260 listpointstriv = gerepilecopy(btop, listpointstriv);
6261 }
6262 }
6263 if (low_stack(st_lim, stack_lim(btop, 1)))
6264 gerepileall(btop, 2, &p8, &listpointstriv);
6265 }
6266 }
6267 listpointstriv = concat(help, listpointstriv);
6268 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
6269 pari_printf(" Trivial points on the curve = %Ps\n", listpointstriv);
6270 }
6271 /* MODI: translate points triviaux */
6272
6273 /* \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
6274 /* Run through the Selmer group \\ */
6275 /* \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
6276
6277 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
6278 {
6279 pari_printf("\n");
6280 pari_printf(" Run through the Selmer group\n");
6281 }
6282 listpoints = cgetg(1, t_VEC);
6283 selmer = lift(selmer);
6284 iwhile = gen_1;
6285 {
6286 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
6287 long l9;
6288 GEN p10 = gen_0; /* vec */
6289 long l11;
6290 GEN p12 = gen_0;
6291 long l13, l14;
6292 GEN p15 = gen_0, p16 = gen_0, p17 = gen_0, p18 = gen_0, p19 = gen_0, p20 = gen_0, p21 = gen_0, p22 = gen_0, p23 = gen_0, p24 = gen_0; /* vec */
6293 while (gcmp(iwhile, shifti(gen_1, glength(selmer))) < 0)
6294 {
6295 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
6296 pari_printf("\n");
6297 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
6298 pari_printf(" iwhile = %Ps\n", iwhile);
6299 l9 = glength(selmer);
6300 {
6301 long i;
6302 p10 = cgetg(l9+1, t_COL);
6303 for (i = 1; i <= l9; ++i)
6304 gel(p10, i) = gbittest(iwhile, i - 1);
6305 }
6306 /* the next element zc as an algebraic number modulo squares */
6307
6308 expo = gmul(selmer, p10);
6309 l11 = glength(LS2);
6310 {
6311 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
6312 long i;
6313 p12 = gen_1;
6314 for (i = 1; i <= l11; ++i)
6315 {
6316 p12 = gmul(p12, gpow(gel(LS2, i), gel(expo, i), prec));
6317 if (low_stack(st_lim, stack_lim(btop, 1)))
6318 p12 = gerepilecopy(btop, p12);
6319 }
6320 }
6321 zc = p12;
6322 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
6323 pari_printf(" zc = %Ps\n", zc);
6324 liftzc = lift(zc);
6325 /* Reduction modulo squares */
6326
6327 if (!gequal0(redflag))
6328 {
6329 zc = reducemodsquares(zc, gen_2, prec);
6330 liftzc = lift(zc);
6331 den = gsqr(denom(content(liftzc)));
6332 zc = gmul(zc, den);
6333 liftzc = gmul(liftzc, den);
6334 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
6335 pari_printf(" zc reduced = %Ps\n", zc);
6336 }
6337 /* Does it come from a trivial point ? */
6338
6339 l13 = glength(listpointstriv);
6340 {
6341 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
6342 long i;
6343 GEN p25 = gen_0; /* vec */
6344 for (i = 1; i <= l13; ++i)
6345 {
6346 point = gcopy(gel(listpointstriv, i));
6347 if (glength(point) == 2)
6348 if (nfissquare(member_nf(bnf), gmul(gmul(K, gsub(gel(point, 1), x)), liftzc), prec))
6349 {
6350 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
6351 pari_printf(" comes from the trivial point %Ps\n", point);
6352 p25 = cgetg(2, t_VEC);
6353 gel(p25, 1) = gcopy(point);
6354 listpoints = concat(listpoints, p25);
6355 iwhile = shifti(gen_1, gtos(gaddgs(degre(iwhile), 1)));
6356 goto label3;
6357 }
6358 if (low_stack(st_lim, stack_lim(btop, 1)))
6359 gerepileall(btop, 4, &point, &p25, &listpoints, &iwhile);
6360 }
6361 }
6362 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
6363 pari_printf(" does not come from a trivial point\n");
6364 /* Construction of the quadratic form q2 */
6365 /* Change the basis using the square factors of zc */
6366
6367 idealfactorzc = idealfactor(bnf, zc);
6368 gel(idealfactorzc, 2) = gmulgs(gel(idealfactorzc, 2), -1);
6369 gel(idealfactorzc, 2) = gdivent(gel(idealfactorzc, 2), gen_2);
6370 /* idealzc = idealfactorback(bnf,idealfactorzc); */
6371 idealzc = matid(3);
6372 l14 = glength(gel(idealfactorzc, 1));
6373 {
6374 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
6375 long i;
6376 for (i = 1; i <= l14; ++i)
6377 {
6378 idealzc = idealmul(bnf, idealzc, idealpow0(bnf, gcoeff(idealfactorzc, i, 1), gcoeff(idealfactorzc, i, 2), 0));
6379 if (low_stack(st_lim, stack_lim(btop, 1)))
6380 idealzc = gerepilecopy(btop, idealzc);
6381 }
6382 }
6383 {
6384 long i;
6385 p15 = cgetg(4, t_VEC);
6386 for (i = 1; i <= 3; ++i)
6387 gel(p15, i) = basistoalg(bnf, gel(idealzc, i));
6388 }
6389 baseidealzc = p15;
6390 {
6391 long i, j;
6392 p16 = cgetg(4, t_MAT);
6393 for (j = 1; j <= 3; ++j)
6394 {
6395 gel(p16, j) = cgetg(4, t_COL);
6396 for (i = 1; i <= 3; ++i)
6397 gcoeff(p16, i, j) = gtrace(gdiv(gmul(gmul(zc, gel(baseidealzc, i)), gel(baseidealzc, j)), polprime));
6398 }
6399 }
6400 q2 = p16;
6401 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
6402 pari_printf(" q2 = %Ps\n", q2);
6403 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
6404 pari_printf(" q2/content(q2) = %Ps\n", gdiv(q2, content(q2)));
6405 /* Solution of the quadratic equation q2=0 */
6406
6407 sol = Qfsolve(gdiv(q2, content(q2)), gen_0, prec);
6408 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
6409 pari_printf(" sol = %Ps\n", sol);
6410 if (typ(sol) == t_INT)
6411 pari_err(user, " ell2descent_gen : WRONG ELEMENT IN THE SELMER GROUP, please report");
6412 p17 = cgetg(4, t_COL);
6413 gel(p17, 1) = gsqr(x);
6414 gel(p17, 2) = gcopy(x);
6415 gel(p17, 3) = gen_1;
6416 /* Parametrizing the solutions of q2=0 */
6417
6418 param = gmul(Qfparam(q2, sol, NULL, prec), p17);
6419 param = gdiv(param, content(param));
6420 {
6421 long i, j;
6422 p18 = cgetg(4, t_MAT);
6423 for (j = 1; j <= 3; ++j)
6424 {
6425 gel(p18, j) = cgetg(4, t_COL);
6426 for (i = 1; i <= 3; ++i)
6427 gcoeff(p18, i, j) = gtrace(gdiv(gmul(gmul(gmul(zc, gel(baseidealzc, i)), gel(baseidealzc, j)), gadd(ttheta, A)), polprime));
6428 }
6429 }
6430 /* Construction of the quartic */
6431
6432 q1 = gneg(p18);
6433 pol = gmul(gmul(gtrans(param), q1), param);
6434 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
6435 pari_printf(" quartic: %Ps*Y^2 = %Ps\n", K, pol);
6436 redq = redquartic(pol, prec);
6437 pol = gcopy(gel(redq, 1));
6438 den = denom(content(gmul(K, pol)));
6439 pol = gmul(pol, gsqr(den));
6440 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
6441 pari_printf(" reduced: %Ps*Y^2 = %Ps\n", K, pol);
6442 /* Search for points on the quartic */
6443
6444 point = ratpoint(gmul(K, pol), LIM1, gen_1, prec);
6445 if (gequal(point, cgetg(1, t_VEC)))
6446 point = ratpoint2(gmul(K, pol), LIM3, gen_1, NULL, prec);
6447 if (gequal(point, cgetg(1, t_VEC)))
6448 {
6449 iwhile = gaddgs(iwhile, 1);
6450 continue;
6451 }
6452 if (glength(point) == 2)
6453 {
6454 p19 = cgetg(2, t_VEC);
6455 gel(p19, 1) = gen_1;
6456 point = concat(point, p19);
6457 }
6458 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
6459 pari_printf(" point on the reduced quartic = %Ps\n", point);
6460 p20 = cgetg(3, t_COL);
6461 gel(p20, 1) = gcopy(gel(point, 1));
6462 gel(p20, 2) = gcopy(gel(point, 3));
6463 p21 = cgetg(2, t_COL);
6464 gel(p21, 1) = gdiv(gel(point, 2), den);
6465 point = concat(gmul(gel(redq, 2), p20), p21);
6466 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
6467 pari_printf(" point on the quartic = %Ps\n", point);
6468 /* Construction of the point on the elliptic curve from the point on the quartic */
6469
6470 param = gmul(gsubst(param, gvar(x), gdiv(x, y)), gsqr(y));
6471 param = gsubst(gsubst(param, gvar(x), gel(point, 1)), gvar(y), gel(point, 2));
6472 param = gmul(param, gdiv(K, gel(point, 3)));
6473 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
6474 pari_printf(" reconstruction of the point on the curve\n");
6475 {
6476 long i, j;
6477 p22 = cgetg(4, t_MAT);
6478 for (j = 1; j <= 3; ++j)
6479 {
6480 gel(p22, j) = cgetg(4, t_COL);
6481 for (i = 1; i <= 3; ++i)
6482 gcoeff(p22, i, j) = gtrace(gdiv(gmul(gmul(gmul(zc, gel(baseidealzc, i)), gel(baseidealzc, j)), gadd(gadd(gsqr(ttheta), gmul(A, ttheta)), B)), polprime));
6483 }
6484 }
6485 q0 = p22;
6486 pointxx = gdiv(gmul(gmul(gtrans(param), q0), param), K);
6487 p23 = cgetg(3, t_VEC);
6488 gel(p23, 1) = gcopy(pointxx);
6489 gel(p23, 2) = sqrtrat(gdiv(gsubst(polrel, gvar(x), pointxx), K));
6490 point2 = p23;
6491 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
6492 pari_printf(" point on the curve = %Ps\n", point2);
6493 p24 = cgetg(2, t_VEC);
6494 gel(p24, 1) = gcopy(point2);
6495 listpoints = concat(listpoints, p24);
6496 iwhile = shifti(gen_1, gtos(gaddgs(degre(iwhile), 1)));
6497 label3:;
6498 if (low_stack(st_lim, stack_lim(btop, 1)))
6499 gerepileall(btop, 31, &p10, &expo, &p12, &zc, &liftzc, &den, &point, &listpoints, &iwhile, &idealfactorzc, &idealzc, &p15, &baseidealzc, &p16, &q2, &sol, &p17, ¶m, &p18, &q1, &pol, &redq, &p19, &p20, &p21, &p22, &q0, &pointxx, &p23, &point2, &p24);
6500 }
6501 }
6502 /* MODI normalized blanks */
6503
6504 /* \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
6505 /* Conclusion report \\ */
6506 /* \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
6507
6508 rang = stoi(glength(listpoints));
6509 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
6510 {
6511 pari_printf("\n");
6512 pari_printf(" rank of found points = %ld\n", glength(listpoints));
6513 pari_printf(" rank of the Selmer group = %ld\n", glength(selmer));
6514 }
6515 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
6516 afficheselmer(rang, stoi(glength(selmer)), gen_0);
6517 if (!gequal0(gmodgs(gsubsg(glength(selmer), rang), 2)))
6518 {
6519 rang = gaddgs(rang, 1);
6520 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
6521 {
6522 pari_printf(" III should be a square, hence \n");
6523 afficheselmer(rang, stoi(glength(selmer)), gen_0);
6524 }
6525 }
6526 /* Verification */
6527
6528 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
6529 pari_printf("listpoints = %Ps\n", listpoints);
6530 l6 = glength(listpoints);
6531 {
6532 pari_sp btop = avma;
6533 long i;
6534 for (i = 1; i <= l6; ++i)
6535 {
6536 if (!gequal0(gsub(gsubst(polrel, gvar(x), gel(gel(listpoints, i), 1)), gmul(K, gsqr(gel(gel(listpoints, i), 2))))))
6537 pari_err(user, " ell2descent_gen : WRONG POINT = %Ps please report", gel(listpoints, i));
6538 avma = btop;
6539 }
6540 }
6541 /* Reduction of the points */
6542
6543 listpoints = vecsort0(listpoints, NULL, 2);
6544 if ((glength(listpoints) >= 2) && !gequal0(ELLREDGENFLAG))
6545 listpoints = ellredgen(ell, listpoints, K, prec);
6546 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
6547 pari_printf(" end of ell2descent_gen\n");
6548 p7 = cgetg(4, t_VEC);
6549 gel(p7, 1) = gcopy(rang);
6550 gel(p7, 2) = stoi(glength(selmer));
6551 gel(p7, 3) = gcopy(listpoints);
6552 p7 = gerepilecopy(ltop, p7);
6553 return p7;
6554 }
6555
6556 void
6557 afficheselmer(GEN m1, GEN m2, GEN tors2) /* void */
6558 {
6559 pari_sp ltop = avma;
6560 pari_printf("#E(Q)[2] = %Ps\n", shifti(gen_1, gtos(tors2)));
6561 pari_printf("#S(E/Q)[2] = %Ps\n", shifti(gen_1, gtos(m2)));
6562 if (gequal(gadd(m1, tors2), m2))
6563 {
6564 pari_printf("#E(Q)/2E(Q) = %Ps\n", shifti(gen_1, gtos(gadd(m1, tors2))));
6565 pari_printf("#III(E/Q)[2] = 1\n");
6566 pari_printf("rank(E/Q) = %Ps\n", m1);
6567 }
6568 else
6569 {
6570 pari_printf("#E(Q)/2E(Q) >= %Ps\n", shifti(gen_1, gtos(gadd(m1, tors2))));
6571 pari_printf("#III(E/Q)[2] <= %Ps\n", shifti(gen_1, gtos(gsub(gsub(m2, m1), tors2))));
6572 pari_printf("rank(E/Q) >= %Ps\n", m1);
6573 }
6574 avma = ltop;
6575 return;
6576 }
6577
6578 /* MODI: HC added */
6579
6580 GEN
6581 ellrankdebug(GEN ell, GEN lev, GEN help, long prec)
6582 {
6583 pari_sp ltop = avma;
6584 GEN p1 = gen_0;
6585 if (!help)
6586 help = cgetg(1, t_VEC);
6587 DEBUGLEVEL_ell = gcopy(lev);
6588 p1 = ellrank(ell, help, prec);
6589 gerepileall(ltop, 2, &DEBUGLEVEL_ell, &p1);
6590 return p1;
6591 }
6592
6593 GEN
6594 ellrank(GEN ell, GEN help, long prec)
6595 {
6596 pari_sp ltop = avma;
6597 GEN urst = gen_0, urst1 = gen_0, den = gen_0, eqell = gen_0, tors2 = gen_0, bnf = gen_0, rang = gen_0, time1 = gen_0;
6598 GEN p1 = gen_0, p2 = gen_0, p3 = gen_0, p4 = gen_0, p5 = gen_0, p6 = gen_0; /* vec */
6599 if (!help)
6600 help = cgetg(1, t_VEC);
6601 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
6602 pari_printf(" starting ellrank\n");
6603 if (glength(ell) < 13)
6604 ell = smallellinit(ell);
6605 p1 = cgetg(5, t_VEC);
6606 gel(p1, 1) = gen_1;
6607 gel(p1, 2) = gen_0;
6608 gel(p1, 3) = gen_0;
6609 gel(p1, 4) = gen_0;
6610 /* kill the coefficients a1 and a3 */
6611 urst = p1;
6612 if (!gequalgs(ell_get_a1(ell), 0) || !gequalgs(ell_get_a3(ell), 0))
6613 {
6614 p2 = cgetg(5, t_VEC);
6615 gel(p2, 1) = gen_1;
6616 gel(p2, 2) = gen_0;
6617 gel(p2, 3) = gdivgs(gneg(ell_get_a1(ell)), 2);
6618 gel(p2, 4) = gdivgs(gneg(ell_get_a3(ell)), 2);
6619 urst1 = p2;
6620 ell = ellchangecurve(ell, urst1);
6621 urst = ellcomposeurst(urst, urst1);
6622 }
6623 /* kill denominators */
6624 {
6625 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
6626 GEN p7 = gen_0; /* vec */
6627 long l8;
6628 GEN p9 = gen_0, p10 = gen_0; /* vec */
6629 for(;;)
6630 {
6631 p7 = cgetg(4, t_VEC);
6632 gel(p7, 1) = gcopy(ell_get_a2(ell));
6633 gel(p7, 2) = gcopy(ell_get_a4(ell));
6634 gel(p7, 3) = gcopy(ell_get_a6(ell));
6635 if (!(gcmpgs(den = denom(p7), 1) > 0))
6636 break;
6637 den = factor(den);
6638 l8 = glength(gel(den, 2));
6639 {
6640 long i;
6641 p9 = cgetg(l8+1, t_COL);
6642 for (i = 1; i <= l8; ++i)
6643 gel(p9, i) = gen_1;
6644 }
6645 gel(den, 2) = p9;
6646 den = factorback(den);
6647 p10 = cgetg(5, t_VEC);
6648 gel(p10, 1) = ginv(den);
6649 gel(p10, 2) = gen_0;
6650 gel(p10, 3) = gen_0;
6651 gel(p10, 4) = gen_0;
6652 urst1 = p10;
6653 ell = ellchangecurve(ell, urst1);
6654 urst = ellcomposeurst(urst, urst1);
6655 if (low_stack(st_lim, stack_lim(btop, 1)))
6656 gerepileall(btop, 7, &p7, &den, &p9, &p10, &urst1, &ell, &urst);
6657 }
6658 }
6659 help = ellchangepoint(help, urst);
6660 p3 = cgetg(5, t_VEC);
6661 gel(p3, 1) = gen_1;
6662 gel(p3, 2) = gcopy(ell_get_a2(ell));
6663 gel(p3, 3) = gcopy(ell_get_a4(ell));
6664 gel(p3, 4) = gcopy(ell_get_a6(ell));
6665 eqell = gtopoly(p3, -1);
6666 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
6667 pari_printf(" Elliptic curve : Y^2 = %Ps\n", eqell);
6668 p4 = cgetg(2, t_VEC);
6669 gel(p4, 1) = gen_0;
6670 /* Choice of the algorithm depending on the 2-torsion structure */
6671
6672 tors2 = ellhalf(ell, p4, prec);
6673 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
6674 pari_printf(" E[2] = %Ps\n", tors2);
6675 if (glength(tors2) == 1)
6676 {
6677 /* case 1: 2-torsion trivial */
6678 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
6679 pari_printf(" bnfinit(%Ps)", eqell);
6680 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
6681 gettime();
6682 bnf = Buchall(eqell, nf_FORCE, prec);
6683 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
6684 time1 = stoi(gettime());
6685 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
6686 pari_printf(" done\n");
6687 rang = ell2descent_gen(ell, bnf, gen_1, help, NULL, prec);
6688 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
6689 pari_printf(" time for bnfinit = %Ps\n", time1);
6690 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
6691 pari_printf(" time for the rest = %ld\n", gettime());
6692 }
6693 else
6694 {
6695 if ((glength(tors2) == 2) || (gequal0(COMPLETE)))
6696 {
6697 /* case 2: 2-torsion >= Z/2Z */
6698 if (!gequalgs(ell_get_a6(ell), 0))
6699 {
6700 p5 = cgetg(5, t_VEC);
6701 gel(p5, 1) = gen_1;
6702 gel(p5, 2) = gcopy(gel(gel(tors2, 2), 1));
6703 gel(p5, 3) = gen_0;
6704 gel(p5, 4) = gen_0;
6705 urst1 = p5;
6706 ell = ellchangecurve(ell, urst1);
6707 urst = ellcomposeurst(urst, urst1);
6708 }
6709 p6 = cgetg(5, t_VEC);
6710 gel(p6, 1) = gen_1;
6711 gel(p6, 2) = gcopy(ell_get_a2(ell));
6712 gel(p6, 3) = gcopy(ell_get_a4(ell));
6713 gel(p6, 4) = gcopy(ell_get_a6(ell));
6714 eqell = gtopoly(p6, -1);
6715 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
6716 pari_printf(" Elliptic curve : Y^2 = %Ps\n", eqell);
6717 rang = ell2descent_viaisog(ell, help, prec);
6718 }
6719 else
6720 /* case 3: 2-torsion = Z/2Z*Z/2Z */
6721 rang = ell2descent_complete(gel(gel(tors2, 2), 1), gel(gel(tors2, 3), 1), gel(gel(tors2, 4), 1), gen_0, prec);
6722 }
6723 gel(rang, 3) = ellchangepointinverse(gel(rang, 3), urst);
6724 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
6725 pari_printf(" end of ellrank\n");
6726 rang = gerepilecopy(ltop, rang);
6727 return rang;
6728 }
6729
6730 GEN
6731 ell2descent_complete(GEN e1, GEN e2, GEN e3, GEN help, long prec) /* vec */
6732 {
6733 pari_sp ltop = avma;
6734 GEN ee = gen_0, d32 = gen_0, d31 = gen_0, d21 = gen_0, G1 = gen_0, G2 = gen_0, G3 = gen_0, vect1 = gen_0, vect2 = gen_0, vect3 = gen_0, selmer = gen_0, rang = gen_0, listepoints = gen_0, b1 = gen_0, b2 = gen_0, q1 = gen_0, sol1 = gen_0, param1 = gen_0, param1x = gen_0, quart = gen_0, point = gen_0, z1 = gen_0, solx = gen_0, soly = gen_0, strange = gen_0, ell = gen_0;
6735 GEN p1 = gen_0; /* vec */
6736 long l2;
6737 GEN p3 = gen_0; /* vec */
6738 long l4;
6739 GEN p5 = gen_0; /* vec */
6740 GEN x = pol_x(fetch_user_var("x"));
6741 GEN p6 = gen_0, p7 = gen_0; /* vec */
6742 /* local(sol2,q2); */
6743 /* only if used below */
6744 /* MODI remove sol2 q2 */
6745
6746 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
6747 pari_printf(" Algorithm of complete 2-descent\n");
6748 p1 = cgetg(4, t_VEC);
6749 gel(p1, 1) = gcopy(e1);
6750 gel(p1, 2) = gcopy(e2);
6751 gel(p1, 3) = gcopy(e3);
6752 /* sort the integers e1, e2, e3 in increasing order */
6753
6754 ee = sort(p1);
6755 e1 = gcopy(gel(ee, 1));
6756 e2 = gcopy(gel(ee, 2));
6757 e3 = gcopy(gel(ee, 3));
6758 /* Computation of the groups G1 and G2 */
6759
6760 d32 = gsub(e3, e2);
6761 d31 = gsub(e3, e1);
6762 d21 = gsub(e2, e1);
6763 G1 = gcopy(gel(factor(gmul(d31, d21)), 1));
6764 /* (G1 > 0) */
6765 G2 = gcopy(gel(factor(gmul(gneg(d32), d21)), 1));
6766 /* (G2 < 0) */
6767 G3 = gmul(d31, d32);
6768 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
6769 pari_printf(" G1 = %Ps\n", G1);
6770 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
6771 pari_printf(" G2 = %Ps\n", G2);
6772 l2 = glength(G1);
6773 {
6774 long i;
6775 GEN p8 = gen_0; /* vec */
6776 p3 = cgetg(l2+1, t_VEC);
6777 for (i = 1; i <= l2; ++i)
6778 {
6779 p8 = cgetg(3, t_VEC);
6780 gel(p8, 1) = gen_0;
6781 gel(p8, 2) = gen_1;
6782 gel(p3, i) = p8;
6783 }
6784 }
6785 /* Run through G1*G2 */
6786
6787 vect1 = p3;
6788 l4 = glength(G2);
6789 {
6790 long i;
6791 GEN p9 = gen_0; /* vec */
6792 p5 = cgetg(l4+1, t_VEC);
6793 for (i = 1; i <= l4; ++i)
6794 {
6795 p9 = cgetg(3, t_VEC);
6796 gel(p9, 1) = gen_0;
6797 gel(p9, 2) = gen_1;
6798 gel(p5, i) = p9;
6799 }
6800 }
6801 vect2 = p5;
6802 selmer = gen_0;
6803 rang = gen_0;
6804 listepoints = cgetg(1, t_VEC);
6805 {
6806 GEN fv_data = gen_0;
6807 GEN (*fv_next)(GEN, GEN); /* func_GG */
6808 GEN X = forvec_start(vect1, 0, &fv_data, &fv_next); /* vec */
6809 {
6810 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
6811 long l10;
6812 GEN p11 = gen_0;
6813 long l12;
6814 for ( ; X; X = fv_next(fv_data, X))
6815 {
6816 l10 = glength(G1);
6817 {
6818 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
6819 long i;
6820 p11 = gen_1;
6821 for (i = 1; i <= l10; ++i)
6822 {
6823 p11 = gmul(p11, gpow(gel(G1, i), gel(X, i), prec));
6824 if (low_stack(st_lim, stack_lim(btop, 1)))
6825 p11 = gerepilecopy(btop, p11);
6826 }
6827 }
6828 b1 = p11;
6829 /* b1*b2*b3 must be a square, where b3 is a divisor of d32*d31 */
6830 vect3 = gcopy(vect2);
6831 l12 = glength(G2);
6832 {
6833 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
6834 long i;
6835 GEN p13 = gen_0; /* vec */
6836 for (i = 2; i <= l12; ++i)
6837 {
6838 if (!gequalgs(gmod(G3, gel(G2, i)), 0))
6839 {
6840 p13 = cgetg(3, t_VEC);
6841 gel(p13, 1) = gen_1;
6842 gel(p13, 2) = gen_1;
6843 gel(vect3, i) = gmulgs(p13, ggval(b1, gel(G2, i)));
6844 }
6845 if (low_stack(st_lim, stack_lim(btop, 1)))
6846 gerepileall(btop, 2, &p13, &vect3);
6847 }
6848 }
6849 {
6850 GEN fv_data = gen_0;
6851 GEN (*fv_next)(GEN, GEN); /* func_GG */
6852 GEN Y = forvec_start(vect3, 0, &fv_data, &fv_next); /* vec */
6853 {
6854 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
6855 long l14;
6856 GEN p15 = gen_0;
6857 GEN p16 = gen_0, p17 = gen_0, p18 = gen_0, p19 = gen_0, p20 = gen_0, p21 = gen_0, p22 = gen_0; /* vec */
6858 long l23;
6859 GEN p24 = gen_0, p25 = gen_0, p26 = gen_0, p27 = gen_0, p28 = gen_0; /* vec */
6860 for ( ; Y; Y = fv_next(fv_data, Y))
6861 {
6862 l14 = glength(G2);
6863 {
6864 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
6865 long i;
6866 p15 = gen_1;
6867 for (i = 1; i <= l14; ++i)
6868 {
6869 p15 = gmul(p15, gpow(gel(G2, i), gel(Y, i), prec));
6870 if (low_stack(st_lim, stack_lim(btop, 1)))
6871 p15 = gerepilecopy(btop, p15);
6872 }
6873 }
6874 b2 = p15;
6875 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
6876 {
6877 p16 = cgetg(3, t_VEC);
6878 gel(p16, 1) = gcopy(b1);
6879 gel(p16, 2) = gcopy(b2);
6880 pari_printf(" [b1,b2] = %Ps\n", lift(p16));
6881 }
6882 /* Trivial points coming from the 2-torsion */
6883
6884 if (gequal1(b1) && gequal1(b2))
6885 {
6886 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
6887 pari_printf(" trivial point [0]\n");
6888 selmer = gaddgs(selmer, 1);
6889 rang = gaddgs(rang, 1);
6890 continue;
6891 }
6892 if (!gequal0(gissquare(gmul(gneg(d21), b2))) && !gequal0(gissquare(gmul(gmul(d31, d21), b1))))
6893 {
6894 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
6895 pari_printf(" trivial point [e1,0]\n");
6896 selmer = gaddgs(selmer, 1);
6897 rang = gaddgs(rang, 1);
6898 p17 = cgetg(2, t_VEC);
6899 p18 = cgetg(3, t_VEC);
6900 gel(p18, 1) = gcopy(e1);
6901 gel(p18, 2) = gen_0;
6902 gel(p17, 1) = p18;
6903 listepoints = concat(listepoints, p17);
6904 continue;
6905 }
6906 if (!gequal0(gissquare(gmul(d21, b1))) && !gequal0(gissquare(gmul(gmul(gneg(d32), d21), b2))))
6907 {
6908 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
6909 pari_printf(" trivial point [e2,0]\n");
6910 selmer = gaddgs(selmer, 1);
6911 rang = gaddgs(rang, 1);
6912 p19 = cgetg(2, t_VEC);
6913 p20 = cgetg(3, t_VEC);
6914 gel(p20, 1) = gcopy(e2);
6915 gel(p20, 2) = gen_0;
6916 gel(p19, 1) = p20;
6917 listepoints = concat(listepoints, p19);
6918 continue;
6919 }
6920 if (!gequal0(gissquare(gmul(d31, b1))) && !gequal0(gissquare(gmul(d32, b2))))
6921 {
6922 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
6923 pari_printf(" trivial point [e3,0]\n");
6924 selmer = gaddgs(selmer, 1);
6925 rang = gaddgs(rang, 1);
6926 p21 = cgetg(2, t_VEC);
6927 p22 = cgetg(3, t_VEC);
6928 gel(p22, 1) = gcopy(e3);
6929 gel(p22, 2) = gen_0;
6930 gel(p21, 1) = p22;
6931 listepoints = concat(listepoints, p21);
6932 continue;
6933 }
6934 /* Trivial points coming from help */
6935
6936 l23 = glength(help);
6937 {
6938 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
6939 long i;
6940 GEN p29 = gen_0; /* vec */
6941 for (i = 1; i <= l23; ++i)
6942 {
6943 if ((glength(gel(help, i)) != 2) || gequal0(gel(gel(help, i), 2)))
6944 continue;
6945 if (!gequal0(gissquare(gmul(b1, gsub(gel(gel(help, i), 1), e1)))) && !gequal0(gissquare(gmul(b2, gsub(gel(gel(help, i), 1), e2)))))
6946 {
6947 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
6948 pari_printf(" trivial point from help %Ps\n", gel(help, i));
6949 selmer = gaddgs(selmer, 1);
6950 rang = gaddgs(rang, 1);
6951 p29 = cgetg(2, t_VEC);
6952 gel(p29, 1) = gcopy(gel(help, i));
6953 listepoints = concat(listepoints, p29);
6954 goto label4;
6955 }
6956 if (low_stack(st_lim, stack_lim(btop, 1)))
6957 gerepileall(btop, 4, &selmer, &rang, &p29, &listepoints);
6958 }
6959 }
6960 p24 = cgetg(4, t_VEC);
6961 gel(p24, 1) = gcopy(b1);
6962 gel(p24, 2) = gneg(b2);
6963 gel(p24, 3) = gneg(d21);
6964 /* If one can solve 2 quadratic equations */
6965 /* (1) q1 : b1*z1^2-b2*z2^2 = e2-e1 */
6966 /* (2) q2 : b1*z1^2-b1*b2*z3^2 = e3-e1 */
6967 /* then (x,y) = (b1*z1^2+e1,b1*b2*z1*z2*z3) is a point on E */
6968 /* we also have */
6969 /* (3) q3 = q1-q2 : b1*b2*z3^2-b2*z2^2=e2-e3 */
6970
6971 /* Solution of the q1 */
6972
6973 q1 = diagonal(p24);
6974 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
6975 pari_printf(" q1 = %Ps\n", q1);
6976 sol1 = Qfsolve(q1, gen_0, prec);
6977 if (typ(sol1) == t_INT)
6978 {
6979 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
6980 pari_printf(" q1 not ELS at %Ps\n", sol1);
6981 continue;
6982 }
6983 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
6984 pari_printf(" solution of q1 = %Ps\n", sol1);
6985 param1 = Qfparam(q1, sol1, gen_1, prec);
6986 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
6987 pari_printf(" parametrization of q1 = %Ps\n", param1);
6988 p25 = cgetg(4, t_COL);
6989 gel(p25, 1) = gsqr(x);
6990 gel(p25, 2) = gcopy(x);
6991 gel(p25, 3) = gen_1;
6992 param1x = gmul(param1, p25);
6993 /* Solution of the q2 */
6994 /* only useful to detect local non solubility */
6995
6996 /* q2 = matdiagonal([b1,-b1*b2,-d31]); */
6997 /*if( DEBUGLEVEL_ell >= 3, print(" q2 = ",q2)); */
6998 /* sol2 = Qfsolve(q2); */
6999 /* if( type(sol2) == "t_INT", */
7000 /*if( DEBUGLEVEL_ell >= 3, print(" q2 not ELS at ",sol2)); */
7001 /* next); */
7002
7003 /* Construction of the quartic */
7004
7005 quart = gmul(gmul(b1, b2), gsub(gmul(b1, gsqr(gel(param1x, 1))), gmul(d31, gsqr(gel(param1x, 3)))));
7006 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
7007 pari_printf(" quart = %Ps\n", quart);
7008 /* Local solubility of the quartic */
7009
7010 if (!locallysoluble(quart, prec))
7011 {
7012 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
7013 pari_printf(" quartic not ELS \n");
7014 continue;
7015 }
7016 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
7017 pari_printf(" y^2 = %Ps\n", quart);
7018 selmer = gaddgs(selmer, 1);
7019 /* Search for points on the quartic */
7020
7021 point = ratpoint2(quart, LIM3, gen_1, NULL, prec);
7022 if (!gequal(point, cgetg(1, t_VEC)))
7023 {
7024 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
7025 pari_printf(" point found on the quartic !!\n");
7026 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
7027 pari_printf(" %Ps\n", point);
7028 if (glength(point) == 2)
7029 z1 = gdiv(gsubst(gel(param1x, 1), gvar(x), gel(point, 1)), gsubst(gel(param1x, 3), gvar(x), gel(point, 1)));
7030 else
7031 z1 = gdiv(gcoeff(param1, 1, 1), gcoeff(param1, 3, 1));
7032 solx = gadd(gmul(b1, gsqr(z1)), e1);
7033 soly = sqrtrat(gmul(gmul(gsub(solx, e1), gsub(solx, e2)), gsub(solx, e3)));
7034 p26 = cgetg(2, t_VEC);
7035 p27 = cgetg(3, t_VEC);
7036 gel(p27, 1) = gcopy(solx);
7037 gel(p27, 2) = gcopy(soly);
7038 gel(p26, 1) = p27;
7039 listepoints = concat(listepoints, p26);
7040 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
7041 {
7042 p28 = cgetg(3, t_VEC);
7043 gel(p28, 1) = gcopy(solx);
7044 gel(p28, 2) = gcopy(soly);
7045 pari_printf(" point on the elliptic curve = %Ps\n", p28);
7046 }
7047 rang = gaddgs(rang, 1);
7048 }
7049 else
7050 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
7051 pari_printf(" no point found on the quartic\n");
7052 label4:;
7053 if (low_stack(st_lim, stack_lim(btop, 1)))
7054 gerepileall(btop, 27, &p15, &b2, &p16, &selmer, &rang, &p18, &p17, &listepoints, &p20, &p19, &p22, &p21, &p24, &q1, &sol1, ¶m1, &p25, ¶m1x, &quart, &point, &z1, &solx, &soly, &p27, &p26, &p28, &Y);
7055 }
7056 }
7057 }
7058 if (low_stack(st_lim, stack_lim(btop, 1)))
7059 gerepileall(btop, 17, &p11, &b1, &vect3, &b2, &selmer, &rang, &listepoints, &q1, &sol1, ¶m1, ¶m1x, &quart, &point, &z1, &solx, &soly, &X);
7060 }
7061 }
7062 }
7063 /* end */
7064
7065 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
7066 pari_printf("#S^(2) = %Ps\n", selmer);
7067 if (gcmp(rang, gdivgs(selmer, 2)) > 0)
7068 rang = selmer;
7069 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
7070 {
7071 strange = stoi(!gequal(rang, selmer));
7072 if (!gequal0(strange))
7073 pari_printf("#E[K]/2E[K]>= %Ps\n", rang);
7074 else
7075 pari_printf("#E[K]/2E[K] = %Ps\n", rang);
7076 pari_printf("#E[2] = 4\n");
7077 }
7078 rang = gsubgs(gceil(gdiv(glog(rang, prec), glog(gen_2, prec))), 2);
7079 selmer = stoi(ggval(selmer, gen_2));
7080 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
7081 {
7082 if (!gequal0(strange))
7083 pari_printf("%Ps >= rank >= %Ps\n", gsubgs(selmer, 2), rang);
7084 else
7085 pari_printf("rank = %Ps\n", rang);
7086 if (!gequal0(rang))
7087 pari_printf("points = %Ps\n", listepoints);
7088 }
7089 p6 = cgetg(6, t_VEC);
7090 gel(p6, 1) = gen_0;
7091 gel(p6, 2) = gneg(gadd(gadd(e1, e2), e3));
7092 gel(p6, 3) = gen_0;
7093 gel(p6, 4) = gadd(gadd(gmul(e1, e2), gmul(e2, e3)), gmul(e3, e1));
7094 gel(p6, 5) = gmul(gmul(gneg(e1), e2), e3);
7095 ell = smallellinit(p6);
7096 listepoints = vecsort0(listepoints, NULL, 2);
7097 if (!gequal0(ELLREDGENFLAG))
7098 listepoints = ellredgen(ell, listepoints, NULL, prec);
7099 listepoints = concat(ellsort(gel(elltorseven(ell, prec), 3), prec), listepoints);
7100 p7 = cgetg(4, t_VEC);
7101 gel(p7, 1) = gcopy(rang);
7102 gel(p7, 2) = gcopy(selmer);
7103 gel(p7, 3) = gcopy(listepoints);
7104 p7 = gerepilecopy(ltop, p7);
7105 return p7;
7106 }
7107
7108 GEN
7109 ellcount(GEN c, GEN d, GEN KS2gen, GEN listpointstriv, long prec) /* vec */
7110 {
7111 pari_sp ltop = avma;
7112 GEN found = gen_0, listgen = gen_0, listpointscount = gen_0, m1 = gen_0, m2 = gen_0, lastloc = gen_0, mask = gen_0, i = gen_0, d1 = gen_0, iaux = gen_0, j = gen_0, triv = gen_0, pol = gen_0, point = gen_0, qf = gen_0, solqf = gen_0, para = gen_0, point1 = gen_0, v = gen_0;
7113 GEN p1 = gen_0; /* vec */
7114 GEN x = pol_x(fetch_user_var("x")), t = pol_x(fetch_user_var("t"));
7115 long l2;
7116 GEN p3 = gen_0, p4 = gen_0; /* vec */
7117 if (!listpointstriv)
7118 listpointstriv = cgetg(1, t_VEC);
7119 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
7120 {
7121 p1 = cgetg(3, t_VEC);
7122 gel(p1, 1) = gcopy(c);
7123 gel(p1, 2) = gcopy(d);
7124 pari_printf(" starting ellcount %Ps\n", p1);
7125 }
7126 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
7127 pari_printf(" KS2gen = %Ps\n", KS2gen);
7128 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
7129 pari_printf(" listpointstriv = %Ps\n", listpointstriv);
7130 found = gen_0;
7131 listgen = gcopy(KS2gen);
7132 listpointscount = cgetg(1, t_VEC);
7133 m1 = m2 = gen_0;
7134 lastloc = gen_m1;
7135 mask = shifti(gen_1, glength(KS2gen));
7136 i = gen_1;
7137 {
7138 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
7139 long l5;
7140 GEN p6 = gen_0, p7 = gen_0, p8 = gen_0, p9 = gen_0, p10 = gen_0, p11 = gen_0, p12 = gen_0, p13 = gen_0, p14 = gen_0, p15 = gen_0; /* vec */
7141 while (gcmp(i, mask) < 0)
7142 {
7143 d1 = gen_1;
7144 iaux = i;
7145 j = gen_1;
7146 {
7147 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
7148 while (!gequal0(iaux))
7149 {
7150 if (!gequal0(gmodgs(iaux, 2)))
7151 d1 = gmul(d1, gel(listgen, gtos(j)));
7152 iaux = gshift(iaux, -1);
7153 j = gaddgs(j, 1);
7154 if (low_stack(st_lim, stack_lim(btop, 1)))
7155 gerepileall(btop, 3, &d1, &iaux, &j);
7156 }
7157 }
7158 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
7159 pari_printf(" d1 = %Ps\n", d1);
7160 triv = gen_0;
7161 l5 = glength(listpointstriv);
7162 {
7163 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
7164 long j;
7165 GEN p16 = gen_0; /* vec */
7166 for (j = 1; j <= l5; ++j)
7167 {
7168 if (!gequal0(gel(gel(listpointstriv, j), 1)) && !gequal0(gissquare(gmul(d1, gel(gel(listpointstriv, j), 1)))))
7169 {
7170 p16 = cgetg(2, t_VEC);
7171 gel(p16, 1) = gcopy(gel(listpointstriv, j));
7172 listpointscount = concat(listpointscount, p16);
7173 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
7174 pari_printf(" trivial point\n");
7175 triv = gen_1;
7176 m1 = gaddgs(m1, 1);
7177 if (gcmp(degre(i), lastloc) > 0)
7178 m2 = gaddgs(m2, 1);
7179 found = gen_1;
7180 lastloc = gen_m1;
7181 break;
7182 }
7183 if (low_stack(st_lim, stack_lim(btop, 1)))
7184 gerepileall(btop, 7, &p16, &listpointscount, &triv, &m1, &m2, &found, &lastloc);
7185 }
7186 }
7187 if (gequal0(triv))
7188 {
7189 p6 = cgetg(6, t_VEC);
7190 gel(p6, 1) = gcopy(d1);
7191 gel(p6, 2) = gen_0;
7192 gel(p6, 3) = gcopy(c);
7193 gel(p6, 4) = gen_0;
7194 gel(p6, 5) = gdiv(d, d1);
7195 pol = gtopoly(p6, -1);
7196 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
7197 pari_printf(" quartic = y^2 = %Ps\n", pol);
7198 point = ratpoint(pol, LIM1, gen_1, prec);
7199 if (!gequal(point, cgetg(1, t_VEC)))
7200 {
7201 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
7202 pari_printf(" point on the quartic\n");
7203 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
7204 pari_printf("%Ps\n", point);
7205 m1 = gaddgs(m1, 1);
7206 p7 = cgetg(2, t_VEC);
7207 gel(p7, 1) = gmul(gmul(d1, gel(point, 1)), point);
7208 listpointscount = concat(listpointscount, p7);
7209 if (gcmp(degre(i), lastloc) > 0)
7210 m2 = gaddgs(m2, 1);
7211 found = gen_1;
7212 lastloc = gen_m1;
7213 }
7214 else
7215 if (locallysoluble(pol, prec))
7216 {
7217 if (gcmp(degre(i), lastloc) > 0)
7218 {
7219 m2 = gaddgs(m2, 1);
7220 lastloc = degre(i);
7221 }
7222 p8 = cgetg(4, t_MAT);
7223 gel(p8, 1) = cgetg(4, t_COL);
7224 gel(p8, 2) = cgetg(4, t_COL);
7225 gel(p8, 3) = cgetg(4, t_COL);
7226 gcoeff(p8, 1, 1) = gcopy(d1);
7227 gcoeff(p8, 1, 2) = gdivgs(c, 2);
7228 gcoeff(p8, 1, 3) = gen_0;
7229 gcoeff(p8, 2, 1) = gdivgs(c, 2);
7230 gcoeff(p8, 2, 2) = gdiv(d, d1);
7231 gcoeff(p8, 2, 3) = gen_0;
7232 gcoeff(p8, 3, 1) = gen_0;
7233 gcoeff(p8, 3, 2) = gen_0;
7234 gcoeff(p8, 3, 3) = gen_m1;
7235 /* point = ratpoint2(pol,LIM3,1); */
7236 /*\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
7237 /* Instead of solving directly y^2 = d1*x^4+c*x^2+d/d1, */
7238 /* we solve first y^2 = d1*X^2+c*X+d/d1, then solve the quartic X = x^2 */
7239 /* which gives a new quartic */
7240 qf = gmulsg(2, p8);
7241 solqf = Qfsolve(qf, gen_0, prec);
7242 p9 = cgetg(4, t_COL);
7243 gel(p9, 1) = gsqr(x);
7244 gel(p9, 2) = gcopy(x);
7245 gel(p9, 3) = gen_1;
7246 para = gmul(Qfparam(qf, solqf, gen_2, prec), p9);
7247 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
7248 {
7249 p10 = cgetg(4, t_VEC);
7250 gel(p10, 1) = gcopy(d1);
7251 gel(p10, 2) = gcopy(c);
7252 gel(p10, 3) = gdiv(d, d1);
7253 pari_printf(" the conic y^2 = %Ps\n", gtopoly(p10, -1));
7254 p11 = cgetg(3, t_VEC);
7255 gel(p11, 1) = gdiv(gel(para, 1), gel(para, 2));
7256 gel(p11, 2) = gdiv(gel(para, 3), gel(para, 2));
7257 pari_printf(" is parametrized by [x,y] = %Ps\n", gsubst(p11, gvar(x), t));
7258 }
7259 point1 = ratpoint2(gmul(gel(para, 1), gel(para, 2)), LIM3, gen_1, NULL, prec);
7260 if (!gequal(point1, cgetg(1, t_VEC)))
7261 {
7262 if (glength(point1) == 2)
7263 para = gsubst(para, gvar(x), gel(point1, 1));
7264 else
7265 {
7266 p12 = cgetg(4, t_VEC);
7267 gel(p12, 1) = gen_1;
7268 gel(p12, 2) = gdiv(gel(point1, 2), gsqr(gel(point1, 1)));
7269 gel(p12, 3) = gen_0;
7270 point1 = p12;
7271 {
7272 long ii;
7273 p13 = cgetg(4, t_VEC);
7274 for (ii = 1; ii <= 3; ++ii)
7275 gel(p13, ii) = polcoeff0(gel(para, ii), 2, -1);
7276 }
7277 para = p13;
7278 }
7279 p14 = cgetg(3, t_VEC);
7280 gel(p14, 1) = gdiv(gel(point1, 2), gel(para, 2));
7281 gel(p14, 2) = gdiv(gel(para, 3), gel(para, 2));
7282 point = p14;
7283 }
7284 else
7285 point = cgetg(1, t_VEC);
7286 /*\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
7287 if (!gequal(point, cgetg(1, t_VEC)))
7288 {
7289 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
7290 pari_printf(" point on the quartic\n");
7291 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
7292 pari_printf("%Ps\n", point);
7293 m1 = gaddgs(m1, 1);
7294 p15 = cgetg(2, t_VEC);
7295 gel(p15, 1) = gmul(gmul(d1, gel(point, 1)), point);
7296 listpointscount = concat(listpointscount, p15);
7297 if (gcmp(degre(i), lastloc) > 0)
7298 m2 = gaddgs(m2, 1);
7299 found = gen_1;
7300 lastloc = gen_m1;
7301 }
7302 else
7303 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
7304 pari_printf(" no point found on the quartic\n");
7305 }
7306 }
7307 if (!gequal0(found))
7308 {
7309 found = gen_0;
7310 v = gen_0;
7311 iaux = gshift(i, -1);
7312 {
7313 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
7314 while (!gequal0(iaux))
7315 {
7316 iaux = gshift(iaux, -1);
7317 v = gaddgs(v, 1);
7318 if (low_stack(st_lim, stack_lim(btop, 1)))
7319 gerepileall(btop, 2, &iaux, &v);
7320 }
7321 }
7322 mask = gshift(mask, -1);
7323 listgen = extract0(listgen, subis(subii(shifti(gen_1, glength(listgen)), shifti(gen_1, gtos(v))), 1), NULL);
7324 i = shifti(gen_1, gtos(v));
7325 }
7326 else
7327 i = gaddgs(i, 1);
7328 if (low_stack(st_lim, stack_lim(btop, 1)))
7329 gerepileall(btop, 29, &d1, &iaux, &j, &triv, &listpointscount, &m1, &m2, &found, &lastloc, &p6, &pol, &point, &p7, &p8, &qf, &solqf, &p9, ¶, &p10, &p11, &point1, &p12, &p13, &p14, &p15, &v, &mask, &listgen, &i);
7330 }
7331 }
7332 l2 = glength(listpointscount);
7333 {
7334 pari_sp btop = avma;
7335 long i;
7336 for (i = 1; i <= l2; ++i)
7337 {
7338 if (glength(gel(listpointscount, i)) > 1)
7339 if (!gequalgs(gsub(gsubst(gadd(gadd(gpowgs(x, 3), gmul(c, gsqr(x))), gmul(d, x)), gvar(x), gel(gel(listpointscount, i), 1)), gsqr(gel(gel(listpointscount, i), 2))), 0))
7340 pari_err(user, " ellcount : WRONG POINT, please report %ld", i);
7341 avma = btop;
7342 }
7343 }
7344 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
7345 pari_printf(" end of ellcount\n");
7346 p3 = cgetg(3, t_VEC);
7347 gel(p3, 1) = gcopy(listpointscount);
7348 p4 = cgetg(3, t_VEC);
7349 gel(p4, 1) = gcopy(m1);
7350 gel(p4, 2) = gcopy(m2);
7351 gel(p3, 2) = p4;
7352 p3 = gerepilecopy(ltop, p3);
7353 return p3;
7354 }
7355
7356 GEN
7357 ell2descent_viaisog(GEN ell, GEN help, long prec) /* vec */
7358 {
7359 pari_sp ltop = avma;
7360 GEN P = gen_0, Pfact = gen_0, tors = gen_0, listpointstriv = gen_0, KS2prod = gen_0, KS2gen = gen_0, listpoints = gen_0, pointgen = gen_0, n1 = gen_0, n2 = gen_0, certain = gen_0, apinit = gen_0, bpinit = gen_0, np1 = gen_0, np2 = gen_0, listpoints2 = gen_0, aux1 = gen_0, aux2 = gen_0, certainp = gen_0, rang = gen_0, strange = gen_0;
7361 GEN p1 = gen_0; /* vec */
7362 GEN x = pol_x(fetch_user_var("x"));
7363 GEN p2 = gen_0, p3 = gen_0; /* vec */
7364 long l4;
7365 GEN p5 = gen_0; /* vec */
7366 long l6;
7367 GEN p7 = gen_0; /* vec */
7368 if (!help)
7369 help = cgetg(1, t_VEC);
7370 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
7371 pari_printf(" Algorithm of 2-descent via isogenies\n");
7372 if (glength(ell) < 13)
7373 ell = smallellinit(ell);
7374 if (gequal0(member_disc(ell)))
7375 pari_err(user, " ell2descent_viaisog : singular curve !!");
7376 if ((!gequalgs(ell_get_a1(ell), 0) || !gequalgs(ell_get_a3(ell), 0)) || !gequalgs(ell_get_a6(ell), 0))
7377 pari_err(user, " ell2descent_viaisog : the curve is not on the form [0,a,0,b,0]");
7378 if ((gcmpgs(denom(ell_get_a2(ell)), 1) > 0) || (gcmpgs(denom(ell_get_a4(ell)), 1) > 0))
7379 pari_err(user, " ell2descent_viaisog : non-integral coefficients");
7380 p1 = cgetg(4, t_VEC);
7381 gel(p1, 1) = gen_1;
7382 gel(p1, 2) = gcopy(ell_get_a2(ell));
7383 gel(p1, 3) = gcopy(ell_get_a4(ell));
7384 /* */
7385 /* Working with the initial curve */
7386 /* */
7387
7388 /* Construction of trivial points : torsion */
7389
7390 P = gtopoly(p1, -1);
7391 Pfact = gcopy(gel(factor(P), 1));
7392 tors = stoi(glength(Pfact));
7393 listpointstriv = concat(help, gel(elltorseven(ell, prec), 3));
7394 /* Construction of trivial points : small naive height */
7395
7396 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
7397 pari_printf(" Search for trivial points on the curve\n");
7398 P = gmul(P, x);
7399 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
7400 pari_printf(" Y^2 = %Ps\n", P);
7401 listpointstriv = concat(listpointstriv, ratpoint(P, LIMTRIV, gen_0, prec));
7402 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
7403 {
7404 pari_printf(" trivial points on E(Q) = %Ps\n", listpointstriv);
7405 pari_printf("\n");
7406 }
7407 KS2prod = gneg(gabs(ell_get_a4(ell), prec));
7408 if (gcmpgs(gsub(gsqr(ell_get_a2(ell)), gmulsg(4, ell_get_a4(ell))), 0) < 0)
7409 KS2prod = gmulgs(KS2prod, -1);
7410 KS2gen = gcopy(gel(factor(KS2prod), 1));
7411 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
7412 {
7413 pari_printf(" #K(b,2)gen = %ld\n", glength(KS2gen));
7414 pari_printf(" K(b,2)gen = %Ps\n", KS2gen);
7415 }
7416 listpoints = ellcount(ell_get_a2(ell), ell_get_a4(ell), KS2gen, listpointstriv, prec);
7417 pointgen = gcopy(gel(listpoints, 1));
7418 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
7419 {
7420 pari_printf(" points on E(Q) = %Ps\n", pointgen);
7421 pari_printf("\n");
7422 }
7423 n1 = gcopy(gel(gel(listpoints, 2), 1));
7424 n2 = gcopy(gel(gel(listpoints, 2), 2));
7425 certain = stoi(gequal(n1, n2));
7426 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
7427 {
7428 if (!gequal0(certain))
7429 {
7430 pari_printf("[E(Q):phi'(E'(Q))] = %Ps\n", shifti(gen_1, gtos(n1)));
7431 pari_printf("#S^(phi')(E'/Q) = %Ps\n", shifti(gen_1, gtos(n2)));
7432 pari_printf("#III(E'/Q)[phi'] = 1\n");
7433 pari_printf("\n");
7434 }
7435 else
7436 {
7437 pari_printf("[E(Q):phi'(E'(Q))] >= %Ps\n", shifti(gen_1, gtos(n1)));
7438 pari_printf("#S^(phi')(E'/Q) = %Ps\n", shifti(gen_1, gtos(n2)));
7439 pari_printf("#III(E'/Q)[phi'] <= %Ps\n", shifti(gen_1, gtos(gsub(n2, n1))));
7440 pari_printf("\n");
7441 }
7442 }
7443 /* */
7444 /* Working with the isogeneous curve */
7445 /* */
7446
7447 apinit = gmulsg(-2, ell_get_a2(ell));
7448 bpinit = gsub(gsqr(ell_get_a2(ell)), gmulsg(4, ell_get_a4(ell)));
7449 KS2prod = gneg(gabs(bpinit, prec));
7450 if (gcmpgs(ell_get_a4(ell), 0) < 0)
7451 KS2prod = gmulgs(KS2prod, -1);
7452 KS2gen = gcopy(gel(factor(KS2prod), 1));
7453 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
7454 {
7455 pari_printf(" #K(a^2-4b,2)gen = %ld\n", glength(KS2gen));
7456 pari_printf(" K(a^2-4b,2)gen = %Ps\n", KS2gen);
7457 }
7458 p2 = cgetg(4, t_VEC);
7459 gel(p2, 1) = gen_1;
7460 gel(p2, 2) = gcopy(apinit);
7461 gel(p2, 3) = gcopy(bpinit);
7462 /* Construction of trivial points : torsion */
7463
7464 P = gtopoly(p2, -1);
7465 p3 = cgetg(6, t_VEC);
7466 gel(p3, 1) = gen_0;
7467 gel(p3, 2) = gcopy(apinit);
7468 gel(p3, 3) = gen_0;
7469 gel(p3, 4) = gcopy(bpinit);
7470 gel(p3, 5) = gen_0;
7471 listpointstriv = gcopy(gel(elltorseven(p3, prec), 3));
7472 /* Construction of trivial points : small naive height */
7473
7474 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
7475 pari_printf(" Search for trivial points on the curve\n");
7476 P = gmul(P, x);
7477 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
7478 pari_printf(" Y^2 = %Ps\n", P);
7479 listpointstriv = concat(listpointstriv, ratpoint(P, LIMTRIV, gen_0, prec));
7480 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
7481 {
7482 pari_printf(" trivial points on E'(Q) = %Ps\n", listpointstriv);
7483 pari_printf("\n");
7484 }
7485 listpoints = ellcount(apinit, bpinit, KS2gen, listpointstriv, prec);
7486 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
7487 pari_printf(" points on E'(Q) = %Ps\n", gel(listpoints, 1));
7488 np1 = gcopy(gel(gel(listpoints, 2), 1));
7489 np2 = gcopy(gel(gel(listpoints, 2), 2));
7490 l4 = glength(gel(listpoints, 1));
7491 {
7492 long i;
7493 p5 = cgetg(l4+1, t_VEC);
7494 for (i = 1; i <= l4; ++i)
7495 gel(p5, i) = gen_0;
7496 }
7497 listpoints2 = p5;
7498 l6 = glength(gel(listpoints, 1));
7499 {
7500 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
7501 long i;
7502 GEN p8 = gen_0; /* vec */
7503 for (i = 1; i <= l6; ++i)
7504 {
7505 p8 = cgetg(3, t_VEC);
7506 gel(p8, 1) = gen_0;
7507 gel(p8, 2) = gen_0;
7508 gel(listpoints2, i) = p8;
7509 aux1 = gsqr(gel(gel(gel(listpoints, 1), i), 1));
7510 if (!gequalgs(aux1, 0))
7511 {
7512 aux2 = gcopy(gel(gel(gel(listpoints, 1), i), 2));
7513 gel(gel(listpoints2, i), 1) = gdivgs(gdiv(gsqr(aux2), aux1), 4);
7514 gel(gel(listpoints2, i), 2) = gdivgs(gdiv(gmul(aux2, gsub(bpinit, aux1)), aux1), 8);
7515 }
7516 else
7517 gel(listpoints2, i) = gcopy(gel(gel(listpoints, 1), i));
7518 if (low_stack(st_lim, stack_lim(btop, 1)))
7519 gerepileall(btop, 4, &p8, &listpoints2, &aux1, &aux2);
7520 }
7521 }
7522 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
7523 {
7524 pari_printf(" points on E(Q) = %Ps\n", listpoints2);
7525 pari_printf("\n");
7526 }
7527 pointgen = concat(pointgen, listpoints2);
7528 certainp = stoi(gequal(np1, np2));
7529 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
7530 {
7531 if (!gequal0(certainp))
7532 {
7533 pari_printf("[E'(Q):phi(E(Q))] = %Ps\n", shifti(gen_1, gtos(np1)));
7534 pari_printf("#S^(phi)(E/Q) = %Ps\n", shifti(gen_1, gtos(np2)));
7535 pari_printf("#III(E/Q)[phi] = 1\n");
7536 pari_printf("\n");
7537 }
7538 else
7539 {
7540 pari_printf("[E'(Q):phi(E(Q))] >= %Ps\n", shifti(gen_1, gtos(np1)));
7541 pari_printf("#S^(phi)(E/Q) = %Ps\n", shifti(gen_1, gtos(np2)));
7542 pari_printf("#III(E/Q)[phi] <= %Ps\n", shifti(gen_1, gtos(gsub(np2, np1))));
7543 pari_printf("\n");
7544 }
7545 if ((gequal0(certain)) && (gcmp(np2, np1) > 0))
7546 pari_printf("%Ps <= ", shifti(gen_1, gtos(gsub(np2, np1))));
7547 pari_printf("#III(E/Q)[2] ");
7548 if (!gequal0(certain) && !gequal0(certainp))
7549 pari_printf(" ");
7550 else
7551 pari_printf("<");
7552 pari_printf("= %Ps\n", shifti(gen_1, gtos(gsub(gsub(gadd(n2, np2), n1), np1))));
7553 pari_printf("#E(Q)[2] = %Ps\n", shifti(gen_1, gtos(tors)));
7554 }
7555 rang = gsubgs(gadd(n1, np1), 2);
7556 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
7557 {
7558 if (!gequal0(certain) && !gequal0(certainp))
7559 {
7560 pari_printf("#E(Q)/2E(Q) = %Ps\n", shifti(gen_1, gtos(gadd(rang, tors))));
7561 pari_printf("rank = %Ps\n", rang);
7562 pari_printf("\n");
7563 }
7564 else
7565 {
7566 pari_printf("#E(Q)/2E(Q) >= %Ps\n", shifti(gen_1, gtos(gadd(rang, tors))));
7567 pari_printf("\n");
7568 pari_printf("%Ps <= rank <= %Ps\n", rang, gsubgs(gadd(n2, np2), 2));
7569 pari_printf("\n");
7570 }
7571 }
7572 strange = gmodgs(gsub(gsub(gadd(n2, np2), n1), np1), 2);
7573 if (!gequal0(strange))
7574 {
7575 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
7576 {
7577 pari_printf(" !!! III should be a square !!!\n");
7578 pari_printf("hence\n");
7579 }
7580 if (!gequal0(certain))
7581 {
7582 np1 = gaddgs(np1, 1);
7583 certainp = stoi(gequal(np1, np2));
7584 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
7585 {
7586 if (!gequal0(certainp))
7587 {
7588 pari_printf("[E'(Q):phi(E(Q))] = %Ps\n", shifti(gen_1, gtos(np1)));
7589 pari_printf("#S^(phi)(E/Q) = %Ps\n", shifti(gen_1, gtos(np2)));
7590 pari_printf("#III(E/Q)[phi] = 1\n");
7591 pari_printf("\n");
7592 }
7593 else
7594 {
7595 pari_printf("[E'(Q):phi(E(Q))] >= %Ps\n", shifti(gen_1, gtos(np1)));
7596 pari_printf("#S^(phi)(E/Q) = %Ps\n", shifti(gen_1, gtos(np2)));
7597 pari_printf("#III(E/Q)[phi] <= %Ps\n", shifti(gen_1, gtos(gsub(np2, np1))));
7598 pari_printf("\n");
7599 }
7600 }
7601 }
7602 else
7603 {
7604 if (!gequal0(certainp))
7605 {
7606 n1 = gaddgs(n1, 1);
7607 certain = stoi(gequal(n1, n2));
7608 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
7609 {
7610 if (!gequal0(certain))
7611 {
7612 pari_printf("[E(Q):phi'(E'(Q))] = %Ps\n", shifti(gen_1, gtos(n1)));
7613 pari_printf("#S^(phi')(E'/Q) = %Ps\n", shifti(gen_1, gtos(n2)));
7614 pari_printf("#III(E'/Q)[phi'] = 1\n");
7615 pari_printf("\n");
7616 }
7617 else
7618 {
7619 pari_printf("[E(Q):phi'(E'(Q))] >= %Ps\n", shifti(gen_1, gtos(n1)));
7620 pari_printf("#S^(phi')(E'/Q) = %Ps\n", shifti(gen_1, gtos(n2)));
7621 pari_printf("#III(E'/Q)[phi'] <= %Ps\n", shifti(gen_1, gtos(gsub(n2, n1))));
7622 pari_printf("\n");
7623 }
7624 }
7625 }
7626 else
7627 n1 = gaddgs(n1, 1);
7628 }
7629 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
7630 {
7631 pari_printf("#S^(2)(E/Q) = %Ps\n", shifti(gen_1, gtos(gsubgs(gadd(n2, np2), 1))));
7632 if ((gequal0(certain)) && (gcmp(np2, np1) > 0))
7633 pari_printf(" %Ps <= ", shifti(gen_1, gtos(gsub(np2, np1))));
7634 pari_printf("#III(E/Q)[2] ");
7635 if (!gequal0(certain) && !gequal0(certainp))
7636 pari_printf(" ");
7637 else
7638 pari_printf("<");
7639 pari_printf("= %Ps\n", shifti(gen_1, gtos(gsub(gsub(gadd(n2, np2), n1), np1))));
7640 pari_printf("#E(Q)[2] = %Ps\n", shifti(gen_1, gtos(tors)));
7641 }
7642 rang = gsubgs(gadd(n1, np1), 2);
7643 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
7644 {
7645 if (!gequal0(certain) && !gequal0(certainp))
7646 {
7647 pari_printf("#E(Q)/2E(Q) = %Ps\n", shifti(gen_1, gtos(gadd(rang, tors))));
7648 pari_printf("\n");
7649 pari_printf("rank = %Ps\n", rang);
7650 pari_printf("\n");
7651 }
7652 else
7653 {
7654 pari_printf("#E(Q)/2E(Q) >= %Ps\n", shifti(gen_1, gtos(gadd(rang, tors))));
7655 pari_printf("\n");
7656 pari_printf("%Ps <= rank <= %Ps\n", rang, gsubgs(gadd(n2, np2), 2));
7657 pari_printf("\n");
7658 }
7659 }
7660 }
7661 /* end of strange */
7662
7663 pointgen = vecsort0(pointgen, NULL, 2);
7664 if (!gequal0(ELLREDGENFLAG))
7665 pointgen = ellredgen(ell, pointgen, NULL, prec);
7666 pointgen = concat(ellsort(gel(elltorseven(ell, prec), 3), prec), pointgen);
7667 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
7668 pari_printf("points = %Ps\n", pointgen);
7669 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
7670 pari_printf(" end of ell2descent_viaisog\n");
7671 p7 = cgetg(4, t_VEC);
7672 gel(p7, 1) = gcopy(rang);
7673 gel(p7, 2) = gadd(gsubgs(gadd(n2, np2), 2), tors);
7674 gel(p7, 3) = gcopy(pointgen);
7675 p7 = gerepilecopy(ltop, p7);
7676 return p7;
7677 }
7678
7679 long
7680 nfsign_s(GEN nf, GEN a, GEN i, long prec)
7681 {
7682 pari_sp ltop = avma;
7683 GEN nf_roots = gen_0, ay = gen_0, def = gen_0;
7684 long l1, l2;
7685 if (gequal0(a))
7686 {
7687 avma = ltop;
7688 return 0;
7689 }
7690 a = lift(a);
7691 if (typ(a) != t_POL)
7692 {
7693 l1 = gsigne(a);
7694 avma = ltop;
7695 return l1;
7696 }
7697 nf_roots = gcopy(member_roots(nf));
7698 def = stoi(getrealprecision());
7699 ay = gen_0;
7700 {
7701 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
7702 while (gequal0(ay) || (cmpis(precision0(ay, 0), 10) < 0))
7703 {
7704 ay = gsubst(a, gvar(gpolvar(a)), gel(nf_roots, gtos(i)));
7705 if (gequal0(ay) || (cmpis(precision0(ay, 0), 10) < 0))
7706 {
7707 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
7708 pari_printf(" **** Warning: doubling the real precision in nfsign_s **** %ld\n", 2*getrealprecision());
7709 setrealprecision(2*getrealprecision(), &prec);
7710 nf_roots = greal(roots0(member_pol(nf), 0, prec));
7711 }
7712 if (low_stack(st_lim, stack_lim(btop, 1)))
7713 gerepileall(btop, 2, &ay, &nf_roots);
7714 }
7715 }
7716 setrealprecision(gtos(def), &prec);
7717 l2 = gsigne(ay);
7718 avma = ltop;
7719 return l2;
7720 }
7721
7722 GEN
7723 nfpolratroots(GEN nf, GEN pol)
7724 {
7725 pari_sp ltop = avma;
7726 GEN f = gen_0, ans = gen_0;
7727 long l1;
7728 f = gcopy(gel(nffactor(nf, lift(pol)), 1));
7729 ans = cgetg(1, t_VEC);
7730 l1 = glength(f);
7731 {
7732 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
7733 long j;
7734 GEN p2 = gen_0; /* vec */
7735 for (j = 1; j <= l1; ++j)
7736 {
7737 if (degree(gel(f, j)) == 1)
7738 {
7739 p2 = cgetg(2, t_VEC);
7740 gel(p2, 1) = gdiv(gneg(polcoeff0(gel(f, j), 0, -1)), polcoeff0(gel(f, j), 1, -1));
7741 ans = concat(ans, p2);
7742 }
7743 if (low_stack(st_lim, stack_lim(btop, 1)))
7744 gerepileall(btop, 2, &p2, &ans);
7745 }
7746 }
7747 ans = gerepilecopy(ltop, ans);
7748 return ans;
7749 }
7750
7751 GEN
7752 nfmodid2(GEN nf, GEN a, GEN ideal)
7753 {
7754 pari_sp ltop = avma;
7755 GEN p1 = gen_0, p2 = gen_0;
7756 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
7757 pari_printf("entree dans nfmodid2\n");
7758 /* ideal doit etre sous la forme primedec */
7759 if ((lg(member_zk(nf))-1) == 1)
7760 {
7761 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
7762 pari_printf("fin de nfmodid2\n");
7763 p1 = gmul(a, gmodulsg(1, member_p(ideal)));
7764 p1 = gerepilecopy(ltop, p1);
7765 return p1;
7766 }
7767 a = mynfeltmod(nf, a, basistoalg(nf, gel(ideal, 2)));
7768 if (gequal1(ggcd(denom(content(lift(a))), member_p(ideal))))
7769 {
7770 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
7771 pari_printf("fin de nfmodid2\n");
7772 p2 = gmul(a, gmodulsg(1, member_p(ideal)));
7773 p2 = gerepilecopy(ltop, p2);
7774 return p2;
7775 }
7776 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
7777 pari_printf("fin de nfmodid2\n");
7778 a = gerepilecopy(ltop, a);
7779 return a;
7780 }
7781
7782 GEN
7783 nfhilb2(GEN nf, GEN a, GEN b, GEN p, long prec)
7784 {
7785 pari_sp ltop = avma;
7786 GEN res = gen_0, x = pol_x(fetch_user_var("x"));
7787 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
7788 pari_printf("entree dans nfhilb2\n");
7789 if (nfqpsoluble(nf, gadd(gmul(a, gsqr(x)), b), initp(nf, p, prec), prec))
7790 res = gen_1;
7791 else
7792 res = gen_m1;
7793 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
7794 pari_printf("fin de nfhilb2\n");
7795 res = gerepilecopy(ltop, res);
7796 return res;
7797 }
7798
7799 GEN
7800 mynfhilbertp(GEN nf, GEN a, GEN b, GEN p, long prec)
7801 {
7802 pari_sp ltop = avma;
7803 GEN alpha = gen_0, beta = gen_0, sig = gen_0, aux = gen_0, aux2 = gen_0, rep = gen_0, p1 = gen_0;
7804 GEN p2 = gen_0; /* vec */
7805 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
7806 pari_printf("entree dans mynfhilbertp %Ps\n", p);
7807 if (gequal0(a) || gequal0(b))
7808 pari_printf("0 argument in mynfhilbertp\n");
7809 if (cmpis(member_p(p), 2) == 0)
7810 {
7811 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
7812 pari_printf("fin de mynfhilbertp\n");
7813 p1 = nfhilb2(nf, a, b, p, prec);
7814 p1 = gerepilecopy(ltop, p1);
7815 return p1;
7816 }
7817 if (typ(a) != t_POLMOD)
7818 a = gmodulo(a, member_pol(nf));
7819 if (typ(b) != t_POLMOD)
7820 b = gmodulo(b, member_pol(nf));
7821 alpha = stoi(idealval(nf, a, p));
7822 beta = stoi(idealval(nf, b, p));
7823 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
7824 {
7825 p2 = cgetg(3, t_VEC);
7826 gel(p2, 1) = gcopy(alpha);
7827 gel(p2, 2) = gcopy(beta);
7828 pari_printf("[alpha,beta] = %Ps\n", p2);
7829 }
7830 if (gequal0(gmodgs(alpha, 2)) && gequal0(gmodgs(beta, 2)))
7831 {
7832 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
7833 pari_printf("fin de mynfhilbertp\n");
7834 avma = ltop;
7835 return gen_1;
7836 }
7837 aux2 = gdiventgs(idealnorm(nf, p), 2);
7838 if ((!gequal0(gmodgs(alpha, 2)) && !gequal0(gmodgs(beta, 2))) && !gequal0(gmodgs(aux2, 2)))
7839 sig = gen_1;
7840 else
7841 sig = gen_m1;
7842 if (!gequal0(beta))
7843 aux = nfmodid2(nf, gdiv(gpow(a, beta, prec), gpow(b, alpha, prec)), p);
7844 else
7845 aux = nfmodid2(nf, gpow(b, alpha, prec), p);
7846 aux = gadd(gpow(aux, aux2, prec), sig);
7847 aux = lift(lift(aux));
7848 if (gequal0(aux))
7849 rep = gen_1;
7850 else
7851 rep = stoi(idealval(nf, aux, p) >= 1);
7852 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
7853 pari_printf("fin de mynfhilbertp\n");
7854 if (!gequal0(rep))
7855 {
7856 avma = ltop;
7857 return gen_1;
7858 }
7859 else
7860 {
7861 avma = ltop;
7862 return gen_m1;
7863 }
7864 avma = ltop;
7865 return gen_0;
7866 }
7867
7868 GEN
7869 ideallistfactor(GEN nf, GEN listfact)
7870 {
7871 pari_sp ltop = avma;
7872 GEN Slist = gen_0, S1 = gen_0, test = gen_0, k = gen_0;
7873 long l1;
7874 /* MODI remove i,j */
7875
7876 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
7877 pari_printf("entree dans ideallistfactor\n");
7878 Slist = cgetg(1, t_VEC);
7879 test = gen_1;
7880 l1 = glength(listfact);
7881 {
7882 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
7883 long i, l2;
7884 for (i = 1; i <= l1; ++i)
7885 {
7886 if (gequal0(gel(listfact, i)))
7887 continue;
7888 S1 = gcopy(gel(idealfactor(nf, gel(listfact, i)), 1));
7889 l2 = glength(S1);
7890 {
7891 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
7892 long j, l3;
7893 GEN p4 = gen_0; /* vec */
7894 for (j = 1; j <= l2; ++j)
7895 {
7896 k = stoi(glength(Slist));
7897 l3 = glength(Slist);
7898 {
7899 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
7900 long k;
7901 for (k = 1; k <= l3; ++k)
7902 {
7903 if (gequal(gel(Slist, k), gel(S1, j)))
7904 {
7905 test = gen_0;
7906 break;
7907 }
7908 if (low_stack(st_lim, stack_lim(btop, 1)))
7909 test = gerepilecopy(btop, test);
7910 }
7911 }
7912 if (!gequal0(test))
7913 {
7914 p4 = cgetg(2, t_VEC);
7915 gel(p4, 1) = gcopy(gel(S1, j));
7916 Slist = concat(Slist, p4);
7917 }
7918 else
7919 test = gen_1;
7920 if (low_stack(st_lim, stack_lim(btop, 1)))
7921 gerepileall(btop, 4, &k, &test, &p4, &Slist);
7922 }
7923 }
7924 if (low_stack(st_lim, stack_lim(btop, 1)))
7925 gerepileall(btop, 4, &S1, &k, &test, &Slist);
7926 }
7927 }
7928 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
7929 pari_printf("fin de ideallistfactor\n");
7930 Slist = gerepilecopy(ltop, Slist);
7931 return Slist;
7932 }
7933
7934 long
7935 mynfhilbert(GEN nf, GEN a, GEN b, long prec)
7936 {
7937 pari_sp ltop = avma;
7938 GEN al = gen_0, bl = gen_0, S = gen_0;
7939 GEN p1 = gen_0; /* vec */
7940 GEN p2 = gen_0; /* int */
7941 GEN p3 = gen_0; /* vec */
7942 long l4;
7943 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
7944 {
7945 p1 = cgetg(3, t_VEC);
7946 gel(p1, 1) = gcopy(a);
7947 gel(p1, 2) = gcopy(b);
7948 pari_printf("entree dans mynfhilbert %Ps\n", p1);
7949 }
7950 if (gequal0(a) || gequal0(b))
7951 pari_err(user, "mynfhilbert : argument = 0");
7952 al = lift(a);
7953 bl = lift(b);
7954 /* solutions locales aux places reelles */
7955
7956 p2 = icopy(member_r1(nf));
7957 {
7958 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
7959 GEN i = gen_0;
7960 for (i = gen_1; gcmp(i, p2) <= 0; i = gaddgs(i, 1))
7961 {
7962 if ((nfsign_s(nf, al, i, prec) < 0) && (nfsign_s(nf, bl, i, prec) < 0))
7963 {
7964 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
7965 pari_printf("mynfhilbert non soluble a l'infini\n");
7966 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
7967 pari_printf("fin de mynfhilbert\n");
7968 avma = ltop;
7969 return -1;
7970 }
7971 if (low_stack(st_lim, stack_lim(btop, 1)))
7972 i = gerepilecopy(btop, i);
7973 }
7974 }
7975 if (typ(a) != t_POLMOD)
7976 a = gmodulo(a, member_pol(nf));
7977 if (typ(b) != t_POLMOD)
7978 b = gmodulo(b, member_pol(nf));
7979 p3 = cgetg(4, t_VEC);
7980 gel(p3, 1) = gen_2;
7981 gel(p3, 2) = gcopy(a);
7982 gel(p3, 3) = gcopy(b);
7983 /* solutions locales aux places finies (celles qui divisent 2ab) */
7984
7985 S = ideallistfactor(nf, p3);
7986 l4 = glength(S);
7987 {
7988 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
7989 GEN i = gen_0;
7990 long l5 = -1 > 0; /* bool */
7991 for (i = stoi(l4); l5?gcmpgs(i, 2) <= 0:gcmpgs(i, 2) >= 0; i = gaddgs(i, -1))
7992 {
7993 /* d'apres la formule du produit on peut eviter un premier */
7994 if (gequalm1(mynfhilbertp(nf, a, b, gel(S, gtos(i)), prec)))
7995 {
7996 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
7997 pari_printf("mynfhilbert non soluble en : %Ps\n", gel(S, gtos(i)));
7998 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
7999 pari_printf("fin de mynfhilbert\n");
8000 avma = ltop;
8001 return -1;
8002 }
8003 if (low_stack(st_lim, stack_lim(btop, 1)))
8004 i = gerepilecopy(btop, i);
8005 }
8006 }
8007 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
8008 pari_printf("fin de mynfhilbert\n");
8009 avma = ltop;
8010 return 1;
8011 }
8012
8013 GEN
8014 initp(GEN nf, GEN p, long prec)
8015 {
8016 pari_sp ltop = avma;
8017 GEN idval = gen_0, pp = gen_0;
8018 GEN p1 = gen_0; /* vec */
8019 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8020 pari_printf("entree dans initp\n");
8021 idval = stoi(idealval(nf, gen_2, p));
8022 p1 = cgetg(6, t_VEC);
8023 gel(p1, 1) = gcopy(p);
8024 gel(p1, 2) = basistoalg(nf, gel(p, 2));
8025 gel(p1, 3) = gcopy(idval);
8026 gel(p1, 4) = gen_0;
8027 gel(p1, 5) = repres(nf, p, prec);
8028 pp = p1;
8029 if (!gequal0(idval))
8030 gel(pp, 4) = idealstar0(nf, idealpow0(nf, p, gaddsg(1, gmulsg(2, idval)), 0), 1);
8031 else
8032 gel(pp, 4) = gdiventgs(gpowgs(member_p(p), pr_get_f(p)), 2);
8033 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8034 pari_printf("fin de initp\n");
8035 pp = gerepilecopy(ltop, pp);
8036 return pp;
8037 }
8038
8039 GEN
8040 deno(GEN num)
8041 {
8042 pari_sp ltop = avma;
8043 GEN p1 = gen_0, p2 = gen_0;
8044 if (gequal0(num))
8045 {
8046 avma = ltop;
8047 return gen_1;
8048 }
8049 if (typ(num) == t_POL)
8050 {
8051 p1 = denom(content(num));
8052 p1 = gerepilecopy(ltop, p1);
8053 return p1;
8054 }
8055 p2 = denom(num);
8056 p2 = gerepilecopy(ltop, p2);
8057 return p2;
8058 }
8059
8060 GEN
8061 nfratpoint(GEN nf, GEN pol, GEN lim, GEN singlepoint, long prec)
8062 {
8063 pari_sp ltop = avma;
8064 GEN compt1 = gen_0, compt2 = gen_0, deg = gen_0, n = gen_0, AA = gen_0, point = gen_0, listpoints = gen_0, vectx = gen_0, evpol = gen_0, sq = gen_0, xpol = gen_0;
8065 GEN p1 = gen_0, p2 = gen_0, p3 = gen_0, p4 = gen_0, p5 = gen_0; /* vec */
8066 GEN x = pol_x(fetch_user_var("x"));
8067 if (!singlepoint)
8068 singlepoint = gen_1;
8069 /* MODI remove xx, denoz */
8070 /* MODI add xpol */
8071
8072 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
8073 {
8074 pari_printf("entree dans nfratpoint avec pol = %Ps\n", pol);
8075 pari_printf("lim = %Ps\n", lim);
8076 }
8077 compt1 = gen_0;
8078 compt2 = gen_0;
8079 deg = stoi(degree(pol));
8080 n = stoi(degree(member_pol(nf)));
8081 AA = gshift(lim, 1);
8082 if (gequal0(singlepoint))
8083 listpoints = cgetg(1, t_VEC);
8084 /* cas triviaux */
8085 sq = nfsqrt(nf, polcoeff0(pol, 0, -1), prec);
8086 if (!gequal(sq, cgetg(1, t_VEC)))
8087 {
8088 p1 = cgetg(4, t_VEC);
8089 gel(p1, 1) = gen_0;
8090 gel(p1, 2) = gcopy(gel(sq, 1));
8091 gel(p1, 3) = gen_1;
8092 point = p1;
8093 if (!gequal0(singlepoint))
8094 {
8095 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
8096 pari_printf("fin de nfratpoint\n");
8097 point = gerepilecopy(ltop, point);
8098 return point;
8099 }
8100 p2 = cgetg(2, t_VEC);
8101 gel(p2, 1) = gcopy(point);
8102 listpoints = concat(listpoints, p2);
8103 }
8104 sq = nfsqrt(nf, pollead(pol, -1), prec);
8105 if (!gequal(sq, cgetg(1, t_VEC)))
8106 {
8107 p3 = cgetg(4, t_VEC);
8108 gel(p3, 1) = gen_1;
8109 gel(p3, 2) = gcopy(gel(sq, 1));
8110 gel(p3, 3) = gen_0;
8111 point = p3;
8112 if (!gequal0(singlepoint))
8113 {
8114 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
8115 pari_printf("fin de nfratpoint\n");
8116 point = gerepilecopy(ltop, point);
8117 return point;
8118 }
8119 p4 = cgetg(2, t_VEC);
8120 gel(p4, 1) = gcopy(point);
8121 listpoints = concat(listpoints, p4);
8122 }
8123 /* boucle generale */
8124 point = cgetg(1, t_VEC);
8125 {
8126 long i;
8127 GEN p6 = gen_0; /* vec */
8128 p5 = cgetg(gtos(n)+1, t_VEC);
8129 for (i = 1; gcmpsg(i, n) <= 0; ++i)
8130 {
8131 p6 = cgetg(3, t_VEC);
8132 gel(p6, 1) = gneg(lim);
8133 gel(p6, 2) = gcopy(lim);
8134 gel(p5, i) = p6;
8135 }
8136 }
8137 vectx = p5;
8138 {
8139 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
8140 GEN denoz = gen_0;
8141 for (denoz = gen_1; gcmp(denoz, lim) <= 0; denoz = gaddgs(denoz, 1))
8142 {
8143 {
8144 GEN fv_data = gen_0;
8145 GEN (*fv_next)(GEN, GEN); /* func_GG */
8146 GEN xx = forvec_start(vectx, 0, &fv_data, &fv_next); /* vec */
8147 {
8148 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
8149 GEN p7 = gen_0, p8 = gen_0; /* vec */
8150 for ( ; xx; xx = fv_next(fv_data, xx))
8151 {
8152 if (gequal1(denoz) || gequal1(ggcd(content(xx), denoz)))
8153 {
8154 xpol = basistoalg(nf, gtrans(xx));
8155 evpol = gsubst(pol, gvar(x), gdiv(xpol, denoz));
8156 sq = nfsqrt(nf, evpol, prec);
8157 if (!gequal(sq, cgetg(1, t_VEC)))
8158 {
8159 p7 = cgetg(4, t_VEC);
8160 gel(p7, 1) = gdiv(xpol, denoz);
8161 gel(p7, 2) = gcopy(gel(sq, 1));
8162 gel(p7, 3) = gen_1;
8163 point = p7;
8164 if (!gequal0(singlepoint))
8165 goto label5;
8166 p8 = cgetg(2, t_VEC);
8167 gel(p8, 1) = gcopy(point);
8168 listpoints = concat(listpoints, p8);
8169 }
8170 }
8171 if (low_stack(st_lim, stack_lim(btop, 1)))
8172 gerepileall(btop, 8, &xpol, &evpol, &sq, &p7, &point, &p8, &listpoints, &xx);
8173 }
8174 }
8175 }
8176 if (low_stack(st_lim, stack_lim(btop, 1)))
8177 gerepileall(btop, 6, &denoz, &xpol, &evpol, &sq, &point, &listpoints);
8178 }
8179 label5:;
8180 }
8181 if (!gequal0(singlepoint))
8182 listpoints = point;
8183 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
8184 pari_printf("sortie de nfratpoint\n");
8185 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
8186 pari_printf("points trouves par nfratpoint = %Ps\n", listpoints);
8187 listpoints = gerepilecopy(ltop, listpoints);
8188 return listpoints;
8189 }
8190
8191 GEN
8192 repres(GEN nf, GEN p, long prec)
8193 {
8194 pari_sp ltop = avma;
8195 GEN fond = gen_0, mat = gen_0, f = gen_0, rep = gen_0, pp = gen_0, ppi = gen_0, pp2 = gen_0, jppi = gen_0, gjf = gen_0;
8196 long l1;
8197 GEN p2 = gen_0;
8198 GEN p3 = gen_0; /* vec */
8199 GEN p4 = gen_0;
8200 /* MODI remove i,j,k */
8201
8202 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8203 pari_printf("entree dans repres\n");
8204 fond = cgetg(1, t_VEC);
8205 mat = idealhnf0(nf, p, NULL);
8206 l1 = glength(mat);
8207 {
8208 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
8209 long i;
8210 for (i = 1; i <= l1; ++i)
8211 {
8212 if (!gequalgs(gcoeff(mat, i, i), 1))
8213 fond = concat(fond, gel(member_zk(nf), i));
8214 if (low_stack(st_lim, stack_lim(btop, 1)))
8215 fond = gerepilecopy(btop, fond);
8216 }
8217 }
8218 f = stoi(glength(fond));
8219 pp = icopy(member_p(p));
8220 p2 = gpow(pp, f, prec);
8221 {
8222 long i;
8223 p3 = cgetg(gtos(p2)+1, t_VEC);
8224 for (i = 1; gcmpsg(i, p2) <= 0; ++i)
8225 gel(p3, i) = gen_0;
8226 }
8227 rep = p3;
8228 gel(rep, 1) = gen_0;
8229 ppi = gen_1;
8230 pp2 = gdiventgs(pp, 2);
8231 {
8232 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
8233 GEN i = gen_0, p5 = gen_0;
8234 for (i = gen_1; gcmp(i, f) <= 0; i = gaddgs(i, 1))
8235 {
8236 p5 = gsubgs(pp, 1);
8237 {
8238 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
8239 GEN j = gen_0, p6 = gen_0;
8240 for (j = gen_1; gcmp(j, p5) <= 0; j = gaddgs(j, 1))
8241 {
8242 if (gcmp(j, pp2) <= 0)
8243 gjf = gmul(j, gel(fond, gtos(i)));
8244 else
8245 gjf = gmul(gsub(j, pp), gel(fond, gtos(i)));
8246 jppi = gmul(j, ppi);
8247 p6 = gsubgs(ppi, 1);
8248 {
8249 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
8250 GEN k = gen_0;
8251 for (k = gen_0; gcmp(k, p6) <= 0; k = gaddgs(k, 1))
8252 {
8253 gel(rep, gtos(gaddgs(gadd(jppi, k), 1))) = gadd(gel(rep, gtos(gaddgs(k, 1))), gjf);
8254 if (low_stack(st_lim, stack_lim(btop, 1)))
8255 gerepileall(btop, 2, &k, &rep);
8256 }
8257 }
8258 if (low_stack(st_lim, stack_lim(btop, 1)))
8259 gerepileall(btop, 5, &j, &gjf, &jppi, &p6, &rep);
8260 }
8261 }
8262 ppi = gmul(ppi, pp);
8263 if (low_stack(st_lim, stack_lim(btop, 1)))
8264 gerepileall(btop, 6, &i, &p5, &gjf, &jppi, &rep, &ppi);
8265 }
8266 }
8267 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8268 pari_printf("fin de repres\n");
8269 p4 = gmodulo(rep, member_pol(nf));
8270 p4 = gerepilecopy(ltop, p4);
8271 return p4;
8272 }
8273
8274 GEN
8275 val(GEN nf, GEN num, GEN p)
8276 {
8277 pari_sp ltop = avma;
8278 GEN p1 = gen_0;
8279 if (gequal0(num))
8280 p1 = BIGINT;
8281 else
8282 p1 = stoi(idealval(nf, lift(num), p));
8283 p1 = gerepilecopy(ltop, p1);
8284 return p1;
8285 }
8286
8287 GEN
8288 nfissquarep(GEN nf, GEN a, GEN p, GEN q, long prec)
8289 {
8290 pari_sp ltop = avma;
8291 GEN pherm = gen_0, f = gen_0, aaa = gen_0, n = gen_0, pp = gen_0, qq = gen_0, e = gen_0, z = gen_0, xx = gen_0, yy = gen_0, r = gen_0, aux = gen_0, b = gen_0, m = gen_0, vp = gen_0, inv2x = gen_0, zinit = gen_0, zlog = gen_0, expo = gen_0, id = gen_0;
8292 long l1;
8293 /* MODI add id */
8294
8295 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8296 pari_printf("entree dans nfissquarep %Ps%Ps%Ps\n", a, p, q);
8297 if (gequal0(a) || gequal1(a))
8298 {
8299 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
8300 pari_printf("fin de nfissquarep\n");
8301 a = gerepilecopy(ltop, a);
8302 return a;
8303 }
8304 pherm = idealhnf0(nf, p, NULL);
8305 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8306 pari_printf("pherm = %Ps\n", pherm);
8307 f = stoi(idealval(nf, a, p));
8308 if (gcmp(f, q) >= 0)
8309 {
8310 if (gcmp(f, q) > 0)
8311 aaa = gpow(basistoalg(nf, gel(p, 2)), gshift(gaddgs(q, 1), -1), prec);
8312 else
8313 aaa = gen_0;
8314 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
8315 pari_printf("fin de nfissquarep\n");
8316 aaa = gerepilecopy(ltop, aaa);
8317 return aaa;
8318 }
8319 if (!gequal0(f))
8320 aaa = gmul(a, gpow(basistoalg(nf, gdiv(gel(p, 5), member_p(p))), f, prec));
8321 else
8322 aaa = gcopy(a);
8323 if (!gequalgs(gcoeff(pherm, 1, 1), 2))
8324 {
8325 /* cas ou p ne divise pas 2 */
8326 /* algorithme de Shanks */
8327 n = nfrandintmodid(nf, pherm);
8328 {
8329 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
8330 while (nfpsquareodd(nf, n, p, prec))
8331 {
8332 n = nfrandintmodid(nf, pherm);
8333 if (low_stack(st_lim, stack_lim(btop, 1)))
8334 n = gerepilecopy(btop, n);
8335 }
8336 }
8337 pp = gmodulsg(1, member_p(p));
8338 n = gmul(n, pp);
8339 qq = gdiventgs(idealnorm(nf, pherm), 2);
8340 e = gen_1;
8341 {
8342 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
8343 while (gequal0(gmodgs(qq, 2)))
8344 {
8345 e = gaddgs(e, 1);
8346 qq = gdivent(qq, gen_2);
8347 if (low_stack(st_lim, stack_lim(btop, 1)))
8348 gerepileall(btop, 2, &e, &qq);
8349 }
8350 }
8351 z = mynfeltreduce(nf, lift(lift(gpow(n, qq, prec))), pherm);
8352 yy = z;
8353 r = e;
8354 xx = mynfeltreduce(nf, lift(lift(gpow(gmul(aaa, pp), gdiventgs(qq, 2), prec))), pherm);
8355 aux = mynfeltreduce(nf, gmul(aaa, xx), pherm);
8356 b = mynfeltreduce(nf, gmul(aux, xx), pherm);
8357 xx = aux;
8358 aux = b;
8359 m = gen_0;
8360 {
8361 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
8362 while (gequal0(val(nf, gsubgs(aux, 1), p)))
8363 {
8364 m = gaddgs(m, 1);
8365 aux = mynfeltreduce(nf, gsqr(aux), pherm);
8366 if (low_stack(st_lim, stack_lim(btop, 1)))
8367 gerepileall(btop, 2, &m, &aux);
8368 }
8369 }
8370 {
8371 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
8372 while (!gequal0(m))
8373 {
8374 if (gequal(m, r))
8375 pari_err(user, "nfissquarep : m = r");
8376 yy = gmul(yy, pp);
8377 aux = mynfeltreduce(nf, lift(lift(powgi(yy, shifti(gen_1, gtos(gsubgs(gsub(r, m), 1)))))), pherm);
8378 yy = mynfeltreduce(nf, gsqr(aux), pherm);
8379 r = m;
8380 xx = mynfeltreduce(nf, gmul(xx, aux), pherm);
8381 b = mynfeltreduce(nf, gmul(b, yy), pherm);
8382 aux = b;
8383 m = gen_0;
8384 {
8385 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
8386 while (gequal0(val(nf, gsubgs(aux, 1), p)))
8387 {
8388 m = gaddgs(m, 1);
8389 aux = mynfeltreduce(nf, gsqr(aux), pherm);
8390 if (low_stack(st_lim, stack_lim(btop, 1)))
8391 gerepileall(btop, 2, &m, &aux);
8392 }
8393 }
8394 if (low_stack(st_lim, stack_lim(btop, 1)))
8395 gerepileall(btop, 6, &yy, &aux, &r, &xx, &b, &m);
8396 }
8397 }
8398 /* lift de Hensel */
8399 /* */
8400 if (gcmpgs(q, 1) > 0)
8401 {
8402 vp = stoi(idealval(nf, gsub(gsqr(xx), aaa), p));
8403 if (gcmp(vp, gsub(q, f)) < 0)
8404 {
8405 yy = gmulsg(2, xx);
8406 inv2x = gdiv(basistoalg(nf, gel(idealaddtoone0(nf, yy, p), 1)), yy);
8407 {
8408 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
8409 while (gcmp(vp, q) < 0)
8410 {
8411 vp = gaddgs(vp, 1);
8412 xx = gsub(xx, gmul(gsub(gsqr(xx), aaa), inv2x));
8413 if (low_stack(st_lim, stack_lim(btop, 1)))
8414 gerepileall(btop, 2, &vp, &xx);
8415 }
8416 }
8417 }
8418 if (!gequal0(f))
8419 xx = gmul(xx, gpow(basistoalg(nf, gel(p, 2)), gshift(f, -1), prec));
8420 }
8421 xx = mynfeltreduce(nf, xx, idealpow0(nf, p, q, 0));
8422 }
8423 else
8424 {
8425 /* cas ou p divise 2 *\ */
8426 if (gcmpgs(gsub(q, f), 1) > 0)
8427 id = idealpow0(nf, p, gsub(q, f), 0);
8428 else
8429 id = pherm;
8430 zinit = idealstar0(nf, id, 2);
8431 zlog = ideallog(nf, aaa, zinit);
8432 xx = gen_1;
8433 l1 = glength(zlog);
8434 {
8435 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
8436 long i;
8437 for (i = 1; i <= l1; ++i)
8438 {
8439 expo = gcopy(gel(zlog, i));
8440 if (!gequal0(expo))
8441 {
8442 if (smodss(gequal0(expo), 2))
8443 expo = gshift(expo, -1);
8444 else
8445 {
8446 aux = gcopy(gel(gel(zinit, 2), i));
8447 expo = gmod(gmul(expo, gshift(gaddgs(aux, 1), -1)), aux);
8448 }
8449 xx = gmul(xx, gpow(basistoalg(nf, gel(gel(gel(zinit, 2), 3), i)), expo, prec));
8450 }
8451 if (low_stack(st_lim, stack_lim(btop, 1)))
8452 gerepileall(btop, 3, &expo, &aux, &xx);
8453 }
8454 }
8455 if (!gequal0(f))
8456 {
8457 xx = gmul(xx, gpow(basistoalg(nf, gel(p, 2)), gshift(f, -1), prec));
8458 id = idealpow0(nf, p, q, 0);
8459 }
8460 xx = mynfeltreduce(nf, xx, id);
8461 }
8462 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
8463 pari_printf("fin de nfissquarep %Ps\n", xx);
8464 xx = gerepilecopy(ltop, xx);
8465 return xx;
8466 }
8467
8468 long
8469 nfpsquareodd(GEN nf, GEN a, GEN p, long prec)
8470 {
8471 pari_sp ltop = avma;
8472 GEN v = gen_0, ap = gen_0, norme = gen_0, den = gen_0;
8473 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8474 pari_printf("entree dans nfpsquareodd\n");
8475 if (gequal0(a))
8476 {
8477 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8478 pari_printf("fin de nfpsquareodd\n");
8479 avma = ltop;
8480 return 1;
8481 }
8482 v = stoi(idealval(nf, lift(a), p));
8483 if (!gequal0(gmodgs(v, 2)))
8484 {
8485 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8486 pari_printf("fin de nfpsquareodd\n");
8487 avma = ltop;
8488 return 0;
8489 }
8490 ap = gdiv(a, gpow(basistoalg(nf, gel(p, 2)), v, prec));
8491 norme = gdiventgs(idealnorm(nf, p), 2);
8492 den = gmod(denom(content(lift(ap))), member_p(p));
8493 if (gsigne(den))
8494 ap = gmul(ap, gmodulsg(1, member_p(p)));
8495 ap = gsubgs(gpow(ap, norme, prec), 1);
8496 if (gequal0(ap))
8497 {
8498 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8499 pari_printf("fin de nfpsquareodd\n");
8500 avma = ltop;
8501 return 1;
8502 }
8503 ap = lift(lift(ap));
8504 if (idealval(nf, ap, p) > 0)
8505 {
8506 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8507 pari_printf("fin de nfpsquareodd\n");
8508 avma = ltop;
8509 return 1;
8510 }
8511 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8512 pari_printf("fin de nfpsquareodd\n");
8513 avma = ltop;
8514 return 0;
8515 }
8516
8517 long
8518 nfpsquare(GEN nf, GEN a, GEN p, GEN zinit, long prec)
8519 {
8520 pari_sp ltop = avma;
8521 GEN valap = gen_0, zlog = gen_0;
8522 GEN p1 = gen_0; /* vec */
8523 long l2, l3;
8524 /* MODI remove i */
8525
8526 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8527 {
8528 p1 = cgetg(4, t_VEC);
8529 gel(p1, 1) = gcopy(a);
8530 gel(p1, 2) = gcopy(p);
8531 gel(p1, 3) = gcopy(zinit);
8532 pari_printf("entree dans nfpsquare %Ps\n", p1);
8533 }
8534 if (gequal0(a))
8535 {
8536 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8537 pari_printf("fin de nfpsquare\n");
8538 avma = ltop;
8539 return 1;
8540 }
8541 if (cmpis(member_p(p), 2) != 0)
8542 {
8543 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8544 pari_printf("fin de nfpsquare\n");
8545 l2 = nfpsquareodd(nf, a, p, prec);
8546 avma = ltop;
8547 return l2;
8548 }
8549 valap = stoi(idealval(nf, a, p));
8550 if (!gequal0(gmodgs(valap, 2)))
8551 {
8552 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8553 pari_printf("fin de nfpsquare\n");
8554 avma = ltop;
8555 return 0;
8556 }
8557 if (!gequal0(valap))
8558 zlog = ideallog(nf, gmul(a, gpow(gdiv(basistoalg(nf, gel(p, 5)), member_p(p)), valap, prec)), zinit);
8559 else
8560 zlog = ideallog(nf, a, zinit);
8561 l3 = glength(gel(gel(zinit, 2), 2));
8562 {
8563 pari_sp btop = avma;
8564 long i;
8565 for (i = 1; i <= l3; ++i)
8566 {
8567 if ((gequal0(gmodgs(gel(gel(gel(zinit, 2), 2), i), 2))) && !gequal0(gmodgs(gel(zlog, i), 2)))
8568 {
8569 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8570 pari_printf("fin de nfpsquare\n");
8571 avma = ltop;
8572 return 0;
8573 }
8574 avma = btop;
8575 }
8576 }
8577 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8578 pari_printf("fin de nfpsquare\n");
8579 avma = ltop;
8580 return 1;
8581 }
8582
8583 long
8584 nfpsquareq(GEN nf, GEN a, GEN p, GEN q, long prec)
8585 {
8586 pari_sp ltop = avma;
8587 GEN vala = gen_0, zinit = gen_0, zlog = gen_0;
8588 GEN p1 = gen_0; /* vec */
8589 long l2;
8590 /* MODI remove i */
8591
8592 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8593 {
8594 p1 = cgetg(4, t_VEC);
8595 gel(p1, 1) = gcopy(a);
8596 gel(p1, 2) = gcopy(p);
8597 gel(p1, 3) = gcopy(q);
8598 pari_printf("entree dans nfpsquareq %Ps\n", p1);
8599 }
8600 if (gequal0(a))
8601 {
8602 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8603 pari_printf("fin de nfpsquareq\n");
8604 avma = ltop;
8605 return 1;
8606 }
8607 vala = stoi(idealval(nf, a, p));
8608 if (gcmp(vala, q) >= 0)
8609 {
8610 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8611 pari_printf("fin de nfpsquareq\n");
8612 avma = ltop;
8613 return 1;
8614 }
8615 if (!gequal0(gmodgs(vala, 2)))
8616 {
8617 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8618 pari_printf("fin de nfpsquareq\n");
8619 avma = ltop;
8620 return 0;
8621 }
8622 zinit = idealstar0(nf, idealpow0(nf, p, gsub(q, vala), 0), 2);
8623 zlog = ideallog(nf, gmul(a, gpow(basistoalg(nf, gdivgs(gel(p, 5), 2)), vala, prec)), zinit);
8624 l2 = glength(gel(gel(zinit, 2), 2));
8625 {
8626 pari_sp btop = avma;
8627 long i;
8628 for (i = 1; i <= l2; ++i)
8629 {
8630 if ((gequal0(gmodgs(gel(gel(gel(zinit, 2), 2), i), 2))) && !gequal0(gmodgs(gel(zlog, i), 2)))
8631 {
8632 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8633 pari_printf("fin de nfpsquareq\n");
8634 avma = ltop;
8635 return 0;
8636 }
8637 avma = btop;
8638 }
8639 }
8640 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8641 pari_printf("fin de nfpsquareq\n");
8642 avma = ltop;
8643 return 1;
8644 }
8645
8646 long
8647 nflemma6(GEN nf, GEN pol, GEN p, GEN nu, GEN xx, long prec)
8648 {
8649 pari_sp ltop = avma;
8650 GEN gx = gen_0, gpx = gen_0, lambda = gen_0, mu = gen_0, x = pol_x(fetch_user_var("x"));
8651 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8652 pari_printf("entree dans nflemma6\n");
8653 gx = gsubst(pol, gvar(x), xx);
8654 if (nfpsquareodd(nf, gx, p, prec))
8655 {
8656 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8657 pari_printf("fin de nflemma6\n");
8658 avma = ltop;
8659 return 1;
8660 }
8661 gpx = gsubst(deriv(pol,-1), gvar(x), xx);
8662 lambda = val(nf, gx, p);
8663 mu = val(nf, gpx, p);
8664 if (gcmp(lambda, gmulsg(2, mu)) > 0)
8665 {
8666 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8667 pari_printf("fin de nflemma6\n");
8668 avma = ltop;
8669 return 1;
8670 }
8671 if ((gcmp(lambda, gmulsg(2, nu)) >= 0) && (gcmp(mu, nu) >= 0))
8672 {
8673 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8674 pari_printf("fin de nflemma6\n");
8675 avma = ltop;
8676 return 0;
8677 }
8678 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8679 pari_printf("fin de nflemma6\n");
8680 avma = ltop;
8681 return -1;
8682 }
8683
8684 long
8685 nflemma7(GEN nf, GEN pol, GEN p, GEN nu, GEN xx, GEN zinit, long prec)
8686 {
8687 pari_sp ltop = avma;
8688 GEN gx = gen_0, gpx = gen_0, v = gen_0, lambda = gen_0, mu = gen_0, q = gen_0;
8689 GEN p1 = gen_0; /* vec */
8690 GEN x = pol_x(fetch_user_var("x"));
8691 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8692 {
8693 p1 = cgetg(3, t_VEC);
8694 gel(p1, 1) = gcopy(xx);
8695 gel(p1, 2) = gcopy(nu);
8696 pari_printf("entree dans nflemma7 %Ps\n", p1);
8697 }
8698 gx = gsubst(pol, gvar(x), xx);
8699 if (nfpsquare(nf, gx, p, zinit, prec))
8700 {
8701 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8702 pari_printf("fin de nflemma7\n");
8703 avma = ltop;
8704 return 1;
8705 }
8706 gpx = gsubst(deriv(pol,-1), gvar(x), xx);
8707 v = gcopy(gel(p, 3));
8708 lambda = val(nf, gx, p);
8709 mu = val(nf, gpx, p);
8710 if (gcmp(lambda, gmulsg(2, mu)) > 0)
8711 {
8712 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8713 pari_printf("fin de nflemma7\n");
8714 avma = ltop;
8715 return 1;
8716 }
8717 if (gcmp(nu, mu) > 0)
8718 {
8719 if (!gequal0(gmodgs(lambda, 2)))
8720 {
8721 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8722 pari_printf("fin de nflemma7\n");
8723 avma = ltop;
8724 return -1;
8725 }
8726 q = gsub(gadd(mu, nu), lambda);
8727 if (gcmp(q, gmulsg(2, v)) > 0)
8728 {
8729 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8730 pari_printf("fin de nflemma7\n");
8731 avma = ltop;
8732 return -1;
8733 }
8734 if (nfpsquareq(nf, gmul(gx, gpow(basistoalg(nf, gdivgs(gel(p, 5), 2)), lambda, prec)), p, q, prec))
8735 {
8736 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8737 pari_printf("fin de nflemma7\n");
8738 avma = ltop;
8739 return 1;
8740 }
8741 }
8742 else
8743 {
8744 if (gcmp(lambda, gmulsg(2, nu)) >= 0)
8745 {
8746 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8747 pari_printf("fin de nflemma7\n");
8748 avma = ltop;
8749 return 0;
8750 }
8751 if (!gequal0(gmodgs(lambda, 2)))
8752 {
8753 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8754 pari_printf("fin de nflemma7\n");
8755 avma = ltop;
8756 return -1;
8757 }
8758 q = gsub(gmulsg(2, nu), lambda);
8759 if (gcmp(q, gmulsg(2, v)) > 0)
8760 {
8761 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8762 pari_printf("fin de nflemma7\n");
8763 avma = ltop;
8764 return -1;
8765 }
8766 if (nfpsquareq(nf, gmul(gx, gpow(basistoalg(nf, gdivgs(gel(p, 5), 2)), lambda, prec)), p, q, prec))
8767 {
8768 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8769 pari_printf("fin de nflemma7\n");
8770 avma = ltop;
8771 return 0;
8772 }
8773 }
8774 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8775 pari_printf("fin de nflemma7\n");
8776 avma = ltop;
8777 return -1;
8778 }
8779
8780 long
8781 nfzpsoluble(GEN nf, GEN pol, GEN p, GEN nu, GEN pnu, GEN x0, long prec)
8782 {
8783 pari_sp ltop = avma;
8784 GEN result = gen_0, pnup = gen_0, lrep = gen_0;
8785 GEN p1 = gen_0; /* vec */
8786 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8787 {
8788 p1 = cgetg(3, t_VEC);
8789 gel(p1, 1) = lift(x0);
8790 gel(p1, 2) = gcopy(nu);
8791 pari_printf("entree dans nfzpsoluble %Ps\n", p1);
8792 }
8793 if (gequal0(gel(p, 3)))
8794 result = stoi(nflemma6(nf, pol, gel(p, 1), nu, x0, prec));
8795 else
8796 result = stoi(nflemma7(nf, pol, gel(p, 1), nu, x0, gel(p, 4), prec));
8797 if (gequalgs(result, 1))
8798 {
8799 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8800 pari_printf("fin de nfzpsoluble\n");
8801 avma = ltop;
8802 return 1;
8803 }
8804 if (gequalm1(result))
8805 {
8806 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8807 pari_printf("fin de nfzpsoluble\n");
8808 avma = ltop;
8809 return 0;
8810 }
8811 pnup = gmul(pnu, gel(p, 2));
8812 lrep = stoi(glength(gel(p, 5)));
8813 nu = gaddgs(nu, 1);
8814 {
8815 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
8816 GEN i = gen_0;
8817 for (i = gen_1; gcmp(i, lrep) <= 0; i = gaddgs(i, 1))
8818 {
8819 if (nfzpsoluble(nf, pol, p, nu, pnup, gadd(x0, gmul(pnu, gel(gel(p, 5), gtos(i)))), prec))
8820 {
8821 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8822 pari_printf("fin de nfzpsoluble\n");
8823 avma = ltop;
8824 return 1;
8825 }
8826 if (low_stack(st_lim, stack_lim(btop, 1)))
8827 i = gerepilecopy(btop, i);
8828 }
8829 }
8830 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8831 pari_printf("fin de nfzpsoluble\n");
8832 avma = ltop;
8833 return 0;
8834 }
8835
8836 GEN
8837 mynfeltmod(GEN nf, GEN a, GEN b)
8838 {
8839 pari_sp ltop = avma;
8840 GEN qred = gen_0;
8841 qred = ground(algtobasis(nf, gdiv(a, b)));
8842 qred = gsub(a, gmul(b, basistoalg(nf, qred)));
8843 qred = gerepilecopy(ltop, qred);
8844 return qred;
8845 }
8846
8847 GEN
8848 mynfeltreduce(GEN nf, GEN a, GEN id)
8849 {
8850 pari_sp ltop = avma;
8851 GEN p1 = gen_0;
8852 p1 = basistoalg(nf, nfreduce(nf, algtobasis(nf, a), id));
8853 p1 = gerepilecopy(ltop, p1);
8854 return p1;
8855 }
8856
8857 GEN
8858 nfrandintmodid(GEN nf, GEN id)
8859 {
8860 pari_sp ltop = avma;
8861 GEN res = gen_0;
8862 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8863 pari_printf("entree dans nfrandintmodid\n");
8864 res = gen_0;
8865 {
8866 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
8867 while (gequal0(res))
8868 {
8869 res = nfrandint(nf, gen_0);
8870 res = mynfeltreduce(nf, res, id);
8871 if (low_stack(st_lim, stack_lim(btop, 1)))
8872 res = gerepilecopy(btop, res);
8873 }
8874 }
8875 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8876 pari_printf("fin de nfrandintmodid\n");
8877 res = gerepilecopy(ltop, res);
8878 return res;
8879 }
8880
8881 GEN
8882 nfrandint(GEN nf, GEN borne)
8883 {
8884 pari_sp ltop = avma;
8885 GEN l = gen_0, res = gen_0;
8886 GEN p1 = gen_0; /* vec */
8887 /* MODI remove i */
8888
8889 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8890 pari_printf("entree dans nfrandint\n");
8891 l = stoi(lg(member_zk(nf))-1);
8892 {
8893 long i;
8894 p1 = cgetg(gtos(l)+1, t_COL);
8895 for (i = 1; gcmpsg(i, l) <= 0; ++i)
8896 gel(p1, i) = gen_0;
8897 }
8898 res = p1;
8899 {
8900 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
8901 GEN i = gen_0;
8902 for (i = gen_1; gcmp(i, l) <= 0; i = gaddgs(i, 1))
8903 {
8904 if (!gequal0(borne))
8905 gel(res, gtos(i)) = gsub(genrand(gshift(borne, 1)), borne);
8906 else
8907 gel(res, gtos(i)) = genrand(NULL);
8908 if (low_stack(st_lim, stack_lim(btop, 1)))
8909 gerepileall(btop, 2, &i, &res);
8910 }
8911 }
8912 res = basistoalg(nf, res);
8913 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
8914 pari_printf("fin de nfrandint\n");
8915 res = gerepilecopy(ltop, res);
8916 return res;
8917 }
8918
8919 long
8920 nfqpsolublebig(GEN nf, GEN pol, GEN p, GEN ap, GEN b, long prec)
8921 {
8922 pari_sp ltop = avma;
8923 GEN deg = gen_0, xx = gen_0, z = gen_0, Px = gen_0, cont = gen_0, pi = gen_0, pol2 = gen_0, Roots = gen_0;
8924 long l1;
8925 GEN x = pol_x(fetch_user_var("x"));
8926 if (!ap)
8927 ap = gen_0;
8928 if (!b)
8929 b = gen_1;
8930 /* MODI remove i,j */
8931
8932 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
8933 pari_printf("entree dans nfqpsolublebig avec %Ps\n", member_p(p));
8934 deg = stoi(degree(pol));
8935 if (nfpsquareodd(nf, polcoeff0(pol, 0, -1), p, prec))
8936 {
8937 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
8938 pari_printf("fin de nfqpsolublebig\n");
8939 avma = ltop;
8940 return 1;
8941 }
8942 if (nfpsquareodd(nf, pollead(pol, -1), p, prec))
8943 {
8944 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
8945 pari_printf("fin de nfqpsolublebig\n");
8946 avma = ltop;
8947 return 1;
8948 }
8949 /* on tient compte du contenu de pol */
8950 cont = stoi(idealval(nf, polcoeff0(pol, 0, -1), p));
8951 {
8952 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
8953 GEN i = gen_0;
8954 for (i = gen_1; gcmp(i, deg) <= 0; i = gaddgs(i, 1))
8955 {
8956 if (!gequal0(cont))
8957 cont = gmings(cont, idealval(nf, polcoeff0(pol, gtos(i), -1), p));
8958 if (low_stack(st_lim, stack_lim(btop, 1)))
8959 gerepileall(btop, 2, &i, &cont);
8960 }
8961 }
8962 if (!gequal0(cont))
8963 pi = basistoalg(nf, gdiv(gel(p, 5), member_p(p)));
8964 if (gcmpgs(cont, 1) > 0)
8965 pol = gmul(pol, gpow(pi, gmulsg(2, gdiventgs(cont, 2)), prec));
8966 /* On essaye des valeurs de x au hasard */
8967 if (!gequal0(gmodgs(cont, 2)))
8968 pol2 = gmul(pol, pi);
8969 else
8970 {
8971 pol2 = gcopy(pol);
8972 {
8973 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
8974 GEN i = gen_0, p2 = gen_0;
8975 for (i = gen_1; gcmp(i, MAXPROB) <= 0; i = gaddgs(i, 1))
8976 {
8977 xx = nfrandint(nf, gen_0);
8978 z = gen_0;
8979 {
8980 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
8981 while (gequal0(z))
8982 {
8983 z = genrand(NULL);
8984 if (low_stack(st_lim, stack_lim(btop, 1)))
8985 z = gerepilecopy(btop, z);
8986 }
8987 }
8988 xx = gadd(gmul(gneg(ap), z), gmul(b, xx));
8989 Px = polcoeff0(pol, gtos(deg), -1);
8990 p2 = gsubgs(deg, 1);
8991 {
8992 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
8993 GEN j = gen_0;
8994 long l3 = -1 > 0; /* bool */
8995 for (j = p2; l3?gcmpgs(j, 0) <= 0:gcmpgs(j, 0) >= 0; j = gaddgs(j, -1))
8996 {
8997 Px = gadd(gmul(Px, xx), polcoeff0(pol, gtos(j), -1));
8998 if (low_stack(st_lim, stack_lim(btop, 1)))
8999 gerepileall(btop, 2, &j, &Px);
9000 }
9001 }
9002 Px = gmul(Px, gpow(z, deg, prec));
9003 if (nfpsquareodd(nf, Px, p, prec))
9004 {
9005 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
9006 pari_printf("fin de nfqpsolublebig\n");
9007 avma = ltop;
9008 return 1;
9009 }
9010 if (low_stack(st_lim, stack_lim(btop, 1)))
9011 gerepileall(btop, 5, &i, &xx, &z, &Px, &p2);
9012 }
9013 }
9014 }
9015 /* On essaye les racines de pol */
9016 Roots = nfpolrootsmod(nf, pol2, p);
9017 pi = basistoalg(nf, gel(p, 2));
9018 l1 = glength(Roots);
9019 {
9020 pari_sp btop = avma;
9021 long i;
9022 for (i = 1; i <= l1; ++i)
9023 {
9024 if (nfqpsolublebig(nf, gsubst(pol, gvar(x), gadd(gmul(pi, x), gel(Roots, i))), p, NULL, NULL, prec))
9025 {
9026 avma = ltop;
9027 return 1;
9028 }
9029 avma = btop;
9030 }
9031 }
9032 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
9033 pari_printf("fin de nfqpsolublebig\n");
9034 avma = ltop;
9035 return 0;
9036 }
9037
9038 GEN
9039 nfpolrootsmod(GEN nf, GEN pol, GEN p)
9040 {
9041 pari_sp ltop = avma;
9042 GEN factlist = gen_0, sol = gen_0;
9043 long l1;
9044 factlist = gcopy(gel(nffactormod(nf, pol, p), 1));
9045 sol = cgetg(1, t_VEC);
9046 l1 = glength(factlist);
9047 {
9048 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
9049 long i;
9050 GEN p2 = gen_0; /* vec */
9051 for (i = 1; i <= l1; ++i)
9052 {
9053 if (degree(gel(factlist, i)) == 1)
9054 {
9055 p2 = cgetg(2, t_VEC);
9056 gel(p2, 1) = gdiv(gneg(polcoeff0(gel(factlist, i), 0, -1)), polcoeff0(gel(factlist, i), 1, -1));
9057 sol = concat(sol, p2);
9058 }
9059 if (low_stack(st_lim, stack_lim(btop, 1)))
9060 gerepileall(btop, 2, &p2, &sol);
9061 }
9062 }
9063 sol = gerepilecopy(ltop, sol);
9064 return sol;
9065 }
9066
9067 long
9068 nfqpsoluble(GEN nf, GEN pol, GEN p, long prec)
9069 {
9070 pari_sp ltop = avma;
9071 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
9072 pari_printf("entree dans nfqpsoluble %Ps\n", p);
9073 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
9074 pari_printf("pol = %Ps\n", pol);
9075 if (nfpsquare(nf, pollead(pol, -1), gel(p, 1), gel(p, 4), prec))
9076 {
9077 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
9078 pari_printf("fin de nfqpsoluble\n");
9079 avma = ltop;
9080 return 1;
9081 }
9082 if (nfpsquare(nf, polcoeff0(pol, 0, -1), gel(p, 1), gel(p, 4), prec))
9083 {
9084 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
9085 pari_printf("fin de nfqpsoluble\n");
9086 avma = ltop;
9087 return 1;
9088 }
9089 if (nfzpsoluble(nf, pol, p, gen_0, gen_1, gen_0, prec))
9090 {
9091 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
9092 pari_printf("fin de nfqpsoluble\n");
9093 avma = ltop;
9094 return 1;
9095 }
9096 if (nfzpsoluble(nf, polrecip(pol), p, gen_1, gel(p, 2), gen_0, prec))
9097 {
9098 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
9099 pari_printf("fin de nfqpsoluble\n");
9100 avma = ltop;
9101 return 1;
9102 }
9103 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
9104 pari_printf("fin de nfqpsoluble\n");
9105 avma = ltop;
9106 return 0;
9107 }
9108
9109 long
9110 nflocallysoluble(GEN nf, GEN pol, GEN r, GEN a, GEN b, long prec)
9111 {
9112 pari_sp ltop = avma;
9113 GEN pol0 = gen_0, plist = gen_0, add = gen_0, ff = gen_0, p = gen_0, Delta = gen_0, vecpol = gen_0, vecpolr = gen_0, Sturmr = gen_0;
9114 GEN p1 = gen_0; /* vec */
9115 GEN p2 = gen_0; /* int */
9116 if (!r)
9117 r = gen_0;
9118 if (!a)
9119 a = gen_1;
9120 if (!b)
9121 b = gen_1;
9122 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
9123 {
9124 p1 = cgetg(5, t_VEC);
9125 gel(p1, 1) = gcopy(pol);
9126 gel(p1, 2) = gcopy(r);
9127 gel(p1, 3) = gcopy(a);
9128 gel(p1, 4) = gcopy(b);
9129 pari_printf("entree dans nflocallysoluble %Ps\n", p1);
9130 }
9131 pol0 = gcopy(pol);
9132 /* */
9133 /* places finies de plist *\ */
9134 /* */
9135 pol = gmul(/* */
9136 /* places finies de plist *\ */
9137 /* */
9138 pol, gsqr(deno(content(lift(pol)))));
9139 {
9140 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
9141 long ii, l3;
9142 for (ii = 1; ii <= 3; ++ii)
9143 {
9144 if (ii == 1)
9145 plist = idealprimedec(nf, gen_2);
9146 if ((ii == 2) && !gequal0(r))
9147 plist = gcopy(gel(idealfactor(nf, gdiv(gdiv(poldisc0(gdiv(pol0, pollead(pol0, -1)), -1), gpowgs(pollead(pol0, -1), 6)), gpowgs(gen_2, 12))), 1));
9148 if ((ii == 2) && (gequal0(r)))
9149 plist = gcopy(gel(idealfactor(nf, poldisc0(pol0, -1)), 1));
9150 if (ii == 3)
9151 {
9152 add = idealadd(nf, a, b);
9153 ff = gcopy(gel(factor(idealnorm(nf, add)), 1));
9154 addprimes(ff);
9155 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
9156 pari_printf("liste de premiers = %Ps\n", ff);
9157 plist = gcopy(gel(idealfactor(nf, add), 1));
9158 }
9159 l3 = glength(plist);
9160 {
9161 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
9162 long i;
9163 for (i = 1; i <= l3; ++i)
9164 {
9165 p = gcopy(gel(plist, i));
9166 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
9167 pari_printf("p = %Ps\n", p);
9168 if (gcmp(member_p(p), LIMBIGPRIME) < 0)
9169 {
9170 if (!nfqpsoluble(nf, pol, initp(nf, p, prec), prec))
9171 {
9172 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
9173 pari_printf(" non ELS en %Ps\n", p);
9174 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
9175 pari_printf("fin de nflocallysoluble\n");
9176 avma = ltop;
9177 return 0;
9178 }
9179 }
9180 else
9181 if (!nfqpsolublebig(nf, pol, p, gdiv(r, a), b, prec))
9182 {
9183 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
9184 pari_printf(" non ELS en %Ps ( = grand premier )\n", member_p(p));
9185 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
9186 pari_printf("fin de nflocallysoluble\n");
9187 avma = ltop;
9188 return 0;
9189 }
9190 if (low_stack(st_lim, stack_lim(btop, 1)))
9191 p = gerepilecopy(btop, p);
9192 }
9193 }
9194 if (low_stack(st_lim, stack_lim(btop, 1)))
9195 gerepileall(btop, 4, &plist, &add, &ff, &p);
9196 }
9197 }
9198 /* places reelles */
9199 if (signe(member_r1(nf)))
9200 {
9201 Delta = poldisc0(pol, -1);
9202 vecpol = gtovec(pol);
9203 p2 = icopy(member_r1(nf));
9204 {
9205 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
9206 GEN i = gen_0;
9207 long l4;
9208 GEN p5 = gen_0; /* vec */
9209 for (i = gen_1; gcmp(i, p2) <= 0; i = gaddgs(i, 1))
9210 {
9211 if (nfsign_s(nf, pollead(pol, -1), i, prec) > 0)
9212 continue;
9213 if (nfsign_s(nf, polcoeff0(pol, 0, -1), i, prec) > 0)
9214 continue;
9215 if (nfsign_s(nf, Delta, i, prec) < 0)
9216 continue;
9217 l4 = glength(vecpol);
9218 {
9219 long j;
9220 p5 = cgetg(l4+1, t_VEC);
9221 for (j = 1; j <= l4; ++j)
9222 gel(p5, j) = mysubst(gel(vecpol, j), gel(member_roots(nf), gtos(i)));
9223 }
9224 vecpolr = p5;
9225 Sturmr = stoi(sturmpart(gtopoly(vecpolr, -1), NULL, NULL));
9226 if (gequal0(Sturmr))
9227 {
9228 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
9229 pari_printf(" non ELS a l'infini\n");
9230 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
9231 pari_printf("fin de nflocallysoluble\n");
9232 avma = ltop;
9233 return 0;
9234 }
9235 if (low_stack(st_lim, stack_lim(btop, 1)))
9236 gerepileall(btop, 4, &i, &p5, &vecpolr, &Sturmr);
9237 }
9238 }
9239 }
9240 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
9241 pari_printf(" quartique ELS \n");
9242 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
9243 pari_printf("fin de nflocallysoluble\n");
9244 avma = ltop;
9245 return 1;
9246 }
9247
9248 GEN
9249 nfellcount(GEN nf, GEN c, GEN d, GEN KS2gen, GEN pointstriv, long prec) /* vec */
9250 {
9251 pari_sp ltop = avma;
9252 GEN found = gen_0, listgen = gen_0, listpointscount = gen_0, m1 = gen_0, m2 = gen_0, lastloc = gen_0, mask = gen_0, i = gen_0, d1 = gen_0, iaux = gen_0, j = gen_0, triv = gen_0, pol = gen_0, point = gen_0, deuxpoints = gen_0, aux = gen_0, v = gen_0;
9253 GEN p1 = gen_0; /* vec */
9254 long l2;
9255 GEN x = pol_x(fetch_user_var("x"));
9256 GEN p3 = gen_0, p4 = gen_0; /* vec */
9257 /* MODI add aux, v */
9258 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
9259 {
9260 p1 = cgetg(3, t_VEC);
9261 gel(p1, 1) = gcopy(c);
9262 gel(p1, 2) = gcopy(d);
9263 pari_printf("entree dans nfellcount %Ps\n", p1);
9264 }
9265 found = gen_0;
9266 listgen = gcopy(KS2gen);
9267 listpointscount = cgetg(1, t_VEC);
9268 m1 = m2 = gen_0;
9269 lastloc = gen_m1;
9270 mask = shifti(gen_1, glength(KS2gen));
9271 i = gen_1;
9272 {
9273 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
9274 long l5;
9275 GEN p6 = gen_0, p7 = gen_0, p8 = gen_0, p9 = gen_0, p10 = gen_0, p11 = gen_0; /* vec */
9276 while (gcmp(i, mask) < 0)
9277 {
9278 d1 = gen_1;
9279 iaux = i;
9280 j = gen_1;
9281 {
9282 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
9283 while (!gequal0(iaux))
9284 {
9285 if (!gequal0(gmodgs(iaux, 2)))
9286 d1 = gmul(d1, gel(listgen, gtos(j)));
9287 iaux = gshift(iaux, -1);
9288 j = gaddgs(j, 1);
9289 if (low_stack(st_lim, stack_lim(btop, 1)))
9290 gerepileall(btop, 3, &d1, &iaux, &j);
9291 }
9292 }
9293 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
9294 pari_printf("d1 = %Ps\n", d1);
9295 triv = gen_0;
9296 l5 = glength(pointstriv);
9297 {
9298 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
9299 long j;
9300 GEN p12 = gen_0; /* vec */
9301 for (j = 1; j <= l5; ++j)
9302 {
9303 if (!gequal0(gmul(gel(gel(pointstriv, j), 3), gel(gel(pointstriv, j), 1))) && nfissquare(nf, gmul(gmul(d1, gel(gel(pointstriv, j), 1)), gel(gel(pointstriv, j), 3)), prec))
9304 {
9305 p12 = cgetg(2, t_VEC);
9306 gel(p12, 1) = gcopy(gel(pointstriv, j));
9307 listpointscount = concat(listpointscount, p12);
9308 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
9309 pari_printf("point trivial\n");
9310 triv = gen_1;
9311 m1 = gaddgs(m1, 1);
9312 if (gcmp(degre(i), lastloc) > 0)
9313 m2 = gaddgs(m2, 1);
9314 found = gen_1;
9315 lastloc = gen_m1;
9316 break;
9317 }
9318 if (low_stack(st_lim, stack_lim(btop, 1)))
9319 gerepileall(btop, 7, &p12, &listpointscount, &triv, &m1, &m2, &found, &lastloc);
9320 }
9321 }
9322 if (gequal0(triv))
9323 {
9324 p6 = cgetg(6, t_VEC);
9325 gel(p6, 1) = gcopy(d1);
9326 gel(p6, 2) = gen_0;
9327 gel(p6, 3) = gcopy(c);
9328 gel(p6, 4) = gen_0;
9329 gel(p6, 5) = gdiv(d, d1);
9330 pol = gtopoly(p6, -1);
9331 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
9332 pari_printf("quartique = y^2 = %Ps\n", pol);
9333 point = nfratpoint(nf, pol, LIM1, gen_1, prec);
9334 if (!gequal(point, cgetg(1, t_VEC)))
9335 {
9336 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
9337 pari_printf("point sur la quartique\n");
9338 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
9339 pari_printf("%Ps\n", point);
9340 m1 = gaddgs(m1, 1);
9341 if (!gequalgs(gel(point, 3), 0))
9342 {
9343 aux = gdiv(gmul(d1, gel(point, 1)), gsqr(gel(point, 3)));
9344 p7 = cgetg(3, t_VEC);
9345 gel(p7, 1) = gmul(aux, gel(point, 1));
9346 gel(p7, 2) = gdiv(gmul(aux, gel(point, 2)), gel(point, 3));
9347 deuxpoints = p7;
9348 }
9349 else
9350 {
9351 p8 = cgetg(2, t_VEC);
9352 gel(p8, 1) = gen_0;
9353 deuxpoints = p8;
9354 }
9355 p9 = cgetg(2, t_VEC);
9356 gel(p9, 1) = gcopy(deuxpoints);
9357 listpointscount = concat(listpointscount, p9);
9358 if (gcmp(degre(i), lastloc) > 0)
9359 m2 = gaddgs(m2, 1);
9360 found = gen_1;
9361 lastloc = gen_m1;
9362 }
9363 else
9364 if (nflocallysoluble(nf, pol, NULL, NULL, NULL, prec))
9365 {
9366 if (gcmp(degre(i), lastloc) > 0)
9367 {
9368 m2 = gaddgs(m2, 1);
9369 lastloc = degre(i);
9370 }
9371 point = nfratpoint(nf, pol, LIM3, gen_1, prec);
9372 if (!gequal(point, cgetg(1, t_VEC)))
9373 {
9374 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
9375 pari_printf("point sur la quartique\n");
9376 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
9377 pari_printf("%Ps\n", point);
9378 m1 = gaddgs(m1, 1);
9379 aux = gdiv(gmul(d1, gel(point, 1)), gsqr(gel(point, 3)));
9380 p10 = cgetg(3, t_VEC);
9381 gel(p10, 1) = gmul(aux, gel(point, 1));
9382 gel(p10, 2) = gdiv(gmul(aux, gel(point, 2)), gel(point, 3));
9383 deuxpoints = p10;
9384 p11 = cgetg(2, t_VEC);
9385 gel(p11, 1) = gcopy(deuxpoints);
9386 listpointscount = concat(listpointscount, p11);
9387 if (gcmp(degre(i), lastloc) > 0)
9388 m2 = gaddgs(m2, 1);
9389 found = gen_1;
9390 lastloc = gen_m1;
9391 }
9392 else
9393 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
9394 pari_printf("pas de point trouve sur la quartique\n");
9395 }
9396 }
9397 if (!gequal0(found))
9398 {
9399 found = gen_0;
9400 v = gen_0;
9401 iaux = gshift(i, -1);
9402 {
9403 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
9404 while (!gequal0(iaux))
9405 {
9406 iaux = gshift(iaux, -1);
9407 v = gaddgs(v, 1);
9408 if (low_stack(st_lim, stack_lim(btop, 1)))
9409 gerepileall(btop, 2, &iaux, &v);
9410 }
9411 }
9412 mask = gshift(mask, -1);
9413 listgen = extract0(listgen, subis(subii(shifti(gen_1, glength(listgen)), shifti(gen_1, gtos(v))), 1), NULL);
9414 i = shifti(gen_1, gtos(v));
9415 }
9416 else
9417 i = gaddgs(i, 1);
9418 if (low_stack(st_lim, stack_lim(btop, 1)))
9419 gerepileall(btop, 23, &d1, &iaux, &j, &triv, &listpointscount, &m1, &m2, &found, &lastloc, &p6, &pol, &point, &aux, &p7, &deuxpoints, &p8, &p9, &p10, &p11, &v, &mask, &listgen, &i);
9420 }
9421 }
9422 l2 = glength(listpointscount);
9423 {
9424 pari_sp btop = avma;
9425 long i;
9426 for (i = 1; i <= l2; ++i)
9427 {
9428 if (glength(gel(listpointscount, i)) > 1)
9429 if (!gequalgs(gsub(gsubst(gadd(gadd(gpowgs(x, 3), gmul(c, gsqr(x))), gmul(d, x)), gvar(x), gel(gel(listpointscount, i), 1)), gsqr(gel(gel(listpointscount, i), 2))), 0))
9430 pari_err(user, "nfellcount : MAUVAIS POINT = %Ps", gel(listpointscount, i));
9431 avma = btop;
9432 }
9433 }
9434 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
9435 pari_printf("fin de nfellcount\n");
9436 p3 = cgetg(3, t_VEC);
9437 gel(p3, 1) = gcopy(listpointscount);
9438 p4 = cgetg(3, t_VEC);
9439 gel(p4, 1) = gcopy(m1);
9440 gel(p4, 2) = gcopy(m2);
9441 gel(p3, 2) = p4;
9442 p3 = gerepilecopy(ltop, p3);
9443 return p3;
9444 }
9445
9446 /* To keep gp2c happy */
9447 GEN
9448 gettufu(GEN bnf)
9449 {
9450 pari_sp ltop = avma;
9451 GEN p1 = gen_0;
9452 p1 = concat(gel(member_tu(bnf), 2), member_fu(bnf));
9453 p1 = gerepilecopy(ltop, p1);
9454 return p1;
9455 }
9456
9457 GEN
9458 getfutu(GEN bnf)
9459 {
9460 pari_sp ltop = avma;
9461 GEN p1 = gen_0;
9462 p1 = concat(member_fu(bnf), gel(member_tu(bnf), 2));
9463 p1 = gerepilecopy(ltop, p1);
9464 return p1;
9465 }
9466
9467 GEN
9468 bnfell2descent_viaisog(GEN bnf, GEN ell, long prec) /* vec */
9469 {
9470 pari_sp ltop = avma;
9471 GEN P = gen_0, Pfact = gen_0, tors = gen_0, pointstriv = gen_0, apinit = gen_0, bpinit = gen_0, plist = gen_0, KS2prod = gen_0, oddclass = gen_0, KS2gen = gen_0, listpoints = gen_0, pointgen = gen_0, n1 = gen_0, n2 = gen_0, certain = gen_0, np1 = gen_0, np2 = gen_0, listpoints2 = gen_0, aux1 = gen_0, aux2 = gen_0, certainp = gen_0, rang = gen_0, strange = gen_0, y = pol_x(fetch_user_var("y"));
9472 GEN p1 = gen_0, p2 = gen_0, p3 = gen_0, p4 = gen_0, p5 = gen_0, p6 = gen_0, p7 = gen_0; /* vec */
9473 GEN x = pol_x(fetch_user_var("x"));
9474 long l8, l9;
9475 GEN p10 = gen_0, p11 = gen_0, p12 = gen_0, p13 = gen_0, p14 = gen_0, p15 = gen_0, p16 = gen_0; /* vec */
9476 long l17;
9477 GEN p18 = gen_0; /* vec */
9478 long l19;
9479 GEN p20 = gen_0; /* vec */
9480 /* MODI remove i */
9481
9482 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
9483 pari_printf("Algorithme de la 2-descente par isogenies\n");
9484 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
9485 pari_printf("entree dans bnfell2descent_viaisog\n");
9486 if (!gequal(gpolvar(member_pol(bnf)), y))
9487 pari_err(user, " bnfell2descent_viaisog : la variable du corps de nombres doit etre y ");
9488 ell = smallellinit(gmodulo(lift(ell), member_pol(bnf)));
9489 if (gequal0(member_disc(ell)))
9490 pari_err(user, " bnfell2descent_viaisog : courbe singuliere !!");
9491 if ((!gequalgs(ell_get_a1(ell), 0) || !gequalgs(ell_get_a3(ell), 0)) || !gequalgs(ell_get_a6(ell), 0))
9492 pari_err(user, " bnfell2descent_viaisog : la courbe n'est pas sous la forme [0,a,0,b,0]");
9493 if ((gcmpgs(denom(algtobasis(bnf, ell_get_a2(ell))), 1) > 0) || (gcmpgs(denom(algtobasis(bnf, ell_get_a4(ell))), 1) > 0))
9494 pari_err(user, " bnfell2descent_viaisog : coefficients non entiers");
9495 p1 = cgetg(4, t_VEC);
9496 gel(p1, 1) = gen_1;
9497 gel(p1, 2) = gcopy(ell_get_a2(ell));
9498 gel(p1, 3) = gcopy(ell_get_a4(ell));
9499 P = gmul(gtopoly(p1, -1), gmodulsg(1, member_pol(bnf)));
9500 Pfact = gcopy(gel(polfnf(P, member_pol(bnf)), 1));
9501 tors = stoi(glength(Pfact));
9502 if (glength(Pfact) > 1)
9503 {
9504 p2 = cgetg(4, t_VEC);
9505 p3 = cgetg(4, t_VEC);
9506 gel(p3, 1) = gen_0;
9507 gel(p3, 2) = gen_0;
9508 gel(p3, 3) = gen_1;
9509 gel(p2, 1) = p3;
9510 p4 = cgetg(4, t_VEC);
9511 gel(p4, 1) = gneg(polcoeff0(gel(Pfact, 1), 0, -1));
9512 gel(p4, 2) = gen_0;
9513 gel(p4, 3) = gen_1;
9514 gel(p2, 2) = p4;
9515 p5 = cgetg(4, t_VEC);
9516 gel(p5, 1) = gneg(polcoeff0(gel(Pfact, 2), 0, -1));
9517 gel(p5, 2) = gen_0;
9518 gel(p5, 3) = gen_1;
9519 gel(p2, 3) = p5;
9520 pointstriv = p2;
9521 }
9522 else
9523 {
9524 p6 = cgetg(2, t_VEC);
9525 p7 = cgetg(4, t_VEC);
9526 gel(p7, 1) = gen_0;
9527 gel(p7, 2) = gen_0;
9528 gel(p7, 3) = gen_1;
9529 gel(p6, 1) = p7;
9530 pointstriv = p6;
9531 }
9532 apinit = gmulsg(-2, ell_get_a2(ell));
9533 bpinit = gsub(gsqr(ell_get_a2(ell)), gmulsg(4, ell_get_a4(ell)));
9534 /* calcul des ideaux premiers de plist */
9535 /* et de quelques renseignements associes */
9536 plist = gcopy(gel(idealfactor(bnf, gmulsg(6, member_disc(ell))), 1));
9537 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
9538 pari_printf(" Recherche de points triviaux sur la courbe\n");
9539 P = gmul(P, x);
9540 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
9541 pari_printf("Y^2 = %Ps\n", P);
9542 pointstriv = concat(pointstriv, nfratpoint(member_nf(bnf), P, LIMTRIV, gen_0, prec));
9543 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
9544 {
9545 pari_printf("points triviaux sur E(K) = \n");
9546 pari_printf("%Ps\n", lift(pointstriv));
9547 pari_printf("\n");
9548 }
9549 KS2prod = gcopy(ell_get_a4(ell));
9550 oddclass = gen_0;
9551 {
9552 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
9553 while (gequal0(oddclass))
9554 {
9555 KS2gen = bnfsunit(bnf, gtrans(gel(idealfactor(bnf, KS2prod), 1)), prec);
9556 oddclass = gmodgs(gel(gel(KS2gen, 5), 1), 2);
9557 if (gequal0(oddclass))
9558 KS2prod = idealmul(bnf, KS2prod, gel(gel(gel(KS2gen, 5), 3), 1));
9559 if (low_stack(st_lim, stack_lim(btop, 1)))
9560 gerepileall(btop, 3, &KS2gen, &oddclass, &KS2prod);
9561 }
9562 }
9563 KS2gen = gcopy(gel(KS2gen, 1));
9564 /* A CHANGER : KS2gen = matbasistoalg(bnf,KS2gen); */
9565 l8 = glength(KS2gen);
9566 {
9567 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
9568 long i;
9569 for (i = 1; i <= l8; ++i)
9570 {
9571 gel(KS2gen, i) = basistoalg(bnf, gel(KS2gen, i));
9572 if (low_stack(st_lim, stack_lim(btop, 1)))
9573 KS2gen = gerepilecopy(btop, KS2gen);
9574 }
9575 }
9576 KS2gen = concat(gmodulo(lift(gettufu(bnf)), member_pol(bnf)), KS2gen);
9577 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
9578 {
9579 pari_printf("#K(b,2)gen = %ld\n", glength(KS2gen));
9580 pari_printf("K(b,2)gen = %Ps\n", KS2gen);
9581 }
9582 listpoints = nfellcount(member_nf(bnf), ell_get_a2(ell), ell_get_a4(ell), KS2gen, pointstriv, prec);
9583 pointgen = gcopy(gel(listpoints, 1));
9584 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
9585 {
9586 pari_printf("points sur E(K) = %Ps\n", lift(pointgen));
9587 pari_printf("\n");
9588 }
9589 n1 = gcopy(gel(gel(listpoints, 2), 1));
9590 n2 = gcopy(gel(gel(listpoints, 2), 2));
9591 certain = stoi(gequal(n1, n2));
9592 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
9593 {
9594 if (!gequal0(certain))
9595 {
9596 pari_printf("[E(K):phi'(E'(K))] = %Ps\n", shifti(gen_1, gtos(n1)));
9597 pari_printf("#S^(phi')(E'/K) = %Ps\n", shifti(gen_1, gtos(n2)));
9598 pari_printf("#III(E'/K)[phi'] = 1\n");
9599 pari_printf("\n");
9600 }
9601 else
9602 {
9603 pari_printf("[E(K):phi'(E'(K))] >= %Ps\n", shifti(gen_1, gtos(n1)));
9604 pari_printf("#S^(phi')(E'/K) = %Ps\n", shifti(gen_1, gtos(n2)));
9605 pari_printf("#III(E'/K)[phi'] <= %Ps\n", shifti(gen_1, gtos(gsub(n2, n1))));
9606 pari_printf("\n");
9607 }
9608 }
9609 KS2prod = bpinit;
9610 oddclass = gen_0;
9611 {
9612 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
9613 while (gequal0(oddclass))
9614 {
9615 KS2gen = bnfsunit(bnf, gtrans(gel(idealfactor(bnf, KS2prod), 1)), prec);
9616 oddclass = gmodgs(gel(gel(KS2gen, 5), 1), 2);
9617 if (gequal0(oddclass))
9618 KS2prod = idealmul(bnf, KS2prod, gel(gel(gel(KS2gen, 5), 3), 1));
9619 if (low_stack(st_lim, stack_lim(btop, 1)))
9620 gerepileall(btop, 3, &KS2gen, &oddclass, &KS2prod);
9621 }
9622 }
9623 KS2gen = gcopy(gel(KS2gen, 1));
9624 /* A CHANGER KS2gen = matbasistoalg(bnf,KS2gen); */
9625 l9 = glength(KS2gen);
9626 {
9627 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
9628 long i;
9629 for (i = 1; i <= l9; ++i)
9630 {
9631 gel(KS2gen, i) = basistoalg(bnf, gel(KS2gen, i));
9632 if (low_stack(st_lim, stack_lim(btop, 1)))
9633 KS2gen = gerepilecopy(btop, KS2gen);
9634 }
9635 }
9636 KS2gen = concat(gmodulo(lift(gettufu(bnf)), member_pol(bnf)), KS2gen);
9637 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
9638 {
9639 pari_printf("#K(a^2-4b,2)gen = %ld\n", glength(KS2gen));
9640 pari_printf("K(a^2-4b,2)gen = %Ps\n", KS2gen);
9641 }
9642 p10 = cgetg(4, t_VEC);
9643 gel(p10, 1) = gen_1;
9644 gel(p10, 2) = gcopy(apinit);
9645 gel(p10, 3) = gcopy(bpinit);
9646 P = gmul(gtopoly(p10, -1), gmodulsg(1, member_pol(bnf)));
9647 Pfact = gcopy(gel(polfnf(P, member_pol(bnf)), 1));
9648 if (glength(Pfact) > 1)
9649 {
9650 p11 = cgetg(4, t_VEC);
9651 p12 = cgetg(4, t_VEC);
9652 gel(p12, 1) = gen_0;
9653 gel(p12, 2) = gen_0;
9654 gel(p12, 3) = gen_1;
9655 gel(p11, 1) = p12;
9656 p13 = cgetg(4, t_VEC);
9657 gel(p13, 1) = gneg(polcoeff0(gel(Pfact, 1), 0, -1));
9658 gel(p13, 2) = gen_0;
9659 gel(p13, 3) = gen_1;
9660 gel(p11, 2) = p13;
9661 p14 = cgetg(4, t_VEC);
9662 gel(p14, 1) = gneg(polcoeff0(gel(Pfact, 2), 0, -1));
9663 gel(p14, 2) = gen_0;
9664 gel(p14, 3) = gen_1;
9665 gel(p11, 3) = p14;
9666 pointstriv = p11;
9667 }
9668 else
9669 {
9670 p15 = cgetg(2, t_VEC);
9671 p16 = cgetg(4, t_VEC);
9672 gel(p16, 1) = gen_0;
9673 gel(p16, 2) = gen_0;
9674 gel(p16, 3) = gen_1;
9675 gel(p15, 1) = p16;
9676 pointstriv = p15;
9677 }
9678 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
9679 pari_printf(" Recherche de points triviaux sur la courbe\n");
9680 P = gmul(P, x);
9681 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
9682 pari_printf("Y^2 = %Ps\n", P);
9683 pointstriv = concat(pointstriv, nfratpoint(member_nf(bnf), P, LIMTRIV, gen_0, prec));
9684 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
9685 {
9686 pari_printf("points triviaux sur E'(K) = \n");
9687 pari_printf("%Ps\n", lift(pointstriv));
9688 pari_printf("\n");
9689 }
9690 listpoints = nfellcount(member_nf(bnf), apinit, bpinit, KS2gen, pointstriv, prec);
9691 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
9692 pari_printf("points sur E'(K) = %Ps\n", lift(gel(listpoints, 1)));
9693 np1 = gcopy(gel(gel(listpoints, 2), 1));
9694 np2 = gcopy(gel(gel(listpoints, 2), 2));
9695 l17 = glength(gel(listpoints, 1));
9696 {
9697 long i;
9698 p18 = cgetg(l17+1, t_VEC);
9699 for (i = 1; i <= l17; ++i)
9700 gel(p18, i) = gen_0;
9701 }
9702 listpoints2 = p18;
9703 l19 = glength(gel(listpoints, 1));
9704 {
9705 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
9706 long i;
9707 GEN p21 = gen_0; /* vec */
9708 for (i = 1; i <= l19; ++i)
9709 {
9710 p21 = cgetg(3, t_VEC);
9711 gel(p21, 1) = gen_0;
9712 gel(p21, 2) = gen_0;
9713 gel(listpoints2, i) = p21;
9714 aux1 = gsqr(gel(gel(gel(listpoints, 1), i), 1));
9715 if (!gequalgs(aux1, 0))
9716 {
9717 aux2 = gcopy(gel(gel(gel(listpoints, 1), i), 2));
9718 gel(gel(listpoints2, i), 1) = gdivgs(gdiv(gsqr(aux2), aux1), 4);
9719 gel(gel(listpoints2, i), 2) = gdivgs(gdiv(gmul(aux2, gsub(bpinit, aux1)), aux1), 8);
9720 }
9721 else
9722 gel(listpoints2, i) = gcopy(gel(gel(listpoints, 1), i));
9723 if (low_stack(st_lim, stack_lim(btop, 1)))
9724 gerepileall(btop, 4, &p21, &listpoints2, &aux1, &aux2);
9725 }
9726 }
9727 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
9728 {
9729 pari_printf("points sur E(K) = %Ps\n", lift(listpoints2));
9730 pari_printf("\n");
9731 }
9732 pointgen = concat(pointgen, listpoints2);
9733 certainp = stoi(gequal(np1, np2));
9734 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
9735 {
9736 if (!gequal0(certainp))
9737 {
9738 pari_printf("[E'(K):phi(E(K))] = %Ps\n", shifti(gen_1, gtos(np1)));
9739 pari_printf("#S^(phi)(E/K) = %Ps\n", shifti(gen_1, gtos(np2)));
9740 pari_printf("#III(E/K)[phi] = 1\n");
9741 pari_printf("\n");
9742 }
9743 else
9744 {
9745 pari_printf("[E'(K):phi(E(K))] >= %Ps\n", shifti(gen_1, gtos(np1)));
9746 pari_printf("#S^(phi)(E/K) = %Ps\n", shifti(gen_1, gtos(np2)));
9747 pari_printf("#III(E/K)[phi] <= %Ps\n", shifti(gen_1, gtos(gsub(np2, np1))));
9748 pari_printf("\n");
9749 }
9750 if ((gequal0(certain)) && (gcmp(np2, np1) > 0))
9751 pari_printf("%Ps <= ", shifti(gen_1, gtos(gsub(np2, np1))));
9752 pari_printf("#III(E/K)[2] ");
9753 if (!gequal0(certain) && !gequal0(certainp))
9754 pari_printf(" ");
9755 else
9756 pari_printf("<");
9757 pari_printf("= %Ps\n", shifti(gen_1, gtos(gsub(gsub(gadd(n2, np2), n1), np1))));
9758 pari_printf("#E(K)[2] = %Ps\n", shifti(gen_1, gtos(tors)));
9759 }
9760 rang = gsubgs(gadd(n1, np1), 2);
9761 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
9762 {
9763 if (!gequal0(certain) && !gequal0(certainp))
9764 {
9765 pari_printf("#E(K)/2E(K) = %Ps\n", shifti(gen_1, gtos(gadd(rang, tors))));
9766 pari_printf("rang = %Ps\n", rang);
9767 pari_printf("\n");
9768 }
9769 else
9770 {
9771 pari_printf("#E(K)/2E(K) >= %Ps\n", shifti(gen_1, gtos(gadd(rang, tors))));
9772 pari_printf("\n");
9773 pari_printf("%Ps <= rang <= %Ps\n", rang, gsubgs(gadd(n2, np2), 2));
9774 pari_printf("\n");
9775 }
9776 }
9777 strange = gmodgs(gsub(gsub(gadd(n2, np2), n1), np1), 2);
9778 if (!gequal0(strange))
9779 {
9780 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
9781 {
9782 pari_printf(" !!! III doit etre un carre !!!\n");
9783 pari_printf("donc\n");
9784 }
9785 if (!gequal0(certain))
9786 {
9787 np1 = gaddgs(np1, 1);
9788 certainp = stoi(gequal(np1, np2));
9789 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
9790 {
9791 if (!gequal0(certainp))
9792 {
9793 pari_printf("[E'(K):phi(E(K))] = %Ps\n", shifti(gen_1, gtos(np1)));
9794 pari_printf("#S^(phi)(E/K) = %Ps\n", shifti(gen_1, gtos(np2)));
9795 pari_printf("#III(E/K)[phi] = 1\n");
9796 pari_printf("\n");
9797 }
9798 else
9799 {
9800 pari_printf("[E'(K):phi(E(K))] >= %Ps\n", shifti(gen_1, gtos(np1)));
9801 pari_printf("#S^(phi)(E/K) = %Ps\n", shifti(gen_1, gtos(np2)));
9802 pari_printf("#III(E/K)[phi] <= %Ps\n", shifti(gen_1, gtos(gsub(np2, np1))));
9803 pari_printf("\n");
9804 }
9805 }
9806 }
9807 else
9808 {
9809 if (!gequal0(certainp))
9810 {
9811 n1 = gaddgs(n1, 1);
9812 certain = stoi(gequal(n1, n2));
9813 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
9814 {
9815 if (!gequal0(certain))
9816 {
9817 pari_printf("[E(K):phi'(E'(K))] = %Ps\n", shifti(gen_1, gtos(n1)));
9818 pari_printf("#S^(phi')(E'/K) = %Ps\n", shifti(gen_1, gtos(n2)));
9819 pari_printf("#III(E'/K)[phi'] = 1\n");
9820 pari_printf("\n");
9821 }
9822 else
9823 {
9824 pari_printf("[E(K):phi'(E'(K))] >= %Ps\n", shifti(gen_1, gtos(n1)));
9825 pari_printf("#S^(phi')(E'/K) = %Ps\n", shifti(gen_1, gtos(n2)));
9826 pari_printf("#III(E'/K)[phi'] <= %Ps\n", shifti(gen_1, gtos(gsub(n2, n1))));
9827 pari_printf("\n");
9828 }
9829 }
9830 }
9831 else
9832 n1 = gaddgs(n1, 1);
9833 }
9834 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
9835 {
9836 if ((gequal0(certain)) && (gcmp(np2, np1) > 0))
9837 pari_printf("%Ps <= ", shifti(gen_1, gtos(gsub(np2, np1))));
9838 pari_printf("#III(E/K)[2] ");
9839 if (!gequal0(certain) && !gequal0(certainp))
9840 pari_printf(" ");
9841 else
9842 pari_printf("<");
9843 pari_printf("= %Ps\n", shifti(gen_1, gtos(gsub(gsub(gadd(n2, np2), n1), np1))));
9844 pari_printf("#E(K)[2] = %Ps\n", shifti(gen_1, gtos(tors)));
9845 }
9846 rang = gsubgs(gadd(n1, np1), 2);
9847 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
9848 {
9849 if (!gequal0(certain) && !gequal0(certainp))
9850 {
9851 pari_printf("#E(K)/2E(K) = %Ps\n", shifti(gen_1, gtos(gadd(rang, tors))));
9852 pari_printf("\n");
9853 pari_printf("rang = %Ps\n", rang);
9854 pari_printf("\n");
9855 }
9856 else
9857 {
9858 pari_printf("#E(K)/2E(K) >= %Ps\n", shifti(gen_1, gtos(gadd(rang, tors))));
9859 pari_printf("\n");
9860 pari_printf("%Ps <= rang <= %Ps\n", rang, gsubgs(gadd(n2, np2), 2));
9861 pari_printf("\n");
9862 }
9863 }
9864 }
9865 /* fin de strange */
9866
9867 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
9868 pari_printf("points = %Ps\n", pointgen);
9869 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
9870 pari_printf("fin de bnfell2descent_viaisog\n");
9871 p20 = cgetg(4, t_VEC);
9872 gel(p20, 1) = gcopy(rang);
9873 gel(p20, 2) = gadd(gsubgs(gadd(n2, np2), 2), tors);
9874 gel(p20, 3) = gcopy(pointgen);
9875 p20 = gerepilecopy(ltop, p20);
9876 return p20;
9877 }
9878
9879 GEN
9880 nfchinremain(GEN nf, GEN b, GEN fact)
9881 {
9882 pari_sp ltop = avma;
9883 GEN l = gen_0, fact2 = gen_0;
9884 GEN p1 = gen_0; /* vec */
9885 /* MODI remove i */
9886
9887 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
9888 pari_printf("entree dans nfchinremain\n");
9889 l = stoi(glength(gel(fact, 1)));
9890 {
9891 long i;
9892 p1 = cgetg(gtos(l)+1, t_VEC);
9893 for (i = 1; gcmpsg(i, l) <= 0; ++i)
9894 gel(p1, i) = idealdiv(nf, b, idealpow0(nf, gcoeff(fact, i, 1), gcoeff(fact, i, 2), 0));
9895 }
9896 fact2 = p1;
9897 /* for( i = 1, l, */
9898 /* fact2[i] = idealdiv(nf,b,idealpow(nf,fact[i,1],fact[i,2]))); */
9899 fact2 = idealaddtoone0(nf, fact2, NULL);
9900 /* A CHANGER : fact2 = matbasistoalg(nf,fact2); */
9901 {
9902 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
9903 GEN i = gen_0;
9904 for (i = gen_1; gcmp(i, l) <= 0; i = gaddgs(i, 1))
9905 {
9906 gel(fact2, gtos(i)) = basistoalg(nf, gel(fact2, gtos(i)));
9907 if (low_stack(st_lim, stack_lim(btop, 1)))
9908 gerepileall(btop, 2, &i, &fact2);
9909 }
9910 }
9911 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
9912 pari_printf("fin de nfchinremain\n");
9913 fact2 = gerepilecopy(ltop, fact2);
9914 return fact2;
9915 }
9916
9917 GEN
9918 bnfqfsolve2(GEN bnf, GEN aleg, GEN bleg, GEN auto_s, long prec) /* vec */
9919 {
9920 pari_sp ltop = avma;
9921 GEN p1 = gen_0; /* vec */
9922 GEN y = pol_x(fetch_user_var("y")), aux = gen_0, solvepolrel = gen_0, auxsolve = gen_0, solvepolabs = gen_0, exprxy = gen_0, rrrnf = gen_0, bbbnf = gen_0, SL0 = gen_0, SL1 = gen_0, SL = gen_0, sunL = gen_0, fondsunL = gen_0, normfondsunL = gen_0, SK = gen_0, sunK = gen_0, fondsunK = gen_0, vecbleg = gen_0, matnorm = gen_0, matnormmod = gen_0, expsolution = gen_0, solution = gen_0, reste = gen_0, carre = gen_0, verif = gen_0, x0 = gen_0, x1 = gen_0, x = pol_x(fetch_user_var("x"));
9923 long l2, l3, l4;
9924 GEN p5 = gen_0; /* vec */
9925 long l6;
9926 GEN p7 = gen_0; /* vec */
9927 long l8, l9;
9928 GEN p10 = gen_0; /* vec */
9929 long l11, l12;
9930 GEN p13 = gen_0;
9931 long l14;
9932 GEN p15 = gen_0;
9933 GEN p16 = gen_0; /* vec */
9934 if (!auto_s)
9935 {
9936 p1 = cgetg(2, t_VEC);
9937 gel(p1, 1) = gcopy(y);
9938 auto_s = p1;
9939 }
9940 /* MODI remove i */
9941 /* MODI add x0, x1 */
9942
9943 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
9944 pari_printf("entree dans bnfqfsolve2\n");
9945 solvepolrel = gsub(gsqr(x), aleg);
9946 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
9947 pari_printf("aleg = %Ps\n", aleg);
9948 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
9949 pari_printf("bleg = %Ps\n", bleg);
9950 if (glength(auto_s) > 1)
9951 {
9952 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
9953 pari_printf("factorisation du discriminant avec les auto_smorhpismes de bnf\n");
9954 l2 = glength(auto_s);
9955 {
9956 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
9957 long i;
9958 for (i = 2; i <= l2; ++i)
9959 {
9960 aux = gabs(polresultant0(gsub(lift(aleg), gsubst(lift(aleg), gvar(y), gel(auto_s, i))), member_pol(bnf), -1, 0), prec);
9961 if (!gequal0(aux))
9962 addprimes(gel(factor(aux), 1));
9963 if (low_stack(st_lim, stack_lim(btop, 1)))
9964 aux = gerepilecopy(btop, aux);
9965 }
9966 }
9967 }
9968 auxsolve = rnfequation0(bnf, solvepolrel, 1);
9969 solvepolabs = gcopy(gel(auxsolve, 1));
9970 exprxy = gcopy(gel(auxsolve, 2));
9971 if (!gequal0(gel(auxsolve, 3)))
9972 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
9973 pari_printf(" CECI EST LE NOUVEAU CAS auxsolve[3] != 0\n");
9974 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
9975 pari_printf(" bbbnfinit %Ps\n", solvepolabs);
9976 rrrnf = rnfinit(bnf, solvepolrel);
9977 bbbnf = Buchall(solvepolabs, nf_FORCE, prec);
9978 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
9979 pari_printf(" done\n");
9980 SL0 = gen_1;
9981 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
9982 pari_printf("bbbnf.clgp = %Ps\n", member_clgp(bbbnf));
9983 l3 = glength(gel(member_clgp(bbbnf), 2));
9984 {
9985 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
9986 long i;
9987 for (i = 1; i <= l3; ++i)
9988 {
9989 if (gequal0(gmodgs(gel(gel(member_clgp(bbbnf), 2), i), 2)))
9990 SL0 = idealmul(bbbnf, SL0, gcoeff(gel(gel(member_clgp(bbbnf), 3), i), 1, 1));
9991 if (low_stack(st_lim, stack_lim(btop, 1)))
9992 SL0 = gerepilecopy(btop, SL0);
9993 }
9994 }
9995 SL1 = idealmul(bbbnf, SL0, rnfelementup(rrrnf, bleg));
9996 SL = gtrans(gel(idealfactor(bbbnf, SL1), 1));
9997 sunL = bnfsunit(bbbnf, SL, prec);
9998 l4 = glength(gel(sunL, 1));
9999 {
10000 long i;
10001 p5 = cgetg(l4+1, t_VEC);
10002 for (i = 1; i <= l4; ++i)
10003 gel(p5, i) = basistoalg(bbbnf, gel(gel(sunL, 1), i));
10004 }
10005 /* A CHANGER : fondsunL = concat(bbbnf.futu,matbasistoalg(bbbnf,sunL[1])); */
10006 fondsunL = concat(getfutu(bbbnf), p5);
10007 normfondsunL = gnorm(rnfelementabstorel(rrrnf, fondsunL));
10008 SK = gtrans(gel(idealfactor(bnf, idealnorm(bbbnf, SL1)), 1));
10009 sunK = bnfsunit(bnf, SK, prec);
10010 l6 = glength(gel(sunK, 1));
10011 {
10012 long i;
10013 p7 = cgetg(l6+1, t_VEC);
10014 for (i = 1; i <= l6; ++i)
10015 gel(p7, i) = basistoalg(bnf, gel(gel(sunK, 1), i));
10016 }
10017 /* A CHANGER : fondsunK = concat(bnf.futu,matbasistoalg(bnf,sunK[1])); */
10018 fondsunK = concat(getfutu(bnf), p7);
10019 vecbleg = bnfissunit(bnf, sunK, bleg);
10020 l8 = glength(normfondsunL);
10021 l9 = glength(fondsunK);
10022 {
10023 long i, j;
10024 p10 = cgetg(l8+1, t_MAT);
10025 for (j = 1; j <= l8; ++j)
10026 {
10027 gel(p10, j) = cgetg(l9+1, t_COL);
10028 for (i = 1; i <= l9; ++i)
10029 gcoeff(p10, i, j) = gen_0;
10030 }
10031 }
10032 matnorm = p10;
10033 l11 = glength(normfondsunL);
10034 {
10035 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
10036 long i;
10037 for (i = 1; i <= l11; ++i)
10038 {
10039 gel(matnorm, i) = lift(bnfissunit(bnf, sunK, gel(normfondsunL, i)));
10040 if (low_stack(st_lim, stack_lim(btop, 1)))
10041 matnorm = gerepilecopy(btop, matnorm);
10042 }
10043 }
10044 matnormmod = gmul(matnorm, gmodulss(1, 2));
10045 expsolution = lift(inverseimage(matnormmod, gmul(vecbleg, gmodulss(1, 2))));
10046 if (gequal(expsolution, cgetg(1, t_COL)))
10047 pari_err(user, " bnfqfsolve2 : IL N'Y A PAS DE SOLUTION ");
10048 l12 = glength(expsolution);
10049 {
10050 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
10051 long i;
10052 p13 = gen_1;
10053 for (i = 1; i <= l12; ++i)
10054 {
10055 p13 = gmul(p13, gpow(gel(fondsunL, i), gel(expsolution, i), prec));
10056 if (low_stack(st_lim, stack_lim(btop, 1)))
10057 p13 = gerepilecopy(btop, p13);
10058 }
10059 }
10060 solution = p13;
10061 solution = rnfelementabstorel(rrrnf, solution);
10062 reste = gdivgs(gsub(lift(vecbleg), gmul(matnorm, expsolution)), 2);
10063 l14 = glength(vecbleg);
10064 {
10065 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
10066 long i;
10067 p15 = gen_1;
10068 for (i = 1; i <= l14; ++i)
10069 {
10070 p15 = gmul(p15, gpow(gel(fondsunK, i), gel(reste, i), prec));
10071 if (low_stack(st_lim, stack_lim(btop, 1)))
10072 p15 = gerepilecopy(btop, p15);
10073 }
10074 }
10075 carre = p15;
10076 solution = gmul(solution, carre);
10077 x1 = polcoeff0(lift(solution), 1, gvar(x));
10078 x0 = polcoeff0(lift(solution), 0, gvar(x));
10079 verif = gsub(gsub(gsqr(x0), gmul(aleg, gsqr(x1))), bleg);
10080 if (!gequal0(verif))
10081 pari_err(user, " bnfqfsolve2 : MAUVAIS POINT");
10082 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
10083 pari_printf("fin de bnfqfsolve2\n");
10084 p16 = cgetg(4, t_VEC);
10085 gel(p16, 1) = gcopy(x0);
10086 gel(p16, 2) = gcopy(x1);
10087 gel(p16, 3) = gen_1;
10088 p16 = gerepilecopy(ltop, p16);
10089 return p16;
10090 }
10091
10092 GEN
10093 bnfqfsolve(GEN bnf, GEN aleg, GEN bleg, GEN flag3, GEN auto_s, long prec)
10094 {
10095 pari_sp ltop = avma;
10096 GEN p1 = gen_0; /* vec */
10097 GEN y = pol_x(fetch_user_var("y")), nf = gen_0, aa = gen_0, bb = gen_0, na = gen_0, nb = gen_0, maxnb = gen_0, mat = gen_0, resl = gen_0, t = gen_0, sq = gen_0, pol = gen_0, vecrat = gen_0, alpha = gen_0, xx = gen_0, yy = gen_0, borne = gen_0, test = gen_0, sun = gen_0, fact = gen_0, suni = gen_0, f = gen_0, l = gen_0, aux = gen_0, alpha2 = gen_0, maxnbiter = gen_0, idbb = gen_0, rem = gen_0, nbiter = gen_0, mask = gen_0, oldnb = gen_0, newnb = gen_0, bor = gen_0, testici = gen_0, de = gen_0, xxp = gen_0, yyp = gen_0, rap = gen_0, verif = gen_0;
10098 GEN p2 = gen_0, p3 = gen_0; /* vec */
10099 GEN x = pol_x(fetch_user_var("x"));
10100 if (!auto_s)
10101 {
10102 p1 = cgetg(2, t_VEC);
10103 gel(p1, 1) = gcopy(y);
10104 auto_s = p1;
10105 }
10106 /* MODI remove k, maxna */
10107
10108 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
10109 pari_printf("entree dans bnfqfsolve\n");
10110 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
10111 pari_printf("(a,b) = (%Ps,%Ps)\n", aleg, bleg);
10112 nf = gcopy(member_nf(bnf));
10113 aleg = gmodulo(lift(aleg), member_pol(nf));
10114 aa = gcopy(aleg);
10115 bleg = gmodulo(lift(bleg), member_pol(nf));
10116 bb = gcopy(bleg);
10117 if (gequal0(aa))
10118 {
10119 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
10120 pari_printf("fin de bnfqfsolve\n");
10121 p2 = cgetg(4, t_COL);
10122 gel(p2, 1) = gen_0;
10123 gel(p2, 2) = gen_1;
10124 gel(p2, 3) = gen_0;
10125 p2 = gerepilecopy(ltop, p2);
10126 return p2;
10127 }
10128 if (gequal0(bb))
10129 {
10130 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
10131 pari_printf("fin de bnfqfsolve\n");
10132 p3 = cgetg(4, t_COL);
10133 gel(p3, 1) = gen_0;
10134 gel(p3, 2) = gen_0;
10135 gel(p3, 3) = gen_1;
10136 p3 = gerepilecopy(ltop, p3);
10137 return p3;
10138 }
10139 na = gabs(gnorm(aa), prec);
10140 nb = gabs(gnorm(bb), prec);
10141 if (gcmp(na, nb) > 0)
10142 maxnb = na;
10143 else
10144 maxnb = nb;
10145 maxnb = gshift(maxnb, 20);
10146 mat = gmodulo(matid(3), member_pol(nf));
10147 borne = gen_1;
10148 test = gen_0;
10149 nbiter = gen_0;
10150 {
10151 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
10152 GEN p4 = gen_0, p5 = gen_0, p6 = gen_0, p7 = gen_0, p8 = gen_0, p9 = gen_0, p10 = gen_0, p11 = gen_0, p12 = gen_0, p13 = gen_0; /* vec */
10153 long l14;
10154 GEN p15 = gen_0; /* vec */
10155 long l16;
10156 GEN p17 = gen_0, p18 = gen_0; /* vec */
10157 while (1)
10158 {
10159 if (!gequal0(flag3) && (gcmpgs(gel(member_clgp(bnf), 1), 1) > 0))
10160 {
10161 resl = gtrans(bnfqfsolve2(bnf, aa, bb, auto_s, prec));
10162 break;
10163 }
10164 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
10165 {
10166 p4 = cgetg(7, t_VEC);
10167 gel(p4, 1) = gcopy(na);
10168 gel(p4, 2) = gcopy(nb);
10169 gel(p4, 3) = gcopy(aa);
10170 gel(p4, 4) = gcopy(bb);
10171 gel(p4, 5) = gnorm(aa);
10172 gel(p4, 6) = gnorm(bb);
10173 pari_printf("(na,nb,a,b) = %Ps\n", lift(p4));
10174 }
10175 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
10176 pari_printf("***%Ps*** \n", nb);
10177 if (gcmp(nb, maxnb) >= 0)
10178 {
10179 mat = gmodulo(matid(3), member_pol(nf));
10180 aa = gcopy(aleg);
10181 bb = gcopy(bleg);
10182 na = gabs(gnorm(aleg), prec);
10183 nb = gabs(gnorm(bleg), prec);
10184 }
10185 if (gequal1(aa))
10186 {
10187 p5 = cgetg(4, t_COL);
10188 gel(p5, 1) = gen_1;
10189 gel(p5, 2) = gen_1;
10190 gel(p5, 3) = gen_0;
10191 resl = p5;
10192 break;
10193 }
10194 if (gequal1(bb))
10195 {
10196 p6 = cgetg(4, t_COL);
10197 gel(p6, 1) = gen_1;
10198 gel(p6, 2) = gen_0;
10199 gel(p6, 3) = gen_1;
10200 resl = p6;
10201 break;
10202 }
10203 if (gequal1(gadd(aa, bb)))
10204 {
10205 p7 = cgetg(4, t_COL);
10206 gel(p7, 1) = gen_1;
10207 gel(p7, 2) = gen_1;
10208 gel(p7, 3) = gen_1;
10209 resl = p7;
10210 break;
10211 }
10212 if (gequal0(gadd(aa, bb)))
10213 {
10214 p8 = cgetg(4, t_COL);
10215 gel(p8, 1) = gen_0;
10216 gel(p8, 2) = gen_1;
10217 gel(p8, 3) = gen_1;
10218 resl = p8;
10219 break;
10220 }
10221 if (gequal(aa, bb) && !gequalgs(aa, 1))
10222 {
10223 t = gmul(aa, gel(mat, 1));
10224 gel(mat, 1) = gcopy(gel(mat, 3));
10225 gel(mat, 3) = gcopy(t);
10226 aa = gen_m1;
10227 na = gen_1;
10228 }
10229 if (!gequal0(gissquare(na)))
10230 {
10231 sq = nfsqrt(nf, aa, prec);
10232 if (!gequal(sq, cgetg(1, t_VEC)))
10233 {
10234 p9 = cgetg(4, t_COL);
10235 gel(p9, 1) = gcopy(gel(sq, 1));
10236 gel(p9, 2) = gen_1;
10237 gel(p9, 3) = gen_0;
10238 resl = p9;
10239 break;
10240 }
10241 }
10242 if (!gequal0(gissquare(nb)))
10243 {
10244 sq = nfsqrt(nf, bb, prec);
10245 if (!gequal(sq, cgetg(1, t_VEC)))
10246 {
10247 p10 = cgetg(4, t_COL);
10248 gel(p10, 1) = gcopy(gel(sq, 1));
10249 gel(p10, 2) = gen_0;
10250 gel(p10, 3) = gen_1;
10251 resl = p10;
10252 break;
10253 }
10254 }
10255 if (gcmp(na, nb) > 0)
10256 {
10257 t = aa;
10258 aa = bb;
10259 bb = t;
10260 t = na;
10261 na = nb;
10262 nb = t;
10263 t = gcopy(gel(mat, 3));
10264 gel(mat, 3) = gcopy(gel(mat, 2));
10265 gel(mat, 2) = gcopy(t);
10266 }
10267 if (gequal1(nb))
10268 {
10269 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
10270 {
10271 p11 = cgetg(3, t_VEC);
10272 gel(p11, 1) = gcopy(aa);
10273 gel(p11, 2) = gcopy(bb);
10274 pari_printf("(a,b) = %Ps\n", lift(p11));
10275 }
10276 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
10277 {
10278 p12 = cgetg(3, t_VEC);
10279 gel(p12, 1) = gcopy(na);
10280 gel(p12, 2) = gcopy(nb);
10281 pari_printf("(na,nb) = %Ps\n", lift(p12));
10282 }
10283 if (gequal(aleg, aa) && gequal(bleg, bb))
10284 mat = gmodulo(matid(3), member_pol(nf));
10285 if (!gequal0(flag3))
10286 {
10287 resl = gtrans(bnfqfsolve2(bnf, aa, bb, auto_s, prec));
10288 break;
10289 }
10290 pol = gadd(gmul(aa, gsqr(x)), bb);
10291 vecrat = nfratpoint(nf, pol, borne = gaddgs(borne, 1), gen_1, prec);
10292 if (!gequalgs(vecrat, 0))
10293 {
10294 p13 = cgetg(4, t_COL);
10295 gel(p13, 1) = gcopy(gel(vecrat, 2));
10296 gel(p13, 2) = gcopy(gel(vecrat, 1));
10297 gel(p13, 3) = gcopy(gel(vecrat, 3));
10298 resl = p13;
10299 break;
10300 }
10301 alpha = gen_0;
10302 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
10303 pari_printf("borne = %Ps\n", borne);
10304 {
10305 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
10306 while (gequal0(alpha))
10307 {
10308 xx = nfrandint(nf, borne);
10309 yy = nfrandint(nf, borne);
10310 borne = gaddgs(borne, 1);
10311 alpha = gsub(gsqr(xx), gmul(aa, gsqr(yy)));
10312 if (low_stack(st_lim, stack_lim(btop, 1)))
10313 gerepileall(btop, 4, &xx, &yy, &borne, &alpha);
10314 }
10315 }
10316 bb = gmul(bb, alpha);
10317 nb = gmul(nb, gabs(gnorm(alpha), prec));
10318 t = gadd(gmul(xx, gel(mat, 1)), gmul(yy, gel(mat, 2)));
10319 gel(mat, 2) = gadd(gmul(xx, gel(mat, 2)), gmul(gmul(aa, yy), gel(mat, 1)));
10320 gel(mat, 1) = gcopy(t);
10321 gel(mat, 3) = gmul(gel(mat, 3), alpha);
10322 }
10323 else
10324 {
10325 test = gen_1;
10326 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
10327 pari_printf("on factorise bb = %Ps\n", bb);
10328 sun = bnfsunit(bnf, gtrans(gel(idealfactor(bnf, bb), 1)), prec);
10329 fact = lift(bnfissunit(bnf, sun, bb));
10330 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
10331 pari_printf("fact = %Ps\n", fact);
10332 l14 = glength(gel(sun, 1));
10333 {
10334 long i;
10335 p15 = cgetg(l14+1, t_VEC);
10336 for (i = 1; i <= l14; ++i)
10337 gel(p15, i) = basistoalg(bnf, gel(gel(sun, 1), i));
10338 }
10339 suni = concat(getfutu(bnf), p15);
10340 l16 = glength(suni);
10341 {
10342 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
10343 long i;
10344 for (i = 1; i <= l16; ++i)
10345 {
10346 if (!gequal0(f = gshift(gel(fact, i), -1)))
10347 {
10348 test = gen_0;
10349 {
10350 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
10351 long k;
10352 for (k = 1; k <= 3; ++k)
10353 {
10354 gcoeff(mat, k, 3) = gdiv(gcoeff(mat, k, 3), gpow(gel(suni, i), f, prec));
10355 if (low_stack(st_lim, stack_lim(btop, 1)))
10356 mat = gerepilecopy(btop, mat);
10357 }
10358 }
10359 nb = gdiv(nb, gpow(gabs(gnorm(gel(suni, i)), prec), gmulsg(2, f), prec));
10360 bb = gdiv(bb, gpow(gel(suni, i), gmulsg(2, f), prec));
10361 }
10362 if (low_stack(st_lim, stack_lim(btop, 1)))
10363 gerepileall(btop, 5, &f, &test, &mat, &nb, &bb);
10364 }
10365 }
10366 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
10367 pari_printf("on factorise bb = %Ps\n", bb);
10368 fact = idealfactor(nf, bb);
10369 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
10370 pari_printf("fact = %Ps\n", fact);
10371 l = stoi(glength(gel(fact, 1)));
10372 if (!gequal0(test))
10373 {
10374 aux = gen_1;
10375 {
10376 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
10377 GEN i = gen_0;
10378 for (i = gen_1; gcmp(i, l) <= 0; i = gaddgs(i, 1))
10379 {
10380 if ((!gequal0(f = gshift(gcoeff(fact, gtos(i), 2), -1)) && (gequal0(gmodgs(gel(gcoeff(fact, gtos(i), 1), 1), 2)))) && (!nfpsquareodd(nf, aa, gcoeff(fact, gtos(i), 1), prec)))
10381 aux = idealmul(nf, aux, idealpow0(nf, gcoeff(fact, gtos(i), 1), f, 0));
10382 if (low_stack(st_lim, stack_lim(btop, 1)))
10383 gerepileall(btop, 3, &i, &f, &aux);
10384 }
10385 }
10386 if (!gequalgs(aux, 1))
10387 {
10388 test = gen_0;
10389 alpha = basistoalg(nf, idealappr0(nf, idealinv(nf, aux), 0));
10390 alpha2 = gsqr(alpha);
10391 bb = gmul(bb, alpha2);
10392 nb = gmul(nb, gabs(gnorm(alpha2), prec));
10393 gel(mat, 3) = gmul(gel(mat, 3), alpha);
10394 }
10395 }
10396 if (!gequal0(test))
10397 {
10398 maxnbiter = shifti(gen_1, gtos(l));
10399 {
10400 long i;
10401 p17 = cgetg(gtos(l)+1, t_VEC);
10402 for (i = 1; gcmpsg(i, l) <= 0; ++i)
10403 gel(p17, i) = nfissquarep(nf, aa, gcoeff(fact, i, 1), gcoeff(fact, i, 2), prec);
10404 }
10405 sq = p17;
10406 l = stoi(glength(sq));
10407 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
10408 {
10409 pari_printf("sq = %Ps\n", sq);
10410 pari_printf("fact = %Ps\n", fact);
10411 pari_printf("l = %Ps\n", l);
10412 }
10413 if (gcmpgs(l, 1) > 0)
10414 {
10415 idbb = idealhnf0(nf, bb, NULL);
10416 rem = nfchinremain(nf, idbb, fact);
10417 }
10418 test = gen_1;
10419 nbiter = gen_1;
10420 {
10421 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
10422 GEN p19 = gen_0, p20 = gen_0, p21 = gen_0; /* vec */
10423 while (!gequal0(test) && (gcmp(nbiter, maxnbiter) <= 0))
10424 {
10425 if (gcmpgs(l, 1) > 0)
10426 {
10427 mask = nbiter;
10428 xx = gen_0;
10429 {
10430 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
10431 GEN i = gen_0;
10432 for (i = gen_1; gcmp(i, l) <= 0; i = gaddgs(i, 1))
10433 {
10434 if (!gequal0(gmodgs(mask, 2)))
10435 xx = gadd(xx, gmul(gel(rem, gtos(i)), gel(sq, gtos(i))));
10436 else
10437 xx = gsub(xx, gmul(gel(rem, gtos(i)), gel(sq, gtos(i))));
10438 mask = gshift(mask, -1);
10439 if (low_stack(st_lim, stack_lim(btop, 1)))
10440 gerepileall(btop, 3, &i, &xx, &mask);
10441 }
10442 }
10443 }
10444 else
10445 {
10446 test = gen_0;
10447 xx = gcopy(gel(sq, 1));
10448 }
10449 xx = mynfeltmod(nf, xx, bb);
10450 alpha = gsub(gsqr(xx), aa);
10451 if (gequal0(alpha))
10452 {
10453 p19 = cgetg(4, t_COL);
10454 gel(p19, 1) = gcopy(xx);
10455 gel(p19, 2) = gen_1;
10456 gel(p19, 3) = gen_0;
10457 resl = p19;
10458 goto label6;
10459 }
10460 t = gdiv(alpha, bb);
10461 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
10462 {
10463 p20 = cgetg(3, t_VEC);
10464 gel(p20, 1) = gcopy(alpha);
10465 gel(p20, 2) = gcopy(bb);
10466 pari_printf("[alpha,bb] = %Ps\n", p20);
10467 }
10468 oldnb = nb;
10469 newnb = gabs(gnorm(t), prec);
10470 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
10471 {
10472 p21 = cgetg(4, t_VEC);
10473 gel(p21, 1) = gcopy(oldnb);
10474 gel(p21, 2) = gcopy(newnb);
10475 gel(p21, 3) = gadd(gdiv(oldnb, newnb), real_0(prec));
10476 pari_printf("[oldnb,newnb,oldnb/newnb] = %Ps\n", p21);
10477 }
10478 {
10479 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
10480 while (gcmp(nb, newnb) > 0)
10481 {
10482 gel(mat, 3) = gmul(gel(mat, 3), t);
10483 bb = t;
10484 nb = newnb;
10485 t = gadd(gmul(xx, gel(mat, 1)), gel(mat, 2));
10486 gel(mat, 2) = gadd(gmul(aa, gel(mat, 1)), gmul(xx, gel(mat, 2)));
10487 gel(mat, 1) = gcopy(t);
10488 xx = mynfeltmod(nf, gneg(xx), bb);
10489 alpha = gsub(gsqr(xx), aa);
10490 t = gdiv(alpha, bb);
10491 newnb = gabs(gnorm(t), prec);
10492 if (low_stack(st_lim, stack_lim(btop, 1)))
10493 gerepileall(btop, 7, &mat, &bb, &nb, &t, &xx, &alpha, &newnb);
10494 }
10495 }
10496 if (gequal(nb, oldnb))
10497 nbiter = gaddgs(nbiter, 1);
10498 else
10499 test = gen_0;
10500 if (low_stack(st_lim, stack_lim(btop, 1)))
10501 gerepileall(btop, 15, &mask, &xx, &test, &alpha, &p19, &resl, &t, &p20, &oldnb, &newnb, &p21, &mat, &bb, &nb, &nbiter);
10502 }
10503 }
10504 if (gequal(nb, oldnb))
10505 {
10506 if (!gequal0(flag3))
10507 {
10508 resl = gtrans(bnfqfsolve2(bnf, aa, bb, auto_s, prec));
10509 break;
10510 }
10511 pol = gadd(gmul(aa, gsqr(x)), bb);
10512 vecrat = nfratpoint(nf, pol, gshift(borne = gaddgs(borne, 1), 1), gen_1, prec);
10513 if (!gequalgs(vecrat, 0))
10514 {
10515 p18 = cgetg(4, t_COL);
10516 gel(p18, 1) = gcopy(gel(vecrat, 2));
10517 gel(p18, 2) = gcopy(gel(vecrat, 1));
10518 gel(p18, 3) = gcopy(gel(vecrat, 3));
10519 resl = p18;
10520 break;
10521 }
10522 bor = stoi(1000);
10523 yy = gen_1;
10524 testici = gen_1;
10525 {
10526 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
10527 long i, l22;
10528 GEN p23 = gen_0; /* vec */
10529 for (i = 1; i <= 10000; ++i)
10530 {
10531 l22 = degree(member_pol(nf));
10532 {
10533 long j;
10534 p23 = cgetg(l22+1, t_COL);
10535 for (j = 1; j <= l22; ++j)
10536 gel(p23, j) = genrand(bor);
10537 }
10538 de = basistoalg(nf, p23);
10539 if (!gequal(idealadd(bnf, de, bb), matid(degree(member_pol(bnf)))))
10540 continue;
10541 xxp = mynfeltmod(bnf, gmul(de, xx), bb);
10542 yyp = mynfeltmod(bnf, gmul(de, yy), bb);
10543 rap = gadd(gdiv(gnorm(gsub(gsqr(xxp), gmul(aa, gsqr(yyp)))), gsqr(nb)), real_0(prec));
10544 if (gcmpgs(gabs(rap, prec), 1) < 0)
10545 {
10546 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
10547 pari_printf("********** \n \n MIRACLE %Ps \n \n ***\n", rap);
10548 t = gdiv(gsub(gsqr(xxp), gmul(aa, gsqr(yyp))), bb);
10549 gel(mat, 3) = gmul(gel(mat, 3), t);
10550 bb = t;
10551 nb = gabs(gnorm(bb), prec);
10552 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
10553 pari_printf("newnb = %Ps\n", nb);
10554 t = gadd(gmul(xxp, gel(mat, 1)), gmul(yyp, gel(mat, 2)));
10555 gel(mat, 2) = gadd(gmul(gmul(aa, yyp), gel(mat, 1)), gmul(xxp, gel(mat, 2)));
10556 gel(mat, 1) = gcopy(t);
10557 xx = xxp;
10558 yy = gneg(yyp);
10559 testici = gen_0;
10560 }
10561 if (low_stack(st_lim, stack_lim(btop, 1)))
10562 gerepileall(btop, 12, &p23, &de, &xxp, &yyp, &rap, &t, &mat, &bb, &nb, &xx, &yy, &testici);
10563 }
10564 }
10565 if (!gequal0(testici))
10566 {
10567 alpha = gen_0;
10568 {
10569 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
10570 while (gequal0(alpha))
10571 {
10572 xx = nfrandint(nf, gmulsg(4, borne));
10573 yy = nfrandint(nf, gmulsg(4, borne));
10574 borne = gaddgs(borne, 1);
10575 alpha = gsub(gsqr(xx), gmul(aa, gsqr(yy)));
10576 if (low_stack(st_lim, stack_lim(btop, 1)))
10577 gerepileall(btop, 4, &xx, &yy, &borne, &alpha);
10578 }
10579 }
10580 bb = gmul(bb, alpha);
10581 nb = gmul(nb, gabs(gnorm(alpha), prec));
10582 t = gadd(gmul(xx, gel(mat, 1)), gmul(yy, gel(mat, 2)));
10583 gel(mat, 2) = gadd(gmul(xx, gel(mat, 2)), gmul(gmul(aa, yy), gel(mat, 1)));
10584 gel(mat, 1) = gcopy(t);
10585 gel(mat, 3) = gmul(gel(mat, 3), alpha);
10586 }
10587 }
10588 }
10589 }
10590 if (low_stack(st_lim, stack_lim(btop, 1)))
10591 gerepileall(btop, 48, &resl, &p4, &mat, &aa, &bb, &na, &nb, &p5, &p6, &p7, &p8, &t, &sq, &p9, &p10, &p11, &p12, &pol, &borne, &vecrat, &p13, &alpha, &xx, &yy, &test, &sun, &fact, &p15, &suni, &f, &l, &aux, &alpha2, &maxnbiter, &p17, &idbb, &rem, &nbiter, &mask, &oldnb, &newnb, &p18, &bor, &testici, &de, &xxp, &yyp, &rap);
10592 }
10593 label6:;
10594 }
10595 resl = lift(gmul(mat, resl));
10596 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
10597 pari_printf("resl1 = %Ps\n", resl);
10598 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
10599 pari_printf("content = %Ps\n", content(resl));
10600 resl = gdiv(resl, content(resl));
10601 resl = gmodulo(lift(resl), member_pol(nf));
10602 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
10603 pari_printf("resl3 = %Ps\n", resl);
10604 fact = idealadd(nf, idealadd(nf, gel(resl, 1), gel(resl, 2)), gel(resl, 3));
10605 fact = bnfisprincipal0(bnf, fact, 3);
10606 resl = gmul(resl, ginv(basistoalg(nf, gel(fact, 2))));
10607 if (gcmpgs(DEBUGLEVEL_ell, 5) >= 0)
10608 pari_printf("resl4 = %Ps\n", resl);
10609 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
10610 pari_printf("resl = %Ps\n", resl);
10611 verif = stoi(gequal0(gsub(gsub(gsqr(gel(resl, 1)), gmul(aleg, gsqr(gel(resl, 2)))), gmul(bleg, gsqr(gel(resl, 3))))));
10612 if ((gequal0(verif)) && (gcmpgs(DEBUGLEVEL_ell, 0) >= 0))
10613 pari_err(user, " bnfqfsolve : MAUVAIS POINT");
10614 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
10615 pari_printf("fin de bnfqfsolve\n");
10616 resl = gerepilecopy(ltop, resl);
10617 return resl;
10618 }
10619
10620 GEN
10621 bnfredquartique2(GEN bnf, GEN pol, GEN r, GEN a, GEN b) /* vec */
10622 {
10623 pari_sp ltop = avma;
10624 GEN gcc = gen_0, princ = gen_0, rp = gen_0, pol2 = gen_0;
10625 GEN p1 = gen_0, p2 = gen_0; /* vec */
10626 GEN x = pol_x(fetch_user_var("x"));
10627 GEN p3 = gen_0; /* vec */
10628 /* MODI remove ap, den */
10629
10630 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
10631 pari_printf("entree dans bnfredquartique2\n");
10632 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
10633 {
10634 p1 = cgetg(4, t_VEC);
10635 gel(p1, 1) = gcopy(r);
10636 gel(p1, 2) = gcopy(a);
10637 gel(p1, 3) = gcopy(b);
10638 pari_printf("%Ps\n", p1);
10639 }
10640 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
10641 pari_printf(" reduction de la quartique %Ps\n", pol);
10642 if (gequal0(a))
10643 rp = gen_0;
10644 else
10645 {
10646 gcc = idealadd(bnf, b, a);
10647 if (gequal1(gcc))
10648 {
10649 rp = gdiv(basistoalg(bnf, gel(idealaddtoone0(member_nf(bnf), a, b), 1)), a);
10650 rp = mynfeltmod(bnf, gmul(r, rp), b);
10651 }
10652 else
10653 {
10654 princ = bnfisprincipal0(bnf, gcc, 3);
10655 if (gequal0(gel(princ, 1)))
10656 gcc = basistoalg(bnf, gel(princ, 2));
10657 else
10658 {
10659 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
10660 pari_printf(" quartique non reduite\n");
10661 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
10662 pari_printf("fin de bnfredquartique2\n");
10663 p2 = cgetg(4, t_VEC);
10664 gel(p2, 1) = gcopy(pol);
10665 gel(p2, 2) = gen_0;
10666 gel(p2, 3) = gen_1;
10667 p2 = gerepilecopy(ltop, p2);
10668 return p2;
10669 }
10670 rp = gdiv(basistoalg(bnf, gel(idealaddtoone0(member_nf(bnf), gdiv(a, gcc), gdiv(b, gcc)), 1)), gdiv(a, gcc));
10671 rp = gdiv(mynfeltmod(bnf, gmul(r, rp), b), gcc);
10672 b = gdiv(b, gcc);
10673 }
10674 }
10675 pol2 = gdiv(gsubst(gdiv(pol, b), gvar(x), gadd(rp, gmul(b, x))), gpowgs(b, 3));
10676 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
10677 pari_printf(" quartique reduite = %Ps\n", pol2);
10678 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
10679 pari_printf("fin de bnfredquartique2\n");
10680 p3 = cgetg(4, t_VEC);
10681 gel(p3, 1) = gcopy(pol2);
10682 gel(p3, 2) = gcopy(rp);
10683 gel(p3, 3) = gcopy(b);
10684 p3 = gerepilecopy(ltop, p3);
10685 return p3;
10686 }
10687
10688 GEN
10689 bnfell2descent_gen(GEN bnf, GEN ell, GEN ext, GEN help, GEN bigflag, GEN flag3, GEN auto_s, long prec) /* vec */
10690 {
10691 pari_sp ltop = avma;
10692 GEN p1 = gen_0; /* vec */
10693 GEN y = pol_x(fetch_user_var("y")), nf = gen_0, unnf = gen_0, ellnf = gen_0, A = gen_0, B = gen_0, C = gen_0, S = gen_0, plist = gen_0, Lrnf = gen_0, SLprod = gen_0, oddclass = gen_0, SLlist = gen_0, LS2gen = gen_0, polrel = gen_0, alpha = gen_0, ttheta = gen_0, KS2gen = gen_0, LS2genunit = gen_0, normcoord = gen_0, LS2coordtilda = gen_0, LS2tilda = gen_0, aux = gen_0, listgen = gen_0, listpoints = gen_0, listpointstriv = gen_0, listpointsmwr = gen_0, list = gen_0, m1 = gen_0, m2 = gen_0, loc = gen_0, lastloc = gen_0, maskwhile = gen_0, iwhile = gen_0, zc = gen_0, iaux = gen_0, liftzc = gen_0, ispointtriv = gen_0, point = gen_0, c = gen_0, b = gen_0, a = gen_0, sol = gen_0, found = gen_0, alphac = gen_0, r = gen_0, denc = gen_0, dena = gen_0, cp = gen_0, alphacp = gen_0, beta = gen_0, mattr = gen_0, vec = gen_0, z1 = gen_0, ff = gen_0, cont = gen_0, d = gen_0, e = gen_0, polorig = gen_0, pol = gen_0, redq = gen_0, transl = gen_0, multip = gen_0, UVW = gen_0, pointxx = gen_0, point2 = gen_0, v = gen_0, rang = gen_0, normLS2gen = gen_0, listELS = gen_0, listnotELS = gen_0, listlistELS = gen_0, x = pol_x(fetch_user_var("x"));
10694 long l2;
10695 GEN p3 = gen_0; /* vec */
10696 long l4, l5;
10697 GEN p6 = gen_0; /* vec */
10698 long l7;
10699 long l8; /* lg */
10700 GEN p9 = gen_0; /* vec */
10701 long l10; /* lg */
10702 GEN p11 = gen_0, p12 = gen_0, p13 = gen_0; /* vec */
10703 long l14;
10704 GEN p15 = gen_0; /* vec */
10705 if (!help)
10706 help = cgetg(1, t_VEC);
10707 if (!bigflag)
10708 bigflag = gen_1;
10709 if (!flag3)
10710 flag3 = gen_1;
10711 if (!auto_s)
10712 {
10713 p1 = cgetg(2, t_VEC);
10714 gel(p1, 1) = gcopy(y);
10715 auto_s = p1;
10716 }
10717 /* MODI remove i,j,normLS2, add normLS2gen */
10718 /* MODI add listELS,listnotELS,listlistELS */
10719
10720 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
10721 pari_printf("entree dans bnfell2descent_gen\n");
10722 /* \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
10723 /* construction de L(S,2) \\ */
10724 /* \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
10725
10726 nf = gcopy(member_nf(bnf));
10727 unnf = gmodulsg(1, member_pol(nf));
10728 ellnf = gmul(ell, unnf);
10729 if (glength(ellnf) <= 5)
10730 ellnf = smallellinit(ellnf);
10731 A = gcopy(ell_get_a2(ellnf));
10732 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
10733 pari_printf("A = %Ps\n", A);
10734 B = gcopy(ell_get_a4(ellnf));
10735 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
10736 pari_printf("B = %Ps\n", B);
10737 C = gcopy(ell_get_a6(ellnf));
10738 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
10739 pari_printf("C = %Ps\n", C);
10740 S = gmulsg(6, lift(member_disc(ellnf)));
10741 plist = gcopy(gel(idealfactor(nf, S), 1));
10742 Lrnf = gcopy(gel(ext, 3));
10743 SLprod = gsubst(lift(deriv(gel(ext, 1),-1)), gvar(y), lift(gel(gel(ext, 2), 2)));
10744 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
10745 pari_printf("%Ps\n", gel(ext, 2));
10746 oddclass = gen_0;
10747 {
10748 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
10749 while (gequal0(oddclass))
10750 {
10751 /* Constructoin de S: */
10752 SLlist = gtrans(gel(idealfactor(Lrnf, SLprod), 1));
10753 /* Construction des S-unites */
10754 LS2gen = bnfsunit(Lrnf, SLlist, prec);
10755 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
10756 pari_printf("LS2gen = %Ps\n", LS2gen);
10757 /* on ajoute la partie paire du groupe de classes. */
10758 oddclass = gmodgs(gel(gel(LS2gen, 5), 1), 2);
10759 if (gequal0(oddclass))
10760 {
10761 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
10762 pari_printf("2-class group %Ps\n", gcoeff(gel(gel(gel(LS2gen, 5), 3), 1), 1, 1));
10763 S = gmul(S, gcoeff(gel(gel(gel(LS2gen, 5), 3), 1), 1, 1));
10764 SLprod = idealmul(Lrnf, SLprod, gel(gel(gel(LS2gen, 5), 3), 1));
10765 }
10766 if (low_stack(st_lim, stack_lim(btop, 1)))
10767 gerepileall(btop, 5, &SLlist, &LS2gen, &oddclass, &S, &SLprod);
10768 }
10769 }
10770 polrel = gcopy(gel(ext, 1));
10771 alpha = gmodulo(gmodulo(y, member_pol(nf)), polrel);
10772 /* alpha est l'element primitif de K */
10773 ttheta = gmodulo(x, polrel);
10774 /* ttheta est la racine de P(x) */
10775
10776 KS2gen = bnfsunit(bnf, gtrans(gel(idealfactor(nf, S), 1)), prec);
10777 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
10778 pari_printf("#KS2gen = %ld\n", glength(gel(KS2gen, 1)));
10779 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
10780 pari_printf("KS2gen = %Ps\n", gel(KS2gen, 1));
10781 LS2genunit = lift(getfutu(Lrnf));
10782 l2 = glength(gel(LS2gen, 1));
10783 {
10784 long i;
10785 p3 = cgetg(l2+1, t_VEC);
10786 for (i = 1; i <= l2; ++i)
10787 gel(p3, i) = lift(basistoalg(Lrnf, gel(gel(LS2gen, 1), i)));
10788 }
10789 /* A CHANGER : LS2genunit = concat(LS2genunit,lift(matbasistoalg(Lrnf,LS2gen[1]))); */
10790 LS2genunit = concat(LS2genunit, p3);
10791 LS2genunit = gsubst(LS2genunit, gvar(x), ttheta);
10792 LS2genunit = gmul(LS2genunit, gmodulsg(1, polrel));
10793 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
10794 pari_printf("#LS2genunit = %ld\n", glength(LS2genunit));
10795 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
10796 pari_printf("LS2genunit = %Ps\n", LS2genunit);
10797 /* dans LS2gen, on ne garde que ceux dont la norme est un carre. */
10798
10799 normLS2gen = gnorm(LS2genunit);
10800 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
10801 pari_printf("normLS2gen = %Ps\n", normLS2gen);
10802 l4 = glength(normLS2gen);
10803 l5 = (glength(gel(KS2gen, 1)) + glength(gel(gel(bnf, 8), 5))) + 1;
10804 {
10805 long i, j;
10806 p6 = cgetg(l4+1, t_MAT);
10807 for (j = 1; j <= l4; ++j)
10808 {
10809 gel(p6, j) = cgetg(l5+1, t_COL);
10810 for (i = 1; i <= l5; ++i)
10811 gcoeff(p6, i, j) = gen_0;
10812 }
10813 }
10814 /* matrice de l'application norme */
10815
10816 normcoord = p6;
10817 l7 = glength(normLS2gen);
10818 {
10819 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
10820 long i;
10821 for (i = 1; i <= l7; ++i)
10822 {
10823 gel(normcoord, i) = bnfissunit(bnf, KS2gen, gel(normLS2gen, i));
10824 if (low_stack(st_lim, stack_lim(btop, 1)))
10825 normcoord = gerepilecopy(btop, normcoord);
10826 }
10827 }
10828 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
10829 pari_printf("normcoord = %Ps\n", normcoord);
10830 /* construction du noyau de la norme */
10831
10832 LS2coordtilda = lift(matker0(gmul(normcoord, gmodulss(1, 2)), 0));
10833 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
10834 pari_printf("LS2coordtilda = %Ps\n", LS2coordtilda);
10835 l8 = lg(rowcopy(LS2coordtilda, 1));
10836 {
10837 long i;
10838 p9 = cgetg(l8, t_VEC);
10839 for (i = 1; i < l8; ++i)
10840 gel(p9, i) = gen_0;
10841 }
10842 LS2tilda = p9;
10843 l10 = lg(rowcopy(LS2coordtilda, 1));
10844 {
10845 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
10846 long i, l16;
10847 for (i = 1; i < l10; ++i)
10848 {
10849 aux = gen_1;
10850 l16 = glength(gel(LS2coordtilda, i));
10851 {
10852 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
10853 long j;
10854 for (j = 1; j <= l16; ++j)
10855 {
10856 if (gsigne(gcoeff(LS2coordtilda, j, i)))
10857 aux = gmul(aux, gel(LS2genunit, j));
10858 if (low_stack(st_lim, stack_lim(btop, 1)))
10859 aux = gerepilecopy(btop, aux);
10860 }
10861 }
10862 gel(LS2tilda, i) = gcopy(aux);
10863 if (low_stack(st_lim, stack_lim(btop, 1)))
10864 gerepileall(btop, 2, &aux, &LS2tilda);
10865 }
10866 }
10867 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
10868 pari_printf("LS2tilda = %Ps\n", LS2tilda);
10869 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
10870 pari_printf("norm(LS2tilda) = %Ps\n", gnorm(LS2tilda));
10871 /* Fin de la construction de L(S,2) */
10872
10873 listgen = gcopy(LS2tilda);
10874 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
10875 pari_printf("LS2gen = %Ps\n", listgen);
10876 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
10877 pari_printf("#LS2gen = %ld\n", glength(listgen));
10878 listpoints = cgetg(1, t_VEC);
10879 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
10880 {
10881 p11 = cgetg(4, t_VEC);
10882 gel(p11, 1) = gcopy(A);
10883 gel(p11, 2) = gcopy(B);
10884 gel(p11, 3) = gcopy(C);
10885 pari_printf("(A,B,C) = %Ps\n", p11);
10886 }
10887 /* \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
10888 /* Recherche de points triviaux \\ */
10889 /* \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
10890
10891 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
10892 pari_printf(" Recherche de points triviaux sur la courbe \n");
10893 listpointstriv = nfratpoint(nf, gadd(gadd(gadd(gpowgs(x, 3), gmul(A, gsqr(x))), gmul(B, x)), C), LIMTRIV, gen_0, prec);
10894 listpointstriv = concat(help, listpointstriv);
10895 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
10896 pari_printf("points triviaux sur la courbe = %Ps\n", listpointstriv);
10897 /* \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
10898 /* parcours de L(S,2) \\ */
10899 /* \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ */
10900
10901 listpointsmwr = cgetg(1, t_VEC);
10902 p12 = cgetg(4, t_VEC);
10903 gel(p12, 1) = stoi(6);
10904 gel(p12, 2) = gcopy(member_disc(ellnf));
10905 gel(p12, 3) = gen_0;
10906 list = p12;
10907 m1 = gen_0;
10908 m2 = gen_0;
10909 lastloc = gen_m1;
10910 maskwhile = shifti(gen_1, glength(listgen));
10911 p13 = cgetg(2, t_VEC);
10912 gel(p13, 1) = gen_0;
10913 listELS = p13;
10914 listnotELS = cgetg(1, t_VEC);
10915 iwhile = gen_1;
10916 {
10917 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
10918 long l17, l18, l19;
10919 GEN p20 = gen_0; /* vec */
10920 long l21;
10921 GEN p22 = gen_0;
10922 long l23;
10923 GEN p24 = gen_0; /* vec */
10924 long l25;
10925 GEN p26 = gen_0, p27 = gen_0, p28 = gen_0, p29 = gen_0, p30 = gen_0, p31 = gen_0, p32 = gen_0, p33 = gen_0, p34 = gen_0, p35 = gen_0, p36 = gen_0; /* vec */
10926 while (gcmp(iwhile, maskwhile) < 0)
10927 {
10928 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
10929 {
10930 pari_printf("iwhile = %Ps\n", iwhile);
10931 pari_printf("listgen = %Ps\n", listgen);
10932 }
10933 /* utilise la structure de groupe pour detecter une eventuelle solubilite locale. */
10934 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
10935 {
10936 pari_printf("listELS = %Ps\n", listELS);
10937 pari_printf("listnotELS = %Ps\n", listnotELS);
10938 }
10939 sol = gen_1;
10940 loc = gen_0;
10941 l17 = glength(listELS);
10942 {
10943 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
10944 long i, l37;
10945 for (i = 1; i <= l17; ++i)
10946 {
10947 l37 = glength(listnotELS);
10948 {
10949 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
10950 long j;
10951 GEN p38 = gen_0; /* vec */
10952 for (j = 1; j <= l37; ++j)
10953 {
10954 if (gequal(gbitxor(gel(listELS, i), gel(listnotELS, j)), iwhile))
10955 {
10956 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
10957 pari_printf(" Non ELS d'apres la structure de groupe\n");
10958 p38 = cgetg(2, t_VEC);
10959 gel(p38, 1) = gcopy(iwhile);
10960 listnotELS = concat(listnotELS, p38);
10961 sol = gen_0;
10962 goto label7;
10963 }
10964 if (low_stack(st_lim, stack_lim(btop, 1)))
10965 gerepileall(btop, 3, &p38, &listnotELS, &sol);
10966 }
10967 }
10968 if (low_stack(st_lim, stack_lim(btop, 1)))
10969 gerepileall(btop, 2, &listnotELS, &sol);
10970 }
10971 label7:;
10972 }
10973 if (gequal0(sol))
10974 {
10975 iwhile = gaddgs(iwhile, 1);
10976 continue;
10977 }
10978 l18 = glength(listELS);
10979 {
10980 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
10981 long i, l39, l40;
10982 for (i = 1; i <= l18; ++i)
10983 {
10984 l39 = i + 1;
10985 l40 = glength(listELS);
10986 {
10987 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
10988 GEN j = gen_0;
10989 GEN p41 = gen_0; /* vec */
10990 for (j = stoi(l39); gcmpgs(j, l40) <= 0; j = gaddgs(j, 1))
10991 {
10992 if (gequal(gbitxor(gel(listELS, i), gel(listELS, gtos(j))), iwhile))
10993 {
10994 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
10995 pari_printf(" ELS d'aptres la structure de \n");
10996 p41 = cgetg(2, t_VEC);
10997 gel(p41, 1) = gcopy(iwhile);
10998 listELS = concat(listELS, p41);
10999 loc = gen_2;
11000 goto label8;
11001 }
11002 if (low_stack(st_lim, stack_lim(btop, 1)))
11003 gerepileall(btop, 4, &j, &p41, &listELS, &loc);
11004 }
11005 }
11006 if (low_stack(st_lim, stack_lim(btop, 1)))
11007 gerepileall(btop, 2, &listELS, &loc);
11008 }
11009 label8:;
11010 }
11011 l19 = glength(listgen);
11012 {
11013 long i;
11014 p20 = cgetg(l19+1, t_VEC);
11015 for (i = 1; i <= l19; ++i)
11016 gel(p20, i) = gbittest(iwhile, i - 1);
11017 }
11018 iaux = gtrans(p20);
11019 iaux = gmodgs(gmul(LS2coordtilda, iaux), 2);
11020 l21 = glength(LS2genunit);
11021 {
11022 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
11023 long i;
11024 p22 = gen_1;
11025 for (i = 1; i <= l21; ++i)
11026 {
11027 p22 = gmul(p22, gpow(gel(LS2genunit, i), gel(iaux, i), prec));
11028 if (low_stack(st_lim, stack_lim(btop, 1)))
11029 p22 = gerepilecopy(btop, p22);
11030 }
11031 }
11032 zc = gmul(unnf, p22);
11033 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
11034 pari_printf("zc = %Ps\n", zc);
11035 liftzc = lift(zc);
11036 /* Est-ce un point trivial ? */
11037 ispointtriv = gen_0;
11038 l23 = glength(listpointstriv);
11039 {
11040 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
11041 long i;
11042 GEN p42 = gen_0, p43 = gen_0; /* vec */
11043 for (i = 1; i <= l23; ++i)
11044 {
11045 point = gcopy(gel(listpointstriv, i));
11046 if ((glength(point) == 2) || !gequalgs(gel(point, 3), 0))
11047 if (nfissquare(member_nf(Lrnf), gsubst(gmul(gsub(lift(gel(point, 1)), x), lift(liftzc)), gvar(y), lift(gel(gel(ext, 2), 2))), prec))
11048 {
11049 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
11050 pari_printf(" vient du point trivial %Ps\n", point);
11051 p42 = cgetg(2, t_VEC);
11052 gel(p42, 1) = gcopy(point);
11053 listpointsmwr = concat(listpointsmwr, p42);
11054 m1 = gaddgs(m1, 1);
11055 p43 = cgetg(2, t_VEC);
11056 gel(p43, 1) = gcopy(iwhile);
11057 listELS = concat(listELS, p43);
11058 if (gcmp(degre(iwhile), lastloc) > 0)
11059 m2 = gaddgs(m2, 1);
11060 sol = found = ispointtriv = gen_1;
11061 break;
11062 }
11063 if (low_stack(st_lim, stack_lim(btop, 1)))
11064 gerepileall(btop, 10, &point, &p42, &listpointsmwr, &m1, &p43, &listELS, &m2, &ispointtriv, &found, &sol);
11065 }
11066 }
11067 /* Ce n'est pas un point trivial */
11068 if (gequal0(ispointtriv))
11069 {
11070 c = polcoeff0(liftzc, 2, -1);
11071 b = gneg(polcoeff0(liftzc, 1, -1));
11072 a = polcoeff0(liftzc, 0, -1);
11073 sol = gen_0;
11074 found = gen_0;
11075 /* \\\\\\\\\\\\\ */
11076 /* On cherche a ecrire zc sous la forme a-b*theta */
11077 /* \\\\\\\\\\\\\ */
11078 if (gequal0(c))
11079 sol = gen_1;
11080 else
11081 {
11082 alphac = gadd(gmul(gsub(gadd(gmul(A, b), gmul(B, c)), a), c), gsqr(b));
11083 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
11084 pari_printf("alphac = %Ps\n", alphac);
11085 r = gcopy(gel(nfsqrt(nf, gnorm(zc), prec), 1));
11086 if (gequal0(alphac))
11087 {
11088 /* cas particulier */
11089 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
11090 pari_printf(" on continue avec 1/zc\n");
11091 sol = gen_1;
11092 zc = gmul(gnorm(zc), ginv(zc));
11093 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
11094 pari_printf(" zc = %Ps\n", zc);
11095 }
11096 else
11097 {
11098 /* Il faut resoudre une forme quadratique */
11099 /* Existence (locale = globale) d'une solution : */
11100 denc = deno(lift(c));
11101 if (!gequalgs(denc, 1))
11102 cp = gmul(c, gsqr(denc));
11103 else
11104 cp = c;
11105 dena = deno(lift(alphac));
11106 if (!gequalgs(dena, 1))
11107 alphacp = gmul(alphac, gsqr(dena));
11108 else
11109 alphacp = alphac;
11110 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
11111 pari_printf(" symbole de Hilbert (%Ps,%Ps) = ", alphacp, cp);
11112 sol = stoi(!gequal0(loc) || (mynfhilbert(nf, alphacp, cp, prec) + 1));
11113 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
11114 pari_printf("%Ps\n", gsubgs(sol, 1));
11115 if (!gequal0(sol))
11116 {
11117 beta = gadd(gsub(gmul(A, gadd(gadd(gmul(gmul(A, b), c), gmul(B, gsqr(c))), gsqr(b))), gmul(C, gsqr(c))), gmul(a, b));
11118 mattr = matid(3);
11119 gcoeff(mattr, 1, 1) = gcopy(c);
11120 gcoeff(mattr, 2, 2) = gcopy(alphac);
11121 gcoeff(mattr, 3, 3) = gcopy(r);
11122 gcoeff(mattr, 2, 3) = gneg(beta);
11123 gcoeff(mattr, 1, 2) = gneg(gadd(b, gmul(A, c)));
11124 gcoeff(mattr, 1, 3) = gadd(gsub(a, gmul(B, c)), gmul(A, gadd(gmul(A, c), b)));
11125 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
11126 pari_printf(" sol de Legendre = ");
11127 vec = bnfqfsolve(bnf, alphacp, cp, flag3, auto_s, prec);
11128 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
11129 pari_printf("%Ps\n", lift(vec));
11130 aux = gmul(gel(vec, 2), dena);
11131 gel(vec, 2) = gcopy(gel(vec, 1));
11132 gel(vec, 1) = gcopy(aux);
11133 gel(vec, 3) = gmul(gel(vec, 3), denc);
11134 vec = gmul(ginv(mattr), vec);
11135 vec = gdiv(vec, content(lift(vec)));
11136 z1 = gadd(gmul(gadd(gmul(gel(vec, 3), ttheta), gel(vec, 2)), ttheta), gel(vec, 1));
11137 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
11138 pari_printf(" z1 = %Ps\n", z1);
11139 zc = gmul(zc, gsqr(z1));
11140 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
11141 pari_printf(" zc*z1^2 = %Ps\n", zc);
11142 }
11143 }
11144 }
11145 }
11146 if (gequal0(sol))
11147 {
11148 p24 = cgetg(2, t_VEC);
11149 gel(p24, 1) = gcopy(iwhile);
11150 listnotELS = concat(listnotELS, p24);
11151 iwhile = gaddgs(iwhile, 1);
11152 continue;
11153 }
11154 /* \\\\\\\\\\ */
11155 /* Maintenant zc est de la forme a-b*theta */
11156 /* \\\\\\\\\\ */
11157 if (gequal0(ispointtriv))
11158 {
11159 liftzc = lift(zc);
11160 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
11161 pari_printf(" zc = %Ps\n", liftzc);
11162 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
11163 pari_printf(" N(zc) = %Ps\n", gnorm(zc));
11164 if (degree(liftzc) >= 2)
11165 pari_err(user, " bnfell2descent_gen : c <> 0");
11166 b = gneg(polcoeff0(liftzc, 1, -1));
11167 a = polcoeff0(liftzc, 0, -1);
11168 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
11169 pari_printf(" on factorise (a,b) = %Ps\n", idealadd(nf, a, b));
11170 ff = idealfactor(nf, idealadd(nf, a, b));
11171 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
11172 pari_printf(" ff = %Ps\n", ff);
11173 cont = gen_1;
11174 l25 = glength(gel(ff, 1));
11175 {
11176 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
11177 long i;
11178 for (i = 1; i <= l25; ++i)
11179 {
11180 cont = idealmul(nf, cont, idealpow0(nf, gcoeff(ff, i, 1), gdiventgs(gcoeff(ff, i, 2), 2), 0));
11181 if (low_stack(st_lim, stack_lim(btop, 1)))
11182 cont = gerepilecopy(btop, cont);
11183 }
11184 }
11185 cont = idealinv(nf, cont);
11186 cont = gsqr(basistoalg(nf, gel(bnfisprincipal0(bnf, cont, 3), 2)));
11187 a = gmul(a, cont);
11188 b = gmul(b, cont);
11189 zc = gmul(zc, cont);
11190 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
11191 {
11192 p26 = cgetg(3, t_VEC);
11193 gel(p26, 1) = gcopy(a);
11194 gel(p26, 2) = gcopy(b);
11195 pari_printf(" [a,b] = %Ps\n", p26);
11196 }
11197 if (nfissquare(nf, b, prec))
11198 {
11199 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
11200 pari_printf(" b est un carre\n");
11201 p27 = cgetg(3, t_VEC);
11202 gel(p27, 1) = gdiv(a, b);
11203 gel(p27, 2) = gcopy(gel(nfsqrt(nf, gadd(gadd(gadd(gpowgs(gdiv(a, b), 3), gmul(A, gsqr(gdiv(a, b)))), gmul(B, gdiv(a, b))), C), prec), 1));
11204 point = p27;
11205 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
11206 pari_printf("point trouve = %Ps\n", point);
11207 p28 = cgetg(2, t_VEC);
11208 gel(p28, 1) = gcopy(point);
11209 listpointsmwr = concat(listpointsmwr, p28);
11210 m1 = gaddgs(m1, 1);
11211 if (gcmp(degre(iwhile), lastloc) > 0)
11212 m2 = gaddgs(m2, 1);
11213 found = ispointtriv = gen_1;
11214 }
11215 }
11216 /* \\\\\\\\\\\ */
11217 /* Construction de la quartique */
11218 /* \\\\\\\\\\\ */
11219 if (gequal0(ispointtriv))
11220 {
11221 r = gcopy(gel(nfsqrt(nf, gnorm(zc), prec), 1));
11222 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
11223 pari_printf(" r = %Ps\n", r);
11224 c = gmulsg(-2, gadd(gmul(A, b), gmulsg(3, a)));
11225 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
11226 pari_printf(" c = %Ps\n", c);
11227 d = gmulsg(8, r);
11228 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
11229 pari_printf(" d = %Ps\n", d);
11230 e = gsub(gsub(gsub(gmul(gsqr(A), gsqr(b)), gmul(gmul(gmulsg(2, A), a), b)), gmul(gmulsg(4, B), gsqr(b))), gmulsg(3, gsqr(a)));
11231 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
11232 pari_printf(" e = %Ps\n", e);
11233 polorig = gmul(gmul(b, gadd(gadd(gadd(gpowgs(x, 4), gmul(c, gsqr(x))), gmul(d, x)), e)), unnf);
11234 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
11235 pari_printf(" quartique : (%Ps)*Y^2 = %Ps\n", lift(b), lift(gdiv(polorig, b)));
11236 gel(list, 3) = gcopy(b);
11237 pol = polorig;
11238 if (!gequal0(bigflag))
11239 {
11240 redq = bnfredquartique2(bnf, pol, r, a, b);
11241 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
11242 pari_printf(" reduite: Y^2 = %Ps\n", lift(gel(redq, 1)));
11243 pol = gcopy(gel(redq, 1));
11244 transl = gcopy(gel(redq, 2));
11245 multip = gcopy(gel(redq, 3));
11246 }
11247 point = nfratpoint(nf, pol, LIM1, gen_1, prec);
11248 if (!gequal(point, cgetg(1, t_VEC)))
11249 {
11250 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
11251 pari_printf("point = %Ps\n", point);
11252 m1 = gaddgs(m1, 1);
11253 if (!gequal0(bigflag))
11254 {
11255 gel(point, 1) = gadd(gmul(gel(point, 1), multip), transl);
11256 gel(point, 2) = gcopy(gel(nfsqrt(nf, gsubst(polorig, gvar(x), gdiv(gel(point, 1), gel(point, 3))), prec), 1));
11257 }
11258 mattr = matid(3);
11259 gcoeff(mattr, 1, 1) = gmulsg(-2, gsqr(b));
11260 gcoeff(mattr, 1, 2) = gmul(gadd(gmul(A, b), a), b);
11261 gcoeff(mattr, 1, 3) = gadd(gsqr(a), gmul(gsub(gmulsg(2, B), gsqr(A)), gsqr(b)));
11262 gcoeff(mattr, 2, 2) = gneg(b);
11263 gcoeff(mattr, 2, 3) = gadd(a, gmul(A, b));
11264 gcoeff(mattr, 3, 3) = gcopy(r);
11265 p29 = cgetg(4, t_COL);
11266 gel(p29, 1) = gsqr(gel(point, 1));
11267 gel(p29, 2) = gsqr(gel(point, 3));
11268 gel(p29, 3) = gmul(gel(point, 1), gel(point, 3));
11269 UVW = p29;
11270 vec = gmul(ginv(mattr), UVW);
11271 z1 = gadd(gmul(gadd(gmul(gel(vec, 3), ttheta), gel(vec, 2)), ttheta), gel(vec, 1));
11272 zc = gmul(zc, gsqr(z1));
11273 zc = gdiv(zc, gneg(polcoeff0(lift(zc), 1, -1)));
11274 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
11275 pari_printf("zc*z1^2 = %Ps\n", zc);
11276 pointxx = polcoeff0(lift(zc), 0, -1);
11277 p30 = cgetg(3, t_VEC);
11278 gel(p30, 1) = gcopy(pointxx);
11279 gel(p30, 2) = gcopy(gel(nfsqrt(nf, gsubst(gadd(gadd(gadd(gpowgs(x, 3), gmul(A, gsqr(x))), gmul(B, x)), C), gvar(x), pointxx), prec), 1));
11280 point2 = p30;
11281 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
11282 pari_printf(" point trouve = %Ps\n", point2);
11283 p31 = cgetg(2, t_VEC);
11284 gel(p31, 1) = gcopy(point2);
11285 listpointsmwr = concat(listpointsmwr, p31);
11286 if (gcmp(degre(iwhile), lastloc) > 0)
11287 m2 = gaddgs(m2, 1);
11288 found = gen_1;
11289 lastloc = gen_m1;
11290 }
11291 else
11292 {
11293 if ((!gequal0(loc) || ((gequal0(bigflag)) && nflocallysoluble(nf, pol, r, a, b, prec))) || (!gequal0(bigflag) && nflocallysoluble(nf, pol, gen_0, gen_1, gen_1, prec)))
11294 {
11295 if (gequal0(loc))
11296 {
11297 p32 = cgetg(2, t_VEC);
11298 gel(p32, 1) = gcopy(iwhile);
11299 listlistELS = concat(listELS, p32);
11300 }
11301 if (gcmp(degre(iwhile), lastloc) > 0)
11302 {
11303 m2 = gaddgs(m2, 1);
11304 lastloc = degre(iwhile);
11305 }
11306 point = nfratpoint(nf, pol, LIM3, gen_1, prec);
11307 if (!gequal(point, cgetg(1, t_VEC)))
11308 {
11309 m1 = gaddgs(m1, 1);
11310 if (!gequal0(bigflag))
11311 {
11312 gel(point, 1) = gadd(gmul(gel(point, 1), multip), transl);
11313 gel(point, 2) = gcopy(gel(nfsqrt(nf, gsubst(polorig, gvar(x), gdiv(gel(point, 1), gel(point, 3))), prec), 1));
11314 }
11315 mattr = matid(3);
11316 gcoeff(mattr, 1, 1) = gmulsg(-2, gsqr(b));
11317 gcoeff(mattr, 1, 2) = gmul(gadd(gmul(A, b), a), b);
11318 gcoeff(mattr, 1, 3) = gadd(gsqr(a), gmul(gsub(gmulsg(2, B), gsqr(A)), gsqr(b)));
11319 gcoeff(mattr, 2, 2) = gneg(b);
11320 gcoeff(mattr, 2, 3) = gadd(a, gmul(A, b));
11321 gcoeff(mattr, 3, 3) = gcopy(r);
11322 p33 = cgetg(4, t_COL);
11323 gel(p33, 1) = gsqr(gel(point, 1));
11324 gel(p33, 2) = gsqr(gel(point, 3));
11325 gel(p33, 3) = gmul(gel(point, 1), gel(point, 3));
11326 UVW = p33;
11327 vec = gmul(ginv(mattr), UVW);
11328 z1 = gadd(gmul(gadd(gmul(gel(vec, 3), ttheta), gel(vec, 2)), ttheta), gel(vec, 1));
11329 zc = gmul(zc, gsqr(z1));
11330 zc = gdiv(zc, gneg(polcoeff0(lift(zc), 1, -1)));
11331 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
11332 pari_printf(" zc*z1^2 = %Ps\n", zc);
11333 pointxx = polcoeff0(lift(zc), 0, -1);
11334 p34 = cgetg(3, t_VEC);
11335 gel(p34, 1) = gcopy(pointxx);
11336 gel(p34, 2) = gcopy(gel(nfsqrt(nf, gsubst(gadd(gadd(gadd(gpowgs(x, 3), gmul(A, gsqr(x))), gmul(B, x)), C), gvar(x), pointxx), prec), 1));
11337 point2 = p34;
11338 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
11339 pari_printf(" point trouve = %Ps\n", point2);
11340 p35 = cgetg(2, t_VEC);
11341 gel(p35, 1) = gcopy(point2);
11342 listpointsmwr = concat(listpointsmwr, p35);
11343 found = gen_1;
11344 lastloc = gen_m1;
11345 }
11346 }
11347 else
11348 {
11349 p36 = cgetg(2, t_VEC);
11350 gel(p36, 1) = gcopy(iwhile);
11351 listnotELS = concat(listnotELS, p36);
11352 }
11353 }
11354 }
11355 if (!gequal0(found))
11356 {
11357 found = gen_0;
11358 lastloc = gen_m1;
11359 v = degre(iwhile);
11360 iwhile = shifti(gen_1, gtos(v));
11361 maskwhile = gshift(maskwhile, -1);
11362 LS2coordtilda = extract0(LS2coordtilda, gsubgs(gsub(shifti(gen_1, glength(listgen)), iwhile), 1), NULL);
11363 listgen = extract0(listgen, gsubgs(gsub(shifti(gen_1, glength(listgen)), iwhile), 1), NULL);
11364 {
11365 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
11366 while (gcmp(gel(listELS, glength(listELS)), iwhile) >= 0)
11367 {
11368 listELS = extract0(listELS, subis(shifti(gen_1, glength(listELS) - 1), 1), NULL);
11369 if (low_stack(st_lim, stack_lim(btop, 1)))
11370 listELS = gerepilecopy(btop, listELS);
11371 }
11372 }
11373 {
11374 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
11375 while (glength(listnotELS) && (gcmp(gel(listnotELS, glength(listnotELS)), iwhile) >= 0))
11376 {
11377 listnotELS = extract0(listnotELS, subis(shifti(gen_1, glength(listnotELS) - 1), 1), NULL);
11378 if (low_stack(st_lim, stack_lim(btop, 1)))
11379 listnotELS = gerepilecopy(btop, listnotELS);
11380 }
11381 }
11382 }
11383 else
11384 iwhile = gaddgs(iwhile, 1);
11385 if (low_stack(st_lim, stack_lim(btop, 1)))
11386 gerepileall(btop, 61, &sol, &loc, &listnotELS, &iwhile, &listELS, &p20, &iaux, &p22, &zc, &liftzc, &ispointtriv, &point, &listpointsmwr, &m1, &m2, &found, &c, &b, &a, &alphac, &r, &denc, &cp, &dena, &alphacp, &beta, &mattr, &vec, &aux, &z1, &p24, &ff, &cont, &p26, &p27, &p28, &d, &e, &polorig, &list, &pol, &redq, &transl, &multip, &p29, &UVW, &pointxx, &p30, &point2, &p31, &lastloc, &p32, &listlistELS, &p33, &p34, &p35, &p36, &v, &maskwhile, &LS2coordtilda, &listgen);
11387 }
11388 }
11389 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
11390 {
11391 pari_printf("m1 = %Ps\n", m1);
11392 pari_printf("m2 = %Ps\n", m2);
11393 }
11394 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
11395 pari_printf("#S(E/K)[2] = %Ps\n", shifti(gen_1, gtos(m2)));
11396 if (gequal(m1, m2))
11397 {
11398 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
11399 {
11400 pari_printf("#E(K)/2E(K) = %Ps\n", shifti(gen_1, gtos(m1)));
11401 pari_printf("#III(E/K)[2] = 1\n");
11402 pari_printf("rang(E/K) = %Ps\n", m1);
11403 }
11404 rang = m1;
11405 }
11406 else
11407 {
11408 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
11409 {
11410 pari_printf("#E(K)/2E(K) >= %Ps\n", shifti(gen_1, gtos(m1)));
11411 pari_printf("#III(E/K)[2] <= %Ps\n", shifti(gen_1, gtos(gsub(m2, m1))));
11412 pari_printf("rang(E/K) >= %Ps\n", m1);
11413 }
11414 rang = m1;
11415 if (!gequal0(gmodgs(gsub(m2, m1), 2)))
11416 {
11417 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
11418 {
11419 pari_printf(" III devrait etre un carre, donc \n");
11420 if (gcmpgs(gsub(m2, m1), 1) > 0)
11421 {
11422 pari_printf("#E(K)/2E(K) >= %Ps\n", shifti(gen_1, gtos(gaddgs(m1, 1))));
11423 pari_printf("#III(E/K)[2] <= %Ps\n", shifti(gen_1, gtos(gsubgs(gsub(m2, m1), 1))));
11424 pari_printf("rang(E/K) >= %Ps\n", gaddgs(m1, 1));
11425 }
11426 else
11427 {
11428 pari_printf("#E(K)/2E(K) = %Ps\n", shifti(gen_1, gtos(gaddgs(m1, 1))));
11429 pari_printf("#III(E/K)[2] = 1\n");
11430 pari_printf("rang(E/K) = %Ps\n", gaddgs(m1, 1));
11431 }
11432 }
11433 rang = gaddgs(m1, 1);
11434 }
11435 }
11436 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
11437 pari_printf("listpointsmwr = %Ps\n", listpointsmwr);
11438 l14 = glength(listpointsmwr);
11439 {
11440 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
11441 long i;
11442 for (i = 1; i <= l14; ++i)
11443 {
11444 if (glength(gel(listpointsmwr, i)) == 3)
11445 gel(listpointsmwr, i) = extract0(gel(listpointsmwr, i), stoi(3), NULL);
11446 if (gequal0(ellisoncurve(ellnf, gel(listpointsmwr, i))))
11447 pari_err(user, "bnfell2descent : MAUVAIS POINT ");
11448 if (low_stack(st_lim, stack_lim(btop, 1)))
11449 listpointsmwr = gerepilecopy(btop, listpointsmwr);
11450 }
11451 }
11452 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
11453 pari_printf("fin de bnfell2descent_gen\n");
11454 p15 = cgetg(4, t_VEC);
11455 gel(p15, 1) = gcopy(rang);
11456 gel(p15, 2) = gcopy(m2);
11457 gel(p15, 3) = gcopy(listpointsmwr);
11458 p15 = gerepilecopy(ltop, p15);
11459 return p15;
11460 }
11461
11462 GEN
11463 bnfellrank(GEN bnf, GEN ell, GEN help, GEN bigflag, GEN flag3, long prec)
11464 {
11465 pari_sp ltop = avma;
11466 GEN urst = gen_0, urst1 = gen_0, den = gen_0, factden = gen_0, eqtheta = gen_0, rnfeq = gen_0, bbnf = gen_0, ext = gen_0, rang = gen_0, f = gen_0;
11467 GEN p1 = gen_0, p2 = gen_0, p3 = gen_0, p4 = gen_0; /* vec */
11468 GEN y = pol_x(fetch_user_var("y")), x = pol_x(fetch_user_var("x"));
11469 GEN p5 = gen_0, p6 = gen_0; /* vec */
11470 if (!help)
11471 help = cgetg(1, t_VEC);
11472 if (!bigflag)
11473 bigflag = gen_1;
11474 if (!flag3)
11475 flag3 = gen_1;
11476 /* MODI add f */
11477 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
11478 pari_printf("entree dans bnfellrank\n");
11479 if (glength(ell) <= 5)
11480 ell = smallellinit(ell);
11481 p1 = cgetg(5, t_VEC);
11482 gel(p1, 1) = gen_1;
11483 gel(p1, 2) = gen_0;
11484 gel(p1, 3) = gen_0;
11485 gel(p1, 4) = gen_0;
11486 /* removes the coefficients a1 and a3 */
11487 urst = p1;
11488 if (!gequalgs(ell_get_a1(ell), 0) || !gequalgs(ell_get_a3(ell), 0))
11489 {
11490 p2 = cgetg(5, t_VEC);
11491 gel(p2, 1) = gen_1;
11492 gel(p2, 2) = gen_0;
11493 gel(p2, 3) = gdivgs(gneg(ell_get_a1(ell)), 2);
11494 gel(p2, 4) = gdivgs(gneg(ell_get_a3(ell)), 2);
11495 urst1 = p2;
11496 ell = ellchangecurve(ell, urst1);
11497 urst = ellcomposeurst(urst, urst1);
11498 }
11499 /* removes denominators */
11500 {
11501 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
11502 long l7;
11503 GEN p8 = gen_0; /* vec */
11504 while (gcmpgs(gcoeff(den = idealinv(bnf, idealadd(bnf, idealadd(bnf, gen_1, ell_get_a2(ell)), idealadd(bnf, ell_get_a4(ell), ell_get_a6(ell)))), 1, 1), 1) > 0)
11505 {
11506 factden = gcopy(gel(idealfactor(bnf, den), 1));
11507 den = gen_1;
11508 l7 = glength(factden);
11509 {
11510 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
11511 long i;
11512 for (i = 1; i <= l7; ++i)
11513 {
11514 den = idealmul(bnf, den, gel(factden, i));
11515 if (low_stack(st_lim, stack_lim(btop, 1)))
11516 den = gerepilecopy(btop, den);
11517 }
11518 }
11519 den = gcopy(gcoeff(den, 1, 1));
11520 p8 = cgetg(5, t_VEC);
11521 gel(p8, 1) = ginv(den);
11522 gel(p8, 2) = gen_0;
11523 gel(p8, 3) = gen_0;
11524 gel(p8, 4) = gen_0;
11525 urst1 = p8;
11526 ell = ellchangecurve(ell, urst1);
11527 urst = ellcomposeurst(urst, urst1);
11528 if (low_stack(st_lim, stack_lim(btop, 1)))
11529 gerepileall(btop, 6, &den, &factden, &p8, &urst1, &ell, &urst);
11530 }
11531 }
11532 help = ellchangepoint(help, urst);
11533 /* choix de l'algorithme suivant la 2-torsion */
11534 ell = gmul(/* choix de l'algorithme suivant la 2-torsion */
11535 ell, gmodulsg(1, member_pol(bnf)));
11536 p3 = cgetg(5, t_VEC);
11537 gel(p3, 1) = gen_1;
11538 gel(p3, 2) = gcopy(ell_get_a2(ell));
11539 gel(p3, 3) = gcopy(ell_get_a4(ell));
11540 gel(p3, 4) = gcopy(ell_get_a6(ell));
11541 eqtheta = gtopoly(p3, -1);
11542 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
11543 pari_printf("courbe elliptique : Y^2 = %Ps\n", eqtheta);
11544 f = nfpolratroots(bnf, eqtheta);
11545 if (glength(f) == 0)
11546 {
11547 /* cas 1: 2-torsion triviale */
11548 rnfeq = rnfequation0(bnf, eqtheta, 1);
11549 p4 = cgetg(5, t_VEC);
11550 gel(p4, 1) = gen_1;
11551 gel(p4, 2) = gmul(gneg(gel(rnfeq, 3)), gmodulo(y, member_pol(bnf)));
11552 gel(p4, 3) = gen_0;
11553 gel(p4, 4) = gen_0;
11554 urst1 = p4;
11555 if (!gequalgs(gel(rnfeq, 3), 0))
11556 {
11557 ell = ellchangecurve(ell, urst1);
11558 urst = ellcomposeurst(urst, urst1);
11559 eqtheta = gsubst(eqtheta, gvar(x), gsub(x, gmul(gel(rnfeq, 3), gmodulo(y, member_pol(bnf)))));
11560 rnfeq = rnfequation0(bnf, eqtheta, 1);
11561 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
11562 pari_printf("translation : on travaille avec Y^2 = %Ps\n", eqtheta);
11563 }
11564 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
11565 pari_printf("bbnfinit ");
11566 bbnf = Buchall(gel(rnfeq, 1), nf_FORCE, prec);
11567 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
11568 pari_printf("done\n");
11569 p5 = cgetg(4, t_VEC);
11570 gel(p5, 1) = gcopy(eqtheta);
11571 gel(p5, 2) = gcopy(rnfeq);
11572 gel(p5, 3) = gcopy(bbnf);
11573 ext = p5;
11574 rang = bnfell2descent_gen(bnf, ell, ext, help, bigflag, flag3, NULL, prec);
11575 }
11576 else
11577 {
11578 if (glength(f) == 1)
11579 {
11580 /* cas 2: 2-torsion = Z/2Z */
11581 if (!gequalgs(gel(f, 1), 0))
11582 {
11583 p6 = cgetg(5, t_VEC);
11584 gel(p6, 1) = gen_1;
11585 gel(p6, 2) = gcopy(gel(f, 1));
11586 gel(p6, 3) = gen_0;
11587 gel(p6, 4) = gen_0;
11588 urst1 = p6;
11589 ell = ellchangecurve(ell, urst1);
11590 urst = ellcomposeurst(urst, urst1);
11591 }
11592 rang = bnfell2descent_viaisog(bnf, ell, prec);
11593 }
11594 else
11595 /* cas 3: 2-torsion = Z/2Z*Z/2Z */
11596 rang = bnfell2descent_complete(bnf, gel(f, 1), gel(f, 2), gel(f, 3), flag3, NULL, prec);
11597 }
11598 gel(rang, 3) = ellchangepointinverse(gel(rang, 3), urst);
11599 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
11600 pari_printf("fin de bnfellrank\n");
11601 rang = gerepilecopy(ltop, rang);
11602 return rang;
11603 }
11604
11605 GEN
11606 bnfell2descent_complete(GEN bnf, GEN e1, GEN e2, GEN e3, GEN flag3, GEN auto_s, long prec) /* vec */
11607 {
11608 pari_sp ltop = avma;
11609 GEN p1 = gen_0; /* vec */
11610 GEN y = pol_x(fetch_user_var("y")), KS2prod = gen_0, oddclass = gen_0, KS2gen = gen_0, vect = gen_0, selmer = gen_0, rang = gen_0, b1 = gen_0, b2 = gen_0, vec = gen_0, z1 = gen_0, z2 = gen_0, d31 = gen_0, quart0 = gen_0, quart = gen_0, cont = gen_0, fa = gen_0, point = gen_0, solx = gen_0, soly = gen_0, listepoints = gen_0, strange = gen_0;
11611 long l2, l3;
11612 GEN p4 = gen_0; /* vec */
11613 GEN x = pol_x(fetch_user_var("x"));
11614 GEN p5 = gen_0; /* vec */
11615 if (!flag3)
11616 flag3 = gen_1;
11617 if (!auto_s)
11618 {
11619 p1 = cgetg(2, t_VEC);
11620 gel(p1, 1) = gcopy(y);
11621 auto_s = p1;
11622 }
11623 /* MODI remove i,X,Y */
11624 /* MODI add strange */
11625 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
11626 pari_printf("Algorithme de la 2-descente complete\n");
11627 /* calcul de K(S,2) */
11628
11629 KS2prod = gmulgs(gmul(gmul(gsub(e1, e2), gsub(e2, e3)), gsub(e3, e1)), 2);
11630 oddclass = gen_0;
11631 {
11632 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
11633 while (gequal0(oddclass))
11634 {
11635 KS2gen = bnfsunit(bnf, gtrans(gel(idealfactor(bnf, KS2prod), 1)), prec);
11636 oddclass = gmodgs(gel(gel(KS2gen, 5), 1), 2);
11637 if (gequal0(oddclass))
11638 KS2prod = idealmul(bnf, KS2prod, gel(gel(gel(KS2gen, 5), 3), 1));
11639 if (low_stack(st_lim, stack_lim(btop, 1)))
11640 gerepileall(btop, 3, &KS2gen, &oddclass, &KS2prod);
11641 }
11642 }
11643 KS2gen = gcopy(gel(KS2gen, 1));
11644 /* A CHANGER : KS2gen = matbasistoalg(bnf,KS2gen); */
11645 l2 = glength(KS2gen);
11646 {
11647 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
11648 long i;
11649 for (i = 1; i <= l2; ++i)
11650 {
11651 gel(KS2gen, i) = basistoalg(bnf, gel(KS2gen, i));
11652 if (low_stack(st_lim, stack_lim(btop, 1)))
11653 KS2gen = gerepilecopy(btop, KS2gen);
11654 }
11655 }
11656 KS2gen = concat(gmodulo(lift(gettufu(bnf)), member_pol(bnf)), KS2gen);
11657 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
11658 {
11659 pari_printf("#K(S,2)gen = %ld\n", glength(KS2gen));
11660 pari_printf("K(S,2)gen = %Ps\n", KS2gen);
11661 }
11662 l3 = glength(KS2gen);
11663 {
11664 long i;
11665 GEN p6 = gen_0; /* vec */
11666 p4 = cgetg(l3+1, t_VEC);
11667 for (i = 1; i <= l3; ++i)
11668 {
11669 p6 = cgetg(3, t_VEC);
11670 gel(p6, 1) = gen_0;
11671 gel(p6, 2) = gen_1;
11672 gel(p4, i) = p6;
11673 }
11674 }
11675 /* parcours de K(S,2)*K(S,2) */
11676
11677 vect = p4;
11678 selmer = gen_0;
11679 rang = gen_0;
11680 listepoints = cgetg(1, t_VEC);
11681 {
11682 GEN fv_data = gen_0;
11683 GEN (*fv_next)(GEN, GEN); /* func_GG */
11684 GEN X = forvec_start(vect, 0, &fv_data, &fv_next); /* vec */
11685 {
11686 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
11687 long l7;
11688 GEN p8 = gen_0;
11689 for ( ; X; X = fv_next(fv_data, X))
11690 {
11691 l7 = glength(KS2gen);
11692 {
11693 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
11694 long i;
11695 p8 = gen_1;
11696 for (i = 1; i <= l7; ++i)
11697 {
11698 p8 = gmul(p8, gpow(gel(KS2gen, i), gel(X, i), prec));
11699 if (low_stack(st_lim, stack_lim(btop, 1)))
11700 p8 = gerepilecopy(btop, p8);
11701 }
11702 }
11703 b1 = p8;
11704 {
11705 GEN fv_data = gen_0;
11706 GEN (*fv_next)(GEN, GEN); /* func_GG */
11707 GEN Y = forvec_start(vect, 0, &fv_data, &fv_next); /* vec */
11708 {
11709 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
11710 long l9;
11711 GEN p10 = gen_0;
11712 GEN p11 = gen_0, p12 = gen_0; /* vec */
11713 long l13;
11714 GEN p14 = gen_0, p15 = gen_0, p16 = gen_0; /* vec */
11715 for ( ; Y; Y = fv_next(fv_data, Y))
11716 {
11717 l9 = glength(KS2gen);
11718 {
11719 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
11720 long i;
11721 p10 = gen_1;
11722 for (i = 1; i <= l9; ++i)
11723 {
11724 p10 = gmul(p10, gpow(gel(KS2gen, i), gel(Y, i), prec));
11725 if (low_stack(st_lim, stack_lim(btop, 1)))
11726 p10 = gerepilecopy(btop, p10);
11727 }
11728 }
11729 b2 = p10;
11730 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
11731 {
11732 p11 = cgetg(3, t_VEC);
11733 gel(p11, 1) = gcopy(b1);
11734 gel(p11, 2) = gcopy(b2);
11735 pari_printf("[b1,b2] = %Ps\n", lift(p11));
11736 }
11737 /* points triviaux provenant de la 2-torsion */
11738
11739 if (gequal1(b1) && gequal1(b2))
11740 {
11741 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
11742 pari_printf(" point trivial [0]\n");
11743 selmer = gaddgs(selmer, 1);
11744 rang = gaddgs(rang, 1);
11745 continue;
11746 }
11747 if (nfissquare(member_nf(bnf), gmul(gsub(e2, e1), b1), prec) && nfissquare(member_nf(bnf), gmul(gmul(gsub(e2, e3), gsub(e2, e1)), b2), prec))
11748 {
11749 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
11750 pari_printf(" point trivial [e2,0]\n");
11751 selmer = gaddgs(selmer, 1);
11752 rang = gaddgs(rang, 1);
11753 continue;
11754 }
11755 if (nfissquare(member_nf(bnf), gmul(gsub(e1, e2), b2), prec) && nfissquare(member_nf(bnf), gmul(gmul(gsub(e1, e3), gsub(e1, e2)), b1), prec))
11756 {
11757 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
11758 pari_printf(" point trivial [e1,0]\n");
11759 selmer = gaddgs(selmer, 1);
11760 rang = gaddgs(rang, 1);
11761 continue;
11762 }
11763 if (nfissquare(member_nf(bnf), gmul(gsub(e3, e1), b1), prec) && nfissquare(member_nf(bnf), gmul(gsub(e3, e2), b2), prec))
11764 {
11765 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
11766 pari_printf(" point trivial [e3,0]\n");
11767 selmer = gaddgs(selmer, 1);
11768 rang = gaddgs(rang, 1);
11769 continue;
11770 }
11771 /* premier critere local : sur les formes quadratiques */
11772
11773 if (((mynfhilbert(member_nf(bnf), gmul(b1, b2), gmul(b1, gsub(e2, e1)), prec) < 0) || (mynfhilbert(member_nf(bnf), b2, gmul(b1, gsub(e3, e1)), prec) < 0)) || (mynfhilbert(member_nf(bnf), b1, gmul(b2, gsub(e3, e2)), prec) < 0))
11774 {
11775 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
11776 pari_printf("non ELS\n");
11777 continue;
11778 }
11779 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
11780 {
11781 p12 = cgetg(3, t_VEC);
11782 gel(p12, 1) = gcopy(b1);
11783 gel(p12, 2) = gcopy(b2);
11784 pari_printf("[b1,b2] = %Ps\n", lift(p12));
11785 }
11786 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
11787 pari_printf("qf loc soluble\n");
11788 /* solution de la premiere forme quadratique */
11789
11790 if (!gequal(b1, b2))
11791 {
11792 vec = bnfqfsolve(bnf, gmul(b1, b2), gmul(b1, gsub(e2, e1)), flag3, NULL, prec);
11793 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
11794 pari_printf("sol part = %Ps\n", vec);
11795 if (gequal0(gel(vec, 3)))
11796 pari_err(user, "bnfell2descent_complete : BUG !!! : vec[3]=0 ");
11797 z1 = gdiv(gdiv(gel(vec, 1), gel(vec, 3)), b1);
11798 z2 = gdiv(gel(vec, 2), gel(vec, 3));
11799 }
11800 else
11801 {
11802 z1 = gdivgs(gaddsg(1, gdiv(gsub(e2, e1), b1)), 2);
11803 z2 = gsubgs(z1, 1);
11804 }
11805 d31 = gsub(e3, e1);
11806 quart0 = gadd(gsub(gadd(gsub(gmul(gmul(gsqr(b2), gsub(gmul(gsqr(z1), b1), d31)), gpowgs(x, 4)), gmul(gmul(gmul(gmul(gmulsg(4, z1), gsqr(b2)), z2), b1), gpowgs(x, 3))), gmul(gmul(gmul(gmulsg(2, b1), b2), gadd(gadd(gmul(gsqr(z1), b1), gmul(gmulsg(2, b2), gsqr(z2))), d31)), gsqr(x))), gmul(gmul(gmul(gmul(gmulsg(4, z1), b2), z2), gsqr(b1)), x)), gmul(gsqr(b1), gsub(gmul(gsqr(z1), b1), d31)));
11807 quart = gmul(gmul(quart0, b1), b2);
11808 if (gcmpgs(DEBUGLEVEL_ell, 4) >= 0)
11809 pari_printf("quart = %Ps\n", quart);
11810 quart = gmul(quart, gsqr(denom(simplify(content(quart)))));
11811 cont = simplify(content(lift(quart)));
11812 fa = factor(cont);
11813 l13 = glength(gel(fa, 1));
11814 {
11815 pari_sp btop = avma, st_lim = stack_lim(btop, 1);
11816 long i;
11817 for (i = 1; i <= l13; ++i)
11818 {
11819 quart = gdiv(quart, gpow(gcoeff(fa, i, 1), gmulsg(2, gdiventgs(gcoeff(fa, i, 2), 2)), prec));
11820 if (low_stack(st_lim, stack_lim(btop, 1)))
11821 quart = gerepilecopy(btop, quart);
11822 }
11823 }
11824 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
11825 pari_printf("quart red = %Ps\n", quart);
11826 /* la quartique est-elle localement soluble ? */
11827
11828 if (!nflocallysoluble(member_nf(bnf), quart, NULL, NULL, NULL, prec))
11829 {
11830 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
11831 pari_printf(" quartique non ELS \n");
11832 continue;
11833 }
11834 selmer = gaddgs(selmer, 1);
11835 /* recherche de points sur la quartique. */
11836
11837 point = nfratpoint(member_nf(bnf), quart, LIM3, gen_1, prec);
11838 if (!gequal(point, cgetg(1, t_VEC)))
11839 {
11840 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
11841 pari_printf("point trouve sur la quartique !!\n");
11842 if (gcmpgs(DEBUGLEVEL_ell, 3) >= 0)
11843 pari_printf("%Ps\n", point);
11844 if (!gequal0(gel(point, 3)))
11845 {
11846 point = gdiv(point, gel(point, 3));
11847 z1 = gdiv(gsub(gmul(gmul(gmulsg(2, b2), gel(point, 1)), z2), gmul(z1, gadd(b1, gmul(b2, gsqr(gel(point, 1)))))), gsub(b1, gmul(b2, gsqr(gel(point, 1)))));
11848 solx = gadd(gmul(b1, gsqr(z1)), e1);
11849 soly = gcopy(gel(nfsqrt(member_nf(bnf), gmul(gmul(gsub(solx, e1), gsub(solx, e2)), gsub(solx, e3)), prec), 1));
11850 p14 = cgetg(2, t_VEC);
11851 p15 = cgetg(3, t_VEC);
11852 gel(p15, 1) = gcopy(solx);
11853 gel(p15, 2) = gcopy(soly);
11854 gel(p14, 1) = p15;
11855 listepoints = concat(listepoints, p14);
11856 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
11857 {
11858 p16 = cgetg(3, t_VEC);
11859 gel(p16, 1) = gcopy(solx);
11860 gel(p16, 2) = gcopy(soly);
11861 pari_printf("point sur la courbe elliptique =%Ps\n", p16);
11862 }
11863 }
11864 rang = gaddgs(rang, 1);
11865 }
11866 else
11867 if (gcmpgs(DEBUGLEVEL_ell, 2) >= 0)
11868 pari_printf("aucun point trouve sur la quartique\n");
11869 if (low_stack(st_lim, stack_lim(btop, 1)))
11870 gerepileall(btop, 22, &p10, &b2, &p11, &selmer, &rang, &p12, &vec, &z1, &z2, &d31, &quart0, &quart, &cont, &fa, &point, &solx, &soly, &p15, &p14, &listepoints, &p16, &Y);
11871 }
11872 }
11873 }
11874 if (low_stack(st_lim, stack_lim(btop, 1)))
11875 gerepileall(btop, 18, &p8, &b1, &b2, &selmer, &rang, &vec, &z1, &z2, &d31, &quart0, &quart, &cont, &fa, &point, &solx, &soly, &listepoints, &X);
11876 }
11877 }
11878 }
11879 /* fin */
11880
11881 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
11882 pari_printf("#S^(2) = %Ps\n", selmer);
11883 if (gcmp(rang, gdivgs(selmer, 2)) > 0)
11884 rang = selmer;
11885 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
11886 {
11887 strange = stoi(!gequal(rang, selmer));
11888 if (!gequal0(strange))
11889 pari_printf("#E[K]/2E[K]>= %Ps\n", rang);
11890 else
11891 pari_printf("#E[K]/2E[K] = %Ps\n", rang);
11892 pari_printf("#E[2] = 4\n");
11893 }
11894 rang = gsubgs(gceil(gdiv(glog(rang, prec), glog(gen_2, prec))), 2);
11895 selmer = stoi(ggval(selmer, gen_2));
11896 if (gcmpgs(DEBUGLEVEL_ell, 1) >= 0)
11897 {
11898 if (!gequal0(strange))
11899 pari_printf("%Ps >= rang >= %Ps\n", gsubgs(selmer, 2), rang);
11900 else
11901 pari_printf("rang = %Ps\n", rang);
11902 if (!gequal0(rang))
11903 pari_printf("points = %Ps\n", listepoints);
11904 }
11905 p5 = cgetg(4, t_VEC);
11906 gel(p5, 1) = gcopy(rang);
11907 gel(p5, 2) = gcopy(selmer);
11908 gel(p5, 3) = gcopy(listepoints);
11909 p5 = gerepilecopy(ltop, p5);
11910 return p5;
11911 }
Attached Files
To refer to attachments on a page, use attachment:filename, as shown below in the list of files. Do NOT use the URL of the [get] link, since this is subject to change and can break easily.You are not allowed to attach a file to this page.