0
$\begingroup$
I am trying to make the plots using the second equation from the  appendix B.5 from the paper (https://arxiv.org/pdf/cond-mat/0008249.pdf) which is basically integration of polarization function.

My code is given as below:

    In[150]:= d = 1;
    t = 10^-5 d;
    avn = 0.875;
    q0 = 0.5;
    v = 0.5 d;
    ufc = 0.1 d;
    \[Epsilon]f0 = -0.736;
    \[Epsilon]f = 0.0985;
    \[Mu] = 0.0962;
    a = 0.0846;
    avnf = 0.5 - a^2;
    avnc = avn - avnf;
    \[Nu] = 10^-7;
    m = (3 \[Pi]^2/Sqrt[2])^(2/3) 1/(2 d);
    kval[\[Epsilon]_] := Sqrt[2 m (\[Epsilon] + d)];
    ds[\[Epsilon]_] := 3/(4 Sqrt[2] d) Sqrt[(\[Epsilon] + d)/d];
    
    bepsk[\[Epsilon]_] := \[Epsilon] + ufc avnf;
    bepskq [\[Epsilon]_, q_, \[Theta]_] := 
      bepsk[\[Epsilon]] + kval[\[Epsilon]] q Cos[\[Theta]]/m + q^2/(2 m);
    rk[\[Epsilon]_] := 
      Sqrt[(\[Epsilon]f - bepsk[\[Epsilon]])^2 + (2 v a)^2];
    rkq[\[Epsilon]_, q_, \[Theta]_] := 
      Sqrt[(\[Epsilon]f - bepskq[\[Epsilon], q, \[Theta]])^2 + (2 v a)^2];
    akq[\[Epsilon]_, q_, \[Theta]_] := v a/rkq[\[Epsilon], q, \[Theta]];
    bkq[\[Epsilon]_, q_, \[Theta]_] := -v a/rkq[\[Epsilon], q, \[Theta]];
    ak[\[Epsilon]_] := v a/rk[\[Epsilon]];
    bk[\[Epsilon]_] := -v a/rk[\[Epsilon]];
    uk2 [\[Epsilon]_] := 
      0.5 (1 - (\[Epsilon]f - bepsk[\[Epsilon]])/rk[\[Epsilon]]);
    ukq2 [\[Epsilon]_, q_, \[Theta]_] := 
      0.5 (1 - (\[Epsilon]f - bepskq [\[Epsilon], q, \[Theta]])/
         rkq[\[Epsilon], q, \[Theta]]);
    vk2 [\[Epsilon]_] := 
      0.5 (1 + (\[Epsilon]f - bepsk[\[Epsilon]])/rk[\[Epsilon]]);
    vkq2 [\[Epsilon]_, q_, \[Theta]_] := 
      0.5 (1 + (\[Epsilon]f - bepskq [\[Epsilon], q, \[Theta]])/
         rkq[\[Epsilon], q, \[Theta]]);
    
    In[178]:= 
    E1k[\[Epsilon]_] := 
      0.5 (\[Epsilon]f + bepsk[\[Epsilon]] + rk[\[Epsilon]]);
    E1kq[\[Epsilon]_, q_, \[Theta]_] := 
      0.5 (\[Epsilon]f + bepskq[\[Epsilon], q, \[Theta]] + 
         rkq[\[Epsilon], q, \[Theta]]);
    E2k[\[Epsilon]_] := 
      0.5 (\[Epsilon]f + bepsk[\[Epsilon]] - rk[\[Epsilon]]);
    E2kq[\[Epsilon]_, q_, \[Theta]_] := 
      0.5 (\[Epsilon]f + bepskq[\[Epsilon], q, \[Theta]] - 
         rkq[\[Epsilon], q, \[Theta]]);
    nf1kq[\[Epsilon]_, q_, \[Theta]_] := 
      0.5 (1 - Tanh[((E1kq[\[Epsilon], q, \[Theta]] - \[Mu])/(2 t))]);
    nf2kq[\[Epsilon]_, q_, \[Theta]_] := 
      0.5 (1 - Tanh[((E2kq[\[Epsilon], q, \[Theta]] - \[Mu])/(2 t))]);
    nf1k[\[Epsilon]_] := 0.5 (1 - Tanh[((E1k[\[Epsilon]] - \[Mu])/(2 t))]);
    nf2k[\[Epsilon]_] := 
      0.50 (1 - Tanh[((E2k[\[Epsilon]] - \[Mu])/(2 t))]);
    
    In[186]:= 
    part1[\[Epsilon]_, q_, \[Theta]_] := (
      vkq2[\[Epsilon], 
        q, \[Theta]] vk2[\[Epsilon]] (nf1kq[\[Epsilon], q, \[Theta]] - 
         nf1k[\[Epsilon]]))/(
      E1k[\[Epsilon]] - E1kq[\[Epsilon], q, \[Theta]] + I \[Nu]);
    part2[\[Epsilon]_, q_, \[Theta]_] := (
     vkq2[\[Epsilon], 
       q, \[Theta]] uk2[\[Epsilon]] (nf1kq[\[Epsilon], q, \[Theta]] - 
        nf2k[\[Epsilon]]))/(
     E2k[\[Epsilon]] - E1kq[\[Epsilon], q, \[Theta]] + I \[Nu]); 
    part3[\[Epsilon]_, q_, \[Theta]_] := (
     ukq2[\[Epsilon], 
       q, \[Theta]] vk2[\[Epsilon]] (nf2kq[\[Epsilon], q, \[Theta]] - 
        nf1k[\[Epsilon]]))/(
     E1k[\[Epsilon]] - E2kq[\[Epsilon], q, \[Theta]] + I \[Nu]); 
    part4[\[Epsilon]_, q_, \[Theta]_] := (
     ukq2[\[Epsilon], 
       q, \[Theta]] uk2[\[Epsilon]] (nf2kq[\[Epsilon], q, \[Theta]] - 
        nf2k[\[Epsilon]]))/(
     E2k[\[Epsilon]] - E2kq[\[Epsilon], q, \[Theta]] + I \[Nu]);
    
    In[188]:= 
    Mff[\[Epsilon]_, q_, \[Theta]_] := 
      ds[\[Epsilon]] (part1[\[Epsilon], q, \[Theta]] + 
         part2[\[Epsilon], q, \[Theta]] + part3[\[Epsilon], q, \[Theta]] +
          part4[\[Epsilon], q, \[Theta]]);
    Pff[q_] := 
      NIntegrate[ -Mff[\[Epsilon], q, \[Theta]] Sin[\[Theta]], {\[Theta], 
        0, \[Pi]}, {\[Epsilon], -d, d}, MaxRecursion -> 60, 
       Method -> {GlobalAdaptive, MaxErrorIncreases -> 8000}, 
       WorkingPrecision -> 10];
    
    In[190]:= 
    qa = 0;
    qb = 2;
    Ns = 10;
    h = (qb - qa)/(Ns - 1);
    res = {};
    For[i = 0, i < Ns, i++,
     q = qa + h *i;
      AppendTo[res, q];
     res]
    
    data =  {};
    For[i = 1, i <= Ns, i++,
       AppendTo[data , {res[[i]] // N, Re[Pff[res[[i]]]]}]];
    
    
    
    In[198]:= ListLinePlot[
     Table[{data[[i, 1]], data[[i, 2]]}, {i, 1, Length[data]}], 
     Frame -> True, PlotStyle -> Blue, PlotRange -> Full, 
     FrameLabel -> {"q", "Polre"}]

)

I also followed https://mathematica.stackexchange.com/questions/85694/numerical-integration-converging-too-slowly but with no success.

My function involves Tan hyberbolic function and is the reason it is converging slowly.

Runnnig the code gave me an error

During evaluation of In[190]:= NIntegrate::slwcon: Numerical integration converging too slowly; suspect one of the following: singularity, value of the integration is 0, highly oscillatory integrand, or WorkingPrecision too small. During evaluation of In[190]:= General::stop: Further output of NIntegrate::slwcon will be suppressed during this calculation.

Could someone help me out?
$\endgroup$
4
  • $\begingroup$ Plot3D[-Mff[\[Epsilon], q, \[Theta]] Sin[\[Theta]], {\[Theta], 0, \[Pi]}, {\[Epsilon], -d, d}] shows integrand, which is only defined in a small part of the integration range! $\endgroup$ Commented Jan 5, 2023 at 7:16
  • $\begingroup$ Thank you for the reply so whatever written in the codes its correct right? Also do i need to modify anything in the codes? $\endgroup$
    – Tiku
    Commented Jan 5, 2023 at 12:55
  • $\begingroup$ Shouldn't the integrand be defined real in the whole integration range? $\endgroup$ Commented Jan 5, 2023 at 13:21
  • $\begingroup$ I have extracted only the real part in the above code which is Re[Pff[res[[i]]]]. $\endgroup$
    – Tiku
    Commented Jan 5, 2023 at 15:08

0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.