10
$\begingroup$

I am trying to make an animation of an accretion disk or a planetary disk. For example, a cool disk showing below (created by NAHKS TR'EHNL): enter image description here or in this link

Here is what I have tried so far:

step1:Set the inner boundary rmin and the outer boundary rmax of the disk:

{rmin, rmax} = {0.1, 1.0};

Step 2: Define a function that gives the temperature gradient of the disk:

temgrad[r_] := (r - rmin)/(rmax - rmin)

You can see that the function =0 at the inner boundary and =1 at the outer boundary of the disk. The function will be used to color code the disk.

Step 3 Making a parametric plot of the disk, rendering the disk by using the ColorFunction:

figdisk = ParametricPlot3D[{r Cos[\[Theta]], r Sin[\[Theta]], 0}, {r, rmin, rmax}, {\[Theta], 0, 2 \[Pi]}, PlotPoints -> 100, Mesh -> False, Axes -> False, Boxed -> False, BoundaryStyle -> Opacity[0], Lighting -> {{"Ambient", White}}, Background ->Black, ColorFunctionScaling -> False, ImageSize -> {500, 300}, ColorFunction -> (ColorData[{"SolarColors", "Reverse"}][temgrad[Sqrt[#1^2 + #2^2]]+ 0.1 RandomReal[{-1, 1}]] &)];

The trick here in ColorFunction is that random values are assigned and added to the original temperature gradient, so to mimic the random fluctuations.

For the black hole, I use a simple sphere:

figBH = Graphics3D[{Black, Sphere[{0, 0, 0}, rmin]}];

for the jets I use cones (point to the top as well as the bottom):

figjet = Show@MapThread[ParametricPlot3D[{0.05 z Cos[t], 0.05 z Sin[t], z}, {z, #1, #2}, {t, 0, 2 \[Pi]}, Mesh -> False, PlotStyle -> Glow[Blend[{White, Lighter@Blue}]]] &, {{-5 rmin, rmin}, {-rmin, 5 rmin}}];

Then combining these figures presents my toy accretion disk:

Show[figdisk, figBH, figjet]

enter image description here

Now the problems are:

  1. The appearance of the example disk seems to be natural as given at the top of this post. It is more like a real flow with fluctuations and even some random magnetic field lines on it.
  2. Same for the jet, the example's jet is more realistic with fluid-like materials ejected outward while mine jet..... I have seen this post that simulated realistic jet engine flame, but it does not look like the fragmented thing in the example.
  3. The way I choose to plot the disk only gives a surface (or a disk without thickness), which is not true in nature. The disk should have some thickness (varying with the radius).

    Can anyone help me to improve this piece of art? Thank you so much in advance!

Update_20200228

MassDefect suggested that a z-component can be added to make an ellipsoidal shape. And here is what I came up:

figdisk = ParametricPlot3D[{{r Cos[\[Theta]], r Sin[\[Theta]], .5 (r - rmin) Sqrt[rmax^2 - r^2]}, {r Cos[\[Theta]], r Sin[\[Theta]], -.5 (r - rmin)*Sqrt[rmax^2 - r^2]}}, {r, rmin, rmax}, {\[Theta], 0,(*2 *)\[Pi]}, PlotPoints -> 100, Mesh -> False, Axes -> False, Boxed -> False, BoundaryStyle -> Opacity[0], Lighting -> {{"Ambient", White}}, Background ->(*White*)Black, ColorFunctionScaling -> False, ImageSize -> {300, 300}, ColorFunction -> (ColorData[{"SolarColors", "Reverse"}][temgrad[Sqrt[#1^2 + #2^2]] + 0.1 RandomReal[{-1, 1}]] &)];

Now only half of the disk is plotted to show the cross section: enter image description here

For the problem of creating a more fluid-like one, I found the algorithm for procedural terrain or Perlin noise (invented by Perlin in 1983) might help. This post made really nice gas animations.

$\endgroup$
5
  • 1
    $\begingroup$ So why is the disk not flat and the jet point only to the top? It breaks the inversion symmetry, and contradicts the conservation of orbital angular momentum. :) $\endgroup$
    – yarchik
    Feb 27, 2020 at 22:46
  • $\begingroup$ Yes,you are absolutely right @yarchik, the disk should be flat and the jets are bipolar jets. For jet, I am only making one of it for simplicity or in order not to confuse people with many codes;for disk, surely it should be a flat one. I have thought about it, and I want a 3D disk with some thickness in this case $\endgroup$
    – YiTuan
    Feb 27, 2020 at 23:14
  • $\begingroup$ I will make updates following your suggetions, after I get some sleep...It was a really intense day that I have today $\endgroup$
    – YiTuan
    Feb 27, 2020 at 23:34
  • 1
    $\begingroup$ The coloration you created is really neat! I'm not sure how to improve the jet, but to add thickness the easiest way is probably in the z portion of your ParametricPlot3D. I might do something like figdisk = ParametricPlot3D[{ {r Cos[\[Theta]], r Sin[\[Theta]], .05 Sqrt[1 - r^2]}, {r Cos[\[Theta]], r Sin[\[Theta]], -.05 Sqrt[1 - r^2]} }, ... to give an ellipsoid shape. I'm not sure if that's exactly the shape you're looking for or not. $\endgroup$
    – MassDefect
    Feb 28, 2020 at 5:08
  • $\begingroup$ Thank you for your nice suggestion!@MassDefect !I make a little variation of your z-component, so to set the thickness equal to zero,at both the inner and outer boundary,and it looks much more better than a single disk without thickness. $\endgroup$
    – YiTuan
    Feb 28, 2020 at 14:03

0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.