Karplus curve

Gribov lecture #8, 
http://www.indiana.edu/~jpac/Gribov.html

(*Mathias Wagner*)
(*Rocio Reyes Ramos*)
(*Misha Mikhasenko*)

Introduce masses

Changing parameter α you can investigate smooth transition from standard book Karplus curve (all masses are the same, λ=0) to one for specific values of masses (λ=1).

Example here is a photoproduction of kaon γ p -> K Λ(Σ)

λ$sc=1;
m1sq =(0.497614^2)λ$sc+1-λ$sc;(*K*)
m2sq = (0.89581^2)λ$sc+1-λ$sc;(*(SuperStar[K])*)
m3sq = (0.1349766^2)λ$sc+1-λ$sc;(*π*)
m4sq = (1.18937^2)λ$sc+1-λ$sc;(*Σ*)
M1sq = 0λ$sc+1-λ$sc;(*real γ*)
M2sq = (0.938272046^2)λ$sc+1-λ$sc;(*p*)
M3sq = m1sq λ$sc+1-λ$sc;(*K*)
M4sq = m4sq λ$sc+1-λ$sc;(*Σ*)

some notations for 2(Subscript[k, i])(Subscript[k, i+1])

mu1sq = m1sq+m2sq-M1sq;
mu2sq = m1sq+m4sq-M2sq;
mu3sq = m2sq+m3sq-M3sq;
mu4sq = m3sq+m4sq-M4sq;
SumMsq = M1sq+M2sq+M3sq+M4sq;

Landau equations

Solvability

Ab[s_,t_]:={{2m1sq, mu1sq, m1sq+m3sq-t, mu2sq},{mu1sq, 2m2sq, mu3sq, m2sq+m4sq-s},{m1sq+m3sq-t, mu3sq,2m3sq,mu4sq},{mu2sq,m2sq+m4sq-s, mu4sq, 2m4sq}}
f[s_,t_]:=Det[Ab[s,t]];

Explicit equations for α, for condition (Subscript[α, i])>0

ns[s_,t_]:=Join[Ab[s,t][[1;;3]],{{1,1,1,1}}];
α[s_,t_]:=Inverse[ns[s,t]].{0,0,0,1};

Border of kinematic region

Calculate (Subscript[t, min]), (Subscript[t, max]) and build up equation for the border

Clear@λ;
λ[x_,y_,z_]:= (x^2)+(y^2)+(z^2)-2x y-2x z -2y z;
g[s_,t_]:= (((t-M1sq-M3sq+2(((s+M1sq-M2sq)/(2(Sqrt[s])))((s+M3sq-M4sq)/(2(Sqrt[s]))))))^2)-4((λ [s,M1sq,M2sq])/(4 s))((λ[s,M3sq,M4sq])/(4 s));

Mandelstam coordinates

Rotation and shift of x axis

sv[x_,y_]:=SumMsq+((Sqrt[3])/2)x-(1/2)y;

Plot Landau singularities

Module[{x$min=-10,x$max=10,y$min=-5,y$max=10},
Show[
ContourPlot[{sv[x,y]==0,y==0,SumMsq-sv[x,y]-y==0},{x,x$min,x$max},{y,y$min,y$max},
ContourStyle->Directive[Thick,Black]],
RegionPlot[{
And@@Table[α[sv[x,y],y][[i]]>0,{i,4}],(*α>0*)
f[sv[x,y],y]>0,(*Det[A]==0*)
g[sv[x,y],y]<0 (*(Subscript[t, min])<t<(Subscript[t, max])*)
},{x,x$min,x$max},{y,y$min,y$max}],ImageSize->Medium,
PlotRangePadding->0
]
]

Plot intersection

Module[{x$min=-5,x$max=10,y$min=-5,y$max=10},
Show[
ContourPlot[{sv[x,y]==0,y==0,SumMsq-sv[x,y]-y==0},{x,x$min,x$max},{y,y$min,y$max},
ContourStyle->Directive[Thick,Black]],
RegionPlot[{
And@@Table[α[sv[x,y],y][[i]]>0,{i,4}]&&(f[sv[x,y],y]>0),
g[sv[x,y],y]<0&&sv[x,y]>((((Sqrt[M1sq])+(Sqrt[M2sq])))^2)
},{x,x$min,x$max},{y,y$min,y$max}],ImageSize->Medium,
PlotRangePadding->0
]
]