Kvanttimekaniikka II luennot, kevät 2005
Mikko Saarela

Eulerin kulmat

Luentomoniste s. 90

Clear[a, b, g]
R1 = {{Cos[a], -Sin[a], 0}, {Sin[a], Cos[a], 0}, {0, 0, 
            1}};
R2 = {{Cos[b], 0, Sin[b]}, {0, 1, 0}, {-Sin[b], 0, 
            Cos[b]}};
R3 = {{Cos[g], -Sin[g], 0}, {Sin[g], Cos[g], 0}, {0, 0, 
            1}};

Ry[a_, b_, g_] = R3 . R2 . R1 // Expand
Ry[0, b, 0] // MatrixForm

<< Graphics`Shapes`

ex = {3, 0, 0}; yy = {0, 3, 0}; 
    tset = {0, 0, 3};
di = 1.4 
kuva = 
        Plot3D[0, {x, -di, di}, {y, -di, di}, Axes -> False, 
          Mesh -> False, Boxed -> False, 
          DisplayFunction -> Identity];
α = 0;
β = 0;
γ = 0; 
    poly := Graphics3D[{RGBColor[1, 0, 0], 
          Polygon[{Ry[α, β, γ] . ex, 
              Ry[α, β, γ] . yy, 
              Ry[α, β, γ] . tset}]}]
koordi = {Graphics3D[Line[{{0, 0, 0}, ex*1.2}]], 
        Graphics3D[Line[{{0, 0, 0}, yy*1.2}]], 
        Graphics3D[Line[{{0, 0, 0}, tset*1.2}]], 
        Graphics3D[Text["x", ex*1.3]], Graphics3D[Text["y", yy*1.3]], 
        Graphics3D[Text["z", tset*1.4]]}

    
Show[{kuva, koordi, poly}, DisplayFunction -> $DisplayFunction, 
      ViewPoint -> {6, -0.5, 0.5}, 
      TextStyle -> {FontSize -> 16}]

SetDirectory["D:/Mikko/opetus/kvmii"];
Display["kuva36.eps", %15, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\5.0\
"];

α = 0;
β = 0;
γ = Pi/6;
\(\(\(uusi = {Graphics3D[{Dashing[{0.02, 0.02}], 
            Line[{{0, 0, 0}, Ry[α, β, γ] . ex*1.2}]}], 
        Graphics3D[{Dashing[{0.02, 0.02}], 
            Line[{{0, 0, 0}, Ry[α, β, γ] . yy*1.2}]}], 
        Graphics3D[{RGBColor[1, 0, 0], Thickness[0.01], 
            Line[{{0, 0, 0}, Ry[α, β, γ] . tset*1.2}]}], 
        Graphics3D[
          Text[\*""\!\(x\_1\)"", 
            Ry[α, β, γ] . ex*1.3]], 
        Graphics3D[
          Text[\*""\!\(y\_1\)"", 
            Ry[α, β, γ] . yy*1.3]], 
        Graphics3D[
          Text[\*""\!\(z\_1\)"", 
            Ry[α, β, γ] . 
                tset*1.7]]}\)\(
\)
    \)\)
kulma = {Graphics3D[{RGBColor[1, 0, 0], Dashing[{0.01, 0.01}], 
            Thickness[0.005], 
            Line[{{3, 0, 0}, Ry[α, β, γ] . {3, 0, 0}}]}], 
        Graphics3D[
          Text["γ", {3.5, 
              0.5, -0.5}]]}

    
Show[{kuva, koordi, poly, uusi, kulma}, 
      DisplayFunction -> $DisplayFunction, 
      ViewPoint -> {1, -0.5, 0.5}, 
      TextStyle -> {FontSize -> 16}]

SetDirectory["D:/Mikko/opetus/kvmii"];
Display["kuva37.eps", %24, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\5.0\
"];

α = 0;
β = Pi/6;
γ = Pi/6;
\(\(\(uusi = {Graphics3D[{Dashing[{0.02, 0.02}], 
            Line[{{0, 0, 0}, Ry[α, β, γ] . ex*1.2}]}], 
        Graphics3D[{Dashing[{0.02, 0.02}], 
            Line[{{0, 0, 0}, Ry[α, β, γ] . yy*1.2}]}], 
        Graphics3D[{Dashing[{0.02, 0.02}], 
            Line[{{0, 0, 0}, Ry[α, β, γ] . tset*1.2}]}], 
        Graphics3D[{RGBColor[1, 0, 0], Thickness[0.01], 
            Line[{{0, 0, 0}, Ry[α, β, γ] . yy*1.2}]}], 
        Graphics3D[
          Text[\*""\!\(x\_2\)"", 
            Ry[α, β, γ] . ex*1.3]], 
        Graphics3D[
          Text[\*""\!\(y\_2\)"", 
            Ry[α, β, γ] . yy*1.3]], 
        Graphics3D[
          Text[\*""\!\(y\_1\)"", 
            Ry[α, β, γ] . yy*1.5]], 
        Graphics3D[
          Text[\*""\!\(z\_2\)"", 
            Ry[α, β, γ] . 
                tset*1.3]]}\)\(
\)
    \)\)
\(\(\(vanha = {Graphics3D[{Dashing[{0.02, 0.02}], 
            Line[{{0, 0, 0}, Ry[0, 0, γ] . ex}]}], 
        Graphics3D[
          Text[\*""\!\(x\_1\)"", Ry[0, 0, γ] . ex*1.1]], 
        Graphics3D[{Dashing[{0.02, 0.02}], 
            Line[{{0, 0, 0}, 
                Ry[α, β, γ] . 
                  ex}]}]}\)\(
\)\(
\)
    \)\)
kulma = {Graphics3D[{RGBColor[1, 0, 0], Dashing[{0.01, 0.01}], 
            Thickness[0.005], 
            Line[{{3, 0, 0}, Ry[0, 0, γ] . {3, 0, 0}}]}], 
        Graphics3D[{RGBColor[1, 0, 0], Dashing[{0.01, 0.01}], 
            Thickness[0.005], 
            Line[{Ry[α, 0, γ] . {3, 0, 0}, 
                Ry[α, β, γ] . {3, 0, 0}}]}], 
        Graphics3D[Text["γ", {3.1, 0.5, -0.5}]], 
        Graphics3D[
          Text["β", {3.1, 1. , 
              0.5}]]
}

    
Show[{kuva, koordi, poly, uusi, vanha, kulma}, 
      DisplayFunction -> $DisplayFunction, 
      ViewPoint -> {3, 0.5, 0.5}, 
      TextStyle -> {FontSize -> 16}]

SetDirectory["D:/Mikko/opetus/kvmii"];
Display["kuva38.eps", %75, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\5.0\
"];

α = Pi/6;
β = Pi/6;
γ = Pi/6;
\(\(\(uusi = {Graphics3D[{Dashing[{0.02, 0.02}], 
            Line[{{0, 0, 0}, Ry[α, β, γ] . ex*1.2}]}], 
        Graphics3D[{Dashing[{0.02, 0.02}], 
            Line[{{0, 0, 0}, Ry[α, β, γ] . yy*1.2}]}], 
        Graphics3D[{Dashing[{0.02, 0.02}], 
            Line[{{0, 0, 0}, Ry[α, β, γ] . tset*1.2}]}], 
        Graphics3D[{RGBColor[1, 0, 0], Thickness[0.01], 
            Line[{{0, 0, 0}, Ry[α, β, γ] . tset*1.2}]}], 
        Graphics3D[
          Text[\*""\!\(x\_3\)"", 
            Ry[α, β, γ] . ex*1.3]], 
        Graphics3D[
          Text[\*""\!\(y\_3\)"", 
            Ry[α, β, γ] . yy*1.3]], 
        Graphics3D[
          Text[\*""\!\(z\_3\)"", 
            Ry[α, β, γ] . tset*1.4]], 
        Graphics3D[
          Text[\*""\!\(z\_2\)"", 
            Ry[α, β, γ] . 
                tset*1.7]]}\)\(
\)
    \)\)
\(\(\(vanha = {Graphics3D[{Dashing[{0.02, 0.02}], 
            Line[{{0, 0, 0}, Ry[0, 0, γ] . ex}]}], 
        Graphics3D[
          Text[\*""\!\(x\_1\)"", Ry[0, 0, γ] . ex*1.1]], 
        Graphics3D[
          Text[\*""\!\(x\_2\)"", Ry[0, β, γ] . ex*1.1]], 
        Graphics3D[{Dashing[{0.02, 0.02}], 
            Line[{{0, 0, 0}, 
                Ry[0, β, γ] . ex}]}]}\)\(
\)
    \)\)
\(\(\(kulma = {Graphics3D[{RGBColor[1, 0, 0], Dashing[{0.01, 0.01}], 
            Thickness[0.005], 
            Line[{{3, 0, 0}, Ry[0, 0, γ] . {3, 0, 0}}]}], 
        Graphics3D[{RGBColor[1, 0, 0], Dashing[{0.01, 0.01}], 
            Thickness[0.005], 
            Line[{Ry[0, 0, γ] . {3, 0, 0}, 
                Ry[0, β, γ] . {3, 0, 0}}]}], 
        Graphics3D[{RGBColor[1, 0, 0], Dashing[{0.01, 0.01}], 
            Thickness[0.005], 
            Line[{Ry[0, β, γ] . ex, 
                Ry[α, β, γ] . ex}]}], 
        Graphics3D[Text["γ", {3.1, 0.5, \(-0.2\)}]], 
        Graphics3D[
          Text["β", {3.1, 
              1.3, \(-0.5\)}]], 
Graphics3D[
          Text["α", {3.1, 
              2.2, \(-1.5\)}]]
}\)\(
\)
    \)\)
Show[{kuva, koordi, poly, uusi, vanha, kulma}, 
      DisplayFunction -> $DisplayFunction, 
      ViewPoint -> {6, 0.5, 0.5}, 
      TextStyle -> {FontSize -> 16}]

SetDirectory["D:/Mikko/opetus/kvmii"];
Display["kuva39.eps", %92, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\5.0\
"];

Animaatio Eulerin kulmista

alfa = Pi/2; bet = Pi/2; gam = Pi;
Clear[gee, h, k, ef]
gee[n_] := n*alfa /; 0 ≤ n ≤ 1
gee[n_] := alfa /; n > 1
h[n_] := 0 /; n < 1
h[n_] := (n - 1)*bet /; 1 ≤ n ≤ 2
h[n_] := bet /; n > 2
k[n_] := 0 /; n < 2
k[n_] := (n - 2)*gam /; 2 ≤ n ≤ 3
k[n_] := gam /; n > 3

ef[n_] := 
      Graphics3D[{RGBColor[1, 0, 0], Thickness[0.01], 
            Line[{{0, 0, 0}, tset*1.2}]}] /; n < 1
ef[n_] := 
      Graphics3D[{RGBColor[1, 0, 0], Thickness[0.01], 
            Line[{{0, 0, 0}, Ry[0, 0, alfa] . yy}]}] /; 
        1 ≤ n < 2
ef[n_] := 
      Graphics3D[{RGBColor[1, 0, 0], Thickness[0.01], 
            Line[{{0, 0, 0}, Ry[0, bet, alfa] . tset*1.2}]}] /; 
        2 ≤ n ≤ 3

Table[
        Show[{kuva, 
            Graphics3D[{Dashing[{0.02, 0.02}], 
                Line[{{0, 0, 0}, Ry[k[n], h[n], gee[n]] . yy}]}], 
            Graphics3D[{Dashing[{0.02, 0.02}], 
                Line[{{0, 0, 0}, Ry[k[n], h[n], gee[n]] . tset}]}], 
            Graphics3D[Line[{{0, 0, 0}, ex}]], 
            Graphics3D[Line[{{0, 0, 0}, yy}]], 
            Graphics3D[Line[{{0, 0, 0}, tset*1.2}]], ef[n], 
            Graphics3D[{Dashing[{0.02, 0.02}], 
                Line[{{0, 0, 0}, Ry[k[n], h[n], gee[n]] . ex}]}], 
            Graphics3D[{RGBColor[1, 0, 0], 
                Polygon[{Ry[k[n], h[n], gee[n]] . ex, 
                    Ry[k[n], h[n], gee[n]] . yy, 
                    Ry[k[n], h[n], gee[n]] . tset}]}]}, 
          ViewPoint -> {4, -1.5, 2}, 
          DisplayFunction -> $DisplayFunction], {n, 0, 3, 
          1/12}];

Matriisielementit vetymolekyyli-ionille

Luentomoniste s. 126 - 129

Clear[r, R]
M1 = -8/R*Integrate[r^2*E^(-2 r), {r, 0, R}] - 
          8*Integrate[r E^(-2 r), {r, R, Infinity}] // 
        Simplify

M2 = 
      4/R*E^(-R)*Integrate[r (E^(-2 r) - 1), {r, 0, R}] + 
          4/R*(E^(-R) - E^R)*
            Integrate[r*E^(-2*r), {r, R, Infinity}] // 
        Simplify

N2p = 
      2 + 4/R*E^(-R)*
            Integrate[
              r*(1 + R - r - (1 + R + r) E^(-2 r)), {r, 0, 
                R}] + 4/R*
            Integrate[
              r*E^(-2 r)*((1 + r - R)*E^R - (1 + r + R)*
                      E^(-R)), {r, R, Infinity}] // 
        Simplify
N2m = 
      2 - 4/R*E^(-R)*
            Integrate[
              r*(1 + R - r - (1 + R + r) E^(-2 r)), {r, 0, 
                R}] - 4/R*
            Integrate[
              r*E^(-2 r)*((1 + r - R)*E^R - (1 + r + R)*
                      E^(-R)), {r, R, Infinity}] // 
        Simplify

R = 3
t = 1
psip = (E^-Abs[r] + E^-Sqrt[r^2 + R^2 - 2*r*R*t])/
        Sqrt[N2p]
psim = (E^-Abs[r] - E^-Sqrt[r^2 + R^2 - 2*r*R*t])/
        Sqrt[N2m]
Plot[{psip, psim}, {r, -R - 5, R + 5}, PlotRange -> All, 
      PlotStyle -> {RGBColor[1, 0, 0], RGBColor[0, 0, 1]}]
Plot[{psip^2, psim^2}, {r, -R - 5, R + 5}, PlotRange -> All, 
      PlotStyle -> {RGBColor[1, 0, 0], RGBColor[0, 0, 1]}]

up = 2/R + 2*(M1 + M2)/N2p // Simplify
um = 2/R + 2*(M1 - M2)/N2m // Simplify

derip = D[up, R] // Simplify
roo = FindRoot[derip == 0, {R, 1}]
up /. roo
derim = D[um, R] // Simplify
room = FindRoot[derim == 0, {R, 1}]
um /. room

tx = Table[{n, n, 0.03}, {n, 0, 10, 2}];
ty = 
        Table[{n, n, 0.03}, {n, -1.1, -0.5, 
            0.1}];
Plot[{up - 1, um - 1}, {R, 1, 10}, 
      PlotStyle -> {Hue[0.69], Hue[0]}, 
      Background -> RGBColor[0.6, 0.8, 0.8], AxesLabel -> {R, Energy}, 
      Ticks -> {tx, ty}, 
      TextStyle -> {FontSize -> 16}]

SetDirectory["C:/Documents and Settings/tuorilaj/My Documents/kvmii\
"];
Display["kuva28.eps", %209, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

Vetymolekyylin orbitaalit

Luentomoniste s. 126 - 129

a = 1;
b = 0;
norp = 1/Sqrt[N2p /. R -> 2  a];
norm = 1/Sqrt[N2m /. R -> 2  a];
ContourPlot[
      norp*(E^-Sqrt[(x - a)^2 + (y - b)^2] + 
            E^-Sqrt[(x + a)^2 + (y + b)^2]), {x, -2, 
        2}, {y, -2, 2}, ContourLines -> False, 
      TextStyle -> {FontSize -> 16}, 
      Background -> RGBColor[0.6, 0.8, 0.8]]
ContourPlot[
      norm*(E^-Sqrt[(x - a)^2 + (y - b)^2] - 
            E^-Sqrt[(x + a)^2 + (y + b)^2]), {x, -2, 
        2}, {y, -2, 2}, ContourLines -> False, 
      TextStyle -> {FontSize -> 16}, 
      Background -> RGBColor[0.6, 0.8, 0.8]]

SetDirectory["D:/Mikko/opetus/kvmii"];
Display["kuva29.eps", %29, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\5.0\
"];

SetDirectory["D:/Mikko/opetus/kvmii"];
Display["kuva30.eps", %30, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\5.0\
"];

Helium atomin perus ja viritystilat

Aaltofunktio ja sen normitus

Tilojen 1s, 2s ja 2p aaltofunktiot

phi1s = Exp[-r]/Sqrt[Pi]
phi2s = 
      Exp[-r/2]*(2 - r)/Sqrt[8*4*Pi]
phi2p = Exp[-r/2]*r/Sqrt[24*4*Pi]

Tarkistetaan normitus

Integrate[
      4*Pi*r^2*phi1s^2, {r, 0, Infinity}]
Integrate[
      4*Pi*r^2*phi2s^2, {r, 0, Infinity}]
Integrate[4*Pi*r^2*phi2p^2, {r, 0, Infinity}]

Lasketaan malliksi Yukawa-potentiaalin Fourier muunnos

4  Pi/k*Sqrt[Pi/2] 
      FourierSinTransform[E^(-a*r), r, k]
1/(2  Pi^2*r)*Sqrt[Pi/2] 
        FourierSinTransform[4  Pi*k/(a^2 + k^2), k, r] // 
      PowerExpand

Heliumin perustila

f1s = 
      4  Pi/k*Sqrt[Pi/2]*
        FourierSinTransform[r*phi1s^2, r, k]
c = 
      1/(2  Pi^2)*
        Integrate[4*Pi*f1s^2, {k, 0, Infinity}]
Z = 2
c*Z^2*13.6
ene = (-2 + c)*Z^2*13.6

Heliumin  1s2s-viritystila

f2s = 
      4  Pi/k*Sqrt[Pi/2]*
        FourierSinTransform[r*phi2s^2, r, k]
c = 
      1/(2  Pi^2)*
        Integrate[4*Pi*f1s*f2s, {k, 0, Infinity}]
Z = 2
c*Z^2*13.6
f1s2s = 
      4  Pi/k*Sqrt[Pi/2]*
        FourierSinTransform[r*phi1s*phi2s, r, k]
Kvai = 
      1/(2  Pi^2)*
        Integrate[4*Pi*f1s2s^2, {k, 0, Infinity}]
tulos = Kvai*Z^2*13.6
enes1 = (-1 - 1/4 + c + Kvai)*
        Z^2*13.6
enes2 = (-1 - 1/4 + c - Kvai)*Z^2*13.6

Heliumin  1s2p-viritystila

f2p = 4*Pi*Sqrt[Pi/2]*FourierSinTransform[r*phi2p^2, r, k]/k
Plot[{f2p, f1s}, {k, 0, 10}, PlotRange -> All]

Z = 2
c = 1/(2  Pi^2)*Integrate[4*Pi*f1s*f2p, {k, 0, Infinity}]
c*Z^2*13.6
f1s2p = 
      4*Pi*Sqrt[
            Pi/2]*(FourierSinTransform[phi1s*phi2p, r, k]/
                k^2 - 
FourierCosTransform[r*phi1s*phi2p, 
                  r, k]/k) // Simplify
Kvai = 
      1/(2*Pi^2)*Integrate[4*Pi*f1s2p^2, {k, 0, Infinity}]
tulos = Kvai*Z^2*13.6
enep1 = (-1 - 1/4 + c + Kvai)*
        Z^2*13.6
enep2 = (-1 - 1/4 + c - Kvai)*Z^2*13.6

Tilatiheys ja delta-funktion

Luentomoniste s. 137 - 139

del := 
      Sin[1/2*(wk - w)*t]^2/(wk - w)^2
wk = 1;
t = 100;
tx = 
        Table[{n, n, 0.03}, {n, -20, 20, 
            10}];
ty = 
        Table[{n, n, 0.03}, {n, 0, 1500, 250}];
kuva = 
      Plot[del, {w, -20, 20}, PlotRange -> All, 
        PlotStyle -> Hue[0.69], Background -> RGBColor[0.6, 0.8, 0.8], 
        AxesLabel -> {x, δ}, Ticks -> {tx, ty}, 
        TextStyle -> {FontSize -> 16}]

SetDirectory["D:/Mikko/opetus/kvmii"];
Display["kuva31.eps", %230, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\5.0\
"];

Clear[a]
Integrate[
      r^2*E^(-a*r), {r, 0, Infinity}]
Integrate[r*E^(-a*r), {r, 0, Infinity}]

Integrate[1/(4*a^2 + k^2)^4, {k, 0, Infinity}] // 
      Simplify

Integrate[r*E^(-2*a*r)*Sin[k*r], {r, 0, Infinity}]

Integrate[Sin[x]/x, {x, 0, Infinity}]

Integrate[
      r^2  E^(-2 r/a)/(4  Pi), {r, 0, Infinity}]

Sironta potentiaalivallista

Heijastus ja läpäisykertoimet

Vastaavasti kuten symmetriselle potentiaalikuopalle, voidaan heijastus- ja läpäisykertoimet ratkaista myös potentiaalivallin tapauksessa.

Clear[A, T, R, k, v0, a, e]
A := v0^2/(4  e (e - v0))
T := 1/(1 + A*Sin[k*a]^2)
R := A*Sin[k*a]^2/(1 + A*Sin[k*a]^2)
k :=  Sqrt[e - v0]
v0 = 1;
e = 1.5;
tx = 
        Table[{n, n, 0.03}, {n, 0, 50, 10}];
ty = 
        Table[{n, n, 0.03}, {n, 0, 1, 0.2}];
kuva1 = 
        Plot[{R, T}, {a, 0, 50}, PlotRange -> All, 
          PlotStyle -> {Hue[0], Hue[0.65]}, 
          Background -> 
            RGBColor[0.6, 0.8, 0.8],   
            AxesLabel -> {a, P}, Ticks -> {tx, ty}, 
          DisplayFunction -> Identity, 
          TextStyle -> {FontSize -> 10}];

teksti = {Graphics[Text["T", {8, 1}]], 
          Graphics[Text["R", {7, 0.2}]]};

Show[{kuva1, teksti}, DisplayFunction -> $DisplayFunction, 
      TextStyle -> {FontSize -> 16}]

Heijastus- ja läpäisytodennäköisyydet oskilloivat potentiaalivallin paksuuden funktiona. Voidaan lisäksi osoittaa, että potentiaalivallin paksuuden ollessa vallissa etenevän hiukkasen aallonpituuden puolikkaan monikerta heijastumista ei tapahdu ollenkaan ja kaikki säteily tunkeutuu vallin lävitse.

SetDirectory["C:/Documents and Settings/tuorilaj/My Documents/kvmii\
"];
Display["kuva20.eps", %148, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

Tarkastellaan seuraavaksi heijastus- ja läpäisykertoimia, kun a=4 ja V\(TraditionalForm\`\_0\)=1.
Piirretään ensin kertoimet hiukkasen energian funktiona, kun hiukkasen energia≥V\(TraditionalForm\`\_0\).

Clear[e]
a = 4;
v0 = 1;
tx = Table[{n, n, 0.03}, {n, 0, 10, 2}];
ty = 
        Table[{n, n, 0.03}, {n, 0, 1, 0.2}];
kuva3 = 
        Plot[{1, R, T}, {e, v0, 10}, 
          PlotStyle -> {Hue[0, 0, 0], Hue[0], Hue[0.65]}, 
          Background -> 
            RGBColor[0.6, 0.8, 0.8],   
            AxesLabel -> {γ, P}, Ticks -> {tx, ty}, 
          DisplayFunction -> Identity, 
          TextStyle -> {FontSize -> 10}];

teksti = {Graphics[Text["R", {1.8, 0.2}]], 
          Graphics[Text["T", {1.8, 0.8}]]};

Show[{kuva3, teksti}, DisplayFunction -> $DisplayFunction, 
      TextStyle -> {FontSize -> 16}]

SetDirectory["C:/Documents and Settings/tuorilaj/My Documents/kvmii\
"];
Display["kuva21.eps", %159, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

Piirretään seuraavaksi kertoimet, kun hiukkasen energia ≤ V\(TraditionalForm\`\_0\).

Clear[A, T, R, k, v0, a]
A := v0^2/(4  e (v0 - e))
T := 1/(1 + A*Sinh[k*a]^2)
R := A*Sinh[k*a]^2/(1 + A*Sinh[k*a]^2)
k :=  Sqrt[v0 - e]
v0 = 1;
a = 4;
tx = 
        Table[{n, n, 0.03}, {n, 0, 1, 0.2}];
ty = 
        Table[{n, n, 0.03}, {n, 0, 1, 0.2}];
kuva2 = 
        Plot[{1, R, T}, {e, 0, v0}, PlotRange -> All, 
          PlotStyle -> {Hue[0, 0, 0], Hue[0], Hue[0.65]}, 
          Background -> 
            RGBColor[0.6, 0.8, 0.8],   
            AxesLabel -> {γ, P}, Ticks -> {tx, ty}, 
          DisplayFunction -> Identity, 
          TextStyle -> {FontSize -> 10}];

teksti = {Graphics[Text["R", {0.6, 0.85}]], 
          Graphics[Text["T", {0.6, 0.15}]]};

Show[{kuva2, teksti}, DisplayFunction -> $DisplayFunction, 
      TextStyle -> {FontSize -> 16}]

Show[{kuva3, kuva2, 
        teksti},   DisplayFunction -> $DisplayFunction, 
      TextStyle -> {FontSize -> 16}]

Kuvaajista nähdään, että heijastustodennäköisyys on suurimmillaan hiukkasen energian ollessa pienempi kuin potentiaalivallin korkeus. Kuitenkin heijastuminen on mahdollista myös potentiaalivallin korkeutta suuremiilla hiukkasen energian arvoilla.

SetDirectory["C:/Documents and Settings/tuorilaj/My Documents/kvmii\
"];
Display["kuva22.eps", %174, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

SetDirectory["C:/Documents and Settings/tuorilaj/My Documents/kvmii\
"];
Display["pic23.eps", %175, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

Piirretään sironnan aaltofunktion reaaliosa potentiaalivalissa.

Clear[Ah, Bh, Ch, Dh, x, Ψ, a, alf, k, u, 
      k0]
Ah[k_, u_, 
        a_] := -E^(-I k a)*2*(1 + u)/
          alf[k, a, u]
Bh[k_, u_, a_] := 
      E^(I k a)*2*(1 - u)/alf[k, a, u]
Fh[k0_, u_, a_] := -E^(-I k0 a)*4 
         u/alf[k, a, u]
Ch[k_, u_, a_] := 
      2  I Sin[k a] (1 - u^2)/alf[k, a, u]
alf[k_, a_, u_] := 
      2  I (1 + u^2) Sin[k a] - 4  u Cos[k a]

k = 2; a = 5; k0 = 5; u = k/k0;
Ψ[x_] := 
      E^(I k0 x) + Ch[k, u, a] E^(-I k0 x) /; 
        x ≤ 0
Ψ[x_] := 
      Ah[k, u, a]*E^(I k x) + Bh[k, u, a] E^(-I k x) /; 
        0 < x < a
Ψ[x_] := 
      Fh[k0, u, a] E^(I k0 x) /; x ≥ a

kuvavalli = 
        Plot[Re[Ψ[x]], {x, -2 a, 2  a}, 
          PlotStyle -> Hue[0.69], DisplayFunction -> Identity, 
          TextStyle -> {FontSize -> 10}];

Show[{kuvavalli, 
        Graphics[{Thickness[0.01], Line[{{a, 0}, {a, 3}}], 
            Line[{{0, 0}, {0, 3}}], Line[{{0, 3}, {a, 3}}]}]}, 
      AxesLabel -> {x, Ψ}, Axes -> True, 
      Ticks -> False, Background -> RGBColor[0.6, 0.8, 0.8], 
      PlotRange -> {{-2 a, 2  a}, {-2, 4}}, 
      DisplayFunction -> $DisplayFunction, 
      TextStyle -> {FontSize -> 16}]

SetDirectory["C:/Documents and Settings/tuorilaj/My Documents/kvmii\
"];
Display["kuva23.eps", %193, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

Animaatio aaltopaketin sironnalle potentiaaliportaasta

Clear[G, K0, x, t, a, hbar, m, k, k0, wave]
G[x_, k_, t_] := 
      1/(Sqrt[Sqrt[Pi]*(delta + ((I hbar t)/(m delta)))])*
        Exp[-(x - ((hbar k)/m) 
                        t)^(2/(2 delta^2 (1 + ((I hbar t)/(m delta^2)))))]*Exp[I k*(x - hbar k t/2  m)]

K0 = 10; k0 = 10.2; k2 = Sqrt[k0^2 - K0^2]; a = 1; delta = 1; m = 1; 
    hbar = 1

wave[x_, t_] := 
      UnitStep[-x]*G[x + a, k0, t] + 
        UnitStep[-x]*G[x - a, -k0, t]*(k0 - k2)/(k0 + k2) +  
        UnitStep[x]*G[k0/Sqrt[k0^2 - K0^2]*x + a, k0, t]*
          Exp[-((I K0^2 x)/Sqrt)[k0^2 - K0^2]]*(2 k0/(k0 + 
                    k2))

Table[
      Plot[{0.4  UnitStep[x], Abs[wave[x, t]]^2}, {x, -6, 6}, 
        PlotRange -> {{-6, 6}, {0, 2}}, 
        Background -> RGBColor[0.6, 0.8, 0.8], 
        PlotStyle -> {{Thickness[0.01]}, {Thickness[0]}}, 
        Ticks -> False], {t, -0.17, 1. , 0.05}]

K0 = 10; k0 = 9.5; k2 = Sqrt[k0^2 - K0^2]; a = 1; delta = 1; m = 1; 
    hbar = 1

wave[x_, t_] := 
      UnitStep[-x]*G[x + a, k0, t] + 
        UnitStep[-x]*G[x - a, -k0, t]*(k0 - k2)/(k0 + k2) +  
        UnitStep[x]*G[k0/Sqrt[k0^2 - K0^2]*x + a, k0, t]*
          Exp[-((I K0^2 x)/Sqrt)[k0^2 - K0^2]]*(2 k0/(k0 + 
                    k2))

Table[
      Plot[{0.4  UnitStep[x], Abs[wave[x, t]]^2}, {x, -10, 0.1}, 
        PlotRange -> {{-6, 6}, {0, 2}}, 
        Background -> RGBColor[0.6, 0.8, 0.8], 
        PlotStyle -> {{Thickness[0.01]}, {Thickness[0]}}, 
        Ticks -> False], {t, -0.17, 1.0, 0.05}]

Palloaallot ulos ja sisään

Palloaalto ulos

<< Graphics`PlotField`

f[x_, y_] := {x/(x^2 + y^2), y/(x^2 + y^2)} /; 
        Sqrt[x^2 + y^2] > a
f[x_, y_] := {0, 0} /; Sqrt[x^2 + y^2] <= a

a = 0.05;

kuva1 = 
        PlotVectorField[f[x, y], {x, -0.2, 0.2}, {y, -0.2, 0.2}, 
          Axes -> False, Ticks -> False, 
          Background -> RGBColor[0.6, 0.8, 0.8], 
          DisplayFunction -> Identity];

Show[{kuva1, Graphics[{RGBColor[1, 0, 0], Disk[{0, 0}, a]}]}, 
      DisplayFunction -> $DisplayFunction]

SetDirectory["C:/Documents and Settings/tuorilaj/My Documents/kvmii\
"];
Display["kuva32.eps", %6, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

Palloaalto sisään

kuva2 = 
        PlotVectorField[
          f[-x, -y], {x, -0.2, 0.2}, {y, -0.2, 0.2}, 
          Axes -> True, Ticks -> False, 
          Background -> RGBColor[0.6, 0.8, 0.8], 
          DisplayFunction -> Identity];

Show[{kuva2, Graphics[{RGBColor[1, 0, 0], Disk[{0, 0}, a/2]}]}, 
      DisplayFunction -> $DisplayFunction]

SetDirectory["C:/Documents and Settings/tuorilaj/My Documents/kvmii\
"];
Display["kuva33.eps", %11, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

Sironta keskeispotentiaalista - tuleva ja lähtevä aalto

Luentomoniste s. 17 - 18

<< Graphics`PlotField`
<< LinearAlgebra`MatrixManipulation`

Clear[f, g, step]
step[y_] := If[Abs[y] < a, 1, 0]
f[x_, 
        y_] := {step[y] + ftheta*x/(x^2 + y^2), 
          ftheta*y/(x^2 + y^2)} /; 
        Sqrt[x^2 + y^2] > a
f[x_, y_] := {0, 0} /; Sqrt[x^2 + y^2] <= a
g[x_, y_] := 
      f[x, y] /; VectorNorm[N[f[x, y]], 2] > raja
g[x_, y_] := {0, 0} /; VectorNorm[N[f[x, y]], 2] <= raja

a = 0.05; ftheta = 0.1; b = 0.2; raja = 0.3;
kuva3 = 
        PlotVectorField[g[x, y], {x, -0.6, 0.4}, {y, -0.3, 0.3}, 
          Axes -> False, Ticks -> False, 
          Background -> RGBColor[0.6, 0.8, 0.8], 
          DisplayFunction -> Identity];

Show[{kuva3, Graphics[{RGBColor[1, 0, 0], Disk[{0, 0}, a]}]}, 
      DisplayFunction -> $DisplayFunction, 
      PlotRange -> {{-0.6, 0.4}, {-0.3, 0.3}}]

SetDirectory["C:/Documents and Settings/tuorilaj/My Documents/kvmii\
"];
Display["kuva34.eps", %233, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

Besselin funktiot

DSolve[u''[r] + (1 - l*(l + 1)/r^2) u[r] == 0, u[r], 
      r]

Aaltofunktio äärettömässä potentiaalikuopassa

Kvanttimekaniikka I : s. 26 - 28

a = 1;
\(\(teksti = {Graphics[Text["V = ", {1.33, 3}]], 
          Graphics[
            Text["ääretön", {1.5, 
                2.5}]], Graphics[Text["V = 0", {0.5, 3}]], 
          Graphics[Text["V =", {\(-0.73\), 3}]], 
          Graphics[
            Text["ääretön", {\(-0.5\), 2.5}]]};\)\)
Show[{Graphics[{Thickness[0.01], Line[{{0, 0}, {a, 0}}], 
            Line[{{a, 0}, {a, 5}}], Line[{{0, 0}, {0, 5}}]}], teksti}, 
      AxesLabel -> {x, V}, Axes -> True, Ticks -> False, 
      Background -> RGBColor[0.6, 0.8, 0.8], 
      PlotRange -> {{-1, 2}, {-1, 5}}, 
      TextStyle -> {FontSize -> 17}]

SetDirectory["C:/Documents and Settings/tuorilaj/My Documents/kvmii\
"];
Display["kuva1.eps", %66, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

Piirretään kolmen alimman tilan normitetut aaltofunktiot äärettömässä potentiaalikuopassa. Koska potentiaali on ääretön kuopan ulkopuolella täytyy aaltofunktion toteuttaa reunaehdot:  (Subscript[u, n])(0)= (Subscript[u, n])(a)= 0 
Sisäalueessa potentiaali on nolla, joten Schrödingerin yhtälö supistuu muotoon u'' + (k^2)u = 0. Reunaehdoista ja normituksesta seuraa aaltofunktio (Subscript[u, n])(x) = (Sqrt[(2/a)]) sin (n(π/a) x) = (Sqrt[(2/a)]) sin [k(n) x]

Clear[n, k, a, u]
a = 1;
k[n_] = n*Pi/a;
wave[n_, x_]  =  
        Sqrt[2/a] Sin[k[n]*x];
tx = 
        Table[{n, n, 0.03}, {n, 0, 1, 0.25}];
ty = 
        Table[{n, n, 0.03}, {n, -1.5, 1.5, 
            0.5}];
kuva = 
        Plot[Evaluate[Table[wave[n, x], {n, 1, 3}]], {x, 0, a}, 
          PlotStyle -> {Hue[0], {Hue[0.9], 
                Dashing[{0.05, 0.05}]}, {Hue[0.7], 
                Dashing[{0.005, 0.03, 0.07, 0.03}]}}, 
          Background -> RGBColor[0.6, 0.8, 0.8], 
          AxesLabel -> {x, 
              (Subscript[u, n])}, 
  Ticks -> {tx, ty}, 
          DisplayFunction -> Identity, 
          TextStyle -> {FontSize -> 
                10}];
Integrate[wave[4, x]^2, {x, 0, a}]

teksti = {Graphics[Text["n=1", {0.71, 1.5}]], 
          Graphics[Text["n=2", {0.5, 0.7}]], 
          Graphics[Text["n=3", {0.37, 0.5}]]};

Show[{kuva, Graphics[Line[{{1, -2}, {1, 2}}]], teksti}, 
      DisplayFunction -> $DisplayFunction, 
      TextStyle -> {FontSize -> 16}]

Eli, kuten reunaehdoista jo nähtiin, aaltofunktiot vastaavat päistään kiinnitetyn kielen värähtelyä.

SetDirectory["C:/Documents and Settings/tuorilaj/My Documents/kvmii\
"];
Display["pic2.eps", %79, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

Piirretään vielä systeemin todennäköisyystiheydet kolmelle alimmalle tilalle.

tx = 
        Table[{n, n, 0.03}, {n, 0, 1, 0.25}];
ty = 
        Table[{n, n, 0.03}, {n, -1.5, 1.5, 
            0.5}];
kuva1 = 
        Plot[Evaluate[Table[wave[n, x]^2, {n, 1, 3}]], {x, 0, a}, 
          PlotStyle -> {Hue[0], {Hue[0.9], 
                Dashing[{0.05, 0.05}]}, {Hue[0.7], 
                Dashing[{0.005, 0.03, 0.07, 0.03}]}}, 
          Background -> RGBColor[0.6, 0.8, 0.8], 
          AxesLabel -> {x, 
              ((Subscript[u, n])^2)}, 
  Ticks -> {tx, ty}, 
          DisplayFunction -> Identity];

teksti1 = {Graphics[Text["n=1", {0.64, 2}]], 
          Graphics[Text["n=2", {0.35, 2}]], 
          Graphics[Text["n=3", {0.93, 2}]]};

Show[{kuva1, teksti1, Graphics[Line[{{1, 0}, {1, 2}}]]}, 
      DisplayFunction -> $DisplayFunction, 
      TextStyle -> {FontSize -> 16}]

SetDirectory["C:/Documents and Settings/tuorilaj/My Documents/kvmii\
"];
Display["pic3.eps", %87, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

Show[GraphicsArray[{kuva, kuva1}], 
      TextStyle -> {FontSize -> 10}]

SetDirectory["C:/Documents and Settings/tuorilaj/My Documents/kvmii\
"];
Display["pic4.eps", %91, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

Äärellinen potentiaalikuoppa

Kvanttimekaniikka I : s. 28 - 32

"Arvataan" ensin aaltofunktio ja piirretään sen kuvaaja.

Clear[a, k, kappa, wave, x]
a = 1;
k = 2;
kappa = 0.5;
wave[x_] := 
      E^(kappa*x) /; x ≤ 0
wave[x_] := 
      1  E^(k x I) + 2  E^(-k x I) /; 
        0 < x < a
wave[x_] := 
      1.5  E^(-kappa*x) /; x ≥ a

tx = 
        Table[{n, n, 0.03}, {n, -5, 7, 1}];
ty = 
        Table[{n, n, 0.03}, {n, -3, 5, 1}];
aalto1 = 
        Plot[Re[wave[x]], {x, 0, a}, DisplayFunction -> Identity, 
          PlotStyle -> Hue[0], Background -> RGBColor[0.6, 0.8, 0.8], 
          AxesLabel -> {x, V}, 
  Ticks -> None, 
          TextStyle -> {FontSize -> 
                10}];
aalto2 = 
        Plot[wave[x], {x, -1, 0}, DisplayFunction -> Identity, 
          PlotStyle -> Hue[0], Background -> RGBColor[0.6, 0.8, 0.8], 
          AxesLabel -> {x, V}, 
  Ticks -> None, 
          TextStyle -> {FontSize -> 
                10}];
aalto3 = 
        Plot[wave[x], {x, a, 2}, DisplayFunction -> Identity, 
          PlotStyle -> Hue[0], Background -> RGBColor[0.6, 0.8, 0.8], 
          AxesLabel -> {x, V}, 
  Ticks -> None, 
          TextStyle -> {FontSize -> 10}];

\(\(tekstipot = {Graphics[Text["II", {0.5, \(-1\)}]], 
          Graphics[Text["I", {\(-0.5\), \(-2\)}]], 
          Graphics[Text["III", {1.5, \(-2\)}]], 
          Graphics[Text[\*""V = -\!\(V\_0\)"", {0.5, \(-2.5\)}]], 
          Graphics[Text["V = 0", {\(-0.5\), \(-1\)}]], 
          Graphics[Text["V = 0", {1.5, \(-1\)}]], 
          Graphics[Text["a", { .9, 0.25}]], 
          Graphics[Text["0", {0.1, 0.25}]]};\)\)

Show[{aalto1, aalto2, aalto3, 
        Graphics[{Thickness[0.01], Line[{{0, -3}, {a, -3}}], 
            Line[{{0, -3}, {0, 0}}], Line[{{0, 0}, {-1, 0}}], 
            Line[{{a, -3}, {a, 0}}], Line[{{a, 0}, {2, 0}}]}], 
        Graphics[Line[{{a, 0}, {a, 3}}]], tekstipot}, 
      DisplayFunction -> $DisplayFunction, 
      TextStyle -> {FontSize -> 18}]

Kuten kuvaajasta nähdään, aaltofunktio ei ole jatkuva rajoilla x=0 ja x=a.

SetDirectory["C:/Documents and Settings/tuorilaj/My Documents/kvmii\
"];
Display["pic5.eps", %108, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

Energian ominaisarvot

Ratkaistaan energian ominaisarvot graafisesti. Luentojen mukaan y= γα = 2arccos α + (n-1)π. Tämä yhtälö toteutuu, kun sen oikean ja vasemman puolen funktioiden kuvaajat leikkaavat. γ on energiasta riippumaton vakio. Seuraavaksi piirretään funktioiden kuvaajat ja määritetään niiden leikkauspisteet eri γ:n arvoilla.

Clear[gam, alf, n, α]
tx = 
        Table[{n, n, 0.04}, {n, 0, 1, 0.25}];
ty = Table[{n, n, 0.04}, {n, 0, 12, 2}];
suora = 
        Plot[Evaluate[Table[gam*alf, {gam, 1, 13, 4}]], {alf, 0, 1}, 
          PlotStyle -> {Hue[0.69]}, 
          Background -> 
            RGBColor[0.6, 0.8, 
              0.8], 
AxesLabel -> {α, 
              y}, 
Ticks -> {tx, ty}, 
          DisplayFunction -> Identity, 
          TextStyle -> {FontSize -> 
                10}];
teksti = {Graphics[Text["γ=1", {1.07, 1.3}]], 
          Graphics[Text["γ=5", {1.07, 5.3}]], 
          Graphics[Text["γ=9", {1.07, 9.3}]], 
          Graphics[
            Text["γ=12", {1.07, 
                13.3}]]};
Show[{suora, teksti}, DisplayFunction -> $DisplayFunction, 
      TextStyle -> {FontSize -> 13}, 
      PlotRange -> {{0, 1.2}, {0, 14}}]

SetDirectory["C:/Documents and Settings/tuorilaj/My Documents/kvmii\
"];
Display["pic6.eps", %18, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

arccos = 
        Plot[Evaluate[
            Table[2  ArcCos[alf] + Pi (n - 1), {n, 1, 4, 1}]], {alf, 0, 
            1}, PlotStyle -> {Hue[0.79]}, 
          Background -> RGBColor[0.6, 0.8, 0.8], 
          AxesLabel -> {α, y}, Ticks -> {tx, ty}, 
          DisplayFunction -> Identity, 
          TextStyle -> {FontSize -> 
                10}];
teksti2 = {Graphics[
            Text["2arccosα + 3π", {0.275, 13}]], 
          Graphics[Text["2arccosα + 2π", {0.26, 10}]], 
          Graphics[Text["2arccosα + π", {0.25, 7}]], 
          Graphics[
            Text["2arccosα", {0.17, 
                3.8}]]};
Show[{arccos, teksti2}, DisplayFunction -> $DisplayFunction, 
      TextStyle -> {FontSize -> 13}, 
      PlotRange -> {{0, 1.2}, {0, 14}}]

SetDirectory["C:/Documents and Settings/tuorilaj/My Documents/kvmii\
"];
Display["kuva7.eps", %24, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

Show[{arccos, suora, teksti, 
        teksti2}, 
  
        DisplayFunction -> $DisplayFunction, 
      TextStyle -> {FontSize -> 13}, 
      PlotRange -> {{0, 1.2}, {0, 14}}]

Kuvan kuvaajien leikkauspisteet ovat sallittuja energianarvoja. Kuten kuvaajista nähdään, parametrin γ kasvaessa potentiaalikuoppa syvenee ja sidottujen tilojen lukumäärä kasvaa.

SetDirectory["C:/Documents and Settings/tuorilaj/My Documents/kvmii\
"];
Display["kuva8.eps", %28, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

Numeerinen ratkaisu

Ratkaistaan seuraavaksi kuvaajien leikkauspiste numeerisesti γ:n arvolla 1.

Clear[alf]
gam = 1;
n = 1;
arvaus = 0.95;
FindRoot[
      gam*alf == 2  ArcCos[alf] + (n - 1) Pi, {alf, 
        arvaus}]
alf = alf /. %

Aaltofunktiot

Piirretään numeerista ratkaisua vastaava aaltofunktio välillä  -∞ -> ∞ a:n arvolla 1. Lisäksi γ = 1ja n=1.

a = 1;
k  = gam *alf/a;
kappa = gam*Sqrt[1 - alf^2]/a;
wave[x_] := 
      E^(kappa*x) /; x ≤ 0
wave[x_] := 
      1/alf *Sin[k*(x - a/2) + n*Pi/2] /; 
        0 < x < a
wave[x_] := (-1)^(n - 1) E^(-kappa*(x - a)) /; 
        x ≥ a

tx = 
        Table[{n, n, 0.03}, {n, -20, 20, 
            10}];
ty = 
        Table[{n, n, 0.03}, {n, 0, 1, 0.2}];
teksti = {Graphics[
            Text["γ = 1, n = 1", {12, 
                0.9}]]};
perus = 
        Plot[wave[x], {x, -20, 20}, PlotRange -> All, 
          PlotStyle -> {Hue[0]}, Background -> RGBColor[0.6, 0.8, 0.8], 
          AxesLabel -> {x, (Subscript[u, n])},   Ticks -> {tx, ty}, 
          DisplayFunction -> Identity];
Show[{perus, teksti}, DisplayFunction -> $DisplayFunction, 
      TextStyle -> {FontSize -> 15}]

SetDirectory["C:/Documents and Settings/tuorilaj/My Documents/kvmii\
"];
Display["kuva9.eps", %147, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

Nyt γ = 12 ja n=1.

Clear[alf]
gam = 12;
n = 1;
arvaus = 0.2;
FindRoot[
      gam*alf == 2  ArcCos[alf] + (n - 1) Pi, {alf, 
        arvaus}]
alf = alf /. %

a = 1;
k  = gam *alf/a;
kappa = gam*Sqrt[1 - alf^2]/a;
wave[x_] := 
      E^(kappa*x) /; x ≤ 0
wave[x_] := 
      1/alf *Sin[k*(x - a/2) + n*Pi/2] /; 
        0 < x < a
wave[x_] := (-1)^(n - 1) E^(-kappa*(x - a)) /; 
        x ≥ a

tx = 
        Table[{n, n, 0.03}, {n, -4, 4, 2}];
ty = Table[{n, n, 0.03}, {n, 0, 10, 1}];
teksti2 = {Graphics[
            Text["γ = 12, n = 1", {4, 
                3}]]};
kakst = 
        Plot[wave[x], {x, -5, 5}, PlotRange -> All, 
          PlotStyle -> {Hue[0]}, Background -> RGBColor[0.6, 0.8, 0.8], 
          AxesLabel -> {x, (Subscript[u, n])},   Ticks -> {tx, ty}, 
          DisplayFunction -> Identity];
Show[{kakst, teksti2}, DisplayFunction -> $DisplayFunction, 
      TextStyle -> {FontSize -> 15}]

SetDirectory["C:/Documents and Settings/tuorilaj/My Documents/kvmii\
"];
Display["kuva10.eps", %167, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

Nyt γ = 12 ja n = 2.

Clear[alf]
gam = 12;
n = 2;
arvaus = 0.4;
FindRoot[
      gam*alf == 2  ArcCos[alf] + (n - 1) Pi, {alf, 
        arvaus}]
alf = alf /. %

a = 1;
k  = gam *alf/a;
kappa = gam*Sqrt[1 - alf^2]/a;
wave[x_] := 
      E^(kappa*x) /; x ≤ 0
wave[x_] := 
      1/alf *Sin[k*(x - a/2) + n*Pi/2] /; 
        0 < x < a
wave[x_] := (-1)^(n - 1) E^(-kappa*(x - a)) /; 
        x ≥ a

tx = 
        Table[{n, n, 0.03}, {n, -4, 4, 2}];
ty = 
        Table[{n, n, 0.03}, {n, -2, 2, 1}];
teksti3 = {Graphics[
            Text["γ = 12, n = 2", {2.5, 
                2}]]};
virit = 
        Plot[wave[x], {x, -4, 4}, PlotRange -> All, 
          PlotStyle -> {Hue[0]}, Background -> RGBColor[0.6, 0.8, 0.8], 
          AxesLabel -> {x, (Subscript[u, n])},   Ticks -> {tx, ty}, 
          DisplayFunction -> Identity];
Show[{virit, teksti3}, DisplayFunction -> $DisplayFunction, 
      TextStyle -> {FontSize -> 15}]

SetDirectory["C:/Documents and Settings/tuorilaj/My Documents/kvmii\
"];
Display["kuva11.eps", %187, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

Ratkaisu, kun V0->0

Graafisesta ratkaisusta nähdään, että rajalla (Subscript[V, 0]) -> 0 
		α -> 1-δ , missä δ = ((Abs(E))/(2  (Subscript[V, 0])))
Täten ominaisarvoyhtälö  γα = 2arccos α voidaan kehittää sarjaksi nollan ympäristössä. Tällöin

Series[ArcCos[1 - δ], {δ, 0, 2}]

Joten γ(1-δ) = 2arccos(1-δ) -> 2(Sqrt[2  δ]), kun δ->0

Symmetrinen kuoppa

Kvanttimekaniikka I : s.32 - 37

a = 1;
\(\(tekstisymm = {Graphics[Text[\*""V = \!\(V\_0\)"", {2.2, 1.5}]], 
          Graphics[Text["V = 0", {0, 1.5}]], 
          Graphics[Text[\*""V = \!\(V\_0\)"", {\(-2.2\), 1.5}]], 
          Graphics[Text["-a", {\(-a\), \(-0.2\)}]], 
          Graphics[Text["a", {a, \(-0.2\)}]], 
          Graphics[Text["I", {\(-2.2\), 0.5}]], 
          Graphics[Text["III", {2.2, 0.5}]], 
          Graphics[Text["II", {0, 2.5}]]};\)\)
Show[{Graphics[{Thickness[0.01], Line[{{-a, 0}, {a, 0}}], 
            Line[{{a, 0}, {a, 3}}], Line[{{-a, 0}, {-a, 3}}], 
            Line[{{-a, 3}, {-a - 2, 3}}], 
            Line[{{a, 3}, {a + 2, 3}}]}], tekstisymm}, 
      AxesLabel -> {x, V}, Axes -> True, Ticks -> False, 
      Background -> RGBColor[0.6, 0.8, 0.8], 
      PlotRange -> {{-3 a, 3  a}, {-1, 3}}, 
      TextStyle -> {FontSize -> 16}]

SetDirectory["C:/Documents and Settings/tuorilaj/My Documents/kvmii\
"];
Display["kuva12.eps", %193, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

Energian ominaisarvot

Ratkaistaan energian ominaisarvot taas graafisesti. Symmetrisessä tapauksessa η = ξ tan ξ ja antisymmetrisessä η = - ξ cot ξ. Toisaalta η\(TraditionalForm\`\^2\) = R\(TraditionalForm\`\^2\) - ξ\(TraditionalForm\`\^2\). Symmetriset ja antisymmetriset ratkaisut saadaan näiden funktioiden kuvaajien leikkauspisteistä.

r = Sqrt[12];
tx = Table[{n, n, 0.03}, {n, 0, 5, 1}];
ty = Table[{n, n, 0.03}, {n, 0, 5, 1}];
\(\(kuva14 = 
        Plot[{Sqrt[
              r^2 - ξ^2], ξ\ Tan[ξ], \(-ξ\)\ Cot[ξ]}, {ξ, 0, r}, PlotRange -> {0, r}, AspectRatio -> Automatic, 
          PlotStyle -> {Hue[0], {Hue[0.66], 
                Dashing[{0.05, 0.05}]}, {Hue[0.78], 
                Dashing[{0.005, 0.03, 0.05, 0.03}]}}, 
          Background -> 
            RGBColor[0.6, 0.8, 0.8],  (*\(PlotLabel -> 
              StyleForm["Parillinen ja pariton ratkaisu", 
                FontSize -> 11]\)\(,\)*) 
            AxesLabel -> {ξ, η}, Ticks -> {tx, ty}, 
          DisplayFunction -> Identity, 
          TextStyle -> {FontSize -> 10}];\)\)

\(\(teksti = {Graphics[Text[\*""\!\(R\^2\)=12"", {4.2, 0.5}]], 
          Graphics[Text["η=ξtanξ", {0.9, 2.5}]], 
          Graphics[Text["η=-ξcotξ", {2.7, 4.2}]], 
          Graphics[
            Text["η=ξtanξ", {4.7, 2.7}]]};\)\)

Show[{kuva14, teksti, Graphics[Circle[{0, 0}, Sqrt[12], {0, Pi/2}]], 
        Table[Graphics[Circle[{0, 0}, r, {0, Pi/2}]], {r, 1, 2, 1}]}, 
      DisplayFunction -> $DisplayFunction, 
      PlotRange -> {{0, 5.5}, {0, 4.4}}, 
      TextStyle -> {FontSize -> 16}]

Tässä sininen käyrä kuvaa symmetristä ja sinipunainen antisymmetristä ratkaisua. R on potentiaalista riippuva vakio. Kun potentiaalikuoppa on riittävän syvä, saadaan kolme sidottua tilaa (kaksi symmetristä ja yksi antisymmetrinen). Tiloja vastaavat energiat saadaan R:n ja η:n leikkauspisteistä annetulla R:n (eli potentiaalin) arvolla.

SetDirectory["C:/Documents and Settings/tuorilaj/My Documents/kvmii\
"];
Display["kuva13.eps", %202, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

Numeerinen ratkaisu symmetrisessä tapauksessa

Ratkaistaan seuraavaksi kuvaajien leikkauspiste numeerisesti symmetrisessä tapauksessa. Etsitään perustilan ratkaisua.

Clear[xi, x, i]
r = Sqrt[12];
arvaus = 0.7;
FindRoot[
      xi*Tan[xi] == Sqrt[r^2 - xi^2], {xi, 
        arvaus}]
xi = xi /. %

Symmetrinen aaltofunktio

Piirretään alimman symmetrisen tilan aaltofunktio.

a = 1;
alf = xi/a;
bet = Sqrt[r^2 - xi^2]/a;
B = E^(-bet*a)/Cos[alf*a];
wave[x_] := 
      E^(bet*x) /; x ≤ -a
wave[x_] := B*Cos[alf*x] /; -a < x < a
wave[x_] := 
      E^(-bet*x) /; x ≥ a
normitus = 
      NIntegrate[(wave[x])^2, {x, -Infinity, 
          Infinity}]
tx = 
        Table[{n, n, 0.03}, {n, -4 a, 4  a, 
            1}];
ty = 
        Table[{n, n, 0.03}, {n, 0, 0.7, 0.2}];
kuva1 = 
      Plot[wave[x]/Sqrt[normitus], {x, -4 a, 4  a}, 
        PlotStyle -> {Hue[0]}, 
        Background -> 
          RGBColor[0.6, 0.8, 0.8],   AxesLabel -> {x, u}, 
        Ticks -> {tx, ty}, AxesOrigin -> {0, 0}, 
        TextStyle -> {FontSize -> 16}]

SetDirectory["C:/Documents and Settings/tuorilaj/My Documents/kvmii\
"];
Display["kuva14.eps", %16, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

Ratkaistaan toisen virittyneen tilan aaltofunktio.

Clear[xi, x, i]
r = Sqrt[12];
arvaus = 2.3;
FindRoot[
      xi*Tan[xi] == Sqrt[r^2 - xi^2], {xi, 
        arvaus}]
xi = xi /. %

a = 1;
alf = xi/a;
bet = Sqrt[r^2 - xi^2]/a;
B = E^(-bet*a)/Cos[alf*a];
wave[x_] := 
      E^(bet*x) /; x ≤ -a
wave[x_] := B*Cos[alf*x] /; -a < x < a
wave[x_] := 
      E^(-bet*x) /; x ≥ a
normitus = 
      NIntegrate[(wave[x])^2, {x, -Infinity, 
          Infinity}]
tx = 
        Table[{n, n, 0.03}, {n, -4 a, 4  a, 
            1}];
ty = 
        Table[{n, n, 0.03}, {n, 0, 0.7, 0.2}];
kuva2 = 
      Plot[wave[x]/Sqrt[normitus], {x, -4 a, 4  a}, 
        PlotStyle -> {Hue[0.9], Dashing[{0.05, 0.05}]}, 
        Background -> 
          RGBColor[0.6, 0.8, 0.8],   AxesLabel -> {x, u}, 
        Ticks -> {tx, ty}, 
        TextStyle -> {FontSize -> 16}]

SetDirectory["C:/Documents and Settings/tuorilaj/My Documents/kvmii\
"];
Display["kuva15.eps", %38, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

Numeerinen ratkaisu antisymmetrisessä tapauksessa

Ratkaistaan seuraavaksi kuvaajien leikkauspiste numeerisesti antisymmetrisessä tapauksessa.

Clear[xi]
r = Sqrt[12];
arvaus = 1.9;
FindRoot[-xi*Cot[xi] == Sqrt[r^2 - xi^2], {xi, 
        arvaus}]
xi = xi /. %

Antisymmetrinen aaltofunktio

Piirretään ensimmäisen virittyneen tilan(antisymmetrinen) aaltofunktio.

a = 1;
alf = xi/a;
bet = Sqrt[r^2 - xi^2]/a;
A = -E^(-bet*a)/Sin[alf*a];
wave[x_] := 
      E^(bet*x) /; x ≤ -a
wave[x_] := A*Sin[alf*x] /; -a < x < a
wave[x_] := -E^(-bet*x) /; 
        x ≥ a
normitus = 
      NIntegrate[(wave[x])^2, {x, -Infinity, 
          Infinity}]
tx = 
        Table[{n, n, 0.03}, {n, -2, 2, 1}];
ty = 
        Table[{n, n, 0.03}, {n, -1, 1, 
            0.5}];
kuva3 = 
      Plot[wave[x]/Sqrt[normitus], {x, -3 a, 3  a}, 
        PlotStyle -> {Hue[0.65], Dashing[{0.005, 0.03, 0.07, 0.03}]}, 
        Background -> 
          RGBColor[0.6, 0.8, 0.8],   AxesLabel -> {x, u}, 
        Ticks -> {tx, ty}, 
        TextStyle -> {FontSize -> 16}]

SetDirectory["C:/Documents and Settings/tuorilaj/My Documents/kvmii\
"];
Display["kuva16.eps", %116, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

Show[{kuva3, kuva2, 
        kuva1}  ]

SetDirectory["C:/Documents and Settings/tuorilaj/My Documents/kvmii\
"];
Display["kuva17.eps", %120, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

Show[{kuva1, kuva2, 
        kuva3, {Graphics[{Thickness[0.01], Line[{{-1, 0}, {1, 0}}], 
              Line[{{1, 0}, {1, 3}}], Line[{{-1, 0}, {-1, 3}}], 
              Line[{{-1, 3}, {-3, 3}}], Line[{{1, 3}, {3, 3}}]}], 
          tekstisymm}}, AxesLabel -> {x, V}, Axes -> True, 
      Ticks -> False, Background -> RGBColor[0.6, 0.8, 0.8], 
      PlotRange -> {{-3, 3}, {-1, 3}}  , 
      TextStyle -> {FontSize -> 16}]

SetDirectory["C:/Documents and Settings/tuorilaj/My Documents/kvmii\
"];
Display["kuva18.eps", %127, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

Tunneloituminen

Integrate[
      2 E^(-2*bet*x)/normitus, {x, a, Infinity}]

m = {{-f, 1/g, g, 0}, {h*f, I*k/g, -I*k*g, 0}, {0, g, 
          1/g, -f}, {0, 
          I*k*g, -I*k/g, -h*f}}
Det[m] // Factor

Sironta symmetrisestä kuopasta

Kvanttimekaniikka I : s. 37 - 42

Määrittämällä aaltofunktion kertoimet saadaan laskettua heijastumiskerroin R ja läpäisykerroin T.

Ratkaistaan kertoimet A, B, C ja D

Ratkaistaan neljän yhtälön yhtälöryhmä, jossa on neljä tuntematonta (A, B, C ja D) käyttäen matriiseja.

Tässä f = (e^ika), g = (e^i)κa, h = κ

m = {{1/f, 
            f, -1/g, -g}, {k/f, -k f, -h/g, -h g}, {0, 
            0, g, 1/g}, {0, 0, h g, -h/g}};
b = {0, 0, f, k f};
MatrixForm[m]
MatrixForm[b]
LinearSolve[m, b] // Simplify

Potentiaaliporras

porras = 
      Plot[UnitStep[x], {x, -1, 1}, 
        PlotRange -> {{-1, 1}, {0, 2}}, 
        Background -> RGBColor[0.6, 0.8, 0.8], 
        PlotStyle -> {{Thickness[0.01]}, {Thickness[0]}}, 
        Ticks -> False]
\(\(tekstipor = {Graphics[Text["V = 0", {\(-0.5\), 0.5}]], 
          Graphics[Text[\*""V = \!\(V\_0\)"", {0.5, 0.5}]], 
          Graphics[Text["I", {\(-0.5\), 0.8}]], 
          Graphics[Text["II", {0.5, 0.8}]]};\)\)
Show[porras, tekstipor, AxesLabel -> {x, V}, Axes -> True, 
      Ticks -> False, 
      TextStyle -> {FontSize -> 16}]

SetDirectory["D:/Mikko/opetus/kvmii"];
Display["porras.eps", %40, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

a = 1;
\(\(tekstivall = {Graphics[Text["V = 0", {1.5, 1.5}]], 
          Graphics[Text[\*""V = \!\(V\_0\)"", {0.5, 1.5}]], 
          Graphics[Text["V = 0", {\(-0.5\), 1.5}]], 
          Graphics[Text["0", {0.1, \(-0.2\)}]], 
          Graphics[Text["a", {a - 0.1, \(-0.2\)}]], 
          Graphics[Text["I", {\(-0.5\), 2.5}]], 
          Graphics[Text["III", {1.5, 2.5}]], 
          Graphics[Text["II", {0.5, 2.5}]]};\)\)
Show[{Graphics[{Thickness[0.01], Line[{{a, 0}, {a, 3}}], 
            Line[{{0, 0}, {0, 3}}], Line[{{0, 3}, {a, 3}}]}], tekstivall}, 
      AxesLabel -> {x, V}, Axes -> True, Ticks -> False, 
      Background -> RGBColor[0.6, 0.8, 0.8], 
      PlotRange -> {{-a, 2  a}, {-1, 4}}, 
      TextStyle -> {FontSize -> 16}]

SetDirectory["C:/Documents and Settings/tuorilaj/My Documents/kvmii\
"];
Display["kuva19.eps", %133, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

D[ArcTan[Sqrt[k0^2/x^2 - 1]], x]

Asymptoottinen käyttäytyminen

Clear[R0, besseli, k, r, delta]

R0[r_] := Sin[k r + delta]/(k r)
besseli[r_] := Sin[k r]/(k r)

k = 1.5;
delta = Pi/3;
tx = Table[{n, n, 0.03}, {n, 0, 10, 2}];
ty = 
        Table[{n, n, 0.03}, {n, -0.2, 0.2, 
            0.1}];
kuva = 
        Plot[{R0[r], besseli[r]}, {r, 2, 12}, 
          PlotStyle -> {Hue[0.69], Hue[0]}, 
          Background -> RGBColor[0.6, 0.8, 0.8], AxesLabel -> {r, R}, 
          Ticks -> {tx, ty}, TextStyle -> {FontSize -> 12}, 
          DisplayFunction -> Identity, 
          PlotRange -> {{0, 10}, {-0.3, 0.3}}];

\(Show[{kuva, Graphics[Text["δ/k", {4, 0.02}]], 
        Graphics[Text[\*""\!\(R\_0\)(r)"", {1, \(-0.25\)}]], 
        Graphics[Text[\*""\!\(j\_0\)(r)"", {6, 0.17}]]}, 
      DisplayFunction -> $DisplayFunction]\)

SetDirectory["D:/Mikko/opetus/kvmii"];
Display["kuva35b.eps", %9, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

SetDirectory["C:/Documents and Settings/tuorilaj/My Documents/kvmii\
"];
Display["kuva35.eps", %31, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

Sironta kovasta pallosta

Clear[R0, besseli, k, r, delta]

a = 2
R0[r_] := 0 /; r < a
R0[r_] := Sin[k r + delta] /; r >= a
besseli[r_] := Sin[k r]

k = 1;
delta = -a*k;
tx = Table[{n, n, 0.03}, {n, 0, 10, 2}];
ty = 
        Table[{n, n, 0.03}, {n, -1, 1, 
            0.5}];
kuva = 
        Plot[{R0[r], besseli[r]}, {r, 0, 12}, 
          PlotStyle -> {Hue[0.69], Hue[0]}, 
          Background -> RGBColor[0.6, 0.8, 0.8], AxesLabel -> {r, R}, 
          Ticks -> {tx, ty}, TextStyle -> {FontSize -> 12}, 
          DisplayFunction -> Identity, 
          PlotRange -> {{0, 10}, {-1.2, 1.2}}];

Show[{kuva, Graphics[Text["-δ/k", {1. , 0.1}]], 
        Graphics[Text["sin(kr+δ)", {4.5, 1.1}]], 
        Graphics[Text["sin(kr)", {4, -1.1}]]}, 
      Graphics[{AbsoluteThickness[2], Line[{{a, 0}, {a, 2}}]}], 
      DisplayFunction -> $DisplayFunction]

SetDirectory["D:/Mikko/opetus/kvmii"];
Display["kovapallo.eps", %261, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

3D sironta potentiaalikuopasta

n = 0;
r0 =. ;
h0 =. ;
k =. 
h := Sqrt[k^2 + h0^2];
d := n*Pi - k*r0 + ArcTan[k*Tan[h*r0]/h]
stot = 4*Pi*Sin[d]^2/k^2
Series[stot, {k, 0, 1}] // Simplify
PowerExpand[%] // Simplify

h0 = 1;
r0 = 1.4;
tx = 
        Table[{n, n, 0.03}, {n, 0, 1, 0.2}];
ty = 
        Table[{n, n, 0.03}, {n, 1.5, 4, 0.5}];
Plot[stot, {k, 0, 1}, PlotStyle -> {Hue[0.69]}, 
      Background -> RGBColor[0.6, 0.8, 0.8], PlotRange -> All, 
      AxesLabel -> {"k", (Subscript[σ, TOT])}, 
      TextStyle -> {FontSize -> 16}]

SetDirectory["D:/Mikko/opetus/kvmii"];
Display["kuva24.eps", %126, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

Kokonaisvaikutusala kuopan leveyden funktiona, kun k=0.1

Clear[r0]
h0 = 1;
k = 0.1;
tx = Table[{n, n, 0.03}, {n, 0, 10, 2}];
ty = 
        Table[{n, n, 0.03}, {n, 0, 1000, 500}];
Plot[stot, {r0, 0, 10}, PlotStyle -> {Hue[0.69]}, 
      Background -> RGBColor[0.6, 0.8, 0.8], PlotRange -> All, 
      AxesLabel -> {(Subscript[r, 0]), (Subscript[σ, TOT])}, Ticks -> {tx, ty}, 
      TextStyle -> {FontSize -> 20}]

SetDirectory["D:/Mikko/opetus/kvmii"];
Display["rvirtual.eps", %136, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

Kuoppapotentiaalin s-aalto vaihesiirto

\(\(\(Clear[k, r0, k]

    d := \(-k\)*r0 + ArcTan[k*Tan[h*r0]/h] /; h*r0 < Pi/2

    d := 1*Pi - k*r0 + ArcTan[k*Tan[h*r0]/h] /; 
        h*r0 < 3  Pi/2

    d := 2*Pi - k*r0 + ArcTan[k*Tan[h*r0]/h] /; 
        h*r0 < 5  Pi/2

    d := 3*Pi - k*r0 + ArcTan[k*Tan[h*r0]/h] /; 
        h*r0 < 7  Pi/2

    \(h0 = 1;\)

    \(k = 0.1;\)

    \(tx = Table[{n, n, 0.03}, {n, 0, 10, 2}];\)

    \(ty = Table[{n, n, 0.03}, {n, 0, 10, 2}];\)

    Plot[d, {r0, 0, 9.5}, PlotStyle -> {Hue[0.69]}, 
      Background -> RGBColor[0.6, 0.8, 0.8], PlotRange -> All, 
      AxesLabel -> {r\_0, δ\_0}, Ticks -> {tx, ty}, 
      TextStyle -> {FontSize -> 20}]\)\(\ \)\)\)

SetDirectory["D:/Mikko/opetus/kvmii"];
Display["svaihe.eps", %528, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

Sirontapituus

Clear[a, h]
asir := r0 - ArcTan[k*Tan[h*r0]/h]/k
k = 0.1
h0 = 1
h = Sqrt[k^2 + h0^2];
tx = Table[{n, n, 0.03}, {n, 0, 10, 2}];
ty = Table[{n, n, 0.03}, {n, 0, 20, 10}];
Plot[asir, {r0, 0, 10}, PlotStyle -> {Hue[0.69]}, 
      Background -> RGBColor[0.6, 0.8, 0.8], PlotRange -> All, 
      AxesLabel -> {(Subscript[r, 0]), a}, Ticks -> {tx, ty}, 
      TextStyle -> {FontSize -> 20}]

SetDirectory["D:/Mikko/opetus/kvmii"];
Display["sirpit.eps", %1066, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

Sirontapituus luettuna aaltofunktion nollakohdasta

h0 = 1
r0 = Pi/2 + 0.03
k = 0.05
h = Sqrt[k^2 + h0^2]
d := -k*r0 + ArcTan[k*Tan[h*r0]/h] /; 
        h*r0 <= Pi/2
d := -k*r0 + ArcTan[k*Tan[h*r0]/h] /; 
        Pi/2 <= h*r0 <= 3  Pi/2
b =  Sin[h*r0]/Sin[k*r0 + d]
kuvab = 
      Plot[{b*Sin[k*r + d]}, {r, -50,  50}, 
        PlotRange -> All]

Kokonaisvaikutusala s-aaltosironnassa

a = 5.38;
reff = 1.75;
stot := 
      4*Pi/(k^2 + (-1/a + 
                    1/2*reff*k^2)^2)
tx = 
        Table[{n, n, 0.03}, {n, 0, 2, 0.5}];
ty = 
        Table[{n, n, 0.03}, {n, 0, 350, 50}];
kuva1 = 
        Plot[stot, {k, 0, 2}, PlotStyle -> Hue[0.69], 
          Background -> RGBColor[0.6, 0.8, 0.8], 
          AxesLabel -> {k, (Subscript[σ, TOT])}, Ticks -> {tx, ty}, 
          TextStyle -> {FontSize -> 16}, PlotRange -> All, 
          DisplayFunction -> Identity];
a = -23.7;
reff = 2.4;
tx = 
        Table[{n, n, 0.03}, {n, 0, 2, 0.5}];
ty = 
        Table[{n, n, 0.03}, {n, 0, 7000, 1000}];
kuva2 = 
        Plot[stot, {k, 0, 2}, PlotStyle -> Hue[0.69], 
          Background -> RGBColor[0.6, 0.8, 0.8], 
          AxesLabel -> {k, (Subscript[σ, TOT])}, Ticks -> {tx, ty}, 
          TextStyle -> {FontSize -> 16}, PlotRange -> All, 
          DisplayFunction -> Identity];
Show[{kuva1, Graphics[Text["a = 5.38, reff = 1.75", {1.25, 300}]]}, 
      DisplayFunction -> $DisplayFunction]
Show[{kuva2, 
        Graphics[Text["a = -23.7, reff = 2.4", {1.25, 6000}]]}, 
      DisplayFunction -> $DisplayFunction]

SetDirectory["C:/Documents and Settings/tuorilaj/My Documents/kvmii\
"];
Display["kuva26.eps", %177, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

SetDirectory["C:/Documents and Settings/tuorilaj/My Documents/kvmii\
"];
Display["kuva27.eps", %178, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

Integrate[r*Sin[K*r] E^(-r^2/a^2), {r, 0, Infinity}] // 
      Simplify

Vaihesiirto kuoppapotentiaalista

Clear[r, u]
 k = 0.5;
b =  Sin[h*r0]/Sin[k*r0 + d];
u[r_] := 0 /; r < 0
u[r_] := Sin[h*r] /; 0 < r <= r0
u[r_] := b*Sin[k*r + d] /; r > r0
uf[r_] := 0 /; r < 0
uf[r_] := b*Sin[k*r] /; 0 < r
tx = 
        Table[{n, n, 0.03}, {n, -3, 9, 3}];
ty = 
        Table[{n, n, 0.03}, {n, -1.5, 1.5, 
            0.5}];
kuva = 
        Plot[{b*Sin[k*r + d], u[r], uf[r]}, {r, -3,  10}, 
          PlotRange -> All, 
          PlotStyle -> {Hue[0.69], Hue[0], Hue[0.88]}, 
          Background -> RGBColor[0.6, 0.8, 0.8], 
          AxesLabel -> {r, ""}, Ticks -> {tx, ty}, 
          TextStyle -> {FontSize -> 14}, 
          DisplayFunction -> Identity];

Show[{kuva, Graphics[Text["sin(kr)", {5.5, 1.1}]], 
        Graphics[{AbsoluteThickness[2], 
            Line[{{0, -1}, {r0, -1}, {r0, 0}}]}], 
        Graphics[Text["u(r)", {5, -0.6}]], 
        Graphics[Text["sin(kr+δ)", {-2.5, 0.8}]], 
        Graphics[Text["-δ/k", {-1, -0.2}]]}, 
      DisplayFunction -> $DisplayFunction]

SetDirectory["D:/Mikko/opetus/kvmii"];
Display["kuva25.eps", %50, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

Kuoppapotentiaalin vaihesiirto

Clear[k]
d := n*Pi - k*r0 + ArcTan[k*Tan[h*r0]/h]
Series[d, {k, 0, 3}] // PowerExpand // 
      Simplify
dco = k*Cot[d];
sarja = Series[dco, {k, 0, 2}] // PowerExpand // 
        Simplify
Normal[sarja] /. Tan[h0 r0] -> x/Sqrt[1 - x^2] // 
        PowerExpand // Simplify

SetDirectory["D:/Mikko/opetus/kvmii"];
Display["kuva26.eps", %177, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

SetDirectory["D:/Mikko/opetus/kvmii"];
Display["kuva27.eps", %178, "EPS"];
SetDirectory["C:\\Program Files\\Wolfram Research\\Mathematica\\4.1\
"];

Integrate[r*Sin[K*r] E^(-r^2/a^2), {r, 0, Infinity}] // 
      Simplify

Rutherfordin sironta

Clear[t, a, k]
a = 1
k = 1
diff = (1 - Exp[-(k*a)^2 Sin[t/2]^2])^2/
        Sin[t/2]^4
Plot[diff, {t, 0, Pi}, PlotRange -> All]