geodesic_wgs84 1.32.1

This diff represents the content of publicly available package versions that have been released to one of the supported registries. The information contained in this diff is provided for informational purposes only and reflects changes between package versions as they appear in their respective public registries.
@@ -0,0 +1,1770 @@
1
+ /**
2
+ * \file geodesic.c
3
+ * \brief Implementation of the geodesic routines in C
4
+ *
5
+ * For the full documentation see geodesic.h.
6
+ **********************************************************************/
7
+
8
+ /** @cond SKIP */
9
+
10
+ /*
11
+ * This is a C implementation of the geodesic algorithms described in
12
+ *
13
+ * C. F. F. Karney,
14
+ * Algorithms for geodesics,
15
+ * J. Geodesy <b>87</b>, 43--55 (2013);
16
+ * http://dx.doi.org/10.1007/s00190-012-0578-z
17
+ * Addenda: http://geographiclib.sf.net/geod-addenda.html
18
+ *
19
+ * See the comments in geodesic.h for documentation.
20
+ *
21
+ * Copyright (c) Charles Karney (2012-2013) <charles@karney.com> and licensed
22
+ * under the MIT/X11 License. For more information, see
23
+ * http://geographiclib.sourceforge.net/
24
+ */
25
+
26
+ #include "geodesic.h"
27
+ #include <math.h>
28
+
29
+ #define GEOGRAPHICLIB_GEODESIC_ORDER 6
30
+ #define nC1 GEOGRAPHICLIB_GEODESIC_ORDER
31
+ #define nC1p GEOGRAPHICLIB_GEODESIC_ORDER
32
+ #define nC2 GEOGRAPHICLIB_GEODESIC_ORDER
33
+ #define nA3 GEOGRAPHICLIB_GEODESIC_ORDER
34
+ #define nA3x nA3
35
+ #define nC3 GEOGRAPHICLIB_GEODESIC_ORDER
36
+ #define nC3x ((nC3 * (nC3 - 1)) / 2)
37
+ #define nC4 GEOGRAPHICLIB_GEODESIC_ORDER
38
+ #define nC4x ((nC4 * (nC4 + 1)) / 2)
39
+
40
+ typedef double real;
41
+ typedef int boolx;
42
+
43
+ static unsigned init = 0;
44
+ static const int FALSE = 0;
45
+ static const int TRUE = 1;
46
+ static unsigned digits, maxit1, maxit2;
47
+ static real epsilon, realmin, pi, degree, NaN,
48
+ tiny, tol0, tol1, tol2, tolb, xthresh;
49
+
50
+ static void Init() {
51
+ if (!init) {
52
+ #if defined(__DBL_MANT_DIG__)
53
+ digits = __DBL_MANT_DIG__;
54
+ #else
55
+ digits = 53;
56
+ #endif
57
+ #if defined(__DBL_EPSILON__)
58
+ epsilon = __DBL_EPSILON__;
59
+ #else
60
+ epsilon = pow(0.5, digits - 1);
61
+ #endif
62
+ #if defined(__DBL_MIN__)
63
+ realmin = __DBL_MIN__;
64
+ #else
65
+ realmin = pow(0.5, 1022);
66
+ #endif
67
+ #if defined(M_PI)
68
+ pi = M_PI;
69
+ #else
70
+ pi = atan2(0.0, -1.0);
71
+ #endif
72
+ maxit1 = 20;
73
+ maxit2 = maxit1 + digits + 10;
74
+ tiny = sqrt(realmin);
75
+ tol0 = epsilon;
76
+ /* Increase multiplier in defn of tol1 from 100 to 200 to fix inverse case
77
+ * 52.784459512564 0 -52.784459512563990912 179.634407464943777557
78
+ * which otherwise failed for Visual Studio 10 (Release and Debug) */
79
+ tol1 = 200 * tol0;
80
+ tol2 = sqrt(tol0);
81
+ /* Check on bisection interval */
82
+ tolb = tol0 * tol2;
83
+ xthresh = 1000 * tol2;
84
+ degree = pi/180;
85
+ NaN = sqrt(-1.0);
86
+ init = 1;
87
+ }
88
+ }
89
+
90
+ enum captype {
91
+ CAP_NONE = 0U,
92
+ CAP_C1 = 1U<<0,
93
+ CAP_C1p = 1U<<1,
94
+ CAP_C2 = 1U<<2,
95
+ CAP_C3 = 1U<<3,
96
+ CAP_C4 = 1U<<4,
97
+ CAP_ALL = 0x1FU,
98
+ OUT_ALL = 0x7F80U
99
+ };
100
+
101
+ static real sq(real x) { return x * x; }
102
+ static real log1px(real x) {
103
+ volatile real
104
+ y = 1 + x,
105
+ z = y - 1;
106
+ /* Here's the explanation for this magic: y = 1 + z, exactly, and z
107
+ * approx x, thus log(y)/z (which is nearly constant near z = 0) returns
108
+ * a good approximation to the true log(1 + x)/x. The multiplication x *
109
+ * (log(y)/z) introduces little additional error. */
110
+ return z == 0 ? x : x * log(y) / z;
111
+ }
112
+
113
+ static real atanhx(real x) {
114
+ real y = fabs(x); /* Enforce odd parity */
115
+ y = log1px(2 * y/(1 - y))/2;
116
+ return x < 0 ? -y : y;
117
+ }
118
+
119
+ static real hypotx(real x, real y)
120
+ { return sqrt(x * x + y * y); }
121
+
122
+ static real cbrtx(real x) {
123
+ real y = pow(fabs(x), 1/(real)(3)); /* Return the real cube root */
124
+ return x < 0 ? -y : y;
125
+ }
126
+
127
+ static real sumx(real u, real v, real* t) {
128
+ volatile real s = u + v;
129
+ volatile real up = s - v;
130
+ volatile real vpp = s - up;
131
+ up -= u;
132
+ vpp -= v;
133
+ *t = -(up + vpp);
134
+ /* error-free sum:
135
+ * u + v = s + t
136
+ * = round(u + v) + t */
137
+ return s;
138
+ }
139
+
140
+ static real minx(real x, real y)
141
+ { return x < y ? x : y; }
142
+
143
+ static real maxx(real x, real y)
144
+ { return x > y ? x : y; }
145
+
146
+ static void swapx(real* x, real* y)
147
+ { real t = *x; *x = *y; *y = t; }
148
+
149
+ static void SinCosNorm(real* sinx, real* cosx) {
150
+ real r = hypotx(*sinx, *cosx);
151
+ *sinx /= r;
152
+ *cosx /= r;
153
+ }
154
+
155
+ static real AngNormalize(real x)
156
+ { return x >= 180 ? x - 360 : (x < -180 ? x + 360 : x); }
157
+ static real AngNormalize2(real x)
158
+ { return AngNormalize(fmod(x, (real)(360))); }
159
+
160
+ static real AngDiff(real x, real y) {
161
+ real t, d = sumx(-x, y, &t);
162
+ if ((d - (real)(180)) + t > (real)(0)) /* y - x > 180 */
163
+ d -= (real)(360); /* exact */
164
+ else if ((d + (real)(180)) + t <= (real)(0)) /* y - x <= -180 */
165
+ d += (real)(360); /* exact */
166
+ return d + t;
167
+ }
168
+
169
+ static real AngRound(real x) {
170
+ const real z = 1/(real)(16);
171
+ volatile real y = fabs(x);
172
+ /* The compiler mustn't "simplify" z - (z - y) to y */
173
+ y = y < z ? z - (z - y) : y;
174
+ return x < 0 ? -y : y;
175
+ }
176
+
177
+ static void A3coeff(struct geod_geodesic* g);
178
+ static void C3coeff(struct geod_geodesic* g);
179
+ static void C4coeff(struct geod_geodesic* g);
180
+ static real SinCosSeries(boolx sinp,
181
+ real sinx, real cosx,
182
+ const real c[], int n);
183
+ static void Lengths(const struct geod_geodesic* g,
184
+ real eps, real sig12,
185
+ real ssig1, real csig1, real dn1,
186
+ real ssig2, real csig2, real dn2,
187
+ real cbet1, real cbet2,
188
+ real* ps12b, real* pm12b, real* pm0,
189
+ boolx scalep, real* pM12, real* pM21,
190
+ /* Scratch areas of the right size */
191
+ real C1a[], real C2a[]);
192
+ static real Astroid(real x, real y);
193
+ static real InverseStart(const struct geod_geodesic* g,
194
+ real sbet1, real cbet1, real dn1,
195
+ real sbet2, real cbet2, real dn2,
196
+ real lam12,
197
+ real* psalp1, real* pcalp1,
198
+ /* Only updated if return val >= 0 */
199
+ real* psalp2, real* pcalp2,
200
+ /* Only updated for short lines */
201
+ real* pdnm,
202
+ /* Scratch areas of the right size */
203
+ real C1a[], real C2a[]);
204
+ static real Lambda12(const struct geod_geodesic* g,
205
+ real sbet1, real cbet1, real dn1,
206
+ real sbet2, real cbet2, real dn2,
207
+ real salp1, real calp1,
208
+ real* psalp2, real* pcalp2,
209
+ real* psig12,
210
+ real* pssig1, real* pcsig1,
211
+ real* pssig2, real* pcsig2,
212
+ real* peps, real* pdomg12,
213
+ boolx diffp, real* pdlam12,
214
+ /* Scratch areas of the right size */
215
+ real C1a[], real C2a[], real C3a[]);
216
+ static real A3f(const struct geod_geodesic* g, real eps);
217
+ static void C3f(const struct geod_geodesic* g, real eps, real c[]);
218
+ static void C4f(const struct geod_geodesic* g, real eps, real c[]);
219
+ static real A1m1f(real eps);
220
+ static void C1f(real eps, real c[]);
221
+ static void C1pf(real eps, real c[]);
222
+ static real A2m1f(real eps);
223
+ static void C2f(real eps, real c[]);
224
+ static int transit(real lon1, real lon2);
225
+ static void accini(real s[]);
226
+ static void acccopy(const real s[], real t[]);
227
+ static void accadd(real s[], real y);
228
+ static real accsum(const real s[], real y);
229
+ static void accneg(real s[]);
230
+
231
+ void geod_init(struct geod_geodesic* g, real a, real f) {
232
+ if (!init) Init();
233
+ g->a = a;
234
+ g->f = f <= 1 ? f : 1/f;
235
+ g->f1 = 1 - g->f;
236
+ g->e2 = g->f * (2 - g->f);
237
+ g->ep2 = g->e2 / sq(g->f1); /* e2 / (1 - e2) */
238
+ g->n = g->f / ( 2 - g->f);
239
+ g->b = g->a * g->f1;
240
+ g->c2 = (sq(g->a) + sq(g->b) *
241
+ (g->e2 == 0 ? 1 :
242
+ (g->e2 > 0 ? atanhx(sqrt(g->e2)) : atan(sqrt(-g->e2))) /
243
+ sqrt(fabs(g->e2))))/2; /* authalic radius squared */
244
+ /* The sig12 threshold for "really short". Using the auxiliary sphere
245
+ * solution with dnm computed at (bet1 + bet2) / 2, the relative error in the
246
+ * azimuth consistency check is sig12^2 * abs(f) * min(1, 1-f/2) / 2. (Error
247
+ * measured for 1/100 < b/a < 100 and abs(f) >= 1/1000. For a given f and
248
+ * sig12, the max error occurs for lines near the pole. If the old rule for
249
+ * computing dnm = (dn1 + dn2)/2 is used, then the error increases by a
250
+ * factor of 2.) Setting this equal to epsilon gives sig12 = etol2. Here
251
+ * 0.1 is a safety factor (error decreased by 100) and max(0.001, abs(f))
252
+ * stops etol2 getting too large in the nearly spherical case. */
253
+ g->etol2 = 0.1 * tol2 /
254
+ sqrt( maxx((real)(0.001), fabs(g->f)) * minx((real)(1), 1 - g->f/2) / 2 );
255
+
256
+ A3coeff(g);
257
+ C3coeff(g);
258
+ C4coeff(g);
259
+ }
260
+
261
+ void geod_lineinit(struct geod_geodesicline* l,
262
+ const struct geod_geodesic* g,
263
+ real lat1, real lon1, real azi1, unsigned caps) {
264
+ real alp1, cbet1, sbet1, phi, eps;
265
+ l->a = g->a;
266
+ l->f = g->f;
267
+ l->b = g->b;
268
+ l->c2 = g->c2;
269
+ l->f1 = g->f1;
270
+ /* If caps is 0 assume the standard direct calculation */
271
+ l->caps = (caps ? caps : GEOD_DISTANCE_IN | GEOD_LONGITUDE) |
272
+ GEOD_LATITUDE | GEOD_AZIMUTH; /* Always allow latitude and azimuth */
273
+
274
+ /* Guard against underflow in salp0 */
275
+ azi1 = AngRound(AngNormalize(azi1));
276
+ lon1 = AngNormalize(lon1);
277
+ l->lat1 = lat1;
278
+ l->lon1 = lon1;
279
+ l->azi1 = azi1;
280
+ /* alp1 is in [0, pi] */
281
+ alp1 = azi1 * degree;
282
+ /* Enforce sin(pi) == 0 and cos(pi/2) == 0. Better to face the ensuing
283
+ * problems directly than to skirt them. */
284
+ l->salp1 = azi1 == -180 ? 0 : sin(alp1);
285
+ l->calp1 = fabs(azi1) == 90 ? 0 : cos(alp1);
286
+ phi = lat1 * degree;
287
+ /* Ensure cbet1 = +epsilon at poles */
288
+ sbet1 = l->f1 * sin(phi);
289
+ cbet1 = fabs(lat1) == 90 ? tiny : cos(phi);
290
+ SinCosNorm(&sbet1, &cbet1);
291
+ l->dn1 = sqrt(1 + g->ep2 * sq(sbet1));
292
+
293
+ /* Evaluate alp0 from sin(alp1) * cos(bet1) = sin(alp0), */
294
+ l->salp0 = l->salp1 * cbet1; /* alp0 in [0, pi/2 - |bet1|] */
295
+ /* Alt: calp0 = hypot(sbet1, calp1 * cbet1). The following
296
+ * is slightly better (consider the case salp1 = 0). */
297
+ l->calp0 = hypotx(l->calp1, l->salp1 * sbet1);
298
+ /* Evaluate sig with tan(bet1) = tan(sig1) * cos(alp1).
299
+ * sig = 0 is nearest northward crossing of equator.
300
+ * With bet1 = 0, alp1 = pi/2, we have sig1 = 0 (equatorial line).
301
+ * With bet1 = pi/2, alp1 = -pi, sig1 = pi/2
302
+ * With bet1 = -pi/2, alp1 = 0 , sig1 = -pi/2
303
+ * Evaluate omg1 with tan(omg1) = sin(alp0) * tan(sig1).
304
+ * With alp0 in (0, pi/2], quadrants for sig and omg coincide.
305
+ * No atan2(0,0) ambiguity at poles since cbet1 = +epsilon.
306
+ * With alp0 = 0, omg1 = 0 for alp1 = 0, omg1 = pi for alp1 = pi. */
307
+ l->ssig1 = sbet1; l->somg1 = l->salp0 * sbet1;
308
+ l->csig1 = l->comg1 = sbet1 != 0 || l->calp1 != 0 ? cbet1 * l->calp1 : 1;
309
+ SinCosNorm(&l->ssig1, &l->csig1); /* sig1 in (-pi, pi] */
310
+ /* SinCosNorm(somg1, comg1); -- don't need to normalize! */
311
+
312
+ l->k2 = sq(l->calp0) * g->ep2;
313
+ eps = l->k2 / (2 * (1 + sqrt(1 + l->k2)) + l->k2);
314
+
315
+ if (l->caps & CAP_C1) {
316
+ real s, c;
317
+ l->A1m1 = A1m1f(eps);
318
+ C1f(eps, l->C1a);
319
+ l->B11 = SinCosSeries(TRUE, l->ssig1, l->csig1, l->C1a, nC1);
320
+ s = sin(l->B11); c = cos(l->B11);
321
+ /* tau1 = sig1 + B11 */
322
+ l->stau1 = l->ssig1 * c + l->csig1 * s;
323
+ l->ctau1 = l->csig1 * c - l->ssig1 * s;
324
+ /* Not necessary because C1pa reverts C1a
325
+ * B11 = -SinCosSeries(TRUE, stau1, ctau1, C1pa, nC1p); */
326
+ }
327
+
328
+ if (l->caps & CAP_C1p)
329
+ C1pf(eps, l->C1pa);
330
+
331
+ if (l->caps & CAP_C2) {
332
+ l->A2m1 = A2m1f(eps);
333
+ C2f(eps, l->C2a);
334
+ l->B21 = SinCosSeries(TRUE, l->ssig1, l->csig1, l->C2a, nC2);
335
+ }
336
+
337
+ if (l->caps & CAP_C3) {
338
+ C3f(g, eps, l->C3a);
339
+ l->A3c = -l->f * l->salp0 * A3f(g, eps);
340
+ l->B31 = SinCosSeries(TRUE, l->ssig1, l->csig1, l->C3a, nC3-1);
341
+ }
342
+
343
+ if (l->caps & CAP_C4) {
344
+ C4f(g, eps, l->C4a);
345
+ /* Multiplier = a^2 * e^2 * cos(alpha0) * sin(alpha0) */
346
+ l->A4 = sq(l->a) * l->calp0 * l->salp0 * g->e2;
347
+ l->B41 = SinCosSeries(FALSE, l->ssig1, l->csig1, l->C4a, nC4);
348
+ }
349
+ }
350
+
351
+ real geod_genposition(const struct geod_geodesicline* l,
352
+ boolx arcmode, real s12_a12,
353
+ real* plat2, real* plon2, real* pazi2,
354
+ real* ps12, real* pm12,
355
+ real* pM12, real* pM21,
356
+ real* pS12) {
357
+ real lat2 = 0, lon2 = 0, azi2 = 0, s12 = 0,
358
+ m12 = 0, M12 = 0, M21 = 0, S12 = 0;
359
+ /* Avoid warning about uninitialized B12. */
360
+ real sig12, ssig12, csig12, B12 = 0, AB1 = 0;
361
+ real omg12, lam12, lon12;
362
+ real ssig2, csig2, sbet2, cbet2, somg2, comg2, salp2, calp2, dn2;
363
+ unsigned outmask =
364
+ (plat2 ? GEOD_LATITUDE : 0U) |
365
+ (plon2 ? GEOD_LONGITUDE : 0U) |
366
+ (pazi2 ? GEOD_AZIMUTH : 0U) |
367
+ (ps12 ? GEOD_DISTANCE : 0U) |
368
+ (pm12 ? GEOD_REDUCEDLENGTH : 0U) |
369
+ (pM12 || pM21 ? GEOD_GEODESICSCALE : 0U) |
370
+ (pS12 ? GEOD_AREA : 0U);
371
+
372
+ outmask &= l->caps & OUT_ALL;
373
+ if (!( TRUE /*Init()*/ &&
374
+ (arcmode || (l->caps & GEOD_DISTANCE_IN & OUT_ALL)) ))
375
+ /* Uninitialized or impossible distance calculation requested */
376
+ return NaN;
377
+
378
+ if (arcmode) {
379
+ real s12a;
380
+ /* Interpret s12_a12 as spherical arc length */
381
+ sig12 = s12_a12 * degree;
382
+ s12a = fabs(s12_a12);
383
+ s12a -= 180 * floor(s12a / 180);
384
+ ssig12 = s12a == 0 ? 0 : sin(sig12);
385
+ csig12 = s12a == 90 ? 0 : cos(sig12);
386
+ } else {
387
+ /* Interpret s12_a12 as distance */
388
+ real
389
+ tau12 = s12_a12 / (l->b * (1 + l->A1m1)),
390
+ s = sin(tau12),
391
+ c = cos(tau12);
392
+ /* tau2 = tau1 + tau12 */
393
+ B12 = - SinCosSeries(TRUE,
394
+ l->stau1 * c + l->ctau1 * s,
395
+ l->ctau1 * c - l->stau1 * s,
396
+ l->C1pa, nC1p);
397
+ sig12 = tau12 - (B12 - l->B11);
398
+ ssig12 = sin(sig12); csig12 = cos(sig12);
399
+ if (fabs(l->f) > 0.01) {
400
+ /* Reverted distance series is inaccurate for |f| > 1/100, so correct
401
+ * sig12 with 1 Newton iteration. The following table shows the
402
+ * approximate maximum error for a = WGS_a() and various f relative to
403
+ * GeodesicExact.
404
+ * erri = the error in the inverse solution (nm)
405
+ * errd = the error in the direct solution (series only) (nm)
406
+ * errda = the error in the direct solution (series + 1 Newton) (nm)
407
+ *
408
+ * f erri errd errda
409
+ * -1/5 12e6 1.2e9 69e6
410
+ * -1/10 123e3 12e6 765e3
411
+ * -1/20 1110 108e3 7155
412
+ * -1/50 18.63 200.9 27.12
413
+ * -1/100 18.63 23.78 23.37
414
+ * -1/150 18.63 21.05 20.26
415
+ * 1/150 22.35 24.73 25.83
416
+ * 1/100 22.35 25.03 25.31
417
+ * 1/50 29.80 231.9 30.44
418
+ * 1/20 5376 146e3 10e3
419
+ * 1/10 829e3 22e6 1.5e6
420
+ * 1/5 157e6 3.8e9 280e6 */
421
+ real
422
+ ssig2 = l->ssig1 * csig12 + l->csig1 * ssig12,
423
+ csig2 = l->csig1 * csig12 - l->ssig1 * ssig12,
424
+ serr;
425
+ B12 = SinCosSeries(TRUE, ssig2, csig2, l->C1a, nC1);
426
+ serr = (1 + l->A1m1) * (sig12 + (B12 - l->B11)) - s12_a12 / l->b;
427
+ sig12 = sig12 - serr / sqrt(1 + l->k2 * sq(ssig2));
428
+ ssig12 = sin(sig12); csig12 = cos(sig12);
429
+ /* Update B12 below */
430
+ }
431
+ }
432
+
433
+ /* sig2 = sig1 + sig12 */
434
+ ssig2 = l->ssig1 * csig12 + l->csig1 * ssig12;
435
+ csig2 = l->csig1 * csig12 - l->ssig1 * ssig12;
436
+ dn2 = sqrt(1 + l->k2 * sq(ssig2));
437
+ if (outmask & (GEOD_DISTANCE | GEOD_REDUCEDLENGTH | GEOD_GEODESICSCALE)) {
438
+ if (arcmode || fabs(l->f) > 0.01)
439
+ B12 = SinCosSeries(TRUE, ssig2, csig2, l->C1a, nC1);
440
+ AB1 = (1 + l->A1m1) * (B12 - l->B11);
441
+ }
442
+ /* sin(bet2) = cos(alp0) * sin(sig2) */
443
+ sbet2 = l->calp0 * ssig2;
444
+ /* Alt: cbet2 = hypot(csig2, salp0 * ssig2); */
445
+ cbet2 = hypotx(l->salp0, l->calp0 * csig2);
446
+ if (cbet2 == 0)
447
+ /* I.e., salp0 = 0, csig2 = 0. Break the degeneracy in this case */
448
+ cbet2 = csig2 = tiny;
449
+ /* tan(omg2) = sin(alp0) * tan(sig2) */
450
+ somg2 = l->salp0 * ssig2; comg2 = csig2; /* No need to normalize */
451
+ /* tan(alp0) = cos(sig2)*tan(alp2) */
452
+ salp2 = l->salp0; calp2 = l->calp0 * csig2; /* No need to normalize */
453
+ /* omg12 = omg2 - omg1 */
454
+ omg12 = atan2(somg2 * l->comg1 - comg2 * l->somg1,
455
+ comg2 * l->comg1 + somg2 * l->somg1);
456
+
457
+ if (outmask & GEOD_DISTANCE)
458
+ s12 = arcmode ? l->b * ((1 + l->A1m1) * sig12 + AB1) : s12_a12;
459
+
460
+ if (outmask & GEOD_LONGITUDE) {
461
+ lam12 = omg12 + l->A3c *
462
+ ( sig12 + (SinCosSeries(TRUE, ssig2, csig2, l->C3a, nC3-1)
463
+ - l->B31));
464
+ lon12 = lam12 / degree;
465
+ /* Use AngNormalize2 because longitude might have wrapped multiple
466
+ * times. */
467
+ lon12 = AngNormalize2(lon12);
468
+ lon2 = AngNormalize(l->lon1 + lon12);
469
+ }
470
+
471
+ if (outmask & GEOD_LATITUDE)
472
+ lat2 = atan2(sbet2, l->f1 * cbet2) / degree;
473
+
474
+ if (outmask & GEOD_AZIMUTH)
475
+ /* minus signs give range [-180, 180). 0- converts -0 to +0. */
476
+ azi2 = 0 - atan2(-salp2, calp2) / degree;
477
+
478
+ if (outmask & (GEOD_REDUCEDLENGTH | GEOD_GEODESICSCALE)) {
479
+ real
480
+ B22 = SinCosSeries(TRUE, ssig2, csig2, l->C2a, nC2),
481
+ AB2 = (1 + l->A2m1) * (B22 - l->B21),
482
+ J12 = (l->A1m1 - l->A2m1) * sig12 + (AB1 - AB2);
483
+ if (outmask & GEOD_REDUCEDLENGTH)
484
+ /* Add parens around (csig1 * ssig2) and (ssig1 * csig2) to ensure
485
+ * accurate cancellation in the case of coincident points. */
486
+ m12 = l->b * ((dn2 * (l->csig1 * ssig2) - l->dn1 * (l->ssig1 * csig2))
487
+ - l->csig1 * csig2 * J12);
488
+ if (outmask & GEOD_GEODESICSCALE) {
489
+ real t = l->k2 * (ssig2 - l->ssig1) * (ssig2 + l->ssig1) / (l->dn1 + dn2);
490
+ M12 = csig12 + (t * ssig2 - csig2 * J12) * l->ssig1 / l->dn1;
491
+ M21 = csig12 - (t * l->ssig1 - l->csig1 * J12) * ssig2 / dn2;
492
+ }
493
+ }
494
+
495
+ if (outmask & GEOD_AREA) {
496
+ real
497
+ B42 = SinCosSeries(FALSE, ssig2, csig2, l->C4a, nC4);
498
+ real salp12, calp12;
499
+ if (l->calp0 == 0 || l->salp0 == 0) {
500
+ /* alp12 = alp2 - alp1, used in atan2 so no need to normalized */
501
+ salp12 = salp2 * l->calp1 - calp2 * l->salp1;
502
+ calp12 = calp2 * l->calp1 + salp2 * l->salp1;
503
+ /* The right thing appears to happen if alp1 = +/-180 and alp2 = 0, viz
504
+ * salp12 = -0 and alp12 = -180. However this depends on the sign being
505
+ * attached to 0 correctly. The following ensures the correct
506
+ * behavior. */
507
+ if (salp12 == 0 && calp12 < 0) {
508
+ salp12 = tiny * l->calp1;
509
+ calp12 = -1;
510
+ }
511
+ } else {
512
+ /* tan(alp) = tan(alp0) * sec(sig)
513
+ * tan(alp2-alp1) = (tan(alp2) -tan(alp1)) / (tan(alp2)*tan(alp1)+1)
514
+ * = calp0 * salp0 * (csig1-csig2) / (salp0^2 + calp0^2 * csig1*csig2)
515
+ * If csig12 > 0, write
516
+ * csig1 - csig2 = ssig12 * (csig1 * ssig12 / (1 + csig12) + ssig1)
517
+ * else
518
+ * csig1 - csig2 = csig1 * (1 - csig12) + ssig12 * ssig1
519
+ * No need to normalize */
520
+ salp12 = l->calp0 * l->salp0 *
521
+ (csig12 <= 0 ? l->csig1 * (1 - csig12) + ssig12 * l->ssig1 :
522
+ ssig12 * (l->csig1 * ssig12 / (1 + csig12) + l->ssig1));
523
+ calp12 = sq(l->salp0) + sq(l->calp0) * l->csig1 * csig2;
524
+ }
525
+ S12 = l->c2 * atan2(salp12, calp12) + l->A4 * (B42 - l->B41);
526
+ }
527
+
528
+ if (outmask & GEOD_LATITUDE)
529
+ *plat2 = lat2;
530
+ if (outmask & GEOD_LONGITUDE)
531
+ *plon2 = lon2;
532
+ if (outmask & GEOD_AZIMUTH)
533
+ *pazi2 = azi2;
534
+ if (outmask & GEOD_DISTANCE)
535
+ *ps12 = s12;
536
+ if (outmask & GEOD_REDUCEDLENGTH)
537
+ *pm12 = m12;
538
+ if (outmask & GEOD_GEODESICSCALE) {
539
+ if (pM12) *pM12 = M12;
540
+ if (pM21) *pM21 = M21;
541
+ }
542
+ if (outmask & GEOD_AREA)
543
+ *pS12 = S12;
544
+
545
+ return arcmode ? s12_a12 : sig12 / degree;
546
+ }
547
+
548
+ void geod_position(const struct geod_geodesicline* l, real s12,
549
+ real* plat2, real* plon2, real* pazi2) {
550
+ geod_genposition(l, FALSE, s12, plat2, plon2, pazi2, 0, 0, 0, 0, 0);
551
+ }
552
+
553
+ real geod_gendirect(const struct geod_geodesic* g,
554
+ real lat1, real lon1, real azi1,
555
+ boolx arcmode, real s12_a12,
556
+ real* plat2, real* plon2, real* pazi2,
557
+ real* ps12, real* pm12, real* pM12, real* pM21,
558
+ real* pS12) {
559
+ struct geod_geodesicline l;
560
+ unsigned outmask =
561
+ (plat2 ? GEOD_LATITUDE : 0U) |
562
+ (plon2 ? GEOD_LONGITUDE : 0U) |
563
+ (pazi2 ? GEOD_AZIMUTH : 0U) |
564
+ (ps12 ? GEOD_DISTANCE : 0U) |
565
+ (pm12 ? GEOD_REDUCEDLENGTH : 0U) |
566
+ (pM12 || pM21 ? GEOD_GEODESICSCALE : 0U) |
567
+ (pS12 ? GEOD_AREA : 0U);
568
+
569
+ geod_lineinit(&l, g, lat1, lon1, azi1,
570
+ /* Automatically supply GEOD_DISTANCE_IN if necessary */
571
+ outmask | (arcmode ? GEOD_NONE : GEOD_DISTANCE_IN));
572
+ return geod_genposition(&l, arcmode, s12_a12,
573
+ plat2, plon2, pazi2, ps12, pm12, pM12, pM21, pS12);
574
+ }
575
+
576
+ void geod_direct(const struct geod_geodesic* g,
577
+ real lat1, real lon1, real azi1,
578
+ real s12,
579
+ real* plat2, real* plon2, real* pazi2) {
580
+ geod_gendirect(g, lat1, lon1, azi1, FALSE, s12, plat2, plon2, pazi2,
581
+ 0, 0, 0, 0, 0);
582
+ }
583
+
584
+ real geod_geninverse(const struct geod_geodesic* g,
585
+ real lat1, real lon1, real lat2, real lon2,
586
+ real* ps12, real* pazi1, real* pazi2,
587
+ real* pm12, real* pM12, real* pM21, real* pS12) {
588
+ real s12 = 0, azi1 = 0, azi2 = 0, m12 = 0, M12 = 0, M21 = 0, S12 = 0;
589
+ real lon12;
590
+ int latsign, lonsign, swapp;
591
+ real phi, sbet1, cbet1, sbet2, cbet2, s12x = 0, m12x = 0;
592
+ real dn1, dn2, lam12, slam12, clam12;
593
+ real a12 = 0, sig12, calp1 = 0, salp1 = 0, calp2 = 0, salp2 = 0;
594
+ /* index zero elements of these arrays are unused */
595
+ real C1a[nC1 + 1], C2a[nC2 + 1], C3a[nC3];
596
+ boolx meridian;
597
+ real omg12 = 0;
598
+
599
+ unsigned outmask =
600
+ (ps12 ? GEOD_DISTANCE : 0U) |
601
+ (pazi1 || pazi2 ? GEOD_AZIMUTH : 0U) |
602
+ (pm12 ? GEOD_REDUCEDLENGTH : 0U) |
603
+ (pM12 || pM21 ? GEOD_GEODESICSCALE : 0U) |
604
+ (pS12 ? GEOD_AREA : 0U);
605
+
606
+ outmask &= OUT_ALL;
607
+ /* Compute longitude difference (AngDiff does this carefully). Result is
608
+ * in [-180, 180] but -180 is only for west-going geodesics. 180 is for
609
+ * east-going and meridional geodesics. */
610
+ lon12 = AngDiff(AngNormalize(lon1), AngNormalize(lon2));
611
+ /* If very close to being on the same half-meridian, then make it so. */
612
+ lon12 = AngRound(lon12);
613
+ /* Make longitude difference positive. */
614
+ lonsign = lon12 >= 0 ? 1 : -1;
615
+ lon12 *= lonsign;
616
+ /* If really close to the equator, treat as on equator. */
617
+ lat1 = AngRound(lat1);
618
+ lat2 = AngRound(lat2);
619
+ /* Swap points so that point with higher (abs) latitude is point 1 */
620
+ swapp = fabs(lat1) >= fabs(lat2) ? 1 : -1;
621
+ if (swapp < 0) {
622
+ lonsign *= -1;
623
+ swapx(&lat1, &lat2);
624
+ }
625
+ /* Make lat1 <= 0 */
626
+ latsign = lat1 < 0 ? 1 : -1;
627
+ lat1 *= latsign;
628
+ lat2 *= latsign;
629
+ /* Now we have
630
+ *
631
+ * 0 <= lon12 <= 180
632
+ * -90 <= lat1 <= 0
633
+ * lat1 <= lat2 <= -lat1
634
+ *
635
+ * longsign, swapp, latsign register the transformation to bring the
636
+ * coordinates to this canonical form. In all cases, 1 means no change was
637
+ * made. We make these transformations so that there are few cases to
638
+ * check, e.g., on verifying quadrants in atan2. In addition, this
639
+ * enforces some symmetries in the results returned. */
640
+
641
+ phi = lat1 * degree;
642
+ /* Ensure cbet1 = +epsilon at poles */
643
+ sbet1 = g->f1 * sin(phi);
644
+ cbet1 = lat1 == -90 ? tiny : cos(phi);
645
+ SinCosNorm(&sbet1, &cbet1);
646
+
647
+ phi = lat2 * degree;
648
+ /* Ensure cbet2 = +epsilon at poles */
649
+ sbet2 = g->f1 * sin(phi);
650
+ cbet2 = fabs(lat2) == 90 ? tiny : cos(phi);
651
+ SinCosNorm(&sbet2, &cbet2);
652
+
653
+ /* If cbet1 < -sbet1, then cbet2 - cbet1 is a sensitive measure of the
654
+ * |bet1| - |bet2|. Alternatively (cbet1 >= -sbet1), abs(sbet2) + sbet1 is
655
+ * a better measure. This logic is used in assigning calp2 in Lambda12.
656
+ * Sometimes these quantities vanish and in that case we force bet2 = +/-
657
+ * bet1 exactly. An example where is is necessary is the inverse problem
658
+ * 48.522876735459 0 -48.52287673545898293 179.599720456223079643
659
+ * which failed with Visual Studio 10 (Release and Debug) */
660
+
661
+ if (cbet1 < -sbet1) {
662
+ if (cbet2 == cbet1)
663
+ sbet2 = sbet2 < 0 ? sbet1 : -sbet1;
664
+ } else {
665
+ if (fabs(sbet2) == -sbet1)
666
+ cbet2 = cbet1;
667
+ }
668
+
669
+ dn1 = sqrt(1 + g->ep2 * sq(sbet1));
670
+ dn2 = sqrt(1 + g->ep2 * sq(sbet2));
671
+
672
+ lam12 = lon12 * degree;
673
+ slam12 = lon12 == 180 ? 0 : sin(lam12);
674
+ clam12 = cos(lam12); /* lon12 == 90 isn't interesting */
675
+
676
+ meridian = lat1 == -90 || slam12 == 0;
677
+
678
+ if (meridian) {
679
+
680
+ /* Endpoints are on a single full meridian, so the geodesic might lie on
681
+ * a meridian. */
682
+
683
+ real ssig1, csig1, ssig2, csig2;
684
+ calp1 = clam12; salp1 = slam12; /* Head to the target longitude */
685
+ calp2 = 1; salp2 = 0; /* At the target we're heading north */
686
+
687
+ /* tan(bet) = tan(sig) * cos(alp) */
688
+ ssig1 = sbet1; csig1 = calp1 * cbet1;
689
+ ssig2 = sbet2; csig2 = calp2 * cbet2;
690
+
691
+ /* sig12 = sig2 - sig1 */
692
+ sig12 = atan2(maxx(csig1 * ssig2 - ssig1 * csig2, (real)(0)),
693
+ csig1 * csig2 + ssig1 * ssig2);
694
+ {
695
+ real dummy;
696
+ Lengths(g, g->n, sig12, ssig1, csig1, dn1, ssig2, csig2, dn2,
697
+ cbet1, cbet2, &s12x, &m12x, &dummy,
698
+ (outmask & GEOD_GEODESICSCALE) != 0U, &M12, &M21, C1a, C2a);
699
+ }
700
+ /* Add the check for sig12 since zero length geodesics might yield m12 <
701
+ * 0. Test case was
702
+ *
703
+ * echo 20.001 0 20.001 0 | Geod -i
704
+ *
705
+ * In fact, we will have sig12 > pi/2 for meridional geodesic which is
706
+ * not a shortest path. */
707
+ if (sig12 < 1 || m12x >= 0) {
708
+ m12x *= g->b;
709
+ s12x *= g->b;
710
+ a12 = sig12 / degree;
711
+ } else
712
+ /* m12 < 0, i.e., prolate and too close to anti-podal */
713
+ meridian = FALSE;
714
+ }
715
+
716
+ if (!meridian &&
717
+ sbet1 == 0 && /* and sbet2 == 0 */
718
+ /* Mimic the way Lambda12 works with calp1 = 0 */
719
+ (g->f <= 0 || lam12 <= pi - g->f * pi)) {
720
+
721
+ /* Geodesic runs along equator */
722
+ calp1 = calp2 = 0; salp1 = salp2 = 1;
723
+ s12x = g->a * lam12;
724
+ sig12 = omg12 = lam12 / g->f1;
725
+ m12x = g->b * sin(sig12);
726
+ if (outmask & GEOD_GEODESICSCALE)
727
+ M12 = M21 = cos(sig12);
728
+ a12 = lon12 / g->f1;
729
+
730
+ } else if (!meridian) {
731
+
732
+ /* Now point1 and point2 belong within a hemisphere bounded by a
733
+ * meridian and geodesic is neither meridional or equatorial. */
734
+
735
+ /* Figure a starting point for Newton's method */
736
+ real dnm = 0;
737
+ sig12 = InverseStart(g, sbet1, cbet1, dn1, sbet2, cbet2, dn2,
738
+ lam12,
739
+ &salp1, &calp1, &salp2, &calp2, &dnm,
740
+ C1a, C2a);
741
+
742
+ if (sig12 >= 0) {
743
+ /* Short lines (InverseStart sets salp2, calp2, dnm) */
744
+ s12x = sig12 * g->b * dnm;
745
+ m12x = sq(dnm) * g->b * sin(sig12 / dnm);
746
+ if (outmask & GEOD_GEODESICSCALE)
747
+ M12 = M21 = cos(sig12 / dnm);
748
+ a12 = sig12 / degree;
749
+ omg12 = lam12 / (g->f1 * dnm);
750
+ } else {
751
+
752
+ /* Newton's method. This is a straightforward solution of f(alp1) =
753
+ * lambda12(alp1) - lam12 = 0 with one wrinkle. f(alp) has exactly one
754
+ * root in the interval (0, pi) and its derivative is positive at the
755
+ * root. Thus f(alp) is positive for alp > alp1 and negative for alp <
756
+ * alp1. During the course of the iteration, a range (alp1a, alp1b) is
757
+ * maintained which brackets the root and with each evaluation of
758
+ * f(alp) the range is shrunk, if possible. Newton's method is
759
+ * restarted whenever the derivative of f is negative (because the new
760
+ * value of alp1 is then further from the solution) or if the new
761
+ * estimate of alp1 lies outside (0,pi); in this case, the new starting
762
+ * guess is taken to be (alp1a + alp1b) / 2. */
763
+ real ssig1 = 0, csig1 = 0, ssig2 = 0, csig2 = 0, eps = 0;
764
+ unsigned numit = 0;
765
+ /* Bracketing range */
766
+ real salp1a = tiny, calp1a = 1, salp1b = tiny, calp1b = -1;
767
+ boolx tripn, tripb;
768
+ for (tripn = FALSE, tripb = FALSE; numit < maxit2; ++numit) {
769
+ /* the WGS84 test set: mean = 1.47, sd = 1.25, max = 16
770
+ * WGS84 and random input: mean = 2.85, sd = 0.60 */
771
+ real dv,
772
+ v = (Lambda12(g, sbet1, cbet1, dn1, sbet2, cbet2, dn2, salp1, calp1,
773
+ &salp2, &calp2, &sig12, &ssig1, &csig1, &ssig2, &csig2,
774
+ &eps, &omg12, numit < maxit1, &dv, C1a, C2a, C3a)
775
+ - lam12);
776
+ /* 2 * tol0 is approximately 1 ulp for a number in [0, pi]. */
777
+ /* Reversed test to allow escape with NaNs */
778
+ if (tripb || !(fabs(v) >= (tripn ? 8 : 2) * tol0)) break;
779
+ /* Update bracketing values */
780
+ if (v > 0 && (numit > maxit1 || calp1/salp1 > calp1b/salp1b))
781
+ { salp1b = salp1; calp1b = calp1; }
782
+ else if (v < 0 && (numit > maxit1 || calp1/salp1 < calp1a/salp1a))
783
+ { salp1a = salp1; calp1a = calp1; }
784
+ if (numit < maxit1 && dv > 0) {
785
+ real
786
+ dalp1 = -v/dv;
787
+ real
788
+ sdalp1 = sin(dalp1), cdalp1 = cos(dalp1),
789
+ nsalp1 = salp1 * cdalp1 + calp1 * sdalp1;
790
+ if (nsalp1 > 0 && fabs(dalp1) < pi) {
791
+ calp1 = calp1 * cdalp1 - salp1 * sdalp1;
792
+ salp1 = nsalp1;
793
+ SinCosNorm(&salp1, &calp1);
794
+ /* In some regimes we don't get quadratic convergence because
795
+ * slope -> 0. So use convergence conditions based on epsilon
796
+ * instead of sqrt(epsilon). */
797
+ tripn = fabs(v) <= 16 * tol0;
798
+ continue;
799
+ }
800
+ }
801
+ /* Either dv was not postive or updated value was outside legal
802
+ * range. Use the midpoint of the bracket as the next estimate.
803
+ * This mechanism is not needed for the WGS84 ellipsoid, but it does
804
+ * catch problems with more eccentric ellipsoids. Its efficacy is
805
+ * such for the WGS84 test set with the starting guess set to alp1 =
806
+ * 90deg:
807
+ * the WGS84 test set: mean = 5.21, sd = 3.93, max = 24
808
+ * WGS84 and random input: mean = 4.74, sd = 0.99 */
809
+ salp1 = (salp1a + salp1b)/2;
810
+ calp1 = (calp1a + calp1b)/2;
811
+ SinCosNorm(&salp1, &calp1);
812
+ tripn = FALSE;
813
+ tripb = (fabs(salp1a - salp1) + (calp1a - calp1) < tolb ||
814
+ fabs(salp1 - salp1b) + (calp1 - calp1b) < tolb);
815
+ }
816
+ {
817
+ real dummy;
818
+ Lengths(g, eps, sig12, ssig1, csig1, dn1, ssig2, csig2, dn2,
819
+ cbet1, cbet2, &s12x, &m12x, &dummy,
820
+ (outmask & GEOD_GEODESICSCALE) != 0U, &M12, &M21, C1a, C2a);
821
+ }
822
+ m12x *= g->b;
823
+ s12x *= g->b;
824
+ a12 = sig12 / degree;
825
+ omg12 = lam12 - omg12;
826
+ }
827
+ }
828
+
829
+ if (outmask & GEOD_DISTANCE)
830
+ s12 = 0 + s12x; /* Convert -0 to 0 */
831
+
832
+ if (outmask & GEOD_REDUCEDLENGTH)
833
+ m12 = 0 + m12x; /* Convert -0 to 0 */
834
+
835
+ if (outmask & GEOD_AREA) {
836
+ real
837
+ /* From Lambda12: sin(alp1) * cos(bet1) = sin(alp0) */
838
+ salp0 = salp1 * cbet1,
839
+ calp0 = hypotx(calp1, salp1 * sbet1); /* calp0 > 0 */
840
+ real alp12;
841
+ if (calp0 != 0 && salp0 != 0) {
842
+ real
843
+ /* From Lambda12: tan(bet) = tan(sig) * cos(alp) */
844
+ ssig1 = sbet1, csig1 = calp1 * cbet1,
845
+ ssig2 = sbet2, csig2 = calp2 * cbet2,
846
+ k2 = sq(calp0) * g->ep2,
847
+ eps = k2 / (2 * (1 + sqrt(1 + k2)) + k2),
848
+ /* Multiplier = a^2 * e^2 * cos(alpha0) * sin(alpha0). */
849
+ A4 = sq(g->a) * calp0 * salp0 * g->e2;
850
+ real C4a[nC4];
851
+ real B41, B42;
852
+ SinCosNorm(&ssig1, &csig1);
853
+ SinCosNorm(&ssig2, &csig2);
854
+ C4f(g, eps, C4a);
855
+ B41 = SinCosSeries(FALSE, ssig1, csig1, C4a, nC4);
856
+ B42 = SinCosSeries(FALSE, ssig2, csig2, C4a, nC4);
857
+ S12 = A4 * (B42 - B41);
858
+ } else
859
+ /* Avoid problems with indeterminate sig1, sig2 on equator */
860
+ S12 = 0;
861
+
862
+ if (!meridian &&
863
+ omg12 < (real)(0.75) * pi && /* Long difference too big */
864
+ sbet2 - sbet1 < (real)(1.75)) { /* Lat difference too big */
865
+ /* Use tan(Gamma/2) = tan(omg12/2)
866
+ * * (tan(bet1/2)+tan(bet2/2))/(1+tan(bet1/2)*tan(bet2/2))
867
+ * with tan(x/2) = sin(x)/(1+cos(x)) */
868
+ real
869
+ somg12 = sin(omg12), domg12 = 1 + cos(omg12),
870
+ dbet1 = 1 + cbet1, dbet2 = 1 + cbet2;
871
+ alp12 = 2 * atan2( somg12 * ( sbet1 * dbet2 + sbet2 * dbet1 ),
872
+ domg12 * ( sbet1 * sbet2 + dbet1 * dbet2 ) );
873
+ } else {
874
+ /* alp12 = alp2 - alp1, used in atan2 so no need to normalize */
875
+ real
876
+ salp12 = salp2 * calp1 - calp2 * salp1,
877
+ calp12 = calp2 * calp1 + salp2 * salp1;
878
+ /* The right thing appears to happen if alp1 = +/-180 and alp2 = 0, viz
879
+ * salp12 = -0 and alp12 = -180. However this depends on the sign
880
+ * being attached to 0 correctly. The following ensures the correct
881
+ * behavior. */
882
+ if (salp12 == 0 && calp12 < 0) {
883
+ salp12 = tiny * calp1;
884
+ calp12 = -1;
885
+ }
886
+ alp12 = atan2(salp12, calp12);
887
+ }
888
+ S12 += g->c2 * alp12;
889
+ S12 *= swapp * lonsign * latsign;
890
+ /* Convert -0 to 0 */
891
+ S12 += 0;
892
+ }
893
+
894
+ /* Convert calp, salp to azimuth accounting for lonsign, swapp, latsign. */
895
+ if (swapp < 0) {
896
+ swapx(&salp1, &salp2);
897
+ swapx(&calp1, &calp2);
898
+ if (outmask & GEOD_GEODESICSCALE)
899
+ swapx(&M12, &M21);
900
+ }
901
+
902
+ salp1 *= swapp * lonsign; calp1 *= swapp * latsign;
903
+ salp2 *= swapp * lonsign; calp2 *= swapp * latsign;
904
+
905
+ if (outmask & GEOD_AZIMUTH) {
906
+ /* minus signs give range [-180, 180). 0- converts -0 to +0. */
907
+ azi1 = 0 - atan2(-salp1, calp1) / degree;
908
+ azi2 = 0 - atan2(-salp2, calp2) / degree;
909
+ }
910
+
911
+ if (outmask & GEOD_DISTANCE)
912
+ *ps12 = s12;
913
+ if (outmask & GEOD_AZIMUTH) {
914
+ if (pazi1) *pazi1 = azi1;
915
+ if (pazi2) *pazi2 = azi2;
916
+ }
917
+ if (outmask & GEOD_REDUCEDLENGTH)
918
+ *pm12 = m12;
919
+ if (outmask & GEOD_GEODESICSCALE) {
920
+ if (pM12) *pM12 = M12;
921
+ if (pM21) *pM21 = M21;
922
+ }
923
+ if (outmask & GEOD_AREA)
924
+ *pS12 = S12;
925
+
926
+ /* Returned value in [0, 180] */
927
+ return a12;
928
+ }
929
+
930
+ void geod_inverse(const struct geod_geodesic* g,
931
+ real lat1, real lon1, real lat2, real lon2,
932
+ real* ps12, real* pazi1, real* pazi2) {
933
+ geod_geninverse(g, lat1, lon1, lat2, lon2, ps12, pazi1, pazi2, 0, 0, 0, 0);
934
+ }
935
+
936
+ real SinCosSeries(boolx sinp, real sinx, real cosx, const real c[], int n) {
937
+ /* Evaluate
938
+ * y = sinp ? sum(c[i] * sin( 2*i * x), i, 1, n) :
939
+ * sum(c[i] * cos((2*i+1) * x), i, 0, n-1)
940
+ * using Clenshaw summation. N.B. c[0] is unused for sin series
941
+ * Approx operation count = (n + 5) mult and (2 * n + 2) add */
942
+ real ar, y0, y1;
943
+ c += (n + sinp); /* Point to one beyond last element */
944
+ ar = 2 * (cosx - sinx) * (cosx + sinx); /* 2 * cos(2 * x) */
945
+ y0 = n & 1 ? *--c : 0; y1 = 0; /* accumulators for sum */
946
+ /* Now n is even */
947
+ n /= 2;
948
+ while (n--) {
949
+ /* Unroll loop x 2, so accumulators return to their original role */
950
+ y1 = ar * y0 - y1 + *--c;
951
+ y0 = ar * y1 - y0 + *--c;
952
+ }
953
+ return sinp
954
+ ? 2 * sinx * cosx * y0 /* sin(2 * x) * y0 */
955
+ : cosx * (y0 - y1); /* cos(x) * (y0 - y1) */
956
+ }
957
+
958
+ void Lengths(const struct geod_geodesic* g,
959
+ real eps, real sig12,
960
+ real ssig1, real csig1, real dn1,
961
+ real ssig2, real csig2, real dn2,
962
+ real cbet1, real cbet2,
963
+ real* ps12b, real* pm12b, real* pm0,
964
+ boolx scalep, real* pM12, real* pM21,
965
+ /* Scratch areas of the right size */
966
+ real C1a[], real C2a[]) {
967
+ real s12b = 0, m12b = 0, m0 = 0, M12 = 0, M21 = 0;
968
+ real A1m1, AB1, A2m1, AB2, J12;
969
+
970
+ /* Return m12b = (reduced length)/b; also calculate s12b = distance/b,
971
+ * and m0 = coefficient of secular term in expression for reduced length. */
972
+ C1f(eps, C1a);
973
+ C2f(eps, C2a);
974
+ A1m1 = A1m1f(eps);
975
+ AB1 = (1 + A1m1) * (SinCosSeries(TRUE, ssig2, csig2, C1a, nC1) -
976
+ SinCosSeries(TRUE, ssig1, csig1, C1a, nC1));
977
+ A2m1 = A2m1f(eps);
978
+ AB2 = (1 + A2m1) * (SinCosSeries(TRUE, ssig2, csig2, C2a, nC2) -
979
+ SinCosSeries(TRUE, ssig1, csig1, C2a, nC2));
980
+ m0 = A1m1 - A2m1;
981
+ J12 = m0 * sig12 + (AB1 - AB2);
982
+ /* Missing a factor of b.
983
+ * Add parens around (csig1 * ssig2) and (ssig1 * csig2) to ensure accurate
984
+ * cancellation in the case of coincident points. */
985
+ m12b = dn2 * (csig1 * ssig2) - dn1 * (ssig1 * csig2) - csig1 * csig2 * J12;
986
+ /* Missing a factor of b */
987
+ s12b = (1 + A1m1) * sig12 + AB1;
988
+ if (scalep) {
989
+ real csig12 = csig1 * csig2 + ssig1 * ssig2;
990
+ real t = g->ep2 * (cbet1 - cbet2) * (cbet1 + cbet2) / (dn1 + dn2);
991
+ M12 = csig12 + (t * ssig2 - csig2 * J12) * ssig1 / dn1;
992
+ M21 = csig12 - (t * ssig1 - csig1 * J12) * ssig2 / dn2;
993
+ }
994
+ *ps12b = s12b;
995
+ *pm12b = m12b;
996
+ *pm0 = m0;
997
+ if (scalep) {
998
+ *pM12 = M12;
999
+ *pM21 = M21;
1000
+ }
1001
+ }
1002
+
1003
+ real Astroid(real x, real y) {
1004
+ /* Solve k^4+2*k^3-(x^2+y^2-1)*k^2-2*y^2*k-y^2 = 0 for positive root k.
1005
+ * This solution is adapted from Geocentric::Reverse. */
1006
+ real k;
1007
+ real
1008
+ p = sq(x),
1009
+ q = sq(y),
1010
+ r = (p + q - 1) / 6;
1011
+ if ( !(q == 0 && r <= 0) ) {
1012
+ real
1013
+ /* Avoid possible division by zero when r = 0 by multiplying equations
1014
+ * for s and t by r^3 and r, resp. */
1015
+ S = p * q / 4, /* S = r^3 * s */
1016
+ r2 = sq(r),
1017
+ r3 = r * r2,
1018
+ /* The discrimant of the quadratic equation for T3. This is zero on
1019
+ * the evolute curve p^(1/3)+q^(1/3) = 1 */
1020
+ disc = S * (S + 2 * r3);
1021
+ real u = r;
1022
+ real v, uv, w;
1023
+ if (disc >= 0) {
1024
+ real T3 = S + r3, T;
1025
+ /* Pick the sign on the sqrt to maximize abs(T3). This minimizes loss
1026
+ * of precision due to cancellation. The result is unchanged because
1027
+ * of the way the T is used in definition of u. */
1028
+ T3 += T3 < 0 ? -sqrt(disc) : sqrt(disc); /* T3 = (r * t)^3 */
1029
+ /* N.B. cbrtx always returns the real root. cbrtx(-8) = -2. */
1030
+ T = cbrtx(T3); /* T = r * t */
1031
+ /* T can be zero; but then r2 / T -> 0. */
1032
+ u += T + (T != 0 ? r2 / T : 0);
1033
+ } else {
1034
+ /* T is complex, but the way u is defined the result is real. */
1035
+ real ang = atan2(sqrt(-disc), -(S + r3));
1036
+ /* There are three possible cube roots. We choose the root which
1037
+ * avoids cancellation. Note that disc < 0 implies that r < 0. */
1038
+ u += 2 * r * cos(ang / 3);
1039
+ }
1040
+ v = sqrt(sq(u) + q); /* guaranteed positive */
1041
+ /* Avoid loss of accuracy when u < 0. */
1042
+ uv = u < 0 ? q / (v - u) : u + v; /* u+v, guaranteed positive */
1043
+ w = (uv - q) / (2 * v); /* positive? */
1044
+ /* Rearrange expression for k to avoid loss of accuracy due to
1045
+ * subtraction. Division by 0 not possible because uv > 0, w >= 0. */
1046
+ k = uv / (sqrt(uv + sq(w)) + w); /* guaranteed positive */
1047
+ } else { /* q == 0 && r <= 0 */
1048
+ /* y = 0 with |x| <= 1. Handle this case directly.
1049
+ * for y small, positive root is k = abs(y)/sqrt(1-x^2) */
1050
+ k = 0;
1051
+ }
1052
+ return k;
1053
+ }
1054
+
1055
+ real InverseStart(const struct geod_geodesic* g,
1056
+ real sbet1, real cbet1, real dn1,
1057
+ real sbet2, real cbet2, real dn2,
1058
+ real lam12,
1059
+ real* psalp1, real* pcalp1,
1060
+ /* Only updated if return val >= 0 */
1061
+ real* psalp2, real* pcalp2,
1062
+ /* Only updated for short lines */
1063
+ real* pdnm,
1064
+ /* Scratch areas of the right size */
1065
+ real C1a[], real C2a[]) {
1066
+ real salp1 = 0, calp1 = 0, salp2 = 0, calp2 = 0, dnm = 0;
1067
+
1068
+ /* Return a starting point for Newton's method in salp1 and calp1 (function
1069
+ * value is -1). If Newton's method doesn't need to be used, return also
1070
+ * salp2 and calp2 and function value is sig12. */
1071
+ real
1072
+ sig12 = -1, /* Return value */
1073
+ /* bet12 = bet2 - bet1 in [0, pi); bet12a = bet2 + bet1 in (-pi, 0] */
1074
+ sbet12 = sbet2 * cbet1 - cbet2 * sbet1,
1075
+ cbet12 = cbet2 * cbet1 + sbet2 * sbet1;
1076
+ #if defined(__GNUC__) && __GNUC__ == 4 && \
1077
+ (__GNUC_MINOR__ < 6 || defined(__MINGW32__))
1078
+ /* Volatile declaration needed to fix inverse cases
1079
+ * 88.202499451857 0 -88.202499451857 179.981022032992859592
1080
+ * 89.262080389218 0 -89.262080389218 179.992207982775375662
1081
+ * 89.333123580033 0 -89.333123580032997687 179.99295812360148422
1082
+ * which otherwise fail with g++ 4.4.4 x86 -O3 (Linux)
1083
+ * and g++ 4.4.0 (mingw) and g++ 4.6.1 (tdm mingw). */
1084
+ real sbet12a;
1085
+ {
1086
+ volatile real xx1 = sbet2 * cbet1;
1087
+ volatile real xx2 = cbet2 * sbet1;
1088
+ sbet12a = xx1 + xx2;
1089
+ }
1090
+ #else
1091
+ real sbet12a = sbet2 * cbet1 + cbet2 * sbet1;
1092
+ #endif
1093
+ boolx shortline = cbet12 >= 0 && sbet12 < (real)(0.5) &&
1094
+ cbet2 * lam12 < (real)(0.5);
1095
+ real omg12 = lam12, somg12, comg12, ssig12, csig12;
1096
+ if (shortline) {
1097
+ real sbetm2 = sq(sbet1 + sbet2);
1098
+ /* sin((bet1+bet2)/2)^2
1099
+ * = (sbet1 + sbet2)^2 / ((sbet1 + sbet2)^2 + (cbet1 + cbet2)^2) */
1100
+ sbetm2 /= sbetm2 + sq(cbet1 + cbet2);
1101
+ dnm = sqrt(1 + g->ep2 * sbetm2);
1102
+ omg12 /= g->f1 * dnm;
1103
+ }
1104
+ somg12 = sin(omg12); comg12 = cos(omg12);
1105
+
1106
+ salp1 = cbet2 * somg12;
1107
+ calp1 = comg12 >= 0 ?
1108
+ sbet12 + cbet2 * sbet1 * sq(somg12) / (1 + comg12) :
1109
+ sbet12a - cbet2 * sbet1 * sq(somg12) / (1 - comg12);
1110
+
1111
+ ssig12 = hypotx(salp1, calp1);
1112
+ csig12 = sbet1 * sbet2 + cbet1 * cbet2 * comg12;
1113
+
1114
+ if (shortline && ssig12 < g->etol2) {
1115
+ /* really short lines */
1116
+ salp2 = cbet1 * somg12;
1117
+ calp2 = sbet12 - cbet1 * sbet2 *
1118
+ (comg12 >= 0 ? sq(somg12) / (1 + comg12) : 1 - comg12);
1119
+ SinCosNorm(&salp2, &calp2);
1120
+ /* Set return value */
1121
+ sig12 = atan2(ssig12, csig12);
1122
+ } else if (fabs(g->n) > (real)(0.1) || /* No astroid calc if too eccentric */
1123
+ csig12 >= 0 ||
1124
+ ssig12 >= 6 * fabs(g->n) * pi * sq(cbet1)) {
1125
+ /* Nothing to do, zeroth order spherical approximation is OK */
1126
+ } else {
1127
+ /* Scale lam12 and bet2 to x, y coordinate system where antipodal point
1128
+ * is at origin and singular point is at y = 0, x = -1. */
1129
+ real y, lamscale, betscale;
1130
+ /* Volatile declaration needed to fix inverse case
1131
+ * 56.320923501171 0 -56.320923501171 179.664747671772880215
1132
+ * which otherwise fails with g++ 4.4.4 x86 -O3 */
1133
+ volatile real x;
1134
+ if (g->f >= 0) { /* In fact f == 0 does not get here */
1135
+ /* x = dlong, y = dlat */
1136
+ {
1137
+ real
1138
+ k2 = sq(sbet1) * g->ep2,
1139
+ eps = k2 / (2 * (1 + sqrt(1 + k2)) + k2);
1140
+ lamscale = g->f * cbet1 * A3f(g, eps) * pi;
1141
+ }
1142
+ betscale = lamscale * cbet1;
1143
+
1144
+ x = (lam12 - pi) / lamscale;
1145
+ y = sbet12a / betscale;
1146
+ } else { /* f < 0 */
1147
+ /* x = dlat, y = dlong */
1148
+ real
1149
+ cbet12a = cbet2 * cbet1 - sbet2 * sbet1,
1150
+ bet12a = atan2(sbet12a, cbet12a);
1151
+ real m12b, m0, dummy;
1152
+ /* In the case of lon12 = 180, this repeats a calculation made in
1153
+ * Inverse. */
1154
+ Lengths(g, g->n, pi + bet12a,
1155
+ sbet1, -cbet1, dn1, sbet2, cbet2, dn2,
1156
+ cbet1, cbet2, &dummy, &m12b, &m0, FALSE,
1157
+ &dummy, &dummy, C1a, C2a);
1158
+ x = -1 + m12b / (cbet1 * cbet2 * m0 * pi);
1159
+ betscale = x < -(real)(0.01) ? sbet12a / x :
1160
+ -g->f * sq(cbet1) * pi;
1161
+ lamscale = betscale / cbet1;
1162
+ y = (lam12 - pi) / lamscale;
1163
+ }
1164
+
1165
+ if (y > -tol1 && x > -1 - xthresh) {
1166
+ /* strip near cut */
1167
+ if (g->f >= 0) {
1168
+ salp1 = minx((real)(1), -(real)(x)); calp1 = - sqrt(1 - sq(salp1));
1169
+ } else {
1170
+ calp1 = maxx((real)(x > -tol1 ? 0 : -1), (real)(x));
1171
+ salp1 = sqrt(1 - sq(calp1));
1172
+ }
1173
+ } else {
1174
+ /* Estimate alp1, by solving the astroid problem.
1175
+ *
1176
+ * Could estimate alpha1 = theta + pi/2, directly, i.e.,
1177
+ * calp1 = y/k; salp1 = -x/(1+k); for f >= 0
1178
+ * calp1 = x/(1+k); salp1 = -y/k; for f < 0 (need to check)
1179
+ *
1180
+ * However, it's better to estimate omg12 from astroid and use
1181
+ * spherical formula to compute alp1. This reduces the mean number of
1182
+ * Newton iterations for astroid cases from 2.24 (min 0, max 6) to 2.12
1183
+ * (min 0 max 5). The changes in the number of iterations are as
1184
+ * follows:
1185
+ *
1186
+ * change percent
1187
+ * 1 5
1188
+ * 0 78
1189
+ * -1 16
1190
+ * -2 0.6
1191
+ * -3 0.04
1192
+ * -4 0.002
1193
+ *
1194
+ * The histogram of iterations is (m = number of iterations estimating
1195
+ * alp1 directly, n = number of iterations estimating via omg12, total
1196
+ * number of trials = 148605):
1197
+ *
1198
+ * iter m n
1199
+ * 0 148 186
1200
+ * 1 13046 13845
1201
+ * 2 93315 102225
1202
+ * 3 36189 32341
1203
+ * 4 5396 7
1204
+ * 5 455 1
1205
+ * 6 56 0
1206
+ *
1207
+ * Because omg12 is near pi, estimate work with omg12a = pi - omg12 */
1208
+ real k = Astroid(x, y);
1209
+ real
1210
+ omg12a = lamscale * ( g->f >= 0 ? -x * k/(1 + k) : -y * (1 + k)/k );
1211
+ somg12 = sin(omg12a); comg12 = -cos(omg12a);
1212
+ /* Update spherical estimate of alp1 using omg12 instead of lam12 */
1213
+ salp1 = cbet2 * somg12;
1214
+ calp1 = sbet12a - cbet2 * sbet1 * sq(somg12) / (1 - comg12);
1215
+ }
1216
+ }
1217
+ if (salp1 > 0) /* Sanity check on starting guess */
1218
+ SinCosNorm(&salp1, &calp1);
1219
+ else {
1220
+ salp1 = 1; calp1 = 0;
1221
+ }
1222
+
1223
+ *psalp1 = salp1;
1224
+ *pcalp1 = calp1;
1225
+ if (shortline)
1226
+ *pdnm = dnm;
1227
+ if (sig12 >= 0) {
1228
+ *psalp2 = salp2;
1229
+ *pcalp2 = calp2;
1230
+ }
1231
+ return sig12;
1232
+ }
1233
+
1234
+ real Lambda12(const struct geod_geodesic* g,
1235
+ real sbet1, real cbet1, real dn1,
1236
+ real sbet2, real cbet2, real dn2,
1237
+ real salp1, real calp1,
1238
+ real* psalp2, real* pcalp2,
1239
+ real* psig12,
1240
+ real* pssig1, real* pcsig1,
1241
+ real* pssig2, real* pcsig2,
1242
+ real* peps, real* pdomg12,
1243
+ boolx diffp, real* pdlam12,
1244
+ /* Scratch areas of the right size */
1245
+ real C1a[], real C2a[], real C3a[]) {
1246
+ real salp2 = 0, calp2 = 0, sig12 = 0,
1247
+ ssig1 = 0, csig1 = 0, ssig2 = 0, csig2 = 0, eps = 0, domg12 = 0, dlam12 = 0;
1248
+ real salp0, calp0;
1249
+ real somg1, comg1, somg2, comg2, omg12, lam12;
1250
+ real B312, h0, k2;
1251
+
1252
+ if (sbet1 == 0 && calp1 == 0)
1253
+ /* Break degeneracy of equatorial line. This case has already been
1254
+ * handled. */
1255
+ calp1 = -tiny;
1256
+
1257
+ /* sin(alp1) * cos(bet1) = sin(alp0) */
1258
+ salp0 = salp1 * cbet1;
1259
+ calp0 = hypotx(calp1, salp1 * sbet1); /* calp0 > 0 */
1260
+
1261
+ /* tan(bet1) = tan(sig1) * cos(alp1)
1262
+ * tan(omg1) = sin(alp0) * tan(sig1) = tan(omg1)=tan(alp1)*sin(bet1) */
1263
+ ssig1 = sbet1; somg1 = salp0 * sbet1;
1264
+ csig1 = comg1 = calp1 * cbet1;
1265
+ SinCosNorm(&ssig1, &csig1);
1266
+ /* SinCosNorm(&somg1, &comg1); -- don't need to normalize! */
1267
+
1268
+ /* Enforce symmetries in the case abs(bet2) = -bet1. Need to be careful
1269
+ * about this case, since this can yield singularities in the Newton
1270
+ * iteration.
1271
+ * sin(alp2) * cos(bet2) = sin(alp0) */
1272
+ salp2 = cbet2 != cbet1 ? salp0 / cbet2 : salp1;
1273
+ /* calp2 = sqrt(1 - sq(salp2))
1274
+ * = sqrt(sq(calp0) - sq(sbet2)) / cbet2
1275
+ * and subst for calp0 and rearrange to give (choose positive sqrt
1276
+ * to give alp2 in [0, pi/2]). */
1277
+ calp2 = cbet2 != cbet1 || fabs(sbet2) != -sbet1 ?
1278
+ sqrt(sq(calp1 * cbet1) +
1279
+ (cbet1 < -sbet1 ?
1280
+ (cbet2 - cbet1) * (cbet1 + cbet2) :
1281
+ (sbet1 - sbet2) * (sbet1 + sbet2))) / cbet2 :
1282
+ fabs(calp1);
1283
+ /* tan(bet2) = tan(sig2) * cos(alp2)
1284
+ * tan(omg2) = sin(alp0) * tan(sig2). */
1285
+ ssig2 = sbet2; somg2 = salp0 * sbet2;
1286
+ csig2 = comg2 = calp2 * cbet2;
1287
+ SinCosNorm(&ssig2, &csig2);
1288
+ /* SinCosNorm(&somg2, &comg2); -- don't need to normalize! */
1289
+
1290
+ /* sig12 = sig2 - sig1, limit to [0, pi] */
1291
+ sig12 = atan2(maxx(csig1 * ssig2 - ssig1 * csig2, (real)(0)),
1292
+ csig1 * csig2 + ssig1 * ssig2);
1293
+
1294
+ /* omg12 = omg2 - omg1, limit to [0, pi] */
1295
+ omg12 = atan2(maxx(comg1 * somg2 - somg1 * comg2, (real)(0)),
1296
+ comg1 * comg2 + somg1 * somg2);
1297
+ k2 = sq(calp0) * g->ep2;
1298
+ eps = k2 / (2 * (1 + sqrt(1 + k2)) + k2);
1299
+ C3f(g, eps, C3a);
1300
+ B312 = (SinCosSeries(TRUE, ssig2, csig2, C3a, nC3-1) -
1301
+ SinCosSeries(TRUE, ssig1, csig1, C3a, nC3-1));
1302
+ h0 = -g->f * A3f(g, eps);
1303
+ domg12 = salp0 * h0 * (sig12 + B312);
1304
+ lam12 = omg12 + domg12;
1305
+
1306
+ if (diffp) {
1307
+ if (calp2 == 0)
1308
+ dlam12 = - 2 * g->f1 * dn1 / sbet1;
1309
+ else {
1310
+ real dummy;
1311
+ Lengths(g, eps, sig12, ssig1, csig1, dn1, ssig2, csig2, dn2,
1312
+ cbet1, cbet2, &dummy, &dlam12, &dummy,
1313
+ FALSE, &dummy, &dummy, C1a, C2a);
1314
+ dlam12 *= g->f1 / (calp2 * cbet2);
1315
+ }
1316
+ }
1317
+
1318
+ *psalp2 = salp2;
1319
+ *pcalp2 = calp2;
1320
+ *psig12 = sig12;
1321
+ *pssig1 = ssig1;
1322
+ *pcsig1 = csig1;
1323
+ *pssig2 = ssig2;
1324
+ *pcsig2 = csig2;
1325
+ *peps = eps;
1326
+ *pdomg12 = domg12;
1327
+ if (diffp)
1328
+ *pdlam12 = dlam12;
1329
+
1330
+ return lam12;
1331
+ }
1332
+
1333
+ real A3f(const struct geod_geodesic* g, real eps) {
1334
+ /* Evaluate sum(A3x[k] * eps^k, k, 0, nA3x-1) by Horner's method */
1335
+ real v = 0;
1336
+ int i;
1337
+ for (i = nA3x; i; )
1338
+ v = eps * v + g->A3x[--i];
1339
+ return v;
1340
+ }
1341
+
1342
+ void C3f(const struct geod_geodesic* g, real eps, real c[]) {
1343
+ /* Evaluate C3 coeffs by Horner's method
1344
+ * Elements c[1] thru c[nC3 - 1] are set */
1345
+ int i, j, k;
1346
+ real mult = 1;
1347
+ for (j = nC3x, k = nC3 - 1; k; ) {
1348
+ real t = 0;
1349
+ for (i = nC3 - k; i; --i)
1350
+ t = eps * t + g->C3x[--j];
1351
+ c[k--] = t;
1352
+ }
1353
+
1354
+ for (k = 1; k < nC3; ) {
1355
+ mult *= eps;
1356
+ c[k++] *= mult;
1357
+ }
1358
+ }
1359
+
1360
+ void C4f(const struct geod_geodesic* g, real eps, real c[]) {
1361
+ /* Evaluate C4 coeffs by Horner's method
1362
+ * Elements c[0] thru c[nC4 - 1] are set */
1363
+ int i, j, k;
1364
+ real mult = 1;
1365
+ for (j = nC4x, k = nC4; k; ) {
1366
+ real t = 0;
1367
+ for (i = nC4 - k + 1; i; --i)
1368
+ t = eps * t + g->C4x[--j];
1369
+ c[--k] = t;
1370
+ }
1371
+
1372
+ for (k = 1; k < nC4; ) {
1373
+ mult *= eps;
1374
+ c[k++] *= mult;
1375
+ }
1376
+ }
1377
+
1378
+ /* Generated by Maxima on 2010-09-04 10:26:17-04:00 */
1379
+
1380
+ /* The scale factor A1-1 = mean value of (d/dsigma)I1 - 1 */
1381
+ real A1m1f(real eps) {
1382
+ real
1383
+ eps2 = sq(eps),
1384
+ t = eps2*(eps2*(eps2+4)+64)/256;
1385
+ return (t + eps) / (1 - eps);
1386
+ }
1387
+
1388
+ /* The coefficients C1[l] in the Fourier expansion of B1 */
1389
+ void C1f(real eps, real c[]) {
1390
+ real
1391
+ eps2 = sq(eps),
1392
+ d = eps;
1393
+ c[1] = d*((6-eps2)*eps2-16)/32;
1394
+ d *= eps;
1395
+ c[2] = d*((64-9*eps2)*eps2-128)/2048;
1396
+ d *= eps;
1397
+ c[3] = d*(9*eps2-16)/768;
1398
+ d *= eps;
1399
+ c[4] = d*(3*eps2-5)/512;
1400
+ d *= eps;
1401
+ c[5] = -7*d/1280;
1402
+ d *= eps;
1403
+ c[6] = -7*d/2048;
1404
+ }
1405
+
1406
+ /* The coefficients C1p[l] in the Fourier expansion of B1p */
1407
+ void C1pf(real eps, real c[]) {
1408
+ real
1409
+ eps2 = sq(eps),
1410
+ d = eps;
1411
+ c[1] = d*(eps2*(205*eps2-432)+768)/1536;
1412
+ d *= eps;
1413
+ c[2] = d*(eps2*(4005*eps2-4736)+3840)/12288;
1414
+ d *= eps;
1415
+ c[3] = d*(116-225*eps2)/384;
1416
+ d *= eps;
1417
+ c[4] = d*(2695-7173*eps2)/7680;
1418
+ d *= eps;
1419
+ c[5] = 3467*d/7680;
1420
+ d *= eps;
1421
+ c[6] = 38081*d/61440;
1422
+ }
1423
+
1424
+ /* The scale factor A2-1 = mean value of (d/dsigma)I2 - 1 */
1425
+ real A2m1f(real eps) {
1426
+ real
1427
+ eps2 = sq(eps),
1428
+ t = eps2*(eps2*(25*eps2+36)+64)/256;
1429
+ return t * (1 - eps) - eps;
1430
+ }
1431
+
1432
+ /* The coefficients C2[l] in the Fourier expansion of B2 */
1433
+ void C2f(real eps, real c[]) {
1434
+ real
1435
+ eps2 = sq(eps),
1436
+ d = eps;
1437
+ c[1] = d*(eps2*(eps2+2)+16)/32;
1438
+ d *= eps;
1439
+ c[2] = d*(eps2*(35*eps2+64)+384)/2048;
1440
+ d *= eps;
1441
+ c[3] = d*(15*eps2+80)/768;
1442
+ d *= eps;
1443
+ c[4] = d*(7*eps2+35)/512;
1444
+ d *= eps;
1445
+ c[5] = 63*d/1280;
1446
+ d *= eps;
1447
+ c[6] = 77*d/2048;
1448
+ }
1449
+
1450
+ /* The scale factor A3 = mean value of (d/dsigma)I3 */
1451
+ void A3coeff(struct geod_geodesic* g) {
1452
+ g->A3x[0] = 1;
1453
+ g->A3x[1] = (g->n-1)/2;
1454
+ g->A3x[2] = (g->n*(3*g->n-1)-2)/8;
1455
+ g->A3x[3] = ((-g->n-3)*g->n-1)/16;
1456
+ g->A3x[4] = (-2*g->n-3)/64;
1457
+ g->A3x[5] = -3/(real)(128);
1458
+ }
1459
+
1460
+ /* The coefficients C3[l] in the Fourier expansion of B3 */
1461
+ void C3coeff(struct geod_geodesic* g) {
1462
+ g->C3x[0] = (1-g->n)/4;
1463
+ g->C3x[1] = (1-g->n*g->n)/8;
1464
+ g->C3x[2] = ((3-g->n)*g->n+3)/64;
1465
+ g->C3x[3] = (2*g->n+5)/128;
1466
+ g->C3x[4] = 3/(real)(128);
1467
+ g->C3x[5] = ((g->n-3)*g->n+2)/32;
1468
+ g->C3x[6] = ((-3*g->n-2)*g->n+3)/64;
1469
+ g->C3x[7] = (g->n+3)/128;
1470
+ g->C3x[8] = 5/(real)(256);
1471
+ g->C3x[9] = (g->n*(5*g->n-9)+5)/192;
1472
+ g->C3x[10] = (9-10*g->n)/384;
1473
+ g->C3x[11] = 7/(real)(512);
1474
+ g->C3x[12] = (7-14*g->n)/512;
1475
+ g->C3x[13] = 7/(real)(512);
1476
+ g->C3x[14] = 21/(real)(2560);
1477
+ }
1478
+
1479
+ /* Generated by Maxima on 2012-10-19 08:02:34-04:00 */
1480
+
1481
+ /* The coefficients C4[l] in the Fourier expansion of I4 */
1482
+ void C4coeff(struct geod_geodesic* g) {
1483
+ g->C4x[0] = (g->n*(g->n*(g->n*(g->n*(100*g->n+208)+572)+3432)-12012)+30030)/
1484
+ 45045;
1485
+ g->C4x[1] = (g->n*(g->n*(g->n*(64*g->n+624)-4576)+6864)-3003)/15015;
1486
+ g->C4x[2] = (g->n*((14144-10656*g->n)*g->n-4576)-858)/45045;
1487
+ g->C4x[3] = ((-224*g->n-4784)*g->n+1573)/45045;
1488
+ g->C4x[4] = (1088*g->n+156)/45045;
1489
+ g->C4x[5] = 97/(real)(15015);
1490
+ g->C4x[6] = (g->n*(g->n*((-64*g->n-624)*g->n+4576)-6864)+3003)/135135;
1491
+ g->C4x[7] = (g->n*(g->n*(5952*g->n-11648)+9152)-2574)/135135;
1492
+ g->C4x[8] = (g->n*(5792*g->n+1040)-1287)/135135;
1493
+ g->C4x[9] = (468-2944*g->n)/135135;
1494
+ g->C4x[10] = 1/(real)(9009);
1495
+ g->C4x[11] = (g->n*((4160-1440*g->n)*g->n-4576)+1716)/225225;
1496
+ g->C4x[12] = ((4992-8448*g->n)*g->n-1144)/225225;
1497
+ g->C4x[13] = (1856*g->n-936)/225225;
1498
+ g->C4x[14] = 8/(real)(10725);
1499
+ g->C4x[15] = (g->n*(3584*g->n-3328)+1144)/315315;
1500
+ g->C4x[16] = (1024*g->n-208)/105105;
1501
+ g->C4x[17] = -136/(real)(63063);
1502
+ g->C4x[18] = (832-2560*g->n)/405405;
1503
+ g->C4x[19] = -128/(real)(135135);
1504
+ g->C4x[20] = 128/(real)(99099);
1505
+ }
1506
+
1507
+ int transit(real lon1, real lon2) {
1508
+ real lon12;
1509
+ /* Return 1 or -1 if crossing prime meridian in east or west direction.
1510
+ * Otherwise return zero. */
1511
+ /* Compute lon12 the same way as Geodesic::Inverse. */
1512
+ lon1 = AngNormalize(lon1);
1513
+ lon2 = AngNormalize(lon2);
1514
+ lon12 = AngDiff(lon1, lon2);
1515
+ return lon1 < 0 && lon2 >= 0 && lon12 > 0 ? 1 :
1516
+ (lon2 < 0 && lon1 >= 0 && lon12 < 0 ? -1 : 0);
1517
+ }
1518
+
1519
+ void accini(real s[]) {
1520
+ /* Initialize an accumulator; this is an array with two elements. */
1521
+ s[0] = s[1] = 0;
1522
+ }
1523
+
1524
+ void acccopy(const real s[], real t[]) {
1525
+ /* Copy an accumulator; t = s. */
1526
+ t[0] = s[0]; t[1] = s[1];
1527
+ }
1528
+
1529
+ void accadd(real s[], real y) {
1530
+ /* Add y to an accumulator. */
1531
+ real u, z = sumx(y, s[1], &u);
1532
+ s[0] = sumx(z, s[0], &s[1]);
1533
+ if (s[0] == 0)
1534
+ s[0] = u;
1535
+ else
1536
+ s[1] = s[1] + u;
1537
+ }
1538
+
1539
+ real accsum(const real s[], real y) {
1540
+ /* Return accumulator + y (but don't add to accumulator). */
1541
+ real t[2];
1542
+ acccopy(s, t);
1543
+ accadd(t, y);
1544
+ return t[0];
1545
+ }
1546
+
1547
+ void accneg(real s[]) {
1548
+ /* Negate an accumulator. */
1549
+ s[0] = -s[0]; s[1] = -s[1];
1550
+ }
1551
+
1552
+ void geod_polygon_init(struct geod_polygon* p, boolx polylinep) {
1553
+ p->lat0 = p->lon0 = p->lat = p->lon = NaN;
1554
+ p->polyline = (polylinep != 0);
1555
+ accini(p->P);
1556
+ accini(p->A);
1557
+ p->num = p->crossings = 0;
1558
+ }
1559
+
1560
+ void geod_polygon_addpoint(const struct geod_geodesic* g,
1561
+ struct geod_polygon* p,
1562
+ real lat, real lon) {
1563
+ lon = AngNormalize(lon);
1564
+ if (p->num == 0) {
1565
+ p->lat0 = p->lat = lat;
1566
+ p->lon0 = p->lon = lon;
1567
+ } else {
1568
+ real s12, S12;
1569
+ geod_geninverse(g, p->lat, p->lon, lat, lon,
1570
+ &s12, 0, 0, 0, 0, 0, p->polyline ? 0 : &S12);
1571
+ accadd(p->P, s12);
1572
+ if (!p->polyline) {
1573
+ accadd(p->A, S12);
1574
+ p->crossings += transit(p->lon, lon);
1575
+ }
1576
+ p->lat = lat; p->lon = lon;
1577
+ }
1578
+ ++p->num;
1579
+ }
1580
+
1581
+ void geod_polygon_addedge(const struct geod_geodesic* g,
1582
+ struct geod_polygon* p,
1583
+ real azi, real s) {
1584
+ if (p->num) { /* Do nothing is num is zero */
1585
+ real lat, lon, S12;
1586
+ geod_gendirect(g, p->lat, p->lon, azi, FALSE, s,
1587
+ &lat, &lon, 0,
1588
+ 0, 0, 0, 0, p->polyline ? 0 : &S12);
1589
+ accadd(p->P, s);
1590
+ if (!p->polyline) {
1591
+ accadd(p->A, S12);
1592
+ p->crossings += transit(p->lon, lon);
1593
+ }
1594
+ p->lat = lat; p->lon = lon;
1595
+ ++p->num;
1596
+ }
1597
+ }
1598
+
1599
+ unsigned geod_polygon_compute(const struct geod_geodesic* g,
1600
+ const struct geod_polygon* p,
1601
+ boolx reverse, boolx sign,
1602
+ real* pA, real* pP) {
1603
+ real s12, S12, t[2], area0;
1604
+ int crossings;
1605
+ if (p->num < 2) {
1606
+ if (pP) *pP = 0;
1607
+ if (!p->polyline && pA) *pA = 0;
1608
+ return p->num;
1609
+ }
1610
+ if (p->polyline) {
1611
+ if (pP) *pP = p->P[0];
1612
+ return p->num;
1613
+ }
1614
+ geod_geninverse(g, p->lat, p->lon, p->lat0, p->lon0,
1615
+ &s12, 0, 0, 0, 0, 0, &S12);
1616
+ if (pP) *pP = accsum(p->P, s12);
1617
+ acccopy(p->A, t);
1618
+ accadd(t, S12);
1619
+ crossings = p->crossings + transit(p->lon, p->lon0);
1620
+ area0 = 4 * pi * g->c2;
1621
+ if (crossings & 1)
1622
+ accadd(t, (t[0] < 0 ? 1 : -1) * area0/2);
1623
+ /* area is with the clockwise sense. If !reverse convert to
1624
+ * counter-clockwise convention. */
1625
+ if (!reverse)
1626
+ accneg(t);
1627
+ /* If sign put area in (-area0/2, area0/2], else put area in [0, area0) */
1628
+ if (sign) {
1629
+ if (t[0] > area0/2)
1630
+ accadd(t, -area0);
1631
+ else if (t[0] <= -area0/2)
1632
+ accadd(t, +area0);
1633
+ } else {
1634
+ if (t[0] >= area0)
1635
+ accadd(t, -area0);
1636
+ else if (t[0] < 0)
1637
+ accadd(t, +area0);
1638
+ }
1639
+ if (pA) *pA = 0 + t[0];
1640
+ return p->num;
1641
+ }
1642
+
1643
+ unsigned geod_polygon_testpoint(const struct geod_geodesic* g,
1644
+ const struct geod_polygon* p,
1645
+ real lat, real lon,
1646
+ boolx reverse, boolx sign,
1647
+ real* pA, real* pP) {
1648
+ real perimeter, tempsum, area0;
1649
+ int crossings, i;
1650
+ unsigned num = p->num + 1;
1651
+ if (num == 1) {
1652
+ if (pP) *pP = 0;
1653
+ if (!p->polyline && pA) *pA = 0;
1654
+ return num;
1655
+ }
1656
+ perimeter = p->P[0];
1657
+ tempsum = p->polyline ? 0 : p->A[0];
1658
+ crossings = p->crossings;
1659
+ for (i = 0; i < (p->polyline ? 1 : 2); ++i) {
1660
+ real s12, S12;
1661
+ geod_geninverse(g,
1662
+ i == 0 ? p->lat : lat, i == 0 ? p->lon : lon,
1663
+ i != 0 ? p->lat0 : lat, i != 0 ? p->lon0 : lon,
1664
+ &s12, 0, 0, 0, 0, 0, p->polyline ? 0 : &S12);
1665
+ perimeter += s12;
1666
+ if (!p->polyline) {
1667
+ tempsum += S12;
1668
+ crossings += transit(i == 0 ? p->lon : lon,
1669
+ i != 0 ? p->lon0 : lon);
1670
+ }
1671
+ }
1672
+
1673
+ if (pP) *pP = perimeter;
1674
+ if (p->polyline)
1675
+ return num;
1676
+
1677
+ area0 = 4 * pi * g->c2;
1678
+ if (crossings & 1)
1679
+ tempsum += (tempsum < 0 ? 1 : -1) * area0/2;
1680
+ /* area is with the clockwise sense. If !reverse convert to
1681
+ * counter-clockwise convention. */
1682
+ if (!reverse)
1683
+ tempsum *= -1;
1684
+ /* If sign put area in (-area0/2, area0/2], else put area in [0, area0) */
1685
+ if (sign) {
1686
+ if (tempsum > area0/2)
1687
+ tempsum -= area0;
1688
+ else if (tempsum <= -area0/2)
1689
+ tempsum += area0;
1690
+ } else {
1691
+ if (tempsum >= area0)
1692
+ tempsum -= area0;
1693
+ else if (tempsum < 0)
1694
+ tempsum += area0;
1695
+ }
1696
+ if (pA) *pA = 0 + tempsum;
1697
+ return num;
1698
+ }
1699
+
1700
+ unsigned geod_polygon_testedge(const struct geod_geodesic* g,
1701
+ const struct geod_polygon* p,
1702
+ real azi, real s,
1703
+ boolx reverse, boolx sign,
1704
+ real* pA, real* pP) {
1705
+ real perimeter, tempsum, area0;
1706
+ int crossings;
1707
+ unsigned num = p->num + 1;
1708
+ if (num == 1) { /* we don't have a starting point! */
1709
+ if (pP) *pP = NaN;
1710
+ if (!p->polyline && pA) *pA = NaN;
1711
+ return 0;
1712
+ }
1713
+ perimeter = p->P[0] + s;
1714
+ if (p->polyline) {
1715
+ if (pP) *pP = perimeter;
1716
+ return num;
1717
+ }
1718
+
1719
+ tempsum = p->A[0];
1720
+ crossings = p->crossings;
1721
+ {
1722
+ real lat, lon, s12, S12;
1723
+ geod_gendirect(g, p->lat, p->lon, azi, FALSE, s,
1724
+ &lat, &lon, 0,
1725
+ 0, 0, 0, 0, &S12);
1726
+ tempsum += S12;
1727
+ crossings += transit(p->lon, lon);
1728
+ geod_geninverse(g, lat, lon, p->lat0, p->lon0,
1729
+ &s12, 0, 0, 0, 0, 0, &S12);
1730
+ perimeter += s12;
1731
+ tempsum += S12;
1732
+ crossings += transit(lon, p->lon0);
1733
+ }
1734
+
1735
+ area0 = 4 * pi * g->c2;
1736
+ if (crossings & 1)
1737
+ tempsum += (tempsum < 0 ? 1 : -1) * area0/2;
1738
+ /* area is with the clockwise sense. If !reverse convert to
1739
+ * counter-clockwise convention. */
1740
+ if (!reverse)
1741
+ tempsum *= -1;
1742
+ /* If sign put area in (-area0/2, area0/2], else put area in [0, area0) */
1743
+ if (sign) {
1744
+ if (tempsum > area0/2)
1745
+ tempsum -= area0;
1746
+ else if (tempsum <= -area0/2)
1747
+ tempsum += area0;
1748
+ } else {
1749
+ if (tempsum >= area0)
1750
+ tempsum -= area0;
1751
+ else if (tempsum < 0)
1752
+ tempsum += area0;
1753
+ }
1754
+ if (pP) *pP = perimeter;
1755
+ if (pA) *pA = 0 + tempsum;
1756
+ return num;
1757
+ }
1758
+
1759
+ void geod_polygonarea(const struct geod_geodesic* g,
1760
+ real lats[], real lons[], int n,
1761
+ real* pA, real* pP) {
1762
+ int i;
1763
+ struct geod_polygon p;
1764
+ geod_polygon_init(&p, FALSE);
1765
+ for (i = 0; i < n; ++i)
1766
+ geod_polygon_addpoint(g, &p, lats[i], lons[i]);
1767
+ geod_polygon_compute(g, &p, FALSE, TRUE, pA, pP);
1768
+ }
1769
+
1770
+ /** @endcond */