c=3*;m=(0.16*5.1*)/();ℏ=6.6*;v=5*;λ=0.5*1.65*;g=8.4;mu=5.78*;Δ=-0.5*g*mu*B;ω0=(ℏ*B)/(m);ωD=,i,j,one,a,adag,wa,qd,H,Es,list,nn,x},one=IdentityMatrix[L,SparseArray,WorkingPrecisionMachinePrecision];a=SparseArray{j_,i_}/;i-j==1->*λ*(a.a.a+adag.adag.adag);qd=ω0*(adag.a);H[B_]=ArrayFlatten[Normal[{{(Δ+0.5*ω0)*one+qd+wa,*ωD*a},{-*ωD*adag,(-Δ+0.5*ω0)*one+qd-wa}}]];list[B_?NumericQ]:=Sort@Eigenvalues[H[N[B]]];list[B_?NumericQ,nn_]:=list[B][[nn]];Plot[Evaluate@Transpose@Delete[Table[list[B,nn],{nn,2*L}],L+1],{B,0,40},PlotRange->{{0,40},{-0.1,0.1}},ImageSize->500]
8
10
5
10
2
c
-16
10
5
10
-28
10
-5
10
2*ℏ*B*v^2
;ll=(2*B)/(ℏ)
;Block{L=100,Γ=1.3*-3
10
j
,{L,L},0.;adag=SparseArray{j_,i_}/;j-i==1->i
,{L,L},0.;wa=3
ll
Out[]=
