Plot[{2.5l^2-1.6Sin[Pi/3-ArcSin[1/2l]],2l(0.64-l^2)},{l,0.5,0.8}]

NSolve[2.5l^2-1.6Sin[Pi/3-ArcSin[1/2l]]==2l(0.64-l^2)]

NSolve[(2.5l^2-1.6Sin[Pi/3-ArcSin[1/2l]])^2/4/(l^2-0.64)+(1-25l^2/16)==0]

Plpot[(2.5l^2-1.6Sin[Pi/3-ArcSin[1/2l]])^2/4/(l^2-0.64)+(1-25l^2/16),{l,0.5,0.8}]

(2.75*0.8+1)/4

MinCos[gm_]:= If[gm>5Pi/6 && gm<7Pi/6,-1,Min[Cos[gm-Pi/6],Cos[gm+Pi/6]]]

MaxCos[gm_]:=If[gm<Pi/6 || gm>11Pi/6,1,Max[Cos[gm-Pi/6],Cos[gm+Pi/6]]]

Plot[{MinCos[gm],MaxCos[gm]},{gm,0,2Pi}]

Plot[(l^2/0.8*MaxCos[gm]-0.8MinCos[gm])/(0.8^2-l^2)/.{l->0.71},{gm,0,2Pi}]

NSolve[(l^2/0.8*MaxCos[gm]-0.8MinCos[gm])/(0.8^2-l^2)==2.75/.{l->0.71}]

3.445800416419704+2.8373848907598824-2Pi

((1-l^2/0.8^2)+(0.8^2-l^2)*k^2-2k(l^2/0.8*MaxCos[gm]-0.8MinCos[gm]))/.{l->0.71,gm->0.51,k->2.75}

(* NORM ESTIMATE |\Dl| ge l old redundant *)

MaxQ[a_,b_,c_,d_]:=If[-b/(2a)<d,a d^2+b d+c,-b^2/(4 a)+c]/; a<0

Fct[a_,l_]:={MaxQ[l^2-a^2,2l^2/a-a (Sqrt[3(4l^2-1)]-1)/(2l),(l/a)^2-1,l],
MaxQ[l^2-a^2,2a-l(Sqrt[10(16l^2-1)/3]-Sqrt[2/3])/(4a),(l/a)^2-1,4-1/l]}

Plot[Fct[0.85,l],{l,0.5,0.85}]

beta[l_]:=ArcSin[1/(2l*Sqrt[16l^2+1-4Sqrt[4l^2-1]])]

Plot[beta[l],{l,0.5,1}]

beta[l_]:= ArcSin[2*Sqrt[8/81]/Sqrt[16l^2+1-8l*7/9]]

Plot[beta[l],{l,0.5,1}]

Fct[a_,l_]:={MaxQ[l^2-a^2,2l^2/a-a (Sqrt[8(4l^2-1)]-1)/(3l),(l/a)^2-1,l],
MaxQ[l^2-a^2,2a-2l^2(Sqrt[8/9]*Cos[beta[l]]-Sqrt[1/9]*Sin[beta[l]])/(a),(l/a)^2-1,4-1/l]}

Plot[Fct[0.85,l],{l,0.51,0.85}]

Plot[{ArcSin[1/2l],ArcCos[1/4l]},{l,0.5,1}]

Fct[0.85,0.61]

(* END NORM ESTIMATE |\Dl|\ge l *)

(* stuff for Lemma 2.1 *)
g:=D[Cos[ap]^(1/ap),{ap,2}];
Plot[g/.{ap->a},{a,0,1.23}]

(* test (cos ap)^1/ap ≥1-ap/2+ap^2/4 *)

(* delta of section 2 ≤ 3Pi/4 *)

Plot[{Sqrt[1/4+x-x^2]-1/2,Sqrt[-x^2-2x+7-4Sqrt[-2x+3]]},{x,0,1}]

Simplify[Sqrt[1/4+x-x^2]-1/2-Sqrt[-x^2-2x+7-4Sqrt[-2x+3]]≥0,0≤x≤1]

(Pi/4+ArcSin[1/Sqrt[6]])*2./5

Simplify[1/4+x-x^2  +1/4-Sqrt[1/4+x-x^2]>=-x^2-2x+7-4Sqrt[-2x+3],0≤x≤1]

Simplify[64(3-2x)≥1+4x-4x^2,0≤x≤1]

Simplify[64(3-2x)+1+4x-4x^2-16Sqrt[(3-2x)*(1+4x-4x^2)]≥(13-6x)^2]

Simplify[-5x^2+4 x+3≥0,0≤x≤1]

Simplify[Expand[(-5x^2+4 x+3)^2-4(3+10 x-20 (x^2)+8 (x^3))]≥0,0≤x≤1]

Plot[Expand[(-5x^2+4 x+3)^2-4(3+10 x-20 (x^2)+8 (x^3))],{x,0,1}]

(* end delta of section 2 ≤ 3Pi/4 *)

Plot[{Sin[3al/2]/Sin[3al/2+ArcCos[Sqrt[4/24]]-ArcSin[1/3]],Sqrt[6/4]Sin[al]/Sin[al+ArcSin[1/3]]},{al,0.4823,Pi/3}]

Plot[Cos[x]/Cos[x+0.55],{x,0,2Pi}]

f[x_]:=Sqrt[-x^2-2x+7-4Sqrt[-2x+3]]

al[x_]:=ArcTan[f[x]/x]

bt1[x_]:=ArcSin[Sqrt[5/6]]-ArcTan[f[x]/(1-x)]

Plot[Sin[3al[x]/2]/Sin[bt1[x]+3al[x]/2]-Sqrt[3/2]*Sin[al[x]]/Sin[ArcSin[Sqrt[5/6]]-bt1[x]+al[x]],{x,1/9,1}]

(* upper arc *)

Plot[{Cos[al]+3Sin[al],1/(1-al/2+al^2/4)^(23Pi/12)},{al,0,1.3}]

Plot[{Cos[al]+3Sin[al],1/(1-al/2+al^2/4)^(23Pi/12)},{al,0.015,0.13}]

g:=D[1/(1-al/2+al^2/4)^(23Pi/12),al];
Plot[{g/.{al->a},-Sin[a]+3Cos[a]},{a,0,1.23}]

Plot[{g/.{al->a},-Sin[a]+3Cos[a]},{a,0,0.03}]

(* NSolve[Cos[al]+3Sin[al]==1/(1-al/2+al^2/4)^(23Pi/12)] - don't try that! *)

NSolve[(2-y)Sin[bt-ArcCos[(3-y^2)/2/(2-y)]]==1.5(1-Cos[ArcCos[1/3]+Pi/4-bt+ArcCos[(3-y^2)/2/(2-y)]])(y-1)Sqrt[2]/.{bt->Pi/12}]

ArcCos[(3-y^2)/2/(2-y)]/.{y->1.0671760258350662`}

Plot[{Cos[al]+3Sin[al],1/(1-al/2+al^2/4)^(11Pi/6)},{al,0.06,1.3}]

Plot[{Cos[al]+3Sin[al],1/(1-al/2+al^2/4)^(11Pi/6)},{al,0.06,0.13}]

NSolve[(2-y)Sin[bt-ArcCos[(3-y^2)/2/(2-y)]]==1.5(1-Cos[ArcCos[1/3]+Pi/4-bt+ArcCos[(3-y^2)/2/(2-y)]])(y-1)Sqrt[2]/.{bt->Pi/6}]

ArcCos[(3-y^2)/2/(2-y)]/.{y->1.138550249824842`}

Plot[{Cos[al]+3Sin[al],1/(1-al/2+al^2/4)^(5Pi/3)},{al,0.14,1.3}]

Plot[{Cos[al]+3Sin[al],1/(1-al/2+al^2/4)^(5Pi/3)},{al,0.14,.23}]

NSolve[(2-y)Sin[bt-ArcCos[(3-y^2)/2/(2-y)]]==1.5(1-Cos[ArcCos[1/3]+Pi/4-bt+ArcCos[(3-y^2)/2/(2-y)]])(y-1)Sqrt[2]/.{bt->Pi/3}]

ArcCos[(3-y^2)/2/(2-y)]/.{y->1.2896247613700633`}

Plot[{Cos[al]+3Sin[al],1/(1-al/2+al^2/4)^(7Pi/5)},{al,0.34,1.3}]

Plot[{Cos[al]+3Sin[al],1/(1-al/2+al^2/4)^(7Pi/5)},{al,0.34,.43}]

NSolve[(2-y)Sin[bt-ArcCos[(3-y^2)/2/(2-y)]]==1.5(1-Cos[ArcCos[1/3]+Pi/4-bt+ArcCos[(3-y^2)/2/(2-y)]])(y-1)Sqrt[2]/.{bt->3Pi/5}]

ArcCos[(3-y^2)/2/(2-y)]/.{y->1.5230204354638972`}

Plot[{Cos[al]+3Sin[al],1/(1-al/2+al^2/4)^(4Pi/3)},{al,0.77,1.3}]

NSolve[(2-y)Sin[bt-ArcCos[(3-y^2)/2/(2-y)]]==1.5(1-Cos[ArcCos[1/3]+Pi/4-bt+ArcCos[(3-y^2)/2/(2-y)]])(y-1)Sqrt[2]/.{bt->2Pi/3}]

ArcCos[(3-y^2)/2/(2-y)]/.{y->1.573209405718236`}

Plot[{(2-y)Sin[bt-ArcCos[(3-y^2)/2/(2-y)]],1.5(1-Cos[ArcCos[1/3]+Pi/4-bt+ArcCos[(3-y^2)/2/(2-y)]])(y-1)Sqrt[2]}/.{bt->2Pi/3},{y,1,5/3}]

N[Pi/4]

(* ADDED STUFF OF CASE 1.2.1 (20) AND 1.2.2  *)

Plot[{(2-y)Sin[3ArcCos[(3-y^2)/2/(2-y)]],1.5(1+Cos[3ArcCos[(3-y^2)/2/(2-y)]]/3-Sqrt[8]Sin[3ArcCos[(3-y^2)/2/(2-y)]]/3)*Sqrt[2]*(y-1)},{y,1,5/3}]

Plot[{(2-y)Sin[3ArcCos[(3-y^2)/2/(2-y)]],1.5(1+Cos[3ArcCos[(3-y^2)/2/(2-y)]]/3-Sqrt[8]Sin[3ArcCos[(3-y^2)/2/(2-y)]]/3)*Sqrt[2]*(y-1)},{y,1,1.01}]

FindRoot[(2-y)Sin[3ArcCos[(3-y^2)/2/(2-y)]]-1.5(1+Cos[3ArcCos[(3-y^2)/2/(2-y)]]/3-Sqrt[8]Sin[3ArcCos[(3-y^2)/2/(2-y)]]/3)*Sqrt[2]*(y-1),{y,1.55}]

ArcCos[(3-y^2)/2/(2-y)]/.%

Plot[{(2-y)Sin[3ArcCos[(3-y^2)/2/(2-y)]],1.5(1+Cos[3ArcCos[(3-y^2)/2/(2-y)]]*(Sqrt[.5]-2)/3-(Sqrt[.5]+2)Sin[3ArcCos[(3-y^2)/2/(2-y)]]/3)*Sqrt[2]*(y-1)},{y,1,5/3}]

Plot[{(2-y)Sin[3ArcCos[(3-y^2)/2/(2-y)]],1.5(1+Cos[3ArcCos[(3-y^2)/2/(2-y)]]*(Sqrt[.5]-2)/3-(Sqrt[.5]+2)Sin[3ArcCos[(3-y^2)/2/(2-y)]]/3)*Sqrt[2]*(y-1)},{y,1,1.01}]

FindRoot[(2-y)Sin[3ArcCos[(3-y^2)/2/(2-y)]]-1.5(1+Cos[3ArcCos[(3-y^2)/2/(2-y)]]*(Sqrt[.5]-2)/3-(Sqrt[.5]+2)Sin[3ArcCos[(3-y^2)/2/(2-y)]]/3)*Sqrt[2]*(y-1),{y,1.55}]

ArcCos[(3-y^2)/2/(2-y)]/.{y->1.48}

(* end upper arc *)

(* lower arc does not touch {theta= -3ap/2, -5ap/2,...} *)

MinCos[a_]:=If[-Sin[a+Pi/2]<=0 && -Sin[a+3Pi/4]≥0,-1,Min[Cos[a+Pi/2],Cos[a+3Pi/4]]]

Plot[{Sin[5ArcCos[(3-y^2)/2/(2-y)] /2]*(2-y) ,-3/2*MinCos[5ArcCos[(3-y^2)/2/(2-y)] /2+ArcSin[1/3]]*Sqrt[2]*(y-1)},{y,1,5/3}]

FindRoot[Sin[5ArcCos[(3-y^2)/2/(2-y)] /2]*(2-y)+3/2*MinCos[5ArcCos[(3-y^2)/2/(2-y)] /2+ArcSin[1/3]]*Sqrt[2]*(y-1),{y,1.2}]

NSolve[ArcCos[(3-y^2)/2/(2-y)]==Pi/4]

{(Pi/4-ArcSin[1/3])*0.4,(Pi/2ArcSin[1/3])*0.4}

ArcCos[(3-y^2)/2/(2-y)]/.{y->1.2}

NSolve[Sin[5ArcCos[(3-y^2)/2/(2-y)] /2]*(2-y)==3/2*Sin[5ArcCos[(3-y^2)/2/(2-y)] /2+ArcSin[1/3]]*Sqrt[2]*(y-1)]

{Sin[5ArcCos[(3-y^2)/2/(2-y)] /2]*(2-y) ,-3/2*MinCos[5ArcCos[(3-y^2)/2/(2-y)] /2+ArcSin[1/3]]*Sqrt[2]*(y-1)}/.{y->1.2}

?Arg

Plot[ComplexExpand[Arg[(1-z^3)/(1-z^2)/.{z->x+I Sqrt[x-x^2]}]],{x,0,1}]

f[x_]:=Sqrt[-x^2-2x+7-4Sqrt[-2x+3]];
Plot[ComplexExpand[Arg[(1-z^3)/(1-z^2)/.{z->x+I f[x]}]],{x,0,1}]

Plot3D[ComplexExpand[Arg[(1-z^3)/(1-z^2)/.{z->x+I y}]],{x,1/9,1},{y,f[x],Sqrt[x-x^2]}]

Plot3D[ComplexExpand[Arg[(1-z^4)/(1-z^3)/.{z->x+I y}]],{x,1/9,1},{y,f[x],Sqrt[x-x^2]}]

?Plot

MyArg[a_+I b_]:= Abs[b/a]; Maximize[MyArg[ComplexExpand[(1-z^3)/(1-z^2)/.{z->x+I y}]],{0≤x≤1,f[x]≤y≤Sqrt[x-x^2]},{x,y}]

N[Out[27]]

N[Maximize[MyArg[ComplexExpand[(1-z^4)/(1-z^3)/.{z->x+I y}]],{0≤x≤1,f[x]≤y≤Sqrt[x-x^2]},{x,y}]]

N[Maximize[MyArg[ComplexExpand[(1-z^5)/(1-z^4)/.{z->x+I y}]],{0≤x≤1,f[x]≤y≤Sqrt[x-x^2]},{x,y}]]//Timing

Plot[{Sin[7ArcCos[(3-y^2)/2/(2-y)] /2]*(2-y) ,-3/2*MinCos[7ArcCos[(3-y^2)/2/(2-y)] /2+ArcSin[1/3]]*Sqrt[2]*(y-1)},{y,1.2,1.5266}]

Plot3D[ComplexExpand[Arg[(1-z^5)/(1-z^4)/.{z->x+I y}]],{x,1/9,1},{y,f[x],Sqrt[x-x^2]}]

Plot[{Sin[9ArcCos[(3-y^2)/2/(2-y)] /2]*(2-y) ,-3/2*MinCos[9ArcCos[(3-y^2)/2/(2-y)] /2+ArcSin[1/3]]*Sqrt[2]*(y-1)},{y,1.31,1.51}]

(* end lower arc does not touch {theta= -3ap/2, -5ap/2,...} *)

(* |\ap_n|\ge 0.85 *)

R[al_,b_]:=Sqrt[1+(Cos[al]Sin[al]/(Cos[al]^2-b^2))^2]/; b<Cos[al]

r[al_,b_]:=b Sin[al]/(Cos[al]^2-b^2)

Gm[al_,b_]:=ArcTan[Cos[al]Sin[al]/(Cos[al]^2-b^2)]

F[al_,b_,th_]:=R[al,b]Cos[th-Gm[al,b]]-Sqrt[r[al,b]^2-R[al,b]^2*Sin[th-Gm[al,b]]^2]

Plot[{Cos[al]^((2Pi-th)/al),F[al,0.85,th]}/.{al->0.002},{th,0,Pi/100}]

Plot[{2Pi-al Log[Cos[al],F[al,b,Gm[al,b]]]-Gm[al,b],ArcSin[r[al,b]/R[al,b]]}/.{b->0.85},{al,0,ArcTan[Sqrt[8]]}]

FindRoot[2Pi-al Log[Cos[al],F[al,b,Gm[al,b]]]-Gm[al,b]==ArcSin[r[al,b]/R[al,b]]/.{b->0.85},{al,0.034}]

Plot[{Nest[2Pi-al Log[Cos[al],F[al,b,#]]&,Gm[al,b],1]-Nest[2Pi-al Log[Cos[al],F[al,b,#]]&,Gm[al,b],0],ArcSin[r[al,b]/R[al,b]]}/.{b->0.85},{al,0,ArcTan[Sqrt[8]]}]

Plot[{Nest[2Pi-al Log[Cos[al],F[al,b,#]]&,Gm[al,b],2]-Nest[2Pi-al Log[Cos[al],F[al,b,#]]&,Gm[al,b],1],Nest[2Pi-al Log[Cos[al],F[al,b,#]]&,Gm[al,b],2]-Gm[al,b]-ArcSin[r[al,b]/R[al,b]]}/.{b->0.85},{al,0.052423546149187816,ArcTan[Sqrt[8]]}]

(* END |\ap_m|\ge 0.85 *)

(* |\ap_n|\le 1.5 n\ge 3 *)

(* test that A_z\supset A_Z' when Re 1/z=1 *)

(* P 76,77 of block - hasn't proved useful *)

nw[k_]:=Sqrt[1+k^2]; nwp[k_,th_]:=Sqrt[1+k^2+2k Sin[th]];
Lw[b_,k_]:= b*nw[k]/(b^2 nw[k]^2-1); Lwp[b_,k_,th_]:= b*nwp[k,th]/(b^2 nwp[k,th]^2-1);
lw[b_,k_]:= 1/(b^2 nw[k]^2-1); lwp[b_,k_,th_]:= 1/(b^2 nwp[k,th]^2-1);
Df[b_,k_,th_]:=(Lw[b,k]-Lwp[b,k/2,th])^2-lw[b,k]^2-lwp[b,k/2,th]^2+2Cos[th]lw[b,k]lwp[b,k/2,th]

Df[b,k,th]

D[Df[b,k,th],{th,2}];

D[Df[b,k,th],th]

%/.{th->0}

Plot3D[Df[b,k,th]/.{b->1.5},{k,0,0.7},{th,0,Pi/4}]

(* Lemma 2.4 *)

R[al_,b_]:=Sqrt[1+(Cos[al]Sin[al]/(Cos[al]^2-b^2))^2]/; b>Cos[al]

r[al_,b_]:=-b Sin[al]/(Cos[al]^2-b^2)/; b>Cos[al]

Gm[al_,b_]:=ArcTan[-Cos[al]Sin[al]/(Cos[al]^2-b^2)]/; b>Cos[al]

F[al_,b_,th_]:=R[al,b]Cos[th-Gm[al,b]]-Sqrt[r[al,b]^2-R[al,b]^2*Sin[th-Gm[al,b]]^2]

Plot[{Cos[al]^((2Pi+th)/al),F[al,1.5,th]}//.{al->0.02},{th,0,0.12}]

Plot[F[al,1.5,th]//.{al->0.002},{th,-.2,0.2}]

(* equality 34 *)

gmzero[b_,m_]:=ArcCos[1/(m-1)/(b-1)];

Plot[{ArcSin[r[al,1.5]/R[al,1.5]]+Gm[al,1.5],gmzero[1.5,4]},{al,0,0.2}]

(* derivatives have proved unneeded now *)

D[ArcSin[r[al,1.5]/R[al,1.5]]-Gm[al,1.5],al]

Plot[Out[9],{al,0.0,0.3}] (* must be less than 3 *)

(* this finished |ap_m|le 1.5 *)

Plot[{-2Pi+al Log[Cos[al],F[al,b,Gm[al,b]]]-Gm[al,b],-ArcSin[r[al,b]/R[al,b]]}/.{b->1.5},{al,0,ArcTan[Sqrt[8]]}]

(* again, derivatives have proved unneeded now *)

D[ArcSin[r[al,1.2]/R[al,1.2]]-Gm[al,1.2],al]

Plot[Out[16],{al,0.0,0.3}](* must be less than 6 *)

(* now the bound 1.2 for m\ge 6 *)

gmzero[1.2,6.001]

Plot[{ArcSin[r[al,1.2]/R[al,1.2]]+Gm[al,1.2],gmzero[1.2,8]},{al,0,0.2}]

FindRoot[ArcSin[r[al,b]/R[al,b]]+Gm[al,b]-gmzero[b,8]/.{b->1.2},{al,0.15}]

Plot[{-2Pi+al Log[Cos[al],F[al,b,Gm[al,b]]]-Gm[al,b],-ArcSin[r[al,b]/R[al,b]]}/.{b->1.2},{al,0,ArcTan[Sqrt[8]]}]

(* ok, so works for |\ap_n|le 1.2 n≥7 *)

(* now we see if we can carve out a bit more : 1.1718 *)

D[ArcSin[r[al,7/6]/R[al,7/6]]-Gm[al,7/6],al];

Plot[Out[20],{al,0.0,0.3}]

Plot[{ArcSin[r[al,b]/R[al,b]]+Gm[al,b],gmzero[b,11]}/.{b->1.1718},{al,0,0.2}]

(* the value of gm_0 when we test explicitly |ap_m|le 10 *)

FindRoot[ArcSin[r[al,b]/R[al,b]]+Gm[al,b]-gmzero[b,11]/.{b->1.1718},{al,0.15}]

Plot[{-2Pi+al Log[Cos[al],F[al,b,Gm[al,b]]],Gm[al,b]-ArcSin[r[al,b]/R[al,b]]}/.{b->1.1718},{al,0,ArcTan[Sqrt[8]]}]

Plot[{-2Pi+al Log[Cos[al],F[al,b,Gm[al,b]]],Gm[al,b]-ArcSin[r[al,b]/R[al,b]]}/.{b->1.1718},{al,0.0,0.19}]

FindRoot[-2Pi+al Log[Cos[al],F[al,b,Gm[al,b]]]-Gm[al,b]+ArcSin[r[al,b]/R[al,b]]/.{b->1.1718},{al,0.15}]

Plot[{Nest[-2Pi+al Log[Cos[al],F[al,b,#]]&,Gm[al,b],2]-Nest[-2Pi+al Log[Cos[al],F[al,b,#]]&,Gm[al,b],1],Nest[-2Pi+al Log[Cos[al],F[al,b,#]]&,Gm[al,b],2]-Gm[al,b]+ArcSin[r[al,b]/R[al,b]]}/.{b->1.1718},{al,0.0001,0.12}]

(* evidence that with less than 1.1718 does not work *)

FindRoot[Nest[-2Pi+al Log[Cos[al],F[al,b,#]]&,Gm[al,b],2]-Nest[-2Pi+al Log[Cos[al],F[al,b,#]]&,Gm[al,b],1]/.{b->1.17},{al,0.02893}]

Plot[{Nest[-2Pi+al Log[Cos[al],F[al,b,#]]&,Gm[al,b],3]-Nest[-2Pi+al Log[Cos[al],F[al,b,#]]&,Gm[al,b],2],Nest[-2Pi+al Log[Cos[al],F[al,b,#]]&,Gm[al,b],3]-Gm[al,b]+ArcSin[r[al,b]/R[al,b]]}/.{b->1.16},{al,0.00,0.3}]

(* this is some old exp stuff likely not needed *)

Plot[{Sin[3al/2]/If[3al/2+ArcSin[Sqrt[5/6]]-ArcSin[1/3]>Pi/2,1,Sin[3al/2+ArcSin[Sqrt[5/6]]-ArcSin[1/3]]],Sqrt[3/2]Sin[al]/Sin[ArcSin[1/3]+al]},{al,0,ArcCos[1/3]}]

Plot[{Sin[3al/2]/Sin[bt1+3al/2],Sqrt[3/2]*Sin[al]/Sin[ArcSin[Sqrt[5/6]]-bt1+al]}/.{al->0.04},{bt1,0,ArcSin[Sqrt[5/6]]-ArcSin[1/3]}]

Sin[Pi/6]

(* one small piece for maximum |\ap_4| *)

MyAbs[a_+b_ I]:=Sqrt[a^2+b^2]

f[x_]:=Sqrt[-x^2-2x+7-4Sqrt[-2x+3]];

N[Maximize[MyAbs[ComplexExpand[(1-z^5)/(1-z^4)/.{z->x+I y}]],{0≤x≤1,f[x]≤y≤Sqrt[x-x^2]},{x,y}]]

N[Maximize[MyAbs[ComplexExpand[(1-z^6)/(1-z^5)/.{z->x+I y}]],{0≤x≤1,f[x]≤y≤Sqrt[x-x^2]},{x,y}]]

N[Minimize[MyAbs[ComplexExpand[(1-z^6)/(1-z^5)/.{z->x+I y}]],{0≤x≤1,f[x]≤y≤Sqrt[x-x^2]},{x,y}]]

N[Minimize[MyAbs[ComplexExpand[(1-z^7)/(1-z^6)/.{z->x+I y}]],{0≤x≤1,f[x]≤y≤Sqrt[x-x^2]},{x,y}]]

N[Minimize[MyAbs[ComplexExpand[(1-z^5)/(1-z^4)/.{z->x+I y}]],{0≤x≤1,f[x]≤y≤Sqrt[x-x^2]},{x,y}]]

N[Minimize[MyAbs[ComplexExpand[(1-z^6)/(1-z^5)/.{z->x+I y}]],{0≤x≤1,f[x]≤ y≤ Min[Tan[0.4]*x,Sqrt[x-x^2]]},{x,y}]]

N[Minimize[MyAbs[ComplexExpand[(1-z^3)/(1-z^2)/.{z->x+I y}]],{0≤x≤1,f[x]≤ y≤ Min[Tan[0.45]*x,Sqrt[x-x^2]]},{x,y}]]

N[Minimize[MyAbs[ComplexExpand[(1-z^2)/(1-z^1)/.{z->x+I y}]],{0≤x≤1,f[x]≤y≤Sqrt[x-x^2]},{x,y}]]

Sqrt[108]/9//N

N[Maximize[MyAbs[ComplexExpand[(1-z^4)/(1-z^3)/.{z->x+I y}]],{0≤x≤1,f[x]≤y≤Sqrt[x-x^2]},{x,y}]]

N[Minimize[MyAbs[ComplexExpand[(1-z^4)/(1-z^3)/.{z->x+I y}]],{0≤x≤1,f[x]≤y≤Sqrt[x-x^2]},{x,y}]]

AlMax[ap_,n_]:= ( AlMax[ap,n]=
NMaximize[{Sqrt[(1-Cos[n*ap]*r^n)^2+Sin[n*ap]^2*r^(2n)]/Sqrt[(1-Cos[(n-1)*ap]*r^(n-1))^2+Sin[(n-1)*ap]^2*r^(2n-2)],r≥ 2-Cos[ap]-Sqrt[Cos[ap]^2-4Cos[ap]+3] && r≤ Cos[ap]},r, MaxIterations->1000][[1]]) /; ap>0.0 && ap<Pi/2;
AlMin[ap_,n_]:= (AlMin[ap,n]=NMinimize[{Sqrt[(1-Cos[n*ap]*r^n)^2+Sin[n*ap]^2*r^(2n)]/Sqrt[(1-Cos[(n-1)*ap]*r^(n-1))^2+Sin[(n-1)*ap]^2*r^(2n-2)],r≥ 2-Cos[ap]-Sqrt[Cos[ap]^2-4Cos[ap]+3] && r≤ Cos[ap]},r, MaxIterations->1000][[1]])/; ap>0.0 && ap<Pi/2;

AMax[ap_,n_:2]:=(AMax[ap,n]=
 Block[{a= AlMax[ap,n], b=AlMin[ap,n],c=n,d,f1},
While[++c; (d=(1+Cos[ap]^c)/(1-Cos[ap]^c))>a  || 1/d<b ,
  a=Max[a,AlMax[ap,c]]; b=Min[b,AlMin[ap,c]]]; f1=OpenAppend[AMaxLogFile]; WriteString[f1,"AMax["<>ToString[ap]<>","<>ToString[n]<>"]={"<>ToString[a]<>","<>ToString[b]<>"}
"]; Close[f1]; {a,b} 
] )/; ap>0.1 && ap<Pi/2;

$IterationLimit=Infinity

AMaxLogFile="test.txt";

AMax[0.24,3]

Plot[AMax[ap,3],{ap,0.174,ArcCos[1/3]}]

SetDirectory["C:\\Users\\admin\\Documents\\math"]

<< alpha_bd.m

almax3=Interpolation[Union[{#[[1]],#[[3]]}&/@data]];
almin3=Interpolation[Union[{#[[1]],#[[4]]}&/@data]];

Plot[almin3[ap],{ap,0.174,ArcCos[1/3]}]

Plot[{AlMax[ap,3],AlMin[ap,3]}, {ap,0.0,0.3}]

Plot[{AlMax[ap,7],AlMin[ap,7]}, {ap,0.0,0.3}]

PrintTime[t_]:= Block[{a=Timing[t]},Print[a[[1]]];a[[2]]]

Attributes[Plot]

SetAttributes[PrintTime,{HoldAll}]

Plot[AlMax[ap,7], {ap,0.0,ArcCos[1/3]}]//PrintTime

NMaximize[{AlMax[al,7],0≤al≤0.3},al]

Plot[AlMax[ap,6], {ap,0.0,ArcCos[1/3]}]//PrintTime

Plot[AlMax[ap,#]&/@Range[8,10], {ap,0.0,ArcCos[1/3]}]//PrintTime

<<"almax_bd_7.txt"; AMaxLogFile="almax_bd_7a.txt";

Plot[AMax[ap,7], {ap,0.1,ArcCos[1/3]}]//PrintTime

<< almax_bd_7.m;

(* make interpolation file with almax7[] - done! *)

almax7=Interpolation[Union[{#[[1]],#[[3]]}&/@data7]];

Plot[almax7[ap], {ap,0.1,ArcCos[1/3]}]//PrintTime

SetDirectory["C:\\Users\\admin\\Documents\\math"]

<< almax_bd_7a.m;

almax7a=Interpolation[Union[{#[[1]],#[[3]]}&/@data7a]];almin7a=Interpolation[Union[{#[[1]],#[[4]]}&/@data7a]];

Plot[{almin7a[ap],almax7a[ap]}, {ap,0.1,ArcCos[1/3]}]//PrintTime

AlMax[as_,aq_,n_]:=
NMaximize[{Sqrt[(1-Cos[n*ap]*r^n)^2+Sin[n*ap]^2*r^(2n)]/Sqrt[(1-Cos[(n-1)*ap]*r^(n-1))^2+Sin[(n-1)*ap]^2*r^(2n-2)],r≥ 2-Cos[ap]-Sqrt[Cos[ap]^2-4Cos[ap]+3]-0.1 && r≤ Cos[ap] && as≤ap≤aq },{r, ap}, MaxIterations->1000][[1]] /; as>=0.0 && aq<Pi/2;
AlMin[as_,aq_, n_]:= NMinimize[{Sqrt[(1-Cos[n*ap]*r^n)^2+Sin[n*ap]^2*r^(2n)]/Sqrt[(1-Cos[(n-1)*ap]*r^(n-1))^2+Sin[(n-1)*ap]^2*r^(2n-2)],r≥ 2-Cos[ap]-Sqrt[Cos[ap]^2-4Cos[ap]+3]-0.1 && r≤ Cos[ap]&& as≤ap≤aq},{r, ap}, MaxIterations->1000][[1]]/; as>=0.0 && aq<Pi/2;

AlMax[0.,0.3,7]

AlMax[0,ArcCos[1/3],8]

AlMax[0,ArcCos[1/3],9]

AlMax[0.1,ArcCos[1/3],10]

{AlMax[0,0.174,4],AlMin[0,0.174,4]}

(* for Lemma 4.1 *)

Sig[ap_]=Sqrt[2]*(-1+Cos[ap]+Sqrt[Cos[ap]^2-4Cos[ap]+3]);

Plot[{1-Sqrt[4(Sqrt[3-Sqrt[8]]/(Sqrt[6]Sig[ap]+Sqrt[3-Sqrt[8]]))^(1/(5Pi/4-2ap))-3],Min[ap,1+Sqrt[4(Sqrt[3-Sqrt[8]]/(Sqrt[6]Sig[ap]+Sqrt[3-Sqrt[8]]))^(1/(5Pi/4-2ap))-3]]},{ap,0.1,1.23}]

(* this fails totally , so try 5Pi/4-> 13Pi/4 *)

Plot[{1-Sqrt[4(Sqrt[3-Sqrt[8]]/(Sqrt[6]Sig[ap]+Sqrt[3-Sqrt[8]]))^(1/(13Pi/4-2ap))-3],Min[ap,1+Sqrt[4(Sqrt[3-Sqrt[8]]/(Sqrt[6]Sig[ap]+Sqrt[3-Sqrt[8]]))^(1/(13Pi/4-2ap))-3]]},{ap,0.1,1.23}]

Plot[{1-Sqrt[4(Sqrt[3-Sqrt[8]]/(Sqrt[6]Sig[ap]+Sqrt[3-Sqrt[8]]))^(1/(13Pi/4-2ap))-3],Min[ap,1+Sqrt[4(Sqrt[3-Sqrt[8]]/(Sqrt[6]Sig[ap]+Sqrt[3-Sqrt[8]]))^(1/(13Pi/4-2ap))-3]]},{ap,0.1,0.2}]

Plot[{1-Sqrt[4(Sqrt[3-Sqrt[8]]/(Sqrt[6]Sig[ap]+Sqrt[3-Sqrt[8]]))^(1/(4Pi-ap))-3],Min[ap,1+Sqrt[4(Sqrt[3-Sqrt[8]]/(Sqrt[6]Sig[ap]+Sqrt[3-Sqrt[8]]))^(1/(4Pi-ap))-3]]},{ap,0.1,0.2}]

(* maximal arg of ap_n/ap_{n-1} for ap betw as and aq 
   needed for |arg(ap_n/ap_n-1)}\le \as Lemma 4.1 *)

alpha[ap_,n_]:=ComplexExpand[((1-Cos[n*ap]*r^n)+I Sin[n*ap]*r^(n))*((1-Cos[(n-1)*ap]*r^(n-1))-I Sin[(n-1)*ap]*r^(n-1))];

ArMax[as_,aq_,n_]:= 
NMaximize[Abs[Arg[alpha[ap,n]*Conjugate[alpha[ap,n-1]]]],{r≥ 2-Cos[ap]-Sqrt[Cos[ap]^2-4Cos[ap]+3]-0.00001 && r≤ Cos[ap] && as≤ap≤aq },{r, ap}, MaxIterations->1000][[1]] /; as>0.0 && aq<Pi/2;

ArMax[0.1,0.3,2]

ArMax[0.1,0.3,#]&/@Range[3,100]

Max@@Select[Out[3],NumberQ]

Select[Range[3,100],Not[NumberQ[Out[3][[#-2]]]]&]

{ArMax[0.1,0.28,#],ArMax[0.28, 0.32,#]}&/@%

Max@@Select[%//Flatten,NumberQ]

ArMax[0.1,0.2,#]&/@Range[101,120]

Max@@%

ArMax[0.3,ArcCos[1/3],#]&/@Range[2,50]

Max@@Select[Out[8],NumberQ]

Select[Range[2,50],Not[NumberQ[Out[8][[#-1]]]]&]

{ArMax[0.24,0.72,#],ArMax[0.72, ArcCos[1/3],#]}&/@{12,19,27,31,36,37,39,41,48,50}

Max@@Select[Union[Out[19]]//Flatten,NumberQ]

(* end of proof of arg( ap_n/ap_n-1) lemma *)

(* deforming the calc of delta *)

(* THIS IS sin delta old and wrong *)

sind[ap_,l_]:=Sin[2 ap+2ArcSin[1/3]+ArcTan[Sin[ap]Cos[ap]/(1+Cos[ap]^2)]]/Sqrt[4(4+Tan[ap]^2)l^2+1/Cos[ap]^2-4Sqrt[4+Tan[ap]^2]l  Cos[2 ap+ArcSin[1/3]+2ArcTan[Sin[ap]Cos[ap]/(1+Cos[ap]^2)]]/Cos[ap]]

Plot[sind[ap,0.61],{ap,0,1.23}]

(* max of ax^2+bx+c over x\ge d *)

MaxQ[a_,b_,c_,d_]:=If[-b/(2a)<d,a d^2+b d+c,-b^2/(4 a)+c]/; a<0

Primeap[ap_]:=ArcCos[2-Cos[ap]-Sqrt[Cos[ap]^2-4Cos[ap]+3]]

(* this is delta in paper *)

beta[l_,ap_]:=ArcSin[sind[Primeap[ap],l]]+ArcTan[Tan[Primeap[ap]]/2]

Gm[ap_,l_,k_]:=2Sqrt[k^2+2Cos[ap]k+1]-k/l;

Plot[Gm[ap,l,k]//.{l->0.7-ap/30,ap->0.1},{k,0,3}]

Phi[ap_,l_]:= Gm[ap,l,Max[Min[2-Cos[ap]+Sqrt[Cos[ap]^2-4Cos[ap]+3],-Cos[ap]+Sin[ap]/Sqrt[4l^2-1]],1/Cos[ap]]]

Plot[{2Sqrt[4+Tan[ap]^2]-1/l/Cos[ap], 1*Phi[ap,l],l}/.{l->0.7-ap/30},{ap,0,0.3}]

Fct[a_,l_, ap_]:={MaxQ[l^2Cos[ap]^2-a^2,2l^2Cos[ap]^2/a-2a Cos[3*ArcSin[1/3]+2 ap] ,(l Cos[ap]/a)^2-1,l],
MaxQ[l^2Cos[ap]^2-a^2,2a-2l^2Cos[ap]^2(Sqrt[8/9]*Cos[beta[l,ap]]-Sqrt[1/9]*Sin[beta[l,ap]])/(a),(l Cos[ap]/a)^2-1,Phi[ap,l]]}

Plot[Fct[0.85,0.7-ap/30,ap], {ap,0.00,1.23}]

Plot[Fct[0.85,0.59-ap/30,ap][[2]], {ap,0.00,0.04}]

Plot[Fct[0.85,0.59-ap/30,ap][[2]], {ap,0.00,0.01}]

Plot[{beta[0.61-ap/30,ap],2ArcSin[1/3]+2ap},{ap,0,1.23}]

H[a_,l_,al_]:= Sin[(ArcSin[1/3]+al)/2]/a/(Sqrt[(2Sqrt[4+Tan[al]^2]-1/(l ))^2+1/a^2-
      2/a*(2Sqrt[4+Tan[al]^2]-1/(l ))Cos[(ArcSin[1/3]+al)/2]])-Sin[(ArcSin[1/3]+al)/2]

Plot[H[0.85,0.61-ap/13,ap],{ap,0,1.23}]

Fct[0.85,0.61,0]

Plot[Fct[0.85,l,0.2], {l,0.5,0.85}]

(* end of old and wrong stuff *)

(* this is the current and most reasonable approach *)

(* the test for small alpha w/t lemma 2.3 *)

(* for the general proof Phi \ge l *)

(* below is ok for ap≤0.1 *)

Plot[{-Cos[ap]+Sin[ap]/Sqrt[4l^2-1],1/Cos[ap]}/.{l->0.595-ap/15},{ap,0,1.3}]

Plot[{2Sqrt[4+Tan[ap]^2]-1/l/Cos[ap], Phi[ap,l],l}/.{l->0.595-ap/15},{ap,0,1.3}]

(* this is stuff added 8/27 and must be tested Case 1.1.1 *)
Plot[Cos[ArcSin[1/3]+ap]-l^2Cos[ap]^2/a^2//.{a->0.85,l-> 0.595-ap/15}, {ap,0,0.2}]

(* continue old suff *)

sind[ap_,l_]:=Sin[ 2ArcSin[1/3]+ArcTan[Sin[ap]Cos[ap]/(1+Cos[ap]^2)]+2ap]/Sqrt[4(4+Tan[ap]^2)l^2+1/Cos[ap]^2-4Sqrt[4+Tan[ap]^2]l  Cos[2ArcSin[1/3]+ArcTan[Sin[ap]Cos[ap]/(1+Cos[ap]^2)]+2ap]/Cos[ap]]/Cos[ap]

Primeap[ap_]:=ArcCos[2-Cos[ap]-Sqrt[Cos[ap]^2-4Cos[ap]+3]]

(* delta of paper start of section 3 *)

beta[l_,ap_]:=ArcSin[sind[Primeap[ap],l]]+ArcTan[Tan[Primeap[ap]]/2]

MaxQ[a_,b_,c_,d_]:=If[-b/(2a)<d,a d^2+b d+c,-b^2/(4 a)+c]/; a<0

Gm[ap_,l_,k_]:=2Sqrt[k^2+2Cos[ap]k+1]-k/l;

Phi[ap_,l_]:= Gm[ap,l,Max[Min[2-Cos[ap]+Sqrt[Cos[ap]^2-4Cos[ap]+3],-Cos[ap]+Sin[ap]/Sqrt[4l^2-1]],1/Cos[ap]]]

Plot[Phi[ap, 0.595-ap/15],{ap,0,0.3}]

(* more new stuff to test *)

(* Test in Case 1.1.1 what was before first part *)

Test111[ap_,l_,a_]:=MaxQ[l^2Cos[ap]^2-a^2,2a(-Cos[2ArcSin[1/3]+ ap]*(Cos[ArcSin[1/3]+ap]-l^2Cos[ap]^2/a^2)+
   Sin[2ArcSin[1/3]+ ap]*Sin[ArcSin[1/3]+ap]),(l Cos[ap]/a)^2-1,l];

(* MaxQ[l^2Cos[ap]^2-a^2,2l^2Cos[ap]^2/a-2a Cos[3*ArcSin[1/3]+2ap] ,(l Cos[ap]/a)^2-1,l], old 1st part Case 1.1.1 *)

Plot[Test111[ap,0.595-ap/15,0.85],{ap,0,0.18}]

Plot[{Pi+ArcTan[-Sin[ArcSin[1/3]+ap]/(Cos[ArcSin[1/3]+ap]-l^2Cos[ap]^2/a^2)],
2ArcSin[1/3]+ap}//.{a->0.85,l-> 0.595-ap/15},{ap,0,0.2}]

(* Case 1.1.3.1 *)

(* test this - ok *)

Plot[1.1Phi[ap,l]-1-l Phi[ap,l]*Cos[ap]/.{l->0.595-ap/15},{ap,0,1.3}]

Eta3[ap_,l_,a_,b_]:= 
ArcTan[l^2Cos[ap]^2(Cos[ap]+Sqrt[8]Sin[ap])/(3a b-(Sqrt[8]Cos[ap]-Sin[ap])l^2Cos[ap]^2)]

(* test in case 1.1.3.2.1, 1.1.3.2.2 *)

Test58[ap_,l_,a_,b_]:=MaxQ[l^2Cos[ap]^2-a^2,
2*(a Cos[Min[beta[l,ap]-ap,Eta3[ap,l,a, b]]]-Sqrt[8]l^2Cos[ap]^2/(3b)*Cos[Min[beta[l,ap],Eta3[ap,l,a, b]+ap]]+l^2Cos[ap]^2/(3b)*Sin[Min[beta[l,ap],Eta3[ap,l,a, b]+ap]]),(l Cos[ap]/b)^2-1,Phi[ap,l]];

Plot[{beta[0.595-ap/15,ap],Eta3[ap,0.595-ap/15, 1.4,1.1]+ap},{ap,0,1.3}]

Tst11321[ap_,l_]:= Test58[ap,l,1.4,1.1];

Plot[{beta[0.595-ap/15,ap],Eta3[ap,0.595-ap/15, 1.4,2]+ap},{ap,0,1.3}]

Plot[Tst11321[ap,0.595-ap/15],{ap,0,0.18}]

Tst11322[ap_,l_]:= Test58[ap,l,1.4,2];

Plot[Tst11322[ap,0.595-ap/15],{ap,0,0.28}]

(* Case 1.1.3.3.1 *)

Tst11331[ap_,l_]:= Test58[ap,l,1,1];

Plot[Tst11331[ap,0.595-ap/15],{ap,0,0.28}]

(* Case 1.1.3.3.2 *)

Tst11332[ap_,l_]:= Test58[ap,l,1,1.5];

Plot[Tst11332[ap,0.595-ap/15],{ap,0,0.28}]

(* Case 1.1.3.4.1 *)

(* in paper Eta is the tangent of that !*)

Eta[ap_,l_,a_]:= ArcTan[l^2Cos[ap]^2(Cos[ap]+Sqrt[8]Sin[ap])/(3a^2-(Sqrt[8]Cos[ap]-Sin[ap])l^2Cos[ap]^2)]

Plot[{beta[0.595-ap/15,ap],Eta[ap,0.595-ap/15, 0.85]+ap},{ap,0,1.3}]

Tst11341[ap_,l_,a_]:= MaxQ[l^2Cos[ap]^2-a^2,
2/a*(a^2Cos[Min[beta[l,ap]-ap,Eta[ap,l,a]]]-Sqrt[8]l^2Cos[ap]^2/3*Cos[Min[beta[l,ap],Eta[ap,l,a]+ap]]+l^2Cos[ap]^2/3*Sin[Min[beta[l,ap],Eta[ap,l,a]+ap]]),(l Cos[ap]/a)^2-1,Phi[ap,l]]

Plot[Tst11341[ap,0.595-ap/15,0.85],{ap,0,0.18}]
(* Case 1.1.3.4.2 *)

Plot[Test58[ap,0.595-ap/15,0.85,0.85],{ap,0,0.58}]

Eta2[ap_,l_, a_]:= ArcTan[2l^2Cos[ap]^2(Cos[ap]+Sqrt[8]Sin[ap])/
(9a-2(Sqrt[8]Cos[ap]-Sin[ap])l^2Cos[ap]^2)]

Plot[{beta[0.595-ap/15,ap],Eta2[ap,0.595-ap/15, 0.85]+ap},{ap,0,1.3}]

(* Test11342[ap_,l_,a_]:=MaxQ[l^2Cos[ap]^2-a^2,
2*(a Cos[Min[beta[l,ap]-ap,Eta2[ap,l,a]]]-4Sqrt[8]l^2Cos[ap]^2/15*Cos[Min[beta[l,ap],Eta2[ap,l,a]+ap]]+4l^2Cos[ap]^2/15*Sin[Min[beta[l,ap],Eta2[ap,l,a]+ap]]),(l Cos[ap])^2*(4/5)^2-1,Phi[ap,l]] 

old version *)

Test11342[ap_,l_,a_]:= Test58[ap,l,a,1.1718]; (* 3rd arg a - lower bound for |ap n+1|, 4th arg= upper bound for |ap n| *)

Plot[Test11342[ap,0.595-ap/15,0.85],{ap,0,0.172}]

Plot[Test11342[ap,0.595-ap/15,0.85],{ap,0.108,0.11}]

(* some old stuff *)

Plot[Test58[ap,0.6-ap/30,AlMin[ap,4],AlMax[ap,3]],{ap,0,0.18}]

Plot[Test58[ap,0.7-ap/30,AlMin[ap,44],AlMax[ap,43]],{ap,0,0.18}]

Plot[2*Phi[ap,0.7-ap/30]*Cos[ArcSin[1/3]+beta[0.51-ap/30,ap]]-(2/3+1/0.85),{ap,0,0.2}]
(* this is the reason the 11342 test is worse than 11341 *)

Plot[Test58[ap,0.501,0.853,1/0.853],{ap,0,0.18}]

Plot[Test58[ap,0.58-ap/30,0.851,1.01],{ap,0,0.18}]

(* end old stuff *)

Fct[a_,l_, ap_]:={Test111[ap,l,a],Tst11321[ap,l],Tst11322[ap,l],Tst11331[ap,l],Tst11332[ap,l], Tst11341[ap,l,a],Test11342[ap,l,a]}

Plot[Fct[0.85,0.595-ap/15,ap],{ap,0,0.11}]

Plot[Fct[0.85,0.595-ap/15,ap][[6]], {ap,0.03,0.033}]

H[a_,l_,al_]:= Sin[(ArcSin[1/3]+ al)/2]/a/Sqrt[Phi[al,l]^2+1/a^2-
      2/a*Phi[al,l]*Cos[(ArcSin[1/3]+al)/2]]-Sin[(ArcSin[1/3]+al)/2]

Plot[H[0.85,0.595-ap/15,ap],{ap,0,0.23}]

Plot[{beta[0.595-ap/15,ap],2ArcSin[1/3]+2ap},{ap,0,1.23}]

(* here comes the angle estimate stuff; first the part for small angles *)

(* p 70 block *)

bt[a_,l_,ap_]:=ArcSin[Sin[3ArcSin[1/3]+2ap]/a/Sqrt[l^2+(1/a)^2+2l/a*Cos[3ArcSin[1/3]+2ap]]]

(* this below test was too loose and fails *)

Plot[{bt[0.85,0.595-ap/15,ap],ArcSin[1/3]+ap},{ap,0,0.1}]

(* p. 71-73 block *)

delta[a_,k_,eta_]:= If[Cos[eta]<-k a,Pi-ArcSin[Sin[eta]/Sqrt[1+a^2k^2+2a k Cos[eta]]],ArcSin[Sin[eta]/Sqrt[1+a^2k^2+2a k Cos[eta]]]]

(* if k=|\Dl| is above this, then the angle is small enough *)

kmax[a_,ap_]:= Sin[eta-(ArcSin[1/3]+ap)]/a/Sin[eta]/.{eta->3ArcSin[1/3]+3 ap}
(* if k is above this number, then automatically the angle at 0 is ≤ ArcSin[1/3]+ap ; so if this number <= l, then done *)

Plot[{kmax[0.85,ap],0.595-ap/15},{ap,0,0.3}]

(* but you see is above l, so we have to work *)

fctx[a_,k_,ap_]:= 1/a*Sin[delta[a,k,3*ArcSin[1/3]+2ap]-ArcSin[1/3]-ap]/Sin[delta[a,k,3*ArcSin[1/3]+2ap]]

Plot[delta[0.85,0.595-ap/15,3*ArcSin[1/3]+2ap],{ap,0,0.3}]

(* the lower bounds on the norms of 1/ap_i to prove for
   the small angle proof S2 without lemma 2.3 ; Case 1 *)

Plot[fctx[0.85,0.595-ap/15,ap],{ap,0,0.2}]

(* Case 2 ok *)

Plot[{delta[ 2Sqrt[2-Cos[ap]-Sqrt[Cos[ap]^2-4Cos[ap]+3]],0.595-ap/15,2*ArcSin[1/3]+2.5 ap],ArcSin[1/3]+ap},{ap,0,0.2}]

FindRoot[delta[ 2Sqrt[2-Cos[ap]-Sqrt[Cos[ap]^2-4Cos[ap]+3]],0.595-ap/15,2*ArcSin[1/3]+2.5 ap]-(ArcSin[1/3]+ap),{ap,0.11}]

(*Case 3 *)

fctt[ap_, k_]:=fctx[1/0.7040644,k,ap]-1/2;

Plot[fctt[ap, 0.595-ap/15],{ap,0,0.2}]

(* here the small angle case is done *)

(* this is the general alpha case *)

sind[ap_,l_]:= (* sin of delta *)Sin[ 2ArcSin[1/3]+ArcTan[Sin[ap]Cos[ap]/(1+Cos[ap]^2)]+ap]/Sqrt[4(4+Tan[ap]^2)l^2+1/Cos[ap]^2-4Sqrt[4+Tan[ap]^2]l  Cos[2ArcSin[1/3]+ArcTan[Sin[ap]Cos[ap]/(1+Cos[ap]^2)]+ap]/Cos[ap]]/Cos[ap]

MaxQ[a_,b_,c_,d_]:=If[-b/(2a)<d,a d^2+b d+c,-b^2/(4 a)+c]/; a<0

lap[ap_]:=If[ap>0.77,(0.61-ap/30)/Cos[ap]^(11/10-ap/60),(0.61-ap/30)/Cos[ap]^(13/10-ap/60)]; (* the function l(alpha) for the general case w/ lemma 2.3 all alpha *)

Gm[ap_,l_,k_]:=2Sqrt[k^2+2Cos[ap]k+1]-k/l;

Phi[ap_,l_]:= Gm[ap,l,Max[Min[2-Cos[ap]+Sqrt[Cos[ap]^2-4Cos[ap]+3],-Cos[ap]+Sin[ap]/Sqrt[4l^2-1]],1/Cos[ap]]]

(* for the general proof Phi \ge l *)

Plot[{2-Cos[ap]+Sqrt[Cos[ap]^2-4Cos[ap]+3],-Cos[ap]+Sin[ap]/Sqrt[4lap[ap]^2-1],1/Cos[ap]},{ap,0,ArcCos[1/3]}]

Plot[{2Sqrt[4+Tan[ap]^2]-1/l/Cos[ap], Phi[ap,l],l}/.{l->lap[ap]},{ap,0,1.3}]

Primeap[ap_]:=ArcCos[2-Cos[ap]-Sqrt[Cos[ap]^2-4Cos[ap]+3]]

beta[l_,ap_]:=ArcSin[sind[Primeap[ap],l]]+ArcTan[Tan[Primeap[ap]]/2]
(* delta in paper *)

Plot[{beta[lap[ap],ap],2ArcSin[1/3]+ap},{ap,0,1.23}]

(* Case 1.1.1 *)

Plot[{0.85*lap[ap],-Cos[3*ArcSin[1/3]+ap]},{ap,0.1,1.23}]

Plot[-Cos[3*ArcSin[1/3]+ap]/(a^2-l^2Cos[ap]^2)-l//.{a->0.85,l->lap[ap]},{ap,0.0,1.23}]

(* the above is not alw ≤0, so it's dangerous to test as immed follows *)

Plot[1+a^2l^2+2a l Cos[3 ArcSin[1/3]+ap]-l^4Cos[ap]^2//.{a->0.85,l->lap[ap]},{ap,0.0,1.23}]

(* instead of the prev two plots it's cleaner to test as below *)

Plot[MaxQ[-a^2+l^2Cos[ap]^2,-2a Cos[3ArcSin[1/3]+ap],-1,l]//.{l->lap[ap],a->0.85},{ap,0.1,1.25}]

Plot[Sqrt[8]-3l^2Cos[ap]^2/a^2//.{a->0.85,l->lap[ap]},{ap,0.0,1.3}]

Plot[{If[Sqrt[8]-3l^2Cos[ap]^2/a^2>0,Pi+ArcTan[-1/(Sqrt[8]-3l^2Cos[ap]^2/a^2)],ArcTan[-1/(Sqrt[8]-3l^2Cos[ap]^2/a^2)]],2ArcSin[1/3]+ap}//.{a->0.85,l->lap[ap]},{ap,0,1.23}]

(* this min is not needed if we check that 2\as +\ap is smaller *)

Mf[a_,l_,ap_]:=Min[If[Sqrt[8]-3l^2/a^2>0,Pi+ArcTan[-1/(Sqrt[8]-3l^2/a^2)],ArcTan[-1/(Sqrt[8]-3l^2/a^2)]],2ArcSin[1/3]+ap]

(* the old 1st case; is uses that 2\as +\ap is smaller  *)
Test111[ap_,l_,a_]:= MaxQ[l^2Cos[ap]^2-a^2,2 a (-Cos[2ArcSin[1/3]+ap]*(Sqrt[8]/3-l^2Cos[ap]^2/a^2)+Sin[2ArcSin[1/3]+ap]/3 ),(l Cos[ap]/a)^2-1,l];

Plot[Test111[ap,lap[ap],0.85],{ap,0,1.23}]

(* MaxQ[l^2Cos[ap]^2-a^2,2l^2Cos[ap]^2/a-2a Cos[3*ArcSin[1/3]+ap] ,(l Cos[ap]/a)^2-1,l],the old version *)

(* Case 1.1.3 *)

Plot[{-Cos[ap]+Sin[ap]/Sqrt[4lap[ap]^2-1],1/Cos[ap]},{ap,0.1,1.3}]

Plot[1.1Phi[ap,l]-1-l Phi[ap,l]*Cos[ap]/.{l->lap[ap]},{ap,0,1.3}]

(* Case 1.1.3.2.1 *)
Eta3[ap_,l_,a_,b_]:= ArcTan[l^2Cos[ap]^2/(3a b-Sqrt[8]l^2Cos[ap]^2)];

(* need to repeat Phi from small angle part *)

Gm[ap_,l_,k_]:=2Sqrt[k^2+2Cos[ap]k+1]-k/l;

Phi[ap_,l_]:= Gm[ap,l,Max[Min[2-Cos[ap]+Sqrt[Cos[ap]^2-4Cos[ap]+3],-Cos[ap]+Sin[ap]/Sqrt[4l^2-1]],1/Cos[ap]]]

Plot[0.85 Phi[ap,lap[ap]],{ap,0.1,1.23}] (* should be ≥1 *)

Test87[ap_,l_,a_,b_]:= MaxQ[l^2Cos[ap]^2-a^2,2((a-l^2Cos[ap]^2Sqrt[8]/3/b)Cos[Min[beta[l,ap],Eta3[ap,l,a,b]]]+l^2Cos[ap]^2/(3 b) Sin[Min[beta[l,ap],Eta3[ap,l,a,b]]]),
(l Cos[ap]/b)^2-1,Phi[ap,l]];

Plot[{Eta3[ap,lap[ap],0.947,1.1],beta[lap[ap],ap]},{ap,0,1.23}]

Test11321[ap_,l_]:= Test87[ap,l,0.947,1.1];

Test11321[0.1,0.9]

Plot[Test11321[ap,lap[ap]],{ap,0,1.23}]

(* Case 1.1.3.2.2 *)

Plot[{Eta3[ap,lap[ap],0.947,2],beta[lap[ap],ap]},{ap,0,1.23}]

Test11322[ap_,l_]:= Test87[ap,l,0.947,2];

Plot[Test11322[ap,lap[ap]],{ap,0,1.23}]

(* Case 1.1.3.3 old second case *)

(* m=3,4,5 *)

Test1133[ap_,l_]:={Test87[ap,l,0.885285,0.896456],Test87[ap,l,0.885285,1.5]};

Plot[Test1133[ap,lap[ap]],{ap,0.1,1.23}]

(* Case 1.1.3.4 *) (* m≥ 6 *)

gm[ap_,l_,a_]:= ArcTan[l^2Cos[ap]^2/(3a^2-Sqrt[8]l^2Cos[ap]^2)]

Plot[{gm[ap,lap[ap],0.85],beta[lap[ap],ap]},{ap,0,0.03}]

Plot[{beta[lap[ap],ap],gm[ap,lap[ap],0.85]},{ap,0,1.23}]

Test1134[ap_,l_,a_]:= MaxQ[l^2Cos[ap]^2-a^2,
2/a*((a^2-Sqrt[8]l^2Cos[ap]^2/3)*Cos[Min[beta[l,ap],gm[ap,l,a]]]+l^2Cos[ap]^2/3*Sin[Min[beta[l,ap],gm[ap,l,a]]]),(l Cos[ap]/a)^2-1,Phi[ap,l]]

Plot[Test1134[ap,lap[ap], 0.85],{ap,0,1.23}]

(* this graphic is repeated as 1st comp of Test1134[_,_] below *)

Eta2[ap_,l_,a_]:= ArcTan[5l^2Cos[ap]^2/(18a-5Sqrt[8]l^2Cos[ap]^2)];

Plot[{beta[lap[ap],ap],Eta2[ap,lap[ap],0.85]},{ap,0,1.23}]

(* old test with 1.5 does not work 

Test11332[ap_,l_,a_]:= MaxQ[l^2Cos[ap]^2-a^2,
2*((a-2Sqrt[8]l^2Cos[ap]^2/9)*Cos[Min[beta[l,ap],Eta2[ap,l,a]]]+2l^2Cos[ap]^2/9*Sin[Min[beta[l,ap],Eta2[ap,l,a]]]),(l Cos[ap]/a)^2-1,Phi[ap,l]] *)

Plot[{beta[lap[ap],ap],Eta3[ap,lap[ap],0.85, 1.2]},{ap,0,1.23}]

Test1134[ap_,l_]:={Test87[ap,l,0.85,0.85],Test87[ap,l,0.85,1.2]};

Plot[Test1134[ap,lap[ap]],{ap,0,1.23}]

(* this part does work now ! *)

(* all parts together *)

Fct[a_,l_, ap_]:={Test111[ap,l,a],Test11321[ap,l], Test11322[ap,l], Test1133[ap,l],Test1134[ap,l]}

Plot[Fct[0.85,lap[ap],ap][[#]]&/@{1,2,3,4,5},{ap,0,1.23}]

Plot[Fct[0.85,lap[ap],ap][[2]], {ap,0.00,1.23}]

Plot[Fct[0.85,lap[ap],ap][[3]], {ap,0.00,1.23}]

(* Case 1.2.1 *)
Plot[{2Sqrt[2-Cos[ap]-Sqrt[Cos[ap]^2-4Cos[ap]+3]],1/lap[ap]},{ap,0,1.3}]

Plot[{ArcSin[1/(2*lap[ap]*Sqrt[2-Cos[ap]-Sqrt[Cos[ap]^2-4Cos[ap]+3]])],ap+0*ArcTan[Tan[ap]/2]+4ArcSin[1/3]},{ap,0.0,0.85}]

H[a_,l_,al_]:= Sin[(ArcSin[1/3])/2]/a/Sqrt[Phi[al,l]^2+1/a^2-
      2/a*Phi[al,l]*Cos[(ArcSin[1/3])/2]]-Sin[(ArcSin[1/3])/2]

Plot[H[0.85,lap[ap],ap],{ap,0,1.23}]

(* end new stuff *)

(* here comes the angle estimate stuff - Lemma 4.2 *)

(* the lower bounds on the norms of 1/ap_i to prove for
   the general proof with lemma 2.3 *)

Mm[a_,k_,ap_]:= If[a k>1, Min[3*ArcSin[1/3]+1.0ap,Pi/2+ArcSin[1/(a k)]],3*ArcSin[1/3]+1.0ap]

Plot[{Cos[3*ArcSin[1/3]+ap],-(a lap[ap])}/.{a->0.85},{ap,0.01,1.23}]

Plot[{3*ArcSin[1/3]+1.0ap,Pi/2+ArcSin[1/(a  lap[ap])]}/.{a->0.85},{ap,1.18,1.23}]

(* repeat def of delta from above *)

delta[a_,k_,eta_]:= If[Cos[eta]<-k a,Pi-ArcSin[Sin[eta]/Sqrt[1+a^2k^2+2a k Cos[eta]]],ArcSin[Sin[eta]/Sqrt[1+a^2k^2+2a k Cos[eta]]]]

(* Case 1.1.1 *)

fctx[a_,k_,ap_]:= 1/a*Sin[delta[a,k,Mm[a,k,ap]]-ArcSin[1/3]-0.0ap]/Sin[delta[a,k,Mm[a,k,ap]]]

Plot[{1/almax3[ap],fctx[0.85,lap[ap],ap]},{ap,0.17,1.23}]

Plot[fctx[0.85,lap[ap],ap],{ap,0.96,0.98}]

(* this works now for ap≥0.9, but for smaller ap need to break up in cases *)

(* enough to work for ap≤ 0.9 *)

(* m+1\ge 7 *)

Plot[{1/almax7[ap],fctx[0.85,lap[ap],ap]},{ap,0.1,1.23}]

Plot[AlMax[ap,6],{ap,0.1,1.23}]

Plot[{1/AlMax[ap,6],fctx[0.85,lap[ap],ap]},{ap,0.1,1.23}]

Plot[{1/AlMax[ap,5],fctx[0.85,lap[ap],ap]},{ap,0.1,1.23}]

(* works so we dont need to do this crunching right below *)

Plot[{1/AlMax[ap,5],fctx[Min[AlMin[ap,4],AlMin[ap,6]],lap[ap],ap]},{ap,0.17,1.23}]

(* Min[AlMin[ap,3],AlMin[ap,5] over all ap is 0.896456 *)

Plot[{1/AlMax[ap,4],fctx[0.896456,lap[ap],ap]},{ap,0.1,1.23}]

Plot[{1/AlMax[ap,4],fctx[Min[AlMin[ap,3],AlMin[ap,5]], lap[ap],ap]},{ap,0.1,1.23}]

Plot[{1/AlMax[ap,3],fctx[0.91465, lap[ap],ap]},{ap,0.1,1.23}]

Plot[{1/AlMax[ap,3],fctx[Min[AlMin[ap,2],AlMin[ap,4]], lap[ap],ap]},{ap,0.1,1.23}]

(* Case 1.2.1 *)

Plot[{3*ArcSin[1/3]+1.0ap,Pi/2+ArcSin[1/(a  lap[ap])]}/.{a->0.94744},{ap,1.,1.23}]

fcty[a_,k_,ap_]:= 1/a*Sin[delta[a,k,Mm[a,k,ap]]-2ArcSin[1/3]-0.0ap]/Sin[delta[a,k,Mm[a,k,ap]]]

Plot[{1/AlMax[ap,2],fcty[AlMin[ap,3], lap[ap],ap]},{ap,0.1,1.23}]

Plot[{1/Sqrt[1+3*Cos[ap]^2],fcty[0.94744, lap[ap],ap]},{ap,0.1,1.23}]

(* this case was moved out of lemma 4.1 and seems not needed now *)

Plot[delta[AlMin[ap,2],lap[ap],ap]-ArcSin[1/3],{ap,0.1,1.23}]

(* resolve AlMax[ap,2]= Sqrt[1+3*Cos[ap]^2];
  simplify w/ Lemma 2.5 AlMin[ap,2]=2Sqrt[2-Cos[ap]-Sqrt[Cos[ap]^2-4Cos[ap]_3]]≥3/Sqrt[2] , AlMin[ap,3]≥0.94744, Min[AlMin[ap,4],AlMin[ap,6]]≥0.85 .... *)

(* Case 1.1.2 *)

k[eta_,M_]:= -Sqrt[3+Sqrt[8]]/(Sqrt[6]*M*Cos[eta-ArcSin[1/3]/2]);

eps[a_,eta_,M_]:=ArcSin[Sin[eta]/Sqrt[1+a^2k[eta,M]^2+2a k[eta,M]Cos[eta]]]-ArcSin[Sin[eta]/Sqrt[1+1.2^2k[eta,M]^2+2*1.2* k[eta,M]Cos[eta]]]

almax3[Pi/2-2.5ArcSin[1/3]]

(* so can take 1.2 *)

Plot@@({{eps[a,eta,1.2], ArcSin[1/3]},{eta,Pi/2+ArcSin[1/3]/2+ArcSin[a Sqrt[3+Sqrt[8]]/(3Sqrt[6]*1.2)],Pi/2+ArcSin[1/3]*2}}/.{a->0.85})

(* Case 1.2.2 *)

Plot@@({{eps[a,eta,Sqrt[1+3Cos[eta-3 ArcSin[1/3]]^2]], 2 ArcSin[1/3]},{eta,Pi/2+ArcSin[1/3]/2+ArcSin[2 Sqrt[8] a Sqrt[3+Sqrt[8]]/(9 Sqrt[6]*Sqrt[1+3Sin[2.5 ArcSin[1/3]]^2])],Pi/2+ArcSin[1/3]*2}}/.{a->0.94744})

(* the foll test is indep on choice of lap[] *)

(* OLD STUFF *)

UpperShaft[a_,ap_]:= If[3*ArcSin[1/3]+ap>Pi/2,
{1/(a Sin[3*ArcSin[1/3]+ap-Pi/2])*Sin[ArcSin[1/3]+Eta[a,3/a,3*ArcSin[1/3]+ap]],1/a}]

Plot[UpperShaft[0.85,ap],{ap,0.4,1.23}]

(* END OLD STUFF *)

(* STUFF added from .m file *)

(* Case 2.1 *)

Plot[{2ArcSin[1/3]+ap,Pi/2+ArcSin[Sin[3 ArcSin[1/3]+ap]/Sqrt[1+9m^2/(4a^2)+3m/a Cos[3ArcSin[1/3]+ap]]]}/.{a->0.85, m->3},{ap,0,1.23}]

FindRoot[2ArcSin[1/3]+ap==Pi/2+ArcSin[Sin[3 ArcSin[1/3]+ap]/Sqrt[1+9m^2/(4a^2)+3m/a Cos[3ArcSin[1/3]+ap]]]/.{a->0.85, m->3},{ap,1.07}]

Plot[{2ArcSin[1/3]+ap,Pi/2+ArcSin[Sin[3 ArcSin[1/3]+ap]/Sqrt[1+9m^2/(4a^2)+3m/a Cos[3ArcSin[1/3]+ap]]]}/.{a->0.85, m->1.6},{ap,1.2,ArcCos[1/3]}]

Ls={3,2.1,1.81,1.69,1.635,1.609,1.6};

Plot[(M*Sin[ArcSin[1/3]+ArcSin[Sin[3 ArcSin[1/3]+ap]/Sqrt[1+9m^2/(4a^2)+3m/a Cos[3ArcSin[1/3]+ap]]]]-1/.{a->0.85, m->Ls[[#]], M->Ls[[#+1]]})&/@Range[6],{ap,1.07,ArcCos[1/3]}]

(* here essentially the proof should be done !! *)

(* some old and likely redundant attempts *)

limit:=0.315

sind[ap_,l_]:=Sin[2 ap+ArcSin[limit]+ArcTan[Sin[ap]Cos[ap]/(1+Cos[ap]^2)]]/Sqrt[4(4+Tan[ap]^2)l^2+1/Cos[ap]^2-4Sqrt[4+Tan[ap]^2]l  Cos[2 ap+ArcSin[limit]+ArcTan[Sin[ap]Cos[ap]/(1+Cos[ap]^2)]]/Cos[ap]]

Fct[a_,l_, ap_]:={MaxQ[l^2Cos[ap]^2-a^2,2l^2Cos[ap]^2/a-2a Cos[3*ArcSin[limit]+2 ap],(l Cos[ap]/a)^2-1,l],
MaxQ[l^2Cos[ap]^2-a^2,2a-2l^2Cos[ap]^2(Cos[ArcSin[limit]]*Cos[beta[l,ap]]-Sin[ArcSin[limit]]*Sin[beta[l,ap]])/(a),(l Cos[ap]/a)^2-1,2Sqrt[4+Tan[ap]^2]-1/l/Cos[ap]]}

Plot[Fct[0.8527,0.61-ap/6,ap][[2]], {ap,0.08,0.26}]

Plot[Fct[0.8527,(0.61-ap/6-ap^2/8-ap^3/70),ap], {ap,0.08,1.26}]

Plot[Fct[0.8527,l,0.57], {l,0.08,0.76}]

(* so if we prove |arg ap|≤arcsin(0.315) for ap le 0.275..=pi/2-3\as/2 , then ok  and |ap_n|ge 0.8527 *)

Plot[{((0.61-ap/6)*Sin[2 ap+3 ArcSin[1/3]])/Cos[ap],1/(2 a Cos[(ArcSin[1/3]+ap)/2])}/.{a->.85},{ap,0.005,0.8}]

sind[ap_,l_]:=Sin[ 2ArcSin[1/3]+ArcTan[Tan[ap]/2]]/Sqrt[4(4+Tan[ap]^2)l^2+1/Cos[ap]^2-4Sqrt[4+Tan[ap]^2]l  Cos[2ArcSin[1/3]+ArcTan[Tan[ap]/2]]/Cos[ap]]/Cos[ap]

Plot[{sind[ap,0.61-ap/13],Sin[2ArcSin[1/3]+2ap]},{ap,0,1.23}]

(* now see what you get with |arg ap_n/ap_n-1|<\as *)

Plot[0.61-ap/7+ap^2/10,{ap,0.3,1.3}]

Fct[a_,l_, ap_]:={MaxQ[l^2Cos[ap]^2-a^2,2l^2Cos[ap]^2/a-2a Cos[3*ArcSin[1/3]+ ap] ,(l Cos[ap]/a)^2-1,l],
MaxQ[l^2Cos[ap]^2-a^2,2a-2/a*l^2*Cos[ap]^2*(Sqrt[8/9]*Cos[beta[l,ap]]-Sqrt[1/9]*Sin[beta[l,ap]]),(l Cos[ap]/a)^2-1,2Sqrt[4+Tan[ap]^2]-1/l/Cos[ap]]}

Plot[Fct[0.851,0.61-ap/16-ap^2/8-ap^3/70,ap], {ap,0.00,1.23}]

Plot[Fct[0.851,0.61+ap/30,ap], {ap,0.00,1.23}]

Plot[{Sin[ArcSin[1/3]/2]/a/Sqrt[(2Sqrt[4+Tan[ap]^2]-1/l/Cos[ap])^2+1/a^2-2/a*(Sqrt[4+Tan[ap]^2]-1/l/Cos[ap])Cos[ArcSin[1/3]/2]],Sin[ArcSin[1/3]/2]}/.{l->0.61-ap/30,a->0.85},{ap,0,1.23}]

(* the modified approach with z^{-n/2}\Dl *)

MaxQ[a_,b_,c_,d_]:=If[-b/(2a)<d,a d^2+b d+c,-b^2/(4 a)+c]/; a<0

sind[ap_,l_]:=Sin[ 2ArcSin[1/3]+ArcTan[Tan[ap]/2]]/Sqrt[4(4+Tan[ap]^2)l^2+1-4Sqrt[4+Tan[ap]^2]l  Cos[2ArcSin[1/3]+ArcTan[Tan[ap]/2]]]

beta[l_,ap_]:=ArcSin[sind[ap,l]]+ArcTan[Sin[ap]Cos[ap]/(1+Cos[ap]^2)]

Fct[a_,l_, ap_]:={MaxQ[l^2-a^2,2 l^2/a-2a*Cos[3*ArcSin[1/3]+ap] ,(l/a)^2-1,l/Cos[ap]],
MaxQ[l^2-a^2,2a-2l^2/a*(Sqrt[8/9]*Cos[beta[l,ap]+ap]-Sqrt[1/9]*Sin[beta[l,ap]+ap]),(l /a)^2-1,2Sqrt[4+Tan[ap]^2]-1/l]}

Plot[Fct[0.852,0.61-ap/12,ap], {ap,0.099,0.93}]

Plot[Fct[0.852,0.61-ap/12,ap], {ap,0.099,0.23}]

Plot[Fct[0.852,0.61-ap/13+ap^2/10,ap], {ap,0.0,0.03}]

Plot[{Sin[ArcSin[1/3]/2]/a/Sqrt[(2Sqrt[4+Tan[ap]^2]-1/l)^2+1/a^2-2/a*(Sqrt[4+Tan[ap]^2]-1/l)Cos[ArcSin[1/3]/2]],Sin[ArcSin[1/3]/2]}/.{l->If[ap<0.6,0.61-ap/12,0.61-ap^2/8-ap^3/10],a->0.852},{ap,0,1.23}]

Plot[2Sqrt[1+3Cos[ap]^2]-Cos[ap]/l-l/.{l->If[ap<0.6,0.61-ap/12,0.61-ap^2/8-ap^3/10]},{ap,0,1.23}]

limit:=1/3

sind[ap_,l_]:=Sin[2 limit+ ArcTan[Tan[ap]/2]]/Sqrt[4(4+Tan[ap]^2)l^2+1-4Sqrt[4+Tan[ap]^2]l  Cos[2 limit+ArcTan[Tan[ap]/2]]]

beta[l_,ap_]:=ArcSin[sind[ap,l]]

Fct[a_,l_, ap_]:={MaxQ[l^2-a^2,2 l^2/a-2a*Cos[3*ArcSin[limit]+ap] ,(l/a)^2-1,l/Cos[ap]],
MaxQ[l^2-a^2,2a-2l^2/a*(Cos[ArcSin[limit]]*Cos[beta[l,ap]+ap]-limit*Sin[beta[l,ap]+ap]),(l /a)^2-1,2Sqrt[4+Tan[ap]^2]-1/l]}

Plot[Fct[0.852,0.61-ap/12,ap], {ap,0.009,0.83}]