LaunchKernels[];s0=
;s1=
;a=1/2;p=700;v[i_]:=Transpose[{UnitVector[p+2,i]}]ρTA[r_]:=SumKroneckerProduct[s1,s0,s0,v[n+1]].Transpose[KroneckerProduct[s1,s0,s0,v[n+1]]],{n,0,p}+SumKroneckerProduct[s0,s0,s0,v[n+1]].Transpose[KroneckerProduct[s1,s1,s0,v[n+1]]],{n,0,p}+SumKroneckerProduct[s0,s0,s0,v[n+1]].Transpose[KroneckerProduct[s1,s0,s1,v[n+1]]],{n,0,p}+SumKroneckerProduct[s1,s1,s0,v[n+1]].Transpose[KroneckerProduct[s0,s0,s0,v[n+1]]],{n,0,p}+SumKroneckerProduct[s0,s1,s0,v[n+1]].Transpose[KroneckerProduct[s0,s1,s0,v[n+1]]],{n,0,p}+SumKroneckerProduct[s0,s1,s0,v[n+1]].Transpose[KroneckerProduct[s0,s0,s1,v[n+1]]],{n,0,p}+SumKroneckerProduct[s1,s0,s1,v[n+1]].Transpose[KroneckerProduct[s0,s0,s0,v[n+1]]],{n,0,p}+SumKroneckerProduct[s0,s0,s1,v[n+1]].Transpose[KroneckerProduct[s0,s1,s0,v[n+1]]],{n,0,p}+SumKroneckerProduct[s0,s0,s1,v[n+1]].Transpose[KroneckerProduct[s0,s0,s1,v[n+1]]],{n,0,p}+Sum(n+1)KroneckerProduct[s0,s0,s0,v[n+2]].Transpose[KroneckerProduct[s0,s0,s0,v[n+2]]],{n,0,p}+Sum
1 |
0 |
0 |
1 |
2
a
2n
Tanh[r]
2
Cosh[r]
2
a
2n
Tanh[r]
2
Cosh[r]
2
a
2n
Tanh[r]
2
Cosh[r]
2
a
2n
Tanh[r]
2
Cosh[r]
2
a
2n
Tanh[r]
2
Cosh[r]
2
a
2n
Tanh[r]
2
Cosh[r]
2
a
2n
Tanh[r]
2
Cosh[r]
2
a
2n
Tanh[r]
2
Cosh[r]
2
a
2n
Tanh[r]
2
Cosh[r]
2
a
2n
Tanh[r]
4
Cosh[r]
2
a
2n
Tanh[r]
3
Cosh[r]
(n+1)
KroneckerProduct[s0,s0,s0,v[n+1]].Transpose[KroneckerProduct[s1,s0,s0,v[n+2]]],{n,0,p}+Sum2
a
2n
Tanh[r]
3
Cosh[r]
(n+1)
KroneckerProduct[s0,s1,s0,v[n+1]].Transpose[KroneckerProduct[s0,s0,s0,v[n+2]]],{n,0,p}+Sum2
a
2n
Tanh[r]
3
Cosh[r]
(n+1)
KroneckerProduct[s0,s0,s1,v[n+1]].Transpose[KroneckerProduct[s0,s0,s0,v[n+2]]],{n,0,p}+Sum2
a
2n
Tanh[r]
3
Cosh[r]
(n+1)
KroneckerProduct[s1,s0,s0,v[n+2]].Transpose[KroneckerProduct[s0,s0,s0,v[n+1]]],{n,0,p}+Sum2
a
2n
Tanh[r]
3
Cosh[r]
(n+1)
KroneckerProduct[s0,s0,s0,v[n+2]].Transpose[KroneckerProduct[s0,s1,s0,v[n+1]]],{n,0,p}+Sum2
a
2n
Tanh[r]
3
Cosh[r]
(n+1)
KroneckerProduct[s0,s0,s0,v[n+2]].Transpose[KroneckerProduct[s0,s0,s1,v[n+1]]],{n,0,p}data=ParallelTable[ρτABCD=Chop[ρTA[r]];ρτABCD=Chop[ρτABCD/Tr[ρτABCD]];NeABCD=-2Total[Select[Chop[Eigenvalues[ρτABCD]],#<0&]];{r,NeABCD},{r,0.01,3.5,0.05}];NeABCDData=data[[All,{1,2}]];ListLinePlot[{NeABCDData},PlotRange{0,1},RotateLabelTrue,FrameTrue,FrameStyleDirective[Black,12,Bold],FrameLabel{Style["r",13,Bold,Black],Style["One-Tangle",13,Bold,Black]},PlotStyle{Block,Thickness[0.015],Black},DataRange{0,3.5},PlotLabelStyle["a",13,Black],PlotRangePadding0,ImageSizeMedium]