geodesic_wgs84 1.32.1

Sign up to get free protection for your applications and to get access to all the features.
@@ -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 */