半波長ダイポールの電気力線

Mathematica 5.1で計算。
他のバージョン(例えば Mathematica 4.2)を使うとNDSolveルーチンが古いバージョンなので、FieldLineコマンド内で使っているNDSolveコマンドの影響で違った結果となる。

[参考文献]
*http://www-antenna.ee.titech.ac.jp/~hira/hobby/edu/em/smalldipole/field_lines.pdf
*寺沢寛一, 「自然科学者のための 数学概論」, 岩波書店
*K.W. Kark, and R. Dill, “A general theory on the graphical representation of antenna-radiation fields,” IEEE Trans. Antennas Propag., Vol.32, No.2, Feb. 1990.

2005/6/14 平野拓一(東京工業大学)
June 14, 2005 Takuichi Hirano (Tokyo Institute of Technology)

SetDirectory["D:/hira1/work2/Publishing/2005_Antenna_Eng_HDBK/chap02/\
graphics/mathematica"]

<< Graphics`Colors`

モーメント法(MoM)解析
区分正弦ガラーキン法
デルタギャップ給電
セグメント数: n=21
ダイポール長: l=2h=0.47(Subscript[λ, 0])
導体半径: a=0.01(Subscript[λ, 0])

\( (*\ モ - メント法の結果\ *) \)
ivec = {{0.003636282971785757`, -0.44636413864403934`}, {0.0049958399920667805`, -0.42893827872653234`}, {0.006658226630825315`, -0.4144653996108061`}, {0.007990972139088667`, -0.39809262864560185`}, {0.009178821050582235`, -0.3805383219787897`}, {0.01016938052097131`, -0.36133609202863326`}, {0.010962570365456135`, -0.33837677426529716`}, {0.01156688003582297`, -0.3157710799250509`}, {0.011909051187458079`, -0.2729579886960811`}, {0.012205361276998948`, -0.2726746177539231`}, {0.011866768359100655`, -0.052751168591330236`}, {0.012205361276998951`, -0.27267461775392293`}, {0.011909051187458079`, -0.27295798869608084`}, {0.01156688003582297`, -0.31577107992505066`}, {0.01096257036545613`, -0.33837677426529705`}, {0.010169380520971306`, -0.3613360920286333`}, {0.009178821050582235`, -0.38053832197878956`}, {0.007990972139088663`, -0.39809262864560163`}, {0.006658226630825315`, -0.41446539961080603`}, {0.0049958399920667805`, -0.42893827872653234`}, {0.0036362829717857563`, -0.4463641386440394`}};

c = 1. ;
λ0 = 1. ;
k0 = ((2 π)/λ)0;
h = (0.47)*λ0/2;
nn = Length[ ivec ];
cur[n_, t_] := 
        ivec[[n, 1]]*
          Cos[t + ivec[[n, 2]]];
posSeg[n_] := ((2*h)/(nn + 1))*n - h;

Clear[ω];
sol = 
        Solve[λ0*(ω/(2*π)) == 
            c, ω];
ω = (ω  /.  sol[[1]]);

grapdist = {Red, AbsoluteThickness[2], 
          Line[Table[{20*
                  ivec[[i, 
                      1]], ((i - 1)/(nn - 1))*(2*h) - 
                  h}, {i, 1, nn}]]};
Show[ Graphics[grapdist] ];

微小ダイポールの放射電界

\(\(r\&^ . x\&^ = 
        Sin[θ]\ Cos[φ];\)\)
\(\(θ\&^ . x\&^ = 
        Cos[θ]\ Cos[φ];\)\)
\(\(\(φ\&^ . x\&^ = Sin[φ];\)\(
\)
    \)\)
\(\(r\&^ . y\&^ = 
        Sin[θ]\ Sin[φ];\)\)
\(\(θ\&^ . y\&^ = 
        Cos[θ]\ Sin[φ];\)\)
\(\(\(φ\&^ . y\&^ = Cos[φ];\)\(
\)
    \)\)
\(\(r\&^ . z\&^ = Cos[θ];\)\)
\(\(θ\&^ . z\&^ = Sin[θ];\)\)
\(\(φ\&^ . z\&^ = 0;\)\)

\(\(\(simpi[f_, {ξ_, a_, b_}, n_] := 
        Module[{h = \((b - a)\)/\((2*n)\), x, i}, 
		x[i_] := 
            a + h*i; 
		\(h\/3\) \((\((f /. {ξ -> x[0]})\) + 
                  4\ \(∑\+\(i = 1\)\%n\((f /. {ξ -> 
                              x[2*i - 1]})\)\) + 
                  2\ \(∑\+\(i = 2\)\%n\((f /. {ξ -> \ 
                              x[2*i - 2]})\)\) + \((f /. {ξ -> \ 
                          x[2*n]})\))\) // N
	];\)\(
\)
    \)\)
er[i_, r_, θ_, t_] := 
        2*Cos[θ]*(Cos[k0*(c*t - r) + ivec[[i, 2]]]/(((k0*r))^2) + Sin[k0*(c*t - r) + ivec[[i, 2]]]/(((k0*r))^3));
etheta[i_, r_, θ_, t_] := 
        Sin[θ]*(Cos[k0*(c t - r) + ivec[[i, 2]]]/(((k0*r))^2) - ((1/((k0*r))) - (1/(((k0*r))^3)))*
                Sin[k0*(c t - r) + 
                    ivec[[i, 2]]]);
hphi[i_, zpos_, r_, θ_, t_] := 
        Sin[θ]*(Cos[k0*(c*t - r) + ivec[[i, 2]]]/(k0*r) - 
              Sin[k0*(c*t - r) + ivec[[i, 2]]]/(((k0*r))^2));
ex[i_, r_, θ_, φ_, t_] := 
        Sin[θ]*Cos[φ]*er[i, r, θ, t] + 
          Cos[θ]*Cos[φ]*
            etheta[i, r, θ, t];
ey[i_, r_, θ_, φ_, t_] := 
        Sin[θ]*Sin[φ]*er[i, r, θ, t] + 
          Cos[θ]*Sin[φ]*
            etheta[i, r, θ, t];
ez[i_, r_, θ_, φ_, t_] := 
        Cos[θ]*er[i, r, θ, t] - 
          Sin[θ]*
            etheta[i, r, θ, t];
eField[xo_, yo_, zo_, t_] := 
        Module[{xs = 0, ys = 0, zs = 0, r, θ, φ, exsum = 0, 
            eysum = 0, ezsum = 0, i, j, 
            nb = 1}, 
Do[
zs = 
              posSeg[i - 
                    1] + (2*(posSeg[i] - posSeg[i - 1])/(nb + 1))*
                  
                  j; 
r = (Sqrt[(((xo - xs))^2) + (((yo - ys))^2) + (((zo - zs))^2)]); 
θ = 
              ArcCos[((zo - zs)/(Sqrt[(((xo - xs))^2) + (((yo - ys))^2) + (((zo - zs))^2)]))]; 
φ = 
              ArcCos[((xo - xs)/(Sqrt[(((xo - xs))^2) + (((yo - ys))^2)]))]; 
exsum += (ivec[[i, 1]]*(1 - 
                        Abs[posSeg[i] - zs]/(posSeg[i + 1] - posSeg[i]))*(1/nb))*
                ex[i, r, θ, φ, 
                  t]; 
eysum += (ivec[[i, 1]]*(1 - 
                        Abs[posSeg[i] - zs]/(posSeg[i + 1] - posSeg[i]))*(1/nb))*
                ey[i, r, θ, φ, 
                  t]; 
ezsum += (ivec[[i, 1]]*(1 - 
                        Abs[posSeg[i] - zs]/(posSeg[i + 1] - posSeg[i]))*(1/nb))*
                ez[i, r, θ, φ, t]
, {i, 1, 
              nn}, {j, 1, nb}
]; 
{exsum, 
            eysum, ezsum}
];
erSumSpherical[ro_, θo_, φo_, t_] := 
        Module[{xo = ro*Sin[θo]*Cos[φo], 
            yo = ro*Sin[θo]*Sin[φo], zo = ro*Cos[θo], 
            xs = 0, ys = 0, zs = 0, r, θ, φ, 
            erSum = 0}, 
Do[
zs = (i - 
                        1)/(nn - 1)*(2*h) - 
                h; 
r = (Sqrt[(((xo - xs))^2) + (((yo - ys))^2) + (((zo - zs))^2)]); 
θ = 
              ArcCos[((zo - zs)/(Sqrt[(((xo - xs))^2) + (((yo - ys))^2) + (((zo - zs))^2)]))]; 
φ = 
              ArcCos[((xo - xs)/(Sqrt[(((xo - xs))^2) + (((yo - ys))^2)]))]; 
erSum += 
              ivec[[i, 1]]*er[i, r, θ, t];
, {i, 
              1, nn}
]; 
erSum
];
ethetaSumSpherical[ro_, θo_, φo_, t_] := 
        Module[{xo = ro*Sin[θo]*Cos[φo], 
            yo = ro*Sin[θo]*Sin[φo], zo = ro*Cos[θo], 
            xs = 0, ys = 0, zs = 0, r, θ, φ, 
            ethetaSum = 
              0}, 
Do[
zs = (i - 
                        1)/(nn - 1)*(2*h) - 
                h; 
r = (Sqrt[(((xo - xs))^2) + (((yo - ys))^2) + (((zo - zs))^2)]); 
θ = 
              ArcCos[((zo - zs)/(Sqrt[(((xo - xs))^2) + (((yo - ys))^2) + (((zo - zs))^2)]))]; 
φ = 
              ArcCos[((xo - xs)/(Sqrt[(((xo - xs))^2) + (((yo - ys))^2)]))]; 
ethetaSum += 
              ivec[[i, 1]]*
                etheta[i, r, θ, t];
, {i, 1, 
              nn}
]; 
ethetaSum
];
hphiSumSpherical[ro_, θo_, φo_, t_] := 
        Module[{xo = ro*Sin[θo]*Cos[φo], 
            yo = ro*Sin[θo]*Sin[φo], zo = ro*Cos[θo], 
            xs = 0, ys = 0, zs = 0, r, θ, φ, 
            hphiSum = 
              0}, 
Do[
zs = (i - 
                        1)/(nn - 1)*(2*h) - 
                h; 
r = (Sqrt[(((xo - xs))^2) + (((yo - ys))^2) + (((zo - zs))^2)]); 
θ = 
              ArcCos[((zo - zs)/(Sqrt[(((xo - xs))^2) + (((yo - ys))^2) + (((zo - zs))^2)]))]; 
φ = 
              ArcCos[((xo - xs)/(Sqrt[(((xo - xs))^2) + (((yo - ys))^2)]))]; 
hphiSum += 
              ivec[[i, 1]]*
                hphi[i, r, θ, t]
, {i, 1, 
              nn}
]; 
hphiSum
];
energy[xo_, yo_, zo_, t_] := 
      Module[{xs = 0, ys = 0, zs = 0, r, θ, φ, exsum = 0, 
          eysum = 0, 
          ezsum = 0}, 
Do[
zs = (i - 
                      1)/(nn - 1)*(2*h) - 
              h; 
r = (Sqrt[(((xo - xs))^2) + (((yo - ys))^2) + (((zo - zs))^2)]); 
θ = 
            
            ArcCos[((zo - zs)/(Sqrt[(((xo - xs))^2) + (((yo - ys))^2) + (((zo - zs))^2)]))]; 
φ = 
            ArcCos[((xo - xs)/(Sqrt[(((xo - xs))^2) + (((yo - ys))^2)]))]; 
exsum += 
            ivec[[i, 1]]*
              ex[i, r, θ, φ, t]; 
eysum += 
            ivec[[i, 1]]*
              ey[i, r, θ, φ, t]; 
ezsum += 
            ivec[[i, 1]]*
              ez[i, r, θ, φ, t]
, {i, 1, 
            nn}
]; 
(exsum^2) + (eysum^2) + 
          (ezsum^2)
]

FieldLines (Ver.2)

t=0
(nb=5)

等高線密度計算

ez2[
          x_] = eField[0, x, 0, 
              t][[3]]  /.   t -> ((π/(c*k0))/
                  8)*0;

    Plot[x*ez2[x], {x, 0, 
        3}, 
PlotRange -> {-0.04, 
          0.04}]

FindRoot[x*ez2[x] == 0, {x, 0.9}]

FindMaximum[x*ez2[x], {x, 0.7}]

FindMinimum[x*ez2[x], {x, 1.2}]

流束(Flux)の計算

x0 = 1.4;
x1 = 1.5;
Ψs = simpi[x*Abs[ez2[x]], {x, x0, x1}, 10]

Ψ0 = 0.00075;

x0 = 0.5826842652307703`;
x1 = 0.6364915772054781`;
simpi[x*Abs[ez2[x]], {x, x0, x1}, 10]

Clear[Ψ]

Ψ[x0_, x_] := 
        simpi[t*Abs[ez2[t]], {t, x0, x}, 10];
x0 = 0.6570176173504582`;
Plot[Ψ[x0, x], {x, x0, 
          2*x0}, 
PlotRange -> 
          All];
FindRoot[Ψ[x0, x] == Ψ0, {x, 
        x0}]

x0 = 1.2374862645822562`;
FindRoot[Ψ[x0, x] == Ψ0, {x, 
        x0}]

[等高線を描くためのx座標]

{{0.47842153317114244`, 
0.5222668388354459`, 
0.557115502671497`, 
0.5877927333799371`, 
0.6162373886544161`, 
0.6435421757316049`}, 
0.6570176173504582`, 
{0.6704931376493997`, 
0.6978046064502564`, 
0.7263017047548648`, 
0.7572021986386483`, 
0.7928784583837198`, 
0.8406516586164728`}, 
1.1718494966800148`, 
{1.184635199882095`, 
1.2105317167681096`, 
1.2374862645822562`
}
}

[グラフィック]

<< ExtendGraphics`FieldLines`;
exFL = eField[0, x, y, t][[2]]  /.  
          t -> ((π/(c*k0))/
                  8)*0;
eyFL = eField[0, x, y, t][[3]]  /.  
          t -> ((π/(c*k0))/
                  8)*0;
eline1 = {{FieldLine[{x, exFL, 0.47842153317114244`}, {y, eyFL, 
                0}, {l, 50}], 
FieldLine[{x, exFL, 
                0.5222668388354459`}, {y, eyFL, 0}, {l, 
                55}], 
FieldLine[{x, exFL, 
                0.557115502671497`}, {y, eyFL, 0}, {l, 
                65}], 
FieldLine[{x, exFL, 
                0.5877927333799371`}, {y, eyFL, 0}, {l, 
                70}], 
FieldLine[{x, exFL, 
                0.6162373886544161`}, {y, eyFL, 0}, {l, 
                45}], 
FieldLine[{x, -exFL, 
                0.6162373886544161`}, {y, -eyFL, 0}, {l, 
                45}], 
FieldLine[{x, exFL, 
                0.6435421757316049`}, {y, eyFL, 0}, {l, 
                65}], 
FieldLine[{x, -exFL, 
                0.6435421757316049`}, {y, -eyFL, 0}, {l, 
                65}]}, 
{FieldLine[{x, exFL, 
                0.6704931376493997`}, {y, eyFL, 0}, {l, 
                460}], 
FieldLine[{x, exFL, 
                0.6978046064502564`}, {y, eyFL, 0}, {l, 
                350}], 
FieldLine[{x, exFL, 
                0.7263017047548648`}, {y, eyFL, 0}, {l, 
                295}], 
FieldLine[{x, exFL, 
                0.7572021986386483`}, {y, eyFL, 0}, {l, 
                260}], 
FieldLine[{x, exFL, 
                0.7928784583837198`}, {y, eyFL, 0}, {l, 
                230}], 
FieldLine[{x, exFL, 
                0.8406516586164728`}, {y, eyFL, 0}, {l, 
                210}]}, 
{FieldLine[{x, exFL, 
                1.184635199882095`}, {y, eyFL, 0}, {l, 
                1160}], 
FieldLine[{x, exFL, 
                1.2105317167681096`}, {y, eyFL, 0}, {l, 
                845}], 
FieldLine[{x, exFL, 
                1.2374862645822562`}, {y, eyFL, 0}, {l, 
                705}]}};
eline2 = {{FieldLine[{x, -exFL, -0.47842153317114244`}, {y, 
                eyFL, 0}, {l, 
                50}], 
FieldLine[{x, -exFL, -0.5222668388354459`}, {y, eyFL, 0}, {l, 
                55}], 
FieldLine[{x, -exFL, -0.557115502671497`}, {y, eyFL, 0}, {l, 
                65}], 
FieldLine[{x, -exFL, -0.5877927333799371`}, {y, eyFL, 0}, {l, 
                70}], 
FieldLine[{x, -exFL, -0.6162373886544161`}, {y, eyFL, 0}, {l, 
                45}], 
FieldLine[{x, 
                exFL, -0.6162373886544161`}, {y, -eyFL, 0}, {l, 
                45}], 
FieldLine[{x, -exFL, -0.6435421757316049`}, {y, eyFL, 0}, {l, 
                65}], 
FieldLine[{x, 
                exFL, -0.6435421757316049`}, {y, -eyFL, 0}, {l, 
                65}]}, 
{FieldLine[{x, -exFL, -0.6704931376493997`}, {y, eyFL, 0}, {l, 
                460}], 
FieldLine[{x, -exFL, -0.6978046064502564`}, {y, eyFL, 0}, {l, 
                350}], 
FieldLine[{x, -exFL, -0.7263017047548648`}, {y, eyFL, 0}, {l, 
                295}], 
FieldLine[{x, -exFL, -0.7572021986386483`}, {y, eyFL, 0}, {l, 
                260}], 
FieldLine[{x, -exFL, -0.7928784583837198`}, {y, eyFL, 0}, {l, 
                230}], 
FieldLine[{x, -exFL, -0.8406516586164728`}, {y, eyFL, 0}, {l, 
                210}]}, 
{FieldLine[{x, -exFL, -1.184635199882095`}, {y, eyFL, 0}, {l, 
                1160}], 
FieldLine[{x, -exFL, -1.2105317167681096`}, {y, eyFL, 0}, {l, 
                845}], 
FieldLine[{x, -exFL, -1.2374862645822562`}, {y, eyFL, 0}, {l, 
                705}]}};
a = 0.01;
h = 0.47/2;
halfdip = {AbsoluteThickness[2], 
          Line[{{a, -h}, {a, h}, {-a, 
                h}, {-a, -h}, {a, -h}}]};
g = 
        Show[Graphics[{AbsoluteThickness[2], eline1, 
              eline2}], 
Prolog -> 
            halfdip, 
ImageSize -> {320, 
              320}, 
PlotRange -> {{-1, 
                1}, {-1, 1}}, 
AspectRatio -> 
            Automatic];

Export["t00.wmf", g];
Export["t00.eps", g];
Export["t00.gif", g];

t=(1/8)T
(nb=1)

等高線密度計算

ez2[
          x_] = eField[0, x, 0, 
              t][[3]]  /.   t -> ((π/(c*k0))/
                  8)*1;

    Plot[x*ez2[x], {x, 0, 
        3}, 
PlotRange -> {-0.08, 
          0.08}]

FindRoot[x*ez2[x] == 0, {x, 1}]

FindMaximum[x*ez2[x], {x, 0.7}]

FindMinimum[x*ez2[x], {x, 1.2}]

流束(Flux)の計算

x0 = 1.4;
x1 = 1.5;
Ψs = simpi[x*Abs[ez2[x]], {x, x0, x1}, 10]

Ψ0 = 0.00075;

x0 = 0.5826842652307703`;
x1 = 0.6364915772054781`;
simpi[x*Abs[ez2[x]], {x, x0, x1}, 10]

Clear[Ψ]

Ψ[x0_, x_] := 
        simpi[t*Abs[ez2[t]], {t, x0, x}, 10];
x0 = 0.7219970511182235`;
Plot[Ψ[x0, x], {x, x0, 
          2*x0}, 
PlotRange -> 
          All];
FindRoot[Ψ[x0, x] == Ψ0, {x, 
        x0}]

x0 = 1.248296117142237`;
FindRoot[Ψ[x0, x] == Ψ0, {x, 
        x0}]

[等高線を描くためのx座標]

{{0.5458108453539218`, 
0.5890505718678807`, 
0.623403223572553`, 
0.6536611041612331`, 
0.6817330654781347`, 
0.7086908727134592`}, 
0.7219970511182235`, 
{0.735303290812253`, 
0.7622662976584254`, 
0.7903789678567109`, 
0.8208093148710218`, 
0.8557951891064748`, 
0.90195908624929`}, 
1.235543473321916`, 
{1.248296117142237`, 
1.2741251383546497`}
}

[グラフィック]

<< ExtendGraphics`FieldLines`;
exFL = eField[0, x, y, t][[2]]  /.  
          t -> ((π/(c*k0))/
                  8)*1;
eyFL = eField[0, x, y, t][[3]]  /.  
          t -> ((π/(c*k0))/
                  8)*1;
eline1 = {{FieldLine[{x, exFL, 0.5458108453539218`}, {y, eyFL, 
                0}, {l, 40}], 
FieldLine[{x, exFL, 
                0.5890505718678807`}, {y, eyFL, 0}, {l, 
                45}], 
FieldLine[{x, exFL, 
                0.623403223572553`}, {y, eyFL, 0}, {l, 
                50}], 
FieldLine[{x, exFL, 
                0.6536611041612331`}, {y, eyFL, 0}, {l, 
                55}], 
FieldLine[{x, exFL, 
                0.6817330654781347`}, {y, eyFL, 0}, {l, 
                70}], 
FieldLine[{x, exFL, 
                0.7086908727134592`}, {y, eyFL, 0}, {l, 
                100}]}, 
{FieldLine[{x, exFL, 
                0.735303290812253`}, {y, eyFL, 0}, {l, 
                320}], 
FieldLine[{x, exFL, 
                0.7622662976584254`}, {y, eyFL, 0}, {l, 
                240}], 
FieldLine[{x, exFL, 
                0.7903789678567109`}, {y, eyFL, 0}, {l, 
                205}], 
FieldLine[{x, exFL, 
                0.8208093148710218`}, {y, eyFL, 0}, {l, 
                180}], 
FieldLine[{x, exFL, 
                0.8557951891064748`}, {y, eyFL, 0}, {l, 
                160}], 
FieldLine[{x, exFL, 
                0.90195908624929`}, {y, eyFL, 0}, {l, 
                145}]}, 
{FieldLine[{x, exFL, 
                1.248296117142237`}, {y, eyFL, 0}, {l, 
                760}], 
FieldLine[{x, exFL, 
                1.2741251383546497`}, {y, eyFL, 0}, {l, 
                550}]}};
eline2 = {{FieldLine[{x, -exFL, -0.5458108453539218`}, {y, 
                eyFL, 0}, {l, 
                40}], 
FieldLine[{x, -exFL, -0.5890505718678807`}, {y, eyFL, 0}, {l, 
                45}], 
FieldLine[{x, -exFL, -0.623403223572553`}, {y, eyFL, 0}, {l, 
                50}], 
FieldLine[{x, -exFL, -0.6536611041612331`}, {y, eyFL, 0}, {l, 
                55}], 
FieldLine[{x, -exFL, -0.6817330654781347`}, {y, eyFL, 0}, {l, 
                70}], 
FieldLine[{x, -exFL, -0.7086908727134592`}, {y, eyFL, 0}, {l, 
                100}]}, 
{FieldLine[{x, -exFL, -0.735303290812253`}, {y, eyFL, 0}, {l, 
                320}], 
FieldLine[{x, -exFL, -0.7622662976584254`}, {y, eyFL, 0}, {l, 
                240}], 
FieldLine[{x, -exFL, -0.7903789678567109`}, {y, eyFL, 0}, {l, 
                205}], 
FieldLine[{x, -exFL, -0.8208093148710218`}, {y, eyFL, 0}, {l, 
                180}], 
FieldLine[{x, -exFL, -0.8557951891064748`}, {y, eyFL, 0}, {l, 
                160}], 
FieldLine[{x, -exFL, -0.90195908624929`}, {y, eyFL, 0}, {l, 
                145}]}, 
{FieldLine[{x, -exFL, -1.248296117142237`}, {y, eyFL, 0}, {l, 
                760}], 
FieldLine[{x, -exFL, -1.2741251383546497`}, {y, eyFL, 0}, {l, 
                550}]}};
a = 0.01;
h = 0.47/2;
halfdip = {AbsoluteThickness[2], 
          Line[{{a, -h}, {a, h}, {-a, 
                h}, {-a, -h}, {a, -h}}]};
g = 
        Show[Graphics[{AbsoluteThickness[2], eline1, 
              eline2}], 
Prolog -> 
            halfdip, 
ImageSize -> {320, 
              320}, 
PlotRange -> {{-1, 
                1}, {-1, 1}}, 
AspectRatio -> 
            Automatic];

Export["t01.wmf", g];
Export["t01.eps", g];
Export["t01.gif", g];

t=(2/8)T
(nb=1)

等高線密度計算

ez2[
          x_] = eField[0, x, 0, 
              t][[3]]  /.   t -> ((π/(c*k0))/
                  8)*2;

    Plot[x*ez2[x], {x, 0, 
        3}, 
PlotRange -> {-0.08, 
          0.08}]

FindRoot[x*ez2[x] == 0, {x, 0.5}]

FindMaximum[x*ez2[x], {x, 0.8}]

FindMinimum[x*ez2[x], {x, 1.3}]

流束(Flux)の計算

x0 = 1.4;
x1 = 1.5;
Ψs = simpi[x*Abs[ez2[x]], {x, x0, x1}, 10]

Ψ0 = 0.00075;

x0 = 0.5826842652307703`;
x1 = 0.6364915772054781`;
simpi[x*Abs[ez2[x]], {x, x0, x1}, 10]

exFL = eField[0, x, y, t][[2]]  /.  
          t -> ((π/(c*k0))/
                  8)*2;
eyFL = eField[0, x, y, t][[3]]  /.  
          t -> ((π/(c*k0))/
                  8)*2;
x0 = 0.7736177286921867`;
y0 = 0;
len = 100;
sol = 
        NDSolve[{x'[
                l] == (exFL  /. {x -> x[l], 
                    y -> y[l]}), y'[
                l] == (eyFL  /. {x -> x[l], y -> y[l]}), 
            x[0] == x0, y[0] == y0}, {x[l], y[l]}, {l, 0, 
            len}];
sol = sol[[1]];
Plot[{x[l]  /.  sol, y[l]  /.  sol}, {l, 0, 
          len}, 
PlotStyle -> {RGBColor[1, 0, 0], 
            RGBColor[0, 1, 0]}];
l0 = 
        l  /.  FindRoot[(y[l]  /.  sol) == 0, {l, 
              60}];
Print["L0=", l0];
Print["x0=", (x[l]  /.  
              sol  /.  {l -> l0})];

Clear[Ψ]

Ψ[x0_, x_] := 
        simpi[t*Abs[ez2[t]], {t, x0, x}, 10];
x0 = 0.7219970511182235`;
Plot[Ψ[x0, x], {x, x0, 
          2*x0}, 
PlotRange -> 
          All];
FindRoot[Ψ[x0, x] == Ψ0, {x, 
        x0}]

x0 = 1.2991380781886568`;
FindRoot[Ψ[x0, x] == Ψ0/2, {x, 
        x0}]

[等高線を描くためのx座標]

{{0.06115678074079843`, 
0.12967122757372704`, 
0.17798192644709632`}, 
0.21843165644489915`, 
{0.6124055537991108`, 
0.6552128262944866`, 
0.689197262649574`, 
0.7191384656388392`, 
0.7469261230459268`, 
0.7736177286921867`}, 
0.7867938021532318`, 
{0.7999699242076984`, 
0.8266656493851221`, 
0.854485502131702`, 
0.8845626344885916`, 
0.9190428584018323`, 
0.9640992216843597`}, 
1.2991380781886568`, 
{1.3118622969063776`}
}

[グラフィック]

<< ExtendGraphics`FieldLines`;
exFL = eField[0, x, y, t][[2]]  /.  
          t -> ((π/(c*k0))/
                  8)*2;
eyFL = eField[0, x, y, t][[3]]  /.  
          t -> ((π/(c*k0))/
                  8)*2;
eline1 = {{FieldLine[{x, exFL, 0.06115678074079843`}, {y, eyFL, 
                0}, {l, 1}], 
FieldLine[{x, -exFL, 
                0.06115678074079843`}, {y, -eyFL, 0}, {l, 
                1}], 
FieldLine[{x, exFL, 
                0.12967122757372704`}, {y, eyFL, 0}, {l, 
                3}], 
FieldLine[{x, -exFL, 
                0.12967122757372704`}, {y, -eyFL, 0}, {l, 
                3}], 
FieldLine[{x, exFL, 
                0.17798192644709632`}, {y, eyFL, 0}, {l, 
                5}], 
FieldLine[{x, -exFL, 
                0.17798192644709632`}, {y, -eyFL, 0}, {l, 
                5}]}, 
{FieldLine[{x, exFL, 
                0.6124055537991108`}, {y, eyFL, 0}, {l, 
                50}], 
FieldLine[{x, exFL, 
                0.6552128262944866`}, {y, eyFL, 0}, {l, 
                55}], 
FieldLine[{x, exFL, 
                0.689197262649574`}, {y, eyFL, 0}, {l, 
                60}], 
FieldLine[{x, exFL, 
                0.7191384656388392`}, {y, eyFL, 0}, {l, 
                70}], 
FieldLine[{x, exFL, 
                0.7469261230459268`}, {y, eyFL, 0}, {l, 
                85}], 
FieldLine[{x, exFL, 
                0.7736177286921867`}, {y, eyFL, 0}, {l, 
                125}]}, 
{FieldLine[{x, exFL, 
                0.7999699242076984`}, {y, eyFL, 0}, {l, 
                365}], 
FieldLine[{x, exFL, 
                0.8266656493851221`}, {y, eyFL, 0}, {l, 
                275}], 
FieldLine[{x, exFL, 
                0.854485502131702`}, {y, eyFL, 0}, {l, 
                230}], 
FieldLine[{x, exFL, 
                0.8845626344885916`}, {y, eyFL, 0}, {l, 
                200}], 
FieldLine[{x, exFL, 
                0.9190428584018323`}, {y, eyFL, 0}, {l, 
                180}], 
FieldLine[{x, exFL, 
                0.9640992216843597`}, {y, eyFL, 0}, {l, 
                165}]}, 
{FieldLine[{x, exFL, 
                1.3118622969063776`}, {y, eyFL, 0}, {l, 
                825}]}};
eline2 = {{FieldLine[{x, -exFL, -0.06115678074079843`}, {y, 
                eyFL, 0}, {l, 1}], 
FieldLine[{x, 
                exFL, -0.06115678074079843`}, {y, -eyFL, 0}, {l, 
                1}], 
FieldLine[{x, -exFL, -0.12967122757372704`}, {y, eyFL, 0}, {l, 
                3}], 
FieldLine[{x, 
                exFL, -0.12967122757372704`}, {y, -eyFL, 0}, {l, 
                3}], 
FieldLine[{x, -exFL, -0.17798192644709632`}, {y, eyFL, 0}, {l, 
                5}], 
FieldLine[{x, 
                exFL, -0.17798192644709632`}, {y, -eyFL, 0}, {l, 
                5}]}, 
{FieldLine[{x, -exFL, -0.6124055537991108`}, {y, eyFL, 0}, {l, 
                50}], 
FieldLine[{x, -exFL, -0.6552128262944866`}, {y, eyFL, 0}, {l, 
                55}], 
FieldLine[{x, -exFL, -0.689197262649574`}, {y, eyFL, 0}, {l, 
                60}], 
FieldLine[{x, -exFL, -0.7191384656388392`}, {y, eyFL, 0}, {l, 
                70}], 
FieldLine[{x, -exFL, -0.7469261230459268`}, {y, eyFL, 0}, {l, 
                85}], 
FieldLine[{x, -exFL, -0.7736177286921867`}, {y, eyFL, 0}, {l, 
                125}]}, 
{FieldLine[{x, -exFL, -0.7999699242076984`}, {y, eyFL, 0}, {l, 
                365}], 
FieldLine[{x, -exFL, -0.8266656493851221`}, {y, eyFL, 0}, {l, 
                275}], 
FieldLine[{x, -exFL, -0.854485502131702`}, {y, eyFL, 0}, {l, 
                230}], 
FieldLine[{x, -exFL, -0.8845626344885916`}, {y, eyFL, 0}, {l, 
                200}], 
FieldLine[{x, -exFL, -0.9190428584018323`}, {y, eyFL, 0}, {l, 
                180}], 
FieldLine[{x, -exFL, -0.9640992216843597`}, {y, eyFL, 0}, {l, 
                165}]}, 
{FieldLine[{x, -exFL, -1.3118622969063776`}, {y, eyFL, 0}, {l, 
                825}]}};
a = 0.01;
h = 0.47/2;
halfdip = {AbsoluteThickness[2], 
          Line[{{a, -h}, {a, h}, {-a, 
                h}, {-a, -h}, {a, -h}}]};
g = 
        Show[Graphics[{AbsoluteThickness[2], eline1, 
              eline2}], 
Prolog -> 
            halfdip, 
ImageSize -> {320, 
              320}, 
PlotRange -> {{-1, 
                1}, {-1, 1}}, 
AspectRatio -> 
            Automatic];

Export["t02.wmf", g];
Export["t02.eps", g];
Export["t02.gif", g];

t=(3/8)T
(nb=1)

等高線密度計算

ez2[
          x_] = eField[0, x, 0, 
              t][[3]]  /.   t -> ((π/(c*k0))/
                  8)*3;

    Plot[x*ez2[x], {x, 0, 
        3}, 
PlotRange -> {-0.08, 
          0.08}]

FindRoot[x*ez2[x] == 0, {x, 0.6}]

FindMaximum[x*ez2[x], {x, 0.8}]

FindMinimum[x*ez2[x], {x, 1.3}]

流束(Flux)の計算

x0 = 1.4;
x1 = 1.5;
Ψs = simpi[x*Abs[ez2[x]], {x, x0, x1}, 10]

Ψ0 = 0.00075;

x0 = 0.5826842652307703`;
x1 = 0.6364915772054781`;
simpi[x*Abs[ez2[x]], {x, x0, x1}, 10]

exFL = eField[0, x, y, t][[2]]  /.  
          t -> ((π/(c*k0))/
                  8)*3;
eyFL = eField[0, x, y, t][[3]]  /.  
          t -> ((π/(c*k0))/
                  8)*3;
x0 = 0.8383200537910853`;
y0 = 0;
len = 100;
sol = 
        NDSolve[{x'[
                l] == (exFL  /. {x -> x[l], 
                    y -> y[l]}), y'[
                l] == (eyFL  /. {x -> x[l], y -> y[l]}), 
            x[0] == x0, y[0] == y0}, {x[l], y[l]}, {l, 0, 
            len}];
sol = sol[[1]];
Plot[{x[l]  /.  sol, y[l]  /.  sol}, {l, 0, 
          len}, 
PlotStyle -> {RGBColor[1, 0, 0], 
            RGBColor[0, 1, 0]}];
l0 = 
        l  /.  FindRoot[(y[l]  /.  sol) == 0, {l, 
              70}];
Print["L0=", l0];
Print["x0=", (x[l]  /.  
              sol  /.  {l -> l0})];

Clear[Ψ]

Ψ[x0_, x_] := 
        simpi[t*Abs[ez2[t]], {t, x0, x}, 10];
x0 = 0.8513938895756793`;
Plot[Ψ[x0, x], {x, x0, 
          2*x0}, 
PlotRange -> 
          All];
FindRoot[Ψ[x0, x] == Ψ0, {x, 
        x0}]

x0 = 0.13572464102696843`;
FindRoot[Ψ[x0, x] == -Ψ0, {x, 
        x0}]

[等高線を描くためのx座標]

{{0.13572464102696843`, 
0.234107032286681`, 
0.2707339623585788`}, 
{0.6783921238861139`, 
0.7208747189687679`, 
0.7545764751522552`, 
0.7842718831353677`, 
0.8118373428490245`, 
0.8383200537910853`}, 
0.8513938895756793`, 
{0.8644677644887643`, 
0.89095379164292`, 
0.9185451348009133`, 
0.9483495468201264`, 
0.9824469846753838`, 
1.0267025411389266`}
}

[グラフィック]

<< ExtendGraphics`FieldLines`;
exFL = eField[0, x, y, t][[2]]  /.  
          t -> ((π/(c*k0))/
                  8)*3;
eyFL = eField[0, x, y, t][[3]]  /.  
          t -> ((π/(c*k0))/
                  8)*3;
eline1 = {{FieldLine[{x, exFL, 0.13572464102696843`}, {y, eyFL, 
                0}, {l, 3}], 
FieldLine[{x, -exFL, 
                0.13572464102696843`}, {y, -eyFL, 0}, {l, 
                3}], 
FieldLine[{x, exFL, 
                0.1916617521517576`}, {y, eyFL, 0}, {l, 
                3}], 
FieldLine[{x, -exFL, 
                0.1916617521517576`}, {y, -eyFL, 0}, {l, 
                3}], 
FieldLine[{x, exFL, 
                0.234107032286681`}, {y, eyFL, 0}, {l, 
                5}], 
FieldLine[{x, -exFL, 
                0.234107032286681`}, {y, -eyFL, 0}, {l, 
                5}], 
FieldLine[{x, exFL, 
                0.2707339623585788`}, {y, eyFL, 0}, {l, 
                10}], 
FieldLine[{x, -exFL, 
                0.2707339623585788`}, {y, -eyFL, 0}, {l, 
                10}]}, 
{FieldLine[{x, exFL, 
                0.6783921238861139`}, {y, eyFL, 0}, {l, 
                60}], 
FieldLine[{x, exFL, 
                0.7208747189687679`}, {y, eyFL, 0}, {l, 
                65}], 
FieldLine[{x, exFL, 
                0.7545764751522552`}, {y, eyFL, 0}, {l, 
                75}], 
FieldLine[{x, exFL, 
                0.7842718831353677`}, {y, eyFL, 0}, {l, 
                85}], 
FieldLine[{x, exFL, 
                0.8118373428490245`}, {y, eyFL, 0}, {l, 
                105}], 
FieldLine[{x, exFL, 
                0.8383200537910853`}, {y, eyFL, 0}, {l, 
                150}]}, 
{FieldLine[{x, exFL, 
                0.8644677644887643`}, {y, eyFL, 0}, {l, 
                415}], 
FieldLine[{x, exFL, 
                0.89095379164292`}, {y, eyFL, 0}, {l, 
                310}], 
FieldLine[{x, exFL, 
                0.9185451348009133`}, {y, eyFL, 0}, {l, 
                260}], 
FieldLine[{x, exFL, 
                0.9483495468201264`}, {y, eyFL, 0}, {l, 
                225}], 
FieldLine[{x, exFL, 
                0.9824469846753838`}, {y, eyFL, 0}, {l, 
                205}], 
FieldLine[{x, exFL, 
                1.0267025411389266`}, {y, eyFL, 0}, {l, 
                185}]}};
eline2 = {{FieldLine[{x, -exFL, -0.13572464102696843`}, {y, 
                eyFL, 0}, {l, 3}], 
FieldLine[{x, 
                exFL, -0.13572464102696843`}, {y, -eyFL, 0}, {l, 
                3}], 
FieldLine[{x, -exFL, -0.1916617521517576`}, {y, eyFL, 0}, {l, 
                3}], 
FieldLine[{x, 
                exFL, -0.1916617521517576`}, {y, -eyFL, 0}, {l, 
                3}], 
FieldLine[{x, -exFL, -0.234107032286681`}, {y, eyFL, 0}, {l, 
                5}], 
FieldLine[{x, 
                exFL, -0.234107032286681`}, {y, -eyFL, 0}, {l, 
                5}], 
FieldLine[{x, -exFL, -0.2707339623585788`}, {y, eyFL, 0}, {l, 
                10}], 
FieldLine[{x, 
                exFL, -0.2707339623585788`}, {y, -eyFL, 0}, {l, 
                10}]}, 
{FieldLine[{x, -exFL, -0.6783921238861139`}, {y, eyFL, 0}, {l, 
                60}], 
FieldLine[{x, -exFL, -0.7208747189687679`}, {y, eyFL, 0}, {l, 
                65}], 
FieldLine[{x, -exFL, -0.7545764751522552`}, {y, eyFL, 0}, {l, 
                75}], 
FieldLine[{x, -exFL, -0.7842718831353677`}, {y, eyFL, 0}, {l, 
                85}], 
FieldLine[{x, -exFL, -0.8118373428490245`}, {y, eyFL, 0}, {l, 
                105}], 
FieldLine[{x, -exFL, -0.8383200537910853`}, {y, eyFL, 0}, {l, 
                150}]}, 
{FieldLine[{x, -exFL, -0.8644677644887643`}, {y, eyFL, 0}, {l, 
                415}], 
FieldLine[{x, -exFL, -0.89095379164292`}, {y, eyFL, 0}, {l, 
                310}], 
FieldLine[{x, -exFL, -0.9185451348009133`}, {y, eyFL, 0}, {l, 
                260}], 
FieldLine[{x, -exFL, -0.9483495468201264`}, {y, eyFL, 0}, {l, 
                225}], 
FieldLine[{x, -exFL, -0.9824469846753838`}, {y, eyFL, 0}, {l, 
                205}], 
FieldLine[{x, -exFL, -1.0267025411389266`}, {y, eyFL, 0}, {l, 
                185}]}};
a = 0.01;
h = 0.47/2;
halfdip = {AbsoluteThickness[2], 
          Line[{{a, -h}, {a, h}, {-a, 
                h}, {-a, -h}, {a, -h}}]};
g = 
        Show[Graphics[{AbsoluteThickness[2], eline1, 
              eline2}], 
Prolog -> 
            halfdip, 
ImageSize -> {320, 
              320}, 
PlotRange -> {{-1, 
                1}, {-1, 1}}, 
AspectRatio -> 
            Automatic];

Export["t03.wmf", g];
Export["t03.eps", g];
Export["t03.gif", g];

t=(4/8)T
(nb=9)

等高線密度計算

ez2[
          x_] = eField[0, x, 0, 
              t][[3]]  /.   t -> ((π/(c*k0))/
                  8)*4;

    Plot[x*ez2[x], {x, 0, 
        3}, 
PlotRange -> {-0.08, 
          0.08}]

FindRoot[x*ez2[x] == 0, {x, 0.6}]

FindMaximum[x*ez2[x], {x, 0.9}]

FindMinimum[x*ez2[x], {x, 1.3}]

流束(Flux)の計算

x0 = 1.4;
x1 = 1.5;
Ψs = simpi[x*Abs[ez2[x]], {x, x0, x1}, 10]

Ψ0 = 0.00075;

x0 = 0.5826842652307703`;
x1 = 0.6364915772054781`;
simpi[x*Abs[ez2[x]], {x, x0, x1}, 10]

exFL = eField[0, x, y, t][[2]]  /.  
          t -> ((π/(c*k0))/
                  8)*4;
eyFL = eField[0, x, y, t][[3]]  /.  
          t -> ((π/(c*k0))/
                  8)*4;
x0 = 0.9028114889999522`;
y0 = 0;
len = 100;
sol = 
        NDSolve[{x'[
                l] == (exFL  /. {x -> x[l], 
                    y -> y[l]}), y'[
                l] == (eyFL  /. {x -> x[l], y -> y[l]}), 
            x[0] == x0, y[0] == y0}, {x[l], y[l]}, {l, 0, 
            len}];
sol = sol[[1]];
Plot[{x[l]  /.  sol, y[l]  /.  sol}, {l, 0, 
          len}, 
PlotStyle -> {RGBColor[1, 0, 0], 
            RGBColor[0, 1, 0]}];
l0 = 
        l  /.  FindRoot[(y[l]  /.  sol) == 0, {l, 
              90}];
Print["L0=", l0];
Print["x0=", (x[l]  /.  
              sol  /.  {l -> l0})];

Clear[Ψ]

Ψ[x0_, x_] := 
        simpi[t*Abs[ez2[t]], {t, x0, x}, 10];
x0 = 0.915803461439407`;
Plot[Ψ[x0, x], {x, x0, 
          2*x0}, 
PlotRange -> 
          All];
FindRoot[Ψ[x0, x] == Ψ0, {x, 
        x0}]

x0 = 0.1859375717878042`;
FindRoot[Ψ[x0, x] == -Ψ0, {x, 
        x0}]

[等高線を描くためのx座標]

{{0.1859375717878042`, 
0.2417934736585277`, 
0.2834103600697361`, 
0.31893929173597724`, 
0.3513099988432309`}, 
{0.7438990029772551`, 
0.7861284113027762`, 
0.8196073209594746`, 
0.8491076260602115`, 
0.8764958716584662`, 
0.9028114889999522`}, 
0.915803461439407`, 
{0.928795465849949`, 
0.955113790964061`, 
0.9825231492311537`, 
1.0121121949775318`, 
1.04591207193024`, 
1.0895668148547584`}
}

[グラフィック]

<< ExtendGraphics`FieldLines`;
exFL = eField[0, x, y, t][[2]]  /.  
          t -> ((π/(c*k0))/
                  8)*4;
eyFL = eField[0, x, y, t][[3]]  /.  
          t -> ((π/(c*k0))/
                  8)*4;
eline1 = {{FieldLine[{x, exFL, 0.1859375717878042`}, {y, eyFL, 
                0}, {l, 5}], 
FieldLine[{x, -exFL, 
                0.1859375717878042`}, {y, -eyFL, 0}, {l, 
                5}], 
FieldLine[{x, exFL, 
                0.2417934736585277`}, {y, eyFL, 0}, {l, 
                10}], 
FieldLine[{x, -exFL, 
                0.2417934736585277`}, {y, -eyFL, 0}, {l, 
                10}], 
FieldLine[{x, exFL, 
                0.2834103600697361`}, {y, eyFL, 0}, {l, 
                10}], 
FieldLine[{x, -exFL, 
                0.2834103600697361`}, {y, -eyFL, 0}, {l, 
                10}], 
FieldLine[{x, exFL, 
                0.31893929173597724`}, {y, eyFL, 0}, {l, 
                10}], 
FieldLine[{x, -exFL, 
                0.31893929173597724`}, {y, -eyFL, 0}, {l, 
                10}], 
FieldLine[{x, exFL, 
                0.3513099988432309`}, {y, eyFL, 0}, {l, 
                15}], 
FieldLine[{x, -exFL, 
                0.3513099988432309`}, {y, -eyFL, 0}, {l, 
                15}]}, 
{FieldLine[{x, exFL, 
                0.7438990029772551`}, {y, eyFL, 0}, {l, 
                130}], 
FieldLine[{x, exFL, 
                0.7861284113027762`}, {y, eyFL, 0}, {l, 
                140}], 
FieldLine[{x, exFL, 
                0.8196073209594746`}, {y, eyFL, 0}, {l, 
                160}], 
FieldLine[{x, exFL, 
                0.8491076260602115`}, {y, eyFL, 0}, {l, 
                180}], 
FieldLine[{x, exFL, 
                0.8764958716584662`}, {y, eyFL, 0}, {l, 
                215}], 
FieldLine[{x, exFL, 
                0.9028114889999522`}, {y, eyFL, 0}, {l, 
                305}]}, 
{FieldLine[{x, exFL, 
                0.928795465849949`}, {y, eyFL, 0}, {l, 
                840}], 
FieldLine[{x, exFL, 
                0.955113790964061`}, {y, eyFL, 0}, {l, 
                620}], 
FieldLine[{x, exFL, 
                0.9825231492311537`}, {y, eyFL, 0}, {l, 
                515}], 
FieldLine[{x, exFL, 
                1.0121121949775318`}, {y, eyFL, 0}, {l, 
                450}], 
FieldLine[{x, exFL, 
                1.04591207193024`}, {y, eyFL, 0}, {l, 
                405}]}};
eline2 = {{FieldLine[{x, -exFL, -0.1859375717878042`}, {y, 
                eyFL, 0}, {l, 5}], 
FieldLine[{x, 
                exFL, -0.1859375717878042`}, {y, -eyFL, 0}, {l, 
                5}], 
FieldLine[{x, -exFL, -0.2417934736585277`}, {y, eyFL, 0}, {l, 
                10}], 
FieldLine[{x, 
                exFL, -0.2417934736585277`}, {y, -eyFL, 0}, {l, 
                10}], 
FieldLine[{x, -exFL, -0.2834103600697361`}, {y, eyFL, 0}, {l, 
                10}], 
FieldLine[{x, 
                exFL, -0.2834103600697361`}, {y, -eyFL, 0}, {l, 
                10}], 
FieldLine[{x, -exFL, -0.31893929173597724`}, {y, eyFL, 0}, {l, 
                10}], 
FieldLine[{x, 
                exFL, -0.31893929173597724`}, {y, -eyFL, 0}, {l, 
                10}], 
FieldLine[{x, -exFL, -0.3513099988432309`}, {y, eyFL, 0}, {l, 
                15}], 
FieldLine[{x, 
                exFL, -0.3513099988432309`}, {y, -eyFL, 0}, {l, 
                15}]}, 
{FieldLine[{x, -exFL, -0.7438990029772551`}, {y, eyFL, 0}, {l, 
                130}], 
FieldLine[{x, -exFL, -0.7861284113027762`}, {y, eyFL, 0}, {l, 
                140}], 
FieldLine[{x, -exFL, -0.8196073209594746`}, {y, eyFL, 0}, {l, 
                160}], 
FieldLine[{x, -exFL, -0.8491076260602115`}, {y, eyFL, 0}, {l, 
                180}], 
FieldLine[{x, -exFL, -0.8764958716584662`}, {y, eyFL, 0}, {l, 
                215}], 
FieldLine[{x, -exFL, -0.9028114889999522`}, {y, eyFL, 0}, {l, 
                
                305}]}, 
{FieldLine[{x, -exFL, -0.928795465849949`}, {y, eyFL, 0}, {l, 
                840}], 
FieldLine[{x, -exFL, -0.955113790964061`}, {y, eyFL, 0}, {l, 
                620}], 
FieldLine[{x, -exFL, -0.9825231492311537`}, {y, eyFL, 0}, {l, 
                515}], 
FieldLine[{x, -exFL, -1.0121121949775318`}, {y, eyFL, 0}, {l, 
                450}], 
FieldLine[{x, -exFL, -1.04591207193024`}, {y, eyFL, 0}, {l, 
                405}]}};
a = 0.01;
h = 0.47/2;
halfdip = {AbsoluteThickness[2], 
          Line[{{a, -h}, {a, h}, {-a, 
                h}, {-a, -h}, {a, -h}}]};
g = 
        Show[Graphics[{AbsoluteThickness[2], eline1, 
              eline2}], 
Prolog -> 
            halfdip, 
ImageSize -> {320, 
              320}, 
PlotRange -> {{-1, 
                1}, {-1, 1}}, 
AspectRatio -> 
            Automatic];

Export["t04.wmf", g];
Export["t04.eps", g];
Export["t04.gif", g];

t=(5/8)T
(nb=5)

等高線密度計算

ez2[
          x_] = eField[0, x, 0, 
              t][[3]]  /.   t -> ((π/(c*k0))/
                  8)*5;

    Plot[x*ez2[x], {x, 0, 
        3}, 
PlotRange -> {-0.08, 
          0.08}]

FindRoot[x*ez2[x] == 0, {x, 0.2}]

FindMaximum[x*ez2[x], {x, 1.0}]

FindMinimum[x*ez2[x], {x, 1.3}]

流束(Flux)の計算

x0 = 1.4;
x1 = 1.5;
Ψs = simpi[x*Abs[ez2[x]], {x, x0, x1}, 10]

Ψ0 = 0.00075;

x0 = 0.5826842652307703`;
x1 = 0.6364915772054781`;
simpi[x*Abs[ez2[x]], {x, x0, x1}, 10]

exFL = eField[0, x, y, t][[2]]  /.  
          t -> ((π/(c*k0))/
                  8)*5;
eyFL = eField[0, x, y, t][[3]]  /.  
          t -> ((π/(c*k0))/
                  8)*5;
x0 = 0.9671115560662016`;
y0 = 0;
len = 150;
sol = 
        NDSolve[{x'[
                l] == (exFL  /. {x -> x[l], 
                    y -> y[l]}), y'[
                l] == (eyFL  /. {x -> x[l], y -> y[l]}), 
            x[0] == x0, y[0] == y0}, {x[l], y[l]}, {l, 0, 
            len}];
sol = sol[[1]];
Plot[{x[l]  /.  sol, y[l]  /.  sol}, {l, 0, 
          len}, 
PlotStyle -> {RGBColor[1, 0, 0], 
            RGBColor[0, 1, 0]}];
l0 = 
        l  /.  FindRoot[(y[l]  /.  sol) == 0, {l, 
              102}];
Print["L0=", l0];
Print["x0=", (x[l]  /.  
              sol  /.  {l -> l0})];

Clear[Ψ]

Ψ[x0_, x_] := 
        simpi[t*Abs[ez2[t]], {t, x0, x}, 10];
x0 = 0.9800369126432644`;
Plot[Ψ[x0, x], {x, x0, 
          2*x0}, 
PlotRange -> 
          All];
FindRoot[Ψ[x0, x] == Ψ0, {x, 
        x0}]

x0 = 0.281698732221587`;
FindRoot[Ψ[x0, x] == -Ψ0, {x, 
        x0}]

[等高線を描くためのx座標]

{{0.20989296612761177`, 
0.281698732221587`, 
0.32681679924102236`, 
0.36344651080340645`, 
0.3959107104663872`, 
0.42613598422305926`}, 
{0.8090192248804211`, 
0.8510453815484973`, 
0.8843448161545355`, 
0.9136873432847202`, 
0.9409318044030743`, 
0.9671115560662016`}, 
0.9800369126432644`, 
{0.9929622956293792`, 
1.0191442859045643`, 
1.0464061893327259`, 
1.0758219206818582`, 
1.1093853924804813`}
}

[グラフィック]

<< ExtendGraphics`FieldLines`;
exFL = eField[0, x, y, t][[2]]  /.  
          t -> ((π/(c*k0))/
                  8)*5;
eyFL = eField[0, x, y, t][[3]]  /.  
          t -> ((π/(c*k0))/
                  8)*5;
eline1 = {{FieldLine[{x, exFL, 0.20989296612761177`}, {y, eyFL, 
                0}, {l, 10}], 
FieldLine[{x, -exFL, 
                0.20989296612761177`}, {y, -eyFL, 0}, {l, 
                10}], 
FieldLine[{x, exFL, 
                0.281698732221587`}, {y, eyFL, 0}, {l, 
                10}], 
FieldLine[{x, -exFL, 
                0.281698732221587`}, {y, -eyFL, 0}, {l, 
                10}], 
FieldLine[{x, exFL, 
                0.32681679924102236`}, {y, eyFL, 0}, {l, 
                10}], 
FieldLine[{x, -exFL, 
                0.32681679924102236`}, {y, -eyFL, 0}, {l, 
                10}], 
FieldLine[{x, exFL, 
                0.36344651080340645`}, {y, eyFL, 0}, {l, 
                15}], 
FieldLine[{x, -exFL, 
                0.36344651080340645`}, {y, -eyFL, 0}, {l, 
                15}], 
FieldLine[{x, exFL, 
                0.3959107104663872`}, {y, eyFL, 0}, {l, 
                15}], 
FieldLine[{x, -exFL, 
                0.3959107104663872`}, {y, -eyFL, 0}, {l, 
                15}], 
FieldLine[{x, exFL, 
                0.42613598422305926`}, {y, eyFL, 0}, {l, 
                25}], 
FieldLine[{x, -exFL, 
                0.42613598422305926`}, {y, -eyFL, 0}, {l, 
                25}]}, 
{FieldLine[{x, exFL, 
                0.8090192248804211`}, {y, eyFL, 0}, {l, 
                140}], 
FieldLine[{x, exFL, 
                0.8510453815484973`}, {y, eyFL, 0}, {l, 
                155}], 
FieldLine[{x, exFL, 
                0.8843448161545355`}, {y, eyFL, 0}, {l, 
                175}], 
FieldLine[{x, exFL, 
                0.9136873432847202`}, {y, eyFL, 0}, {l, 
                200}], 
FieldLine[{x, exFL, 
                0.9409318044030743`}, {y, eyFL, 0}, {l, 
                240}], 
FieldLine[{x, exFL, 
                0.9671115560662016`}, {y, eyFL, 0}, {l, 
                330}]}, 
{FieldLine[{x, exFL, 
                0.9929622956293792`}, {y, eyFL, 0}, {l, 
                870}], 
FieldLine[{x, exFL, 
                1.0191442859045643`}, {y, eyFL, 0}, {l, 
                640}], 
FieldLine[{x, exFL, 
                1.0464061893327259`}, {y, eyFL, 0}, {l, 
                530}], 
FieldLine[{x, exFL, 
                1.0758219206818582`}, {y, eyFL, 0}, {l, 
                465}]}};
eline2 = {{FieldLine[{x, -exFL, -0.20989296612761177`}, {y, 
                eyFL, 0}, {l, 10}], 
FieldLine[{x, 
                exFL, -0.20989296612761177`}, {y, -eyFL, 0}, {l, 
                10}], 
FieldLine[{x, -exFL, -0.281698732221587`}, {y, eyFL, 0}, {l, 
                10}], 
FieldLine[{x, 
                exFL, -0.281698732221587`}, {y, -eyFL, 0}, {l, 
                10}], 
FieldLine[{x, -exFL, -0.32681679924102236`}, {y, eyFL, 0}, {l, 
                10}], 
FieldLine[{x, 
                exFL, -0.32681679924102236`}, {y, -eyFL, 0}, {l, 
                10}], 
FieldLine[{x, -exFL, -0.36344651080340645`}, {y, eyFL, 0}, {l, 
                15}], 
FieldLine[{x, 
                exFL, -0.36344651080340645`}, {y, -eyFL, 0}, {l, 
                15}], 
FieldLine[{x, -exFL, -0.3959107104663872`}, {y, eyFL, 0}, {l, 
                15}], 
FieldLine[{x, 
                exFL, -0.3959107104663872`}, {y, -eyFL, 0}, {l, 
                15}], 
FieldLine[{x, -exFL, -0.42613598422305926`}, {y, eyFL, 0}, {l, 
                25}], 
FieldLine[{x, 
                exFL, -0.42613598422305926`}, {y, -eyFL, 0}, {l, 
                25}]}, 
{FieldLine[{x, -exFL, -0.8090192248804211`}, {y, eyFL, 0}, {l, 
                140}], 
FieldLine[{x, -exFL, -0.8510453815484973`}, {y, eyFL, 0}, {l, 
                155}], 
FieldLine[{x, -exFL, -0.8843448161545355`}, {y, eyFL, 0}, {l, 
                
                175}], 
FieldLine[{x, -exFL, -0.9136873432847202`}, {y, eyFL, 0}, {l, 
                200}], 
FieldLine[{x, -exFL, -0.9409318044030743`}, {y, eyFL, 0}, {l, 
                240}], 
FieldLine[{x, -exFL, -0.9671115560662016`}, {y, eyFL, 0}, {l, 
                330}]}, 
{FieldLine[{x, -exFL, -0.9929622956293792`}, {y, eyFL, 0}, {l, 
                870}], 
FieldLine[{x, -exFL, -1.0191442859045643`}, {y, eyFL, 0}, {l, 
                640}], 
FieldLine[{x, -exFL, -1.0464061893327259`}, {y, eyFL, 0}, {l, 
                530}], 
FieldLine[{x, -exFL, -1.0758219206818582`}, {y, eyFL, 0}, {l, 
                465}]}};
a = 0.01;
h = 0.47/2;
halfdip = {AbsoluteThickness[2], 
          Line[{{a, -h}, {a, h}, {-a, 
                h}, {-a, -h}, {a, -h}}]};
g = 
        Show[Graphics[{AbsoluteThickness[2], eline1, 
              eline2}], 
Prolog -> 
            halfdip, 
ImageSize -> {320, 
              320}, 
PlotRange -> {{-1, 
                1}, {-1, 1}}, 
AspectRatio -> 
            Automatic];

Export["t05.wmf", g];
Export["t05.eps", g];
Export["t05.gif", g];

t=(6/8)T

等高線密度計算

ez2[
          x_] = eField[0, x, 0, 
              t][[3]]  /.   t -> ((π/(c*k0))/
                  8)*6;

    Plot[x*ez2[x], {x, 0, 
        3}, 
PlotRange -> {-0.08, 
          0.08}]

FindRoot[x*ez2[x] == 0, {x, 0.8}]

FindMaximum[x*ez2[x], {x, 1.0}]

FindMinimum[x*ez2[x], {x, 1.3}]

流束(Flux)の計算

x0 = 1.4;
x1 = 1.5;
Ψs = simpi[x*Abs[ez2[x]], {x, x0, x1}, 10]

Ψ0 = 0.00075;

x0 = 0.5826842652307703`;
x1 = 0.6364915772054781`;
simpi[x*Abs[ez2[x]], {x, x0, x1}, 10]

exFL = eField[0, x, y, t][[2]]  /.  
          t -> ((π/(c*k0))/
                  8)*6;
eyFL = eField[0, x, y, t][[3]]  /.  
          t -> ((π/(c*k0))/
                  8)*6;
x0 = 1.0312408881294233`;
y0 = 0;
len = 150;
sol = 
        NDSolve[{x'[
                l] == (exFL  /. {x -> x[l], 
                    y -> y[l]}), y'[
                l] == (eyFL  /. {x -> x[l], y -> y[l]}), 
            x[0] == x0, y[0] == y0}, {x[l], y[l]}, {l, 0, 
            len}];
sol = sol[[1]];
Plot[{x[l]  /.  sol, y[l]  /.  sol}, {l, 0, 
          len}, 
PlotStyle -> {RGBColor[1, 0, 0], 
            RGBColor[0, 1, 0]}];
l0 = 
        l  /.  FindRoot[(y[l]  /.  sol) == 0, {l, 
              120}];
Print["L0=", l0];
Print["x0=", (x[l]  /.  
              sol  /.  {l -> l0})];

exFL = eField[0, x, y, t][[2]]  /.  
          t -> ((π/(c*k0))/
                  8)*6;
eyFL = eField[0, x, y, t][[3]]  /.  
          t -> ((π/(c*k0))/
                  8)*6;
x0 = 0.40382230019475546`;
y0 = 0;
len = 8.5;
sol = 
        NDSolve[{x'[
                l] == (exFL  /. {x -> x[l], 
                    y -> y[l]}), y'[
                l] == (eyFL  /. {x -> x[l], y -> y[l]}), 
            x[0] == x0, y[0] == y0}, {x[l], y[l]}, {l, 0, 
            len}];
sol = sol[[1]];
Plot[{x[l]  /.  sol, y[l]  /.  sol}, {l, 0, 
          len}, 
PlotStyle -> {RGBColor[1, 0, 0], 
            RGBColor[0, 1, 0]}];
l0 = 
        l  /.  FindRoot[(x[l]  /.  sol) == a, {l, 
              8}];
Print["L0=", l0];
Print["x0=", (x[l]  /.  
              sol  /.  {l -> l0})];

Clear[Ψ]

Ψ[x0_, x_] := 
        simpi[t*Abs[ez2[t]], {t, x0, x}, 10];
x0 = 1.0441112727644746`;
Plot[Ψ[x0, x], {x, x0, 
          2*x0}, 
PlotRange -> 
          All];
FindRoot[Ψ[x0, x] == Ψ0, {x, 
        x0}]

x0 = 0.3631202219199129`;
FindRoot[Ψ[x0, x] == -Ψ0, {x, 
        x0}]

[等高線を描くためのx座標]

{{0.3050619552007216`, 
0.3631202219199129`, 
0.40382230019475546`, 
0.43795344089521815`, 
0.46872131242078496`, 
0.4976792832813825`}, 
{0.8738226418580488`, 
0.9156818942348413`, 
0.9488342117100557`, 
0.9780471182314086`, 
1.0051731871444414`, 
1.0312408881294233`}, 
1.0441112727644746`, 
{1.0569816795157008`, 
1.0830512525902467`, 
1.11019189742578`, 
1.1394659030402003`}
}

[グラフィック]

<< ExtendGraphics`FieldLines`;
exFL = eField[0, x, y, t][[2]]  /.  
          t -> ((π/(c*k0))/
                  8)*6;
eyFL = eField[0, x, y, t][[3]]  /.  
          t -> ((π/(c*k0))/
                  8)*6;
eline1 = {{FieldLine[{x, exFL, 0.3050619552007216`}, {y, eyFL, 
                0}, {l, 16}], 
            FieldLine[{x, exFL, 0.3631202219199129`}, {y, eyFL, 0}, {l, 
                10}], 
FieldLine[{x, -exFL, 
                0.3631202219199129`}, {y, -eyFL, 0}, {l, 
                10}], 
FieldLine[{x, exFL, 
                0.40382230019475546`}, {y, eyFL, 0}, {l, 
                10}], 
FieldLine[{x, -exFL, 
                0.40382230019475546`}, {y, -eyFL, 0}, {l, 
                10}], 
FieldLine[{x, exFL, 
                0.43795344089521815`}, {y, eyFL, 0}, {l, 
                10}], 
FieldLine[{x, -exFL, 
                0.43795344089521815`}, {y, -eyFL, 0}, {l, 
                10}], 
FieldLine[{x, exFL, 
                0.46872131242078496`}, {y, eyFL, 0}, {l, 
                15}], 
FieldLine[{x, -exFL, 
                0.46872131242078496`}, {y, -eyFL, 0}, {l, 
                15}], 
FieldLine[{x, exFL, 
                0.4976792832813825`}, {y, eyFL, 0}, {l, 
                20}], 
FieldLine[{x, -exFL, 
                0.4976792832813825`}, {y, -eyFL, 0}, {l, 
                20}]}, 
{FieldLine[{x, exFL, 
                0.8738226418580488`}, {y, eyFL, 0}, {l, 
                100}], 
FieldLine[{x, exFL, 
                0.9156818942348413`}, {y, eyFL, 0}, {l, 
                110}], 
FieldLine[{x, exFL, 
                0.9488342117100557`}, {y, eyFL, 0}, {l, 
                120}], 
FieldLine[{x, exFL, 
                0.9780471182314086`}, {y, eyFL, 0}, {l, 
                140}], 
FieldLine[{x, exFL, 
                1.0051731871444414`}, {y, eyFL, 0}, {l, 
                170}], 
FieldLine[{x, exFL, 
                1.0312408881294233`}, {y, eyFL, 0}, {l, 
                240}]}, 
{FieldLine[{x, exFL, 
                1.0569816795157008`}, {y, eyFL, 0}, {l, 
                575}], 
FieldLine[{x, exFL, 
                1.0830512525902467`}, {y, eyFL, 0}, {l, 
                420}], 
FieldLine[{x, exFL, 
                1.11019189742578`}, {y, eyFL, 0}, {l, 
                350}], 
FieldLine[{x, exFL, 
                1.1394659030402003`}, {y, eyFL, 0}, {l, 
                310}]}};
eline2 = {{FieldLine[{x, -exFL, -0.3050619552007216`}, {y, 
                eyFL, 0}, {l, 16}], 
            FieldLine[{x, -exFL, -0.3631202219199129`}, {y, eyFL, 
                0}, {l, 10}], 
FieldLine[{x, 
                exFL, -0.3631202219199129`}, {y, -eyFL, 0}, {l, 
                10}], 
FieldLine[{x, -exFL, -0.40382230019475546`}, {y, eyFL, 0}, {l, 
                10}], 
FieldLine[{x, 
                exFL, -0.40382230019475546`}, {y, -eyFL, 0}, {l, 
                10}], 
FieldLine[{x, -exFL, -0.43795344089521815`}, {y, eyFL, 0}, {l, 
                10}], 
FieldLine[{x, 
                exFL, -0.43795344089521815`}, {y, -eyFL, 0}, {l, 
                10}], 
FieldLine[{x, -exFL, -0.46872131242078496`}, {y, eyFL, 0}, {l, 
                15}], 
FieldLine[{x, 
                exFL, -0.46872131242078496`}, {y, -eyFL, 0}, {l, 
                15}], 
FieldLine[{x, -exFL, -0.4976792832813825`}, {y, eyFL, 0}, {l, 
                20}], 
FieldLine[{x, 
                exFL, -0.4976792832813825`}, {y, -eyFL, 0}, {l, 
                20}]}, 
{FieldLine[{x, -exFL, -0.8738226418580488`}, {y, eyFL, 0}, {l, 
                100}], 
FieldLine[{x, -exFL, -0.9156818942348413`}, {y, eyFL, 0}, {l, 
                110}], 
FieldLine[{x, -exFL, -0.9488342117100557`}, {y, eyFL, 0}, {l, 
                120}], 
FieldLine[{x, -exFL, -0.9780471182314086`}, {y, eyFL, 0}, {l, 
                140}], 
FieldLine[{x, -exFL, -1.0051731871444414`}, {y, eyFL, 0}, {l, 
                170}], 
FieldLine[{x, -exFL, -1.0312408881294233`}, {y, eyFL, 0}, {l, 
                240}]}, 
{FieldLine[{x, -exFL, -1.0569816795157008`}, {y, eyFL, 0}, {l, 
                575}], 
FieldLine[{x, -exFL, -1.0830512525902467`}, {y, eyFL, 0}, {l, 
                420}], 
FieldLine[{x, -exFL, -1.11019189742578`}, {y, eyFL, 0}, {l, 
                350}], 
FieldLine[{x, -exFL, -1.1394659030402003`}, {y, eyFL, 0}, {l, 
                310}]}};
a = 0.01;
h = 0.47/2;
halfdip = {AbsoluteThickness[2], 
          Line[{{a, -h}, {a, h}, {-a, 
                h}, {-a, -h}, {a, -h}}]};
g = 
        Show[Graphics[{AbsoluteThickness[2], eline1, 
              eline2}], 
Prolog -> 
            halfdip, 
ImageSize -> {320, 
              320}, 
PlotRange -> {{-1, 
                1}, {-1, 1}}, 
AspectRatio -> 
            Automatic];

Export["t06.wmf", g];
Export["t06.eps", g];
Export["t06.gif", g];

t=(7/8)T

等高線密度計算

ez2[
          x_] = eField[0, x, 0, 
              t][[3]]  /.   t -> ((π/(c*k0))/
                  8)*7;

    Plot[x*ez2[x], {x, 0, 
        3}, 
PlotRange -> {-0.08, 
          0.08}]

FindRoot[x*ez2[x] == 0, {x, 0.3}]

FindMaximum[x*ez2[x], {x, 1.1}]

FindMinimum[x*ez2[x], {x, 1.3}]

流束(Flux)の計算

x0 = 1.4;
x1 = 1.5;
Ψs = simpi[x*Abs[ez2[x]], {x, x0, x1}, 10]

Ψ0 = 0.00075;

x0 = 0.5826842652307703`;
x1 = 0.6364915772054781`;
simpi[x*Abs[ez2[x]], {x, x0, x1}, 10]

exFL = eField[0, x, y, t][[2]]  /.  
          t -> ((π/(c*k0))/
                  8)*7;
eyFL = eField[0, x, y, t][[3]]  /.  
          t -> ((π/(c*k0))/
                  8)*7;
x0 = 1.0952190541955742`;
y0 = 0;
len = 200;
sol = 
        NDSolve[{x'[
                l] == (exFL  /. {x -> x[l], 
                    y -> y[l]}), y'[
                l] == (eyFL  /. {x -> x[l], y -> y[l]}), 
            x[0] == x0, y[0] == y0}, {x[l], y[l]}, {l, 0, 
            len}];
sol = sol[[1]];
Plot[{x[l]  /.  sol, y[l]  /.  sol}, {l, 0, 
          len}, 
PlotStyle -> {RGBColor[1, 0, 0], 
            RGBColor[0, 1, 0]}];
l0 = 
        l  /.  FindRoot[(y[l]  /.  sol) == 0, {l, 
              140}];
Print["L0=", l0];
Print["x0=", (x[l]  /.  
              sol  /.  {l -> l0})];

Clear[Ψ]

Ψ[x0_, x_] := 
        simpi[t*Abs[ez2[t]], {t, x0, x}, 10];
x0 = 1.1080435175804098`;
Plot[Ψ[x0, x], {x, x0, 
          2*x0}, 
PlotRange -> 
          All];
FindRoot[Ψ[x0, x] == Ψ0, {x, 
        x0}]

x0 = 0.3859706023177428`;
FindRoot[Ψ[x0, x] == -Ψ0, {x, 
        x0}]

[等高線を描くためのx座標]

{{0.3859706023177428`, 
0.43831948618662137`, 
0.476638699168679`, 
0.5092931075299`, 
0.5390017388914187`, 
0.5671365359081395`}, 
{0.938362947929332`, 
0.9800826713694001`, 
1.0131126049228643`, 
1.042217578554968`, 
1.0692449120602296`, 
1.0952190541955742`}, 
1.1080435175804098`, 
{1.1208679996375586`, 
1.1468437228482247`, 
1.173883360560203`}
}

[グラフィック]

<< ExtendGraphics`FieldLines`;
exFL = eField[0, x, y, t][[2]]  /.  
          t -> ((π/(c*k0))/
                  8)*7;
eyFL = eField[0, x, y, t][[3]]  /.  
          t -> ((π/(c*k0))/
                  8)*7;
eline1 = {{FieldLine[{x, exFL, 0.3859706023177428`}, {y, eyFL, 
                0}, {l, 22}]}};
a = 0.01;
h = 0.47/2;
halfdip = {AbsoluteThickness[1], 
          Line[{{a, -h}, {a, h}, {-a, 
                h}, {-a, -h}, {a, -h}}]};
g = 
        Show[Graphics[{AbsoluteThickness[1], 
              eline1}], 
Prolog -> 
            halfdip, 
ImageSize -> {320, 
              320}, 
PlotRange -> {{-1, 
                2}, {-1, 1}}, 
AspectRatio -> 
            Automatic];

<< ExtendGraphics`FieldLines`;
exFL = eField[0, x, y, t][[2]]  /.  
          t -> ((π/(c*k0))/
                  8)*7;
eyFL = eField[0, x, y, t][[3]]  /.  
          t -> ((π/(c*k0))/
                  8)*7;
eline1 = {{FieldLine[{x, exFL, 0.3859706023177428`}, {y, eyFL, 
                0}, {l, 22}], 
FieldLine[{x, exFL, 
                0.43831948618662137`}, {y, eyFL, 0}, {l, 
                25}], 
FieldLine[{x, exFL, 
                0.476638699168679`}, {y, eyFL, 0}, {l, 
                25}], 
FieldLine[{x, -exFL, 
                0.476638699168679`}, {y, -eyFL, 0}, {l, 
                25}], 
FieldLine[{x, exFL, 
                0.5092931075299`}, {y, eyFL, 0}, {l, 
                15}], 
FieldLine[{x, -exFL, 
                0.5092931075299`}, {y, -eyFL, 0}, {l, 
                15}], 
FieldLine[{x, exFL, 
                0.5390017388914187`}, {y, eyFL, 0}, {l, 
                20}], 
FieldLine[{x, -exFL, 
                0.5390017388914187`}, {y, -eyFL, 0}, {l, 
                20}], 
FieldLine[{x, exFL, 
                0.5671365359081395`}, {y, eyFL, 0}, {l, 
                30}], 
FieldLine[{x, -exFL, 
                0.5671365359081395`}, {y, -eyFL, 0}, {l, 
                30}]}, 
{FieldLine[{x, exFL, 
                0.938362947929332`}, {y, eyFL, 0}, {l, 
                115}], 
FieldLine[{x, exFL, 
                0.9800826713694001`}, {y, eyFL, 0}, {l, 
                125}], 
FieldLine[{x, exFL, 
                1.0131126049228643`}, {y, eyFL, 0}, {l, 
                140}], 
FieldLine[{x, exFL, 
                1.042217578554968`}, {y, eyFL, 0}, {l, 
                160}], 
FieldLine[{x, exFL, 
                1.0692449120602296`}, {y, eyFL, 0}, {l, 
                195}], 
FieldLine[{x, exFL, 
                1.0952190541955742`}, {y, eyFL, 0}, {l, 
                275}]}, 
{FieldLine[{x, exFL, 
                1.1208679996375586`}, {y, eyFL, 0}, {l, 
                635}], 
FieldLine[{x, exFL, 
                1.1468437228482247`}, {y, eyFL, 0}, {l, 
                465}], 
FieldLine[{x, exFL, 
                1.173883360560203`}, {y, eyFL, 0}, {l, 
                385}]}};
eline2 = {{FieldLine[{x, -exFL, -0.3859706023177428`}, {y, 
                eyFL, 0}, {l, 
                22}], 
FieldLine[{x, -exFL, -0.43831948618662137`}, {y, eyFL, 0}, {l, 
                25}], 
FieldLine[{x, -exFL, -0.476638699168679`}, {y, eyFL, 0}, {l, 
                25}], 
FieldLine[{x, 
                exFL, -0.476638699168679`}, {y, -eyFL, 0}, {l, 
                25}], 
FieldLine[{x, -exFL, -0.5092931075299`}, {y, eyFL, 0}, {l, 
                15}], 
FieldLine[{x, 
                exFL, -0.5092931075299`}, {y, -eyFL, 0}, {l, 
                15}], 
FieldLine[{x, -exFL, -0.5390017388914187`}, {y, eyFL, 0}, {l, 
                20}], 
FieldLine[{x, 
                exFL, -0.5390017388914187`}, {y, -eyFL, 0}, {l, 
                20}], 
FieldLine[{x, -exFL, -0.5671365359081395`}, {y, eyFL, 0}, {l, 
                30}], 
FieldLine[{x, 
                exFL, -0.5671365359081395`}, {y, -eyFL, 0}, {l, 
                30}]}, 
{FieldLine[{x, -exFL, -0.938362947929332`}, {y, eyFL, 0}, {l, 
                115}], 
FieldLine[{x, -exFL, -0.9800826713694001`}, {y, eyFL, 0}, {l, 
                125}], 
FieldLine[{x, -exFL, -1.0131126049228643`}, {y, eyFL, 0}, {l, 
                140}], 
FieldLine[{x, -exFL, -1.042217578554968`}, {y, eyFL, 0}, {l, 
                160}], 
FieldLine[{x, -exFL, -1.0692449120602296`}, {y, eyFL, 0}, {l, 
                195}], 
FieldLine[{x, -exFL, -1.0952190541955742`}, {y, eyFL, 0}, {l, 
                275}]}, 
{FieldLine[{x, -exFL, -1.1208679996375586`}, {y, eyFL, 0}, {l, 
                635}], 
FieldLine[{x, -exFL, -1.1468437228482247`}, {y, eyFL, 0}, {l, 
                465}], 
FieldLine[{x, -exFL, -1.173883360560203`}, {y, eyFL, 0}, {l, 
                385}]}};
a = 0.01;
h = 0.47/2;
halfdip = {AbsoluteThickness[2], 
          Line[{{a, -h}, {a, h}, {-a, 
                h}, {-a, -h}, {a, -h}}]};
g = 
        Show[Graphics[{AbsoluteThickness[2], eline1, 
              eline2}], 
Prolog -> 
            halfdip, 
ImageSize -> {320, 
              320}, 
PlotRange -> {{-1, 
                1}, {-1, 1}}, 
AspectRatio -> 
            Automatic];

Export["t07.wmf", g];
Export["t07.eps", g];
Export["t07.gif", g];

時間発展

z0 = 120. *π;
sol = 
      NDSolve[{R'[T] == 
            2*(z0*ethetaSumSpherical[R[T]/k0, θ[T], 0. , T/ω]*
                    hphiSumSpherical[R[T]/k0, θ[T], 0. , 
                      T/ω])/(ethetaSumSpherical[R[T]/k0, θ[T], 0. , T/ω]^2 + 
                    erSumSpherical[R[T]/k0, θ[T], 0. , T/ω]^2 + (((z0*hphiSumSpherical[R[T]/k0, θ[T], 0. , T/ω]))^2)), θ'[T] == -(2/(R[T]))*(z0*
                    erSumSpherical[R[T]/k0, θ[T], 0. , T/ω]*
                    hphiSumSpherical[R[T]/k0, θ[T], 0. , 
                      T/ω])/(ethetaSumSpherical[R[T]/k0, θ[T], 0. , T/ω]^2 + 
                    erSumSpherical[R[T]/k0, θ[T], 0. , T/ω]^2 + (((z0*hphiSumSpherical[R[T]/k0, θ[T], 0. , T/ω]))^2)), 
          R[0] == 
            k0*1.1065414794678605`, θ[0] == π/2}, {R[
            T], θ[T]}, {T, 0, ω}]

Plot[
        R[T]/k0  /.  sol[[1]], {T, 
          0, ω}, 
PlotRange -> 
          All];
Plot[θ[T]  /.  sol[[1]], {T, 
        0, ω}, 
PlotRange -> All]