Elektrický axialní kvadrupól

Elektrický axiální kvadrupól -

Intenzita elektrického pole kvadrupol:

Needs["Graphics`PlotField`"]

QuadrupoleE ... graf intenzity elektrického pole kvadrupolu

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

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

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

QuadPlot1 = 
        QuadrupoleE[
          quadrupole, {x, -1.3, 1.3}, {y, -1.3, 1.3}];

Ekvipotenciálové plochy kvadrupolu:

QuadrupoleV ... graf ekvipotenciálních ploch kvadrupolu

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

QuadPlot2  = 
        QuadrupoleV[
          quadrupole, {x, -1.3, 1.3}, {y, -1.3, 1.3}];

QuadrupoleE a QuadrupoleV v jednom grafu

QuadPictureEV = Show[QuadPlot1, QuadPlot2];

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

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

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

QuadInf := infinitesimal = Pi/100000;

    
Quadq1 := 0;
Quadq2 := 0;
Quadq3 := 0;
Quadq4 := 0;

    
For[
Quadq1 = 0, 
Quadq1 < 
          5, 
QuadVector1[Quadq1] = 
          Table[{X[Quadq1/2 (Tan[t] Sin[2 t]^3)^(1/4), t], 
              Y[Quadq1/2 (Tan[t] Sin[2 t]^3)^(1/4), t]}, {t, 
              Pi/2 - QuadInf, 
              QuadInf, -Pi/
                100}], 
Quadq1++
];

    
For[
Quadq2 = 0, 
Quadq2 < 
          5, 
QuadVector2[Quadq2] = 
          Table[{X[Quadq2/2 (Tan[t] Sin[2 t]^3)^(1/4), t], 
              Y[Quadq2/2 (Tan[t] Sin[2 t]^3)^(1/4), t]}, {t, 
              Pi/2 + QuadInf, Pi - QuadInf, 
              Pi/100}], 
Quadq2++
];

    
For[
Quadq3 = 0, 
Quadq3 < 
          5, 
QuadVector3[Quadq3] = 
          Table[{X[Quadq3/2 (Tan[t] Sin[2 t]^3)^(1/4), t], 
              Y[Quadq3/2 (Tan[t] Sin[2 t]^3)^(1/4), t]}, {t, 
              3 Pi/2 - QuadInf, 
              Pi + QuadInf, -Pi/
                100}], 
Quadq3++
];

    
For[
Quadq4 = 0, 
Quadq4 < 
          5, 
QuadVector4[Quadq4] = 
          Table[{X[Quadq4/2 (Tan[t] Sin[2 t]^3)^(1/4), t], 
              Y[Quadq4/2 (Tan[t] Sin[2 t]^3)^(1/4), t]}, {t, 
              3 Pi/2 + QuadInf, 2 Pi - QuadInf, 
              Pi/100}], 
Quadq4++
];

    
pomQuadVector1 = QuadVector1[1];
pomQuadVector2 = QuadVector2[1];
pomQuadVector3 = QuadVector3[1];
pomQuadVector4 = QuadVector4[1];

    
For[
QuadPom1 = 1, 
QuadPom1 < 
          3, 
pomQuadVector1 = 
          Append[pomQuadVector1, 
            QuadVector1[
              QuadPom1]], 
QuadPom1++
];

    
For[
QuadPom2 = 1, 
QuadPom2 < 
          3, 
pomQuadVector2 = 
          Append[pomQuadVector2, 
            QuadVector2[
              QuadPom2]], 
QuadPom2++
];

    
For[
QuadPom3 = 1, 
QuadPom3 < 
          3, 
pomQuadVector3 = 
          Append[pomQuadVector3, 
            QuadVector3[
              QuadPom3]], 
QuadPom3++
];

    
For[
QuadPom4 = 1, 
QuadPom4 < 
          3, 
pomQuadVector4 = 
          Append[pomQuadVector4, 
            QuadVector4[
              QuadPom4]], 
QuadPom4++
];

    
pomQuadVector1 = 
        Flatten[pomQuadVector1];
pomQuadVector2 = 
        Flatten[pomQuadVector2];
pomQuadVector3 = 
        Flatten[pomQuadVector3];
pomQuadVector4 = Flatten[pomQuadVector4];

    
pomQuadVector1 = 
        Partition[pomQuadVector1, 2];
pomQuadVector2 = 
        Partition[pomQuadVector2, 2];
pomQuadVector3 = 
        Partition[pomQuadVector3, 2];
pomQuadVector4 = Partition[pomQuadVector4, 2];

QuadPicture = 
      Show[
ListPlot[
Take[
            pomQuadVector1, 
            Length[pomQuadVector1]], 
PlotJoined -> 
            True, 
DisplayFunction -> 
            Identity
], 
ListPlot[
Take[pomQuadVector2, 
            Length[pomQuadVector2]], 
PlotJoined -> 
            True, 
DisplayFunction -> 
            Identity
], 
ListPlot[
Take[pomQuadVector3, 
            Length[pomQuadVector3]], 
PlotJoined -> 
            True, 
DisplayFunction -> 
            Identity
], 
ListPlot[
Take[pomQuadVector4, 
            Length[pomQuadVector4]], 
PlotJoined -> 
            True, 
DisplayFunction -> 
            Identity
], 
Graphics[
{Hue[0.95], Disk[{0, 0}, 0.05], 
            GrayLevel[
              0]}
], 
Graphics[
{Hue[0.3], Disk[{0.08, 0}, 0.03], 
            GrayLevel[
              0]}
], 
Graphics[
{Hue[0.3], Disk[{-0.08, 0}, 0.03], 
            GrayLevel[
              0]}
], 
PlotRange -> {{-1.2, 1.2}, {-1.2, 1.2}}, 
Ticks -> 
          None, 
DisplayFunction -> $DisplayFunction
]

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

QuadMovie = 
Table[
Show[
ListPlot[
Take[pomQuadVector1, 
                QuadN], 
PlotJoined -> 
                True, 
DisplayFunction -> 
                Identity
], 
ListPlot[
Take[pomQuadVector2, 
                QuadN], 
PlotJoined -> 
                True, 
DisplayFunction -> 
                Identity
], 
ListPlot[
Take[pomQuadVector3, 
                QuadN], 
PlotJoined -> 
                True, 
DisplayFunction -> 
                Identity
], 
ListPlot[
Take[pomQuadVector4, 
                QuadN], 
PlotJoined -> 
                True, 
DisplayFunction -> 
                Identity
], 
Graphics[
{Hue[0.95], Disk[{0, 0}, 0.05], 
                GrayLevel[
                  0]}
], 
Graphics[
{Hue[0.3], Disk[{0.08, 0}, 0.03], 
                GrayLevel[
                  0]}
], 
Graphics[
{Hue[0.3], Disk[{-0.08, 0}, 0.03], 
                GrayLevel[
                  0]}
], 
PlotRange -> {{-1, 1}, {-1.9, 1.9}}, 
Ticks -> 
              None, 
DisplayFunction -> $DisplayFunction
], {QuadN, 1, Length[pomQuadVector4], 
            2}
];

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

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