Волновая функция для 4-солитонного решения КдФ

К лекции 3 (2024)

Формула для n-солитонного решения КдФ:

(1)	u=-2(∂_x^2) log W((Subscript[y, 1]),...,(Subscript[y, n])),    (Subscript[y, j])=(e^(Subscript[X, j]))+(((-1))^(n-j))(e^(-(Subscript[X, j]))),    (Subscript[X, j])=(Subscript[k, j])x+4(Subscript[k, j]^3)t+(Subscript[δ, j]),    0<(Subscript[k, n])<...<(Subscript[k, 1]).

(2)	 (Subscript[c, j])=(((-1))^(n-j))(e^(2(Subscript[δ, j]))),     j=1,...,n.

Соответствующее частное решение уравнения Шрёдингера

(3)	ψ''=(u-λ)ψ,   -(z^2)=λ,

имеет вид

(4)	ψ(z) = (e^X)Φ(z) = (e^(z x + 4 (z^3)t)) ((z^n)+(z^(n-1))(Subscript[φ, 1])+...+(Subscript[φ, n]))= W((Subscript[y, 1]),...,(Subscript[y, n]),(e^(z x+4(z^3)t)))/W((Subscript[y, 1]),...,(Subscript[y, n])).

Мы ограничимся случаем n=4 для конкретных численных параметров (Subscript[k, j]),(Subscript[δ, j]).

•  Одна из функций ψ(z) и ψ(-z) экспоненциально убывает при x->+∞, другая при x->-∞. В точках (Subscript[λ, j])=-(Subscript[k, j]^2) эти функции становятся линейно зависимыми и определяют собственную функцию оператора Шрёдингера, с точностью до нормировки.

•  Собственные значения принято нумеровать по возрастанию.У нас они все отрицательные, (Subscript[λ, j])=-(Subscript[k, j]^2), поэтому (Subscript[λ, n]) – самое маленькое по абсолютной величине:

(Subscript[λ, 1])<...<(Subscript[λ, n])<0.

Числа (Subscript[k, j]) мы для определенности будем считать положительными, тогда они упорядочены так, как указано в (1).

•  Правило чередования знаков (2) обеспечивает регулярность потенциала (и волновых функций).

Вычисления

n=4;   (* число солитонов *)
X[j_]:=x K[j]+4t ((K[j])^3)+d[j]
Y[j_]:=Exp[X[j]]+(((-1))^(n-j))Exp[-X[j]]

w=Det[Table[D[Y[j],{x,k}],{j,1,n},{k,0,n-1}]];
w1=Det[Append[Table[D[Y[j],{x,k}],{j,1,n},{k,0,n}],Table[(z^k),{k,0,n}]]];

(* параметры *)
par={K[1]->0.95,K[2]->0.75,K[3]->0.6,K[4]->0.35,
d[1]->-5,d[2]->1.3,d[3]->0.3,d[4]->-0.2};

(* потенциал *)
u=-2D[D[w,x]/w,x]/.par;
cu=Compile[{{x,_Real},{t,_Real}},Evaluate[u]];

(* psi-функция. Множитель 3 введен произвольно, чтобы отмасштабировать график в данном конкретном примере *)
Psi=3Exp[x z+4t (z^3)]w1/w/.par;
cpsi=Compile[{{x,_Real},{t,_Real},{z,_Real}},Evaluate[Psi]];

(* регуляризуем собственные функции, чтобы подавить численные ошибки на краях *)
regpsi[x_,t_,z_]:=If[
Min[Abs[Table[K[j]/.par,{j,1,n}]-Abs[z]]]>0.001,
cpsi[x,t,z],
If[x z+4t (z^3)<0,cpsi[x,t,z],cpsi[0,0,z]/cpsi[0,0,-z]cpsi[x,t,-z]]]

Зависимость от z при фиксированном t

Вот на что нужно обратить внимание:

– при z ≥ (Subscript[k, 1]) функция ψ(z) не имеет нулей на оси x;

– при уменьшении z до 0, нули «заходят» в ψ(z) через x=+∞, при прохождении z через (Subscript[k, j]), и движутся налево. В результате, при каждом z∈[(Subscript[k, j+1]),(Subscript[k, j])) эта функция имеет j нулей по x (n при 0≤z<(Subscript[k, n]));

– при дальнейшем уменьшении z нули «выходят» через x=-∞, когда z проходит -(Subscript[k, j]);

– у функции ψ(-z) естественно, все наоборот.

– при каждом фиксированном x функция ψ(z,x) имеет ровно n нулей по z:

ψ(z) = (e^X)Φ(z) =(e^X)(z-(Subscript[r, 1])(x))...(z-(Subscript[r, n])(x)),

grz[z_,t_]:=Plot[{regpsi[x,t,z],regpsi[x,t,-z],cu[x,t]},{x,-40,40},
PlotRange->{{-40,40},{-2.1,2.1}},
Filling->{3->0},
AxesLabel->{" \!\(\*SubscriptBox[\(x\), \(\\ \)]\)","ψ(x,t;z\!\(\*SubscriptBox[\()\), \(\\ \)]\)"},
BaseStyle->{FontSize->14,FontFamily->"Times New Roman"},
PlotStyle->{Blue,Red,Black},
ImageSize->500,
Epilog->{
Text["\!\(\*SubscriptBox[\(t\), \(\\ \)]\)\!\(\*SubscriptBox[\(=\), \(\\ \)]\)"<>ToString[N[t]],{13,2.0},{-1,0}],
Style[Text["\!\(\*SubscriptBox[\(z\), \(\\ \)]\)\!\(\*SubscriptBox[\(=\), \(\\ \)]\)"<>ToString[N[z]],{13,1.7},{-1,0}],
If[Min[Abs[Abs[z]-{K[1],K[2],K[3],K[4],0}/.par]]<0.001,
{Bold,Red},Black]]},
PlotLegends->LineLegend[Automatic,{"ψ(z)","ψ(-z)","u"}]
]

Manipulate[grz[z,t],
{{z,1},-1,1,0.01,Appearance->{"Labeled","Open"}},
{{t,0.3},-8,8,0.01,Appearance->"Labeled"}]

Зависимость от t для собственных функций

Нормируем с.ф. на 1.

Do[norm[i]=Sqrt[NIntegrate[((regpsi[x,0,K[i]/.par])^2),{x,-40,40}]],{i,1,4}]

grt[t_]:=Plot[{
regpsi[x,t,K[1]/.par]/norm[1]-((K[1])^2)/.par,
regpsi[x,t,K[2]/.par]/norm[2]-((K[2])^2)/.par,
regpsi[x,t,K[3]/.par]/norm[3]-((K[3])^2)/.par,
regpsi[x,t,K[4]/.par]/norm[4]-((K[4])^2)/.par,
cu[x,t]},{x,-41,41},
PlotRange->{{-41,41},{-2.05,0.35}},
Filling->{1->(-((K[1])^2)/.par),
2->(-((K[2])^2)/.par),
3->(-((K[3])^2)/.par),
4->(-((K[4])^2)/.par),
5->0},
AxesLabel->{" \!\(\*SubscriptBox[\(x\), \(\\ \)]\)",None},
BaseStyle->{FontSize->14,FontFamily->"Times New Roman"},
PlotStyle->{Red,Green,Blue,Cyan,Black},
ImageSize->500,
Epilog->{
Text["\!\(\*SubscriptBox[\(t\), \(\\ \)]\)\!\(\*SubscriptBox[\(=\), \(\\ \)]\)"<>ToString[N[t]],{30,0.2},{-1,0}]},
PlotLegends->LineLegend[Automatic,{"ψ((Subscript[k, 1]))","ψ((Subscript[k, 2]))","ψ((Subscript[k, 3]))","ψ((Subscript[k, 4]))","u"}]
]

Manipulate[grt[t],
{{t,-12},-12,12,0.05,Appearance->{"Labeled","Open"}}]