// This file is used to prove Theorem 6.25. R1:=PolynomialRing(Rationals()); m1:=X^3 + X^2 - 2*X - 1; K:=NumberField(m1); G:=Automorphisms(K); R:=PolynomialRing(K); OK:=Integers(K); I7:=Factorization(7*OK)[1][1]; I3:=Factorization(3*OK)[1][1]; I2:=Factorization(2*OK)[1][1]; t0:=Realtime(); function Realhours(); return Realtime(t0)/3600; end function; // Find the automorphism of K which maps Q1 to Q2. function find_g(Q1,Q2); for g in G do if Q2 eq g(Q1) then return g; end if; end for; end function; // This function is necessary to deal with some incompatibility of universes arising in the output of some Magma functions. // Return the set of prime divisors of x, with special treatment when x is zero or a unit. S:=Parent({1,2,3}); function primeset(x) x:=Integers()!x; if x eq 0 then return S!{0}; elif x in {-1,1} then return S!{x}; else return S!Set(PrimeDivisors(x)); end if; end function; // Return the set of prime divisors of x that belong to A, with special treatment when x is zero or a unit. function primesetwithsupport(x,A); x:=Integers()!x; if x eq 0 then return S!{0}; elif x in {-1,1} then return S!{x}; else B:={}; for q in A do if x mod q eq 0 then B:=B join {q}; end if; end for; return S!B; end if; end function; // Returns the base change to K of the hyperelliptic Frey curve C constructed by Kraus attached to solution (a,b,c) function FreyC(a,b); R:=PolynomialRing(K); return HyperellipticCurve(x^7 + 7*a*b*x^5 + 14*a^2*b^2*x^3 + 7*a^3*b^3*x + b^7 - a^7); end function; // The Jacobian J=J(C) is of GL2-type over K. We want to extract the traces of Frobenius of the 2-dim representations of G_K attached to J/K . // For a prime Q of K of good reduction the degree 6 Euler factor at Q factors into 3 degree 2 polynomials, where the middle coefficients // are minus the traces. function tracefrobenius(C,Q); Lf:=EulerFactor(C,Q); Lf:=Reverse(Lf); Lfactor:=Factorization(R!Lf); return [-Coefficient(f[1],1) : f in Lfactor]; end function; // Recall the field of real multiplications of J/K is equal to K which is of degree 3 over Q. // Thus a rational prime q is either inert or factors completely in K. // Let q be a rational prime such that J has good reduction. // The polynomial of Frobenius at q factors as g(x)^3 over K if q is inert and as the product of 3 conjugate polynomials when q splits in K // note that in the latter case sometimes the factorization is also of the form g(x)^3 (when the trace is in K). // The following returns a list of possible vectors of traces at primes in K above q (assuming good reduction). // Note that although we only work with one 2-dim block in the main argument, we do not know which trace corresponds to each block. // So we need to consider all the possible combinations. // However, we make use of two reductions: (1) the Q-form property (2) disjointness of Hecke eigenvalue field from K (when possible). function tracefrobeniusL(C,factQ); tLQ:=tracefrobenius(C,factQ[1,1]); if #tLQ eq 1 then if #factQ eq 1 then tL:=[[tLQ[1]]]; elif #factQ eq 3 then tL:=[[tLQ[1],tLQ[1],tLQ[1]]]; end if; elif #tLQ eq 3 then if #factQ eq 1 then tL:=[[tLQ[1]],[tLQ[2]],[tLQ[3]]]; elif #factQ eq 3 then // we make use of the Q-form property to restrict possibilities for traces sig:=find_g(factQ[1,1],factQ[2,1]); tL:=[[tLQ[1],sig(tLQ[1]),sig(sig(tLQ[1]))], [tLQ[2],sig(tLQ[2]),sig(sig(tLQ[2]))], [tLQ[3],sig(tLQ[3]),sig(sig(tLQ[3]))]]; end if; end if; return tL; end function; // The next function applies a finer elimination technique that uses also the specific value of p. // It will be used in the very end to clean up the few remaning exponents (for a given form f). procedure RefinedBound(q,f,curve,p) // if no assertions fail then the form has been eliminated factQ:=Factorisation(q*OK); Kf:=BaseField(f); LK:=Compositum(K,Kf); print "Degree of coefficient field is", Degree(Kf); print "Degree of compositum of K and coefficient field is", Degree(LK); OLK:=Integers(LK); factP:=[I[1] : I in Factorization(p*OLK)]; ResFields:=[ where QQ,toQQ := ResidueClassField(I) : I in factP]; afQ:=[OLK!HeckeEigenvalue(f,q[1]) : q in factQ]; list2:=[*[res[2]((Norm(factQ[i][1])+1)^2 - afQ[i]^2) : i in [1..#factQ]] : res in ResFields*]; zeroes:=[*[res[2](0) : i in [1..#factQ]] : res in ResFields*]; assert {list2[i] eq zeroes[i] : i in [1..#ResFields]} eq {false}; for x,y in [0..q-1] do if [x,y] ne [0,0] and (x+y) mod q ne 0 then C:=curve(x,y); tQL:=tracefrobeniusL(C,factQ); for t in tQL do list:=[*[res[2](afQ[i] - t[i]) : i in [1..#factQ]]: res in ResFields*]; zeroes:=[*[res[2](0) : j in [1..#factQ]] : res in ResFields*]; assert {list[i] eq zeroes[i] : i in [1..#ResFields]} eq {false}; end for; end if; end for; end procedure; // Using an auxiliary prime q this function computes a constant B such that the form f is eliminated when the exponent p does not divide B. function Bound2(q,f,LK,curve) B:={}; factQ:=Factorisation(q*OK); /* Kf:=BaseField(f); assert Degree(Kf) mod 3 eq 0; print "The coefficient field Kf contains K so the compositum is Kf"; LK:=Compositum(K,Kf); assert Degree(LK) eq Degree(Kf); */ hL:=[HeckeEigenvalue(f,factQ[i,1]) : i in [1..#factQ]]; for x,y in [0..q-1] do if [x,y] ne [0,0] then C:=curve(x,y); if (x+y) mod q ne 0 then tL:=tracefrobeniusL(C,factQ); L:=1; for u in tL do L:=L*Gcd([Integers()!Norm(LK!u[i] - LK!hL[i]) : i in [1..#factQ]]); end for; else L:=Gcd([Integers()!Norm(LK!(Norm(factQ[i,1])+1)^2 - LK!hL[i]^2) : i in [1..#factQ]]); end if; B:=B join primeset(L); end if; end for; return B join {q}; end function; // Test if there is a bound B that eliminates the form f when the exponent p does not divide B. // It stops after finding one auxiliary prime q that produces a bound. // It returns q and the set of exponents that are not covered. function BoundFormTest2(f,LK,curve,AuxPrimes); for j in [1..#AuxPrimes] do q:=AuxPrimes[j]; T:=Bound2(q,f,LK,curve); if 0 notin T then print "first bound obtained with auxiliary prime q=", q; return ; end if; end for; assert false; // the set of auxiliary primes was chosen such that the previous assertion should never be tested // that is, there is always a bound produced for each form // in particular, applying only this function to all the forms we already improve the previous result of Freitas where only the existence of a bound was proved return S!{0}; end function; function BoundForm2(f,LK,curve,AuxPrimes); // Test if there is a bound B that eliminates the form f when the exponent p does not divide B // It uses several auxiliary primes to sharpen the bound with each prime. // It stops after testing all the auxiliary primes or if the bound is already a subset of {2,3,7}. A:=BoundFormTest2(f,LK,curve,AuxPrimes); ini:=A[1]; LT:=A[2]; assert ini le #AuxPrimes; // this assertion should always be true due to the choice of auxiliary primes if (ini+1) le #AuxPrimes then for i in [(ini+1)..#AuxPrimes] do if LT subset {2,3,7} then break; end if; q:=AuxPrimes[i]; print "trying auxiliary prime q = ", q; T:=Bound2(q,f,LK,curve); if 0 notin T then LT:=LT meet T; print LT; end if; end for; end if; return LT; end function; // Compute newforms at level N1. // There are 61 conjugacy classes of newforms at level N1. N1:=I2^2*I3*I7^2; print "Computing space of Newforms..", Realhours(); NewformsN1:=Eigenforms(NewSubspace(HilbertCuspForms(K,N1))); print "..done", Realhours(); assert #NewformsN1 eq 61; // we test which forms have coefficient field containing K cf. Proposition 6.26 rts:=[#Roots(m1, BaseField(NewformsN1[i])) : i in [1..#NewformsN1]]; index:=[ i : i in [1..#NewformsN1] | rts[i] eq 3]; assert #index eq 25; assert index eq [ 12, 16, 17, 18, 19, 20, 21, 22, 23, 24, 26, 28, 33, 38, 41, 42, 45, 46, 47, 48, 51, 57, 58, 60, 61 ]; // To eliminate all the forms (except forms i=16,22,23 a small list of exponents for each form) we use the auxiliary primes {5, 11, 13, 17, 29}. AuxiliaryPrimes:=[5,11,13,17,29]; BadForms:={}; print "Starting elimination..", Realhours(); for j:=1 to (#index-2) do i:=index[j]; print "++++++++++++++++++++++", Realhours(); print "working with form number =>",i; f:=NewformsN1[i]; Kf:=BaseField(f); assert Degree(Kf) mod 3 eq 0; print "The coefficient field Kf contains K so the compositum is Kf"; LK:=Compositum(K,Kf); assert Degree(LK) eq Degree(Kf); Bf:=BoundForm2(f,LK,FreyC,AuxiliaryPrimes); print Bf; if not (Bf subset {2,3,7}) then print "**** not eliminated"; BadForms:=BadForms join {i}; end if; end for; assert BadForms eq {16, 22, 23}; print "Up to this point we have eliminated all but the forms indexed by i=60,61 and those indexed by i=16,22,23 for exponent p=13"; print "++++++++++++++++++++++", Realhours(); print "We now apply refined elimination for the latter three forms using auxiliary prime q=29"; print "Applying refined elimination with form i=16 and exponent p=13 using auxiliary prime q=29"; RefinedBound(29,NewformsN1[16],FreyC,13); print "Eliminated form i=16 completely."; print "++++++++++++++++++++++", Realhours(); print "Applying refined elimination with form i=22 and exponent p=13 using auxiliary prime q=29"; RefinedBound(29,NewformsN1[22],FreyC,13); print "Eliminated form i=22 completely."; print "++++++++++++++++++++++", Realhours(); print "Applying refined elimination with form i=23 and exponent p=13 using auxiliary prime q=29"; RefinedBound(29,NewformsN1[23],FreyC,13); print "Eliminated form i=23 completely."; print "++++++++++++++++++++++", Realhours(); print "Up to this point we have eliminated all but forms i=60,61. These have field of coefficients of degree 54 which causes the computations to take much longer for each of them, but the elimination procedure is exactly the same."; print "Starting elimination of forms i=60,61"; for j:=(#index-1) to #index do i:=index[j]; print "++++++++++++++++++++++", Realhours(); print "working with form number =>",i; f:=NewformsN1[i]; Kf:=BaseField(f); assert Degree(Kf) mod 3 eq 0; //print "The coefficient field Kf contains K so the compositum is Kf"; LK:=Compositum(K,Kf); assert Degree(LK) eq Degree(Kf); Bf:=BoundForm2(f,LK,FreyC,AuxiliaryPrimes); print Bf; if not (Bf subset {2,3,7}) then print "**** not eliminated"; BadForms:=BadForms join {i}; end if; end for; print "We have eliminated all the forms, hence completing the proof of Theorem 6.25"; print "++++++++++++++++++++++", Realhours();