1
$\begingroup$

In the following code, I am trying to plot the function GG[DM_] that contains Maximize problem as shown in Fig:

enter image description here

where /omega_a and /omega_b are the largest eigenvalues of the matrix "Au". I faced two issues: 1- It takes a too long time to give the results. 2- After this long computation, I got errors such as:

NMaximize::nrnum: The function value 0.979479 +1.25832*10^-20 I is not a real number at {[Theta],[Phi]} = {3.06021,5.22609}.

NMaximize::nrnum: The function value 0.978524 +5.16797*10^-18 I is not a real number at {[Theta],[Phi]} = {3.06021,5.22609}.

NMaximize::nrnum: The function value 0.975438 -1.32626*10^-18 I is not a real number at {[Theta],[Phi]} = {3.06021,5.22609}.

General::stop: Further output of NMaximize::nrnum will be suppressed during this calculation.

How can I overcome these problems? Thank you.

    T = 0.5;
\[Beta] = 1/T;
B = 2;
J = 1;
 \[Delta] = Sqrt[DM^2 + J^2] ;
\[Theta]0 = ArcTan[DM/J] ;
Z = 2 Cosh[2 B \[Beta]] + 2 Cosh[2 \[Beta] \[Delta]] ;

SqRho = 1/Sqrt[Z] \!\(\*
TagBox[
RowBox[{"(", "", GridBox[{
{
SuperscriptBox["E", 
RowBox[{
RowBox[{"-", " ", "B"}], " ", "\[Beta]"}]], "0", "0", "0"},
{"0", 
RowBox[{"Cosh", "[", " ", 
RowBox[{"\[Beta]", " ", "\[Delta]"}], "]"}], 
RowBox[{
RowBox[{"-", 
SuperscriptBox["E", 
RowBox[{"I", " ", "\[Theta]0"}]]}], " ", 
RowBox[{"Sinh", "[", " ", 
RowBox[{"\[Beta]", " ", "\[Delta]"}], "]"}]}], "0"},
{"0", 
RowBox[{
RowBox[{"-", 
SuperscriptBox["E", 
RowBox[{
RowBox[{"-", "I"}], " ", "\[Theta]0"}]]}], " ", 
RowBox[{"Sinh", "[", " ", 
RowBox[{"\[Beta]", " ", "\[Delta]"}], "]"}]}], 
RowBox[{"Cosh", "[", " ", 
RowBox[{"\[Beta]", " ", "\[Delta]"}], "]"}], "0"},
{"0", "0", "0", 
SuperscriptBox["E", 
RowBox[{" ", 
RowBox[{"B", " ", "\[Beta]"}]}]]}
},
GridBoxAlignment->{"Columns" -> {{Center}}, "Rows" -> {{Baseline}}},
GridBoxSpacings->{"Columns" -> {
Offset[0.27999999999999997`], {
Offset[0.7]}, 
Offset[0.27999999999999997`]}, "Rows" -> {
Offset[0.2], {
Offset[0.4]}, 
Offset[0.2]}}], "", ")"}],
Function[BoxForm`e$, 
MatrixForm[BoxForm`e$]]]\);

\[Chi] = \!\(\*
TagBox[
RowBox[{"(", "", GridBox[{
{
RowBox[{"Cos", "[", "\[Theta]", "]"}], "0", 
RowBox[{
RowBox[{
RowBox[{"Cos", "[", "\[Phi]", "]"}], " ", 
RowBox[{"Sin", "[", "\[Theta]", "]"}]}], "-", 
RowBox[{"I", " ", 
RowBox[{"Sin", "[", "\[Theta]", "]"}], " ", 
RowBox[{"Sin", "[", "\[Phi]", "]"}]}]}], "0"},
{"0", 
RowBox[{"Cos", "[", "\[Theta]", "]"}], "0", 
RowBox[{
RowBox[{
RowBox[{"Cos", "[", "\[Phi]", "]"}], " ", 
RowBox[{"Sin", "[", "\[Theta]", "]"}]}], "-", 
RowBox[{"I", " ", 
RowBox[{"Sin", "[", "\[Theta]", "]"}], " ", 
RowBox[{"Sin", "[", "\[Phi]", "]"}]}]}]},
{
RowBox[{
RowBox[{
RowBox[{"Cos", "[", "\[Phi]", "]"}], " ", 
RowBox[{"Sin", "[", "\[Theta]", "]"}]}], "+", 
RowBox[{"I", " ", 
RowBox[{"Sin", "[", "\[Theta]", "]"}], " ", 
RowBox[{"Sin", "[", "\[Phi]", "]"}]}]}], "0", 
RowBox[{"-", 
RowBox[{"Cos", "[", "\[Theta]", "]"}]}], "0"},
{"0", 
RowBox[{
RowBox[{
RowBox[{"Cos", "[", "\[Phi]", "]"}], " ", 
RowBox[{"Sin", "[", "\[Theta]", "]"}]}], "+", 
RowBox[{"I", " ", 
RowBox[{"Sin", "[", "\[Theta]", "]"}], " ", 
RowBox[{"Sin", "[", "\[Phi]", "]"}]}]}], "0", 
RowBox[{"-", 
RowBox[{"Cos", "[", "\[Theta]", "]"}]}]}
},
GridBoxAlignment->{"Columns" -> {{Center}}, "Rows" -> {{Baseline}}},
GridBoxSpacings->{"Columns" -> {
Offset[0.27999999999999997`], {
Offset[0.7]}, 
Offset[0.27999999999999997`]}, "Rows" -> {
Offset[0.2], {
Offset[0.4]}, 
Offset[0.2]}}], "", ")"}],
Function[BoxForm`e$, 
MatrixForm[BoxForm`e$]]]\);
 \[CapitalLambda]u = (SqRho).(\[Chi]).(SqRho);
{\[Omega]1, \[Omega]2, \[Omega]3, \[Omega]4} = 
  Chop[Eigenvalues[\[CapitalLambda]u]]   ;
{\[Omega]a, \[Omega]b, \[Omega]c, \[Omega]d} = 
  Sort[{\[Omega]1, \[Omega]2, \[Omega]3, \[Omega]4}, Greater];
nmax[DM_] := 
  Maximize[{1 - Tr[\[CapitalLambda]u] + 2 (\[Omega]a + \[Omega]b), 
    0 < \[Theta] < (\[Pi]) && 
     0 < \[Phi] < (2 \[Pi])}, {\[Theta], \[Phi]}];
GG[DM_] := Sqrt[(2 + Sqrt[2]) (1 - Sqrt[1/2*First@nmax[DM]])];
GGPlot = Plot[GG[DM], {DM, 0, 8}, PlotRange -> {0, 1}, 
  MaxRecursion -> 1]
$\endgroup$
1
$\begingroup$
T = 1/2; 
β = 1/T; 
B = 2; 
J = 1; 
δ = Sqrt[DM^2 + J^2]; 
θ0 = ArcTan[DM/J]; 
Z = 2*Cosh[2*B*β] + 2*Cosh[2*β*δ]; 

SqRho = {{E^((-B)*β), 0, 0, 0}, {0, Cosh[β*δ], (-E^(I*θ0))*Sinh[β*δ], 0}, 
         {0, (-E^((-I)*θ0))*Sinh[β*δ], Cosh[β*δ], 0}, {0, 0, 0, E^(B*β)}}/Sqrt[Z]; 

χ = {{Cos[θ], 0, Cos[ϕ]*Sin[θ] - I*Sin[θ]*Sin[ϕ], 0}, 
     {0, Cos[θ], 0, Cos[ϕ]*Sin[θ] - I*Sin[θ]*Sin[ϕ]}, 
     {Cos[ϕ]*Sin[θ] + I*Sin[θ]*Sin[ϕ], 0, -Cos[θ], 0}, 
     {0, Cos[ϕ]*Sin[θ] + I*Sin[θ]*Sin[ϕ], 0, -Cos[θ]}}; 

Λu = SqRho . χ . SqRho; 

ev = Eigenvalues[Λu];
{ωa, ωb} = Sort[ev, Greater][[{1, 2}]];

Now define helper function that computes argument of Maximize:

f[DM_?NumericQ] = 
 1 - Tr[Λu] + 2 (ωa + ωb) // ToRadicals // FullSimplify

enter image description here

Compact enough expression, and it does not depend on ϕ. If you only need the maximum value, you can use NMaxValue:

nmax[DM_?NumericQ] := NMaxValue[{f[DM], 0 < θ < π}, θ]

GG[(DM_)?NumericQ] := Sqrt[(2 + Sqrt[2])*(1 - Sqrt[nmax[DM]/2])]

Plot[GG[DM], {DM, 0, 8}, Frame -> True, FrameLabel -> {"DM", "GG(DM)"}]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.