1
$\begingroup$

When I try to draw the next code I get a curve with missing parts, as shown in the picture. I do not know if it is an precision enter image description hereproblem in the Mathematica program or is some data not calculated. Or is it a problem in the way of writing code ?. I'm sure that oriented should be connected.

r=2.0;

T=0.05;
β=1/T;
J=1.0;

Clear@UL;UL[B_]:=(


η =Sqrt[J^2+B^2 r^4];

Z=2( Cosh[(2 J β)/r^2]+Cosh[(2 β η)/r^2]);

Subscript[μ, +]=1/(2Z) ( E^(-((2 J β)/r^2))+Cosh[(2 β η)/r^2]-J/η Sinh[(2 β η)/r^2]); 
Subscript[ϵ, -]=1/(2Z) (- E^(-((2 J β)/r^2))+Cosh[(2 β η)/r^2]-J/η Sinh[(2 β η)/r^2]);
Subscript[ϵ, +]=1/(2Z) ( E^((2 J β)/r^2)+Cosh[(2 β η)/r^2]+J/η Sinh[(2 β η)/r^2]);
Subscript[μ, -]=1/(2Z) (-E^(((2 J β)/r^2))+ Cosh[(2 β η)/r^2]+J/ η Sinh[(2 β η)/r^2]);
\[ScriptK]=-((B r^2 Sinh[(2 β η)/r^2])/(2 η Z));

X1=Cosh[(2 J β)/r^2]/Z;
X2=Cosh[(2 J β)/r^2]/Z;
X3=1/Z (Cosh[(2 β η)/r^2]+(B (r^2) )/ η Sinh[(2 β η)/r^2]);
X4=1/Z (Cosh[(2 β η)/r^2]-(B (r^2) )/ η Sinh[(2 β η)/r^2]);
ϖ=Sqrt[(Sinh[(2 J β)/r^2]+J/η Sinh[(2 β η)/r^2])^2+(B^2 r^4 Sinh[(2 β η)/r^2]^2)/ (η^2) ];
Z1=1/4 -ϖ/(2Z);
Z2=1/4 -ϖ/(2Z);
Z3=1/4 +ϖ/(2Z);
Z4=1/4 +ϖ/(2Z);

B1=1/2 (1-4 \[ScriptK]);
B2=1/2 (1+4 \[ScriptK]);

SρσxB=-X1*Log[2,X1]-X2*Log[2,X2]-X3*Log[2,X3]-X4*Log[2,X4];  
SρσzB=-Z1*Log[2,Z1]-Z2*Log[2,Z2]-Z3*Log[2,Z3]-Z4*Log[2,Z4]; 
SρB=-B1*Log[2,B1]-B2*Log[2,B2];

SρσxB+SρσzB-2*SρB)
ULPlot=Plot[UL[B],{B,0.02,10},PlotRange->All]
$\endgroup$
4
  • $\begingroup$ UL evaluates to Indeterminate for some values of B. Try, for example, UL /@ {3., 3.1, 3.15, 5.9, 6.} $\endgroup$
    – kglr
    Oct 18, 2019 at 8:36
  • $\begingroup$ You are right UL evaluates to Indeterminate for some values of B. When I searched why UL evaluates to Indeterminate I noticed that this was due to the precision of Mathematica fore examble the values which is Almost equal ([TildeEqual]) 0.25 the program considers it =0.25 and this leads to ln[.25-0.25] Indeterminate. Do you know how to solve this problem? $\endgroup$
    – Bekaso
    Oct 18, 2019 at 9:08
  • $\begingroup$ For some values of B you have to resolve the limit Limit[x Log[x],x->0]. You can manually set it to zero or replace with series. $\endgroup$
    – yarchik
    Oct 18, 2019 at 9:23
  • $\begingroup$ Ragab, try (1) rationalize r, T and J, that is define them as r = 2;T = 5/100;J = 1; (2) set precision of UL to Infinity, that is, UL[B_] := SetPrecision[your code, Infinity] and (3) use a high working precision in Plot: e.g., Plot[UL[B], {B, 0.02, 10}, PlotRange -> All, WorkingPrecision -> 400] $\endgroup$
    – kglr
    Oct 18, 2019 at 9:24

1 Answer 1

3
$\begingroup$

(1) Rationalize r, T and J, that is define them as

r = 2; T = 5/100; J = 1;

(2) Set precision of UL to Infinity, that is, use

 UL[B_] := SetPrecision[your code, Infinity]

(3) Use a high working precision in Plot: e.g.,

 Plot[UL[B], {B, 0.02, 10}, PlotRange -> All, WorkingPrecision -> 400] 

to get

enter image description here

Note: removed the lines starting with Subscript[...]= in your code as they are not used anywhere in the rest of your code block.

$\endgroup$

Your Answer

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

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