(* Functions *)
diplines[p_,x_,y_,z_]:=p*z/(x^2+y^2+z^2)^(3/2)
phiB[Rc_,z_,M_]:=M*Rc^2/(Rc^2+z^2)^1.5
emf[Rc_,z_,M_,v_]:=M*Rc^2*z/(Rc^2+z^2)^2.5*v
Iind[Rc_,z_,M_,v_]:=M*z*Rc/(Rc^2+z^2)^2.5*v
Fin[Rc_,z_,M_,v_]:=M^2*Rc^3*z^2/(Rc^2+z^2)^5*v
k[Rc_,M_,λ_]:=1.5^3*M^2/Rc^3*(1-1/λ^3)
ZD[t_,Rc_,M_,λ_]:=Hc/2-1/k[Rc,M,λ]^2*(k[Rc,M,λ]*t-1+Exp[-k[Rc,M,λ]*t])
ZDlin[t_,Rc_,M_,λ_]:=Hc/2-1/k[Rc,M,λ]^2*(k[Rc,M,λ]*t-1)

(* Velocity Normalized to Terminal Velocity *)
vD[t_,Rc_,M_,λ_]:=(1-Exp[-k[Rc,M,λ]*t])
Tmax[Rc_,M_,λ_]:=Hc*k[Rc,M,λ]+1/k[Rc,M,λ]

(* Dipole Lines *)
C1=ContourPlot[diplines[10.,z,0,x],{x,0.001,5},{z,-5,5},MaxRecursion->3,Contours->10,ContourStyle->Directive[{Thickness[.005]}],Axes->False,ContourShading->{None},PlotRange->{{-5,5},{-5,5}},Frame->None,Background->None];
C2 = ContourPlot[diplines[1.,z,0,x],{x,-0.001,-5},{z,-5,5},MaxRecursion->3,Contours->10,ContourStyle->Directive[{Thickness[.005]}],ContourShading->{None},Axes->False, PlotRange->{{-5,5},{-5,5}},Frame->None,Background->None];
dipplot=Show[C1,C2];

(* Tube Specifications *)
Rc=1;Hc=20;Rd=0.6;Hd=2.;
xlim=10;
opM =Opacity[0.7];
z1=5;z2=0;z3=-5;
Fmax=3;

(* Applet Using Manipulate *)

MM=Manipulate[
Grid[
{
{

Graphics[
{
(* Tube Inner *)
{LightGray,Rectangle[{-Rc,-Hc/2},{Rc,Hc/2}]},
{LightGray,Ellipsoid[{0,-Hc/2},{Rc,.1Rc}]},
{LightGray,Ellipsoid[{0,+Hc/2},{Rc,.1Rc}]},

(* Rings on Inner Tube, Back *)
Table[{Gray,Thickness[0.05/2/xlim],Circle[{0,z},{Rc,.1Rc},{0,Pi}]},{z,-Hc/2,Hc/2,Hc/10}],

(* Test Rings, Back *)
If[chR==True,
{
{Darker[Red],Thickness[0.05/2/xlim],Circle[{0,z1},{Rc,.1Rc},{0,Pi}]},
{Darker[Green],Thickness[0.05/2/xlim],Circle[{0,z2},{Rc,.1Rc},{0,Pi}]},
{Darker[Blue],Thickness[0.05/2/xlim],Circle[{0,z3},{Rc,.1Rc},{0,Pi}]}
},
{}

],


(* Force Arrows on Test Rings *)
If[chF==True,
{
{If[Abs[ZD[t,Rc,M,λ]-z1]<3,Arrowheads[0.025],Arrowheads[0.0]],Darker[Red],Arrow[{{0,z1},{0,z1+Fmax*Fin[2,ZD[t,Rc,M,λ]-z1,19.6,1.]}}]},
{If[Abs[ZD[t,Rc,M,λ]-z2]<3,Arrowheads[0.025],Arrowheads[0.0]],Darker[Green],Arrow[{{0,z2},{0,z2+Fmax*Fin[2,ZD[t,Rc,M,λ]-z2,19.6,1.]}}]},
{If[Abs[ZD[t,Rc,M,λ]-z3]<3,Arrowheads[0.025],Arrowheads[0.0]],Darker[Blue],Arrow[{{0,z3},{0,z3+Fmax*Fin[2,ZD[t,Rc,M,λ]-z3,19.6,1.]}}]},
},
{}
],

(* Dipole Magnet Top *)
{LightRed,opM,Ellipsoid[{0,+Hd/2+ZD[t,Rc,M,λ]},{Rd,.1Rd}]},
{Black,Thickness[0.025/2/xlim],Circle[{0,Hd/2+ZD[t,Rc,M,λ]},{Rd,.1Rd},{0,Pi}]},

(* Dipole Field Lines *)
Inset[C1,{0,ZD[t,Rc,M,λ]},{0,0},{1/M*8,Automatic}],
Inset[C2,{0,ZD[t,Rc,M,λ]},{0,0},{1/M*8,Automatic}],



(* Dipole Magnet *)
{LightRed,opM,Rectangle[{-Rd,-Hd/2+ZD[t,Rc,M,λ]},{Rd,Hd/2+ZD[t,Rc,M,λ]}]},
{LightRed,opM,Ellipsoid[{0,-Hd/2+ZD[t,Rc,M,λ]},{Rd,.1Rd}]},
{LightBlue,opM,Ellipsoid[{0,0+ZD[t,Rc,M,λ]},{Rd,.1Rd}]},
{LightBlue,opM,Rectangle[{-Rd,0+ZD[t,Rc,M,λ]},{Rd,Hd/2+ZD[t,Rc,M,λ]}]},
{Black,Thickness[0.025/2/xlim],Circle[{0,Hd/2+ZD[t,Rc,M,λ]},{Rd,.1Rd},{Pi,2Pi}]},
{Black,Thickness[0.025/2/xlim],Circle[{0,0+ZD[t,Rc,M,λ]},{Rd,.1Rd},{Pi,2Pi}]},
{Black,Thickness[0.025/2/xlim],Circle[{0,-Hd/2+ZD[t,Rc,M,λ]},{Rd,.1Rd},{Pi,2Pi}]},

(* Rings on Inner Tube, Front *)
Table[{Gray,Thickness[0.05/2/xlim],Circle[{0,z},{Rc,.1Rc},{Pi,2Pi}]},{z,-Hc/2,Hc/2,Hc/10}],

(* Test Rings, Front *)
If[chR==True,
{
{Darker[Red],Thickness[0.05/2/xlim],Circle[{0,z1},{Rc,.1Rc},{Pi,2Pi}]},
{Darker[Green],Thickness[0.05/2/xlim],Circle[{0,z2},{Rc,.1Rc},{Pi,2Pi}]},
{Darker[Blue],Thickness[0.05/2/xlim],Circle[{0,z3},{Rc,.1Rc},{Pi,2Pi}]}
},
{}
],



(* Arrow on Test Rings *)
If[chI==True,
{{
Arrowheads[0.025],Darker[Red],
If[
Iind[1.,ZD[t,Rc,M,λ]-z1,2.5,1.]>0,
Arrow[{{-0.5*Rc,z1-0.1Rc},{0.5*Rc,z1-0.1Rc}}],Arrow[{{0.5*Rc,z1-0.1Rc},{-0.5Rc,z1-0.1Rc}}]
]
},
{
Arrowheads[0.025],Darker[Green],
If[
Iind[1.,ZD[t,Rc,M,λ]-z2,2.5,1.]>0,
Arrow[{{-0.5*Rc,z2-0.1Rc},{0.5*Rc,z2-0.1Rc}}],Arrow[{{0.5*Rc,z2-0.1Rc},{-0.5Rc,z2-0.1Rc}}]
]
},
{
Arrowheads[0.025],Darker[Blue],
If[
Iind[1.,ZD[t,Rc,M,λ]-z3,2.5,1.]>0,
Arrow[{{-0.5*Rc,z3-0.1Rc},{0.5*Rc,z3-0.1Rc}}],Arrow[{{0.5*Rc,z3-0.1Rc},{-0.5Rc,z3-0.1Rc}}]
]
}},
{}
],

},
PlotRange->{{-xlim,xlim},{-1.*Hc/2,1.5*Hc/2}},ImageSize->{600,900}
]
,SpanFromLeft,

(* Plot EMF, Flux, Current *)
If[ch=="ℰ (EMF)",
Plot[emf[Rc,z,M,vD[t,Rc,M,λ]],{z,-10,10},PlotStyle->{LightGray},ImageSize->{500,300},ImagePadding->{{60,60},{60,60}},Frame->True,FrameLabel->{"(Subscript[z, d])-(Subscript[z, r])","ℰ (a.u.)"},PlotRangePadding->None,PlotRange->{{-10,10},{-0.6,0.6}},
Epilog->{
{Darker[Red],PointSize@Large,Point[{ZD[t,Rc,M,λ]-z1,emf[Rc,ZD[t,Rc,M,λ]-z1,M,vD[t,Rc,M,λ]]}]},
{Darker[Green],PointSize@Large,Point[{ZD[t,Rc,M,λ]-z2,emf[Rc,ZD[t,Rc,M,λ]-z2,M,vD[t,Rc,M,λ]]}]},
{Darker[Blue],PointSize@Large,Point[{ZD[t,Rc,M,λ]-z3,emf[Rc,ZD[t,Rc,M,λ]-z3,M,vD[t,Rc,M,λ]]}]}
},
PlotLegends->{Placed[PointLegend[{Darker[Red],PointSize@Large},{"red ring"}],{0.15,0.9}],Placed[PointLegend[{Darker[Green],PointSize@Large},{"green ring"}],{0.45,0.9}],Placed[PointLegend[{Darker[Blue],PointSize@Large},{"blue ring"}],{0.75,0.9}]}
]
,
If[ch=="(Subscript[Φ, B]) (Flux)",
Plot[phiB[Rc,z,M],{z,-10,10},PlotStyle->{LightGray},ImageSize->{500,300},ImagePadding->{{60,60},{60,60}},Frame->True,FrameLabel->{"(Subscript[z, d])-(Subscript[z, r])","(Subscript[Φ, B]) (a.u.)"},PlotRangePadding->None,PlotRange->{{-10,10},{-0.25,2.25}},
Epilog->{
{Darker[Red],PointSize@Large,Point[{ZD[t,Rc,M,λ]-z1,phiB[Rc,ZD[t,Rc,M,λ]-z1,M]}]},
{Darker[Green],PointSize@Large,Point[{ZD[t,Rc,M,λ]-z2,phiB[Rc,ZD[t,Rc,M,λ]-z2,M]}]},
{Darker[Blue],PointSize@Large,Point[{ZD[t,Rc,M,λ]-z3,phiB[Rc,ZD[t,Rc,M,λ]-z3,M]}]}
},
PlotLegends->{Placed[PointLegend[{Darker[Red],PointSize@Large},{"red ring"}],{0.15,0.9}],Placed[PointLegend[{Darker[Green],PointSize@Large},{"green ring"}],{0.45,0.9}],Placed[PointLegend[{Darker[Blue],PointSize@Large},{"blue ring"}],{0.75,0.9}]}
],
If[ch=="Ι (Current)",
Plot[Iind[Rc,z,M,vD[t,Rc,M,λ]],{z,-10,10},PlotStyle->{LightGray},ImageSize->{500,300},ImagePadding->{{60,60},{60,60}},Frame->True,FrameLabel->{"(Subscript[z, d])-(Subscript[z, r])","Ι (a.u.)"},PlotRangePadding->None,PlotRange->{{-10,10},{-1,1}},
Epilog->{
{Darker[Red],PointSize@Large,Point[{ZD[t,Rc,M,λ]-z1,Iind[Rc,ZD[t,Rc,M,λ]-z1,M,vD[t,Rc,M,λ]]}]},
{Darker[Green],PointSize@Large,Point[{ZD[t,Rc,M,λ]-z2,Iind[Rc,ZD[t,Rc,M,λ]-z2,M,vD[t,Rc,M,λ]]}]},
{Darker[Blue],PointSize@Large,Point[{ZD[t,Rc,M,λ]-z3,Iind[Rc,ZD[t,Rc,M,λ]-z3,M,vD[t,Rc,M,λ]]}]}
},
PlotLegends->{Placed[PointLegend[{Darker[Red],PointSize@Large},{"red ring"}],{0.15,0.9}],Placed[PointLegend[{Darker[Green],PointSize@Large},{"green ring"}],{0.45,0.9}],Placed[PointLegend[{Darker[Blue],PointSize@Large},{"blue ring"}],{0.75,0.9}]}
],
Plot[1,{x,-5,5}]
]
]]
},
{SpanFromAbove,SpanFromBoth,
Plot[Fin[Rc,z,M,vD[t,Rc,M,λ]],{z,-10,10},ImageSize->{500,300},PlotStyle->{LightGray},ImagePadding->{{60,60},{60,60}},Frame->True,FrameLabel->{"(Subscript[z, d])-(Subscript[z, r])","(Subscript[F, ring]) (a.u.)"},PlotRangePadding->None,PlotRange->{{-10,10},{-0.1,0.4}},
Epilog->{
{Darker[Red],PointSize@Large,Point[{ZD[t,Rc,M,λ]-z1,Fin[Rc,ZD[t,Rc,M,λ]-z1,M,vD[t,Rc,M,λ]]}]},
{Darker[Green],PointSize@Large,Point[{ZD[t,Rc,M,λ]-z2,Fin[Rc,ZD[t,Rc,M,λ]-z2,M,vD[t,Rc,M,λ]]}]},
{Darker[Blue],PointSize@Large,Point[{ZD[t,Rc,M,λ]-z3,Fin[Rc,ZD[t,Rc,M,λ]-z3,M,vD[t,Rc,M,λ]]}]}
},
PlotLegends->{Placed[PointLegend[{Darker[Red],PointSize@Large},{"red ring"}],{0.15,0.9}],Placed[PointLegend[{Darker[Green],PointSize@Large},{"green ring"}],{0.45,0.9}],Placed[PointLegend[{Darker[Blue],PointSize@Large},{"blue ring"}],{0.75,0.9}]}
]
},
{SpanFromAbove,SpanFromBoth,
Plot[{ZD[tt,Rc,M,λ],ZDlin[tt,Rc,M,λ]},{tt,0,Tmax[Rc,M,λ]},ImageSize->{500,300},PlotStyle->{{LightGray},{LightGray,Dotted}},PlotRange->{{0,Tmax[Rc,M,λ]},{-Hc/2,Hc/2}},ImagePadding->{{60,60},{60,60}},Frame->True,FrameLabel->{"time t","vertical position (Subscript[z, d])"},PlotRangePadding->None,
Epilog->{
{Darker[Gray],PointSize@Large,Point[{t,ZD[t,Rc,M,λ]}]}
}
]
}
},
Frame->None,Spacings->{0,0},Alignment->{Left,Top}],

(* Magnet Characteristics *)
Style["Magnet Characteristics",12],
Spacer[{0,10}],
{{M,1,"M"},1,2},
Delimiter,
Spacer[{0,10}],

(* Cylinder Characteristics *)
Style["Cylinder Characteristics",12],
Spacer[{0,10}],
{{Rc,1,"(Subscript[R, c])"},1,2},
{λ,1.01,1.1},
Delimiter,
Spacer[{0,10}],

(* Plotting Options *)
Style["Plotting Options",12],
Spacer[{0,10}],
{{ch,"(Subscript[Φ, B]) (Flux)","Plot"},{"(Subscript[Φ, B]) (Flux)","ℰ (EMF)","Ι (Current)"},ControlType->PopupMenu},
Delimiter,
Spacer[{0,10}],
Style["Test Rings",12],
Spacer[{0,10}],
Row[{Control[{{chR,True,"Rings"},{True,False}}],Control[{{chI,True,"Current"},{True,False}}],Control[{{chF,True,"Force"},{True,False}}]},Spacer[10]],
Delimiter,
Spacer[{0,10}],
Style["Time Evolution",12],
Spacer[{0,10}],
{t,0,Tmax[Rc,M,λ]},
ControlPlacement->Left,
SaveDefinitions->True,
Bookmarks->{
"frame2":>(M=1.;Rc=1.;λ=1.01;ch="Ι (Current)";chR=True;chI=True;chF=True;t=0),
"frame3":>(M=1.;Rc=1.;λ=1.01;ch="Ι (Current)";chR=True;chI=True;chF=True;t=Tmax[1.,1.,1.01])
}
]