In[]:=
(*EstimatedMomentsofInertia*)ρ=8050;(*DensityofSteel*)a1=0.004;(*RadiusofSmallRod(m)*)c1=.05;(*LengthofSmallRod(m)*)a2=.0075;(*RadiusofLargeRod(m)*)c2=.1;(*LengthofLargeRod(m)*)m1=ρπc1a1^2;(*Massofthesmallrod(kg)*)m2=(.1)ρπc2a2^2;(*MassofthelargeRod(kg);Theobjectisapproximatedashollowbymakinglessdensethanthesmallrod*)μ=(a2^2c2)/(a1^2c1);(*CenterofMassoftheT-Handle*)Irod1={{1/12m1(3a1^2+4c1^2),0,0},{0,1/12m1(3a1^2+4c1^2),0},{0,0,1/2m1a1^2}};Irod2={{1/12m2(3a2^2+4c2^2),0,0},{0,1/2m2a2^2,0},{0,0,1/12m2(3a2^2+4c2^2)}};h1={{(μ(c1+2a2)/(2(1+μ)))^2,0,0},{0,(μ(c1+2a2)/(2(1+μ)))^2,0},{0,0,0}};h2={{((c1+2a2)/(2(1+μ)))^2,0,0},{0,((c1+2a2)/(2(1+μ)))^2,0},{0,0,0}};InertiaMatrix=MatrixForm[(Irod1+m1h1)+(Irod2+m2h2)](*InertiaMatrixofT-handle*)
Out[]//MatrixForm=
0.0000811717 | 0. | 0. |
0. | 0.0000339534 | 0. |
0. | 0. | 0.0000477803 |
In[]:=
(*RigidBodyParameters*)I1=InertiaMatrix[[1,1,1]];I2=InertiaMatrix[[1,2,2]];I3=InertiaMatrix[[1,3,3]];(*InitialConditions*)θ0=π/180;L=.0024;ω20=LSin[θ0]/I2;ω30=LCos[θ0]/I3;(*~50Rad/s,estimatedfromtheT-handlevideo*)T=1/2(I2ω20^2+I3ω30^2);(*Constants*)k=ω30Sqrt[(I3(I1-I3))/(I2(I1-I2)ω20^2+I3(I1-I3)ω30^2)];A=ω30Sqrt[(I3(I3-I2))/(I2(I1-I2))];b=Sqrt[((I3-I2)(I2(I1-I2)ω20^2+I3(I1-I3)ω30^2))/(I1I2I3)];(*BodyFrameSolutions*)ω1[t_]:=AJacobiCN[bt+EllipticK[k],k];ω2[t_]:=(ω20/Sqrt[1-k^2])JacobiDN[bt+EllipticK[k],k];ω3[t_]:=ω30JacobiSN[bt+EllipticK[k],k];(*PeriodofEllipticFunctions*)τ=4EllipticK[k]/b;(*TimeDependantRotationAngles*)θ[t_]:=ArcCos[I3ω3[t]/L]//N;ψ[t_]:=ArcTan[I1ω1[t],I2ω2[t]]//N;ϕ[t_]:=Lt/I3+((L^2-2I3T)EllipticPi[(ω30^2I3^2)/L^2,JacobiAmplitude[bt,k],k])/(bLI3)//N;
In[]:=
(*NumericalTabulationofAngles*)θψϕ=Table[{θ[t],ψ[t],ϕ[t]},{t,0,7.3,.007}];RRfromθψϕ[{θ_,ψ_,ϕ_}]:=Transpose[{{Cos@ψCos@ϕ-Cos@θSin@ϕSin@ψ,-Sin@ψCos@ϕ-Cos@θSin@ϕCos@ψ,Sin@θSin@ϕ},{Sin@ϕCos@ψ+Cos@θSin@ψCos@ϕ,-Sin@ψSin@ϕ+Cos@θCos@ϕCos@ψ,-Sin@θCos@ϕ},{Sin@θSin@ψ,Sin@θCos@ψ,Cos@θ}}];RR=RRfromθψϕ/@θψϕ;
In[]:=
(*Simultaion*)Simulation=Animate[Graphics3D[{LightGray,Specularity[White,20],Cylinder[{-(.6)*RR〚n,1〛,(.6)*RR〚n,1〛},.20],LightGray,Specularity[White,20],Cylinder[{{0,0,0},(.65)*RR〚n,3〛},.10],Red,Arrow@Tube@{{0,0,0},RR〚n,1〛},(*Line[RR〚1;;n,1〛],*)Green,Arrow@Tube@{{0,0,0},RR〚n,2〛},(*Line[RR〚1;;n,2〛],*)Blue,Arrow@Tube@{{0,0,0},RR〚n,3〛},Line[RR〚1;;n,3〛]},PlotRange1],{n,1,1040,1},AnimationRunningFalse,AnimationRate3]
Out[]=
