Plotting "Maximize" function takes long time!

Question

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

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]

Answer 1

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

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)"}]