https://community.wolfram.com RSS Feed for Wolfram Community showing any discussions tagged with Mechanical Engineering sorted by active. https://community.wolfram.com/groups/-/m/t/3647332 &[Wolfram Notebook][1] [1]: https://www.wolframcloud.com/obj/33bddd45-7f6b-4b2b-a581-dab91355cb78 Housam Binous 2026-02-28T21:02:03Z https://community.wolfram.com/groups/-/m/t/3503134 ![Helping hand to Africa:prosthetic hand's kinetic movement & force-closure grasping analysis][1] &[Wolfram Notebook][2] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot2025-07-10at4.09.36%E2%80%AFPM.png&userId=3501263 [2]: https://www.wolframcloud.com/obj/b1e5f73f-31a2-405b-96fa-122564a24619 Eunchan Hwang 2025-07-10T22:07:54Z https://community.wolfram.com/groups/-/m/t/3449441 I now generate a three-dimensional model, using two methods to calculate the porosity, the first method is generated by the volume function, the second is calculated by the method of discrete mathematics, but I did not understand, the two results are not the same, is not my which method has a problem， L = 2 \[Pi]; d = 0.1; point = Table[{x, y, z}, {x, -L, L, d}, {y, -L, L, d}, {z, -L, L, d}]; point = Flatten[point, 3]; condition = -0.5 < (Cos[#1] Sin[#2] + Cos[#2] Sin[#3] + Cos[#3] Sin[#1] &) @@ # < 0.5 &; point1 = Select[point, condition]; 1 - N@(Length[point1]/Length[point]) tpmsG := Cos[x] Sin[y] + Cos[y] Sin[z] + Cos[z] Sin[x] porosity[formula_, neg_, pos_] := Module[{}, 1 - Volume[ ImplicitRegion[-neg < formula < pos, {{x, -2 \[Pi], 2 \[Pi]}, {y, -2 \[Pi], 2 \[Pi]}, {z, -2 \[Pi], \[Pi]}}]]/(4 \[Pi])^3] porosity[tpmsG, 0.5, 0.5] ![enter image description here][1] ![enter image description here][2] Now, I have a more complex three-dimensional model of radial variation, how do I calculate its porosity ![enter image description here][3] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=%E5%B1%8F%E5%B9%95%E6%88%AA%E5%9B%BE2025-04-28181142.png&userId=3449409 [2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=%E5%B1%8F%E5%B9%95%E6%88%AA%E5%9B%BE2025-04-28181519.png&userId=3449409 [3]: https://community.wolfram.com//c/portal/getImageAttachment?filename=%E5%B1%8F%E5%B9%95%E6%88%AA%E5%9B%BE2025-04-28181730.png&userId=3449409 扬 崔 2025-04-24T08:52:28Z https://community.wolfram.com/groups/-/m/t/3328759 ![Enhanced Geneva mechanism animation: a detailed and complex 3D representation][1] &[Wolfram Notebook][2] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=GenevaMechanismAnimation_IsometricFrontViews3to7Slots.gif&userId=20103 [2]: https://www.wolframcloud.com/obj/3ed2b7ae-9709-4909-96b9-9dd6a356a857 David Balandra 2024-11-26T16:17:09Z https://community.wolfram.com/groups/-/m/t/2591848 I retired 20 years ago. I want to install Mechanical Systems pack v 1.0.0.0 (circa 1995) in my Mathematica 12. Can't quite figure it out. Anyone else had the problem of using really old add-ons iin recent versions of Mathematica? Neil Chiavaroli 2022-08-03T21:46:48Z https://community.wolfram.com/groups/-/m/t/2534173 Hi All, I'm trying to formulate and solve a pde which models thermal radiation between two bodies using a Neumann boundary condition. I've created a mesh and want to capture the thermal radiation heat transfer between element 106 and element 19 in the boundary mesh wireframe plot below. ![enter image description here][1] I've modelled convective BCs as follows: GconvPistComb = NeumannValue[hPistComb*(TPistHeat - temp[z, r]), ElementMarker == 106]; GconvBlkCool = NeumannValue[hCoolWater1*(TWater1 - temp[z, r]), ElementMarker == 75] The pde with just these included looks like: pde = {1/r D[-kMesh r D[temp[z, r], r], r] + D[-kMesh D[temp[z, r], z], z] == GconvPistComb + GconvBlkCool If I were modelling the thermal radiation from ambient gas to element 19 I would use the following Neumann BC in which TAmb is a pre-defined fixed value: GradAmbTest = NeumannValue[Epsilon Sigma (TAmb - temp[z, r])^4, ElementMarker == 19]; How can I replace TAmb with an expression that represents the solved temperature field for Element 106? [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=MathematicaThermalRadiationQuestion.png&userId=1933607 Archie Watts-Farmer 2022-05-18T18:11:52Z https://community.wolfram.com/groups/-/m/t/2509502 *WOLFRAM MATERIALS for the ARTICLE:* > Peretz, O., Ben Abu, E., Zigelman, A. et al. > *A metafluid with multistable density and internal energy states*. > NATURE, Nature Communications 13, 1810 (2022). > https://doi.org/10.1038/s41467-022-29048-3 > [Full article in PDF][1] ![enter image description here][2] *Image from Nature Communications* https://doi.org/10.1038/s41467-022-29048-3 &[Wolfram Notebook][3] [1]: https://www.nature.com/articles/s41467-022-29048-3.pdf [2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=10605hero.png&userId=20103 [3]: https://www.wolframcloud.com/obj/4b9b252d-800b-4b58-8e6e-3c3d74ebe4e3 Ofek Peretz 2022-04-12T18:50:46Z https://community.wolfram.com/groups/-/m/t/2492037 This algorithm is 3D extension of our 2D algorithm published on [this page][1] and [here][2]. We suppose that with this code we can simulate transition from laminar to turbulent flow. In this example we compute viscous flow around cuboid at Reynolds number $Re=6250$. Note, that code has been tested up to $Re=10^6$. dif = 1/6250; pec = .72; U0 = 1.; V0 = 0.; W0 = 0.; dn0 = 1.; n = 80; n1 = n + 1; sm = 500; r = 20; den = ConstantArray[dn0 , {n1, n1, n1}]; u0 = ConstantArray[U0, {n1, n1, n1}]; v0 = ConstantArray[V0, {n1, n1, n1}]; w0 = ConstantArray[W0, {n1, n1, n1}]; Do[u0[[i, j, k]] = 0; v0[[i, j, k]] = 0; w0[[i, j, k]] = 0;, {i, 10, 20, 1}, {j, Round[n/2 - 5], Round[n/2 + 5], 1}, {k, Round[n/2 - 5], Round[n/2 + 5], 1}]; periodic[n_, up_, ud_, ul_, ur_, ub_] := Module[{bd = ub}, Do[bd[[n + 1, i, j]] = bd[[2, i, j]]; bd[[1, i, j]] = bd[[n, i, j]];, {i, 2, n}, {j, 2, n}]; Do[bd[[i, 1, j]] = ud; bd[[i, n + 1, j]] = up; bd[[i, j, 1]] = ul; bd[[i, j, n + 1]] = ur;, {i, 1, n + 1}, {j, 1, n + 1}]; bd]; diffuse[n_, r_, a_, c_, c0_] := Module[{c1 = c}, Do[Do[Do[ Do[c1[[i, j, k]] = (c0[[i, j, k]] + a (c1[[i - 1, j, k]] + c1[[i + 1, j, k]] + c1[[i, j - 1, k]] + c1[[i, j + 1, k]] + c1[[i, j, k - 1]] + c1[[i, j, k + 1]]))/(1 + 6 a);, {k, 2, n}];, {j, 2, n}];, {i, 2, n}]; Do[c1[[i, j, k]] = 0;, {i, 10, 20, 1}, {j, Round[n/2 - 5], Round[n/2 + 5], 1}, {k, Round[n/2 - 5], Round[n/2 + 5], 1}];, {k1, 0, r}]; c1]; advect[n_, d0_, u_, v_, w_, dt_] := Module[{x, y, z, d1, dt0, i0, i1, j0, j1, k0, k1, s0, s1, t0, t1, p1, p0, d000, d100, d010, d001, d110, d011, d101, d111}, d1 = ConstantArray[0, {n + 1, n + 1, n + 1}]; dt0 = dt n; Do[Do[Do[x = i - dt0 u[[i, j, k]]; y = j - dt0 v[[i, j, k]]; z = k - dt0 w[[i, j, k]]; i0 = Which[x <= 1, 1, 1 < x < n, Floor[x], True, n]; i1 = i0 + 1; j0 = Which[y <= 1, 1, 1 < y < n, Floor[y], True, n]; j1 = j0 + 1; k0 = Which[z <= 1, 1, 1 < z < n, Floor[z], True, n]; k1 = k0 + 1; d000 = (d0[[i0, j0, k0]] + (x - i0) (d0[[i1, j0, k0]] - d0[[i0, j0, k0]]) + (y - j0) (d0[[i0, j1, k0]] - d0[[i0, j0, k0]]) + (z - k0) (d0[[i0, j0, k1]] - d0[[i0, j0, k0]])); d100 = (d0[[i1, j0, k0]] + (x - i1) (d0[[i1, j0, k0]] - d0[[i0, j0, k0]]) + (y - j0) (d0[[i1, j1, k0]] - d0[[i1, j0, k0]]) + (z - k0) (d0[[i1, j0, k1]] - d0[[i1, j0, k0]])); d010 = (d0[[i0, j1, k0]] + (x - i0) (d0[[i1, j1, k0]] - d0[[i0, j1, k0]]) + (y - j1) (d0[[i0, j1, k0]] - d0[[i0, j0, k0]]) + (z - k0) (d0[[i0, j1, k1]] - d0[[i0, j1, k0]])); d001 = (d0[[i0, j0, k1]] + (x - i0) (d0[[i1, j0, k1]] - d0[[i0, j0, k1]]) + (y - j0) (d0[[i0, j1, k1]] - d0[[i0, j0, k1]]) + (z - k1) (d0[[i0, j0, k1]] - d0[[i0, j0, k0]])); d110 = (d0[[i1, j1, k0]] + (x - i1) (d0[[i1, j1, k0]] - d0[[i0, j1, k0]]) + (y - j1) (d0[[i1, j1, k0]] - d0[[i1, j0, k0]]) + (z - k0) (d0[[i1, j1, k1]] - d0[[i1, j1, k0]])); d011 = (d0[[i0, j1, k1]] + (x - i0) (d0[[i1, j1, k1]] - d0[[i0, j1, k1]]) + (y - j1) (d0[[i0, j1, k1]] - d0[[i0, j0, k1]]) + (z - k1) (d0[[i0, j1, k1]] - d0[[i0, j1, k0]])); d101 = (d0[[i1, j0, k1]] + (x - i1) (d0[[i1, j0, k1]] - d0[[i0, j0, k1]]) + (y - j0) (d0[[i1, j1, k1]] - d0[[i1, j0, k1]]) + (z - k1) (d0[[i1, j0, k1]] - d0[[i1, j0, k0]])); d111 = (d0[[i1, j1, k1]] + (x - i1) (d0[[i1, j1, k1]] - d0[[i0, j1, k1]]) + (y - j1) (d0[[i1, j1, k1]] - d0[[i1, j0, k1]]) + (z - k1) (d0[[i1, j1, k1]] - d0[[i1, j1, k0]])); d1[[i, j, k]] = (d000 + d100 + d010 + d001 + d110 + d011 + d101 + d111)/8;, {k, 2, n}];, {j, 2, n}];, {i, 1, n + 1}]; d1]; project[n_, r_, u0_, v0_, w0_, u_, v_, w_] := Module[{ux = u, vy = v, wz = w, div, p}, p = ConstantArray[0, {n + 1, n + 1, n + 1}]; div = ConstantArray[0, {n + 1, n + 1, n + 1}]; ux = ConstantArray[0, {n + 1, n + 1, n + 1}]; vy = ConstantArray[0, {n + 1, n + 1, n + 1}]; wz = ConstantArray[0, {n + 1, n + 1, n + 1}]; Do[div[[i, j, k]] = .5/ n (u0[[i + 1, j, k]] - u0[[i - 1, j, k]] + v0[[i, 1 + j, k]] - v0[[i, j - 1, k]] + w0[[i, j, k + 1]] - w0[[i, j, k - 1]]);, {i, 2, n}, {j, 2, n}, {k, 2, n}]; Do[div[[i, j, k]] = 0;, {i, 10, 20, 1}, {j, Round[n/2 - 5], Round[n/2 + 5], 1}, {k, Round[n/2 - 5], Round[n/2 + 5], 1}]; div = periodic[n, 0, 0, 0, 0, div]; Do[Do[Do[ Do[p[[i, j, k]] = (div[[i, j, k]] + (p[[i - 1, j, k]] + p[[i + 1, j, k]] + p[[i, j - 1, k]] + p[[i, j + 1, k]] + p[[i, j, k - 1]] + p[[i, j, k + 1]]))/6;, {k, 2, n}];, {j, 2, n}], {i, 2, n}];, {k1, 0, r}]; Do[p[[i, j, k]] = 0;, {i, 10, 20, 1}, {j, Round[n/2 - 5], Round[n/2 + 5], 1}, {k, Round[n/2 - 5], Round[n/2 + 5], 1}]; p = periodic[n, 0, 0, 0, 0, p]; Do[ux[[i, j, k]] = u0[[i, j, k]] + .5 n (p[[i + 1, j, k]] - p[[i - 1, j, k]]); vy[[i, j, k]] = v0[[i, j, k]] + .5 n (p[[i, j + 1, k]] - p[[i, j - 1, k]]); wz[[i, j, k]] = w0[[i, j, k]] + .5 n (p[[i, j, k + 1]] - p[[i, j, k - 1]]);, {i, 2, n}, {j, 2, n}, {k, 2, n}]; Do[ux[[i, j, k]] = 0; vy[[i, j, k]] = 0; wz[[i, j, k]] = 0;, {i, 10, 20, 1}, {j, Round[n/2 - 5], Round[n/2 + 5], 1}, {k, Round[n/2 - 5], Round[n/2 + 5], 1}]; {ux, vy, wz}]; onestep[n_, step_, r_, a_, uin_, vin_, win_, dt_, c_] := Module[{u1, v1, w1, u, v, w, u0, v0, w0}, u0 = ConstantArray[0., {n + 1, n + 1, n + 1}]; v0 = ConstantArray[0., {n + 1, n + 1, n + 1}]; w0 = ConstantArray[0., {n + 1, n + 1, n + 1}]; u = ConstantArray[0., {n + 1, n + 1, n + 1}]; v = ConstantArray[0., {n + 1, n + 1, n + 1}]; w = ConstantArray[0., {n + 1, n + 1, n + 1}]; u1 = ConstantArray[0., {n + 1, n + 1, n + 1}]; v1 = ConstantArray[0., {n + 1, n + 1, n + 1}]; w1 = ConstantArray[0., {n + 1, n + 1, n + 1}]; u0 = uin; v0 = vin; w0 = win; Do[u0[[i, j, k]] = 0; v0[[i, j, k]] = 0; w0[[i, j, k]] = 0;, {i, 10, 20, 1}, {j, Round[n/2 - 5], Round[n/2 + 5], 1}, {k, Round[n/2 - 5], Round[n/2 + 5], 1}]; u0 = advect[n, u0, u0, v0, w0, dt]; v0 = advect[n, v0, u0, v0, w0, dt]; w0 = advect[n, w0, u0, v0, w0, dt]; Do[u0[[i, j, k]] = 0; v0[[i, j, k]] = 0;, {i, 10, 20, 1}, {j, Round[n/2 - 5], Round[n/2 + 5], 1}, {k, Round[n/2 - 5], Round[n/2 + 5], 1}]; u0 = periodic[n, 0, 0, 0, 0, u0]; v0 = periodic[n, 0, 0, 0, 0, v0]; w0 = periodic[n, 0, 0, 0, 0, w0]; u0 = diffuse[n, r, a, c, u0]; v0 = diffuse[n, r, a, c, v0]; w0 = diffuse[n, r, a, c, w0]; Do[u0[[i, j, k]] = 0; v0[[i, j, k]] = 0; w0[[i, j, k]] = 0;, {i, 10, 20, 1}, {j, Round[n/2 - 5], Round[n/2 + 5], 1}, {k, Round[n/2 - 5], Round[n/2 + 5], 1}]; u0 = periodic[n, 0, 0, 0, 0, u0]; v0 = periodic[n, 0, 0, 0, 0, v0]; w0 = periodic[n, 0, 0, 0, 0, w0]; {u0, v0, w0} = project[n, r, u0, v0, w0, u, v, w]; Do[u0[[i, j, k]] = 0; v0[[i, j, k]] = 0; w0[[i, j, k]] = 0;, {i, 10, 20, 1}, {j, Round[n/2 - 5], Round[n/2 + 5], 1}, {k, Round[n/2 - 5], Round[n/2 + 5], 1}]; u0 = periodic[n, 0, 0, 0, 0, u0]; v0 = periodic[n, 0, 0, 0, 0, v0]; w0 = periodic[n, 0, 0, 0, 0, w0]; {u0, v0, w0}] cf = With[{cg = Compile`GetElement, hp = HoldPattern, dv = DownValues}, Hold@Compile[{{u0argu, _Real, 3}, {v0argu, _Real, 3}, {w0argu, _Real, 3}, {denargu, _Real, 3}, {sm, _Integer}, {n, _Integer}, {r, _Integer}, dif, pec}, Module[{u0 = u0argu, v0 = v0argu, w0 = w0argu, uu, vv, ww, dd, den = denargu, c = Table[0., {n + 1}, {n + 1}, {n + 1}], dt = 40./n^2, a, dnup = den[[1, n + 1, 1]], dnd = den[[1, 1, 1]], dnl = den[[1, 1, 1]], dnr = den[[1, 1, n + 1]]}, a = dt dif n n; uu = vv = ww = dd = Table[0., {sm + 1}, {n + 1}, {n + 1}, {n + 1}]; Do[{u0, v0, w0} = onestep[n, step, r, a, u0, v0, w0, dt, c]; uu[[step + 1]] = u0; vv[[step + 1]] = v0; ww[[step + 1]] = w0; den = diffuse[n, r, a/pec, c, den]; Do[den[[i, j, k]] = 0;, {i, 10, 20, 1}, {j, Round[n/2 - 5], Round[n/2 + 5], 1}, {k, Round[n/2 - 5], Round[n/2 + 5], 1}]; den = periodic[n, dnup, dnd, dnl, dnr, den]; den = advect[n, den, u0, v0, w0, dt]; Do[den[[i, j, k]] = 0;, {i, 10, 20, 1}, {j, Round[n/2 - 5], Round[n/2 + 5], 1}, {k, Round[n/2 - 5], Round[n/2 + 5], 1}]; den = periodic[n, dnup, dnd, dnl, dnr, den]; dd[[step + 1]] = den;, {step, 0, sm}]; {uu, vv, ww, dd}], CompilationTarget -> "C", RuntimeOptions -> "Speed"] /. dv@onestep /. Flatten[dv /@ {advect, diffuse, periodic, project}] /. hp@ConstantArray[c_, {i_, j_, kc_}] :> Table[0., {i}, {j}, {kc}] /. hp@Part[a__] :> cg[a] /. hp[cg[a__] = rhs_] :> (Part[a] = rhs) // ReleaseHold]; rst = cf[u0, v0, w0, den, sm, n, r, dif, pec]; ## Visualization Do[lst11[s] = Table[{{(i - 1)/n, (j - 1)/n, (k - 1)/n}, rst[[1, s, i, j, k]]}, {i, n1}, {j, n1}, {k, n1}]; lst12[s] = Table[{{(i - 1)/n, (j - 1)/n, (k - 1)/n}, rst[[2, s, i, j, k]]}, {i, n1}, {j, n1}, {k, n1}]; lst13[s] = Table[{{(i - 1)/n, (j - 1)/n, (k - 1)/n}, rst[[3, s, i, j, k]]}, {i, n1}, {j, n1}, {k, n1}];, {s, 25, sm, 25}] Do[su1[i] = Interpolation[Flatten[lst11[i], 2], InterpolationOrder -> 3]; sv2[i] = Interpolation[Flatten[lst12[i], 2], InterpolationOrder -> 3]; sw3[i] = Interpolation[Flatten[lst13[i], 2], InterpolationOrder -> 3];, {i, 25, sm, 25}] Table[Show[ DensityPlot3D[ Norm[{su1[i][x, y, z], sv2[i][x, y, z], sw3[i][x, y, z]}], {x, 0, 1}, {y, 0.44, 1}, {z, 0, 1}, BoxRatios -> Automatic, ColorFunction -> "BlueGreenYellow", PlotLabel -> i], VectorPlot3D[{su1[i][x, y, z], sv2[i][x, y, z], sw3[i][x, y, z]}, {x, 0, 1}, {y, 0, .5}, {z, 0, 1}, VectorPoints -> Fine, VectorMarkers -> "Arrow"], Graphics3D[{{Blue, Cuboid[{10, Round[n/2 - 5] - 1/2, Round[n/2 - 5] - 1/2}/(n + 1), {20, Round[n/2 + 5] - 1/2, Round[n/2 + 5] - 1/2}/(n + 1)]}}]], {i, 50, sm, 50}] ![enter image description here][3] ## Animation Do[lstu1[k] = Flatten[Table[{{(i - 1)/n, (j - 1)/n}, rst[[1, k, i, Round[(n + 1)/2], j]]}, {i, n1}, {j, n1}], 1]; lstw1[k] = Flatten[Table[{{(i - 1)/n, (j - 1)/n}, rst[[2, k, i, Round[(n + 1)/2], j]]}, {i, n1}, {j, n1}], 1];, {k, sm}]; Do[Uvel1[i] = Interpolation[lstu1[i], InterpolationOrder -> 3];, {i, 1, sm}]; Do[Wvel1[i] = Interpolation[lstw1[i], InterpolationOrder -> 3];, {i, 1, sm}]; frame = Table[ Show[DensityPlot[ Norm[{Uvel[m][x, y], Vvel[m][x, y]}], {x, 0, 1}, {y, 0, 1}, PlotRange -> All, ColorFunction -> "BlueGreenYellow", Frame -> False, ImageSize -> Tiny, PlotLabel -> m, PlotPoints -> 50], Graphics[{Gray, Rectangle[{10, Round[n/2 - 5] - 1/2}/(n + 1), {20, Round[n/2 + 5] - 1/2}/(n + 1)]}]], {m, 5, sm, 3}]; ![enter image description here][4] The question is about code improvement. How can we define parameter *r* to solve Laplace and Poison equations in this code? Note, *r* is number of iterations in *diffuse* and *project* module (we use Gauss-Seidel relaxation to solve Laplace and Poison's equations). **Update 1.** We can reduce *r* from *r=20* as above to *r=5* as below. Globally there is no difference in two animations. ![enter image description here][5] But if we compare velocity in some point like $x=0.65, y=0.5$ then we have good agreement for $r=5$ (red points) and $r=20$ (gray points) in laminar flow at $t<0.5$, but a big difference in the turbulent flow at $t>0.5$. ![enter image description here][6] **Update 1.** To test the Gauss-Seidel relaxation method itself we can compute viscous flow in a plane channel with external force (gravity) as follows ClearAll["Global`*"] dif = 1/80; pec = 1; U0 = 0; V0 = 0; n = 11; n1 = n + 1; dt = 2./n^2; sm = 3000; r = 7; n2 = Round[n/2]; a = dt dif n n; c = ConstantArray[0, {n1, n1}]; c0 = ConstantArray[0, {n1, n1}];; u0 = ConstantArray[0, {n1, n1}]; v0 = ConstantArray[0, {n1, n1}]; u = ConstantArray[0, {n1, n1}]; v = ConstantArray[0, {n1, n1}]; periodic[n_, up_, ud_, ub_] := Module[{bd = ub}, Do[bd[[1, i]] = .5 (bd[[n, i]] + bd[[2, i]]); bd[[n + 1, i]] = bd[[1, i]]; bd[[i, 1]] = ud; bd[[i, n + 1]] = up;, {i, 2, n}]; bd[[1, 1]] = ud; bd[[n + 1, n + 1]] = up; bd[[n + 1, 1]] = ud; bd[[1, n + 1]] = up; bd]; diffuse[n_, r_, a_, c_, c0_] := Module[{c1 = c}, c1 = ConstantArray[0, {n + 1, n + 1}]; Do[Do[Do[c1[[i, j]] = (c0[[i, j]] + a (c1[[i - 1, j]] + c1[[i + 1, j]] + c1[[i, j - 1]] + c1[[i, j + 1]]))/(1 + 4 a);, {j, 2, n}];, {i, 2, n}]; c1 = periodic[n, 0, 0, c1];, {k, 0, r}]; c1]; advect[n_, b_, d_, d0_, u_, v_, dt_] := Module[{x, y}, d1 = ConstantArray[0, {n + 1, n + 1}]; dt0 = dt n; Do[Do[x = i - dt0 u[[i, j]]; y = j - dt0 v[[i, j]]; i0 = Which[x <= 1, 1, 1 < x < n, Floor[x], x >= n, n]; i1 = i0 + 1; j0 = Which[y <= 1, 1, 1 < y < n, Floor[y], y >= n, n]; j1 = j0 + 1; s1 = x - i0; s0 = 1 - s1; t1 = y - j0; t0 = 1 - t1; d1[[i, j]] = s0 (t0 d0[[i0, j0]] + t1 d0[[i0, j1]]) + s1 (t0 d0[[i1, j0]] + t1 d0[[i1, j1]]);, {j, 1, n + 1}];, {i, 1, n + 1}]; d1]; project[n_, r_, u0_, v0_, u_, v_] := Module[{ux = u, vy = v}, p = ConstantArray[0, {n1, n1}]; div = ConstantArray[0, {n1, n1}]; ux = ConstantArray[0, {n1, n1}]; vy = ConstantArray[0, {n1, n1}]; Do[div[[i, j]] = -.5 / n (u0[[i + 1, j]] - u0[[i - 1, j]] + v0[[i, 1 + j]] - v0[[i, j - 1]]);, {i, 2, n}, {j, 2, n}]; Do[Do[Do[ p[[i, j]] = (div[[i, j]] + (p[[i - 1, j]] + p[[i + 1, j]] + p[[i, j - 1]] + p[[i, j + 1]]))/4;, {j, 2, n}], {i, 2, n}];, {k, 0, r}]; Do[ux[[i, j]] = u0[[i, j]] - .5 n (p[[i + 1, j]] - p[[i - 1, j]]); vy[[i, j]] = v0[[i, j]] - .5 n (p[[i, j + 1]] - p[[i, j - 1]]);, {i, 2, n}, {j, 2, n}]; {ux, vy}]; (*force*) Fx[t_, x_, y_] := 1/10; Fy[t_, x_, y_] := 0; f1 = ConstantArray[0, {n1, n1}]; f2 = ConstantArray[0, {n1, n1}]; Do[u0 = advect[n, 0, c, u0, u0, v0, dt]; v0 = advect[n, 0, c, v0, u0, v0, dt]; u0 = periodic[n, 0, 0, u0]; v0 = periodic[n, 0, 0, v0]; u0 = diffuse[n, r, a, c, u0]; v0 = diffuse[n, r, a, c, v0]; u0 = periodic[n, 0, 0, u0]; v0 = periodic[n, 0, 0, v0]; Do[f1[[i, j]] = Fx[dt (step + .5), (i - 1)/n, (j - 1)/n]; f2[[i, j]] = Fy[dt (step + .5), (i - 1)/n, (j - 1)/n];, {i, 2, n1}, {j, 2, n1}]; u0 += f1 dt; v0 += f2 dt; {u0, v0} = project[n, r, u0, v0, u, v]; u0 = periodic[n, 0, 0, u0]; v0 = periodic[n, 0, 0, v0]; uu[step] = u0; vv[step] = v0;, {step, 0, sm}]; ## Visualization of flow velocity and absolute error Do[lstu[k] = Flatten[Table[{{(i - 1)/n, (j - 1)/n}, uu[k][[i, j]]}, {i, n1}, {j, n1}], 1]; lstv[k] = Flatten[Table[{{(i - 1)/n, (j - 1)/n}, vv[k][[i, j]]}, {i, n1}, {j, n1}], 1];, {k, 0, sm}]; Do[Uvel[i] = Interpolation[lstu[i], InterpolationOrder -> 3];, {i, 1, sm}] Do[Vvel[i] = Interpolation[lstv[i], InterpolationOrder -> 3];, {i, 1, sm}]; {StreamDensityPlot[{Uvel[sm][x, y], Vvel[sm][x, y]}, {x, 0, 1}, {y, 0, 1}, ColorFunction -> "RoseColors", Frame -> False, PlotLegends -> Automatic], Plot3D[Uvel[sm][x, y], {x, 0, 1}, {y, 0, 1}, ColorFunction -> "RoseColors"]} {ListPlot[Table[{i dt, Max[uu[i]]}, {i, sm}], AxesLabel -> {"t", "Umax"}], Plot[{-4 (-y + y^2), Uvel[sm][.5, y]}, {y, 0, 1}, PlotStyle -> {Thick, {Red, Dashed}}, Frame -> True, FrameLabel -> {"y", "u"}, PlotLegends -> {"Exact solution", "Numeric solution"}], Plot[Abs[-Uvel[sm][.5, y] - 4 (-y + y^2)], {y, 0, 1}, Frame -> True, FrameLabel -> {"y", "Error"}]} ![enter image description here][7] Actually for *r=7* we have a good convergence to the exact solution on the grid of 12 points with error of $10^{−2}$. For *r=5* the error is about 0.2 and for *r=10* error is about $10^{−2}$, therefore *r=7* is optimal value. **Update 2.** In the module *advect* we can use trilinear interpolation as follows advect[n_, d0_, u_, v_, w_, dt_] := Module[{x, y, z, d1, dt0, i0, i1, j0, j1, k0, k1, s0, s1, t0, t1, p1, p0, d00, d10, d01, d11, cd0, cd1, xd, yd, zd}, d1 = ConstantArray[0, {n + 1, n + 1, n + 1}]; dt0 = dt n; Do[Do[Do[x = i - dt0 u[[i, j, k]]; y = j - dt0 v[[i, j, k]]; z = k - dt0 w[[i, j, k]]; i0 = Which[x <= 1, 1, 1 < x < n, Floor[x], True, n]; i1 = i0 + 1; j0 = Which[y <= 1, 1, 1 < y < n, Floor[y], True, n]; j1 = j0 + 1; k0 = Which[z <= 1, 1, 1 < z < n, Floor[z], True, n]; k1 = k0 + 1;(*Trilinear interpolation*)xd = x - i0; yd = y - j0; zd = z - k0; d00 = d0[[i0, j0, k0]] (1 - xd) + d0[[i1, j0, k0]] xd; d01 = d0[[i0, j0, k1]] (1 - xd) + d0[[i1, j0, k1]] xd; d10 = d0[[i0, j1, k0]] (1 - xd) + d0[[i1, j1, k0]] xd; d11 = d0[[i0, j1, k1]] (1 - xd) + d0[[i1, j1, k1]] xd; cd0 = d00 (1 - yd) + d10 yd; cd1 = d01 (1 - yd) + d11 yd; d1[[i, j, k]] = cd0 (1 - zd) + cd1 zd; , {k, 2, n}];, {j, 2, n}];, {i, 1, n + 1}]; d1]; ## Update: testing projection step To test `projection` step itself we can use Mathematica FEM and exact benchmark solution from well known paper [EXACT FULLY 3D NAVIER-STOKES SOLUTIONS FOR BENCHMARKING by C. ROSS ETHIER AND D. A. STEINMAN][8] as follows. First, we consider projection step as an implementation of the predictor-corrector algorithm $$\frac{u-u_n}{\tau}+(u.\nabla)u-\nu\nabla^2 u=0$$ $$\frac{u_{n+1}-u}{\tau}+\nabla p =0$$ here $\tau$ is time step, $u_n, u, u_{n+1}$ if velocity field on previous, intermediate and next step consequently, and $p$ is a pressure. We suppose that $\nabla.u_{n+1}=0$, and therefore $$\nabla^2p-\frac{\nabla.u}{\tau}=0$$ Second, we solve NSE in the unit cuboid with Dirichlet condition using exact solution and FEM, we have code Clear["Global`*"] Needs["NDSolve`FEM`"] reg = Cuboid[]; mesh = ToElementMesh[reg, MaxCellMeasure -> 0.001]; (*Exact solution*) U[x_, y_, z_, t_] := -a Exp[-d^2 t] (Exp[a x] Sin[a y + d z] + Exp[a z] Cos[a x + d y]); V[x_, y_, z_, t_] := -a Exp[-d^2 t] (Exp[a y] Sin[a z + d x] + Exp[a x] Cos[a y + d z]); W[x_, y_, z_, t_] := -a Exp[-d^2 t] (Exp[a z] Sin[a x + d y] + Exp[a y] Cos[a z + d x]); P[x_, y_, z_, t_] := -a ^2/ 2 Exp[-2 d^2 t] (Exp[2 a x] + Exp[2 a y] + Exp[2 a z] + 2 Sin[a x + d y] Exp[a (y + z)] Cos[a z + d x] + 2 Sin[a y + d z] Exp[a (x + z)] Cos[a x + d y] + 2 Sin[a z + d x] Exp[a (y + x)] Cos[ a y + d z]); (*t0 is time step, nn is number of iterations *) a = 1; d = 1; t0 = 1/400; nn = 200; \[Nu] = 1; (*FEM implementation of predictor-corrector algorithm*) UX[0] = U[x, y, z, 0]; VY[0] = V[x, y, z, 0]; WZ[0] = W[x, y, z, 0]; P0[0] = P[x, y, z, 0]; Do[ {UX[i], VY[i], WZ[i], P0[i]} = NDSolveValue[{{-\[Nu]* Laplacian[ u[x, y, z], {x, y, z}] + (u[x, y, z] - UX[i - 1])/t0 + UX[i - 1]*D[u[x, y, z], x] + VY[i - 1]*D[u[x, y, z], y] + WZ[i - 1]*D[u[x, y, z], z], -\[Nu]* Laplacian[ v[x, y, z], {x, y, z}] + (v[x, y, z] - VY[i - 1])/t0 + UX[i - 1]*D[v[x, y, z], x] + VY[i - 1]*D[v[x, y, z], y] + WZ[i - 1]*D[v[x, y, z], z], -\[Nu]* Laplacian[ w[x, y, z], {x, y, z}] + (w[x, y, z] - WZ[i - 1])/t0 + UX[i - 1]*D[w[x, y, z], x] + VY[i - 1]*D[w[x, y, z], y] + WZ[i - 1]*D[w[x, y, z], z], Laplacian[p[x, y, z], {x, y, z}] - ( \!\(\*SuperscriptBox[\(u\), TagBox[ RowBox[{"(", RowBox[{"1", ",", "0", ",", "0"}], ")"}], Derivative], MultilineFunction->None]\)[x, y, z] + \!\(\*SuperscriptBox[\(v\), TagBox[ RowBox[{"(", RowBox[{"0", ",", "1", ",", "0"}], ")"}], Derivative], MultilineFunction->None]\)[x, y, z] + \!\(\*SuperscriptBox[\(w\), TagBox[ RowBox[{"(", RowBox[{"0", ",", "0", ",", "1"}], ")"}], Derivative], MultilineFunction->None]\)[x, y, z])/t0} == {0, 0, 0, 0}, { DirichletCondition[{u[x, y, z] == U[x, y, z, i t0 - t0/2] + t0 D[P[x, y, z, i t0], x], v[x, y, z] == V[x, y, z, i t0 - t0/2] + t0 D[P[x, y, z, i t0], y], w[x, y, z] == W[x, y, z, i t0 - t0/2] + t0 D[P[x, y, z, i t0], z], p[x, y, z] == P[x, y, z, i t0 ]}, True]}}, {u[x, y, z] - t0 \!\(\*SuperscriptBox[\(p\), TagBox[ RowBox[{"(", RowBox[{"1", ",", "0", ",", "0"}], ")"}], Derivative], MultilineFunction->None]\)[x, y, z], v[x, y, z] - t0 \!\(\*SuperscriptBox[\(p\), TagBox[ RowBox[{"(", RowBox[{"0", ",", "1", ",", "0"}], ")"}], Derivative], MultilineFunction->None]\)[x, y, z], w[x, y, z] - t0 \!\(\*SuperscriptBox[\(p\), TagBox[ RowBox[{"(", RowBox[{"0", ",", "0", ",", "1"}], ")"}], Derivative], MultilineFunction->None]\)[x, y, z], p[x, y, z]}, {x, y, z} \[Element] mesh, Method -> {"FiniteElement", "InterpolationOrder" -> {u -> 2, v -> 2, w -> 2, p -> 2}}];, {i, 1, nn}]; Visualization of error on every 5 steps on the line $x=1/2, z=1/2$ for $u_n=(UX[n],VY[n],WZ[n])$, and $p=P0[n]$ Table[{k t0 // N, Plot[Evaluate[{U[x, y, z, k t0]/UX[k] - 1} /. {x -> 1/2, z -> 1/2}], {y, 0, 1}, PlotRange -> All], Plot[Evaluate[{V[x, y, z, k t0]/VY[k] - 1} /. {x -> 1/2, z -> 1/2}], {y, 0, 1}, PlotRange -> All], Plot[Evaluate[{W[x, y, z, k t0]/WZ[k] - 1} /. {x -> 1/2, z -> 1/2}], {y, 0, 1}, PlotRange -> All], Plot[Evaluate[{P[x, y, z, k t0]/P0[k] - 1} /. {x -> 1/2, z -> 1/2}], {y, 0, 1}, PlotRange -> All]}, {k, 5, nn, 5}] Please note, that in the picture shown last steps only. The relative error for pressure is about $3\times 10^{-3}$, and for velocity $1.25\times10^{-3}$ on the grid $10\times10\times 10$ on 200 steps in time with time step $\tau =1/400$. ![Figure 1][9] Using exact benchmark solution we also can test linear FEM algorithm described on [Solver for unsteady flow with the use of Mathematica FEM][10] and extended to 3D below as follows Needs["NDSolve`FEM`"] reg = Cuboid[]; mesh = ToElementMesh[reg, MaxCellMeasure -> 0.001] U[x_, y_, z_, t_] := -a Exp[-d^2 t] (Exp[a x] Sin[a y + d z] + Exp[a z] Cos[a x + d y]); V[x_, y_, z_, t_] := -a Exp[-d^2 t] (Exp[a y] Sin[a z + d x] + Exp[a x] Cos[a y + d z]); W[x_, y_, z_, t_] := -a Exp[-d^2 t] (Exp[a z] Sin[a x + d y] + Exp[a y] Cos[a z + d x]); P[x_, y_, z_, t_] := -a ^2/ 2 Exp[-2 d^2 t] (Exp[2 a x] + Exp[2 a y] + Exp[2 a z] + 2 Sin[a x + d y] Exp[a (y + z)] Cos[a z + d x] + 2 Sin[a y + d z] Exp[a (x + z)] Cos[a x + d y] + 2 Sin[a z + d x] Exp[a (y + x)] Cos[ a y + d z]); a = 1; d = 1; t0 = 1/400; nn = 200; \[Nu] = 1; UX[0] = U[x, y, z, 0]; VY[0] = V[x, y, z, 0]; WZ[0] = W[x, y, z, 0]; P0[0] = P[x, y, z, 0]; Do[ {UX[i], VY[i], WZ[i], P0[i]} = NDSolveValue[{{-\[Nu]* Laplacian[ u[x, y, z], {x, y, z}] + (u[x, y, z] - UX[i - 1])/t0 + UX[i - 1]*D[u[x, y, z], x] + VY[i - 1]*D[u[x, y, z], y] + WZ[i - 1]*D[u[x, y, z], z] + \!\(\*SuperscriptBox[\(p\), TagBox[ RowBox[{"(", RowBox[{"1", ",", "0", ",", "0"}], ")"}], Derivative], MultilineFunction->None]\)[x, y, z], -\[Nu]* Laplacian[ v[x, y, z], {x, y, z}] + (v[x, y, z] - VY[i - 1])/t0 + UX[i - 1]*D[v[x, y, z], x] + VY[i - 1]*D[v[x, y, z], y] + WZ[i - 1]*D[v[x, y, z], z] + \!\(\*SuperscriptBox[\(p\), TagBox[ RowBox[{"(", RowBox[{"0", ",", "1", ",", "0"}], ")"}], Derivative], MultilineFunction->None]\)[x, y, z], -\[Nu]* Laplacian[ w[x, y, z], {x, y, z}] + (w[x, y, z] - WZ[i - 1])/t0 + UX[i - 1]*D[w[x, y, z], x] + VY[i - 1]*D[w[x, y, z], y] + WZ[i - 1]*D[w[x, y, z], z] + \!\(\*SuperscriptBox[\(p\), TagBox[ RowBox[{"(", RowBox[{"0", ",", "0", ",", "1"}], ")"}], Derivative], MultilineFunction->None]\)[x, y, z], ( \!\(\*SuperscriptBox[\(u\), TagBox[ RowBox[{"(", RowBox[{"1", ",", "0", ",", "0"}], ")"}], Derivative], MultilineFunction->None]\)[x, y, z] + \!\(\*SuperscriptBox[\(v\), TagBox[ RowBox[{"(", RowBox[{"0", ",", "1", ",", "0"}], ")"}], Derivative], MultilineFunction->None]\)[x, y, z] + \!\(\*SuperscriptBox[\(w\), TagBox[ RowBox[{"(", RowBox[{"0", ",", "0", ",", "1"}], ")"}], Derivative], MultilineFunction->None]\)[x, y, z])} == {0, 0, 0, 0}, { DirichletCondition[{u[x, y, z] == U[x, y, z, i t0], v[x, y, z] == V[x, y, z, i t0], w[x, y, z] == W[x, y, z, i t0], p[x, y, z] == P[x, y, z, i t0]}, True]}}, {u[x, y, z] , v[x, y, z] , w[x, y, z] , p[x, y, z]}, {x, y, z} \[Element] mesh, Method -> {"FiniteElement", "InterpolationOrder" -> {u -> 2, v -> 2, w -> 2, p -> 1}}];, {i, 1, nn}]; Visualization of error on every 5 steps on the line $y=1/2,z=1/2$ for $u_n=(UX[n],VY[n],WZ[n])$, and $p=P0[n]$ Table[{k t0 // N, Plot[Evaluate[{U[x, y, z, k t0]/UX[k] - 1} /. {y -> 1/2, z -> 1/2}], {x, 0, 1}, PlotRange -> All], Plot[Evaluate[{V[x, y, z, k t0]/VY[k] - 1} /. {y -> 1/2, z -> 1/2}], {x, 0, 1}, PlotRange -> All], Plot[Evaluate[{W[x, y, z, k t0]/WZ[k] - 1} /. {y -> 1/2, z -> 1/2}], {x, 0, 1}, PlotRange -> All], Plot[Evaluate[{P[x, y, z, k t0]/P0[k] - 1} /. {y -> 1/2, z -> 1/2}], {x, 0, 1}, PlotRange -> All]}, {k, 5, nn, 5}] Note, that in the picture shown last steps only. The relative error for pressure is about $2×10^{−3}$, and for velocity $1.5×10^{−4}$ on the grid 10×10×10 on 200 steps in time with time step τ=1/400. ![Figure 1][11] [1]: https://mathematica.stackexchange.com/questions/246091/stable-fluids-code-for-electromagnetic-mixture-application [2]: https://community.wolfram.com/groups/-/m/t/2399430 [3]: https://community.wolfram.com//c/portal/getImageAttachment?filename=qzbqN.jpg&userId=20103 [4]: https://community.wolfram.com//c/portal/getImageAttachment?filename=UlIzg.gif&userId=20103 [5]: https://community.wolfram.com//c/portal/getImageAttachment?filename=1zwVo.gif&userId=20103 [6]: https://community.wolfram.com//c/portal/getImageAttachment?filename=GSzFn.png&userId=20103 [7]: https://community.wolfram.com//c/portal/getImageAttachment?filename=uYoQq.png&userId=20103 [8]: https://www.ljll.math.upmc.fr/~frey/papers/Navier-Stokes/Ethier%20C.R.,%20Steinman%20D.A.,%20Exact%20fully%203d%20Navier-Stokes%20solutions%20for%20benchmarking.pdf [9]: https://community.wolfram.com//c/portal/getImageAttachment?filename=uvwperr.jpg&userId=1218692 [10]: https://community.wolfram.com/groups/-/m/t/1433064?p_p_auth=kiX86GkA [11]: https://community.wolfram.com//c/portal/getImageAttachment?filename=err.jpg&userId=1218692 Alexander Trounev 2022-03-17T17:52:07Z https://community.wolfram.com/groups/-/m/t/2483319 Hi everyone, i have the next problem, this is my transferfunction as you can see its a firts order system with time death delay gf = TransferFunctionModel[{{{13.138*E^(-1.919*s)}}, {{1 + 171.18*s}}}, s] I use PIDtune to get a PIDcontrol for my system: Gc = PIDTune[gf, "PID", "ReferenceOutput"] the I want to see the output response, but it gives me an error evaluating the system, and I was trying, it always happens when I put a system delayed with: out1 = OutputResponse[Gc, 4.5, {t, 1, 100}]; ![enter image description here][1] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=OUTPUT.png&userId=2304918 You know I'm really disappointed with this, I was finding by myself at least 3 days, but I didn't find nothing and documentation about outputresponse its not really helpful because outputresponse doesn't have options, I'm new in this so I hope you can help me, I'm very grateful for your time reading this. Jairo Smith Quilumbaquin Lanchimba 2022-03-02T02:46:38Z https://community.wolfram.com/groups/-/m/t/2030260 ![enter image description here][1] &[Wolfram Notebook][2] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=CapturadeTela2020-11-20a%CC%80s18.42.07.png&userId=2029333 [2]: https://www.wolframcloud.com/obj/64ef0cca-d762-4a13-81fa-609012f78f17 Gino Andrade 2020-07-14T17:20:46Z https://community.wolfram.com/groups/-/m/t/2466465 v13.0 of System Modeler provides access to many fluids (bravo!). Unfortunately, I need one more fluid available in NIST/RefProp but not in the list of fluids for v13.0. Can I ask that the fluid be added? Or can you provide access to RefProp directly (most helpful) through System Modeler? Patrick Fourspring 2022-02-08T13:14:34Z https://community.wolfram.com/groups/-/m/t/2450699 I am solving a system of quadratic equations that comes from the 3D rotational kinematics problem expressed by Quaternion variables after simplifying the expressions: Solve[{-2/dT (-qbr1 qbrp0 + qbr0 qbrp1 - qbr3 qbrp2 + qbr2 qbrp3) + 2 constC (-qb1 qbr0 + qb0 qbr1 - qb3 qbr2 + qb2 qbr3) (qb0 qbr0 + qb1 qbr1 + qb2 qbr2 + qb3 qbr3) == const1 && -2/ dT (-qbr2 qbrp0 + qbr3 qbrp1 + qbr0 qbrp2 - qbr1 qbrp3) + 2 constC (-qb2 qbr0 + qb3 qbr1 + qb0 qbr2 - qb1 qbr3) (qb0 qbr0 + qb1 qbr1 + qb2 qbr2 + qb3 qbr3) == const2 && -2/ dT (-qbr3 qbrp0 - qbr2 qbrp1 + qbr1 qbrp2 + qbr0 qbrp3) - 2 constC (qb3 qbr0 + qb2 qbr1 - qb1 qbr2 - qb0 qbr3) (qb0 qbr0 + qb1 qbr1 + qb2 qbr2 + qb3 qbr3) == const3 && qbr0*qbr0 + qbr1*qbr1 + qbr2*qbr2 + qbr3*qbr3 == 1}, {qbr0, qbr1, qbr2, qbr3}, Cubics -> False, Quartics -> False] It keeps running but, so far for 5 hours, cannot get the solution yet. This seems possible to solve and not too difficult. Did I make something wrong, or should I solve using other methods or functions? Please advise me. Bank Pitakwatchara 2022-01-20T10:39:48Z https://community.wolfram.com/groups/-/m/t/2442313 I'm new to SystemModeler and the underlying modeling Language Modelica. I would like to do model a [scissor mechanism][1] and I don't quite see how to do it within the Modelica Mechanics Library. I want an idealized model so I want to neglect the mass of the mechanism and let it act as a linear motion amplificator. That is, given its three connectors a, b and c, I want the component to simply impose the equation `xb - xa = lambda * (xc - xa)`, where lambda is a scalar parameter between 0 and 1. I want to work in one dimension so I suppose I should be able to use the `Modelica.Mechanics.Translational` library, but even that seems complicated. As I see it, most components in the library have two flanges, not three. Maybe I should extend `PartialTwoFlangesAndSupport`? Or should I write my own component without deriving it from the library? If so what would it look like? Would it have a third flange name `flange_c`? [1]: https://en.wikipedia.org/wiki/Scissors_mechanism Lucien Grondin 2022-01-11T07:41:33Z https://community.wolfram.com/groups/-/m/t/2408952 &[Wolfram Notebook][1] [1]: https://www.wolframcloud.com/obj/c7065049-7ed0-403f-ad2c-766d75eaa94e Jeremy Tan 2021-11-18T05:17:56Z https://community.wolfram.com/groups/-/m/t/2417648 This is a question directly related to several other previous questions of mine, however most directly related to [Torn Equations][1] Besides that question, I have also (through Mathematica) modeled, simulated and controlled a [flywheel inverted pendulum][2] (youtube link) This works well, and I have a good mathematical understanding of the model equations, which is why it, and the other previous testbench (as seen in my Torn equations question) are my direct comparisons to models I've made SystemModeler. When improving my models using `RotorWith3DEffects` I realized that this particular class isn't quite used as exactly as the other `Rotor` and also isn't quite connected the same in order to achieve the 1DOF inertia on a 3D body. When reading the documentation there is a single line > Gyroscopic torques appear, if the vector of the carrier body's angular velocity is not parallel to the vector of the rotor's axis. Which for my English is a bit cryptic, but fine. When looking at suggested other examples, such as ` GyroscopicEffects` ![gryo][3] It shows that the class is connected via the Housing connector. So I do this as well in my models, which produce great results that match the real model and the Mathematica version. My issue now comes that when trying to improve my BLDC motor model, which is a maxon EC45 Flat, an "aussen roller" Or namely a motor with rotating housing, clearly also has a rotating inertia that I want to include to complete my model. ![motor][4] Because I want to use this in a library/package later for reuse, I want to the motor model to be complete, and not simply add it's inertia to an outside class. The problem here arises, when I want to connect the motor model shaft of the inner `RotorWith3DEffects` to an 'shaft' or outer `RotorWith3DEffects` the gyroscopic effects disappear. But this is fine, clearly I have a misunderstanding. So I tried to experiment with 5 different modeling/connection techniques to figure out how to connect this model correctly. Unfortunately, I now have 5 different results, none of which are similar, and only one that sort of resembles the model from Mathematica, except it appears to have energy being constantly added to the system, instead of it dissipating. The Mathematica ODEs are : Where $\alpha(t)$ is the pendulum angle, and $\phi(t)$ is the motor angle. with various inertias, friction and masses. $$\left\{g \sin (\alpha (t)) (k \text{mw}+l \text{mb})+\text{jw} \phi ''(t)+\Theta \alpha ''(t)=-\text{rb} \alpha '(t)-\mu \tanh \left(\frac{\alpha '(t)}{\iota }\right),\text{jw} \left(\alpha ''(t)+\phi ''(t)\right)=\tau u(t)-\text{rw} \phi '(t)\right\}$$ When given a simple constant input of 0.6 at $u(t)$ from hanging position of initial angle $\alpha(0) = 0$ the Motor spins up, causes swinging and short lived constant offset before the system falls back to angle zero as seen here: ![rotor][5] Also ![plot][6] When using the actual physical model, this also happens, pretty much exactly the same, as such I am confident this is modeled fairly well. As mentioned unfortunately, when doing this same within my 5 different experiments, I don't get any of the same results but instead either no displacement whatsoever, a constant non-dissipating oscillation or a constant angle accumulation that eventually breaks the simulation, as seen here: ![models][7] ![models][8] ![more plots][9] TLDR: I want to be able to use `RotorWith3DEffects` like `Rotor` to get gyroscopic effects with my internal motor model, and be able to use the rotors shafts as connection points, rather the housing, however it seems this isn't possible in the way I expect it, and when comparing different connect methods, against Mathematica, I get wildly different results, and I don't know which one is correct, and baring all of them are wrong, then I'm completely stuck. How do I use this class correctly, the description and one single example within the documentation don't specify this enough for me, and the many test results don't match up with my real world model or Mathematicas. I have included the Mathematica files and System modeler file within this post for your own testing, done in System modeler 12.3. Thanks for the help. [1]: https://community.wolfram.com/groups/-/m/t/2403814?p_p_auth=J60QE3xh [2]: https://www.youtube.com/watch?v=Lzw3ZGTuMUU [3]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot2021-12-02at10.28.38.png&userId=1222283 [4]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot2021-12-02at10.32.57.png&userId=1222283 [5]: https://community.wolfram.com//c/portal/getImageAttachment?filename=rotar.gif&userId=1222283 [6]: https://community.wolfram.com//c/portal/getImageAttachment?filename=plot.png&userId=1222283 [7]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot2021-12-02at10.51.19.png&userId=1222283 [8]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot2021-12-02at11.07.17.png&userId=1222283 [9]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot2021-12-02at10.51.46.png&userId=1222283 Mor Bo 2021-12-02T10:03:21Z https://community.wolfram.com/groups/-/m/t/2419306 ![enter image description here][1] &[Wolfram Notebook][2] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=show.gif&userId=569571 [2]: https://www.wolframcloud.com/obj/b8c3a801-10c0-41b4-9074-484ba0d003e7 Frederick Wu 2021-12-05T11:02:53Z https://community.wolfram.com/groups/-/m/t/2403814 I am working on a little project to help learn more of SystemModeler and modeling within that environment. I have a working physical test bench of the system I choose to simulate, I would like to simulate and design and test different control schemes via SystemModeler, Mathematica and the Microcontroller Kit. The system being a 3d inverted pendulum, like the [Cubli][1]. When simulating the single degree of freedom, I have great stabilization. ![single degree][2] This model is in-fact the second version of it I have designed, the first version using `Bodyshapes` classes while this newer version uses `Rotorswith3Deffects` I have changed the model to use the rotors as the angle/control reactions in the first did not reflect reality with the physical test bench, while the newer version is almost nearly identical...but I digress. When inverting this model to stand on its corner to be a 3DOF, 3D pendulum, I am now getting constant "torn" errors, which I can view with the Equation browser, however I can't begin to understand how this is helpful, or what I can do, beyond what it *seems* to be setting initial conditions to repair the problem...this however leads to an ever increasing cascade in *more* torn system errors. ![torn][3] My model isn't particularly large I think but I am using several custom subsystems and functions, I realize, but for an idea of what I have built, see the below images. The *working* Single DOF system with control. ![single][4] The Same system with 3 DOF activated, causing torn system. ![3dof][5] I don't think this is a particularly interesting or difficult nonlinear system to Solve for SystemModeler...I feel this has something to do with the `Rotorswith3dEffects` but since this works in the 1DOF systems, I am somewhat at a loss. How can I fix the torn system via the equation browser? Is this is the wrong direction to follow? Is there a better way or thing to look out for? I have looked at the `GyroscopicEffects` example from recommendations from previous questions...which is how I managed to come up with the model I have (which again works great in the 1DOF simulation). My physical test bench for reference: ![enter image description here][6] [1]: https://www.youtube.com/watch?v=n_6p-1J551Y [2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot2021-11-10at13.06.33.png&userId=1222283 [3]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot2021-11-10at13.17.40.png&userId=1222283 [4]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot2021-11-10at13.19.59.png&userId=1222283 [5]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot2021-11-10at13.25.10.png&userId=1222283 [6]: https://community.wolfram.com//c/portal/getImageAttachment?filename=0F2B6A00-0719-46B8-B365-7F99323C99B9.JPG&userId=1222283 Mor Bo 2021-11-10T12:38:29Z https://community.wolfram.com/groups/-/m/t/2399430 *SUPPLEMENTARY WOLFRAM MATERIALS for the ARTICLE:* > Sergio Manzetti, Alexander Trounev (2021). > A Navier-Stokes model for Rogue wave simulation. > ResearchGate, Technical Report. https://www.researchgate.net/publication/354527324 ------ ![enter image description here][1] ABSTRACT -------------------------------------- Rogue waves are anomalous phenomena occurring over large sea bodies, where they are said appear out of nowhere and disappear without a trace. Simulations of rogue waves have been carried over the last 40 years, with several models published. In this paper we investigate the formation of rogue waves by two models: I. the Navier-Stokes equation where we take into account density and viscosity gradient on the air-water interface due to diffusion and II. a Korteveg de Vries-type model for quantum jumps which we developed earlier. We derive also a stable fluids algorithm which we use to compute nonlinear waves interaction produced by the wind. The results are discussed and compared. This code solves problem of viscous incompressible flow with gravitational force in a rectangle with periodic boundary condition on the left and right side and with Dirichlet condition on the top and bottom side. In the initial condition fluid velocity is periodic wave, and density has unit step like distribution on the air/water interface. Some other application of this code has been discussed on https://mathematica.stackexchange.com/questions/246091/stable-fluids-code-for-electromagnetic-mixture-application This model has been discussed in our report [A Navier-Stokes model for Rogue wave simulation][2] Two phase model of air-water interface -------------------------------------- Let us consider the system of equations describing nonlinear waves on the air-water interface. As it well known the air and the water can be considered as viscous incompressible fluids with density $\rho_a, \rho_w$, and dynamical viscosity $\mu_a, \mu_w$ consequently. Taking into account the gravity force and diffusion on the air-water interface, we have $$\nabla.\bf{u}=0\\ \frac{\partial \mathbf{u}}{\partial t}+(\mathbf{u}.\nabla)\mathbf{u}+\frac{\nabla P}{\rho_i}=\nu_i\nabla ^2\mathbf{u}+\mathbf{f}\\\ \frac{\partial \phi}{\partial t} +(\mathbf{u}.\nabla)\phi=\frac{\nu_i}{Sc_i}\nabla ^2\phi\\ $$ Here it is indicated $\rho_i, i=a,w $ - air and water density, $\mathbf{u}=(u_x,u_y)$ - flow velocity, $P$ - pressure; $\bf{f}$ - force acting on the volume of the air-water mixture; $\phi$ - the interface function describing the averaged density of the air-water mixture; $Sc_i$ - analog of the Schmidt number characterized water diffusion in the air and air diffusion in the water. Note that we considered averaged effect of mass transfer on the air-water interface including drops and bubbles. Let us define the Cartesian coordinate system so that the $y$ axis is directed against the direction of the gravitational acceleration vector and the $x$ axis is parallel to horizon. Let suppose that the water surface relief is described by the equation $y=r(t,x,y)$ - Figure 1. ![Figure 1. Flow geometry on the air-water interface with waves of small (left) and large (right) amplitude][3] We set the boundary conditions for the flow parameters on the top and bottom part of the boundary layer and periodic boundary conditions by coordinate $x$ as follows: $$ y=0: \mathbf{u}=0,\phi=\rho_w\\ y=H: \mathbf{u}=(U_0,0), \phi=\rho_a\\ \mathbf{u}(t,0,y)=\mathbf{u}(t,L,y)\\ \phi(t,0,y)=\phi(t,L,y). $$ Here $H$ is the height of the boundary layer,$U_0$ is the wind velocity, $L$ is the period of the wave tray. We assume that at the initial time the flow velocity and interface function are given by $$ t=0, y<H/2:u_x = 0, u_y=V_0 \sin(2 \pi n x/L), \phi =\rho_w\\ t=0, y\ge H/2: u_x=U_0, u_y=V_0\sin (2 \pi n x/L), \phi =\rho_a\\ $$ This problem can be solved with using numerical methods and an appropriate turbulence model. We have used stable fluids algorithm (Stam1999, Stam 2000) to solve 2D Navier-Stokes equations and to simulate nonlinear waves interaction on the air-water interface with a given wind velocity on the top of the boundary layer. While in the standard gravity wave theory the air-water interface is considered mainly as a potential flow, in our approach we take into account velocity, viscosity and density gradients on the interface. Since air/water density ratio is about $10^{-3}$ we have some challenging numerical problem. To solve this problem we made some simplifications in the basic Navier-Stokes equations. First, we suppose that velocity is a continues field at $t>0$ so that flow in the water and flow in the air is an united flow continuously distributed from the bottom to the top and the periodic one in the $x$ direction. We neglect by the surface tension due to large scale of the waves. Therefore we don't need any boundary condition on the air-water interface. Second, at $t>0$ we introduce continues density as $\rho=\phi$ to compute velocity field on every step. Third, we use stable fluid algorithm in time in the very specific order described below. Stable fluids algorithm ----------------------- 1) Solve advection equation with using boundary conditions, initial data from the previous step, and an implicit algorithm $$ \frac{\partial \mathbf{u}_1}{\partial t}+(\mathbf{u}_1.\nabla) \bf{u}_1=0 $$ 2) Solve diffusion equation with $\nu_i=\nu_i(\phi)$, initial data $\mathbf{u}_1$, boundary conditions and with using, for example, Gauss-Seidel relaxation algorithm $$ \frac{\partial \mathbf {u}_2}{\partial t}-\nu_i \nabla^2 \mathbf{u}_2=0$$ here $$\nu_i(\phi)=\nu_w \phi ^k, k=-0.4029$$ for the air temperature of 20C. 3) Add force to the velocity field from the previous step as follows $$ \mathbf{u}_3=\mathbf{u}_2+\mathbf{f} dt\\ $$ To simulate force acting on the volume of air-water mixture we used approximation $$ f_y=-\frac{(\rho_w-\phi)(\phi-\rho_w/2)(\phi-\rho_a)}{\rho_w^2(\rho_w-\rho_a)Fr^2} $$ 4) Make projection step. Here we can use two models. First model is standard projection (Stam 1999) by solving Poison equation $$ t>0, \nabla^2 q=\nabla . \bf{u}_3\\ \bf{u}_4=\bf{u}_3-\nabla q $$ Note, that this step allows us to define divergent free velocity field. 5) Update velocity field $\bf{u}_4\longrightarrow \bf{u}_5$ with using boundary conditions. 6) Make diffusion step with interface function by solving diffusion equation with initial condition from the previous step, with boundary conditions, and with $\nu=\nu_i(\phi)/Sc$ as follows $$ \frac{\partial \phi_1}{\partial t}-\nu \nabla^2 \phi_1=0 $$ 7) Make advection step by solving advection equation with initial data from step 6 with boundary conditions using an implicit algorithm (from step 1, for example), $$ \frac{\partial \phi_2}{\partial t}+(\bf{u}_5.\nabla) \phi_2=0 $$ 8) Update interface function with boundary conditions. 9) Return to step 1 with updated velocity and interface function. This algorithm can be also used in some different order, for example, in the beginning we can compute step 3 (Stam1999). Also we can make steps 6-8 first, and then compute velocity field with steps 1-5. The question about stability of the stable fluids algorithm not really solved yet. From our experience, we can't do arbitrary time step, but $dt$ is limiting by the grid size as usual for more precise computation. In our computations we have used $dt=2/N$ for $N\times N$ grid. In general case the numerical solution depends on the Froude number $Fr=\frac{U_0}{\sqrt{g L}}$, Reynolds number $Re=\frac{U_0 L}{\nu_w}$, Schmidt number and number of waves in the initial data. In our computations we fixed the Froude number, so that we can put $H=L=1$. We also fixed the Reynolds number, therefore we can put $U_0=1.5, V_0=0.5$. The algorithm 1-9 has been implemented with FDM and compiled to C with using Mathematica 12.3. Code to simulate air/water interface with $Re=10^4, Fr=1$ ---- rhoWater20C = 1.027; nuW20C = 0.01007; rhoAir20C = 0.001204; nuA20C = 0.151;dif = 1/10000; pec = .1; U0 = 1.5; V0 = .5; dn0 = 0.997658; dn1 = 0.514102; kap = 1; n = 81; Fr = 1; F0 = 1; n1 = n + 1; sm = 600; r = 20; den = ConstantArray[dn1 (1 + dn0 Tanh[-kap Range[-n1/2, n1/2]]), n1];u0 = ConstantArray[0, {n1, n1}]; Do[ u0[[i, j]] = U0 (1 + Tanh[kap (j - n1/2)])/2;, {i, n1}, {j, n1}]; v0 = ConstantArray[0., {n1, n1}]; Do[ v0[[i, j]] = V0 Sin[10 Pi (i - 1)/n];, {i, n1}, {j, n1}];periodic[n_, up_, ud_, ub_] := Module[{bd = ub}, Do[bd[[1, i]] = .5 (bd[[n, i]] + bd[[2, i]]); bd[[n + 1, i]] = bd[[1, i]]; bd[[i, 1]] = ud; bd[[i, n + 1]] = up;, {i, 2, n}]; bd[[1, 1]] = .5 (bd[[2, 1]] + bd[[1, 2]]); bd[[n + 1, n + 1]] = .5 (bd[[n, n + 1]] + bd[[n + 1, n]]); bd[[n + 1, 1]] = .5 (bd[[n, 1]] + bd[[n + 1, 2]]); bd[[1, n + 1]] = .5 (bd[[1, n]] + bd[[2, n + 1]]); bd]; diffuse[n_, r_, a_, c_, c0_] := Module[{c1 = c}, Do[Do[Do[ c1[[i, j]] = (c0[[i, j]] + (a/den[[i, j]]^.4029) (c1[[i - 1, j]] + c1[[i + 1, j]] + c1[[i, j - 1]] + c1[[i, j + 1]]))/(1 + 4 a/den[[i, j]]^.4029);, {j, 2, n}];, {i, 2, n}]; Do[c1[[1, i]] = c1[[n, i]]; c1[[n + 1, i]] = c1[[2, i]]; c1[[i, 1]] = c0[[i, 1]]; c1[[i, n + 1]] = c0[[i, n + 1]];, {i, 2, n}]; c1[[1, 1]] = .5 (c1[[2, 1]] + c1[[1, 2]]); c1[[n + 1, n + 1]] = .5 (c1[[n, n + 1]] + c1[[n + 1, n]]); c1[[n + 1, 1]] = .5 (c1[[n, 1]] + c1[[n + 1, 2]]); c1[[1, n + 1]] = .5 (c1[[1, n]] + c1[[2, n + 1]]);, {k, 0, r}]; c1]; advect[n_, d0_, u_, v_, dt_] := Module[{x, y, d1, dt0, i0, i1, j0, j1, s0, s1, t0, t1}, d1 = ConstantArray[0, {n + 1, n + 1}]; dt0 = dt n; Do[Do[x = i - dt0 u[[i, j]]; y = j - dt0 v[[i, j]]; i0 = Which[x <= 1, 1, 1 < x < n, Floor[x], True, n]; i1 = i0 + 1; j0 = Which[y <= 1, 1, 1 < y < n, Floor[y], True, n]; j1 = j0 + 1; s1 = x - i0; s0 = 1 - s1; t1 = y - j0; t0 = 1 - t1; d1[[i, j]] = s0 (t0 d0[[i0, j0]] + t1 d0[[i0, j1]]) + s1 (t0 d0[[i1, j0]] + t1 d0[[i1, j1]]);, {j, 1, n + 1}];, {i, 1, n + 1}]; d1]; project[n_, r_, u0_, v0_, u_, v_] := Module[{ux = u, vy = v, div, p}, p = ConstantArray[0, {n + 1, n + 1}]; div = ConstantArray[0, {n + 1, n + 1}]; ux = ConstantArray[0, {n + 1, n + 1}]; vy = ConstantArray[0, {n + 1, n + 1}]; Do[div[[i, j]] = -.5/ n (u0[[i + 1, j]] - u0[[i - 1, j]] + v0[[i, 1 + j]] - v0[[i, j - 1]]);, {i, 2, n}, {j, 2, n}]; Do[Do[Do[ p[[i, j]] = (div[[i, j]] + (p[[i - 1, j]] + p[[i + 1, j]] + p[[i, j - 1]] + p[[i, j + 1]]))/4;, {j, 2, n}], {i, 2, n}];, {k, 0, r}]; Do[ux[[i, j]] = u0[[i, j]] - .5 n (p[[i + 1, j]] - p[[i - 1, j]]); vy[[i, j]] = v0[[i, j]] - .5 n (p[[i, j + 1]] - p[[i, j - 1]]);, {i, 2, n}, {j, 2, n}]; {ux, vy}]; Fx[t_, x_, y_] := 0; Fy[t_, x_, y_] := -1/Fr^2; onestep[n_, step_, r_, a_, uin_, vin_, dt_, c_] := Module[{u1, v1, f1, f2, u, v, u0, v0}, f1 = ConstantArray[0, {n + 1, n + 1}]; f2 = ConstantArray[0., {n + 1, n + 1}]; u0 = ConstantArray[0., {n + 1, n + 1}]; v0 = ConstantArray[0., {n + 1, n + 1}]; u = ConstantArray[0., {n + 1, n + 1}]; v = ConstantArray[0., {n + 1, n + 1}]; u1 = ConstantArray[0., {n + 1, n + 1}]; v1 = ConstantArray[0., {n + 1, n + 1}]; u0 = uin; v0 = vin; Do[ f2[[i, j]] = 1/Fr^2 (den[[i, j]] - rhoWater20C/2) (rhoWater20C - den[[i, j]]) (den[[i, j]] - rhoAir20C)/(rhoWater20C - rhoAir20C)/rhoWater20C^2;, {i, 2, n}, {j, 2, n}]; v0 += f2 dt; u0 = advect[n, u0, u0, v0, dt]; v0 = advect[n, v0, u0, v0, dt]; mnV = 0; u0 = periodic[n, U0, 0, u0]; v0 = periodic[n, mnV, mnV, v0]; u0 = diffuse[n, r, a, c, u0]; v0 = diffuse[n, r, a, c, v0]; u0 = periodic[n, U0, 0, u0]; v0 = periodic[n, mnV, mnV, v0]; {u1, v1} = project[n, r, u0, v0, u, v]; u0 = periodic[n, U0, 0, u1]; v0 = periodic[n, mnV, mnV, v1]; {u0, v0}] cf = With[{cg = Compile`GetElement, hp = HoldPattern, dv = DownValues}, Hold@Compile[{{u0argu, _Real, 2}, {v0argu, _Real, 2}, {denargu, _Real, 2}, {sm, _Integer}, {n, _Integer}, {r, _Integer}, dif, pec, F0}, Module[{u0 = u0argu, v0 = v0argu, uu, vv, dd, den = denargu, c = Table[0., {n + 1}, {n + 1}], dt = 40./n^2, a, dnup = den[[1, n + 1]], dnd = den[[1, 1]]}, a = dt dif n n; uu = vv = dd = Table[0., {sm + 1}, {n + 1}, {n + 1}]; Do[ den = advect[n, den, u0, v0, dt]; den = periodic[n, dnup, dnd, den]; den = diffuse[n, r, a/pec, c, den]; den = periodic[n, dnup, dnd, den]; dd[[step + 1]] = den; {u0, v0} = onestep[n, step, r, a, u0, v0, dt, c]; uu[[step + 1]] = u0; vv[[step + 1]] = v0;, {step, 0, sm}]; {uu, vv, dd}], CompilationTarget -> C, RuntimeOptions -> "Speed"] /. dv@onestep /. Flatten[dv /@ {Fx, Fy, advect, diffuse, periodic, project}] /. hp@ConstantArray[c_, {i_, j_}] :> Table[0., {i}, {j}] /. hp@Part[a__] :> cg[a] /. hp[cg[a__] = rhs_] :> (Part[a] = rhs) // ReleaseHold]; Visualization ------------- rst = cf[u0, v0, den, sm, n, r, dif, pec, F0];Do[lstu[k] = Flatten[Table[{{(i - 1)/n, (j - 1)/n}, rst[[1, k, i, j]]}, {i, n1}, {j, n1}], 1]; lstv[k] = Flatten[Table[{{(i - 1)/n, (j - 1)/n}, rst[[2, k, i, j]]}, {i, n1}, {j, n1}], 1];, {k, sm}]; Do[Uvel[i] = Interpolation[lstu[i], InterpolationOrder -> 3];, {i, 1, sm}]; Do[Vvel[i] = Interpolation[lstv[i], InterpolationOrder -> 3];, {i, 1, sm}]; Do[lst4[k] = Flatten[Table[{{(i - 1)/n, (j - 1)/n}, rst[[3, k, i, j]]}, {i, n1}, {j, n1}], 1];, {k, sm}]; Do[rh[k] = Interpolation[lst4[k], InterpolationOrder -> 3];, {k, sm}];{ContourPlot[Uvel[10][x, y], {x, 0, 1}, {y, 0, 1}, ColorFunction -> "BlueGreenYellow", Frame -> False, PlotRange -> All, ImageSize -> Small, MaxRecursion -> 2, Contours -> 15, ContourStyle -> Yellow, PlotLegends -> Automatic], ContourPlot[Vvel[10][x, y], {x, 0, 1}, {y, 0, 1}, ColorFunction -> "BlueGreenYellow", Frame -> False, PlotRange -> All, ImageSize -> Small, MaxRecursion -> 2, Contours -> 15, ContourStyle -> Yellow, PlotLegends -> Automatic], ContourPlot[1 - rh[10][x, y], {x, 0, 1}, {y, 0, 1}, ColorFunction -> "BlueGreenYellow", Frame -> False, PlotRange -> All, ImageSize -> Small, MaxRecursion -> 2, Contours -> 15, ContourStyle -> Yellow, PlotLegends -> Automatic], ContourPlot[Uvel[sm][x, y], {x, 0, 1}, {y, 0, 1}, ColorFunction -> "BlueGreenYellow", Frame -> False, PlotRange -> All, ImageSize -> Small, MaxRecursion -> 2, Contours -> 15, ContourStyle -> Yellow, PlotLegends -> Automatic], ContourPlot[Vvel[sm][x, y], {x, 0, 1}, {y, 0, 1}, ColorFunction -> "BlueGreenYellow", Frame -> False, PlotRange -> All, ImageSize -> Small, MaxRecursion -> 2, Contours -> 15, ContourStyle -> Yellow, PlotLegends -> Automatic], ContourPlot[1 - rh[sm][x, y], {x, 0, 1}, {y, 0, 1}, ColorFunction -> "BlueGreenYellow", Frame -> False, PlotRange -> All, ImageSize -> Small, MaxRecursion -> 2, Contours -> 8, ContourStyle -> Yellow, PlotLegends -> Automatic]} In this Figure are shown velocity components $u_x$ (left), $u_y$ (middle) and 1- density (right) on step 10 (upper line) and on final step $sm=600$ ![Figure 2][4] UPDATE ---------- Next step is to animate wave transformation using interface function. We can show velocity field over density as follows Show[ContourPlot[1 - rh[sm][x, y]/rhoWater20C, {x, 0, 1}, {y, 0, 1}, PlotRange -> All, ColorFunction -> "BlueGreenYellow", Contours -> 8, ContourStyle -> Yellow, Frame -> False, PlotLegends -> Automatic], StreamPlot[{Uvel[sm][x, y], Vvel[sm][x, y]}, {x, 0, 1}, {y, 0, 1}, PlotRange -> All, StreamColorFunction -> None, VectorPoints -> Fine, VectorColorFunction -> Hue, PlotLegends -> Automatic, StreamColorFunctionScaling -> True, StreamStyle -> LightGray]] ![Figure 3][5] We can also compute frames for animation with using interface function frames=Table[ContourPlot[1 - rh[i][x, y], {x, 0, 1}, {y, 0, 1}, ColorFunction -> "BlueGreenYellow", Frame -> False, PlotRange -> All, ImageSize -> Small, MaxRecursion -> 2, Contours -> 8, ContourStyle -> Yellow, PlotLabel -> i], {i, 20, sm, 20}]; Animate[frames] ![Figure 4][6] References ---------- Jos Stam. Stable fluids. In Computer Graphics Proceedings Annual Conference Series, Los Angeles, Aug. 3–8, 199. Jos Stam. Interacting with smoke and fire in real time. Communications of the ACM, 43(7):77–83, July 2000. [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=RogueWave.gif&userId=11733 [2]: https://www.researchgate.net/publication/354527324_A_Navier-Stokes_model_for_Rogue_wave_simulation [3]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Figure1.jpg&userId=1218692 [4]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Figure2.jpg&userId=1218692 [5]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Figure3.jpg&userId=1218692 [6]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Fr3v3.AW1300Q5.gif&userId=1218692 Alexander Trounev 2021-11-03T06:49:53Z https://community.wolfram.com/groups/-/m/t/2394545 Hi everyone, help me please, I have a problem with this TransferFunctionModel, When I want to obtain the poles from the Discrete Model Wolfram gives me an error, what am I doing wrong? Could it be the delay of the model? ![enter image description here][1] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=tf_1.png&userId=2304918 Jairo Smith Quilumbaquin Lanchimba 2021-10-28T01:42:19Z https://community.wolfram.com/groups/-/m/t/2368402 &[Wolfram Notebook][1] [1]: https://www.wolframcloud.com/obj/cc535bd8-c504-4d33-8147-41e164c8c6ae Alec Graves 2021-09-17T02:02:25Z