Построение диаграммы Северо-Западного прохода с помощью геомагнитного моделирования
Северо-западный проход представляет собой морской путь вдоль побережья Северной Америки, который соединяет северную часть Атлантического и Тихого океанов. Он был обнаружен в 1850 году и был впервые пройден исследователем Руалем Амундсеном в 1903-1906 годах. Перемещение по Северо-Западному проходу с помощью традиционного магнитного компаса является сложной задачей из-за больших различий между показаниями компаса и истинным расположением Северного полюса. В данном примере, мы графически представим маршрут Северо-Западного прохода с помощью геомагнетического моделирования, GeomagneticModelData, с учетом текущих данных о магнитном поле Земли.
Получим список парных значений широты и долготы, относящихся к Северо-Западному проходу и рассмотрим положение Северного полюса на основании геомагнитных данных.

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

geomagneticNorthLocation =
GeomagneticModelData["NorthGeomagneticPole"]


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

Зададим функцию для определения геомагнитного Северного полюса (обозначен красным) и Северного полюса согласно данным компаса (обозначен синим цветом).

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}]}
]
На карте, выберем группу точек выборки в районе Северо-Западного прохода и вычислим, а также визуально отобразим, различия между истинным нахождением Северного полюса (отмечено красным) и нахождением Северного полюса согласно данным компаса (отмечено синим).

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

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


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