Mass Spectrum Plot

Kristjan Kannike, created: 2010-03-15, changed: 2010-03-22. See also Drawing Mass Spectrum Plots.

Options[massSpectrumPlot]={showPhase->True,showPhaseDisk->False,lineLength->100,lineThickness->Thick,labelOffset->0.1,arrowProportion->0.03,arrowheadSize->Small,arrowColor->Black,labelStyle->{FontSize->10},showOptions->{ImageSize->Small},colors->{{Black},{ColorData["Legacy"][67],ColorData["Legacy"][144]},{ColorData["Legacy"][67],ColorData["Legacy"][144],ColorData["Legacy"][59]},{ColorData["Legacy"][67],ColorData["Legacy"][144],ColorData["Legacy"][24],ColorData["Legacy"][59]}}
};
massSpectrumPlot[pts_,OptionsPattern[]]:=Module[{},
Show[{Graphics[Text[Style[First[#],Sequence@@OptionValue[labelStyle] ],{-OptionValue[labelOffset],#[[2]]},Right]],
With[{m=#[[2]],coeffs=#[[3]],
accs=With[{acc=Accumulate[ Abs@#[[3]] ]},OptionValue[lineLength] Partition[Prepend[acc/Last[acc],0],2,1]],cols=If[Length[#]==4,#[[4]],OptionValue[colors][[Length@#[[3]] ]]]},
MapThread[{
Graphics[{#1,OptionValue[lineThickness],Line[{ {First[#2],m},{Last[#2],m} }]}],
If[And[OptionValue[showPhaseDisk],Arg[#3]≠0],
Graphics[{#1,Disk[{Mean[#2],m},OptionValue[arrowProportion] OptionValue[lineLength]]}],
Graphics[]],
If[Arg[#3]≠0,
Graphics[{Arrowheads[OptionValue[arrowheadSize]],OptionValue[lineThickness],OptionValue[arrowColor],
Translate[
Arrow[{{Mean[#2],m},{Mean[#2],m}+OptionValue[arrowProportion] OptionValue[lineLength] {Cos[Arg[#3]],Sin[Arg[#3]]}}],
If[OptionValue[showPhaseDisk],{0,0},-1/2 OptionValue[arrowProportion] OptionValue[lineLength] {Cos[Arg[#3]],Sin[Arg[#3]]} ]]
}],Graphics[]]
}&,{cols,accs,coeffs}]
]}&/@pts ,
Sequence@@OptionValue[showOptions] ]
];

massSpectrumPlot[{ {m1,10,{-1,1}} },showOptions->{ImageSize->Medium},showPhaseDisk->True,arrowheadSize->Medium,arrowProportion->0.04]

massSpectrumPlot[{ {m1,10,{-1,I,1+I}} },showOptions->{ImageSize->Medium},showPhaseDisk->True,arrowheadSize->Medium,arrowProportion->0.04]

massSpectrumPlot[{ {m1,10,{-1,I,1+I,1-I}} },showOptions->{ImageSize->Medium},showPhaseDisk->True,arrowheadSize->Medium,arrowProportion->0.04]

massSpectrumPlot[{ {m1,10,{-1,-1+0.5 I},{ColorData["Legacy"][45],ColorData["Legacy"][49]}} },showOptions->{ImageSize->Medium},showPhaseDisk->True,arrowheadSize->Medium,arrowProportion->0.04]

massSpectrumPlot[{ {m1,10,{1,-1,I,1+I}} },showOptions->{ImageSize->Medium},showPhaseDisk->False,arrowheadSize->Medium,arrowProportion->0.04]

massSpectrumPlot[{{Subscript[m,1],10,{1}},{Subscript[m,2],20,{0.3 (1-I),0.7}},{Subscript[m,3],25,{1+I,1},{ColorData["Legacy"][45],ColorData["Legacy"][49]}}},lineLength->20,labelOffset->1,arrowProportion->0.1,labelStyle->{FontSize->14,FontFamily->"Palatino"}]

Mass Spectrum of Neutrinos

(* Mass squared differences *) dm2atm=2.6 10^(-3); (* dm2atm = mn3^2-mn1^2 *)
 dm2sol=8.2 10^(-5); (* dm2sol = mn2^2-mn1^2 *) 
mn1=0.01; 
mn2=Sqrt[mn1^2+dm2sol]; mn3=Sqrt[mn2^2+dm2atm];
(* Sines and cosines of the mixing angles *)
s23=Sin[ArcTan[0.97]]; s12=Sin[ArcTan[Sqrt[0.39]]];s13=0.05;c23=Sqrt[1-s23^2];
c12=Sqrt[1-s12^2];c13=Sqrt[1-s13^2]; 
(* Dirac and Majorana phases *)
del=Random[Real,{0,2π}];(*  phi1 = Random[Real,{0,2π}]; phi2 =Random[Real,{0,2π}]; *)
phi1=0;phi2=0;
(* Observed mixing matrix at low energies *)
V={{c12 c13,                                               s12 c13,                                                   s13 Exp[-I del]},{-s12 c23-c12 s23 s13 Exp[I del],c12 c23-s12 s23 s13 Exp[I del],s23 c13},
{s12 s23-c12 c23 s13 Exp[I del],-c12 s23-s12 c23 s13 Exp[I del],c23 c13}};
(* Observed mixing matrix at low energies with Majorana phases added *)
U=V.DiagonalMatrix[{Exp[I phi1],Exp[I phi2],1}];
Udagger=ConjugateTranspose[U];

massSpectrumPlot[{ {"",0,{1}},{Subscript[m,1],mn1,Udagger[[1]]},{Subscript[m,2],mn2,Udagger[[2]]},{Subscript[m,3],mn3,Udagger[[3]]} },showOptions->{ImageSize->400,Axes->True,Ticks->{None,Automatic},AxesLabel->{"","(Subscript[m, i])/eV"}},showPhaseDisk->False,lineLength->mn3,labelOffset->0.5 mn1,arrowProportion->0.04,arrowheadSize->Small]