Elektrický axialní oktupól

Elektrický axiální oktupól -

Intenzita elektrického pole oktupólu:

Needs["Graphics`PlotField`"];

Needs["Graphics`Graphics`"];
Needs["Graphics`MultipleListPlot`"];

OctupoleE ... graf intenzity elektrického pole oktupólu

OctupoleE[potencial_, x_, y_] := 
        PlotGradientField[potencial, x, y, PlotPoints -> 30, 
          ScaleFunction -> (1 &), 
          Epilog -> {{Hue[0.95], Disk[{0, 3}, 0.2], GrayLevel[0], 
                Text[StyleForm["+", FontSize -> 24, 
                    FontWeight -> "Bold"], {0, 3}]}, {Hue[0.3], 
                Disk[{0, 1}, 0.6], GrayLevel[0], 
                Text[StyleForm["-", FontSize -> 24, 
                    FontWeight -> "Bold"], {0, 1}]}, {Hue[0.95], 
                Disk[{0, -1}, 0.6], GrayLevel[0], 
                Text[StyleForm["+", FontSize -> 24, 
                    FontWeight -> "Bold"], {0, -1}]}, {Hue[0.3], 
                Disk[{0, -3}, 0.2], GrayLevel[0], 
                Text[StyleForm["-", FontSize -> 24, 
                    FontWeight -> "Bold"], {0, -3}]}}];

potenciál axiálního kvadrupólu:
	Q1 o souřadnici [0,3] a naboji Q1=1
	Q2 o souřadnici [0,1] a naboji Q2=-3
	Q3 o souřadnici [0,-1] a naboji Q3=3
	Q4 o souřadnici [0,-3] a naboji Q4=-1

octupole = 
      1/Sqrt[x^2 + (y + 3)^2] - 3/Sqrt[x^2 + (y + 1)^2] + 
        3/Sqrt[x^2 + (y - 1)^2] - 1/Sqrt[x^2 + (y - 3)^2]

OctuPlot1 = 
        OctupoleE[
          octupole, {x, -3.6, 3.6}, {y, -3.6, 3.6}];

Ekvipotenciálové plochy oktupolu:

OctupoleV ... graf ekvipotenciálních ploch oktupolu

OctupoleV[potencial_, x_, y_] := 
        ContourPlot[potencial, x, y, ContourShading -> False,  
          ContourSmoothing -> True, PlotPoints -> 50, 
          Epilog -> {{Hue[0.95], Disk[{0, 3}, 0.2], GrayLevel[0], 
                Text[StyleForm["+", FontSize -> 24, 
                    FontWeight -> "Bold"], {0, 3}]}, {Hue[0.3], 
                Disk[{0, 1}, 0.6], GrayLevel[0], 
                Text[StyleForm["-", FontSize -> 24, 
                    FontWeight -> "Bold"], {0, 1}]}, {Hue[0.95], 
                Disk[{0, -1}, 0.6], GrayLevel[0], 
                Text[StyleForm["+", FontSize -> 24, 
                    FontWeight -> "Bold"], {0, -1}]}, {Hue[0.3], 
                Disk[{0, -3}, 0.2], GrayLevel[0], 
                Text[StyleForm["-", FontSize -> 24, 
                    FontWeight -> "Bold"], {0, -3}]}}];

OctuPlot2 = 
        OctupoleV[
          octupole, {x, -3.6, 3.6}, {y, -3.6, 3.6}];

Show[OctuPlot1, OctuPlot2]

Postupné vykreslování siločar - vzdálený pohled na dipól

X[R_, θ_] := R Cos[θ];
Y[R_, θ_] := R Sin[θ];

konstanta  =  3;
ZkOctuInf := ZkOctuInfinitesimal = 
          Pi/1000;

    
ZkOctuq1 := 0;
ZkOctuq2 := 0;
ZkOctuq3 := 0;
ZkOctuq4 := 0;
ZkOctuq5 := 0;
ZkOctuq6 := 0;

    
For[
ZkOctuq1 = 0, 
ZkOctuq1 < 
          5, 
ZkOctuVector1[ZkOctuq1] = 
          Table[{X[ZkOctuq1 (Sin[t]^2 Abs[5 Sin[t]^2 - 4])^(1/3), 
                t], Y[ZkOctuq1 (Sin[t]^2 Abs[5 Sin[t]^2 - 4])^(1/
                        3), t]}, {t, ArcSin[2/Sqrt[5]] - ZkOctuInf, 
              0, -Pi/
                100}], 
ZkOctuq1++
];

    
For[
ZkOctuq2 = 0, 
ZkOctuq2 < 
          5, 
ZkOctuVector2[ZkOctuq2] = 
          Table[{X[ZkOctuq2 (Sin[t]^2 Abs[5 Sin[t]^2 - 4])^(1/3), 
                t], Y[ZkOctuq2 (Sin[t]^2 Abs[5 Sin[t]^2 - 4])^(1/
                        3), t]}, {t, ArcSin[2/Sqrt[5]] + ZkOctuInf, 
              Pi - ArcSin[2/Sqrt[5]] - ZkOctuInf, 
              Pi/100}], 
ZkOctuq2++
];

    
For[
ZkOctuq3 = 0, 
ZkOctuq3 < 
          5, 
ZkOctuVector3[ZkOctuq3] = 
          Table[{X[ZkOctuq3 (Sin[t]^2 Abs[5 Sin[t]^2 - 4])^(1/3), 
                t], Y[ZkOctuq3 (Sin[t]^2 Abs[5 Sin[t]^2 - 4])^(1/
                        3), t]}, {t, Pi - ZkOctuInf, 
              Pi - ArcSin[2/Sqrt[5]] + ZkOctuInf, -Pi/
                100}], 
ZkOctuq3++
];

    
For[
ZkOctuq4 = 0, 
ZkOctuq4 < 
          5, 
ZkOctuVector4[ZkOctuq4] = 
          Table[{X[ZkOctuq4 (Sin[t]^2 Abs[5 Sin[t]^2 - 4])^(1/3), 
                t], Y[ZkOctuq4 (Sin[t]^2 Abs[5 Sin[t]^2 - 4])^(1/
                        3), t]}, {t, Pi + ZkOctuInf, 
              Pi + ArcSin[2/Sqrt[5]] - ZkOctuInf, 
              Pi/100}], 
ZkOctuq4++
];

    
For[
ZkOctuq5 = 0, 
ZkOctuq5 < 
          5, 
ZkOctuVector5[ZkOctuq5] = 
          Table[{X[ZkOctuq5 (Sin[t]^2 Abs[5 Sin[t]^2 - 4])^(1/3), 
                t], Y[ZkOctuq5 (Sin[t]^2 Abs[5 Sin[t]^2 - 4])^(1/
                        3), t]}, {t, 2 Pi - ArcSin[2/Sqrt[5]] - ZkOctuInf, 
              Pi + ArcSin[2/Sqrt[5]] + ZkOctuInf, -Pi/
                100}], 
ZkOctuq5++
];

    
For[
ZkOctuq6 = 0, 
ZkOctuq6 < 
          5, 
ZkOctuVector6[ZkOctuq6] = 
          Table[{X[ZkOctuq6 (Sin[t]^2 Abs[5 Sin[t]^2 - 4])^(1/3), 
                t], Y[ZkOctuq6 (Sin[t]^2 Abs[5 Sin[t]^2 - 4])^(1/
                        3), t]}, {t, 2 Pi - ArcSin[2/Sqrt[5]] + ZkOctuInf, 
              2 Pi - ZkOctuInf, 
              Pi/100}], 
ZkOctuq6++
];

    
For[
i = 31, 
i ≤ 
          36, 
i++, 
For[
j = 1, 
j ≤ 
            5, 
j++, 
ZkOctuVector2[
              j] = Append[
              ZkOctuVector2[
                j], ZkOctuVector2[
                  j][[30]]]; 
ZkOctuVector5[j] = 
            Append[ZkOctuVector5[
                j], ZkOctuVector5[
                  j][[30]]]
]
];

    
pomZkOctuVector1 = ZkOctuVector1[1];
pomZkOctuVector2 = ZkOctuVector2[1];
pomZkOctuVector3 = ZkOctuVector3[1];
pomZkOctuVector4 = ZkOctuVector4[1];
pomZkOctuVector5 = ZkOctuVector5[1];
pomZkOctuVector6 = ZkOctuVector6[1];

    
For[
ZkOctuPom1 = 
          1, 
ZkOctuPom1 < 
          konstanta, 
pomZkOctuVector1 = 
          Append[pomZkOctuVector1, 
            ZkOctuVector1[
              ZkOctuPom1]], 
ZkOctuPom1++
];

    
For[
ZkOctuPom2 = 
          1, 
ZkOctuPom2 < 
          konstanta, 
pomZkOctuVector2 = 
          Append[pomZkOctuVector2, 
            ZkOctuVector2[
              ZkOctuPom2]], 
ZkOctuPom2++
];

    
For[
ZkOctuPom3 = 
          1, 
ZkOctuPom3 < 
          konstanta, 
pomZkOctuVector3 = 
          Append[pomZkOctuVector3, 
            ZkOctuVector3[
              ZkOctuPom3]], 
ZkOctuPom3++
];

    
For[
ZkOctuPom4 = 
          1, 
ZkOctuPom4 < 
          konstanta, 
pomZkOctuVector4 = 
          Append[pomZkOctuVector4, 
            ZkOctuVector4[
              ZkOctuPom4]], 
ZkOctuPom4++
];

    
For[
ZkOctuPom5 = 
          1, 
ZkOctuPom5 < 
          konstanta, 
pomZkOctuVector5 = 
          Append[pomZkOctuVector5, 
            ZkOctuVector5[
              ZkOctuPom5]], 
ZkOctuPom5++
];

    
For[
ZkOctuPom6 = 
          1, 
ZkOctuPom6 < 
          konstanta, 
pomZkOctuVector6 = 
          Append[pomZkOctuVector6, 
            ZkOctuVector6[
              ZkOctuPom6]], 
ZkOctuPom6++
];

    
pomZkOctuVector1 = 
        Flatten[pomZkOctuVector1];
pomZkOctuVector2 = 
        Flatten[pomZkOctuVector2];
pomZkOctuVector3 = 
        Flatten[pomZkOctuVector3];
pomZkOctuVector4 = 
        Flatten[pomZkOctuVector4];
pomZkOctuVector5 = 
        Flatten[pomZkOctuVector5];
pomZkOctuVector6 = 
        Flatten[pomZkOctuVector6];

    
pomZkOctuVector1 = 
        Partition[pomZkOctuVector1, 2];
pomZkOctuVector2 = 
        Partition[pomZkOctuVector2, 2];
pomZkOctuVector3 = 
        Partition[pomZkOctuVector3, 2];
pomZkOctuVector4 = 
        Partition[pomZkOctuVector4, 2];
pomZkOctuVector5 = 
        Partition[pomZkOctuVector5, 2];
pomZkOctuVector6 = Partition[pomZkOctuVector6, 2];

OctuPicture = 
        Show[
MultipleListPlot[
ZkOctuVector1[1], 
ZkOctuVector1[
              2], 
ZkOctuVector1[
              3], 
ZkOctuVector2[
              1], 
ZkOctuVector2[
              2], 
ZkOctuVector2[
              3], 
ZkOctuVector3[
              1], 
ZkOctuVector3[
              2], 
ZkOctuVector3[
              3], 
ZkOctuVector4[
              1], 
ZkOctuVector4[
              2], 
ZkOctuVector4[
              3], 
ZkOctuVector5[
              1], 
ZkOctuVector5[
              2], 
ZkOctuVector5[
              3], 
ZkOctuVector6[
              1], 
ZkOctuVector6[
              2], 
ZkOctuVector6[
              3], 
PlotJoined -> 
              True, 
PlotStyle -> {{Hue[0.4]}, {Hue[
                    0.6]}, {Hue[
                    0.8]}}, 
SymbolShape -> 
              None, 
DisplayFunction -> 
              Identity
], 
Graphics[
{Hue[0.95], Disk[{-0.22, 0}, 0.05], 
              GrayLevel[
                0]}
], 
Graphics[
{Hue[0.3], Disk[{-0.08, 0}, 0.09], 
              GrayLevel[
                0]}
], 
Graphics[
{Hue[0.95], Disk[{0.08, 0}, 0.09], 
              GrayLevel[
                0]}
], 
Graphics[
{Hue[0.3], Disk[{0.22, 0}, 0.06], 
              GrayLevel[
                0]}
], 
Ticks -> 
            None, 
DisplayFunction -> $DisplayFunction
];

Export["octupole.jpg", OctuPicture, "JPEG", 
        ImageSize -> {640, 480}];

ZKOctuN2 := 0;

    
OctuMovie = 
Table[
Show[
MultipleListPlot[
Take[ZkOctuVector1[1], 
                ZkOctuN2], 
Take[ZkOctuVector1[2], 
                ZkOctuN2], 
Take[ZkOctuVector1[3], 
                ZkOctuN2], 
Take[ZkOctuVector2[1], 
                ZkOctuN2], 
Take[ZkOctuVector2[2], 
                ZkOctuN2], 
Take[ZkOctuVector2[3], 
                ZkOctuN2], 
Take[ZkOctuVector3[1], 
                ZkOctuN2], 
Take[ZkOctuVector3[2], 
                ZkOctuN2], 
Take[ZkOctuVector3[3], 
                ZkOctuN2], 
Take[ZkOctuVector4[1], 
                ZkOctuN2], 
Take[ZkOctuVector4[2], 
                ZkOctuN2], 
Take[ZkOctuVector4[3], 
                ZkOctuN2], 
Take[ZkOctuVector5[1], 
                ZkOctuN2], 
Take[ZkOctuVector5[2], 
                ZkOctuN2], 
Take[ZkOctuVector5[3], 
                ZkOctuN2], 
Take[ZkOctuVector6[1], 
                ZkOctuN2], 
Take[ZkOctuVector6[2], 
                ZkOctuN2], 
Take[ZkOctuVector6[3], 
                ZkOctuN2], 
PlotJoined -> 
                True, 
PlotStyle -> {{Hue[0.4]}, {Hue[
                      0.6]}, {Hue[
                      0.8]}}, 
SymbolShape -> 
                None, 
PlotRange -> {{-2.5, 
                    2.5}, {-2.5, 
                    2.5}}, 
DisplayFunction -> 
                Identity
], 
Graphics[
{Hue[0.95], Disk[{-0.22, 0}, 0.05], 
                GrayLevel[
                  0]}
], 
Graphics[
{Hue[0.3], Disk[{-0.08, 0}, 0.09], 
                GrayLevel[
                  0]}
], 
Graphics[
{Hue[0.95], Disk[{0.08, 0}, 0.09], 
                GrayLevel[
                  0]}
], 
Graphics[
{Hue[0.3], Disk[{0.22, 0}, 0.06], 
                GrayLevel[
                  0]}
], 
Ticks -> 
              None, 
DisplayFunction -> $DisplayFunction
], 
{ZkOctuN2, 1, 36, 
            1}
];

Export["Octupole.avi",  OctuMovie,  "AVI", 
        ImageSize -> {400, 300}];

Export["Octupole.gif",  OctuMovie,  "GIF", 
        ImageSize -> {640, 480}, 
        ConversionOptions -> {"Loop" -> True}];