One Parameter Calabi-Yau

CY Functions

CYApply[Lnew_,pvec_]:=Map[(∑_(k=0)^(Exponent[Lnew,θ]))(CYCoef[Lnew,θ,k]Nest[z D[##,z]&,#,k])&,pvec];
CYCoef[f_,x_,k_]:=If[k==0,Normal[f]/.x->0,Coefficient[f,(x^k)]];
CYIndicials[L_,p_]:=Module[{roots=Solve[(CYPointchange[L,p,1]/.z->0)==0,θ]},Table[θ/.roots[[i]],{i,1,Exponent[L,θ]}]];
CYPointchange[L_,p_,sc_]:=Module[{Lnew,tmp=0},
Expand[
(Lnew=If[p==∞,rv[p]=z->(1/((sc z)));L/.θ->-θ/.z->1/(sc z),rv[p]={z->sc z +p};(∑_(i=0)^(Exponent[L,θ]))(CYCoef[L,θ,i]/.z->z+p)(tmp=Expand[((z+p)/z)(z (∂_z)tmp+tmp θ)+(KroneckerDeltaSeq[i,0])])])(z^(Exponent[Lnew,1/z]))/.z->z sc ]];
CYSolve[L_,p_,sc_,ord_]:=Module[{ind=CYIndicials[L,p],Lnew=CYPointchange[L,p,sc],f,Δ,c=0},
ind=DeleteDuplicates[Map[{#,Count[ind,#]}&,ind]];
f=Table[((O[z])^(ord+1+ind[[i,1]]-Ceiling[ind[[i,1]]])),{i,1,Length[ind]},{j,1,ind[[i,2]]}];
For[i=1,i≤Length[ind],i++,f[[i,1]]+=(z^(ind[[i,1]]));
For[k=ind[[i,1]]+1,k≤ord,k++,
For[j=1,j≤ind[[i,2]],j++,Δ=Lnew/.{z->0,θ->k};
If[Δ==0&&j<ind[[i,2]],Δ=((∂_θ)Lnew)/.{z->0,θ->k};c=1];
If[Δ!=0,f[[i,j]]-=(∑_(m=0)^(Min[Exponent[Lnew,z],k]))(∑_(n=1)^j)(1/(Δ(n-1)!))(D[CYCoef[Lnew,z,m],{θ,n-1+c}]/.θ->k-m)CYCoef[f[[i,j+1-n]],z,k-m] z^k];c=0]];
$f[p]=f];$fl[p]=Flatten[Map[Table[(∑_(k=0)^(j-1))#[[j-k]](((Log[z])^k)/(k!)),{j,1,Length[#]}]&,f],1]];

CYPeriodMatrix[L_,p_,sc_,n_]:=Module[{f},f={Normal[CYSolve[L,p,sc,n]]/.z->If[p==∞,(1/((sc z))),sc z-p]};
For[i=1,i≤Exponent[L,θ]-1,i++,f=Append[f,D[f[[Length[f]]],z]]];
Transpose[f]];
Clear[ϖ]
$PM[p_,n_]:=$PM[p,n]=CYPeriodMatrix[L0,p,1,n];


(*======================================================================*)

pointincrease[a_]:=Block[{hi},
If[a==="m",nm++,If[a==="k",nk++,If[a==="c",nc++,If[a==="o",no++,If[a==="a",na++]]]]];
StringJoin[a,ToString[ToExpression[StringJoin["n",a]]]]]
gettype[l_]:=Module[{le,orbN},
le=Length[Union[l]];
orbN=LCM[Sequence @@ Map[Denominator[#]&,l]];
$t={If[le==1,ToString[m],If[le==2,ToString[k],If[le==3,ToString[c],If[le==4 ,If[ orbN==1,ToString[a],ToString[o]]]]]],orbN}]

analyzelop[L0_]:=Block[{nm,nc,nk,no,na,f},
Lf=Select[List @@ Factor[Sum[Coefficient[L0,θ,i]Nest[z D[#,z]&,f[z],i],{i,0,4}]],Head[#]===Plus&][[1]]/.f[z]->f/.Derivative[a__][f][z]:>Derivative[a][f];
  ldisf=Select[Apply[List,Factor[Coefficient[Lf,Derivative[4][f]]]],Head[Expand[#]]===Plus&];
  Do[test=ldisf[[i]];
If[Head[test]===Power,ssf[i]=test[[1]];mssf[i]=test[[2]],ssf[i]=test;mssf[i]=1];
ssf[i]=If[(ssf[i]/.z->0)>=0,ssf[i],-ssf[i]],{i,1,$ndf=Length[ldisf]}];
  Czzz=κ*Exp[-Integrate[1/2 Simplify[Coefficient[Lf,Derivative[3][f]]]/(s1=Coefficient[Lf,Derivative[4][f]]),z]];
 ldisc=Select[Apply[List,Factor[Denominator[Czzz]]],Head[Expand[#]]===Plus&];
Do[test=ldisc[[i]];
If[Head[test]===Power,ss[i]=test[[1]];mss[i]=test[[2]],ss[i]=test;mss[i]=1];
ss[i]=If[(ss[i]/.z->0)>=0,ss[i],-ss[i]],{i,1,$nd=Length[ldisc]}];
  $lelist=Map[CYIndicials[L0,#]& ,$criticalpoints=Sort[Join[{0,Infinity},Table[z/.Flatten[Solve[ssf[i]==0,z]],{i,1,$ndf}]],Abs[#1]<Abs[#2]&]];Print[MatrixForm[showllist=Join[{$criticalpoints},Transpose[$lelist]]]];
$Riemann=Sort[Table[{$criticalpoints[[i]],gettype[$lelist[[i]]],$lelist[[i]]},{i,1,Length[$criticalpoints]}],Abs[#1[[1]]]<Abs[#2[[1]]]&];
nm=0;nk=0;nc=0;no=0;na=0;
$Riemann=Map[{#[[1]],{pointincrease[#[[2,1]]],#[[2,2]]},#[[3]]}&,$Riemann];
Zwischenpunkte[$criticalpoints]]


Zwischenpunkte[li_]:=Block[{xval,args,argi,list,R,D,xvi,Ipi},
If[li[[lil=Length[li]]]==Infinity,
(Subscript[R, lil-1])=Abs[1/li[[lil-1]]];
(Subscript[R, lil-2])=Min[Abs[li[[lil-2]]-li[[lil-1]]],Abs[li[[lil-1]]]];
xvi=Select[x/.Solve[1==-(Abs[li[[lil-1]]]-x (Subscript[R, lil-2]))x (Subscript[R, lil-1]),x],#>0&][[1]];
Ipi=Simplify[li[[lil-1]]-xvi li[[lil-1]]];
argi={Simplify[li[[lil-1]]-Ipi], Simplify[li[[lil-1]]-Ipi]};
list=Drop[li,-1],
list=li];
Do[(Subscript[D, i-1])=Abs[list[[i+1]]-list[[i]]],{i,1,Length[list]-1}];
Do[(Subscript[R, i-1])=Min[Abs[list[[i-1]]-list[[i]]],Abs[list[[i+1]]-list[[i]]]],{i,2,Length[list]-1}];
(Subscript[R, 0])=Abs[list[[2]]];
(Subscript[R, Length[list]-1])=Abs[list[[Length[list]]]-list[[Length[list]-1]]];
xval=Table[(x/.Flatten[Solve[{ x (Subscript[R, i-1])==(Subscript[D, i-1])-x  (Subscript[R, i])}]]),{i,1,Length[list]-1}];
$Ip=Table[Simplify[list[[i]]+(list[[i+1]]-list[[i]])xval[[i]]],{i,1,Length[list]-1}];
args=Table[Simplify[{If[i==1,$Ip[[i]]-list[[i]],list[[i]]-$Ip[[i]]],list[[i+1]]-$Ip[[i]]}],{i,1,Length[list]-1}];
  If[li[[lil]]==Infinity,
Print[$xval=Join[xval,{xvi}];$Ip=Join[$Ip,{Ipi}];$args=Join[args,{argi}]]]]

Definition of the Hypergeometric one Parameter Calabi Yau

setmod[mod_]:=Block[{hi,top,lhs,rhs},
$k1=dgs=mod;
$name=mod;
$wts=Which[$k1=={5},{1,1,1,1,1},$k1=={6},{1,1,1,1,2},$k1=={8},{1,1,1,1,4},$k1=={10},{1,1,1,2,5},$k1=={3,3},{1,1,1,1,1,1},$k1=={4,2},{1,1,1,1,1,1},$k1=={3,2,2},{1,1,1,1,1,1,1},$k1=={2,2,2,2},{1,1,1,1,1,1,1,1},$k1=={4,3},{1,1,1,1,1,2},$k1=={6,2},{1,1,1,1,1,3},$k1=={4,4},{1,1,1,1,2,2},$k1=={6,4},{1,1,1,2,2,3},$k1=={6,6},{1,1,2,2,3,3},$k1=={12,2},{1,1,1,1,4,6}];
$as=Which[$k1=={5},{1/5,2/5,3/5,4/5},$k1=={6},{1/6,2/6,4/6,5/6},$k1=={8},{1/8,3/8,5/8,7/8},$k1=={10},{1/10,3/10,7/10,9/10},$k1=={3,3},{1/3,1/3,2/3,2/3},$k1=={4,2},{1/4,1/2,1/2,3/4},$k1=={3,2,2},{1/3,1/2,1/2,2/3},$k1=={2,2,2,2},{1/2,1/2,1/2,1/2},$k1=={4,3},{1/4,1/3,2/3,3/4},$k1=={6,2},{1/6,1/2,1/2,5/6},$k1=={4,4},{1/4,1/4,3/4,3/4},$k1=={6,4},{1/6,1/4,3/4,5/6},$k1=={6,6},{1/6,1/6,5/6,5/6},$k1=={12,2},{1/12,5/12,7/12,11/12}];
top=List @@Normal[Series[Times@@ Map[1+ # H&,$wts]/Times@@ Map[1+ # H&,dgs] (Times @@  Map[H*#&,dgs])/(Times @@  Map[#&,$wts]),{H,0,Length[$wts]-1}]]/.H->1;
χ=$eul=$chi[$name]=top[[3]];
κ=$cll[$name]=top[[1]];
c2=$c2[$name]=top[[2]];
σ=Mod[κ,2]/2;

$M0={{1,-1,top[[1]]/6+top[[2]]/12,top[[1]]/2+Mod[top[[1]],2]/2},{0,1,Mod[top[[1]],2]/2-top[[1]]/2, -top[[1]]},{0,0,1,0},{0,0,1,1}};
$Mc={{1,0,0,0},{0,1,0,0},{-1,0,1,0},{0,0,0,1}};
$MI=Inverse[$M0.$Mc];
$TM["m1"]=(((2π I))^3)(({{((χ Zeta[3])/(((2π I))^3)), (c2/(24 2π I)), 0, (κ/(((2π I))^3))}, {(c2/24), (σ/(2π I)), ((-κ)/(((2 π I))^2)), 0}, {1, 0, 0, 0}, {0, (1/(2π I)), 0, 0}}));
Sig={{0,0,1,0},{0,0,0,1},{-1,0,0,0},{0,-1,0,0}};
$m=1;
Q[j_] := Sum[$l[[mu,j]]*o[mu], {mu, 1, $m}];
$l={Join[-dgs,$wts]};
$ll=Length[$l[[1]]];
$nhs=Length[dgs];
mu=1;
lhs=(∏_(j=$nhs+1)^$ll)If[$l[[mu,j]]>0,(∏_(i=0)^($l[[mu,j]]-1))(Dl[j]-i),1];rhs=((∏_(j=1)^$nhs)((∏_(i=1)^(Abs[$l[[mu,j]]]))(Dl[j]-($l[[mu,j]]+i)))) (∏_(j=$nhs+1)^$ll)If[$l[[mu,j]]<0,(∏_(i=0)^(Abs[$l[[mu,j]]]-1))(Dl[j]-($l[[mu,j]]+i)),1];hi=Cancel[(lhs/rhs)];lhs=Factor[lhs/. {Dl->Q}];rhs=Factor[rhs/. {Dl->Q}];hi=Cancel[(lhs/rhs)];
nhi=Numerator[hi];
glr[mu,1]=If[Head[nhi]===Times,-nhi,nhi];glr[mu,2]=Denominator[hi];$lp[$name]=glr[mu,1]-(Times @@ Map[-1^# &,dgs])(Factor[(glr[mu,2] z[mu]/.o[1]->-o[1])]);
$lp[$name]=glr[mu,1]-(Factor[(glr[mu,2] z[mu]/.o[1]->-o[1])]);
Print["χ=",χ,"  c2=",c2,"  κ=",κ, " σ=",σ];
Print["L0=",L0=Expand[$lp[$name]/.z[1]->z/.o[1]->θ]];
analyzelop[L0];
μ=z/.Flatten[Solve[Coefficient[L0,θ,4]==0,z]];
Czzz=$cll[$name]*Exp[-Integrate[1/2 Simplify[Coefficient[Lf,Derivative[3][f]]]/(s1=Coefficient[Lf,Derivative[4][f]]),z]]]

Constants of Fg g>1 at Mum  and  Conifold

cmF[g_]:=(-1)^(g-1)*BernoulliB[2*g]*BernoulliB[2*(g-1)]/(4*g*(2*g-2)*Factorial[(2*g-2)])*χ;
ccF[g_]:=(-1)^(g+1)*BernoulliB[2*g]/(2*g*(2*g-2));

From the AESZ webpage: copy in maple format and change [.,.,.] to {.,.,.}

lAESZ55={9*X^4,-2496*X^4-2688*X^3-1956*X^2-612*X-72,16384*X^4-475136*X^3-822272*X^2-428544*X-72192,9437184*X^4+37748736*X^3+30605312*X^2+9437184*X+983040,-16777216*(2*X+1)^4};
getlopAESZ[l_]:=Block[{hi},L0=Table[z^(i-1),{i,1,Length[l]}].l/.X->θ; analyzelop[L0]]
getlopAESZ[lAESZ55]

Routines to provide the formal expression for the Ff[g] and the series  Fs[p,g] as well as the ngd[g,d]

Genus 0 and genus 1 at at any point

atpoint[p_,sc_,ord_]:=Block[{ind=CYIndicials[L0,p]},
$type[p]=Length[Union[ind]];
$scale=LCM @@ Map[Denominator[#]&,ind];
Print["Frobenius at ",p,"  ",Timing[CYSolve[L0,p,sc,ord];]];
If[$type[p]==3,$scalegap=If[ind[[2]]-ind[[1]]==0,1,Denominator[ind[[2]]-ind[[1]]]]];
(* mirror map *)
(* at MUM *)
 If[$type[p]==1,
Print["q[z] ",Timing[$qs[p]=Series[z Exp[$f[p][[1,2]]/$f[p][[1,1]]],{z,0,ord}];]],
If[$type[p]>=2,
Print["$qs[p][z] ",Timing[$qs[p]=Series[ $f[p][[2,1]]/$f[p][[1,1]],{z,0,ord}];]]]];
If[$Faster==0 ||  $type[p]=!= 3||p==∞, Print["$rzq[p]",Timing[$rzq[p]={z->InverseSeries[$qs[p],q]};]];
Print["q-series of solutions ",
Timing[
zq[p,1]=z/.$rzq[p];
Do[zq[p,k]=Series[zq[p,k-1]*zq[p,1],{q,0,$scale ord}],{k,2,$scale ord}];
If[$Faster==0||  $type[p]=!= 3,  Do[$fq[p,i]=Expand[Normal[(Flatten[$f[p]][[i]]/.z^(a__):>zq[p,a])/.z->zq[p,1]]],{i,1,4}];]
]]]]

atpoint[p_,sc_,esc_,ord_]:=Block[{ind=CYIndicials[L0,p]},
If[esc==1,atpoint[p,sc,ord],
$se[p]=esc;
$type[p]=Length[Union[ind]];
$scale=LCM @@ Map[Denominator[#]&,ind];
If[$type[p]==3,$scalegap=If[ind[[2]]-ind[[1]]==0,1,Denominator[ind[[2]]-ind[[1]]]]];
Print["Frobenius at ",p,"  ",Timing[CYSolve[L0,p,sc,ord];]];
$$f[p]={ Map[PowerExpand[Normal[#]/.z->z^$se[p]]&,$f[p][[1]]]};
$$fl[p]=Map[PowerExpand[Normal[#]/.z->z^$se[p]]&,$fl[p][[1]]];
rv[p]={z->PowerExpand[(z/.rv[p])^(esc)]};
 If[$type[p]==1,
(* at MUM *)
Print["$q[z] ",Timing[$qs[p]=Series[z Exp[$$f[[1,2]]/$$f[[1,1]]],{z,0,ord}];]],
If[$type[p]>=2,
Print["$q[z] ",Timing[$qs[p]=Series[$$f[[2,1]]/$$f[[1,1]]/.(Subscript[z, p ])->z,{z,0,ord}];]]]];
If[$Faster==0 || $type[p]=!=3  || p==∞, Print["$rzq[p]",Timing[$rzq[p]={z->InverseSeries[$qs[p],q]}]];
Print["q-series of solutions ",
Timing[zq[p,1]=z/.$rzq[p];
Do[zq[p,k]=Series[zq[p,k-1]*zq[p,1],{q,0,$scale ord}],{k,2,$scale ord}];
If[$Faster==0 ||  $type[p]=!= 3,Do[$fq[p,i]=Expand[Normal[(Flatten[$$f][[i]]/.z^(a__):>zp[p,a])/.z->zp[p,1]]],{i,1,4}];]]]]]]

dzq[p_,exp_,nd_]:=If[$type[p]==1,Nest[q D[#,q]&,exp,nd], Nest[ D[#,q]&,exp,nd]]
izq[p_,exp_,nd_]:=If[$type[p]==1,Nest[Integrate[#/q,q]&,exp,nd], Nest[ Integrate[#,q]&,exp,nd]]
repq[p_,exp_]:=Block[{hi},If[$scale==1,Normal[exp]/.z^(a___):>If[a>0,zq[p,a],1/zq[p,-a]]/.z->zq[p,1],exp/.$rzq[p]]]
repq[exp_]:=Block[{hi},Normal[exp]/.z^(a___):>If[a>0,zp[a],1/zp[-a]]/.z->zp[1]]


genus0p[p_,ord_]:=Block[{hi},
atpoint[p,1,ord];
Cttt[p]=Series[$fq[p,1]^(-2)dzq[p,zq[p,1],1]^3 Normal[repq[p,Normal[Series[(Czzz/.rv[p]) D[z/.rv[p],z]^3,{z,0,ord}]]]],{q,0,$scale ord}];
Fs[p,0]= Series[izq[p,Normal[Cttt[p]],3],{q,0,$scale ord}];
(*Fs[0,0]=-5/2 ( fq[0,1]^2 fq[0,4] -  fq[0,1]fq[0,2] fq[0,3]+1/3 fq[0,2]^3)/fq[0,1]^3*)
Series[Expand[Normal[Fs[p,0]-Sum[(Coefficient[Fs[p,0],q,i]/.Log[q]->0) q^i,{i,0,2}]]],{q,0,$scale ord}];
If[$type[p]==3,Fs[p,0]=Normal[Fs[p,0]]/.q->-(Subscript[q,  ]);
Fs[p,0]=(Fs[p,0]/.Log[a__*b__]:>Log[a]+Log[b]);
Fs[p,0]=Series[Expand[Fs[p,0]-Sum[(Coefficient[Fs[p,0],q,i]/.Log[q]->0) q^i,{i,0,2}]],{q,0,$scale ord}]];
 If[$type[p]==1,BPSgenus0[Fs[p,0],ord-3]];Fs[p,0]]



BPSgenus0[F0_,ord_]:=Block[{hi},
Clear[ngd];
test=Normal[F0/.Log[q]->0];
 While[Head[test]==Plus,
cf=(test[[1]]/.q->1);
ex=Exponent[test[[1]],q];
ngd[0,ex]=cf;
test=Normal[Series[Expand[test-cf  Normal[Sum[q^(ex k)/k^3,{k,1,Ceiling[ord/ex]}]]],{q,0,ord}]]]]

$raF1={x[1]->-1/12};
genus1p[p_,ord_,raF1_]:=Block[{hi},
atpoint[p,1,ord+3];
Do[$ssq[p][i]=repq[p,ss[i]/.rv[p]],{i,1,$nd}];
$df[p]=Sum[(x[i]/.raF1)Log[$ssq[p][i]],{i,1,$nd}];
$ld[p]=Log[dzq[p,z/.$rzq[p],1]repq[p,D[z/.rv[p],z]]];
$xf[p]=(c[1])Log[repq[p,(z/.rv[p])]];
$Kz[p]=-Series[Log[$f[p][[1,1]]],{z,0,$scale ord}];
$Kq[p]=-Series[Log[$fq[p,1]],{q,0,$scale ord}] ;
Fs[p,1]=Simplify[PowerExpand[Normal[-((4-χ/12)/2*$Kq[p]+$ld[p]/2+$df[p]+$xf[p])]]];
If[$type[p]==1,
gl=Table[Coefficient[Fs[p,1]/.Log[q]->t,t,1]==$c2[$name]/24,{i,1,$m}];
$F1loes=Flatten[Solve[gl,Table[c[i],{i,1,$m}]]];
Fs[p,1]=Fs[p,1]/.$F1loes];
If[$type[p]==3,Fs[p,1]=PowerExpand[Fs[p,1]/.q->-q]];
Fs[p,1]=Series[Simplify[Fs[p,1]-(Fs[p,1]/.Log[q*a___]->0/.Log[q]->0/.q->0)],{q,0,$scale ord}];
If[$type[p]==1,  BPSgenus1[Fs[p,1],ord-4] ];Fs[p,1]]


BPSgenus1[F1_,ord_]:=Block[{hi},
test=Normal[F1/.Log[q]->0];
While[Head[test]==Plus,
cf=(test[[1]]/.q->1);
ex=Exponent[test[[1]],q];
ngd[1,ex]=-(cf+1/12 ngd[0,ex]);
test=Normal[Series[Expand[test-cf  Normal[Sum[q^(ex k)/k,{k,1,Ceiling[ord/ex]}]]],{q,0,ord}]];
ngdl=Table[ndg1[i]->ngd[1,i],{i,1,ord}];
(* Here we define the genus invariants with the eta multicovering *)
mgdl={};
Do[mgdl=Join[mgdl,{mgd1[i]-> ngd[1,i]-Plus @@ Map[mgd[1,#] &, Drop[Divisors[i],-1]]/.mgdl}],{i,1,ord-2}];Do[mgd[1,i]=mgd1[i]/.mgdl,{i,1,ord-1}]]]

The propagators and their ambiguity

Clear[makeprops]
(* here we define the propagators at the mum points with the ambiguities; the latter are in the rule rall *)
$scalep={audd->saudd/z,auud->sauud z,aud->saud,add->sadd/z^2,ad->sad/z};
lsamb={saudd,sauud ,saud,sadd,sad};

(* Fixing the propagator ambiguities *)
fixpropamb[ord_,ru_]:=Block[{hi,p},
rall=ru;
atpoint[p=0,1,ord];
(* metric and Christoffel *)
dtdzz=D[Log[$qs[p]],z];
dzdtz=Series[1/dtdzz,{z,0,ord}];
Gaz=  Series[ dzdtz D[dtdzz,z],{z,0,ord}];
(* Kaehler potential and derivatives *)
Kz=-Series[Log[$f[p][[1,1]]],{z,0, ord}];
dKz=Series[D[Kz,z],{z,0,ord}];
(* Covariant derivatives *)
Szz=Series[Expand[Normal[(2 dKz-Gaz+audd)/Czzz/.ru/.$scalep/.ru]],{z,0,ord}];
Sz=Series[Expand[Normal[1/2(D[Szz,z]- 2 Szz dKz+2 Gaz  Szz+Czzz Szz Szz-auud)/.$scalep/.ru]],{z,0,ord}];
tSz=Series[Expand[Normal[1/2(D[Szz,z]-Czzz Szz Szz+2 audd  Szz-auud )/.ru/.$scalep/.ru]],{z,0,ord}];
SS=Series[Expand[Normal[1/2(D[Sz,z]- 2 Sz dKz+Gaz  Sz+Czzz Sz Szz-auud  dKz-aud )/.ru/.$scalep/.ru]],{z,0,ord}];
tS=Series[1/2(D[tSz,z]-Czzz tSz Szz +audd tSz +add Szz-aud)/.ru/.$scalep/.ru,{z,0,ord}];
check=Series[Expand[Normal[Sz Czzz-( dKz^2-D[dKz,z]+saudd dKz/z+sadd/z^2)/.ru/.$scalep/.ru]],{z,0,ord-4}];
 Cs=Series[Czzz,{z,0,ord}];
polun={};
usamb=Select[lsamb,!FreeQ[check,#]&];
mpa[usamb,lp=0,hp=4];
test=Expand[Normal[check/.polans]];
lrs=l3=Simplify[Flatten[Solve[Table[Coefficient[test,z,i]==0,{i,-Exponent[test,1/z],ord-4}],polun]]];
Do[ 
Do[
If[(un[l][k]/.l3)=!=0 && (un[l][k]/.l3)=!=un[l][k],
ll=Simplify[Flatten[Solve[(un[l][k]/.l3)==0,polun]]];
If[ll=!={},l3=Join[Simplify[l3/.ll],ll]]],{l,1,Length[pos]}],{k,hp,0,-1}];
lred=Select[l3,#[[2]]=!=0&];
rall=Join[rall,polans]/.l3;
set[rall];
check=D[tS,z]-Series[Expand[Normal[1/2 Czzz tSz tSz -add tSz +ad/.$scalep/.rall]],{z,0,ord}];
usamb=Select[lsamb,!FreeQ[check,#]&];
mpa[usamb,lp=0,hp=4];
test=Expand[Normal[check/.polans]];
lrs=l3=Simplify[Flatten[Solve[Table[Coefficient[test,z,i]==0,{i,-Exponent[test,1/z],ord-6}],polun]]];
rall=Join[Join[rall,polans]/.l3,Flatten[Solve[Coefficient[SS,z,0]==0]]];
set[rall];
Print["check propagator ambiguities  ",  Map[Normal[Series[#,{z,0,ord-6}]]&,
{D[Szz,z]-Series[Expand[Normal[Czzz Szz Szz + 2 tSz-2 audd Szz+auud/.$scalep/.rall]],{z,0,ord}],
D[tSz,z]-Series[Expand[Normal[Czzz Szz tSz + 2 tS- audd  tSz-add Szz+ aud/.$scalep/.rall]],{z,0,ord}],
D[tS,z]-Series[Expand[Normal[1/2 Czzz tSz tSz -add tSz +ad/.$scalep/.rall]],{z,0,ord}],
D[dKz,z]-Series[Expand[Normal[dKz^2 -Czzz Szz *dKz+audd  dKz- Czzz tSz+add/.$scalep/.rall]],{z,0,ord}]}]];
Print["fixed propagator ambiguity: "];Return[rall]]
(* mpa[usamb_,lp_,hp_] makes an polynomial ansatz for the ambiguity usamb *) 
mpa[usamb_,lp_,hp_]:=Block[{hi} , 
pos=Map[Flatten[Position[lsamb,#]][[1]]&,usamb];
polans=Table[usamb[[i]]->Sum[un[pos[[i]]][j] z^j,{j,lp,hp}],{i,1,Length[usamb]}];
polun=Join[polun,Flatten[Table[un[pos[[i]]][j],{j,lp,hp},{i,1,Length[usamb]}]]];]
set[rall_]:=Block[{hi},
Szz=Szz/.rall;  
Sz=Sz/.rall;
tSz=tSz/.rall;
SS=SS/.rall;
tS=tS/.rall;]


makepropsp[p_,ordi_,ru_,sc_,esc_]:=Block[{hi},
(* metric and Christoffel: Note here we use the tensor coordinate 
frame of the new Koordinates at the new point for deriving the propagators.  
This requires  the tensor transformation of the ambiguities and the Christoffel
like shift transformation of audd. Once the propagators are derived they
are transformed back to the original tensor frame at the Mum  *)
ord=ordi+4;
atpoint[p,sc,esc,ord];
(* metric and Christoffel *)
$Dzp[p]=D[z/.rv[p],z];
If[$type[p]==1,$dtdzz[p]=D[Log[$qs[p]],z] , $dtdzz[p]= D[$qs[p],z]];
$dzdtz[p]=Series[1/$dtdzz[p],{z,0,ord}];
$Gaz[p]=  Series[ $dzdtz[p] D[$dtdzz[p],z],{z,0,ord}];
$gauge2[p]=Series[$f[p][[1,1]]^2,{z,0,ord}];
$gauge2q[p]=repq[p,$gauge2[p]];
(* Kaehler potential and derivatives *)
$Kz[p]=-Series[Log[$f[p][[1,1]]],{z,0,$scale (ord)}];
$dKz[p]=Series[D[$Kz[p],z],{z,0,ord}];
(* Covariant derivatives *)
rali=($scalep/.ru);
$rall[p]={audd->Simplify[(audd/.rali/.rv[p])$Dzp[p] + D[D[z/.rv[p],z],z]/$Dzp[p]], auud-> Simplify[(auud/.rali/.rv[p])/$Dzp[p] ], aud->Simplify[(aud/.rali/.rv[p])],
add->Simplify[(add/.rali/.rv[p]) $Dzp[p]^2],ad->Simplify[(ad/.rali/.rv[p])$Dzp[p] ]};
$Czzz[p]=Simplify[(Czzz/.rv[p]) $Dzp[p]^3];
$Cs[p]=Series[(Czzz/.rv[p]),{z,0,ord}];
$Szz[p]=Series[Expand[Normal[(2 $dKz[p]-$Gaz[p]+audd)/$Czzz[p]/.$rall[p]]],{z,0,ord}];
(*$Sz[p]=Series[Expand[Normal[1/2(DSzz[p,ord]+$Czzz[p] $Szz[p] $Szz[p]-auud)/.$rall[p]]],{z,0,ord}];*)
$tSz[p]=Series[Expand[Normal[1/2(D[$Szz[p],z]-$Czzz[p] $Szz[p] $Szz[p]+2 audd  $Szz[p]-auud )/.$rall[p]]],{z,0,ord}];
(*$S[p]=Series[Expand[Normal[1/2(DSz[p,ord]+$Czzz[p] $Sz[p] $Szz[p]-auud  $dKz[p]-aud )/.$rall[p]]],{z,0,ord}];*)
$tS[p]=Series[1/2(D[$tSz[p],z]-$Czzz[p] $tSz[p] $Szz[p] +audd $tSz[p] +add $Szz[p]-aud)/.$rall[p],{z,0,ord}];
(*Print["check $Sz[p] $Czzz[p] : ", check1=Series[Expand[Normal[$Sz[p] $Czzz[p]-( $dKz[p]^2-D[$dKz[p],z]+audd $dKz[p]+add/.$rall[p])]],{z,0,ord-4}]];*)
Print["check propagator ambiguities on the formal and the explicte (covariant) Derivatives ",  Map[Normal[Series[#,{z,0,ord-6}]]&,
{D[$Szz[p],z]-dSzzf[p,ord],
D[$tSz[p],z]-dtSzf[p,ord],
D[$dKz[p],z]-dKf[p,ord](*,
DSzz[p,ord]-DSzzf[p,ord],
DSz[p,ord]-DSzf[p,ord],
DS[p,ord]-DSf[p,ord]*)}]];
$repS[p]={S2->Series[$Dzp[p]^2 $Szz[p],{z,0,ordi}],tS1->Series[$Dzp[p] $tSz[p],{z,0,ordi}],tS0->Series[$tS[p],{z,0,ordi}],Cf->Series[$Cs[p],{z,0,ordi}]};]

(* Formal expression of derivatives of the Propagators and the Kaehler Poetential *) 
dSzzf[p_,ord_]:= Series[Expand[Normal[$Czzz[p] $Szz[p] $Szz[p] + 2 $tSz[p]-2 audd $Szz[p]+auud/.$rall[p]]],{z,0,ord}]
(* spn[D[Szz,z]- dSzzdzf[6]] is always fullfilled*)
dtSzf[p_,ord_]:= Series[Expand[Normal[$Czzz[p] $Szz[p] $tSz[p] + 2 $tS[p]- audd  $tSz[p]-add $Szz[p]+ aud/.$rall[p]]],{z,0,ord}]
dtSf[p_,ord_]:=Series[Expand[Normal[1/2 $Czzz[p] $tSz[p] $tSz[p] -add $tSz[p] +ad/.$rall[p]]],{z,0,ord}]
dKf[p_,ord_]:=Series[Expand[Normal[$dKz[p]^2 -$Czzz[p] $Szz[p] *$dKz[p]+audd  $dKz[p]- $Czzz[p] $tSz[p]+add/.$rall[p]]],{z,0,ord}]
(* Covariant derivatives of the Propagators and the Kaehler Potential at any point  *) 
DSzz[p_,ord_]:=Series[Expand[Normal[D[$Szz[p],z]- 2 $Szz[p] $dKz[p]+2 $Gaz[p]  $Szz[p]/.$rall[p]]],{z,0,ord}]
DSz[p_,ord_]:=Series[Expand[Normal[D[$Sz[p],z]- 2 $Sz[p] $dKz[p]+$Gaz[p] $Sz[p]/.$rall[p]]],{z,0,ord}]
DS[p_,ord_]:=Series[Expand[Normal[D[$S[p],z]- 2 $S[p] $dKz[p]/.$rall[p]]],{z,0,ord}]
(* Formal Covariant derivatives of the Propagators and the Kaehler Poetential *) 
DSzzf[p_,ord_]:=Series[Expand[Normal[-$Czzz[p] $Szz[p] $Szz[p] + 2 $Sz[p]+auud/.$rall[p]]],{z,0,ord}]
DSzf[p_,ord_]:=Series[Expand[Normal[ -$Czzz[p] $Szz[p] $Sz[p] + 2 $S[p]+$dKz[p] auud+aud/.$rall[p]]],{z,0,ord}]
DSf[p_,ord_]:=Series[Expand[Normal[-1/2 $Czzz[p] $Sz[p] $Sz[p] + 1/2auud $dKz[p] $dKz[p] + $dKz[p] aud +ad/.$rall[p]]],{z,0,ord}]

The direct integration Step

(* ===============================================    The direct integration ======================================================================*)
cfs[expr_]:=Block[{lst,mlst},lst=CoefficientList[expr,Cf[z]];
mlst=Table[(z^3 ss[1]/κ)^(Length[lst]-i-1),{i,Length[lst]-1}];
Expand[lst[[1]]]+Expand[lst[[2;;]].mlst] (Cf[z]^(Length[lst]-1))]
rizf=z^a__:>If[a<0,(z^2 ss[1]Cf[z]/κ)^(-a),z^a];
rids=ds^a__:>If[a<0,(z^3 Cf[z]/κ)^(-a),ss[1]^a];
rCf={Cf[z]->Czzz};
Cfform[expr_]:=Block[{hi},var ={S2[z],tS1[z],tS0[z],Cf[z]};
work=Collect[Expand[expr]/.{ss[1]->ds}/.{-ss[1]->-ds}/.rids/.rizf,var,cfs[#]&]];
setdrecc[rall_]:=Block[{hi},drec1=Expand[{
D[Cf[z],z]->D[Czzz,z],
D[S2[z],z]->Cf[z] S2[z]^2 + 2 tS1[z]-2 audd S2[z]+auud,
D[tS1[z],z]->Cf[z] S2[z] tS1[z] + 2 tS0[z]- audd  tS1[z]-add S2[z]+ aud,
D[tS0[z],z]->1/2 Cf[z] tS1[z] tS1[z] -add tS1[z] +ad,
D[dKzf[z],z]->dKzf[z]^2 -Cf[z] S2[z] *dKzf[z]+audd  dKzf[z]- Cf[z] tS1[z]+add}/.$scalep/.rall];
drec=Map[#[[1]]->Cfform[#[[2]]]&,drec1]];


dsF[g_]:=dsF[g]=If[g==1,dsF[1],Collect[Expand[D[Ff[g],z]/.drec],{S2[z],tS1[z],tS0[z]},cfs[#]& ]]

cc[g_]:=If[g==1,χ/24-1,(2 g -2) Ff[g]] 
dsF[g_,rs_]:=If[g==1,dsF[1]/.rs,Collect[Expand[D[Ff[g],z]/.rs/.(drec/.rs)],{S2[z],tS1[z],tS0[z]},cfs[#]& ]]
cc[g_,rs_]:=If[g==1,χ/24-1,(2 g -2) Ff[g]/.rs] 

dfds2[g_]:=Block[{hi},Expand[(D[dsF[g-1],z]/.drec)/2+(Cf[z] S2[z]-csaudd)dsF[g-1]/2+(Cf[z] tS1[z]-csadd)cc[g-1]/2
+Sum[dsF[h] dsF[g-h],{h,1,Floor[(g-1)/2]}]+If[Mod[g,2]==0,dsF[g/2]^2/2,0]]]

dfds1f[g_]:=Block[{hi},Expand[(2g-3) (dsF[g-1]/.{S2[z]->0})+ Sum[cc[h,{S2[z]->0}] (dsF[g-h]/.{S2[z]->0}),{h,1,g-1}]]]
dfds0f[g_]:=Block[{hi},Expand[(2g-3) cc[g-1, {S2[z]->0,tS1[z]->0}]+ Sum[cc[h,{S2[z]->0,tS1[z]->0}] cc[g-h,{S2[z]->0,tS1[z]->0}],{h,1,g-1}]]]


dirint[g_]:=Block[{hi,li},
var ={S2[z],tS1[z],tS0[z]};
Print["dirint genus ", g,"  : = ",$timedirint[g]=Timing[res=Integrate[Collect[dfds2[g],var,cfs[#]&],S2[z]]+Integrate[Collect[dfds1f[g],var,cfs[#]&],tS1[z]]+Integrate[Collect[dfds0f[g],var,cfs[#]&],tS0[z]];][[1]]];
  Print[" collect  ",$timecollectdirint[g]=Timing[ res=Collect[res,var,cfs[#]&];][[1]]];res]
(*=============================================================================================================================================================================================*)
serFfp[gobj_,p_,gen_,ord_]:=Block[{sS2,stS1,stS0,sCf},
Ffl=gobj/.a__[z]:>a;
If[gen===x,genus=(Exponent[Ffl,S2]+3)/3,genus=gen];
eS2=3 genus -3;
etS1=Floor[(genus-1) 3/2];
etS0=(genus-1);
eCf=(2 genus-2);
makepropsp[p,ord,rall,1,1];
sS2[p,1]=S2/.$repS[p];
Do[sS2[p,k]=sS2[p,k-1]*sS2[p,1],{k,2,eS2}];
stS1[p,1]=tS1/.$repS[p];
Do[stS1[p,k]=stS1[p,k-1]*stS1[p,1],{k,2,etS1}];
stS0[p,1]=tS0/.$repS[p];
Do[stS0[p,k]=stS0[p,k-1]*stS0[p,1],{k,2,etS0}];
sCf[p,1]=Cf/.$repS[p];
Do[sCf[p,k]=sCf[p,k-1]*sCf[p,1],{k,2,eCf}];
If[$Faster==0 || $type[p]=!=3||p==∞,
Ffl=($gauge2q[p])^(genus-1) *repq[p,(Ffl/.{z-> Series[z/.rv[p],{z,0,ord}],Cf^a__:>sCf[p,a],S2^a__:>sS2[p,a],tS1^a__:>stS1[p,a],tS0^a__:>stS0[p,a],S2->sS2[p,1],tS1->stS1[p,1],tS0->stS0[p,1],Cf->sCf[p,1]})],
Ffl=($gauge2[p])^(genus-1) *(Ffl/.{z-> Series[z/.rv[p],{z,0,ord}],Cf^a__:>sCf[p,a],S2^a__:>sS2[p,a],tS1^a__:>stS1[p,a],tS0^a__:>stS0[p,a],S2->sS2[p,1],tS1->stS1[p,1],tS0->stS0[p,1],Cf->sCf[p,1]})]]
serF[gobj_,p_,ord_]:=Block[{hi},makepropsp[p,ord,rall,1,1];Print[AbsoluteTiming[Fls=($gauge2q[p])^(genus-1) *repq[p,((gobj/.a__[z]:>a)/.rv[p]/.$repS[p])];]]]

SmallGap[genus_,p_]:=Module[{ord,fac,tmp,leadc,sol},
ord=(smallgapwidth[$mod,genus]+2 genus-2)*$scale;
fac=(1/cshiftmon[$mod,p])(1/clensefac[$mod,p])^(genus-1);
Fs[p,genus]=fac(serFfp[Ff[genus],p,genus,ord]+Series[Expand[Normal[($gauge2q[p])^(genus-1)*repq[p,Series[ambz[genus]/.rv[p],{z,0,ord}]]]],{q,0,ord}]);
tmp=Fs[p,genus];
leadc=-Exponent[Normal[tmp]/.q->1/q,q];
sol=Flatten[Solve[Table[Expand[Coefficient[tmp,q,i]]==If[i==leadc,ccF[genus],0],{i,leadc+$scalegap If[-leadc<$scalegap,1,0],leadc+$scalegap smallgapwidth[$mod,genus],$scalegap}]]];
Return[sol];
]
Clear[ngd,$inputmodular]
$inputmodular[{3,3}]={ngd[0,1]->1053,ngd[0,2]->52812,ngd[0,3]->6424326,ngd[0,4]->1139448384,ngd[0,5]->249787892583,ngd[1,1]->0,ngd[1,2]->0,ngd[1,3]->3402,ngd[1,4]->5520393,ngd[1,5]->4820744484,ngd[1,6]->3163476682080,ngd[2,2]->0,ngd[2,3]->0,ngd[2,4]->0,ngd[2,5]->5520393,ngd[2,6]->23395810338,ngd[2,7]->42200615912499,ngd[3,3]->0,ngd[3,4]->0,ngd[3,5]->0,ngd[3,6]->6852978,ngd[3,7]->174007524240,ngd[3,8]->785786604262830,ngd[4,5]->0,ngd[4,6]->10206,ngd[4,7]->-484542,ngd[4,8]->2028116431098,ngd[5,6]->0,ngd[5,7]->158436,ngd[5,8]->-784819773,ngd[5,9]->36760497856020,ngd[6,6]->0,ngd[6,7]->0,ngd[6,8]->372762,ngd[6,9]->-61753761036,ngd[6,10]->1055748342473838,ngd[7,7]->0,ngd[7,8]->6318,ngd[7,9]->-5412348,ngd[7,10]->-4055688274977,ngd[8,8]->0,ngd[8,9]->39033,ngd[8,10]->1150458714,ngd[8,11]->-277740359622189,ngd[9,9]->1170,ngd[9,10]->-1421550,ngd[9,11]->523544632866,ngd[10,9]->15,ngd[10,10]->-21060,ngd[10,11]->42487254,ngd[10,12]->107933688748656,ngd[11,10]->0,ngd[11,11]->792180,ngd[11,12]->-96817818078,ngd[11,13]->17551409134469472,ngd[12,11]->0,ngd[12,12]->-67672476,ngd[12,13]->-71248361250798,ngd[13,11]->0,ngd[13,12]->-61236,ngd[13,13]->32180134734,ngd[13,14]->-23552769634742655,ngd[14,12]->0,ngd[14,13]->66244716,ngd[14,14]->89193730254030,ngd[15,12]->0,ngd[15,13]->0,ngd[15,14]->-38299950252,ngd[16,13]->0,ngd[16,14]->-77285502,ngd[16,15]->-217376516354913,ngd[17,14]->0,ngd[17,15]->167270244048,ngd[18,14]->0,ngd[18,15]->107320680,ngd[18,16]->990222417035712,ngd[19,15]->91854,ngd[19,16]->-1393793916300,ngd[20,15]->0,ngd[20,16]->-48866814,ngd[20,17]->-7855011831413205,ngd[21,15]->0,ngd[21,16]->-1584360,ngd[21,17]->18349298486658,ngd[22,16]->0,ngd[22,17]->-3916924776,ngd[23,16]->0,ngd[23,17]->2609334,ngd[23,18]->-372702765685392,ngd[24,17]->50544,ngd[24,18]->338860808028,ngd[25,17]->0,ngd[25,18]->23305068,ngd[26,18]->-120186,ngd[27,18]->-5220,ngd[28,18]->-90,ngd[29,19]->-63180,ngd[30,19]->0,ngd[31,20]->-2534976,ngd[32,20]->0,ngd[33,20]->0,ngd[33,21]->-222958548,ngd[34,21]->-183708,ngd[35,21]->0,ngd[35,22]->-107171300556,ngd[36,21]->0,ngd[36,22]->-209774934,ngd[37,22]->0,ngd[38,22]->0,ngd[38,23]->-117773956584,ngd[39,23]->-231856506,ngd[40,23]->0,ngd[40,24]->784094829426108,ngd[41,23]->0,ngd[41,24]->-512109217728,ngd[42,24]->-297478548,ngd[43,24]->-244944,ngd[43,25]->3448552834527066,ngd[44,24]->0,ngd[44,25]->-4179092501304,ngd[45,24]->0,ngd[45,25]->58959090,ngd[46,25]->-4119336,ngd[46,26]->27142164772551882,ngd[47,25]->0,ngd[47,26]->-53529168000492,ngd[48,25]->0,ngd[48,26]->10761641532,ngd[49,26]->-589680,ngd[50,26]->-122148,ngd[50,27]->-1089181917906228,ngd[51,26]->0,ngd[51,27]->890324824482,ngd[52,27]->61819596,ngd[53,27]->78588,ngd[53,28]->-33427151297813844,ngd[54,27]->-1656,ngd[54,28]->63994621219614,ngd[55,27]->-198,ngd[55,28]->-12753357660,ngd[56,28]->-1236222,ngd[57,28]->143208,ngd[57,29]->5107223091368232,ngd[58,28]->0,ngd[58,29]->-5924469211524,ngd[59,29]->236542518,ngd[60,29]->-5703696,ngd[61,29]->0,ngd[61,30]->-1378633833342540,ngd[62,29]->0,ngd[62,30]->841660464438,ngd[63,30]->475327980,ngd[64,30]->398034,ngd[64,31]->-291661896939934680,ngd[65,30]->0,ngd[65,31]->718903306166688,ngd[66,30]->0,ngd[66,31]->-211037368248,ngd[67,31]->-452672226,ngd[68,31]->0,ngd[68,32]->320699529577227510,ngd[69,31]->0,ngd[69,32]->-775956404598264,ngd[70,32]->223088117976,ngd[71,32]->485794584,ngd[72,32]->0,ngd[73,32]->0,ngd[73,33]->1747571748926544,ngd[74,33]->-1032773712696,ngd[75,33]->-576452916,ngd[76,33]->-489888,ngd[77,33]->0,ngd[78,33]->0};

inputKKV

Define and run  the hypergeometric cases

KKV Input and Castelnouvo bound for Hypergeometric cases

(* select model $mod *)
$mod={5};
$ord=48;
$Showord=6;
$gmax=4;
$gmin=2;
$Faster=1;
$Save=1;
$SavedsF=0;
Clear[ngd]
Clear[ambz,eqsi,eqsc,loesamb,loesCN,a,dsF,Ff]
dsF[g_]:=dsF[g]=If[g==1,dsF[1],Collect[Expand[D[Ff[g],z]/.drec],{S2[z],tS1[z],tS0[z]},cfs[#]& ]];
$starttime=AbsoluteTime[];
setmod[$mod];
If[Head[$inputmodular[$mod]]===$inputmodular,$inputmodular[$mod]={}];
Clear[gmax]
Clear[ngd,$input]
gmax[d_]:=Block[{hi},d^2/(2*κ)+d/2+1];
nbgmax[b_]:=Block[{α=Length[Select[$wts,#==1&]],hi},If[b==1,α(α-1)/2,(-1)^(κ b(b-1)/2)α(α+κ b(b-1)/2)]];
inputKKV=Block[{κ},Join[
Table[ngd[gmax[κ b],κ b]->nbgmax[b],{b,30}],
Table[ngd[gmax[κ b]+1,κ b]->0,{b,30}]
]
];
Clear[ngd,$input]
$input[$mod]=Join[inputKKV,$inputmodular[$mod]];
$raF1={x[1]->-1/12};
genus0p[0,$ord];
genus1p[0,$ord,$raF1];
MatrixForm[Table[ngd[g,d],{d,1,$Showord},{g,0,1}]]
(* Data for the hypersurfaces with orbifolds at 1/z=0 *)
$rallinf[{5}]={saudd-> -8/5};
orbregulator[{5}]=5;
$rallinf[{6}]={saudd-> -3/2};
orbregulator[{6}]=6;
$rallinf[{8}]={saudd-> -3/2};
orbregulator[{8}]=8;
$rallinf[{10}]={saudd-> -7/5};
orbregulator[{10}]=10;
(* Data for the complete intersection with orbifolds at 1/z=0 *)
$rallinf[{4,3}]={saudd-> -19/12};
orbregulator[{4,3}]=3;
$rallinf[{6,4}]={saudd-> -17/12}; 
orbregulator[{6,4}]=4;
rall=$rallinf[$mod];
$rallinf[{12,2}]={saudd-> -3/2};
orbregulator[{12,2}]=2;
(* Data for the complete intersection with conifold at 1/z=0 *)
orbregulator[{4,2}]=2;
cshiftmon[{4,2},Infinity]=2;
clensefac[{4,2},Infinity]=-2^2;
$rallinf[{4,2}]={saudd-> -1};
smallgapwidth[{4,2},g_]:=Floor[(2g-4)/4];
$rallinf[{6,2}]={saudd-> -1/3};
orbregulator[{6,2}]=2;
cshiftmon[{6,2},Infinity]=1;
clensefac[{6,2},Infinity]=-2^6;
smallgapwidth[{6,2},g_]:=Floor[(2g-3)/3];
$rallinf[{3,2,2}]={saudd-> -1};
orbregulator[{3,2,2}]=2;
cshiftmon[{3,2,2},Infinity]=1;
clensefac[{3,2,2},Infinity]=-2^6;
smallgapwidth[{3,2,2},g_]:=0;
(* K-point at infinity *)
orbregulator[{3,3}]=2;
$rallinf[{3,3}]={saudd->-1};
orbregulator[{4,4}]=2;
$rallinf[{4,4}]={saudd->-1};
orbregulator[{6,6}]=2;
$rallinf[{6,6}]={saudd->-1};
(* Mum point at Infinity *)
orbregulator[{2,2,2,2}]=2;
$rallinf[{2,2,2,2}]={saudd->-1};
rall=$rallinf[$mod];
rallres=rall;
fixpropamb[12,rall]
setdrec[rall];
csadd=Cfform[add/.$scalep/.rall];
csaudd=Cfform[audd/.$scalep/.rall];
setdrecc[rall];
(* check F1 with progator *) 
makepropsp[0,$ord,rall,1,1]
dsF[1]=(1/2 Czzz S2[z]-   1/2audd-D[ (1/24(12 + $c2[$name]) Log[z]-   Sum[(x[i]/.$raF1) Log[ss[i]],{i,1,$nd}]),z]/.$scalep/.rall)
dsF[1]=Cfform[dsF[1]];
repS=Join[$scalep/.rall,$repS[0],{dKzf->$dKz[0]}];
dF[1]=dsF[1]-(χ/24-1) dKzf/.a_[z]:>a;
Print["Check F1---------------   ",Series[(repq[0,Integrate[dF[1]/.repS,z]])+Fs[0,1],{q,0,$ord-5}]]
(*<<"~/Documents/CYdata/X5BPS47";
(* ----------------If the Kernel crashed load also *)
<<"~/Documents/CYdata/X5dsF47";
<<"~/Documents/CYdata/X5Ff47";*)
Do[ngdd[g,d]=ngd[g,d],{g,0,$gmin-1},{d,1,$ord-4}]
Clear[ngd];
Do[ngd[g,d]=ngdd[g,d],{g,0,$gmin-1},{d,1,$ord-4}]
AbsoluteTiming[
Do[
Print[" Start genus   ",genus," ================================="];
ambzans[genus]=Expand[Sum[a[i,1] z^i,{i,0,2genus-3}]]/ss[1]^(2 genus-2)+Sum[a[i,0] z^i,{i,0,$anhpz[genus]=Floor[(2 genus-2)/orbregulator[$mod]]}];
unam=Join[Table[a[i,1],{i,0,2genus-3}],Table[a[i,0],{i,0,$anhpz[genus]}]];
Print["Anzahl der Unbekannten   ", Length[unam],"   nach gap conditions   ",Length[unam]-(2 genus-2)];
If[genus<4,Print["Ansatz Ambiguity ", ambzans[genus]]];
Print["dir int step", $timedirint[genus]= Timing[Ff[genus]=dirint[genus];]];
(* The Fs[μ,g] series at conifold*)
p=μ;
Print[" make props at conifold and calculate the series   ",$timeconifold[genus]= Timing[ Fs[p,genus]=serFfp[Ff[genus],p,genus,(2 genus-2)]+
$gauge2[p]^(genus-1)(ambzans[genus]/.z-> Series[z/.rv[p],{z,0,2genus-2}])][[1]]];
(* gap condition *)
Print[" solving gap condition  ", Timing[loesamb[genus]=Flatten[Solve[Series[Fs[p,genus]-(cser=ccF[genus](1/($qs[p]/μ))^(2 genus-2)(1/κ)^(genus-1)),{z,0,-1}]==0,unam]]][[1]]];
Print["Unbekannte nach gap =  ",Length[unaml=Select[unam/.loesamb[genus],!FreeQ[#,a]&]]];
ambz[genus]=Simplify[ambzans[genus]/.loesamb[genus]];
(* small gap *)
If[Length[Union[CYIndicials[L0,Infinity]]]==3 && $mod=!={3,2,2},
Print[" make props infinity and test  the small gap there  ",
smallGapTime=AbsoluteTiming[ 
gsol=SmallGap[genus,Infinity];
loesamb[genus]=Join[loesamb[genus]/.gsol,gsol]//Factor;
ambz[genus]=Simplify[ambz[genus]/.gsol];
Print["unbek after small gap  ", Length[unaml=Select[unam/.loesamb[genus],!FreeQ[#,a]&]]];
][[1]]]];
p=0;
Print[" make props at Mum and insert the q expansion  ", 
$timemum[genus]=Timing[Fs[p,genus]=serFfp[Ff[genus],p,genus,$ord]+Series[Expand[Normal[($gauge2q[p])^(genus-1)*repq[p,Series[ambz[genus]/.rv[p],{z,0,$ord}]]]],{q,0,$ord}]][[1]]];
cd=1; castelnovo={};While[ngd[genus-1,cd]==0,castelnovo=Join[castelnovo,{ngd[genus,cd]->0}];cd++];
Print["castelnovobound   ", Length[castenovobound[genus]=castelnovo]];
castelnovo=Join[castelnovo,$input[$mod]];
deg=$ord-4;
Print[" Formal GV series  ",Timing[FBPS=Normal[Sum[cmF[g] gs^(2g),{g,2,genus}]+Simplify[gs^2Series[Series[Sum[ngd[g,d]*(2*Sin[n*gs/2])^(2*g-2)*q^(n*d)/n,{d,1,deg},{g,0,genus},{n,1,Floor[deg/d]}],{gs,0,2*genus-2}],{q,0,deg}]]]][[1]]];
Fcal=Normal[(Fs[0,0]-Fs[0,1]*gs^2/.Log[q]->0)+Sum[Fs[0,g]*gs^(2*g),{g,2,genus}]];
ukngd={};Do[If[Head[ngd[genus,k]]===ngd,ukngd=Join[ukngd,{ngd[genus,k]}]],{k,1,deg}];
Print[" Castelnouvo bound  ",Timing[loesbps=Flatten[Solve[eqsi1[genus]=Flatten[Table[Coefficient[Coefficient[test=FBPS-Fcal,gs,2 genus],q,qp]==0,{qp,0,deg}]],Join[ukngd,unam]]]][[1]]];
loesCN[genus]=Join[Flatten[Solve[eqsi[genus]=Map[#[[1]]==#[[2]]&,loesbps/.castelnovo]]],castelnovo];
loesamb[genus]=Sort[Join[loesamb[genus]/.loesCN[genus],loesCN[genus]]];
ambz[genus]=Simplify[ambz[genus]/.loesamb[genus]];
Print["Unbekannte nach Castelnovo + F_const + Gap =  ",Length[unam=Select[unam/.loesamb[genus],!FreeQ[#,a]&]]];
Ff[genus]=Ff[genus]+Cfform[ambz[genus]];
loesCN[genus]=loesCN[genus]/.ngd[a__]:>Ngd[a];
Fs[0,genus]=Fs[0,genus]/.loesamb[genus];
Fs[μ,genus]=Simplify[Fs[μ,genus]/.loesamb[genus]];
Do[ngd[genus,dk]=(ngd[genus,dk]/.loesamb[genus]),{dk,1,deg}];
Print[MatrixForm[Table[ngd[g,d],{d,1,$Showord},{g,genus,genus}]]];
loesamb[genus]=Select[loesamb[genus],Head[#[[1]]]===a&];
Print["Absolute time ", $timetest[genus]=AbsoluteTime[]-$starttime];
(*  save data, once the program gets to higher genus *) 
If[$Save==1,
If[(genus >= 20 && genus <49 && Mod[genus,10]==0) || genus ==$gmax,
Save[StringJoin["~/Documents/CYdata/X" ,StringJoin[Sequence @@ Map[ToString[#]&,$mod]],"BPS",ToString[genus]],ngd];
Save[StringJoin["~/Documents/CYdata/X", StringJoin[Sequence @@ Map[ToString[#]&,$mod]],"Ff",ToString[genus]],Ff];
If[$SavedsF==1,Save[StringJoin["~/Documents/CYdata/X",StringJoin[Sequence @@ Map[ToString[#]&,$mod]],"dsF",ToString[genus]],dsF]]
,
If[genus >= 50 && Mod[genus,2]==0,
Save[StringJoin["~/Documents/CYdata/X",StringJoin[Sequence @@ Map[ToString[#]&,$mod]]  ,"BPS",ToString[genus]],ngd];
Save[StringJoin["~/Documents/CYdata/X", StringJoin[Sequence @@ Map[ToString[#]&,$mod]] ,"Ff",ToString[genus]],Ff];
If[$SavedsF==1,Save[StringJoin["~/Documents/CYdata/X",StringJoin[Sequence @@ Map[ToString[#]&,$mod]] ,"dsF",ToString[genus]],dsF]];
]]];
Print[" =================================  Finish genus  ",genus],{genus,$gmin,$gmax}]]

Non-perturbative analysis  (connect to  Marcos’s and Jie’s Notebooks)

Input and preparations

$gmax=52;
SetDirectory[NotebookDirectory[]];
<<X5Ff52;
Flist=Table[Ff[g],{g,2,$gmax}]
Clear[Ff]
(*filename="X62Ff20";
SetDirectory[NotebookDirectory[]];
fp=OpenRead[filename];
Flist={};
line=ReadLine[fp];
g=2;
Monitor[While[line=!=EndOfFile&&g<=$gmax,
Flist=Append[Flist,
Ff[g]=ToExpression[line]];
line=ReadLine[fp];
g++;],g];*)
(*Basic tools*)

The Richardson Transform

ClearAll[RichardsonTransform,BestMatch]
RichardsonTransform[list_,0]:=list
RichardsonTransform[list_,order_]:=Module[{prev},
prev=RichardsonTransform[list,order-1];
Table[(n/order)(prev[[n+1]]-prev[[n]])+prev[[n]],{n,1,Length[prev]-1}]];

The following is specific to the quintic. We  just have to check that we provide the general expressions for all models and the conventions exactly agree

w0[u_,n_]:=w0[u,n]=Sum[(5 j)!/(j!)^5*u^j, {j,0,n}];
w0[u_,r_,n_]:=Sum[(Product[(5 r +k), {k,1,5 j}]/Product[(r+k)^5,{k,1, j}])*u^{j+r}, {j,0,n}];
w1[u_,n_]:=Sum[5*((5 j)!/(j!)^5*u^j)*Sum[1/k, {k,j+1,5j}],{j,1,n}];
w2[u_,n_]:=Sum[((5 j)!/(j!)^5*u^j)*(25 (Sum[1/k, {k,j+1,5j}])^2 - 25 Sum[1/k^2, {k,1,5j}] + 5 Sum[1/k^2, {k,1,j}] ),{j,1,n}];
Q[u_,n_]:=Q[u,n]=Series[u*Exp[(5/w0[u,n])*Sum[((5 j)!/(j!)^5*u^j)*Sum[1/k, {k,j+1,5j}],{j,1,n}]],{u,0,n}];
Qn[y_, n_]:=Normal[Q[u,n]]/.u->y;
(*inverts the mirror map*)
U[n_]:=Normal[InverseSeries[Q[u,n],t]];
(*a slight variant: we take the log of t, called T, and we express it in terms of u*)
T[u_,n_]:=T[u,n]=-Log[u] - Normal[Series[w1[u,n]/w0[u,n],{u,0,n}]];
DT[u_,n_]:=DT[u,n]=D[T[u,n],u];
Cz[zp_]:=Czzz/.z->zp;

DCz[z_]:=((5 (-3+12500 z))/((((1-3125 z))^2) (z^4)));
fz[z_]:=((107-350000 z)/(60 z (-1+3125 z)));
sz3[z_]:=-(8/(5 z));
(* The ambiguity for F1 is encoded in the conifold rule(s) $raF1 and $F1loes constructed form the c_2 J (=50 for quintic etc)  datum and calculated to ambz[genus]*)   
f1[z_]:=-31/12 Log[z]-1/12 Log[1-3125 z];
ambz[1]=(c[1]/.$F1loes)Log[z]+(x[1]/.$raF1 )Log[ss[1]]

h3z[z_]:=z/25;
h2z[z_]:=2/(25 z^2);
hud[z_]:=-6/625;
(* Propagator ambiguities are given by this noation as a rule for  (a-ambiguity) (u-upper index) (d-down index), i.e. audd=a^z_{zz} etc *)
$rall[0]

The propagators agree  in the standard gauge at p=z=0

p=0
mySzz[n_]:=Normal[Simplify[Series[-1/Cz[z]( D[T[z, n],{z,2}]/D[T[z,n], z]+2  D[w0[z, n],z]/w0[z,n]+ 8 /(5 z)),{z,0, n}]]];
mytSz[n_]:=Normal[Simplify[Series[1/2 (D[mySzz[n+1],z]-Cz[z] mySzz[n+1]^2+2 sz3[z] mySzz[n+1]- h3z[z]),{z,0, n}]]]
$tSz[p]=Series[Expand[Normal[(1/2) ((∂_z)$Szz[p]-$Czzz[p] $Szz[p] $Szz[p]+2 audd $Szz[p]-auud)/. $rall[p]]],{z,0,$ord}]
mytS[n_]:=Normal[Simplify[Series[1/2 (D[mytSz[n+1],z]-Cz[z] mySzz[n+1]mytSz[n+1]+sz3[z] mytSz[n+1]+h2z[z]mySzz[n+1]-hud[z]),{z,0, n}]]];
SzzLR[y_,n_]:=mySzz[n]/.z->y;
tSzLR[y_,n_]:=mytSz[n]/.z->y;
tSLR[y_,n_]:=mytS[n]/.z->y;

rall

My propagator making routine works with makepropsp[point, order,”rall” fixes the prop ambiguity,1 = scale option for z ,1= scale option for t] it outputs a rule $repS[point]

(* Here we see that the propagtors are equal  at z=0*)

$order=48
makepropsp[0,$order,rall,1,1];
Normal[(S2/.$repS[0])]-mySzz[$order]
Normal[(tS1/.$repS[0])]-mytSz[$order]
Normal[(tS0/.$repS[0])]-mytS[$order]

F0INST[t_,n_]:=F0INST[t,n]=Integrate[t^(-1)Normal[Series[(5/2)(((w2[u,n]/w0[u,n])
-(w1[u,n]/w0[u,n])^2)/.u->U[n]), {t,0,n}]],t];
(*the function GVZERO[n] computes the generating series of GV invariants at genus 0 up to degree n*)
GVZERO[n_]:=Module[{k,l},
For[k=1, k≤n, k++,
gv[k]=0;For[l=1, l≤k, l++, 
If[IntegerQ[k/l]==True, gv[k]=gv[k]+ MoebiusMu[k/l]*(l^3/k^3)*(Coefficient[F0INST[t,n],t,l]*t^l/.{t->t^(k/l)}) ]]];Sum[gv[k],{k,1,n}]];
(*this is the general formula with generic c and d coefficients; these 
coefficients encode the holomorphic ambiguity*)
FONE[t_,n_,a_, b_]:=Normal[Simplify[Series[-31/3*Log[w0[U[n],n]]-1/2 Log[-(DT[u, n]/.u->U[n])]+a Log[U[n]]+b Log[1 - 5^5*U[n]],{t,0,n}],t>0]];
(*analysis of the asymptotics and knowledge of the behavior of the first terms fixes the holomorphic ambiguity and gives c=-31/12, d=-1/12;*)
FONE[t_,n_]:=FONE[t,n,-31/12,-1/12];
(*this extracts the genus one GV invariants after subtracting the genus zero 
contribution*)
GVONE[n_]:=Module[{k,l},
For[k=1, k≤n, k++,
gvo[k]=0;For[l=1, l≤k, l++, 
If[IntegerQ[k/l]==True, gvo[k]=gvo[k]+ MoebiusMu[k/l]*(l/k)*(Coefficient[FONE[t,n+1],t,l]*t^l/.{t->t^(k/l)}) ]]];Collect[Sum[gvo[k],{k,1,n}]-GVZERO[n]/12,t]];
nGV[i_]:=Coefficient[GVZERO[i],t,i];

F0INST[t,10]

μ

Expand[(θ^4)-5z(5θ+1)(5θ+2)(5θ+3)(5θ+4)]

L0

Series[5^5 Normal[CYSolve[L0,μ,1,10][[2]]]/.z->z/5^5,{z,0,10}]

Series[-5^5 Normal[CYSolve[L0,μ,1,10][[2]]]/.z->z/5^5/.z->-z/(1+z),{z,0,10}]

Series[-5^5 Normal[CYPeriodMatrix[L0,μ,1,10][[1,2]]]/.z->z/5^5/.z->-z/(1+z),{z,0,10}]

?CYperiodMatrix

Series[- 5^5Normal[CYSolve[L0,μ,1,10][[2]]]/.z->-z/ 5^5/(1+z),{z,0,10}]

Series[- 5^5Normal[CYSolve[L0,μ,1,10][[2]]]/.z->-z/ 5^5/(1+z),{z,0,10}]

(Subscript[z, cfld ])=(5^(-5));
Clear[omega0,omega1,omega2,omega3,Domega0,D2omega0,D3omega0,Domega1,D2omega1,D3omega1]
omega0[y_, orderak_]:=omega0[y, orderak]=(CYPeriodMatrix[(θ^4)-5z(5θ+1)(5θ+2)(5θ+3)(5θ+4),(Subscript[z, cfld]),1,orderak][[1]][[1]]//Quiet)/.z->y;
omega1[y_, orderak_]:=omega1[y, orderak]=(-5^5 CYPeriodMatrix[(θ^4)-5z(5θ+1)(5θ+2)(5θ+3)(5θ+4),(Subscript[z, cfld]),1,orderak][[2]][[1]]//Quiet)/.z->y;
omega2[y_, orderak_]:=(*omega2[y, orderak]=*)(5^(10) CYPeriodMatrix[(θ^4)-5z(5θ+1)(5θ+2)(5θ+3)(5θ+4),(Subscript[z, cfld]),1,orderak][[4]][[1]]//Quiet)/.z->y;
omega3[y_, orderak_]:=(*omega3[y, orderak]=*)((Coefficient[-5^5 (CYPeriodMatrix[(θ^4)-5z(5θ+1)(5θ+2)(5θ+3)(5θ+4),(Subscript[z, cfld]),1,orderak][[3]][[1]]//Quiet), Log[-(1/3125)+z]] Log[1-5^5 z]+(-5^(5)(CYPeriodMatrix[(θ^4)-5z(5θ+1)(5θ+2)(5θ+3)(5θ+4),(Subscript[z, cfld]),1,orderak][[3]][[1]]//Quiet)/. Log[-(1/3125)+z]->0)))/.z->y;

Series[omega1[x,10] ,{x,0,10}]

Domega0[z_, orderak_]:=D[omega0[y, orderak],y]/.y->z;
D2omega0[z_, orderak_]:=D[omega0[y, orderak],{y,2}]/.y->z;
D3omega0[z_, orderak_]:=D[omega0[y, orderak],{y,3}]/.y->z;
Domega1[z_, orderak_]:=D[omega1[y, orderak],y]/.y->z;
D2omega1[z_, orderak_]:=D[omega1[y, orderak],{y,2}]/.y->z;
D3omega1[z_, orderak_]:=D[omega1[y, orderak],{y,3}]/.y->z;

Szzc[z_, orderc_]:=-1/Cz[z]((omega0[z, orderc+1] D2omega1[z, orderc+3]-D2omega0[z, orderc+3] omega1[z, orderc+1])/(omega0[z, orderc+1] Domega1[z, orderc+2]-Domega0[z, orderc+2] omega1[z, orderc+1])- sz3[z]);
tSzc[z_, orderc_]:=-1/Cz[z]((Domega0[z, orderc+2] D2omega1[z, orderc+3]-D2omega0[z, orderc+3] Domega1[z, orderc+2])/(omega0[z, orderc+1] Domega1[z, orderc+2]-Domega0[z, orderc+2] omega1[z, orderc+1])- h2z[z]);
tSc[z_, orderc_]:=DCz[z]/(2 Cz[z]^2)((Domega0[z, orderc+2] D2omega1[z, orderc+3]-D2omega0[z, orderc+3] Domega1[z, orderc+2])/(omega0[z, orderc+1] Domega1[z, orderc+2]-Domega0[z, orderc+2] omega1[z, orderc+1]))-1/(2 Cz[z])((Domega0[z, orderc+2] D3omega1[z, orderc+4]-D3omega0[z, orderc+4] Domega1[z, orderc+2])/(omega0[z, orderc+1] Domega1[z, orderc+2]-Domega0[z, orderc+2] omega1[z, orderc+1]))- 10z;

Coefficient[Normal[Simplify[Series[omega3[y, 10]/.y->5^(-5)(1-δc),{δc,0,10}]]], Log[δc]]

Normal[Simplify[Series[-omega1[y, 10]/.y->5^(-5)(1+δc),{δc,0,10}]]]

?repS;

$order=12
makepropsp[μ,$order,rall,1,1]
(Normal[S2/.$repS[μ]]/.z->-δc/5^5)-Series[Szzc[z,$order]/.z->5^(-5)(1-δc),{δc,0,$order}]
(Normal[tS1/.$repS[μ]]/.z->-δc/5^5)-Series[tSzc[z,$order]/.z->5^(-5)(1-δc),{δc,0,$order}]
(Normal[tS0/.$repS[μ]]/.z->-δc/5^5)-Series[tSc[z,$order]/.z->5^(-5)(1-δc),{δc,0,$order}]

Flist[[2]]

Instanton Action

mySzz[10]

Here we create the list of F_gs

Clear[nnFz]

(*$order=240;
p=0;
makepropsp[p,$order,rall,1,1] *)
nSzz[y_,n_,prec_]:=nSzz[y,n,prec]=N[mySzz[n]/.z->y, prec];
ntSz[y_,n_,prec_]:=ntSz[y,n,prec]=N[mytSz[n]/.z->y, prec];
ntS[y_,n_,prec_]:=ntS[y,n,prec]=N[mytS[n]/.z->y, prec];

Flz[i_,n_]:=Flist[[i]]/.{Cf[z]->Cz[z], S2[z]->mySzz[n],tS0[z]->mytS[n],tS1[z]->mytSz[n]};
nFz[y_,i_,n_,prec_]:=nFz[y,i,n,prec]=Flist[[i]]/.{z->y,Cf[z]->Cz[y], S2[z]->nSzz[y,n,prec],tS0[z]->ntS[y,n,prec],tS1[z]->ntSz[y,n,prec]};
nlistFz[y_,d_,n_,prec_]:=Table[nFz[y,i,n,prec+IntegerPart[3i/2]],{i,1, d}];
quot[y_,d_,n_, prec_]:=Delete[nlistFz[y,d+1,n,prec],1]/(Table[4 i^2, {i,1,d}]Delete[nlistFz[y,d+1,n,prec],d+1]);

(*Flz[i_,n_]:=Ff[i]/.{Cf[z]->Cz[z], S2[z]->mySzz[n],tS0[z]->mytS[n],tS1[z]->mytSz[n]};
nFz[y_,i_,n_,prec_]:=nFz[y,i,n,prec]=Ff[i]/.{z->y,Cf[z]->Cz[y], S2[z]->nSzz[y,n,prec],tS0[z]->ntS[y,n,prec],tS1[z]->ntSz[y,n,prec]};
nlistFz[y_,d_,n_,prec_]:=Table[nFz[y,i,n,prec+IntegerPart[3i/2]],{i,1, d}];
quot[y_,d_,n_, prec_]:=Delete[nlistFz[y,d+1,n,prec],1]/(Table[4 i^2, {i,1,d}]Delete[nlistFz[y,d+1,n,prec],d+1]);*)

We also create a list of Fg’s in which we have subtracted the constant map contribution

cmF[g_, χ_]:=(-1)^(g-1)*BernoulliB[2*g]*BernoulliB[2*(g-1)]/(4*g*(2*g-2)*Factorial[(2*g-2)])*χ;
nnFz[y_,i_,n_,prec_]:=nFz[y,i,n,prec]-cmF[i+1,-200]/w0[y, n]^(2i);
nnlistFz[y_,d_,n_,prec_]:=Table[nnFz[y,i,n,prec+IntegerPart[3i/2]],{i,1, d}];
nquot[y_,d_,n_, prec_]:=Delete[nnlistFz[y,d+1,n,prec],1]/(Table[4 i^2, {i,1,d}]Delete[nnlistFz[y,d+1,n,prec],d+1]);

This is the conifold action, which controls the asymptotics sufficiently far from LR

action[y_, orderak_]:=2 Pi 5^(1/2)omega1[y, orderak];
Daction[z_, orderak_]:=2 Pi 5^(1/2)Domega1[z, orderak];
D2action[z_, orderak_]:=2 Pi 5^(1/2)D2omega1[z, orderak];

nFz[1/3*5^(-5),14,125,35]

Series[omega1[x,10],{x,0,10}]

Series[CYPeriodMatrix[L0,μ,1,10][[2,1]],{z,0,10}]

Length[Flist[[48]]]

l1g38=Take[RichardsonTransform[1/quot[1/3*5^(-5),38,125,25]^(1/2),5],-5]

l1gm=Take[RichardsonTransform[1/quot[1/3*5^(-5),$gmax-4,125,25]^(1/2),5],-5]

N[action[1/3*5^(-5), 125],20]

l2g38=l38=Take[RichardsonTransform[1/quot[15/16*5^(-5),$gmax-4,145,25]^(1/2),16],-5]

l2gm=Take[RichardsonTransform[1/quot[15/16*5^(-5),$gmax-4,145,25]^(1/2),16],-5]

N[action[15/16*5^(-5), 125],24]-l48[[5]]

N[action[15/16*5^(-5), 125],24]-l38[[5]]

Flist[[2]]

Value of b

bclist[y_, d_,orderc_,orderLR_, prec_]:=Table[(2i(action[y,orderc]^2((nlistFz[y,d+1,orderLR,prec][[i+1]])/(nlistFz[y,d+1,orderLR,prec][[i]]4 (i^2)))-1)-1)/2,{i,1,d}];

N[action[1/3*5^(-5),135],25]

Take[bclist[1/3*5^(-5),38,135,125,25],-5]

l3g38=Take[RichardsonTransform[bclist[1/3*5^(-5),38,135,125,25],6]-1,-5]

l3gm=Take[RichardsonTransform[bclist[1/3*5^(-5),$gmax-4,135,125,25],6]-1,-5]

l4g38=Take[RichardsonTransform[bclist[1/2*5^(-5),38,135,125,25],17]-1,-5]

l4gm=Take[RichardsonTransform[bclist[1/2*5^(-5),$gmax-4,135,125,25],17]-1,-5]

l5g38=Take[RichardsonTransform[bclist[5/8*5^(-5),38,125,125,25],19]-1,-5]

l5gm=Take[RichardsonTransform[bclist[5/8*5^(-5),$gmax-4,125,125,25],19]-1,-5]

l5g38=Take[RichardsonTransform[bclist[15/16*5^(-5),38,100,150,25],18]-1,-5]

l5gm=Take[RichardsonTransform[bclist[15/16*5^(-5),$gmax-4,100,150,25],18]-1,-5]

Value of the prefactor

mu1list[y_, d_, orderc_, orderLR_,prec_]:=Table[ action[y,orderc]^(2i+1)((nlistFz[y,d+1,orderLR,prec][[i]])/(Gamma[2i+1])),{i,1,d}];

Prediction from HAE

mu1[y_, orderc_, orderlr_]:=mu1[y, orderc, orderlr]=1/(2 Pi^2)action[y, orderc]*Exp[1/2 Daction[y, orderc]^2(SzzLR[y, orderlr]-Szzc[y, orderc])-Daction[y, orderc]action[y, orderc] (tSzLR[y, orderlr]-tSzc[y, orderc])+ action[y, orderc]^2 (tSLR[y, orderlr]-tSc[y, orderc])];

firstz[z_, n_]:=Normal[Simplify[Series[-5 T[u, n]^2/2-(5/2)(((w2[u,n]/w0[u,n])
-(w1[u,n]/w0[u,n])^2)),{u,0,n}]]]/.u->z;
secz[z_, n_]:=Normal[Simplify[Series[D[firstz[u, n],u]/DT[u, n],{u,0, n}]]]/.u->z;
F0z[z_, n_]:=Expand[Normal[Series[-5 T[u, n]^3/6,{u,0,n}]]+ Normal[Integrate[Series[-(5/2)(((w2[u,n]/w0[u,n])
-(w1[u,n]/w0[u,n])^2))*DT[u,n],{u,0,n}],u]]]/.u->z;
tau00z[y_,n_]:=tau00z[y,n]= (2 F0z[z,n]+ 200 Zeta[3]-2 T[z,n] firstz[z,n]+ T[z,n]^2 secz[z,n])/.z->y;
mu1ex[y_,  orderc_,orderlr_]:=1/(2 Pi^2)action[y, orderc]*Exp[1/(8 Pi^2)  tau00z[y, orderlr]];
nmu1ex[y_, orderc_, orderlr_,  prec_]:=1/(2 Pi^2)action[z, orderc]*Exp[1/(8 Pi^2) N[ tau00z[z, orderlr],prec]]/.z->y;

z=1/3*5^(-5)

l7g38=Take[RichardsonTransform[mu1list[1/3*5^(-5),38,135,125,25],6],-5]

l7gm=Take[RichardsonTransform[mu1list[1/3*5^(-5),$gmax-4,135,125,25],6],-5]

nmu1ex[1/3*5^(-5), 80, 125,35]

nmu1ex[1/3*5^(-5), 80, 135,35]

z=1/2*5^(-5)

l8g38=Take[RichardsonTransform[mu1list[1/2*5^(-5),38,135,125,25],16],-5]

l8g38=Take[RichardsonTransform[mu1list[1/2*5^(-5),$gmax-4,135,125,25],16],-5]

N[mu1[1/2*5^(-5), 80, 55],25]

N[mu1[1/2*5^(-5), 85, 60],25]

nmu1ex[1/2*5^(-5), 80, 65,35]

ListPlot[{ mu1list[1/2*5^(-5),38,135,125,25], RichardsonTransform[mu1list[1/2*5^(-5),38,135,125,25],5], Table[0.000038081205262381316930884764441765197709028162006581649`25.,{i,1, 38}]}, PlotStyle->{{PointSize[0.015], Red},{PointSize[0.017], Blue},{PointSize[0.01], Black}}, Joined->{False, False, True}, PlotRange->{0.000020, 0.000050}]

ListPlot[{ mu1list[1/2*5^(-5),$gmax-4,135,125,25], RichardsonTransform[mu1list[1/2*5^(-5),$gmax-4,135,125,25],5], Table[0.000038081205262381316930884764441765197709028162006581649`25.,{i,1, $gmax-4}]}, PlotStyle->{{PointSize[0.015], Red},{PointSize[0.017], Blue},{PointSize[0.01], Black}}, Joined->{False, False, True}, PlotRange->{0.000020, 0.000050}]

z=5/8*5^(-5)

Take[RichardsonTransform[mu1list[5/8*5^(-5),38,125,125,25],6],-5]

l9g38=Take[RichardsonTransform[mu1list[5/8*5^(-5),38,125,125,25],19],-5]

l9gm=Take[RichardsonTransform[mu1list[5/8*5^(-5),$gmax-4,125,125,25],19],-5]

N[mu1[5/8*5^(-5), 125, 125],25]

nmu1ex[5/8*5^(-5), 80, 135,35]

z=15/16*5^(-5)

Take[RichardsonTransform[mu1list[15/16*5^(-5),38,100, 150,25],10],-5]

Take[RichardsonTransform[mu1list[15/16*5^(-5),38,100,150,25],16],-5]

N[mu1[15/16*5^(-5), 100,150],25]

nmu1ex[15/16*5^(-5), 100, 200,45]

inter=Table[nmu1ex[15/16*5^(-5), 100, 10*i,25],{i,1, 20}];

ListPlot[inter]

Relation to F0?

Aexp[y_, orderc_, orderlr_]:=Aexp[y, orderc, orderlr]= Daction[y, orderc]^2(SzzLR[y, orderlr]-Szzc[y, orderc])-2 Daction[y, orderc]action[y, orderc] (tSzLR[y, orderlr]-tSzc[y, orderc])+ 2 action[y, orderc]^2 (tSLR[y, orderlr]-tSc[y, orderc]);

NNLO

mu2list[y_, d_, orderc_, orderLR_,prec_]:=Table[(2i)/ action[y,orderc](((action[y,orderc]^(2i+1) nlistFz[y,d+1,orderLR,prec][[i]])/(Gamma[2i+1]))-mu1[y,orderc, orderLR]),{i,1,d}];

Prediction from HAE, expressed in terms of propagators

mu2[y_, orderc_, orderlr_, λ_,χ_]:=1/(2 Pi^2)Exp[1/2 Daction[y, orderc]^2(SzzLR[y, orderlr]-Szzc[y, orderc])-Daction[y, orderc]action[y, orderc] (tSzLR[y, orderlr]-tSzc[y, orderc])+ action[y, orderc]^2 (tSLR[y, orderlr]-tSc[y, orderc])]*((1/24) (24+4 (((tSzLR[y, orderlr]-tSzc[y, orderc]))^2) ((action[y, orderc])^4) ((tSzLR[y, orderlr]+2 tSzc[y, orderc]) Cz[y]-3 h2z[y])+24 (-SzzLR[y, orderlr]+Szzc[y, orderc])((Daction[y, orderc])^2)-2 ((action[y, orderc])^2) ((tSLR[y, orderlr]-tSc[y, orderc]) (24+24 λ-χ)+12 (-tSzLR[y, orderlr]+tSzc[y, orderc]) fz[y]+6 Cz[y] (-SzzLR[y, orderlr] tSzLR[y, orderlr]+Szzc[y, orderc] tSzc[y, orderc]-(SzzLR[y, orderlr]-Szzc[y, orderc]) ((SzzLR[y, orderlr]+Szzc[y, orderc]) tSzLR[y, orderlr]-2 Szzc[y, orderc]tSzc[y, orderc]) ((Daction[y, orderc])^2))+6 (SzzLR[y, orderlr]-Szzc[y, orderc]) (h2z[y]+(SzzLR[y, orderlr]-Szzc[y, orderc]) h2z[y] ((Daction[y, orderc])^2)+2 (tSzLR[y, orderlr]-tSzc[y, orderc]) Daction[y, orderc] (sz3[y]Daction[y, orderc]-D2action[y, orderc])))+12 (tSzLR[y, orderlr]-tSzc[y, orderc]) ((action[y, orderc])^3) (-((-2 Szzc[y, orderc] tSzc[y, orderc]+SzzLR[y, orderlr] (tSzLR[y, orderlr]+tSzc[y, orderc])) Cz[y]+2 (-SzzLR[y, orderlr]+Szzc[y, orderc]) h2z[y]+(-tSzLR[y, orderlr]+tSzc[y, orderc]) sz3[y]) Daction[y, orderc]+(-tSzLR[y, orderlr]+tSzc[y, orderc]) D2action[y, orderc])+action[y, orderc] (Daction[y, orderc] ((tSzLR[y, orderlr]-tSzc[y, orderc]) (48+24 λ-χ)+4 (SzzLR[y, orderlr]-Szzc[y, orderc]) (-3 (SzzLR[y, orderlr]+Szzc[y, orderc]) Cz[y]-6 fz[y]+3 sz3[y]-(SzzLR[y, orderlr]-Szzc[y, orderc]) ((SzzLR[y, orderlr]+2 Szzc[y, orderc]) Cz[y]-3 sz3[y]) ((Daction[y, orderc])^2)))-12 (SzzLR[y, orderlr]-Szzc[y, orderc]) (1+(SzzLR[y, orderlr]-Szzc[y, orderc]) ((Daction[y, orderc])^2)) D2action[y, orderc])));

Ingredients needed for the trans-series, and expressions for (Subscript[μ, 2]) and (Subscript[μ, 3]) in terms of free energies

thirdz[z_,n_]:=thirdz[z,n]=Normal[Simplify[Series[D[secz[y, n],y]/DT[y,n],{y,0, n}]]]/.y->z;
fourthz[z_, n_]:=fourthz[z, n]=Normal[Simplify[Series[D[thirdz[y, n],y]/DT[y,n],{y,0, n}]]]/.y->z;
firstF1z[z_,n_]:=firstF1z[z,n]=Normal[Simplify[Series[ (-31/3 D[w0[u, n],u]/w0[u, n]-1/2 D[DT[u,n], u]/DT[u, n]-31/12*1/u+1/12*5^5/(1 - 5^5*u))/DT[u,n],{u,0, n}]]]/.u->z;;
secondF1z[z_,n_]:=secondF1z[z,n]=Normal[Simplify[Series[D[firstF1z[u, n] ,u]/DT[u, n],{u,0, n}]]]/.u->z;C000[y_, order_]:=- T[y,order]^3/w0[y,order]thirdz[y,order];
C0000[y_,order_]:=T[y, order]^3/w0[y,order]^2 (4  thirdz[y, order]+T[y, order] fourthz[y,order])
F10[y_, χ_,order_]:=-T[y,order]/w0[y,order] firstF1z[y,order] -(χ/24-1)/w0[y,order];
F100[y_,χ_, order_]:=T[y,order]/w0[y,order]^2 (2  firstF1z[y,order]+T[y,order] secondF1z[y,order])+(χ/24-1)/w0[y,order]^2;
Y1[y_,χ_, orderlr_]:=-1/6 *1/(2 Pi)^3  C000[y, orderlr]-1/(2 Pi)  F10[y,χ, orderlr];
Y2[y_,χ_, orderlr_]:=1/(4!*(2 Pi)^4)C0000[y,orderlr]+1/(2!*(2 Pi)^2) F100[y,χ, orderlr]

mu2preex[z_, orderc_, orderlr_, χ_]:=(1+ action[y,orderc]  Y1[y,χ,orderlr]-1/(4 Pi^2)  tau00z[y, orderlr]  )/.y->z;
mu3preex[z_, orderc_, orderlr_, χ_]:=(action[y,orderc] (1/2  Y1[y,χ,orderlr]^2 +Y2[y,χ,orderlr])+Y1[y,χ,orderlr](1 -1/(4 Pi^2)  tau00z[y, orderlr] )+1/(2 (2 Pi)^3) C000[y, orderlr] + 1/(2 Pi) F10[y, χ,orderlr])/.y->z;
nmu2ex[y_, orderc_, orderlr_, χ_, prec_]:=N[1/(2 Pi^2)mu2preex[y, orderc, orderlr, χ],prec]Exp[1/(8 Pi^2)  N[tau00z[y, orderlr],prec]];
nmu3ex[y_, orderc_, orderlr_, χ_, prec_]:=N[1/(2 Pi^2)mu3preex[y, orderc, orderlr, χ],prec]Exp[1/(8 Pi^2)  N[tau00z[y, orderlr],prec]];

C001[y_, order_]:= T[y,order]^2/w0[y,order]thirdz[y,order];
C011[y_, order_]:=- T[y,order]/w0[y,order]thirdz[y,order];
C111[y_, order_]:= 1/w0[y,order]thirdz[y,order];

z=1/3*5^(-5)

lp1g38=Take[RichardsonTransform[mu2list[1/3*5^(-5),38,135,125,40],6],-5]

lpp1gm=Take[RichardsonTransform[mu2list[1/3*5^(-5),$gmax-4,180,180,40],6],-5]

{5.8809970628700174605628326376845687900489769579571953997818462825471181`42.77727350339445*^-7,5.8810013122892606758276017498237565352160837454703921231261835492736823`43.726502601212744*^-7,5.8810048597449999125523673838825071675581428920442453362681775147593135`45.17458852693615*^-7,5.8810077941261929418841267591097968051253465993677337975919208707615464`46.14064363183115*^-7,}

N[mu2[1/3*5^(-5), 100,65, 1,-200],25]

5.881024544188997407990384328973296229625178241023281`25.*^-7-5.88099410206894298695830630035304411337894154635661`35.91095054709303*^-7

5.881024544188997407990384328973296229625178241023281`25.*^-7-5.8810102424051551432568612502313907865209886763029841561550610881528922`47.62113558622076*^-7

nmu2ex[1/3*5^(-5), 100,65, -200,25]

N[mu2[1/3*5^(-5), 105,65, 1,-200],25]

z=1/2*5^(-5)

lp2g38=Take[RichardsonTransform[mu2list[1/2 5^(-5), 38,135, 125,25],5],-5]

lp2gm=Take[RichardsonTransform[mu2list[1/2 5^(-5), $gmax-4,135, 125,25],15],-5]

N[mu2[1/2*5^(-5), 65,65, 1,-200],25]

nmu2ex[1/2*5^(-5), 100,65, -200,25]

nmu2ex[1/2*5^(-5), 100,75, -200,25]

z=5/8*5^(-5)

lp3g38=Take[RichardsonTransform[mu2list[5/8 5^(-5), 38,125, 125,25],5],-5]

lp3gm=Take[RichardsonTransform[mu2list[5/8 5^(-5), $gmax-4,125, 125,25],19],-5]

N[mu2[5/8*5^(-5), 85,85, 1,-200],25]

N[mu2[5/8*5^(-5), 65,65, 1,-200],25]

nmu2ex[5/8*5^(-5), 100,100, -200,25]

z=15/16*5^(-5)

lp4g38=Take[RichardsonTransform[mu2list[15/16 5^(-5), 38,100, 150,25],5],-5]

lp4g38={0.00432972889553833790213434608790305142067286596606240381067214906717182368295368855880693647626`70.31596793057814,0.004329728890756440125501091492046773035151707560862323805574196535543435690903330941972964804558`70.23324005654946,0.004329728886287159298417126838586529297280857540892894404337494452083543950401435165635406940651`70.15307414137128,0.00432972888218865046014304551063111267133953870098048773344108320862176484188504519832411652999`70.07531516036408,0.004329728878477203815474056958653218769937632783981029982416601236107985835676964747558476643888`69.99982185862036}

lp4gm=Take[RichardsonTransform[mu2list[15/16 5^(-5), $gmax-4,100, 150,25],18],-5]

lp4gm={0.00432972884810563434811019655191752639836254845838622829869601882151296760515`62.77182911045579,0.00432972884803818437054605849879066384951506911283164538090142744675723315046`62.43000935264641,0.00432972884800506714231082520023695597366758993808100111435294356760275926535`62.102458466212674,0.00432972884798833869693374688361394354289299388580743314085801306049073919734`61.787982241885025,0.00432972884797992802844295619152197070293151936534206806786467226712445815815`61.48553583432056}

lp4gm[[5]]-lp4g38[[5]]

nmu2ex[15/16*5^(-5), 100,150, 1,-200]

nmu2ex[15/16*5^(-5), 100,150, -200,25]

NNNLO

mu3list[y_, d_, χ_,orderc_, orderLR_,prec_]:=Table[(2i)(2i-1)/ action[y,orderc]^2(((action[y,orderc]^(2i+1) nlistFz[y,d+1,orderLR,prec][[i]])/(Gamma[2i+1]))-mu1[y,orderc, orderLR]-mu2[y,orderc, orderLR, 1, χ]action[y,orderc]/(2i)),{i,1,d}];

mu3conj[y_, orderlr_, orderc_, χ_]:=1/(2 Pi^2)Exp[1/2 Daction[y, orderc]^2(SzzLR[y, orderlr]-Szzc[y, orderc])-Daction[y, orderc]action[y, orderc] (tSzLR[y, orderlr]-tSzc[y, orderc])+ action[y, orderc]^2 (tSLR[y, orderlr]-tSc[y, orderc])]*((1/1152)(-96 ((action[y,orderc])^6) ((Cz[y])^2) Daction[y,orderc] (-Szzc[y,orderc]+SzzLR[y,orderlr]) (((-tSzc[y,orderc]+tSzLR[y,orderlr]))^5)+16 ((action[y,orderc])^7) ((Cz[y])^2) (((-tSzc[y,orderc]+tSzLR[y,orderlr]))^6)+48 ((Daction[y,orderc])^3) (-Szzc[y,orderc]+SzzLR[y,orderlr]) (24 fz[y] (-Szzc[y,orderc]+SzzLR[y,orderlr])+4 Cz[y] (-Szzc[y,orderc]+SzzLR[y,orderlr]) (3 Szzc[y,orderc]+5 (-Szzc[y,orderc]+SzzLR[y,orderlr])+((Daction[y,orderc])^2) (((-Szzc[y,orderc]+SzzLR[y,orderlr]))^2))+(-24+χ) (-tSzc[y,orderc]+tSzLR[y,orderlr]))+16 ((action[y,orderc])^5) (((-tSzc[y,orderc]+tSzLR[y,orderlr]))^3) (((15 (-3+12500 y) (-tSzc[y,orderc]+tSzLR[y,orderlr]))/((((1-3125 y))^2) (y^4)))+15 ((Cz[y])^2) (SzzLR[y,orderlr]+((Daction[y,orderc])^2) (((-Szzc[y,orderc]+SzzLR[y,orderlr]))^2)) (-tSzc[y,orderc]+tSzLR[y,orderlr])+Cz[y] ((-24+χ) (-tSc[y,orderc]+tSLR[y,orderlr])+12 fz[y] (-tSzc[y,orderc]+tSzLR[y,orderlr])-9 sz3[y] (-tSzc[y,orderc]+tSzLR[y,orderlr])))+action[y,orderc] ((Daction[y,orderc])^2) (((48 (107-668750 y+1093750000 (y^2)) (((-Szzc[y,orderc]+SzzLR[y,orderlr]))^2))/(5 (((1-3125 y))^2) (y^2)))+576 ((fz[y])^2) (((-Szzc[y,orderc]+SzzLR[y,orderlr]))^2)+576 h2z[y] (((-Szzc[y,orderc]+SzzLR[y,orderlr]))^2)-24 χ h2z[y] (((-Szzc[y,orderc]+SzzLR[y,orderlr]))^2)+((1440 (-3+12500 y) Szzc[y,orderc] (((-Szzc[y,orderc]+SzzLR[y,orderlr]))^2))/((((1-3125 y))^2) (y^4)))+((1440 (-3+12500 y) (((-Szzc[y,orderc]+SzzLR[y,orderlr]))^3))/((((1-3125 y))^2) (y^4)))+((240 (-3+12500 y) ((Daction[y,orderc])^2) (((-Szzc[y,orderc]+SzzLR[y,orderlr]))^4))/((((1-3125 y))^2) (y^4)))+16 ((Cz[y])^2) (45 ((SzzLR[y,orderlr])^2) (((-Szzc[y,orderc]+SzzLR[y,orderlr]))^2)+15 ((Daction[y,orderc])^2) SzzLR[y,orderlr] (((-Szzc[y,orderc]+SzzLR[y,orderlr]))^4)+((Daction[y,orderc])^4) (((-Szzc[y,orderc]+SzzLR[y,orderlr]))^6))+2304 (-Szzc[y,orderc]+SzzLR[y,orderlr]) (-tSc[y,orderc]+tSLR[y,orderlr])-96 χ (-Szzc[y,orderc]+SzzLR[y,orderlr]) (-tSc[y,orderc]+tSLR[y,orderlr])+2304 (((-tSzc[y,orderc]+tSzLR[y,orderlr]))^2)-120 χ (((-tSzc[y,orderc]+tSzLR[y,orderlr]))^2)+(χ^2) (((-tSzc[y,orderc]+tSzLR[y,orderlr]))^2)-48 fz[y] (-Szzc[y,orderc]+SzzLR[y,orderlr]) (12 sz3[y] (-Szzc[y,orderc]+SzzLR[y,orderlr])-(-72+χ) (-tSzc[y,orderc]+tSzLR[y,orderlr]))+8 Cz[y] (-Szzc[y,orderc]+SzzLR[y,orderlr]) (36 h3z[y] (-Szzc[y,orderc]+SzzLR[y,orderlr])-108 sz3[y] Szzc[y,orderc] (-Szzc[y,orderc]+SzzLR[y,orderlr])-108 sz3[y] (((-Szzc[y,orderc]+SzzLR[y,orderlr]))^2)-18 ((Daction[y,orderc])^2) sz3[y] (((-Szzc[y,orderc]+SzzLR[y,orderlr]))^3)+24 fz[y] (-Szzc[y,orderc]+SzzLR[y,orderlr]) (6 SzzLR[y,orderlr]+((Daction[y,orderc])^2) (((-Szzc[y,orderc]+SzzLR[y,orderlr]))^2))+3 χ (-Szzc[y,orderc]+SzzLR[y,orderlr]) tSzc[y,orderc]-216 Szzc[y,orderc] (-tSzc[y,orderc]+tSzLR[y,orderlr])+3 χ Szzc[y,orderc] (-tSzc[y,orderc]+tSzLR[y,orderlr])-360 (-Szzc[y,orderc]+SzzLR[y,orderlr]) (-tSzc[y,orderc]+tSzLR[y,orderlr])+6 χ (-Szzc[y,orderc]+SzzLR[y,orderlr]) (-tSzc[y,orderc]+tSzLR[y,orderlr])-120 ((Daction[y,orderc])^2) (((-Szzc[y,orderc]+SzzLR[y,orderlr]))^2) (-tSzc[y,orderc]+tSzLR[y,orderlr])+χ ((Daction[y,orderc])^2) (((-Szzc[y,orderc]+SzzLR[y,orderlr]))^2) (-tSzc[y,orderc]+tSzLR[y,orderlr])))-8 ((action[y,orderc])^4) Daction[y,orderc] (((-tSzc[y,orderc]+tSzLR[y,orderlr]))^2) ((1/((((1-3125 y))^2) (y^4)))120 (-3+12500 y) (-Szzc[y,orderc]+SzzLR[y,orderlr]) (-tSzc[y,orderc]+tSzLR[y,orderlr])+40 ((Cz[y])^2) (-Szzc[y,orderc]+SzzLR[y,orderlr]) (3 SzzLR[y,orderlr]+((Daction[y,orderc])^2) (((-Szzc[y,orderc]+SzzLR[y,orderlr]))^2)) (-tSzc[y,orderc]+tSzLR[y,orderlr])+Cz[y] (6 (-24+χ) (-Szzc[y,orderc]+SzzLR[y,orderlr]) (-tSc[y,orderc]+tSLR[y,orderlr])+96 fz[y] (-Szzc[y,orderc]+SzzLR[y,orderlr]) (-tSzc[y,orderc]+tSzLR[y,orderlr])-72 sz3[y] (-Szzc[y,orderc]+SzzLR[y,orderlr]) (-tSzc[y,orderc]+tSzLR[y,orderlr])+(-48+χ) (((-tSzc[y,orderc]+tSzLR[y,orderlr]))^2)))+4 ((action[y,orderc])^3) (1152 (((-tSc[y,orderc]+tSLR[y,orderlr]))^2)-72 χ (((-tSc[y,orderc]+tSLR[y,orderlr]))^2)+(χ^2) (((-tSc[y,orderc]+tSLR[y,orderlr]))^2)+((12 (107-668750 y+1093750000 (y^2)) (((-tSzc[y,orderc]+tSzLR[y,orderlr]))^2))/(5 (((1-3125 y))^2) (y^2)))+144 ((fz[y])^2) (((-tSzc[y,orderc]+tSzLR[y,orderlr]))^2)+144 h2z[y] (((-tSzc[y,orderc]+tSzLR[y,orderlr]))^2)-6 χ h2z[y] (((-tSzc[y,orderc]+tSzLR[y,orderlr]))^2)+((360 (-3+12500 y) Szzc[y,orderc] (((-tSzc[y,orderc]+tSzLR[y,orderlr]))^2))/((((1-3125 y))^2) (y^4)))+(1/((((1-3125 y))^2) (y^4)))360 (-3+12500 y) (-Szzc[y,orderc]+SzzLR[y,orderlr]) (((-tSzc[y,orderc]+tSzLR[y,orderlr]))^2)+(1/((((1-3125 y))^2) (y^4)))360 (-3+12500 y) ((Daction[y,orderc])^2) (((-Szzc[y,orderc]+SzzLR[y,orderlr]))^2) (((-tSzc[y,orderc]+tSzLR[y,orderlr]))^2)+60 ((Cz[y])^2) (3 ((SzzLR[y,orderlr])^2)+6 ((Daction[y,orderc])^2) SzzLR[y,orderlr] (((-Szzc[y,orderc]+SzzLR[y,orderlr]))^2)+((Daction[y,orderc])^4) (((-Szzc[y,orderc]+SzzLR[y,orderlr]))^4)) (((-tSzc[y,orderc]+tSzLR[y,orderlr]))^2)-24 fz[y] (-tSzc[y,orderc]+tSzLR[y,orderlr]) (-((-24+χ) (-tSc[y,orderc]+tSLR[y,orderlr]))+6 sz3[y] (-tSzc[y,orderc]+tSzLR[y,orderlr]))+6 Cz[y] (-tSzc[y,orderc]+tSzLR[y,orderlr]) (2 (-24+χ) (SzzLR[y,orderlr]+((Daction[y,orderc])^2) (((-Szzc[y,orderc]+SzzLR[y,orderlr]))^2)) (-tSc[y,orderc]+tSLR[y,orderlr])+(12 h3z[y]-36 sz3[y] Szzc[y,orderc]-36 sz3[y] (-Szzc[y,orderc]+SzzLR[y,orderlr])-36 ((Daction[y,orderc])^2) sz3[y] (((-Szzc[y,orderc]+SzzLR[y,orderlr]))^2)+48 fz[y] (SzzLR[y,orderlr]+((Daction[y,orderc])^2) (((-Szzc[y,orderc]+SzzLR[y,orderlr]))^2))+χ tSzc[y,orderc]) (-tSzc[y,orderc]+tSzLR[y,orderlr])+(-16+χ+(-56+χ) ((Daction[y,orderc])^2) (-Szzc[y,orderc]+SzzLR[y,orderlr])) (((-tSzc[y,orderc]+tSzLR[y,orderlr]))^2)))-4 ((action[y,orderc])^2) Daction[y,orderc] (288 ((fz[y])^2) (-Szzc[y,orderc]+SzzLR[y,orderlr]) (-tSzc[y,orderc]+tSzLR[y,orderlr])+24 ((Cz[y])^2) (-Szzc[y,orderc]+SzzLR[y,orderlr]) (15 ((SzzLR[y,orderlr])^2)+10 ((Daction[y,orderc])^2) SzzLR[y,orderlr] (((-Szzc[y,orderc]+SzzLR[y,orderlr]))^2)+((Daction[y,orderc])^4) (((-Szzc[y,orderc]+SzzLR[y,orderlr]))^4)) (-tSzc[y,orderc]+tSzLR[y,orderlr])+(-12 (-24+χ) h2z[y] (-Szzc[y,orderc]+SzzLR[y,orderlr])+48 (-Szzc[y,orderc]+SzzLR[y,orderlr]) (((107-668750 y+1093750000 (y^2))/(10 (((1-3125 y))^2) (y^2)))+(1/((((1-3125 y))^2) (y^4)))5 (-3+12500 y) (3 SzzLR[y,orderlr]+((Daction[y,orderc])^2) (((-Szzc[y,orderc]+SzzLR[y,orderlr]))^2)))+(1728-96 χ+(χ^2)) (-tSc[y,orderc]+tSLR[y,orderlr])) (-tSzc[y,orderc]+tSzLR[y,orderlr])+12 fz[y] (2 (-24+χ) (-Szzc[y,orderc]+SzzLR[y,orderlr]) (-tSc[y,orderc]+tSLR[y,orderlr])-24 sz3[y] (-Szzc[y,orderc]+SzzLR[y,orderlr]) (-tSzc[y,orderc]+tSzLR[y,orderlr])+(-48+χ) (((-tSzc[y,orderc]+tSzLR[y,orderlr]))^2))+2 Cz[y] (2 (-24+χ) (-Szzc[y,orderc]+SzzLR[y,orderlr]) (3 SzzLR[y,orderlr]+((Daction[y,orderc])^2) (((-Szzc[y,orderc]+SzzLR[y,orderlr]))^2)) (-tSc[y,orderc]+tSLR[y,orderlr])+6 (-Szzc[y,orderc]+SzzLR[y,orderlr]) (12 h3z[y]-36 sz3[y] Szzc[y,orderc]-36 sz3[y] (-Szzc[y,orderc]+SzzLR[y,orderlr])-12 ((Daction[y,orderc])^2) sz3[y] (((-Szzc[y,orderc]+SzzLR[y,orderlr]))^2)+16 fz[y] (3 SzzLR[y,orderlr]+((Daction[y,orderc])^2) (((-Szzc[y,orderc]+SzzLR[y,orderlr]))^2))+χ tSzc[y,orderc]) (-tSzc[y,orderc]+tSzLR[y,orderlr])+3 ((-48+χ) Szzc[y,orderc]+3 (-32+χ) (-Szzc[y,orderc]+SzzLR[y,orderlr])+(-72+χ) ((Daction[y,orderc])^2) (((-Szzc[y,orderc]+SzzLR[y,orderlr]))^2)) (((-tSzc[y,orderc]+tSzLR[y,orderlr]))^2)))));

z=1/3*5^(-5)

lp6g38=Take[RichardsonTransform[mu3list[1/3*5^(-5),38, -200, 100,100,10],5],-5]

lp6gm=Take[RichardsonTransform[mu3list[1/3*5^(-5),$gmax-4, -200, 100,100,10],5],-5]

N[mu3conj[1/3*5^(-5), 100, 100,-200],15]

nmu3ex[1/3*5^(-5), 100,100, -200,25]

z=1/2*5^(-5)

lp7g38=Take[RichardsonTransform[mu3list[1/2*5^(-5),38, -200, 100,100,10],5],-5]

lp7g38=Take[RichardsonTransform[mu3list[1/2*5^(-5),$gmax-4, -200, 100,100,10],5],-5]

N[mu3conj[1/2*5^(-5), 100, 100,-200],15]

nmu3ex[1/2*5^(-5), 100,100, -200,25]

lp8g38=Take[RichardsonTransform[mu3list[1/2*5^(-5),38, -200, 100,100,10],20],-5]-mu3conj[1/2*5^(-5), 100, 100,-200]

lp8gm=Take[RichardsonTransform[mu3list[1/2*5^(-5),$gmax-4, -200, 100,100,10],20],-5]-mu3conj[1/2*5^(-5), 100, 100,-200]

z=5/8*5^(-5)

lp9g38=Take[RichardsonTransform[mu3list[5/8*5^(-5),38, -200, 100,100,10],15],-5]

lp9gm=Take[RichardsonTransform[mu3list[5/8*5^(-5),$gmax-4, -200, 100,100,10],15],-5]

lp10g38=Take[RichardsonTransform[mu3list[5/8*5^(-5),38, -200, 100,100,10],20],-5]

lp10g38=Take[RichardsonTransform[mu3list[5/8*5^(-5),$gmax-4, -200, 100,100,10],20],-5]

N[mu3conj[5/8*5^(-5), 100, 100,-200],15]

nmu3ex[5/8*5^(-5), 100,100, -200,25]

l11g38=Take[RichardsonTransform[mu3list[5/8*5^(-5),38, -200, 100,100,10],20],-5]-mu3conj[5/8*5^(-5), 100, 100,-200]

l11gm=Take[RichardsonTransform[mu3list[5/8*5^(-5),$gmax-4, -200, 100,100,10],20],-5]-mu3conj[5/8*5^(-5), 100, 100,-200]

z=15/16*5^(-5)

l12g38=Take[RichardsonTransform[mu3list[15/16*5^(-5),38, -200, 100,100,10],15],-5]

l12gm=Take[RichardsonTransform[mu3list[15/16*5^(-5),$gmax-4, -200, 100,100,10],15],-5]

l12g38=Take[RichardsonTransform[mu3list[15/16*5^(-5),38, -200, 100,100,10],20],-5]

l12gm=Take[RichardsonTransform[mu3list[15/16*5^(-5),$gmax-4, -200, 100,100,10],20],-5]

N[mu3conj[15/16*5^(-5), 100, 100,-200],15]

nmu3ex[15/16*5^(-5), 120,100, -200,25]

nmu3ex[15/16*5^(-5), 120,120, -200,25]

impr=Table[nmu3ex[15/16*5^(-5), 120,5*i, -200,25],{i, 1, 30}];

ListPlot[{impr,RichardsonTransform[impr,1]}]

Take[RichardsonTransform[mu3list[15/16*5^(-5),38, -200, 100,100,10],20],-5]-mu3conj[15/16*5^(-5), 100, 100,-200]

Behavior near large radius

Near large radius, the dominating action is the “Kahler action” corresponding to LRaction[y,n]. The first list gives the leading asymptotics, the second 
list is the leading + subleading asymptotics

LRaction[y_,n_]:=2 Pi w0[z, n]T[z,n]/.z->y;
nmu1list[y_, d_, orderLR_,prec_]:=Table[(2 Pi^2) (LRaction[y,orderLR])^(2i) ((nnlistFz[y,d+1,orderLR,prec][[i]])/(Gamma[2i+1])),{i,1,d}];
nmu1listsub[y_, d_, orderLR_,prec_]:=Table[(2 Pi^2) (LRaction[y,orderLR])^(2i) ((nnlistFz[y,d+1,orderLR,prec][[i]])/(Gamma[2i+1](1+1/(2i)))),{i,1,d}];

Predicted oscillatory behavior

thetan[y_,n_]:=ArcTan[2 Pi/T[z,n]]/.z->y;nmu1listosc[y_, d_, orderLR_]:=Table[ 2(LRaction[y,orderLR])^(2i)(LRaction[y,orderLR]^2  + 16  Pi^4  w0[y, orderLR]^2)^(-i)Cos[2 i thetan[y,orderLR]],{i,1,d}];
oscillation[i_, y_,orderLR_]:=2(LRaction[y,orderLR])^(2i)(LRaction[y,orderLR]^2  + 16  Pi^4  w0[y, orderLR]^2)^(-i)Cos[2 i thetan[y,orderLR]];
thetan2[y_,n_]:=ArcTan[2*2 Pi/T[z,n]]/.z->y;
oscillation2[i_, y_,orderLR_]:=2(LRaction[y,orderLR])^(2i)(LRaction[y,orderLR]^2  + 4*16  Pi^4  w0[y, orderLR]^2)^(-i)Cos[2 i thetan2[y,orderLR]];

N[thetan[10^(-5), 65]]

z=10^(-5)

Sum[(ℏ^(2n+2))(( nnlistFz[10^(-5),25, 65,35][[n]])/((2n+2)!)),{n,1,25}];
PadeApproximant[%,{ℏ,0,{24,24}}];
li={Re[#],Im[#]}&/@(ℏ/.NSolve[0==1/%,ℏ]);
ListPlot[%, AspectRatio->Automatic,PlotRange->{{-130,130},{-50,50}}, PlotStyle->{PointSize[Large], Red}]

N[LRaction[10^(-5), 65],10]

The LR action is smaller than the conifold action, and the numerics indicates convergence towards the LR action

Take[1/nquot[10^(-5),38,65,25]^(1/2),-5]

By subtracting the leading asymptotics, we find a sequence which oscillates mildly around 2875

ListPlot[{nmu1list[10^(-5),38,65,35],Table[2875,{i,1, 38}]},PlotStyle->{{PointSize[0.015], Red},{PointSize[0.01], Black}}, Joined->{False, True} , PlotRange->All]

ListPlot[{nmu1list[10^(-5),$gmax-4,65,35],Table[2875,{i,1, $gmax-4}]},PlotStyle->{{PointSize[0.015], Red},{PointSize[0.01], Black}}, Joined->{False, True} , PlotRange->All]

By subtracting 2875 we get just the oscillations. This does not include 1/g corrections

ListPlot[{nmu1list[10^(-5),38,65,35]-2875, 2875*nmu1listosc[10^(-5),38,65]},PlotStyle->{{PointSize[0.015], Red},{PointSize[0.01], Black}}, Joined->{False, True}, PlotRange->{-100, 200} ]

ListPlot[{nmu1list[10^(-5),$gmax-4,65,35]-2875, 2875*nmu1listosc[10^(-5),$gmax-4,65]},PlotStyle->{{PointSize[0.015], Red},{PointSize[0.01], Black}}, Joined->{False, True}, PlotRange->{-100, 200} ]

By including 1/g corrections we match perfectly the oscillatory part

ListPlot[{nmu1listsub[10^(-5),38,65,35]-2875, 2875*nmu1listosc[10^(-5),38,65]},PlotStyle->{{PointSize[0.015], Red},{PointSize[0.01], Black}}, Joined->{False, True}, PlotRange->{-100, 200} ]

ListPlot[{nmu1listsub[10^(-5),$gmax-4,65,35]-2875, 2875*nmu1listosc[10^(-5),$gmax-4,65]},PlotStyle->{{PointSize[0.015], Red},{PointSize[0.01], Black}}, Joined->{False, True}, PlotRange->{-100, 200} ]

Show[Plot[2875 oscillation[i, 10^(-5),65],{i,1, 38},PlotStyle->{ Red}, PlotRange->{-100, 200} ],ListPlot[nmu1listsub[10^(-5),38,65,35]-2875,PlotStyle->{PointSize[0.018], Black}, PlotRange->{-100, 200} ]]

Show[Plot[2875 oscillation[i, 10^(-5),65],{i,1, $gmax-4},PlotStyle->{ Red}, PlotRange->{-100, 200} ],ListPlot[nmu1listsub[10^(-5),$gmax-4,65,35]-2875,PlotStyle->{PointSize[0.018], Black}, PlotRange->{-100, 200} ]]

Export["oscillations.pdf", %95]

A sequence that converges to the Stokes constant can be obtained by subtracting the oscillatory part. Here, the subleading term in 1/g is not included 
and it makes sense to use a Richardson transform

z=10^(-5)

ListPlot[{nmu1list[10^(-5),38,75,110]-2875*nmu1listosc[10^(-5),38,75],RichardsonTransform[nmu1list[10^(-5),38,75,110]-2875*nmu1listosc[10^(-5),38,75],1],Table[2875, {i,1, 38}]},PlotStyle->{{PointSize[0.015], Red},{PointSize[0.015], Blue},{PointSize[0.010], Black}} ]//Quiet

ListPlot[{nmu1list[10^(-5),$gmax-4,75,110]-2875*nmu1listosc[10^(-5),$gmax-4,75],RichardsonTransform[nmu1list[10^(-5),$gmax-4,75,110]-2875*nmu1listosc[10^(-5),$gmax-4,75],1],Table[2875, {i,1, $gmax-4}]},PlotStyle->{{PointSize[0.015], Red},{PointSize[0.015], Blue},{PointSize[0.010], Black}} ]//Quiet

Take[nmu1list[10^(-5),38,75,110]-2875*nmu1listosc[10^(-5),38,75],-5]//Quiet

Take[RichardsonTransform[nmu1list[10^(-5),38,75,110]-2875*nmu1listosc[10^(-5),38,75],1],-5]//Quiet

The result improves dramatically by including the subleading correction in 1/g in the asymptotics. Here, Richardson transforms are not useful since there are no further subleading 1/g corrections

ListPlot[{nmu1listsub[10^(-5),38,75,110]-2875*nmu1listosc[10^(-5),38,75],Table[2875,{i,1, 38}]},PlotStyle->{{PointSize[0.015], Red},{PointSize[0.010], Black}} , Joined->{False, True}]//Quiet

ListPlot[{nmu1listsub[10^(-5),$gmax-4,75,110]-2875*nmu1listosc[10^(-5),$gmax-4,75],Table[2875,{i,1, $gmax-4}]},PlotStyle->{{PointSize[0.015], Red},{PointSize[0.010], Black}} , Joined->{False, True}]//Quiet

Export["2875.pdf", %79]

Take[nmu1listsub[10^(-5),38,75,110]-2875*nmu1listosc[10^(-5),38,75],-5]//Quiet

2875.00000000061796181997084937974258261243`28.10591669157187-2875

Take[nmu1listsub[10^(-5),$gmax-4,75,110]-2875*nmu1listosc[10^(-5),$gmax-4,75],-5]//Quiet

z=10^(-6)

ListPlot[{nmu1list[10^(-6),38,65,25], Table[2875,{i,1, 38}]},PlotStyle->{{PointSize[0.015], Red},{PointSize[0.01], Black}}, Joined->{False, True} , PlotRange->All]

z=10^(-7)

N[2875*LRaction[10^(-7),65]/(2 Pi^2),10]

ListPlot[{nmu1list[10^(-7),38,65,25], Table[2875,{i,1, 38}]},PlotStyle->{{PointSize[0.015], Red},{PointSize[0.01], Black}}, Joined->{False, True} , PlotRange->All]

z=10^(-8)

Sum[(ℏ^(2n+2))(( nnlistFz[10^(-8),32, 65,55][[n]])/((2n+2)!)),{n,1,32}]; 
PadeApproximant[%,{ℏ,0,{32,32}}];
li={Re[#],Im[#]}&/@(ℏ/.NSolve[0==1/%,ℏ]);
ListPlot[%, AspectRatio->Automatic,PlotRange->{{-150,150},{-60,60}}, PlotStyle->{PointSize[Large], Red}]

Show[%371, Graphics[{PointSize[Large],Black,Point[{N[LRaction[10^(-8), 65]],0}]}] ,Graphics[{PointSize[Large],Black,Point[{N[LRaction[10^(-8), 65]],4 Pi^2}]}] ]

ListPlot[{nmu1list[10^(-8),38,65,25], Table[2875,{i,1, 38}]},PlotStyle->{{PointSize[0.015], Red},{PointSize[0.01], Black}}, Joined->{False, True} , PlotRange->All]

ListPlot[{nmu1list[10^(-8),38,65,25]-2875,2875*nmu1listosc[10^(-8),38,65]},PlotStyle->{{PointSize[0.015], Red},{PointSize[0.01], Black}}, Joined->{False, True} ]

ListPlot[{nmu1list[10^(-8),$gmax-4,65,25]-2875,2875*nmu1listosc[10^(-8),$gmax-4,65]},PlotStyle->{{PointSize[0.015], Red},{PointSize[0.01], Black}}, Joined->{False, True} ]

ListPlot[{nmu1listsub[10^(-8),38,65,25]-2875,2875*nmu1listosc[10^(-8),38,65]},PlotStyle->{{PointSize[0.015], Red},{PointSize[0.01], Black}}, Joined->{False, True} ]

ListPlot[{nmu1listsub[10^(-8),$gmax-4,65,25]-2875,2875*nmu1listosc[10^(-8),$gmax-4,65]},PlotStyle->{{PointSize[0.015], Red},{PointSize[0.01], Black}}, Joined->{False, True} ]

ListPlot[{nmu1list[10^(-8),38,65,25]-2875,2875*nmu1listosc[10^(-8),38,65]},PlotStyle->{{PointSize[0.015], Red},{PointSize[0.01], Black}}, Joined->{False, True}, PlotRange->{-500, 500} ]

ListPlot[{nmu1listsub[10^(-8),38,65,25]-2875,2875*nmu1listosc[10^(-8),38,65]},PlotStyle->{{PointSize[0.015], Red},{PointSize[0.01], Black}}, Joined->{False, True} , PlotRange->{-500, 500}]

$MaxExtraPrecision = 200.`;ListPlot[nmu1listsub[10^(-8),38,75,110]-2875*nmu1listosc[10^(-8),38,75]-2875,PlotStyle->{PointSize[0.015], Red}, PlotRange->{-200, 200} ]

Plot[2875  oscillation2[i, 10^(-8),75],{i, 1, 38}, PlotRange->{-200, 200}]

Show[%134,%135]

Take[nmu1listsub[10^(-8),38,75,110]-2875*nmu1listosc[10^(-8),38,75],-5]

sim[g_]:=FullSimplify[1/(I a )^(2g-2)+ Sum[1/(2 Pi n  -I a )^(2 g-2)+1/(2 Pi n  +I a )^(2 g-2),{n,1, Infinity}]-(-1)^(g-1) PolyLog[3-2g, Exp[-a]]/(2g-3)!, Assumptions->a>0];

sim[4]

L0

$Riemann

MatrixForm[Chop[$TM["c1"]/5^5]]
TransitionMatrices[100]

Chop[$TM["c1"][[1,2]]]/Sqrt[5]/(2Pi)^2/5^5

Useful Routines for other purposes

TransitionMatrices[ord_]:=
Block[{hi},
$namecriticalpoints=Map[#[[2,1]]&,$Riemann ];
Do[$TM[$namecriticalpoints[[i1+1]]]=N[$TM[$namecriticalpoints[[i1]]].(T1=ϖ[$criticalpoints[[i1]],ord]/.z->N[$args[[i1,1]],ord]).Inverse[ϖ[$criticalpoints[[i1+1]],ord]/.z->N[$args[[i1,2]],ord]],Floor[ord/3]],{i1,1,Length[$args]}]]
IntegerMonodromy[name_]:=($MoI[name]=Rationalize[Chop[$TM[name].$Mol[name].Inverse[$TM[name]]],10^(-Floor[ord/10])])
$MoL["c1"]=(({{1, 0, 0, 0}, {0, 1, 0, 0}, {0, 2π I, 1, 0}, {0, 0, 0, 1}}));$Mol["o1"]=(({{(E^(2π I(1/5) )), 0, 0, 0}, {0, (E^(2π I(2/5) )), 0, 0}, {0, 0, (E^(2π I(3/5) )), 0}, {0, 0, 0, (E^(2π I(4/5) ))}}));
IntegerMonodromy[name_]:=($MoI[name]=Rationalize[Chop[$TM[name].$Mol[name].Inverse[$TM[name]]],10^(-Floor[ord/10])])
(*Π[p_]:=Which[p≤ (1/(2 (5^5))),(Subscript[T, 0]).ϖ[0,ord]/.z->N[p,ord],p≤ ((1+(Sqrt[5]))/6250),(Subscript[T, (1/(5^5))]).(ϖ[(1/(5^5)),ord]/.z->N[p,ord]),True,(Subscript[T, ∞]).(ϖ[∞,ord]/.z->N[p,ord])]*)

Compare with Thorstens program

<<"/Users/aklemm/Documents/P-adicCY3foldsdoc/Fg/DataOneparameter/Ff/dataX5(11111)genus12Ffts"

dsc=ss[1]
GetFreeEnergy[fts_,g_]:=Module[{},Return[dsc^(2-2g)fts/.{S2p[z]->S2[z]/z^2,S1p[z]->tS1[z] dsc/z,S0p[z]->tS0[z]dsc^2}]]
Collect[GetFreeEnergy[Ffts[2],2],{S2[z],tS1[z],tS0[z]},Together[#]&]
Collect[GetFreeEnergy[Ff[2],2],{S2[z],tS1[z],tS0[z]},Together[#/.Cf[z]->Czzz]&]

GapCondition[fts_,genus_,p_,ar_,unam_]:=Module[{sols,facz,tmp,uc},
makepropspn[p,2genus-2,ar,1,genus];
facz=κ^(genus-1) ((Subscript[gauge2, p]))^(genus-1)(Subscript[dscp, p])^(2-2genus);
tmp=((fts/.a__[z]->a)+Factor[dsc^(2genus-2)ambz[$mod,genus]]/.rv[p]);
tmp=Collect[tmp,{S2p,S1p,S0p}];
tmp=tmp/.(Subscript[repSP, p]);
tmp=Series[sp[$mod,p]^(genus-1)Series[((ccF[genus]((Subscript[qs, p])/p)^(2-2genus))),{(Subscript[z, p]),0,-1}]-Series[facz tmp,{(Subscript[z, p]),0,-1}],{(Subscript[z, p]),0,-1}];
If[ConiExtension[$mod,p]==1||genus==2,
tmp=(#[[2]]&/@CoefficientRules[Expand[z^(2genus-2)Normal[tmp/.(Subscript[z, p])->z]],{z}]);,
tmp=Join@@Table[CoefficientList[Coefficient[Expand[z^(2genus-2)Normal[tmp/.(Subscript[z, p])->z]]//Factor//Numerator,ConiExtension[$mod,p],i],z],{i,0,1}];
];
sols=Solve[tmp==0,unam][[1]];
Return[sols];
]



GetFreeEnergy[fts_,g_]:=Module[{},Return[dsc^(2-2g)fts/.{S2p[z]->S2[z]/z^2,S1p[z]->tS1[z] dsc/z,S0p[z]->tS0[z]dsc^2}];];
Timing[Fs[p,genus]=Series[Normal[κ^(genus-1) ($gauge2q[p])^(genus-1)repq[p,(F[genus]/.a_[z]:>a) +ambz[genus]/.rv[p]/.$repS[p]]]/.q->s μ,{s,0,no}]][[1]]]

LargeVolume[fts_,genus_,p_,ar_]:=Module[{fac,tmp},
makepropspn[0,$ord,ar,1,genus];
fac=((Subscript[gauge2q, p]))^(genus-1)(Subscript[dscpq, p])^(2-2genus);
tmp=((fts/.a__[z]->a)+Factor[dsc^(2genus-2)ambz[$mod,genus]]/.rv[p]);
tmp=Collect[tmp,{S2p,S1p,S0p}];
tmp=repq[p,tmp/.(Subscript[repSP, p])];
Fs[$mod,0,genus]=Expand[fac tmp/.(Subscript[q, p])->q];

Ff[genus]=Ff[genus]+Cfform[ambz[genus]];
loesCN[genus]=loesCN[genus]/.ngd[a__]:>Ngd[a];
Fs[0,genus]=Fs[0,genus]/.loesamb[genus];
Fs[μ,genus]=Simplify[Fs[μ,genus]/.loesamb[genus]];
Do[ngd[genus,dk]=(ngd[genus,dk]/.loesamb[genus]),{dk,1,deg}];
Print[MatrixForm[Table[ngd[g,d],{d,1,deg},{g,genus,genus}]]];
loesamb[genus]=Select[loesamb[genus],Head[#[[1]]]===a&];
Print["Absolute time ", $timetest[genus]=AbsoluteTime[]-$starttime];

unam=Join[Table[a[i,1],{i,0,2genus-3}],Table[a[i,0],{i,0,$anhpz[genus]}]];
Print["Anzahl der Unbekannten   ", Length[unam],"   nach gap conditions   ",Length[unam]-(2 genus-2)];
If[genus<6,Print["Ansatz Ambiguity ", ambzans[genus]]];
Print["dir int step", $timedirint[genus]= Timing[Ff[genus]=dirint[genus];]];
(* The Fs[μ,g] series at conifold*)
p=μ;
Print[" make props at conifold and calculate the series   ",$timeconifold[genus]= Timing[ Fs[p,genus]=serFfp[Ff[genus],p,genus,(2 genus-2)]+
$gauge2[p]^(genus-1)(ambzans[genus]/.z-> Series[z/.rv[p],{z,0,2genus-2}])][[1]]];
(* gap condition *)
Print[" solving gap condition  ", Timing[loesamb[genus]=Flatten[Solve[Series[Fs[p,genus]-(cser=ccF[genus](1/($qs[p]/μ))^(2 genus-2)(1/κ)^(genus-1)),{z,0,-1}]==0,unam]]][[1]]];
Print["Unbekannte nach gap =  ",Length[unaml=Select[unam/.loesamb[genus],!FreeQ[#,a]&]]];
ambz[genus]=Simplify[ambzans[genus]/.loesamb[genus]];
p=0;

Print[" solving gap condition  ", Timing[loesambt[genus]=Flatten[Solve[Series[Fs[p,genus]-(cser=ccF[genus](1/($qs[p]/μ))^(2 genus-2)(1/κ)^(genus-1)),{z,0,-1}]==0,unam]]][[1]]];

setmod[{5}]
fixpropamb[4,{x->x}]

Factor[rall/.un[1][0]->-1]

$rallinf[{5}]={saudd-> -8/5}

$mod

fixpropamb[12,{saudd->-1}]

fixpropamb[12,$rallinf[$mod]]

?CYPeriodMatrix

wr[m_,n_]:=D[X[0][z],{z,m}] D[X[1][z],{z,n}]- D[X[0][z],{z,n}] D[X[1][z],{z,m}]
wrs[m_,n_,no_]:=Block[{hi},CYPeriodMatrix[L0,0,1,no];
Series[(D[X[0][z],{z,m}] D[X[1][z],{z,n}]- D[X[0][z],{z,n}] D[X[1][z],{z,m}])/.Derivative[a__][X[b__]][z]:>$PM[0,no][[b+1,a+1]]/.X[b__][z]:>$PM[0,no][[b+1,1]],{z,0,no}]]

t=X[1][z]/X[0][z];
Szz=-1/C[z] (Together[D[t,{z,2}]/D[t,z]+2 D[X[0][z],z]/X[0][z]]-audd[z])
tsz=Simplify[(D[Szz,z]-Szz^2 C[z]+ 2 audd[z] Szz-auud[z])/2]
K[z]=-Log[X[0][z]]
dKz=D[K[z],z]
tSz=Simplify[-1/C[z](D[dKz,z]-dKz^2+Szz C[z] dKz-audd[z] dKz-add[z])]

makepropsp[0,12,rall,1,1]

(*test Szz *)
testS2=-(wr[2,0]/wr[1,0]-audd[z])/C[z]
Series[testS2/.C[z]->Czzz/.Derivative[a__][X[b__]][z]:>$PM[0,10][[b+1,a+1]]/.X[b__][z]:>$PM[0,10][[b+1,1]]/.audd[z]->(audd/.$rall[0]),{z,0,10}]
S2/.$repS[0]

tsz

(*test tSz *)
testtS1=-(wr[2,1]/wr[1,0]-add[z])/C[z]
Series[testtS1/.C[z]->Czzz/.Derivative[a__][X[b__]][z]:>$PM[0,10][[b+1,a+1]]/.X[b__][z]:>$PM[0,10][[b+1,1]]/.audd[z]->(audd/.$rall[0])/.add[z]->(add/.$rall[0]),{z,0,10}]
Series[tSz/.C[z]->Czzz/.Derivative[a__][X[b__]][z]:>$PM[0,10][[b+1,a+1]]/.X[b__][z]:>$PM[0,10][[b+1,1]]/.audd[z]->(audd/.$rall[0])/.add[z]->(add/.$rall[0]),{z,0,10}]
Series[tsz/.C[z]->Czzz/.Derivative[a__][C][z]:>D[Czzz,{z,a}]/.Derivative[a__][X[b__]][z]:>$PM[0,10][[b+1,a+1]]/.X[b__][z]:>$PM[0,10][[b+1,1]]/.auud[z]->(auud/.$rall[0])/.audd[z]->(audd/.$rall[0])/.Derivative[a__][audd][z]:>D[audd/.$rall[0],{z,a}]/.add[z]->(add/.$rall[0])/.aud[z]->(aud/.$rall[0]),{z,0,10}]
tS1/.$repS[0]

((2 z)/125)-26 (z^2)-11400 (z^3)-17091600 (z^4)-33454104000 (z^5)-74101482794400 (z^6)-176377032163867200 (z^7)-440072731186280088000 (z^8)-1135173673054830888240000 (z^9)-3001609061165759192921400000 (z^10)+((O[z])^11)

t4+t5+Simplify[t1+t2+t3]

(* test tS0 *)
testtS0=(D[C[z],z]/C[z])(wr[2,1]/wr[1,0]-add[z])/(2 C[z])-(wr[3,1]/wr[1,0]-D[add[z],z]-add[z] audd[z])/(2 C[z])-aud[z]/2
Series[testtS0/.C[z]->Czzz/.Derivative[a__][C][z]:>D[Czzz,{z,a}]/.Derivative[a__][X[b__]][z]:>$PM[0,10][[b+1,a+1]]/.X[b__][z]:>$PM[0,10][[b+1,1]]/.audd[z]->(audd/.$rall[0])/.Derivative[a__][add][z]:>D[add/.$rall[0],{z,a}]/.add[z]->(add/.$rall[0])/.aud[z]->(aud/.$rall[0]),{z,0,10}]
Series[t4+t5+Simplify[t1+t2+t3]/.C[z]->Czzz/.Derivative[a__][C][z]:>D[Czzz,{z,a}]/.Derivative[a__][X[b__]][z]:>$PM[0,10][[b+1,a+1]]/.X[b__][z]:>$PM[0,10][[b+1,1]]/.audd[z]->(audd/.$rall[0])/.Derivative[a__][add][z]:>D[add/.$rall[0],{z,a}]/.add[z]->(add/.$rall[0])/.aud[z]->(aud/.$rall[0]),{z,0,10}]
tS0/.$repS[0]

tS=Simplify[1/2(D[tSz,z]-C[z] Szz tSz+audd[z] tSz+add[z] Szz-aud[z])]

(*Simplify[1/2(D[tSz,z]-C[z] Szz tSz+audd[z] tSz+add[z] Szz-aud[z])/.audd[z]->0/.add[z]->0/.D[C[z],z]->0/.aud[z]->0/.D[add[z],z]->0]
Simplify[1/2(D[tSz,z]-C[z] Szz tSz+audd[z] tSz+add[z] Szz-aud[z])/.aud[z]->0]
Simplify[Coefficient[ex=1/2(D[tSz,z]-C[z] Szz tSz+audd[z] tSz+add[z] Szz-aud[z]),add[z]]]
Coefficient[Numerator[Simplify[ex]],C'[z]]*)

$fl[0][[1]]

Szz

atS0=-((-audd+((-X[1][z] (X[0])''[z]+X[0][z] (X[1])''[z])/(-X[1][z] (X[0])'[z]+X[0][z] (X[1])'[z])))/(C[z]))

atS0=-((-D[X[1][z],z] D[X[0][z],{z,3}]+D[X[0][z],z] D[X[1][z],{z,3}]+h)/((C[z]) (-X[1][z] (X[0])'[z]+X[0][z] (X[1])'[z])))

tSz

$rall[0]

Series[Szz/.C[z]->Czzz/.Derivative[a__][X[b__]][z]:>$PM[0,10][[b+1,a+1]]/.X[b__][z]:>$PM[0,10][[b+1,1]]/.audd[z]->(audd/.$rall[0]),{z,0,10}]

Series[tSz/.C[z]->Czzz/.Derivative[a__][X[b__]][z]:>$PM[0,10][[b+1,a+1]]/.X[b__][z]:>$PM[0,10][[b+1,1]]/.audd[z]->(audd/.$rall[0])/.add[z]->(add/.$rall[0]),{z,0,10}]

tsz
t1=Simplify[C[z]^2 Coefficient[Numerator[tsz],C[z],2]/Denominator[tsz]]
t2=Simplify[C[z] audd[z]^2 Coefficient[Coefficient[Numerator[tsz],C[z],1],audd[z],2]/Denominator[tsz]]
t3=Simplify[C[z] D[audd[z],z] Coefficient[Coefficient[Numerator[tsz],C[z],1],D[audd[z],z],1]/Denominator[tsz]]
t4=Simplify[D[C[z],z] Coefficient[Coefficient[Numerator[tsz],D[C[z],z],1],D[audd[z],{z,0}],0]/Denominator[tsz]]
t5=Simplify[D[C[z],z] audd[z] Coefficient[Coefficient[Numerator[tsz],D[C[z],z],1],D[audd[z],{z,0}],1]/Denominator[tsz]]

Simplify[tsz-t1-t2-t3-t4-t5]

t2=Simplify[C[z] audd[z]^2 Coefficient[Coefficient[Numerator[tsz],C[z],1],audd[z],2]/Denominator[tsz]]

tS

t1=Simplify[C[z]^2 Coefficient[Numerator[tS],C[z],2]/Denominator[tS]]

t2=Simplify[add[z]  Coefficient[Numerator[tS],add[z],1]/Denominator[tS]]

t3=Simplify[D[add[z],z] C[z] Coefficient[Coefficient[Numerator[tS],C[z],1],D[add[z],z],1]/Denominator[tS]]

wr[m_,n_]:=D[X[0][z],m] D[X[1][z],n]- D[X[0][z],n] D[X[1][z],m]

t4=Simplify[D[C[z],z]Coefficient[Coefficient[Numerator[tS],D[C[z],z],1],add[z],0]/Denominator[tS]]

t5=Simplify[C[z] Coefficient[Coefficient[Coefficient[Numerator[tS],C[z],1],add[z],0], D[add[z],z],0]/Denominator[tS]]

t4+t5+Simplify[t1+t2+t3]

atS0

atS0=-((h-D[X[1][z],{z,1}] D[X[0][z],{z,3}]+D[X[0][z],{z,1}] D[X[1][z],{z,3}])/((C[z]) (-X[1][z] (X[0])'[z]+X[0][z] (X[1])'[z])))

$ord=40
test=Series[atS0/.C[z]->Czzz/.Derivative[a__][X[b__]][z]:>$PM[0,$ord+4][[b+1,a+1]]/.X[b__][z]:>$PM[0,$ord+4][[b+1,1]]/.audd[z]->(audd/.$rall[0]),{z,0,$ord}];

test

?$repS;

$oe=$ord-28;
on=9;
od=2;
unk=Join[Table[a[i],{i,0,on}],Table[b[i],{i,1,od}]]
tt1=Series[test/.h->(a[0]+Sum[a[i] z^i,{i,1,on}])/z^3(1+Sum[b[i] z^i,{i,1,od}]),{z,0,$oe}];
Solve[eqs=(tt1==Series[(-tS0/.$repS[0]),{z,0,$oe}]),unk]

Solve[eqs=(tt1==Series[(tS0/.$repS[0]),{z,0,$oe}]),unk]

eqs

{{b->}}

$rall[0]

atS0

tS0/.$repS[0]

FullForm[Szz]

Szz

$rall[0]

$mode={5}
setmod[$mod]
fixpropamb[4,{x->x}]

makepropsp[0,40,rall,1,1]

MatrixForm[$fl[0]]

MatrixForm[Simplify[CYPeriodMatrix[L0,0,1,1]]]

D[$fl[0][[2]],{z,2}]

ϖ

?

$PM[0,10][[1,1]]

$ord=4
CYPeriodMatrix[L0,0,1,$ord];
test01=Series[z wr[0,1]/.Derivative[a__][X[b__]][z]:>$PM[0,$ord][[b+1,a+1]]/.X[b__][z]:>$PM[0,$ord][[b+1,1]],{z,0,$ord}]
test02=Series[z wr[1,2]/.Derivative[a__][X[b__]][z]:>$PM[0,$ord][[b+1,a+1]]/.X[b__][z]:>$PM[0,$ord][[b+1,1]],{z,0,$ord}]

Clear[p,θ]
$mm=2;
$nn=5;
PF[z][test,Sum[(Subscript[p, m,n])(z^m)(θ^n),{m,0,$mm},{n,0,$nn}]];
CoefficientList[%,z,$ord-1]//Solve[#==0,Flatten[Table[(Subscript[p, m,n]),{m,0,$mm},{n,0,$nn}]]]&;
L5=ReplaceAll[Sum[(Subscript[p, m,n])(z^m)(θ^n),{m,0,$mm},{n,0,$nn}],Flatten[%]]//Collect[#,θ,Factor]&
%/.z->0//Factor

Coefficient[L5/.(Subscript[p, 0,5])->1,z,0]
Factor[Coefficient[L5/.(Subscript[p, 0,5])->1,z,1]]
Factor[Coefficient[L5/.(Subscript[p, 0,5])->1,z,2]]

$ord=24
FastMinors[2][CYPeriodMatrix[L0,0,1,$ord]];
TestMinorFast2=%+((O[z])^($ord+1))//Collect[#,Log[z],Expand]&;

TestMinorFast2[[2]]

$ord=12
FastMinors[2][Transpose[CYPeriodMatrix[L0,0,1,$ord]]];
TestMinorFast2=%+((O[z])^($ord+1))//Collect[#,Log[z],Expand]&;
Print["Maximaler log: ",Max[Exponent[%,Log[z],Max]]]
TestMinorFast2+((O[z])^6)//Collect[#,Log[z],Expand]&//TableForm

p

Relation to 4-folds

Funktionen

ΘD[t_]:=t D[#,t]&;
ΘDm[t_,m_]:=Module[{hi},
hi=#;
Do[hi=ΘD[t][hi],{k,0,m-1}];
hi]&;
PF[t_]:=Module[{hi},
hi=CoefficientList[#2,θ];
Expand[hi[[1]]#1+Sum[hi[[$n+1]]*Sum[StirlingS2[$n,$k](t^$k)D[#1,{t,$k}],{$k,1,$n}],{$n,1,Length[hi]-1}]]]&;
ThetaPF[f_,t_]:=Module[{hi,maxdiff,khilf},
hi=#;
maxdiff=Max[Cases[hi*khilf,Derivative[order_][f][t]:>order/.khilf->1,Infinity]];
maxdiff=If[maxdiff==-∞,0,maxdiff];
ReplaceAll[hi,Table[D[f[t],{t,n}]->(1/(t^n))Product[θ-k,{k,0,n-1}],{n,0,maxdiff}]]//Expand]&;
TransformToSingularity[z_,x_]:=Module[{hi,max},
hi=#;
max=Exponent[hi,θ,Max];
hi=PF[z][f[z],hi]/.z->z+x/.Table[D[f[x+z],{z,k}]->D[f[z],{z,k}],{k,0,max}]//Together;
hi=ThetaPF[f,z][hi]//Together//Numerator;
hi]&;

ΘD1[t_]:=t D[#,t]&;
ΘD1m[t_,m_]:=Module[{hi},
hi=#;
Do[hi=ΘD1[t][hi],{k,0,m-1}];
hi]&;
Diffoptheta[LList__]:=Module[{hi,hii},
hii=LList;
hi=ReplaceAll[#2,Table[hii[[i]]->(Subscript[XX, i]),{i,Length[hii]}]]*#1;
Do[hi=CoefficientList[hi,(Subscript[θ, l])];
hi=Sum[ΘD1m[hii[[l]],k-1][hi[[k]]],{k,1,Length[hi]}],{l,1,Length[hii]}];
ReplaceAll[hi,Table[(Subscript[XX, i])->hii[[i]],{i,Length[hii]}]]]&;
ThetaDiffop[f,LList__]:=Module[{hi,hii,maxdiff,khilf,listehilf},
hi=#;
hii=LList//Length;
maxdiff=Max[Cases[hi*khilf,Derivative[order__][f]@@LList:>order/.khilf->1,Infinity]];
maxdiff=If[maxdiff==-∞,0,maxdiff];
listehilf=Flatten[Table[D[f@@LList,Sequence@@Table[{LList[[j]],(Subscript[n, j])},{j,1,hii}]]->Product[(1/((LList[[i]])^(Subscript[n, i])))Product[((Subscript[θ, i])-r),{r,0,(Subscript[n, i])-1}],{i,1,hii}],Evaluate[Sequence@@Table[{(Subscript[n, k]),0,maxdiff},{k,1,hii}]]]];
ReplaceAll[hi,listehilf]//Expand]&;

SingPoints[ll_]:=Table[(((ll+1-2k))^2),{k,0,Ceiling[((ll-1)/2)]}]//Sort;

Mein Minor berechnet etwas anderes (falsches) als Fast Minor.

MeinMinor[LList__]:=Module[{hi},
hi=#;
Do[hi=Delete[hi,LList[[kk]]-(kk-1)];
hi=Transpose[Delete[Transpose[hi],LList[[kk]]-(kk-1)]],{kk,Length[LList]}];
hi//Det]&;

AllMinors[nn_]:=Module[{hi,ll,subsets},
hi=#;
ll=Length[hi];
subsets=Drop[Subsets[Table[ii,{ii,ll}]],1];
subsets=Table[If[Length[subsets[[ii]]]==nn,subsets[[ii]],0],{ii,Length[subsets]}]//DeleteCases[#,0]&;
Table[MeinMinor[subsets[[ii]]][hi],{ii,Length[subsets]}]]&;

FastMinors[nn_]:=Module[{hi,ll,subsets},
hi=#;
ll=Length[hi];
subsets=Drop[Subsets[Table[ii,{ii,ll}]],1];
subsets=Table[If[Length[subsets[[ii]]]==nn,subsets[[ii]],0],{ii,Length[subsets]}]//DeleteCases[#,0]&;
hi=Table[Det[hi[[;;Length[ivec],ivec]]]//Expand,{ivec,subsets}];
hi]&;

L0

$modllist={{5},{6},{8},{10},{3,3},{4,2},{3,2,2},{2,2,2,2},{4,3},{6,2},{4,4},{6,4},{6,6},{12,2}}

TestMinorFast2;

ex2

ex3

μ

L0

$end=Length[$modllist]
$end=14
Do[$mod=$modllist[[ki]];
setmod[$mod];
L4[$mod]=Collect[L0,z,Factor[#]&];
$ord=20;
ex1=FastMinors[2][Transpose[CYPeriodMatrix[L0,0,1,$ord]]];
TestMinorFast2=ex1+((O[z])^($ord+1))//Collect[#,Log[z],Expand]&;
$mm=2;
$nn=5;
ex2=PF[z][z TestMinorFast2[[1]],Sum[(Subscript[p, m,n])(z^m)(θ^n),{m,0,$mm},{n,0,$nn}]];
ex3=CoefficientList[ex2,z,$ord-1]//Solve[#==0,unp=Flatten[Table[(Subscript[p, m,n]),{m,0,$mm},{n,0,$nn}]]]&;
L5[$mod]=ReplaceAll[Sum[(Subscript[p, m,n])(z^m)(θ^n),{m,0,$mm},{n,0,$nn}],Flatten[ex3]]//Collect[#,θ,Factor]&;
L5[$mod]/.z->0//Factor;
Print[L5[$mod]=Collect[L5[$mod]/.Map[#->1&,unp],z,Factor[#] &]];
Print[disc[$mod]=Factor[Coefficient[L5[$mod],θ,5]]],{ki,1,$end}]

L5[{5}]
L5[{6}]

L5[{2,2,2,2}]

Factor[Coefficient[L4[{2,2,2,2}],z]]

L4[{10}]

$as

1/μ  (θ+1) Product[θ+(2-$as[[i]]),{i,1,4}]

16 2^4

L0

wts

1500/625

5^5

5 625

}

Factor[Coefficient[L5[$mod],θ,5]]

Collect[L5[$mod]/.Map[#->1&,unp],z,Factor[#] &]

?Collect

Map[#->1&,unp]

setmod[{5}]

?wrs

L5[{5}]

$PM[0,10][[1,1]]

D[wrs[0,1,10],{z,1}]

wrs[0,2,10]

$mod={5}
setmod[$mod]
L4[$mod]
L5[$mod]
$as

Factor[1/μ^2 Product[θ+i/6,{i,3,7}]]

$wts

$as

$as+$as[[1]]