Cartographiez le passage du Nord-Ouest à l'aide de la modélisation géomagnétique : Nouveautés de Wolfram Language 11

Cartographiez le passage du Nord-Ouest à l'aide de la modélisation géomagnétique

Le passage du Nord-Ouest est une route maritime longeant la côte de l'Amérique du Nord et reliant le nord de l'océan Atlantique au Pacifique. Il a été découvert en 1850 et a été emprunté pour la première fois par l'explorateur Roald Amundsen en 1903-1906. La navigation dans le passage du Nord-Ouest à l'aide d'un compas magnétique traditionnel est difficile en raison des grandes différences entre le nord magnétique et le nord géographique aux hautes latitudes. Cet exemple permet de cartographier le passage du Nord-Ouest en utilisant GeomagneticModelData pour renvoyer les données actuelles du champ magnétique de la Terre.

Commencez par une liste de paires latitude-longitude décrivant le passage du Nord-Ouest et obtenez la position du nord géomagnétique.

In[1]:=

course = GeoPosition[{{60.7, -56}, {67.7, -58.5}, {74, -74.4}, {74.4, \
-91.8}, {74.3, -95.9}, {74.2, -98.5}, {73.7, -113.5}, {73.08, \
-116.86}, {72.57, -118.9}, {71.29, -119.9}, {70.7, -124.3}, {70.83, \
-128.4}, {69.85, -139.6}, {70.44, -143.1}, {71.6, -156.5}, {70.4, \
-163.2}, {68.9, -167.3}, {65.7, -168.5}, {62.3, -167.9}}];

In[2]:=

geomagneticNorthLocation = 
 GeomagneticModelData["NorthGeomagneticPole"]

Out[2]=

In[3]:=

GeoGraphics[{
  {Red, PointSize[Large], Point[geomagneticNorthLocation]},
  Line[course]}]

Out[3]=

Définissez une fonction permettant de tracer la direction du pôle nord géomagnétique (en rouge) et la lecture de la boussole locale (en bleu).

In[4]:=

bearings[point_] := Module[{
   d1,
   d2,
   distance = Quantity[400, "Kilometers"],
   h1 = GeoDirection[point, geomagneticNorthLocation],
   h2 = GeomagneticModelData[point, "Declination"]
   },
  {d1, d2} = 
   GeoDestination[point, GeoDisplacement[{distance, #}]] & /@ {h1, h2};
  {Red, Arrow[{GeoPosition@point, d1}], Blue, 
   Arrow[{GeoPosition@point, d2}]}
  ]

Choisissez un ensemble de points d'échantillonnage raisonnablement bien espacés, calculez et observez visuellement les différences entre les relèvements vrais (en rouge) et magnétiques (en bleu) le long du passage.

In[5]:=

samplepoints = course[[All, {2, 3, 4, 7, 11, 13, 15, 17, 19}]];

In[6]:=

GeomagneticModelData[#, "Declination"] & /@ Thread[samplepoints]

Out[6]=

In[7]:=

GeoGraphics[{{Red, PointSize[Large], Point[geomagneticNorthLocation]},
   Line[course],
  bearings /@ samplepoints[[1]]}, GeoRange -> Quantity[1000, "Miles"]]

Out[7]=