Dinamica Cuantica

phi[x_, n_Integer, a_] := 
              If[0 < x < a, Sqrt[2/a]*Sin[(n*Pi*x)/a], 0];

  
Ener[n_Integer,  
              a_]  :=   (n*Pi/a)^2 /2.  ;

  
a  =  2;

Plot[
{phi[x, 1, a], phi[x, 2, a], 
          phi[x, 3, a]}, {x, -1/2, 
          5/2},  
PlotStyle  ->  {{RGBColor[0, 0, 
                1]}, {RGBColor[
                0,  .5,  .5]}, 
                                  {RGBColor[1, 0, 
                0]}
                       } , 
ImageSize  ->  
          500
   ];

τ  =  2*Pi/(Ener[1, a]);

Table[
                Plot[
        {     Re[  phi[
                          x, 1, a]*
                        Exp[- I*Ener[1, a]*
                            t] ] , 
       Im[  phi[x, 1, a]*Exp[- I*Ener[1, a]*t]  ], 
                    Abs[phi[x, 1, a]*
                        Exp[- I*Ener[1, a]*
                            t] ]
}, 
        {x, -0.5, 
                    2.5},  
         PlotRange  ->  {-1.5, 
                      1.5}, 
       PlotStyle  ->  {
                                  {RGBColor[0, 0, 
                          1]}, 
                                 {RGBColor[0, 1, 
                          0]}, 
                                  {RGBColor[1, 0, 0],  
                        Thickness[
                          0.01] }
                                 } ,  
      ImageSize  ->  
                    500
       ], 
       {t, 
                  0, τ,  τ/50}
    ];

c  =   {Sqrt[1. /2. ],  
            Sqrt[1. /2. ]};


      Plot[
{phi[x, 1, a], 
            phi[x, 2, a], 
c[[1]] phi[x, 1, a]  +  
              c[[2]] phi[x, 2, a]}, 
{x, -1/2, 
            5/2},  
PlotStyle  ->  {
                          {RGBColor[0, 0, 
                  1]          }, 
                          {RGBColor[0, 
                  0.5,  .5]      }, 
                          {RGBColor[1, 0, 0],  
                Thickness [ 
                  0.01]  }
                        } , 
ImageSize  ->  
            500
];

τ  =  
          2*Pi/(Ener[1, a]) ;movie1  =  
          Table[Plot[{Re[
                  c[[1]]*phi[x, 1, a]*
                    Exp[- I*Ener[1, a]*
                        t] ], 
         Re[
                  c[[2]]*phi[x, 2, a]*
                    Exp[- I*Ener[2, a]*t] ], 
Re[
                  c[[1]]*phi[x, 1, a]*
                      Exp[- I*Ener[1, a]*
                          t]  + 
       c[[2]]*
                      phi[x, 2, a]*
                      Exp[- I*Ener[2, a]*
                          t]]}, 
        {x, -0.5, 2.5},  
         PlotRange  ->  {-1.25, 
                  1.25}, 
     PlotStyle  ->  {
                                  {RGBColor[0, 0, 
                      1]}, 
                                  {RGBColor[0, 
                      0.5,  .5]}, 
                                  {RGBColor[1, 0, 0] ,  
                    Thickness[
                      0.01] }
                             } ,  
   ImageSize  ->  
                500
       ], 
       {t, 
              0, τ,  τ/
                50}
    ] ;

(* ---- 
                  evolucion temporal de onda total  ---- *) 

Table[
              Plot[{Re[
                    c[[1]]*phi[x, 1, a]*Exp[-I*Ener[1, a]*t] + 
                      c[[2]]*phi[x, 2, a]*Exp[-I*Ener[2, a]*t]], 
                  Im[c[[1]]*phi[x, 1, a]*Exp[-I*Ener[1, a]*t] + 
                      c[[2]]*phi[x, 2, a]*Exp[-I*Ener[2, a]*t]], 
                  Abs[c[[1]]*phi[x, 1, a]*Exp[-I*Ener[1, a]*t] + 
                      c[[2]]*phi[x, 2, a]*
                        Exp[-I*Ener[2, a]*t]]}, {x, -0.5, 2.5}, 
                PlotRange -> {-1.5, 1.5}, 
                PlotStyle -> {
{RGBColor[0, 0, 
                        1]}, 
{RGBColor[0, 1, 
                        0]}, 
{RGBColor[1, 0, 0],  
                      Thickness[
                        0.01] }
},  
ImageSize  ->  
                  500
        ], 
{t, 0, τ, τ/50}];

Gaussian[x_, d0_, w0_, 
        k0_]  :=  
       1/Sqrt[Sqrt[Pi]*w0]*
        Exp[ - (x - d0)^2 / 2 w0^2 ] * 
        Exp[I k0  x]

NIntegrate[(Abs[Gaussian[x, -4, 1, 1]])^2, {x, -10, 
        10} ]

Plot[
        Abs[Gaussian[x, -5, 1, 1]], {x, -10, 10}, 
        PlotRange -> All, 
        PlotStyle -> {RGBColor[1, 0, 0], Thickness[0.01]}, 
        ImageSize -> 500];

a =  20;

    f[n_Integer] := 
        NIntegrate[
          Gaussian[x, -5, 1, 1]*phi[x, n, a], {x, -Infinity, 
            Infinity}];

phi[x_, n_Integer, a_] := 
        If[-a/2 < x < a/2, Sqrt[2/a]*Cos[(n*Pi*x)/a], 
          0];

Plot[ phi[x, 1, a],  {x, -10, 10},  
        PlotStyle -> {{RGBColor[1, 0, 0], Thickness[0.01]}}, 
        ImageSize -> 500
];

f[n_Integer] := 
        NIntegrate[
          Gaussian[x, -5, 1, 10]*phi[x, n, a], {x, -Infinity, 
            Infinity} ];

nmin = 1;
nmax = 30 ;
b := Table[f[n], {n, nmin, nmax}];

ListPlot[Abs[b], 
        PlotStyle -> {RGBColor[1, 0.25, 0.25], PointSize[0.03]}, 
        PlotRange -> {0, 0.4}, ImageSize -> 500];

Sum[ ( 
          Abs[  b[[n]]   ])^2 ,  {n, nmin,  
        nmax}]

ξ[x_, t_] := 
        Sum[b[[n]]*phi[x, n, a]*Exp[-I*Ener[n, a]*t], {n, nmin, 
            nmax}];

\(\(\(
\)\(\(τ = 1*Pi/\((Ener[0])\);\)

    \(Table[
        Plot[Abs[ξ[x, t]], {x, \(-10\), 10}, 
          PlotRange -> {0. , 0.4}, 
          PlotStyle -> {{RGBColor[1, 0, 0], Thickness[0.01]}}, 
          ImageSize -> 500], {t, 
          0, τ, τ/25}];\)\)\)\)

\( (*\ \ \ HTMLSave["dinamicamath.html", \ "dinamicamath.nb"]\ \ *) \)