StepSA:=(Π[[1]]=Π[[2]];Π=0;ψ[[1]]=ψ[[2]];ψ[[n]]=0;Do[ψ[[i]]=ψ[[i]]+Δt*Π[[i]];,{i,n}];
Do[Π[[i]]=(1-Δt*γ)*Π[[i]]+c^2*(Δt/Δx^2)*(ψ[[i-1]]+ψ[[i+1]]-2*ψ[[i]]);,{i,2,n-1}];)
StepA:=(Π[[1]]=Π[[2]];Π[[n]]=Π[[n-1]];ψ[[1]]=ψ[[2]];ψ[[n]]=ψ[[n-1]];Do[ψ[[i]]=ψ[[i]]+Δt*Π[[i]];,{i,n}];
Do[Π[[i]]=(1-Δt*γ)*Π[[i]]+c^2*(Δt/Δx^2)*(ψ[[i-1]]+ψ[[i+1]]-2*ψ[[i]]);,{i,2,n-1}];ψ=ψ-Mean[ψ])
StepC:=(Π[[1]]=0;Π[[n]]=0;ψ[[1]]=0;ψ[[n]]=0;Do[ψ[[i]]=ψ[[i]]+Δt*Π[[i]];,{i,n}];
Do[Π[[i]]=(1-Δt*γ)*Π[[i]]+c^2*(Δt/Δx^2)*(ψ[[i-1]]+ψ[[i+1]]-2*ψ[[i]]);,{i,2,n-1}];)
Energia:=Π.Π+c^2*Sum[(ψ[[i+1]]-ψ[[i-1]])^2/(4*Δx^2),{i,2,n-1}]

Propagacion en la barra

\(\(\( (*Este\ algoritmo\ simula\ la\ propagación\ de\ una\ perturbación\ elástica\ en\ una\ barra\ de\ longitud\ n*Δx, 
      que\ inician\ al\ darle\ una\ velocidad\ inicial\ en\ un\ extremo . 
          Aqui\ γ\ es\ un\ coeficiente\ de\ disipación\ y\ c\ es\ la\ velocidad\ de\ \(\(propagacion\)\(.\)\)*) \)\(\(n = 
        40; Δx =  .05; Δt =  .001; 
      c =  .5; γ =  .01; \)\(
\)\(Π = 
        Table[0, {i, 0, n - 1}]; Π[\([\)\(2\)\(]\)] = 
        1. ; \)\(
\)\(ψ = 
        Table[0. , {n}]; \)\(
\)\(ListAnimate[
        Table[Do[StepA, {200}]; 
          Show[ListPlot[ψ, PlotRange -> {All, {\(- .6\),  .6}}, 
              PlotJoined -> True, PlotLabel -> "Barra"], 
            Graphics[
              Text["Energia:" <> 
                  ToString[
                    Energia], {20,  .5}]]], {200}]]\)\(
\)\(
\)\)\)\)

Resonancia en un tubo semiabierto

\(\(\( (*Este\ algoritmo\ simula\ un\ tubo\ semiabierto\ de\ longitud\ n*Δx, 
      al\ que\ en\ el\ extremo\ abierto\ se\ lo\ excita\ con\ una\ frecuencia\ fija . Aqui\ γ\ es\ un\ coeficiente\ de\ disipación, 
      c\ es\ la\ velocidad\ de\ propagacion\ y\ ω0\ es\ la\ frecuencia\ fundamental\ del\ "tubo" . 
          Variando\ el\ prefactor\ de\ ω0\ podemos\ ver\ como\ al\ pasar\ de\ una\ resonancia\ a\ otra\ aparece\ el\ fenómeno\ de\ \(\(batido\)\(.\)\)*) \)\(\(n = 
        40; Δx =  .05; Δt =  .001; 
      c = 2. ; γ =  .001; ω0 =  .25 
           c/\((38*Δx)\)\ 2  π; ω =  .95  ω0; \)\(
\)\(Π = 
        Table[0, {i, 0, n - 1}]; Π[\([\)\(2\)\(]\)] = 
        1. ; \)\(
\)\(ψ = 
        Table[0. , {n}]; \)\(
\)\(t = 0; \)\(
\)\(ListAnimate[
        Table[Do[ψ[\([\)\(2\)\(]\)] =  .5 
                 Sin[ω\ t]; Π[\([\)\(2\)\(]\)] = ω\  .5  Cos[ω\ t]; t = Δt + t; StepSA, {200}]; 
          Show[ListPlot[ψ, PlotRange -> {All, {\(-4\), 4}}, 
              PlotJoined -> True, PlotLabel -> "Tubo"], 
            Graphics[
              Text["Energia:" <> 
                  ToString[
                    Energia], {20,  .5}]]], {200}]]\)\(
\)\(
\)\)\)\)