NIntegrate numerical accuracy and errors

Question

I have the following 3x3 matrix

M = {{-I*ω + Γ/2, I*g1, 
0}, {I*g1, -I*ω + κ1/2, I*g2}, {0, 
I*g2, -I*ω + κ2/2}};

Finding the eigenvalues and eigenvectors

vals = Eigenvalues[M, Cubics -> True];
vecs = Simplify[
Eigenvectors[M /. Complex[0, -1] -> mi, Cubics -> True] /. 
mi -> -I];

All of this is to diagonalize the initial M matrix

P = Transpose[{vecs[[1]], vecs[[2]], vecs[[3]]}];
Dmat = DiagonalMatrix[{Sqrt[Γ], Sqrt[κ1], 
Sqrt[κ2]}];
Diag = DiagonalMatrix[vals];

Check if the diagonalization works. This should give the zero matrix

Inverse[P].M.P - Diag // Simplify

Define the new matrix Modemat taking certain fixed values for the parameters

Modemat = 
Inverse[Diag].Inverse[P].Dmat /. {Γ -> 
 0.01, κ1 -> 1, κ2 -> 20, g2 -> 10};

Recall that now, the matrix elements of Modemat are dependent on ω and g1. Defining the following functions from the matrix elements of Modemat

M11[ω11_, g11_] := 
Modemat[[1, 1]] /. {ω -> ω11, g1 -> g11};
M12[ω12_, g12_] := 
Modemat[[1, 2]] /. {ω -> ω12, g1 -> g12};
M13[ω13_, g13_] := 
Modemat[[1, 3]] /. {ω -> ω13, g1 -> g13};

fsbb[ω_, g1_] := 
300*Abs[M11[ω, g1]]^2 + 0.1*Abs[M12[ω, g1]]^2 + 
0.1*Abs[M13[ω, g1]]^2;

Now I'm interested in finding the area under the curve of fsbb against ω

poptab = Table[{cc1, 
1/(2 π)*
NIntegrate[
 Evaluate[(fsbb[ω, g1]) /. {g1 -> Sqrt[cc1*1*0.01]/
     2}], {ω, -40, 40}]}, {cc1, 0.001, 10^5, 10}]

Here's where the problem lies, upon computing poptab, I was returned with warnings that says Numerical Integration converging too slowly; suspect one of the following: singularity, value of the integration is 0....

And also "NIntegrate failed to converge to prescribed accuracy after 7 \ recursive bisections in ω near {ω} = {0.60181878}. \ NIntegrate obtained 8.5216538.*^-6 and 7.08893718.*^-6 for the \ integral and "

I've Googled with dealing precision issues and tried something like

poptab = Table[{cc1, 
1/(2 π)*
NIntegrate[
 Evaluate[(fsbb[ω, g1]) /. {g1 -> Sqrt[cc1*1*0.01]/
     2}], {ω, -40, 40}, MaxRecursion -> 7, 
 WorkingPrecision -> 8]}, {cc1, 0.001, 10^5, 10}]

But it didn't help and the warnings remain. I know it's just a warning and not an error but it directly affects the NIntegrate function since it spits out different integration values if I tweak around with the MaxRecursion option for the same parameters. I could really use some help troubleshooting this.

Thank you in advance.

Answer 1

Using the even symmetry of the integrand & compiling:

cf = Compile[{ω, cc1}, Evaluate[(fsbb[ω, g1]) /. {g1 -> Sqrt[cc1*1*0.01]/2}]];
obj[ω_?NumericQ, cc1_?NumericQ] := cf[ω, cc1];
cftab = Table[{cc1, 
     2 *
      1/(2 π) * NIntegrate[obj[ω, cc1], {ω, 0, 40}, 
       Method -> {Automatic, "SymbolicProcessing" -> 0}]},
    {cc1, 0.001, 10^5, 10}]; // AbsoluteTiming
(*  {6.10675, Null}  *)

It's slightly faster if the integrals are meant to be over the whole real line and {-40, 40} was an approximation:

cf = Compile[{ω, cc1}, Evaluate[(fsbb[ω, g1]) /. {g1 -> Sqrt[cc1*1*0.01]/2}]];
obj[ω_?NumericQ, cc1_?NumericQ] := cf[ω, cc1];
cftab2 = Table[{cc1, 
     2 *
      1/(2 π) * NIntegrate[obj[ω, cc1], {ω, 0, Infinity}, 
       Method -> {Automatic, "SymbolicProcessing" -> 0}]},
    {cc1, 0.001, 10^5, 10}]; // AbsoluteTiming
(* {5.54248, Null}  *)

Answer 2

The following is computed fast enough. Only NIntegrate::slwcon messages are issued. Are the results something you expect/like?

AbsoluteTiming[
 poptab = 
   Table[{cc1, 
     1/(2 Pi)*
      NIntegrate[
       Evaluate[(fsbb[\[Omega], g1]) /. {g1 -> 
           Sqrt[cc1*1*0.01]/2}], {\[Omega], -40, 40}, 
       MaxRecursion -> 100, PrecisionGoal -> 3, AccuracyGoal -> 4, 
       Method -> {Automatic, "SymbolicProcessing" -> 0}]}, {cc1, 0.001, 10^5, 10}];
 ]

(* {61.8293, Null} *)