Wolfram Cloud Document

Introduction

3D astrolabe construction: stereographic projection of alt-azimuth coordinates, ecliptic path, and stars and the creation of a movie flying around the graphics model

Notes

◼

i) The above figure shows the geometry of the stereographic projection employed in this program. A sphere of raduis 1/2 is used and its center is at (0,0,1/2) and the projection plane is at z=1.

◼

ii) RotationTransform[θ,w,p] gives a 3D rotation around the axis w={1,0,0} anchored at the point p={0,0,1/2}.

◼

iii) Huntsville, AL Latitude=34.7300° N, Longitude= 86.5850° W.

◼

iv) The definition of the ecliptic in terms of the X,Y,Z coordinate system is such that the x-axis passes the spring and autumn equinoxes when the
Sun is at noon at the summer/winter solstice. However as the hours of the day increase ecliptic asending node changes rotates wrt to the celestial axis. The position of the Sun on the ecliptic changes as the days changes.

◼

v) In the astrolabe stereographic project, the Alt-Azimuth coordinate system remain fixed, hence the celestial coordinate system rotates about the celestial axis, i.e., the north celestial pole which has fixed alt-azimuth coordinate for a fixed latitude.

In[]:=

sdi=.1;(*toreduceoverallsizesfromthe0.5spheretoamuchsmallersphereandfigure*)

In[]:=

LongitudeZero=Line[Table[{0,sdi.5Sin[iDegree],sdi.5Cos[iDegree]+.5},{i,0.,360.,2.}]];LongitudeNinety=Line[Table[{sdi.5Sin[iDegree],0.,sdi.5Cos[iDegree]+.5},{i,0.,360.,2.}]];LatitudeZero=Line[Table[{sdi.5Sin[iDegree],sdi.5Cos[iDegree],.5},{i,0.,360.,2.}]];Axisline={Arrowheads[0.008],Arrow[Tube[{{0,0,.5},{0,0,0.5+sdi1.0}},.0005]]};

xc1=0.;yc1=0.;zc1=6.3;(*location(-6.3)ofthesoleofthefootforthemanwrtoriginhencethecenterpointneedstobemovedupbythisamount*)sc1=sdi.02;(*Scalingfactor*)cpt1={xc1,yc1,sc1zc1};(*centerofmanwithheightscaledbysc1*)θ=34.73;(*latitudeofobserver(e.g.Huntsville,AL*)(*rotationfortheequatorupwards*)Manmodel[cpt_,sc_]:={Gray,Cylinder[{sc{0,0,-1}+cpt,sc{0,0,1}+cpt},sc.85],(*MidSection*)Cylinder[{sc{1.4,0.3,-1.5}+cpt,sc{1.2,0,1}+cpt},sc.2],Cylinder[{sc{-1.4,-0.3,-1.5}+cpt,sc{-1.2,0,1}+cpt},sc.2],(*arms*)Sphere[sc{0,0,1.2}+cpt,sc1],Sphere[sc{0,0,2.8}+cpt,sc0.7],Sphere[sc{1.2,0,1.2}+cpt,sc0.3],Sphere[sc{-1.2,0,1.2}+cpt,sc0.3],Sphere[sc{0,-.7,2.7}+cpt,sc0.2],(*HeadandShoulder*)Sphere[sc{0,0,2.5}+cpt,sc0.5],Sphere[sc{0,0,-1.5}+cpt,sc1.2],(*Cuboid[{-1.,-1.,-2},{1.,1.,-1}],*)Cylinder[{sc{0.5,0,-6}+cpt,sc{0.8,0,-1}+cpt},sc.4],Cylinder[{sc{-0.5,0,-6}+cpt,sc{-0.8,0,-1}+cpt},sc.4],(*Legs*),Cylinder[{sc{0.5,0.2,-6}+cpt,sc{0.5,-1.,-6}+cpt},sc.3],Cylinder[{sc{-0.5,0.2,-6}+cpt,sc{-0.5,-1.,-6}+cpt},sc.3](*Feet*),Cylinder[{sc{0,0,-6.3}+cpt,sc{0,0,-6.34}+cpt},sdi.1]};man2=GeometricTransformation[{Opacity[8.],Red,Manmodel[cpt1,1sc1]},Composition@@{TranslationTransform[{0,sdi0.5Cos[θDegree],sdi0.5Sin[θDegree]+.5}],RotationTransform[-90Degree+θDegree,{1,0,0},{0.,0.,0.}{0,0.0Cos[θDegree],0.0Sin[θDegree]+.5}]}];(*rotatearoundx-axisatapoint*)ManonEarth={Thick,Red,Axisline,Opacity[.5],Blue,Sphere[{0,0,0.5},sdi0.5],Red,Sphere[{0,0,0.5},sdi.025],Opacity[.1],man2,Thick,Red,LongitudeZero,LongitudeNinety,LatitudeZero};(*Graphics3D[ManonEarth]*)

In[]:=

EclipticAngle=23.+26/60.+2.406/3600.;(*Sun'seclipticanglewrttothecelestial-equatorialplane*)

In[]:=

(*ndays=DayCount[{2000,1,1},{2016,1,21}](*Dayssince1Jan2000*)*)

In[]:=

FirstdaysofMonth=Table[DayCount[{2016,1,1},{2016,i,1}],{i,1,12}]+1(*FirstdaysofmonthascountedfromJan1*)

Out[]=

{1,32,61,92,122,153,183,214,245,275,306,336}

In[]:=

(*VernalEquinox={2016,3,20};04:31UT*)(*DatePlus[{2016,1,1},2]*)

In[]:=

EclipticLongitude[doy_]:=Module[{},doy1=doy-1;doydate=DatePlus[{2016,1,1},doy1];ndays=DayCount[{2000,1,1},doydate];(*dayssincenoonof2000Jan1*);MeanLongitude=280.460+0.9856474ndays;MeanAnomaly=357.528+0.9856003ndays;EclipticLong=MeanLongitude+1.915Sin[MeanAnomalyDegree]+0.020Sin[2.MeanAnomalyDegree](*Ofthesun*);EL=FractionalPart[EclipticLong/360.]*360.;EL](*indegrees*)(*https://en.wikipedia.org/wiki/Position_of_the_Sun*)

In[]:=

TableofLongs=Table[EclipticLongitude[i],{i,1,365}];

In[]:=

TableofFirstLong=Table[EclipticLongitude[FirstdaysofMonth[[i]]],{i,1,12}]

Out[]=

{280.494,312.052,341.338,12.1919,41.5425,71.4213,100.077,129.664,159.478,188.74,219.498,249.73}

In[]:=

tf=RotationTransform[(-90.Degree+θDegree),{1.,0.,0.},{0.,0.,1./2}];(*Rotateaboutx-axisaboutpoint(0,0,.5)*)

In[]:=

tfecliptic=RotationTransform[23Degree,{1.,0.,0.},{0.,0.,1./2}];(*Rotateaboutx-axisaboutpoint(0,0,.5)*)

In[]:=

projxyz[{a_,b_,c_}]:={a/c,b/c,1};(*Providesthestereographicprojectionofpointsonthespheretopointsontheflatplainaz=1*)

In[]:=

llzero=Line[{{0,0,0},{0,Tan[((90.-θ)/2.)Degree],1}}];

In[]:=

llninety=Line[{{0,0,0},{0,Tan[((-θ)/2.)Degree],1}}];

In[]:=

SolarLong=TableofLongs[[dayx]];

In[]:=

(*pointer={RGBColor[218,165,32],{Polygon[{{0.0,0.0,1.02},{r01Cos[beta1Degree],r01Sin[beta1Degree],1.02},{r02Cos[beta2Degree],r02Sin[beta2Degree],1.02},{r03Cos[beta3Degree],r03Sin[beta3Degree],1.02},{0.0,0.0,1.02}}],Polygon[{{0.0,0.0,1.02},{r01Cos[beta11Degree],r01Sin[beta11Degree],1.02},{r02Cos[beta22Degree],r02Sin[beta22Degree],1.02},{r03Cos[beta33Degree],r03Sin[beta33Degree],1.02},{0.0,0.0,1.02}}],Cylinder[{{0.,0.,1.0},{0.,0.,1.021}},r03]}};*)

In[]:=

pointerf[t_]:=Module[{beta11f=30.},If[1.<=t<=45.,beta1f=beta11f];If[45.<t<=50.,beta1f=beta11f+(0.-beta11f)*(t-45.)/(50.-45.)];beta2f=beta1f-5.;beta3f=beta1f-90.;r01f=1.6;r02f=1.45;deltabetaf=5.0;r03f=r02fSin[deltabetafDegree];beta11f=beta1f+180.;beta22f=beta2f+180;beta33f=beta3f+180.;ee={RGBColor[218,165,32],{Polygon[{{0.0,0.0,1.02},{r01Cos[beta1fDegree],r01fSin[beta1fDegree],1.02},{r02Cos[beta2fDegree],r02fSin[beta2fDegree],1.02},{r03Cos[beta3fDegree],r03fSin[beta3fDegree],1.02},{0.0,0.0,1.02}}],Polygon[{{0.0,0.0,1.02},{r01fCos[beta11fDegree],r01fSin[beta11fDegree],1.02},{r02fCos[beta22fDegree],r02fSin[beta22fDegree],1.02},{r03fCos[beta33fDegree],r03fSin[beta33fDegree],1.02},{0.0,0.0,1.02}}],Cylinder[{{0.,0.,1.0},{0.,0.,1.021}},r03f]}};ee]

END OF PROGRAM