Clear["`*"]
m = 1;
\[Alpha] = 2;
Subscript[\[Gamma], 1] = 1;
Subscript[\[Gamma], 2] = 0;
c = E^(-\[Alpha]^2/2)/Sqrt[m! LaguerreL[0, -\[Alpha]^2]];
u[x_, y_] = \[Alpha]^x/Sqrt[x!] Sqrt[(x + y)!/x!];
Subscript[s, z][t_] = c^2 ((Subscript[\[Gamma], 2]^2 \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(n = 0\), \(100\)]\(
\*SuperscriptBox[\(u[n, m]\), \(2\)]
\*SuperscriptBox[\(Cos[
\*SqrtBox[\(n + m + 1\)] t]\), \(2\)]\)\) +
Subscript[\[Gamma], 1]^2 \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(n = 0\), \(100\)]\(
\*SuperscriptBox[\(u[n + 1, m]\), \(2\)]
\*SuperscriptBox[\(Sin[
\*SqrtBox[\(n + m + 1\)] t]\), \(2\)]\)\)) - (Subscript[\[Gamma],
1]^2 \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(n = 0\), \(100\)]\(
\*SuperscriptBox[\(u[n + 1, m]\), \(2\)]
\*SuperscriptBox[\(Cos[
\*SqrtBox[\(n + m + 1\)] t]\), \(2\)]\)\) +
Subscript[\[Gamma], 2]^2 \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(n = 0\), \(100\)]\(
\*SuperscriptBox[\(u[n, m]\), \(2\)]
\*SuperscriptBox[\(Sin\ [
\*SqrtBox[\(n + m + 1\)] t]\), \(2\)]\)\)));
m1 = Plot[Subscript[s, z][t], {t, 0, 20}, PlotRange -> All,
PlotStyle -> {Thin, Black}]
a = 1;
b = 1;
\[Alpha] = 2;
n = 50;
m = 1;
Table[Subscript[a, i] =
N[(E^(-\[Alpha]^2/2) \[Alpha]^i Sqrt[(i + m)!])/(
i! Sqrt[m! LaguerreL[0, -\[Alpha]^2]]), 10], {i, 0, n}];
h1 = Table[
I Derivative[1][Subscript[c, i]][
t] == (i a + b/2) Subscript[c, i][t] +
Sqrt[i] Subscript[d, i - 1][t] +
Sqrt[i + 1] Subscript[d, i + 1][t], {i, 0, n}];
h2 = Table[
I Derivative[1][Subscript[d, i]][t] ==
Sqrt[i] Subscript[c, i - 1][t] +
Sqrt[i + 1]
Subscript[c, i + 1][t] + (i a - b/2) Subscript[d, i][t], {i,
0, n}];
h3 = Insert[h2, h1, 1];
h4 = Flatten[h3];
hh1 = ReplacePart[h4,
I Derivative[1][Subscript[c, 0]][t] ==
1/2 b Subscript[c, 0][t] + Subscript[d, 1][t], 1];
hh2 = ReplacePart[hh1,
I Derivative[1][Subscript[c, n]][
t] == (n a + b/2) Subscript[c, n][t] +
Sqrt[n] Subscript[d, n - 1][t], n + 1];
hh3 = ReplacePart[hh2,
I Derivative[1][Subscript[d, 0]][
t] == -(1/2) b Subscript[d, 0][t] + Subscript[c, 1][t], n + 2];
hh4 = ReplacePart[hh3,
I Derivative[1][Subscript[d, n]][t] ==
Sqrt[n] Subscript[c, n - 1][t] + (n a - b/2) Subscript[d, n][t],
2*n + 2];
r1 = Table[Subscript[c, i][t], {i, 0, n}];
r2 = Table[Subscript[d, i][t], {i, 0, n}];
r3 = Insert[r2, r1, 1];
rr1 = Flatten[r3];
ic1 = Table[Subscript[c, i][0] == Subscript[a, i], {i, 0, n}];
ic2 = Table[Subscript[d, i][0] == 0 , {i, 0, n}];
ic3 = Insert[ic2, ic1, 1];
ic = Flatten[ic3];
deg1 = Insert[ic, hh4, 1];
s = NDSolve[deg1, rr1, {t, 0, 20}];
P[t_] = \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 0\), \(n\)]\((Abs[
\(\*SubscriptBox[\(c\), \(i\)]\)[t] /. s]*Abs[
\(\*SubscriptBox[\(c\), \(i\)]\)[t] /. s] - Abs[
\(\*SubscriptBox[\(d\), \(i\)]\)[t] /. s]*Abs[
\(\*SubscriptBox[\(d\), \(i\)]\)[t] /. s])\)\);
m2 = Plot[P[t], {t, 0, 20}, PlotStyle -> {Dashed, Black},
PlotRange -> All]
Show[m1, m2]
m = 1;
\[Alpha] = 2;
Subscript[\[Gamma], 1] = 1;
Subscript[\[Gamma], 2] = 0;
c = E^(-\[Alpha]^2/2)/Sqrt[m! LaguerreL[0, -\[Alpha]^2]];
u[x_, y_] = \[Alpha]^x/Sqrt[x!] Sqrt[(x + y)!/x!];
Subscript[s, z][t_] = c^2 ((Subscript[\[Gamma], 2]^2 \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(n = 0\), \(100\)]\(
\*SuperscriptBox[\(u[n, m]\), \(2\)]
\*SuperscriptBox[\(Cos[
\*SqrtBox[\(n + m + 1\)] t]\), \(2\)]\)\) +
Subscript[\[Gamma], 1]^2 \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(n = 0\), \(100\)]\(
\*SuperscriptBox[\(u[n + 1, m]\), \(2\)]
\*SuperscriptBox[\(Sin[
\*SqrtBox[\(n + m + 1\)] t]\), \(2\)]\)\)) - (Subscript[\[Gamma],
1]^2 \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(n = 0\), \(100\)]\(
\*SuperscriptBox[\(u[n + 1, m]\), \(2\)]
\*SuperscriptBox[\(Cos[
\*SqrtBox[\(n + m + 1\)] t]\), \(2\)]\)\) +
Subscript[\[Gamma], 2]^2 \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(n = 0\), \(100\)]\(
\*SuperscriptBox[\(u[n, m]\), \(2\)]
\*SuperscriptBox[\(Sin\ [
\*SqrtBox[\(n + m + 1\)] t]\), \(2\)]\)\)));
m1 = Plot[Subscript[s, z][t], {t, 0, 20}, PlotRange -> All,
PlotStyle -> {Thin, Black}]
a = 1;
b = 1;
\[Alpha] = 2;
n = 50;
m = 1;
Table[Subscript[a, i] =
N[(E^(-\[Alpha]^2/2) \[Alpha]^i Sqrt[(i + m)!])/(
i! Sqrt[m! LaguerreL[0, -\[Alpha]^2]]), 10], {i, 0, n}];
h1 = Table[
I Derivative[1][Subscript[c, i]][
t] == (i a + b/2) Subscript[c, i][t] +
Sqrt[i] Subscript[d, i - 1][t] +
Sqrt[i + 1] Subscript[d, i + 1][t], {i, 0, n}];
h2 = Table[
I Derivative[1][Subscript[d, i]][t] ==
Sqrt[i] Subscript[c, i - 1][t] +
Sqrt[i + 1]
Subscript[c, i + 1][t] + (i a - b/2) Subscript[d, i][t], {i,
0, n}];
h3 = Insert[h2, h1, 1];
h4 = Flatten[h3];
hh1 = ReplacePart[h4,
I Derivative[1][Subscript[c, 0]][t] ==
1/2 b Subscript[c, 0][t] + Subscript[d, 1][t], 1];
hh2 = ReplacePart[hh1,
I Derivative[1][Subscript[c, n]][
t] == (n a + b/2) Subscript[c, n][t] +
Sqrt[n] Subscript[d, n - 1][t], n + 1];
hh3 = ReplacePart[hh2,
I Derivative[1][Subscript[d, 0]][
t] == -(1/2) b Subscript[d, 0][t] + Subscript[c, 1][t], n + 2];
hh4 = ReplacePart[hh3,
I Derivative[1][Subscript[d, n]][t] ==
Sqrt[n] Subscript[c, n - 1][t] + (n a - b/2) Subscript[d, n][t],
2*n + 2];
r1 = Table[Subscript[c, i][t], {i, 0, n}];
r2 = Table[Subscript[d, i][t], {i, 0, n}];
r3 = Insert[r2, r1, 1];
rr1 = Flatten[r3];
ic1 = Table[Subscript[c, i][0] == Subscript[a, i], {i, 0, n}];
ic2 = Table[Subscript[d, i][0] == 0 , {i, 0, n}];
ic3 = Insert[ic2, ic1, 1];
ic = Flatten[ic3];
deg1 = Insert[ic, hh4, 1];
s = NDSolve[deg1, rr1, {t, 0, 20}];
P[t_] = \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 0\), \(n\)]\((Abs[
\(\*SubscriptBox[\(c\), \(i\)]\)[t] /. s]*Abs[
\(\*SubscriptBox[\(c\), \(i\)]\)[t] /. s] - Abs[
\(\*SubscriptBox[\(d\), \(i\)]\)[t] /. s]*Abs[
\(\*SubscriptBox[\(d\), \(i\)]\)[t] /. s])\)\);
m2 = Plot[P[t], {t, 0, 20}, PlotStyle -> {Dashed, Black},
PlotRange -> All]
Show[m1, m2]