Budeme používat sférické souřadnice a příslušné bázové vektory

Na úvod spočteme rotaci vektorvého pole a ukážeme jak jej transformovat do kartézské báze:

sour = {r, θ,ϕ}

A1 = {0,0,B0/2 r Sin[θ]}  (* vekt. potenciál homogenního pole *)

B1 = Curl[ A1, sour, "Spherical"] (* musíme specifikovat, že nejde o kartézské souřadnice*)

j1 = Curl[ B1, sour, "Spherical"]//Simplify

TransformedField["Spherical"->"Cartesian",B1,sour->{x,y,z}]//Simplify

Úloha:

Ukažte, že rovnice 
Δ (OverVector[A]) = κ(r) (OverVector[A])
přejde na ODR pro (OverVector[A]) = f(r) sin(θ) (Subscript[(OverVector[e]), ϕ])

A2 = {0,0,f[r] Sin[θ]}

Div[ A2, sour, "Spherical"]

Laplacian[ A2, sour, "Spherical"]-κ[r]A2//Simplify

odr2 = (-f[r] (2+r^2  κ[r])+r (2 f'[r]+r f''[r]))==0

Nalezněte takové κ(r) aby bylo možno nalézt analytické řešení připouštějící homogenní magnetické pole v nekonečnu

DSolve[ odr2, f[r], r]  (*obecně to nepůjde*)

κ[r]-> κ0 /r^4 (*musíme zvolit konkrétní průběh κ[r]*)
reseni = DSolve[ odr2/.%, f[r], r][[1,1,2]]
Simplify[ %/.κ0->-I *L^2,Assumptions->L>0]

Series[ reseni/. (C[1])->0,{r, Infinity,1}]

(*Položili jsme  (C[1])->0 aby řešení v počátku bylo konečné
ještě si to oveříme obrázkem  *)
Plot[ Abs[ reseni]/. (C[1])->0 /.(C[2])->1/.κ0->-I  ,{r,1*^-3,1}]

Spočteme C[2] tak aby v nekone4nu bylo pole (Subscript[B, 0])

B0/2 r ==Series[ reseni/.C[1]->0,{r, Infinity,0}]//Normal
vyslednef = reseni /.Solve[%,C[2]][[1]]/.C[1]->0

Ukažte, že siločáry uvažovaného magnetického pole jsou isočáry funkce (r^l) (sin^k)θ (Subscript[A, ϕ]) pro vhodná k,l

A3 = {0,0,Aϕ[r,θ]}
B3 = Curl[%,sour,"Spherical"]

isfoFce = r^l Sin[θ]^k Aϕ[r,θ]/.{k->1,l->1}
Grad[%,sour,"Spherical"]
B3.%//Simplify

nakreslete magnetické pole pro
 κ[r]-> κ0 /r^4
Z rozměrových důvodů volíme
 κ0->-i *L^2
 (-i má původ v časové derivaci v rovnici difuze)

A4 = {0,0,f[r] Sin[θ]}/.f[r]->vyslednef
B4 = Curl[%,sour,"Spherical"]//Simplify

B4a = Simplify[ B4/.κ0->-I *L^2,Assumptions->L>0]

B4b = TransformedField["Spherical"->"Cartesian",B4a,sour->{x,y,z}]/.y->0//Simplify

param={B0->1,L->8};
Re[B4b][[{1,3}]]/.param
StreamPlot[ %, {x,-6,6},{z,-6,6}]

A4
A4[[3]] r Sin[θ]/.κ0->-I *L^2
A4b = TransformedField["Spherical"->"Cartesian",%,sour->{x,y,z}]/.y->0//Simplify

param={B0->1,L->12};
Re[A4b]/.param
ContourPlot[ %, {x,-6,6},{z,-6,6},ContourShading->None,Contours->Table[Sign[q]q^2,{q,-4.1,4,0.2}],PlotPoints->50]

param={B0->1,L->12};
frames = Table[ 
A4c = Re[A4b Exp[I t]]/.param;
Rasterize[ContourPlot[A4c, {x,-6,6},{z,-6,6},ContourShading->None,Contours->Table[Sign[q]q^2,{q,-4.1,4,0.2}],PlotPoints->50],RasterSize->1000],{t,0,2Pi,2Pi/40}];
ListAnimate[frames]

param={B0->1,L->4};
frames = Table[ 
A4c = Re[A4b Exp[I t]]/.param;
Rasterize[ContourPlot[A4c, {x,-6,6},{z,-6,6},ContourShading->None,Contours->Table[Sign[q]q^2,{q,-4.1,4,0.2}],PlotPoints->50],RasterSize->1000],{t,0,2Pi,2Pi/40}];
ListAnimate[frames]

param={B0->1,L->6};

frames2= Table[ 
B4c = Re[B4b Exp[I t]][[{1,3}]]/.param;
Rasterize[StreamPlot[ B4c, {x,-6,6},{z,-6,6}],RasterSize->1000],{t,0,2Pi,2Pi/40}];
ListAnimate[frames2]