\[Gamma] = 1; \[Lambda] = 0.05; dt = 0.05; J = 0.2; steps = 500; nx = 21; ny = 21; n = nx*ny; adjacency = Normal@AdjacencyMatrix[GridGraph[{nx, ny}] ]; M0 = Table[{0, 0, 1}, {n}]; M = M0; M[[Floor[nx/2]*ny + Floor[ny/2] + 1]] = {1, 1, 0}; Graphics3D[{ Flatten@Table[Line[{{Mod[j, Sqrt[n], 1], Quotient[j, Sqrt[n], 1] + 1, 0}, {Mod[j, Sqrt[n], 1], Quotient[j, Sqrt[n], 1] + 1, 0} + M[[j]]} ], {j, 1, n}] }, PlotRange -> {{Sqrt[n]/4, 3/4 Sqrt[n] + 1}, {Sqrt[n]/4, 3/4 Sqrt[n] + 1}, {-0.25, 1}}] evo = Reap[Do[ M = (#/Norm[#] &) /@ M; Hext = J*adjacency . M; M = Table[ M[[j]] + dt*(-\[Gamma] Cross[M[[j]], Hext[[j]] ] - \[Lambda] Cross[ M[[j]], Cross[M[[j]], Hext[[j]] ]]), {j, 1, n}]; Sow[M]; , {steps}]][[2, 1]]; \[Alpha] = 1; frames = Table[Graphics3D[{ Black, Table[ Sphere[{Mod[j, Sqrt[n], 1], Quotient[j, Sqrt[n], 1] + 1, 0}, 0.08], {j, 1, n}], Table[ Sphere[{Mod[j, Sqrt[n], 1], Quotient[j, Sqrt[n], 1] + 1, 0} + \[Alpha]*evo[[k, j]], 0.05], {j, 1, n}], Thick, Flatten@Table[ Line[{{Mod[j, Sqrt[n], 1], Quotient[j, Sqrt[n], 1] + 1, 0}, {Mod[j, Sqrt[n], 1], Quotient[j, Sqrt[n], 1] + 1, 0} + \[Alpha]*evo[[k, j]]} ], {j, 1, n}], Red, Table[ Line[({Mod[j, Sqrt[n], 1], Quotient[j, Sqrt[n], 1] + 1, 0} + # &) /@ (\[Alpha]*evo[[Max[1, k - 50] ;; k, j]]) ], {j, 1, n}], Gray, Cuboid[{Sqrt[n]/4, Sqrt[n]/4, 0}, {3 Sqrt[n]/4 + 1, 3 Sqrt[n]/4 + 1, -0.2}] }, PlotRange -> {{Sqrt[n]/4, 3/4 Sqrt[n] + 1}, {Sqrt[n]/4, 3/4 Sqrt[n] + 1}, {-0.25, \[Alpha] + 0.1}}, ImageSize -> 500, Lighting -> "Neutral", Boxed -> False] , {k, 2, steps/1, 4}]; ListAnimate[frames]