magnet

Elektrický dipól - jedná se o dvojici bodových nábojů, které se nacházejí ve vzájemné vzdálenosti (Overscript[l,  ->]) . Pro velikosti bodových nábojů platí |(Subscript[Q, 1])| = |(Subscript[Q, 2])| = 
          Q, kde (Subscript[Q, 1]) < 0 a (Subscript[Q, 2]) > 0.

Intenzita elektrického pole dipólu:

Needs["Graphics`PlotField`"]

DipoleE ... graf intenzity elektrického pole dipólu

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

potenciál dipólu:
	Q1 o souřadnicích [1,0] a naboji Q=1
	Q2  o souřadnicích [-1,0] a naboji Q=-1

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

DipoleMagnetE[potencial_, x_, y_] := 
        PlotGradientField[potencial, x, y, PlotPoints -> 30, 
          ScaleFunction -> (1 &), 
          DisplayFunction -> Identity];

\(Show[
{
DipoleMagnetE[
          dipole, {x, \(-2.3\), 2.3}, {y, \(-2\), 
            2}], 
Graphics[
{
{
Hue[
                0.3], 
Rectangle[{\(-1.5\), \(-0.2\)}, {0, 
                  0.2}]
}, 
{
Hue[
                0.95], 
Rectangle[{0, \(-0.2\)}, {1.5, 
                  0.2}]
}, 
{
Thickness[
                0.003], 
Line[{{\(-1.5\), 0.2}, {1.5, 
                    0.2}}]
}, 
{
Thickness[
                0.003], 
Line[{{\(-1.5\), \(-0.2\)}, {\(-1.5\), 
                    0.2}}]
}, 
{
Thickness[
                0.003], 
Line[{{1.5, \(-0.2\)}, {1.5, 
                    0.2}}]
}, 
{
Thickness[
                0.003], 
Line[{{\(-1.5\), \(-0.2\)}, {1.5, \(-0.2\)}}]
}, 
{
Text[
                StyleForm["+", FontFamily -> "Arial", 
                  FontSize -> 20, 
                  FontWeight -> "Bold"], {1, \(-0.02\)}]
}, 
{
Text[
                StyleForm["-", FontFamily -> "Arial", 
                  FontSize -> 20, 
                  FontWeight -> "Bold"], {\(-1\), \(-0.02\)}]
}
}
]
}, 
DisplayFunction -> $DisplayFunction
]\)

Ekvipotenciálové plochy dipólu:

DipoleV ... graf ekvipotenciálních ploch dipólu

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

DipoleMagnetV[potencial_, x_, y_] := 
        ContourPlot[potencial, x, y, ContourShading -> False,  
          ContourSmoothing -> True, PlotPoints -> 50,  
          DisplayFunction -> Identity];

\(Show[
{
DipoleMagnetV[
          dipole, {x, \(-2\), 2}, {y, \(-2\), 
            2}], 
Graphics[
{
{
Hue[
                0.3], 
Rectangle[{\(-1.5\), \(-0.2\)}, {0, 
                  0.2}]
}, 
{
Hue[
                0.95], 
Rectangle[{0, \(-0.2\)}, {1.5, 
                  0.2}]
}, 
{
Thickness[
                0.003], 
Line[{{\(-1.5\), 0.2}, {1.5, 
                    0.2}}]
}, 
{
Thickness[
                0.003], 
Line[{{\(-1.5\), \(-0.2\)}, {\(-1.5\), 
                    0.2}}]
}, 
{
Thickness[
                0.003], 
Line[{{1.5, \(-0.2\)}, {1.5, 
                    0.2}}]
}, 
{
Thickness[
                0.003], 
Line[{{\(-1.5\), \(-0.2\)}, {1.5, \(-0.2\)}}]
}, 
{
Text[
                StyleForm["+", FontFamily -> "Arial", 
                  FontSize -> 20, 
                  FontWeight -> "Bold"], {1, \(-0.02\)}]
}, 
{
Text[
                StyleForm["-", FontFamily -> "Arial", 
                  FontSize -> 20, 
                  FontWeight -> "Bold"], {\(-1\), \(-0.02\)}]
}
}
]
}, 
DisplayFunction -> $DisplayFunction
]\)

DipoleE a DipoleV v jednom grafu

\(DiMagnetPictureEV = 
      Show[
DipoleMagnetE[
          dipole, {x, \(-2.3\), 2.3}, {y, \(-2\), 
            2}], 
DipoleMagnetV[
          dipole, {x, \(-2.3\), 2.3}, {y, \(-2\), 
            2}], 
Graphics[
{
{
Hue[
                0.3], 
Rectangle[{\(-1.5\), \(-0.2\)}, {0, 
                  0.2}]
}, 
{
Hue[
                0.95], 
Rectangle[{0, \(-0.2\)}, {1.5, 
                  0.2}]
}, 
{
Thickness[
                0.003], 
Line[{{\(-1.5\), 0.2}, {1.5, 
                    0.2}}]
}, 
{
Thickness[
                0.003], 
Line[{{\(-1.5\), \(-0.2\)}, {\(-1.5\), 
                    0.2}}]
}, 
{
Thickness[
                0.003], 
Line[{{1.5, \(-0.2\)}, {1.5, 
                    0.2}}]
}, 
{
Thickness[
                0.003], 
Line[{{\(-1.5\), \(-0.2\)}, {1.5, \(-0.2\)}}]
}, 
{
Text[
                StyleForm["+", FontFamily -> "Arial", 
                  FontSize -> 20, 
                  FontWeight -> "Bold"], {1, \(-0.02\)}]
}, 
{
Text[
                StyleForm["-", FontFamily -> "Arial", 
                  FontSize -> 20, 
                  FontWeight -> "Bold"], {\(-1\), \(-0.02\)}]
}
}
], 
DisplayFunction -> $DisplayFunction
]\)

Export["dipole-magnetEV.jpg", DiMagnetPictureEV, "JPEG", 
        ImageSize -> {640, 480}];

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

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

DiMagnetq1 := 0;
DiMagnetq2 := 0;

    
For[
DiMagnetq1 = 
          0, 
DiMagnetq1 < 
          5, 
DiMagnetVector1[DiMagnetq1] = 
          Table[{X[DiMagnetq1/2 Sin[t]^2, t], 
              Y[DiMagnetq1/2 Sin[t]^2, t]}, {t, 0, Pi, 
              Pi/50}], 
DiMagnetq1++
];

For[
DiMagnetq2 = 
          0, 
DiMagnetq2 < 
          5, 
DiMagnetVector2[DiMagnetq2] = 
          Table[{X[DiMagnetq2/2 Sin[t]^2, t], 
              Y[DiMagnetq2/2 Sin[t]^2, t]}, {t, 2 Pi, 
              Pi, -Pi/
                50}], 
DiMagnetq2++
];

pomDiMagnetVector1 = DiMagnetVector1[1];
pomDiMagnetVector2 = 
        DiMagnetVector2[1];

For[
DiMagnetPom1 = 
          1, 
DiMagnetPom1 < 
          6, 
pomDiMagnetVector1 = 
          Append[pomDiMagnetVector1, 
            DiMagnetVector1[
              DiMagnetPom1]], 
DiMagnetPom1++
];

For[
DiMagnetPom2 = 
          1, 
DiMagnetPom2 < 
          6, 
pomDiMagnetVector2 = 
          Append[pomDiMagnetVector2, 
            DiMagnetVector2[
              DiMagnetPom2]], 
DiMagnetPom2++
];

pomDiMagnetVector1 = 
        Flatten[pomDiMagnetVector1];
pomDiMagnetVector2 = 
        Flatten[pomDiMagnetVector2];

pomDiMagnetVector1 = 
        Partition[pomDiMagnetVector1, 2];
pomDiMagnetVector2 = Partition[pomDiMagnetVector2, 2];

\(
\)

\(\(DiPicture = 
        Show[
Graphics[
{
{
Hue[
                  0.3], 
Rectangle[{\(-0.1\), \(-0.08\)}, {0, 0.08}]
}, 
{
Hue[
                  0.95], 
Rectangle[{\(-0\), \(-0.08\)}, {0.1, 0.08}]
}, 
{
Thickness[
                  0.003], 
Line[{{\(-0.1\), 0.08}, {0.1, 
                      0.08}}]
}, 
{
Thickness[
                  0.003], 
Line[{{\(-0.1\), \(-0.08\)}, {\(-0.1\), 
                      0.08}}]
}, 
{
Thickness[
                  0.003], 
Line[{{0.1, \(-0.08\)}, {0.1, 
                      0.08}}]
}, 
{
Thickness[
                  0.003], 
Line[{{\(-0.1\), \(-0.08\)}, {0.1, \(-0.08\)}}]
}, 
{
Text[
                  StyleForm["+", FontFamily -> "Arial", 
                    FontSize -> 15, 
                    FontWeight -> "Bold"], {0.06, \(-0.2\)}]
}, 
{
Text[
                  StyleForm["-", FontFamily -> "Arial", 
                    FontSize -> 15, 
                    FontWeight -> "Bold"], {\(-0.06\), \(-0.2\)}]
}
}
], 
ListPlot[
Take[pomDiMagnetVector1, 
              Length[pomDiMagnetVector1]], 
PlotJoined -> True, Ticks -> None, 
            DisplayFunction -> 
              Identity
], 
ListPlot[
Take[pomDiMagnetVector2, 
              Length[pomDiMagnetVector1]], 
PlotRange -> {{\(-0.8\), 0.8}, {\(-1.4\), 1.4}}, PlotJoined -> True, 
            Ticks -> None, 
            DisplayFunction -> 
              Identity
], 
PlotRange -> {{\(-0.6\), 0.6}, {\(-1.5\), 
                
                1.5}}, 
DisplayFunction -> $DisplayFunction
];\)\)

Export["dipole-magnet.jpg", DiPicture, "JPEG", 
      ImageSize -> {640, 480}]

\(
\)

\(\(DiMagnetMovie = 
Table[
Show[
Graphics[
{
{
Hue[
                    0.3], 
Rectangle[{\(-0.14\), \(-0.08\)}, {0, 
                      0.08}]
}, 
{
Hue[
                    0.95], 
Rectangle[{\(-0\), \(-0.08\)}, {0.14, 0.08}]
}, 
{
Thickness[
                    0.003], 
Line[{{\(-0.14\), 
                        0.08}, {0.14, 
                        0.08}}]
}, 
{
Thickness[
                    0.003], 
Line[{{\(-0.14\), \(-0.08\)}, {\(-0.14\), 
                        0.08}}]
}, 
{
Thickness[
                    0.003], 
Line[{{0.14, \(-0.08\)}, {0.14, 0.08}}]
}, 
{
Thickness[
                    0.003], 
Line[{{\(-0.14\), \(-0.08\)}, {0.14, \(-0.08\)}}]
}, 
{
Text[
                    StyleForm["+", FontFamily -> "Arial", 
                      FontSize -> 15, 
                      FontWeight -> "Bold"], {0.06, \(-0.2\)}]
}, 
{
Text[
                    StyleForm["-", FontFamily -> "Arial", 
                      FontSize -> 15, 
                      FontWeight -> "Bold"], {\(-0.06\), \(-0.2\)}]
}
}
], 
ListPlot[
Take[pomDiMagnetVector1, 
                DiMagnetN], 
PlotJoined -> True, 
              Ticks -> None, 
              DisplayFunction -> 
                Identity
], 
ListPlot[
Take[pomDiMagnetVector2, 
                DiMagnetN], 
PlotJoined -> True, 
              Ticks -> None, 
              DisplayFunction -> 
                Identity
], 
PlotRange -> {{\(-0.7\), 0.7}, {\(-1.4\), 
                  1.4}}, 
DisplayFunction -> $DisplayFunction
], {DiMagnetN, 1, 
            Length[pomDiMagnetVector2], 2}
];\)\)

Export["dipole-magnet.avi",  DiMagnetMovie,  "AVI", 
        ImageSize -> {400, 300}];

Export["dipole-magnet.gif",  DiMagnetMovie,  "GIF", 
        ImageSize -> {640, 480}, 
        ConversionOptions -> {"Loop" -> True}];