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$
  • $\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 '19 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$ – Ragab Zidan Oct 18 '19 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 '19 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 '19 at 9:24
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, privacy policy and cookie policy

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