Faça um gráfico da Passagem do Noroeste com modelagem geomagnétia: Novos Recursos do Wolfram Language 11

Faça um gráfico da Passagem do Noroeste com modelagem geomagnétia

A Passagem do Noroeste é uma rota marítima ao longo da costa da América do Norte que liga o norte dos oceanos Atlântico e Pacífico. Foi descoberto em 1850 e navegado pela primeira vez pelo explorador Roald Amundsen em 1903-1906. Navegar pela Passagem do Noroeste usando uma bússola magnética tradicional é um desafio devido às grandes diferenças entre o norte magnético e verdadeiro em altas latitudes. Este exemplo faz um gráfico da Passagem do Noroeste usando GeomagneticModelData para obter os dados atuais do campo magnético para a Terra.

Comece com uma lista de pares de latitude e longitude descrevendo a Passagem do Noroeste e obtenha a posição do norte geomagnético.

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]=

Defina uma função para traçar a direção ao pólo norte geomagnético (em vermelho) e leitura de bússola local (em azul).

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}]}
  ]

Selecione pontos de amostra razoavelmente bem espaçados, calcule e observe visualmente as diferenças entre o verdadeiro (vermelho) e o magnético (azul) ao longo da Passagem.

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]=