The Grid Zeta Function

SetDirectory[NotebookDirectory[]]

<<"ComplexUtilities`"

<<"GridZeta`"

Numeric Approach

numericZ[u_]:=(1/(1-u^2))*(2/(1+3u^2))*Exp[
	((-2)/Pi)NIntegrate[Log[1+Sqrt[1-kfromu[u]^2 Sin[w]^2]],{w,0,Pi/2}]]

Plot[numericZ[u],{u,-1/3,1/3},PlotRange->{.9,1.1},Ticks->{{-1/3,0,1/3},Automatic}]

numericplot=Plot3DComplex[Im[numericZ[u]],u∈Rectangle[{-.5,-.5},{.5,.5}],
PlotPoints->50,ClippingStyle->None]

Series Representations

Here, we get the series directly.  Note that using tfromu takes too long, because of the conditionals involved in tfromu.  So, we avoid that by going through m and q, and taking a square root.

Series[gridZetat[Sqrt[qfromm[mfromu[u]]]][[1]],{u,0,10}]

Now, get the series using the combinatorical formula:

?trLogDeltaCoefficient

trLogDeltaCoefficient[M]

Sum[trLogDeltaCoefficient[M](u^(2M)),{M,1,7}]

Series[Exp[Sum[trLogDeltaCoefficient[M](u^(2M)),{M,1,10}]],{u,0,12}]

Here is the zeta function series done via combinatorics.  It matches!

Normal[Series[
Exp[-Sum[trLogDeltaCoefficient[n]*u^(2n),{n,1,100}]]/(1-u^2)
,{u,0,20}
]]

Parametric Approach

Plot[gridZetat[tfromu[u]][[1]],{u,-1/3,1/3},PlotRange->{.9,1.1},PlotLabel->"Zeta function of u on the real domain."]

imaginaryinside=ParametricPlot3D[
Evaluate[{
Re[First[ufromt[#]]],
Im[First[ufromt[#]]],
Im[First[gridZetat[#]]]
}&@tfromτ[fundτ[x,y]]
],{x,-2,2},{y,0.01,.9},PlotPoints->50,
PlotRange->{{-.6,.6},{-.6,.6},{-.3,.3}}]

insidepic=Show[imaginaryinside,
baduSet3D[{Thick,Red},0],
PlotRange->{{-.6,.6},{-.6,.6},{-.3,.3}},ViewPoint->{0,-2,3}]

(*
Export["ImInside.pdf",insidepic,"AllowRasterization"->True,ImageSize->360,ImageResolution->600]
*)

Show[numericplot,imaginaryinside,baduSet3D[{Thick,Red},0],
PlotRange->{{-.6,.6},{-.6,.6},{-.3,.3}},
PlotLabel->"Numeric and parametric zeta functions match!"]

Plot3DComplex[Im[gridZetat[t]],t∈Rectangle[{-.6,-.6},{.6,.6}],
	ClippingStyle->None,PlotStyle->{Opacity[.8]},Mesh->None,PlotPoints->70,PlotLabel->"Zeta function, in terms of t"]

inside=ParametricPlot3D[
Evaluate[{
Re[First[ufromt[#]]],
Im[First[ufromt[#]]],
Abs[First[gridZetat[#]]]
}&@tfromτ[fundτ[x,y]]
],{x,-2,2},{y,0.01,.9},PlotPoints->50,
PlotRange->{{-.6,.6},{-.6,.6},{.8,1.4}}]

outside1=ParametricPlot3D[
Evaluate[{
Re[Last[ufromt[#]]],
Im[Last[ufromt[#]]],
Abs[Last[gridZetat[#]]]
}&@tfromτ[MobiusTransformation[generatorV,fundτ[x,y]]]
],{x,-2,2},{y,0.01,.9},PlotPoints->50,
PlotRange->{{-1,1},{-1,1},{0,2}}]

outside2=ParametricPlot3D[
Evaluate[{
Re[Last[ufromt[#]]],
Im[Last[ufromt[#]]],
Abs[Last[gridZetat[#]]]
}&@tfromτ[MobiusTransformation[generatorU.generatorV,fundτ[x,y]]]
],{x,-2,2},{y,0.01,.9},PlotPoints->50,
PlotRange->{{-1,1},{-1,1},{0,2}}]

abs3sheets=Show[inside,outside1,outside2,baduSet3D[{Thick,Red}],
PlotRange->{{-1.5,1.5},{-1.5,1.5},{0,2}},ViewPoint->{0,-2,3}]

(*
Export["Abs3Sheets.pdf",abs3sheets,"AllowRasterization"->True,ImageSize->360,ImageResolution->600]
*)

As a function of u, the absolute value of the zeta function is continuous except for poles at +/-1, when you pick your cuts well (which is nontrivial - getting the right choices requires an if statement).

zetaAsU=Plot3DComplex[Abs[gridZeta[u]],u∈Rectangle[{-1,-1},{1,1}],PlotPoints->50]

(*
Export["AbsZeta.pdf",zetaAsU,"AllowRasterization"->True,ImageSize->360,ImageResolution->600]
*)

zetaAsUIm=Plot3D[Im[gridZeta[x+I y]],{x,-1.5,1.5},{y,-1,1},
Exclusions->{x^2+y^2 ==1/3,{y==0,x>1/3&&x<1},{y==0,x<-1/3&&x>-1}},PlotRange->{-1,1},PlotPoints->50,
ViewPoint->{0,-2,3},Ticks->{{-1,-1/Sqrt[3],-1/3,0,1/3,1/Sqrt[3],1},{-1,-1/Sqrt[3],-1/3,0,1/3,1/Sqrt[3],1},Automatic}]

(*
Export["ImZeta.pdf",zetaAsUIm,"AllowRasterization"->True,ImageSize->360,ImageResolution->600]
*)

Plot3D[Re[gridZeta[x+I y]],{x,-1.5,1.5},{y,-1,1},
Exclusions->{x^2+y^2 ==1/3,{y==0,x>1/3&&x<1},{y==0,x<-1/3&&x>-1}},PlotRange->{-2,2}]

The functions for u and parameterized by t match (as they should!)

Show[inside,zetaAsU]