Уравнение Шредингера. Прямая задача

К лекции 10 (2024)

Данные рассеяния быстроубывающего потенциала: 
	– дискретный спектр (отрицательные числа), 
	– коэффициенты пропорциональности функций Йоста в точках дискретного спектра (знакопеременные числа),
	– коэффициент отражения (комплекснозначная функция вещественного аргумента).

В этой программе иллюстрируется построение функций Йоста путем численного решения УШ при помощи NDSolve. Данные рассеяния находятся приближенно сканированием решений по λ (точнее, по κ=(Sqrt[-λ]) если λ<0 и по k=(Sqrt[λ]) если λ>0), с достаточно мелким шагом.

Определим решение УШ с заданной асимптотикой (считая, что на концах рассматриваемого интервала потенциал уже нулевой)

xmin=-10;
xmax=10;
lmin=-10;
lmax=10;

nsol[λ_,x0_,as_]:=NDSolveValue[{
psi'[x]==psix[x],
psix'[x]==(u-λ)psi[x],
psi[x0]==(as/.x->x0),
psix[x0]==(D[as,x]/.x->x0)},
{psi[x],psix[x]},{x,xmin,xmax}]

Определим не слишком плохой потенциал. Для λ<0 вычисляем функции Йоста убывающие на разных “бесконечностях” (равных ±10) и вычисляем их вронкиан. Табулируем по κ=(Sqrt[-λ]) и приближенно находим точки, где вронскиан равен 0, это и есть дискретный спектр.

u=((-10)/((Cosh[x-1])^2))+((-3)/((Cosh[x+1])^2));

als=Table[
phi1=nsol[-(kappa^2),xmin,Exp[kappa x]]/.x->0;
psi2=nsol[-(kappa^2),xmax,Exp[-kappa x]]/.x->0;
{kappa,Det[{phi1,psi2}]/(2kappa)},
{kappa,0.02,Sqrt[-lmin],0.01}];

spec={};
Do[If[als[[n,2]]als[[n+1,2]]<0,
AppendTo[spec,((als[[n,1]]als[[n+1,2]]-als[[n+1,1]]als[[n,2]])/(als[[n+1,2]]-als[[n,2]]))]],
{n,1,Length[als]-1}];

-(spec^2)

Для λ>0 вычисляем функции Йоста c тригонометрической асимптотикой, вычисляем матрицу перехода и по ней коэффициент отражения  r=b/a. Он тоже табулируется по k=(Sqrt[λ]).

rlist=Table[
phi1=nsol[(k^2),xmin,Exp[-I k x]]/.x->0;
psi1=nsol[(k^2),xmax,Exp[-I k x]]/.x->0;
t={phi1,Conjugate[phi1]}.Inverse[{psi1,Conjugate[psi1]}];
t[[1,2]]/t[[1,1]],
{k,-Sqrt[lmax],Sqrt[lmax],0.03}];

klist=Table[k,{k,-Sqrt[lmax],Sqrt[lmax],0.03}];
rerlist=Re[rlist];
imrlist=Im[rlist];

GraphicsRow[{
ListPlot[als,
PlotRange->{{0,Sqrt[-lmin]},{-0.01,0.01}},
Joined->True,PlotStyle->Blue,
AxesLabel->{"κ","a(Iκ)"},
BaseStyle->{FontFamily->"Times New Roman",FontSize->16},
Epilog->{Black,PointSize[0.025],Point[{#,0}]&/@spec,
Yellow,PointSize[0.015],Point[{#,0}]&/@spec},
ImageSize->300],
ListPlot[{Transpose[{klist,rerlist}],Transpose[{klist,imrlist}]},
PlotRange->{{-Sqrt[lmax],Sqrt[lmax]},{-1.05,1.05}},
Joined->True,
PlotStyle->{Red,Blue},
PlotLegends->{"Re r(k)","Im r(k)"},
AxesLabel->{"k","r(κ)"},
BaseStyle->{FontFamily->"Times New Roman",FontSize->16},
ImageSize->300]
},ImageSize->700]

Графики самих функций Йоста

Manipulate[
If[λ<=0,kappa=Sqrt[-λ];phi1=nsol[λ,xmin,Exp[kappa x]];psi2=nsol[λ,xmax,Exp[-kappa x]],
k=Sqrt[λ];phi1=nsol[λ,xmin,Exp[-I k x]];psi1=nsol[λ,xmax,Exp[-I k x]]];
Plot[
Evaluate[If[λ<=0,{u,s phi1[[1]],s psi2[[1]],λ},
{u,Re[phi1[[1]]],Im[phi1[[1]]],Re[psi1[[1]]],Im[psi1[[1]]],λ}]],
{x,xmin,xmax},
PlotRange->{{xmin-0.1,xmax+0.1},{lmin-1.1,lmax+0.1}},
Filling->{1->{0,GrayLevel[0.5,0.5]}},
PlotStyle->Evaluate[If[λ<=0,{Black,Blue,Red,Green},{Black,Blue,Cyan,Red,Magenta,Green}]],
AxesLabel->{"x","λ"},
BaseStyle->{FontFamily->"Times New Roman",FontSize->14},
ImageSize->600,
Epilog->{{Black,PointSize[0.012],Point[{0,-((#)^2)}],Yellow,PointSize[0.008],Point[{0,-((#)^2)}]}&/@spec}
],
{{s,50},1,50,Appearance->"Labeled"},
{{λ,lmin},lmin,lmax,Appearance->{"Labeled","Open"}}
]