(* --- Calculo de las funciones de onda en el pozo --- *)

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

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

(* ----  ancho del pozo ---- *)
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,0,1]},
                                  {RGBColor[1,0,0]}}]

(* ---- coeficientes de onda total ---- *)
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,1]},
                                  {RGBColor[1,0,0]}}]

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

(* Mathematica 5 ------
τ = 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,1]},
                                  {RGBColor[1,0,0]}}
       ],
       {t,0,τ, τ/50}
    ]
----- fin Mathematica 5   *)

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

Manipulate[ 
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.3,1.3}],
  {t,0,τ, τ/50}
      ]

(* Mathematica 5 ------
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]}}
       ],
       {t,0,τ, τ/50}
    ];
----- fin Mathematica 5   *)

Manipulate[ 
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.3,1.3}],
  {t,0,τ, τ/50}
      ]

HTMLSave["dinamicanb.html", "dinamica.nb"]