Fortran library for Geodesics  1.52
geodtest.for
Go to the documentation of this file.
1 *> @file geodtest.for
2 *! @brief Test suite for the geodesic routines in Fortran
3 *!
4 *! Run these tests by configuring with cmake and running "make test".
5 *!
6 *! Copyright (c) Charles Karney (2015-2021) <charles@karney.com> and
7 *! licensed under the MIT/X11 License. For more information, see
8 *! https://geographiclib.sourceforge.io/
9 
10 *> @cond SKIP
11 
12  block data tests
13 
14  integer j
15  double precision tstdat(20, 12)
16  common /tstcom/ tstdat
17  data (tstdat(1,j), j = 1,12) /
18  + 35.60777d0,-139.44815d0,111.098748429560326d0,
19  + -11.17491d0,-69.95921d0,129.289270889708762d0,
20  + 8935244.5604818305d0,80.50729714281974d0,6273170.2055303837d0,
21  + 0.16606318447386067d0,0.16479116945612937d0,
22  + 12841384694976.432d0 /
23  data (tstdat(2,j), j = 1,12) /
24  + 55.52454d0,106.05087d0,22.020059880982801d0,
25  + 77.03196d0,197.18234d0,109.112041110671519d0,
26  + 4105086.1713924406d0,36.892740690445894d0,
27  + 3828869.3344387607d0,
28  + 0.80076349608092607d0,0.80101006984201008d0,
29  + 61674961290615.615d0 /
30  data (tstdat(3,j), j = 1,12) /
31  + -21.97856d0,142.59065d0,-32.44456876433189d0,
32  + 41.84138d0,98.56635d0,-41.84359951440466d0,
33  + 8394328.894657671d0,75.62930491011522d0,6161154.5773110616d0,
34  + 0.24816339233950381d0,0.24930251203627892d0,
35  + -6637997720646.717d0 /
36  data (tstdat(4,j), j = 1,12) /
37  + -66.99028d0,112.2363d0,173.73491240878403d0,
38  + -12.70631d0,285.90344d0,2.512956620913668d0,
39  + 11150344.2312080241d0,100.278634181155759d0,
40  + 6289939.5670446687d0,
41  + -0.17199490274700385d0,-0.17722569526345708d0,
42  + -121287239862139.744d0 /
43  data (tstdat(5,j), j = 1,12) /
44  + -17.42761d0,173.34268d0,-159.033557661192928d0,
45  + -15.84784d0,5.93557d0,-20.787484651536988d0,
46  + 16076603.1631180673d0,144.640108810286253d0,
47  + 3732902.1583877189d0,
48  + -0.81273638700070476d0,-0.81299800519154474d0,
49  + 97825992354058.708d0 /
50  data (tstdat(6,j), j = 1,12) /
51  + 32.84994d0,48.28919d0,150.492927788121982d0,
52  + -56.28556d0,202.29132d0,48.113449399816759d0,
53  + 16727068.9438164461d0,150.565799985466607d0,
54  + 3147838.1910180939d0,
55  + -0.87334918086923126d0,-0.86505036767110637d0,
56  + -72445258525585.010d0 /
57  data (tstdat(7,j), j = 1,12) /
58  + 6.96833d0,52.74123d0,92.581585386317712d0,
59  + -7.39675d0,206.17291d0,90.721692165923907d0,
60  + 17102477.2496958388d0,154.147366239113561d0,
61  + 2772035.6169917581d0,
62  + -0.89991282520302447d0,-0.89986892177110739d0,
63  + -1311796973197.995d0 /
64  data (tstdat(8,j), j = 1,12) /
65  + -50.56724d0,-16.30485d0,-105.439679907590164d0,
66  + -33.56571d0,-94.97412d0,-47.348547835650331d0,
67  + 6455670.5118668696d0,58.083719495371259d0,
68  + 5409150.7979815838d0,
69  + 0.53053508035997263d0,0.52988722644436602d0,
70  + 41071447902810.047d0 /
71  data (tstdat(9,j), j = 1,12) /
72  + -58.93002d0,-8.90775d0,140.965397902500679d0,
73  + -8.91104d0,133.13503d0,19.255429433416599d0,
74  + 11756066.0219864627d0,105.755691241406877d0,
75  + 6151101.2270708536d0,
76  + -0.26548622269867183d0,-0.27068483874510741d0,
77  + -86143460552774.735d0 /
78  data (tstdat(10,j), j = 1,12) /
79  + -68.82867d0,-74.28391d0,93.774347763114881d0,
80  + -50.63005d0,-8.36685d0,34.65564085411343d0,
81  + 3956936.926063544d0,35.572254987389284d0,3708890.9544062657d0,
82  + 0.81443963736383502d0,0.81420859815358342d0,
83  + -41845309450093.787d0 /
84  data (tstdat(11,j), j = 1,12) /
85  + -10.62672d0,-32.0898d0,-86.426713286747751d0,
86  + 5.883d0,-134.31681d0,-80.473780971034875d0,
87  + 11470869.3864563009d0,103.387395634504061d0,
88  + 6184411.6622659713d0,
89  + -0.23138683500430237d0,-0.23155097622286792d0,
90  + 4198803992123.548d0 /
91  data (tstdat(12,j), j = 1,12) /
92  + -21.76221d0,166.90563d0,29.319421206936428d0,
93  + 48.72884d0,213.97627d0,43.508671946410168d0,
94  + 9098627.3986554915d0,81.963476716121964d0,
95  + 6299240.9166992283d0,
96  + 0.13965943368590333d0,0.14152969707656796d0,
97  + 10024709850277.476d0 /
98  data (tstdat(13,j), j = 1,12) /
99  + -19.79938d0,-174.47484d0,71.167275780171533d0,
100  + -11.99349d0,-154.35109d0,65.589099775199228d0,
101  + 2319004.8601169389d0,20.896611684802389d0,
102  + 2267960.8703918325d0,
103  + 0.93427001867125849d0,0.93424887135032789d0,
104  + -3935477535005.785d0 /
105  data (tstdat(14,j), j = 1,12) /
106  + -11.95887d0,-116.94513d0,92.712619830452549d0,
107  + 4.57352d0,7.16501d0,78.64960934409585d0,
108  + 13834722.5801401374d0,124.688684161089762d0,
109  + 5228093.177931598d0,
110  + -0.56879356755666463d0,-0.56918731952397221d0,
111  + -9919582785894.853d0 /
112  data (tstdat(15,j), j = 1,12) /
113  + -87.85331d0,85.66836d0,-65.120313040242748d0,
114  + 66.48646d0,16.09921d0,-4.888658719272296d0,
115  + 17286615.3147144645d0,155.58592449699137d0,
116  + 2635887.4729110181d0,
117  + -0.90697975771398578d0,-0.91095608883042767d0,
118  + 42667211366919.534d0 /
119  data (tstdat(16,j), j = 1,12) /
120  + 1.74708d0,128.32011d0,-101.584843631173858d0,
121  + -11.16617d0,11.87109d0,-86.325793296437476d0,
122  + 12942901.1241347408d0,116.650512484301857d0,
123  + 5682744.8413270572d0,
124  + -0.44857868222697644d0,-0.44824490340007729d0,
125  + 10763055294345.653d0 /
126  data (tstdat(17,j), j = 1,12) /
127  + -25.72959d0,-144.90758d0,-153.647468693117198d0,
128  + -57.70581d0,-269.17879d0,-48.343983158876487d0,
129  + 9413446.7452453107d0,84.664533838404295d0,
130  + 6356176.6898881281d0,
131  + 0.09492245755254703d0,0.09737058264766572d0,
132  + 74515122850712.444d0 /
133  data (tstdat(18,j), j = 1,12) /
134  + -41.22777d0,122.32875d0,14.285113402275739d0,
135  + -7.57291d0,130.37946d0,10.805303085187369d0,
136  + 3812686.035106021d0,34.34330804743883d0,3588703.8812128856d0,
137  + 0.82605222593217889d0,0.82572158200920196d0,
138  + -2456961531057.857d0 /
139  data (tstdat(19,j), j = 1,12) /
140  + 11.01307d0,138.25278d0,79.43682622782374d0,
141  + 6.62726d0,247.05981d0,103.708090215522657d0,
142  + 11911190.819018408d0,107.341669954114577d0,
143  + 6070904.722786735d0,
144  + -0.29767608923657404d0,-0.29785143390252321d0,
145  + 17121631423099.696d0 /
146  data (tstdat(20,j), j = 1,12) /
147  + -29.47124d0,95.14681d0,-163.779130441688382d0,
148  + -27.46601d0,-69.15955d0,-15.909335945554969d0,
149  + 13487015.8381145492d0,121.294026715742277d0,
150  + 5481428.9945736388d0,
151  + -0.51527225545373252d0,-0.51556587964721788d0,
152  + 104679964020340.318d0 /
153  end
154 
155  integer function assert(x, y, d)
156  double precision x, y, d
157 
158  if (abs(x - y) .le. d) then
159  assert = 0
160  else
161  assert = 1
162  print 10, x, y, d
163  10 format(1x, 'assert fails: ',
164  + g14.7, ' != ', g14.7, ' +/- ', g10.3)
165  end if
166 
167  return
168  end
169 
170  integer function chknan(x)
171  double precision x
172 
173  if (x .ne. x) then
174  chknan = 0
175  else
176  chknan = 1
177  end if
178 
179  return
180  end
181 
182  integer function tstinv()
183  double precision tstdat(20, 12)
184  common /tstcom/ tstdat
185  double precision lat1, lon1, azi1, lat2, lon2, azi2,
186  + s12, a12, m12, MM12, MM21, SS12
187  double precision azi1a, azi2a, s12a, a12a,
188  + m12a, MM12a, MM21a, SS12a
189  double precision a, f
190  integer r, assert, i, omask
191  include 'geodesic.inc'
192 
193 * WGS84 values
194  a = 6378137d0
195  f = 1/298.257223563d0
196  omask = 1 + 2 + 4 + 8
197  r = 0
198 
199  do 10 i = 1,20
200  lat1 = tstdat(i, 1)
201  lon1 = tstdat(i, 2)
202  azi1 = tstdat(i, 3)
203  lat2 = tstdat(i, 4)
204  lon2 = tstdat(i, 5)
205  azi2 = tstdat(i, 6)
206  s12 = tstdat(i, 7)
207  a12 = tstdat(i, 8)
208  m12 = tstdat(i, 9)
209  mm12 = tstdat(i, 10)
210  mm21 = tstdat(i, 11)
211  ss12 = tstdat(i, 12)
212  call invers(a, f, lat1, lon1, lat2, lon2,
213  + s12a, azi1a, azi2a, omask, a12a, m12a, mm12a, mm21a, ss12a)
214  r = r + assert(azi1, azi1a, 1d-13)
215  r = r + assert(azi2, azi2a, 1d-13)
216  r = r + assert(s12, s12a, 1d-8)
217  r = r + assert(a12, a12a, 1d-13)
218  r = r + assert(m12, m12a, 1d-8)
219  r = r + assert(mm12, mm12a, 1d-15)
220  r = r + assert(mm21, mm21a, 1d-15)
221  r = r + assert(ss12, ss12a, 0.1d0)
222  10 continue
223 
224  tstinv = r
225  return
226  end
227 
228  integer function tstdir()
229  double precision tstdat(20, 12)
230  common /tstcom/ tstdat
231  double precision lat1, lon1, azi1, lat2, lon2, azi2,
232  + s12, a12, m12, MM12, MM21, SS12
233  double precision lat2a, lon2a, azi2a, a12a,
234  + m12a, MM12a, MM21a, SS12a
235  double precision a, f
236  integer r, assert, i, omask, flags
237  include 'geodesic.inc'
238 
239 * WGS84 values
240  a = 6378137d0
241  f = 1/298.257223563d0
242  omask = 1 + 2 + 4 + 8
243  flags = 2
244  r = 0
245 
246  do 10 i = 1,20
247  lat1 = tstdat(i, 1)
248  lon1 = tstdat(i, 2)
249  azi1 = tstdat(i, 3)
250  lat2 = tstdat(i, 4)
251  lon2 = tstdat(i, 5)
252  azi2 = tstdat(i, 6)
253  s12 = tstdat(i, 7)
254  a12 = tstdat(i, 8)
255  m12 = tstdat(i, 9)
256  mm12 = tstdat(i, 10)
257  mm21 = tstdat(i, 11)
258  ss12 = tstdat(i, 12)
259  call direct(a, f, lat1, lon1, azi1, s12, flags,
260  + lat2a, lon2a, azi2a, omask, a12a, m12a, mm12a, mm21a, ss12a)
261  r = r + assert(lat2, lat2a, 1d-13)
262  r = r + assert(lon2, lon2a, 1d-13)
263  r = r + assert(azi2, azi2a, 1d-13)
264  r = r + assert(a12, a12a, 1d-13)
265  r = r + assert(m12, m12a, 1d-8)
266  r = r + assert(mm12, mm12a, 1d-15)
267  r = r + assert(mm21, mm21a, 1d-15)
268  r = r + assert(ss12, ss12a, 0.1d0)
269  10 continue
270 
271  tstdir = r
272  return
273  end
274 
275  integer function tstarc()
276  double precision tstdat(20, 12)
277  common /tstcom/ tstdat
278  double precision lat1, lon1, azi1, lat2, lon2, azi2,
279  + s12, a12, m12, MM12, MM21, SS12
280  double precision lat2a, lon2a, azi2a, s12a,
281  + m12a, MM12a, MM21a, SS12a
282  double precision a, f
283  integer r, assert, i, omask, flags
284  include 'geodesic.inc'
285 
286 * WGS84 values
287  a = 6378137d0
288  f = 1/298.257223563d0
289  omask = 1 + 2 + 4 + 8
290  flags = 1 + 2
291  r = 0
292 
293  do 10 i = 1,20
294  lat1 = tstdat(i, 1)
295  lon1 = tstdat(i, 2)
296  azi1 = tstdat(i, 3)
297  lat2 = tstdat(i, 4)
298  lon2 = tstdat(i, 5)
299  azi2 = tstdat(i, 6)
300  s12 = tstdat(i, 7)
301  a12 = tstdat(i, 8)
302  m12 = tstdat(i, 9)
303  mm12 = tstdat(i, 10)
304  mm21 = tstdat(i, 11)
305  ss12 = tstdat(i, 12)
306  call direct(a, f, lat1, lon1, azi1, a12, flags,
307  + lat2a, lon2a, azi2a, omask, s12a, m12a, mm12a, mm21a, ss12a)
308  r = r + assert(lat2, lat2a, 1d-13)
309  r = r + assert(lon2, lon2a, 1d-13)
310  r = r + assert(azi2, azi2a, 1d-13)
311  r = r + assert(s12, s12a, 1d-8)
312  r = r + assert(m12, m12a, 1d-8)
313  r = r + assert(mm12, mm12a, 1d-15)
314  r = r + assert(mm21, mm21a, 1d-15)
315  r = r + assert(ss12, ss12a, 0.1d0)
316  10 continue
317 
318  tstarc = r
319  return
320  end
321 
322  integer function tstg0()
323  double precision azi1, azi2, s12, a12, m12, MM12, MM21, SS12
324  double precision a, f
325  integer r, assert, omask
326  include 'geodesic.inc'
327 
328 * WGS84 values
329  a = 6378137d0
330  f = 1/298.257223563d0
331  omask = 0
332  r = 0
333  call invers(a, f, 40.6d0, -73.8d0, 49.01666667d0, 2.55d0,
334  + s12, azi1, azi2, omask, a12, m12, mm12, mm21, ss12)
335  r = r + assert(azi1, 53.47022d0, 0.5d-5)
336  r = r + assert(azi2, 111.59367d0, 0.5d-5)
337  r = r + assert(s12, 5853226d0, 0.5d0)
338 
339  tstg0 = r
340  return
341  end
342 
343  integer function tstg1()
344  double precision lat2, lon2, azi2, a12, m12, MM12, MM21, SS12
345  double precision a, f
346  integer r, assert, omask, flags
347  include 'geodesic.inc'
348 
349 * WGS84 values
350  a = 6378137d0
351  f = 1/298.257223563d0
352  omask = 0
353  flags = 0
354  r = 0
355  call direct(a, f, 40.63972222d0, -73.77888889d0, 53.5d0, 5850d3,
356  + flags, lat2, lon2, azi2, omask, a12, m12, mm12, mm21, ss12)
357  r = r + assert(lat2, 49.01467d0, 0.5d-5)
358  r = r + assert(lon2, 2.56106d0, 0.5d-5)
359  r = r + assert(azi2, 111.62947d0, 0.5d-5)
360 
361  tstg1 = r
362  return
363  end
364 
365  integer function tstg2()
366 * Check fix for antipodal prolate bug found 2010-09-04
367  double precision azi1, azi2, s12, a12, m12, MM12, MM21, SS12
368  double precision a, f
369  integer r, assert, omask
370  include 'geodesic.inc'
371 
372  a = 6.4d6
373  f = -1/150d0
374  omask = 0
375  r = 0
376  call invers(a, f, 0.07476d0, 0d0, -0.07476d0, 180d0,
377  + s12, azi1, azi2, omask, a12, m12, mm12, mm21, ss12)
378  r = r + assert(azi1, 90.00078d0, 0.5d-5)
379  r = r + assert(azi2, 90.00078d0, 0.5d-5)
380  r = r + assert(s12, 20106193d0, 0.5d0)
381  call invers(a, f, 0.1d0, 0d0, -0.1d0, 180d0,
382  + s12, azi1, azi2, omask, a12, m12, mm12, mm21, ss12)
383  r = r + assert(azi1, 90.00105d0, 0.5d-5)
384  r = r + assert(azi2, 90.00105d0, 0.5d-5)
385  r = r + assert(s12, 20106193d0, 0.5d0)
386 
387  tstg2 = r
388  return
389  end
390 
391  integer function tstg4()
392 * Check fix for short line bug found 2010-05-21
393  double precision azi1, azi2, s12, a12, m12, MM12, MM21, SS12
394  double precision a, f
395  integer r, assert, omask
396  include 'geodesic.inc'
397 
398 * WGS84 values
399  a = 6378137d0
400  f = 1/298.257223563d0
401  omask = 0
402  r = 0
403  call invers(a, f,
404  + 36.493349428792d0, 0d0, 36.49334942879201d0, .0000008d0,
405  + s12, azi1, azi2, omask, a12, m12, mm12, mm21, ss12)
406  r = r + assert(s12, 0.072d0, 0.5d-3)
407 
408  tstg4 = r
409  return
410  end
411 
412  integer function tstg5()
413  double precision lat2, lon2, azi2, a12, m12, MM12, MM21, SS12
414  double precision a, f
415  integer r, assert, omask, flags
416  include 'geodesic.inc'
417 
418 * WGS84 values
419  a = 6378137d0
420  f = 1/298.257223563d0
421  omask = 0
422  flags = 0
423  r = 0
424  call direct(a, f, 0.01777745589997d0, 30d0, 0d0, 10d6,
425  + flags, lat2, lon2, azi2, omask, a12, m12, mm12, mm21, ss12)
426  if (lon2 .lt. 0) then
427  r = r + assert(lon2, -150d0, 0.5d-5)
428  r = r + assert(abs(azi2), 180d0, 0.5d-5)
429  else
430  r = r + assert(lon2, 30d0, 0.5d-5)
431  r = r + assert(azi2, 0d0, 0.5d-5)
432  end if
433 
434  tstg5 = r
435  return
436  end
437 
438  integer function tstg6()
439 * Check fix for volatile sbet12a bug found 2011-06-25 (gcc 4.4d0.4d0
440 * x86 -O3). Found again on 2012-03-27 with tdm-mingw32 (g++ 4.6d0.1d0).
441  double precision azi1, azi2, s12, a12, m12, MM12, MM21, SS12
442  double precision a, f
443  integer r, assert, omask
444  include 'geodesic.inc'
445 
446 * WGS84 values
447  a = 6378137d0
448  f = 1/298.257223563d0
449  omask = 0
450  r = 0
451  call invers(a, f, 88.202499451857d0, 0d0,
452  + -88.202499451857d0, 179.981022032992859592d0,
453  + s12, azi1, azi2, omask, a12, m12, mm12, mm21, ss12)
454  r = r + assert(s12, 20003898.214d0, 0.5d-3)
455  call invers(a, f, 89.262080389218d0, 0d0,
456  + -89.262080389218d0, 179.992207982775375662d0,
457  + s12, azi1, azi2, omask, a12, m12, mm12, mm21, ss12)
458  r = r + assert(s12, 20003925.854d0, 0.5d-3)
459  call invers(a, f, 89.333123580033d0, 0d0,
460  + -89.333123580032997687d0, 179.99295812360148422d0,
461  + s12, azi1, azi2, omask, a12, m12, mm12, mm21, ss12)
462  r = r + assert(s12, 20003926.881d0, 0.5d-3)
463 
464  tstg6 = r
465  return
466  end
467 
468  integer function tstg9()
469 * Check fix for volatile x bug found 2011-06-25 (gcc 4.4d0.4d0 x86 -O3)
470  double precision azi1, azi2, s12, a12, m12, MM12, MM21, SS12
471  double precision a, f
472  integer r, assert, omask
473  include 'geodesic.inc'
474 
475 * WGS84 values
476  a = 6378137d0
477  f = 1/298.257223563d0
478  omask = 0
479  r = 0
480  call invers(a, f, 56.320923501171d0, 0d0,
481  + -56.320923501171d0, 179.664747671772880215d0,
482  + s12, azi1, azi2, omask, a12, m12, mm12, mm21, ss12)
483  r = r + assert(s12, 19993558.287d0, 0.5d-3)
484 
485  tstg9 = r
486  return
487  end
488 
489  integer function tstg10()
490 * Check fix for adjust tol1_ bug found 2011-06-25 (Visual Studio 10 rel
491 * + debug)
492  double precision azi1, azi2, s12, a12, m12, MM12, MM21, SS12
493  double precision a, f
494  integer r, assert, omask
495  include 'geodesic.inc'
496 
497 * WGS84 values
498  a = 6378137d0
499  f = 1/298.257223563d0
500  omask = 0
501  r = 0
502  call invers(a, f, 52.784459512564d0, 0d0,
503  + -52.784459512563990912d0, 179.634407464943777557d0,
504  + s12, azi1, azi2, omask, a12, m12, mm12, mm21, ss12)
505  r = r + assert(s12, 19991596.095d0, 0.5d-3)
506 
507  tstg10 = r
508  return
509  end
510 
511  integer function tstg11()
512 * Check fix for bet2 = -bet1 bug found 2011-06-25 (Visual Studio 10 rel
513 * + debug)
514  double precision azi1, azi2, s12, a12, m12, MM12, MM21, SS12
515  double precision a, f
516  integer r, assert, omask
517  include 'geodesic.inc'
518 
519 * WGS84 values
520  a = 6378137d0
521  f = 1/298.257223563d0
522  omask = 0
523  r = 0
524  call invers(a, f, 48.522876735459d0, 0d0,
525  + -48.52287673545898293d0, 179.599720456223079643d0,
526  + s12, azi1, azi2, omask, a12, m12, mm12, mm21, ss12)
527  r = r + assert(s12, 19989144.774d0, 0.5d-3)
528 
529  tstg11 = r
530  return
531  end
532 
533  integer function tstg12()
534 * Check fix for inverse geodesics on extreme prolate/oblate ellipsoids
535 * Reported 2012-08-29 Stefan Guenther <stefan.gunther@embl.de>; fixed
536 * 2012-10-07
537  double precision azi1, azi2, s12, a12, m12, MM12, MM21, SS12
538  double precision a, f
539  integer r, assert, omask
540  include 'geodesic.inc'
541 
542  a = 89.8d0
543  f = -1.83d0
544  omask = 0
545  r = 0
546  call invers(a, f, 0d0, 0d0, -10d0, 160d0,
547  + s12, azi1, azi2, omask, a12, m12, mm12, mm21, ss12)
548  r = r + assert(azi1, 120.27d0, 1d-2)
549  r = r + assert(azi2, 105.15d0, 1d-2)
550  r = r + assert(s12, 266.7d0, 1d-1)
551 
552  tstg12 = r
553  return
554  end
555 
556  integer function tstg14()
557 * Check fix for inverse ignoring lon12 = nan
558  double precision azi1, azi2, s12, a12, m12, MM12, MM21, SS12
559  double precision a, f, LatFix
560  integer r, chknan, omask
561  include 'geodesic.inc'
562 
563 * WGS84 values
564  a = 6378137d0
565  f = 1/298.257223563d0
566  omask = 0
567  r = 0
568  call invers(a, f, 0d0, 0d0, 1d0, latfix(91d0),
569  + s12, azi1, azi2, omask, a12, m12, mm12, mm21, ss12)
570  r = r + chknan(azi1)
571  r = r + chknan(azi2)
572  r = r + chknan(s12)
573 
574  tstg14 = r
575  return
576  end
577 
578  integer function tstg15()
579 * Initial implementation of Math::eatanhe was wrong for e^2 < 0. This
580 * checks that this is fixed.
581  double precision lat2, lon2, azi2, a12, m12, MM12, MM21, SS12
582  double precision a, f
583  integer r, assert, omask, flags
584  include 'geodesic.inc'
585 
586  a = 6.4d6
587  f = -1/150.0d0
588  omask = 8
589  flags = 0
590  r = 0
591  call direct(a, f, 1d0, 2d0, 3d0, 4d0,
592  + flags, lat2, lon2, azi2, omask, a12, m12, mm12, mm21, ss12)
593  r = r + assert(ss12, 23700d0, 0.5d0)
594 
595  tstg15 = r
596  return
597  end
598 
599  integer function tstg17()
600 * Check fix for LONG_UNROLL bug found on 2015-05-07
601  double precision lat2, lon2, azi2, a12, m12, MM12, MM21, SS12
602  double precision a, f
603  integer r, assert, omask, flags
604  include 'geodesic.inc'
605 
606 * WGS84 values
607  a = 6378137d0
608  f = 1/298.257223563d0
609  omask = 0
610  flags = 2
611  r = 0
612  call direct(a, f, 40d0, -75d0, -10d0, 2d7,
613  + flags, lat2, lon2, azi2, omask, a12, m12, mm12, mm21, ss12)
614  r = r + assert(lat2, -39d0, 1d0)
615  r = r + assert(lon2, -254d0, 1d0)
616  r = r + assert(azi2, -170d0, 1d0)
617  flags = 0
618  call direct(a, f, 40d0, -75d0, -10d0, 2d7,
619  + flags, lat2, lon2, azi2, omask, a12, m12, mm12, mm21, ss12)
620  r = r + assert(lat2, -39d0, 1d0)
621  r = r + assert(lon2, 105d0, 1d0)
622  r = r + assert(azi2, -170d0, 1d0)
623 
624  tstg17 = r
625  return
626  end
627 
628  integer function tstg26()
629 * Check 0/0 problem with area calculation on sphere 2015-09-08
630  double precision azi1, azi2, s12, a12, m12, MM12, MM21, SS12
631  double precision a, f
632  integer r, assert, omask
633  include 'geodesic.inc'
634 
635  a = 6.4d6
636  f = 0
637  omask = 8
638  r = 0
639  call invers(a, f, 1d0, 2d0, 3d0, 4d0,
640  + s12, azi1, azi2, omask, a12, m12, mm12, mm21, ss12)
641  r = r + assert(ss12, 49911046115.0d0, 0.5d0)
642 
643  tstg26 = r
644  return
645  end
646 
647  integer function tstg28()
648 * Check fix for LONG_UNROLL bug found on 2015-05-07
649  double precision lat2, lon2, azi2, a12, m12, MM12, MM21, SS12
650  double precision a, f
651  integer r, assert, omask, flags
652  include 'geodesic.inc'
653 
654  a = 6.4d6
655  f = 0.1d0
656  omask = 1 + 2 + 4 + 8
657  flags = 0
658  r = 0
659  call direct(a, f, 1d0, 2d0, 10d0, 5d6,
660  + flags, lat2, lon2, azi2, omask, a12, m12, mm12, mm21, ss12)
661  r = r + assert(a12, 48.55570690d0, 0.5d-8)
662 
663  tstg28 = r
664  return
665  end
666 
667  integer function tstg33()
668 * Check max(-0.0,+0.0) issues 2015-08-22 (triggered by bugs in Octave --
669 * sind(-0.0) = +0.0 -- and in some version of Visual Studio --
670 * fmod(-0.0, 360.0) = +0.0.
671  double precision azi1, azi2, s12, a12, m12, MM12, MM21, SS12
672  double precision a, f
673  integer r, assert, omask
674  include 'geodesic.inc'
675 
676 * WGS84 values
677  a = 6378137d0
678  f = 1/298.257223563d0
679  omask = 0
680  r = 0
681  call invers(a, f, 0d0, 0d0, 0d0, 179d0,
682  + s12, azi1, azi2, omask, a12, m12, mm12, mm21, ss12)
683  r = r + assert(azi1, 90.00000d0, 0.5d-5)
684  r = r + assert(azi2, 90.00000d0, 0.5d-5)
685  r = r + assert(s12, 19926189d0, 0.5d0)
686  call invers(a, f, 0d0, 0d0, 0d0, 179.5d0,
687  + s12, azi1, azi2, omask, a12, m12, mm12, mm21, ss12)
688  r = r + assert(azi1, 55.96650d0, 0.5d-5)
689  r = r + assert(azi2, 124.03350d0, 0.5d-5)
690  r = r + assert(s12, 19980862d0, 0.5d0)
691  call invers(a, f, 0d0, 0d0, 0d0, 180d0,
692  + s12, azi1, azi2, omask, a12, m12, mm12, mm21, ss12)
693  r = r + assert(azi1, 0.00000d0, 0.5d-5)
694  r = r + assert(abs(azi2), 180.00000d0, 0.5d-5)
695  r = r + assert(s12, 20003931d0, 0.5d0)
696  call invers(a, f, 0d0, 0d0, 1d0, 180d0,
697  + s12, azi1, azi2, omask, a12, m12, mm12, mm21, ss12)
698  r = r + assert(azi1, 0.00000d0, 0.5d-5)
699  r = r + assert(abs(azi2), 180.00000d0, 0.5d-5)
700  r = r + assert(s12, 19893357d0, 0.5d0)
701  a = 6.4d6
702  f = 0
703  call invers(a, f, 0d0, 0d0, 0d0, 179d0,
704  + s12, azi1, azi2, omask, a12, m12, mm12, mm21, ss12)
705  r = r + assert(azi1, 90.00000d0, 0.5d-5)
706  r = r + assert(azi2, 90.00000d0, 0.5d-5)
707  r = r + assert(s12, 19994492d0, 0.5d0)
708  call invers(a, f, 0d0, 0d0, 0d0, 180d0,
709  + s12, azi1, azi2, omask, a12, m12, mm12, mm21, ss12)
710  r = r + assert(azi1, 0.00000d0, 0.5d-5)
711  r = r + assert(abs(azi2), 180.00000d0, 0.5d-5)
712  r = r + assert(s12, 20106193d0, 0.5d0)
713  call invers(a, f, 0d0, 0d0, 1d0, 180d0,
714  + s12, azi1, azi2, omask, a12, m12, mm12, mm21, ss12)
715  r = r + assert(azi1, 0.00000d0, 0.5d-5)
716  r = r + assert(abs(azi2), 180.00000d0, 0.5d-5)
717  r = r + assert(s12, 19994492d0, 0.5d0)
718  a = 6.4d6
719  f = -1/300.0d0
720  call invers(a, f, 0d0, 0d0, 0d0, 179d0,
721  + s12, azi1, azi2, omask, a12, m12, mm12, mm21, ss12)
722  r = r + assert(azi1, 90.00000d0, 0.5d-5)
723  r = r + assert(azi2, 90.00000d0, 0.5d-5)
724  r = r + assert(s12, 19994492d0, 0.5d0)
725  call invers(a, f, 0d0, 0d0, 0d0, 180d0,
726  + s12, azi1, azi2, omask, a12, m12, mm12, mm21, ss12)
727  r = r + assert(azi1, 90.00000d0, 0.5d-5)
728  r = r + assert(azi2, 90.00000d0, 0.5d-5)
729  r = r + assert(s12, 20106193d0, 0.5d0)
730  call invers(a, f, 0d0, 0d0, 0.5d0, 180d0,
731  + s12, azi1, azi2, omask, a12, m12, mm12, mm21, ss12)
732  r = r + assert(azi1, 33.02493d0, 0.5d-5)
733  r = r + assert(azi2, 146.97364d0, 0.5d-5)
734  r = r + assert(s12, 20082617d0, 0.5d0)
735  call invers(a, f, 0d0, 0d0, 1d0, 180d0,
736  + s12, azi1, azi2, omask, a12, m12, mm12, mm21, ss12)
737  r = r + assert(azi1, 0.00000d0, 0.5d-5)
738  r = r + assert(abs(azi2), 180.00000d0, 0.5d-5)
739  r = r + assert(s12, 20027270d0, 0.5d0)
740 
741  tstg33 = r
742  return
743  end
744 
745  integer function tstg55()
746 * Check fix for nan + point on equator or pole not returning all nans in
747 * Geodesic::Inverse, found 2015-09-23.
748  double precision azi1, azi2, s12, a12, m12, MM12, MM21, SS12
749  double precision a, f
750  integer r, chknan, omask
751  include 'geodesic.inc'
752 
753 * WGS84 values
754  a = 6378137d0
755  f = 1/298.257223563d0
756  omask = 0
757  r = 0
758  call invers(a, f, 91d0, 0d0, 0d0, 90d0,
759  + s12, azi1, azi2, omask, a12, m12, mm12, mm21, ss12)
760  r = r + chknan(azi1)
761  r = r + chknan(azi2)
762  r = r + chknan(s12)
763  call invers(a, f, 91d0, 0d0, 90d0, 9d0,
764  + s12, azi1, azi2, omask, a12, m12, mm12, mm21, ss12)
765  r = r + chknan(azi1)
766  r = r + chknan(azi2)
767  r = r + chknan(s12)
768 
769  tstg55 = r
770  return
771  end
772 
773  integer function tstg59()
774 * Check for points close with longitudes close to 180 deg apart.
775  double precision azi1, azi2, s12, a12, m12, MM12, MM21, SS12
776  double precision a, f
777  integer r, assert, omask
778  include 'geodesic.inc'
779 
780 * WGS84 values
781  a = 6378137d0
782  f = 1/298.257223563d0
783  omask = 0
784  r = 0
785  call invers(a, f, 5d0, 0.00000000000001d0, 10d0, 180d0,
786  + s12, azi1, azi2, omask, a12, m12, mm12, mm21, ss12)
787  r = r + assert(azi1, 0.000000000000035d0, 1.5d-14)
788  r = r + assert(azi2, 179.99999999999996d0, 1.5d-14)
789  r = r + assert(s12, 18345191.174332713d0, 5d-9)
790 
791  tstg59 = r
792  return
793  end
794 
795  integer function tstg61()
796 * Make sure small negative azimuths are west-going
797  double precision lat2, lon2, azi2, a12, m12, MM12, MM21, SS12
798  double precision a, f
799  integer r, assert, omask, flags
800  include 'geodesic.inc'
801 
802 * WGS84 values
803  a = 6378137d0
804  f = 1/298.257223563d0
805  omask = 0
806  flags = 2
807  r = 0
808  call direct(a, f, 45d0, 0d0, -0.000000000000000003d0, 1d7,
809  + flags, lat2, lon2, azi2, omask, a12, m12, mm12, mm21, ss12)
810  r = r + assert(lat2, 45.30632d0, 0.5d-5)
811  r = r + assert(lon2, -180d0, 0.5d-5)
812  r = r + assert(abs(azi2), 180d0, 0.5d-5)
813 
814  tstg61 = r
815  return
816  end
817 
818  integer function tstg73()
819 * Check for backwards from the pole bug reported by Anon on 2016-02-13.
820 * This only affected the Java implementation. It was introduced in Java
821 * version 1.44 and fixed in 1.46-SNAPSHOT on 2016-01-17.
822 * Also the + sign on azi2 is a check on the normalizing of azimuths
823 * (converting -0.0 to +0.0).
824  double precision lat2, lon2, azi2, a12, m12, MM12, MM21, SS12
825  double precision a, f
826  integer r, assert, omask, flags
827  include 'geodesic.inc'
828 
829 * WGS84 values
830  a = 6378137d0
831  f = 1/298.257223563d0
832  omask = 0
833  flags = 0
834  r = 0
835  call direct(a, f, 90d0, 10d0, 180d0, -1d6,
836  + flags, lat2, lon2, azi2, omask, a12, m12, mm12, mm21, ss12)
837  r = r + assert(lat2, 81.04623d0, 0.5d-5)
838  r = r + assert(lon2, -170d0, 0.5d-5)
839  r = r + assert(azi2, 0d0, 0d0)
840  r = r + assert(sign(1d0, azi2), 1d0, 0d0)
841 
842  tstg73 = r
843  return
844  end
845 
846  integer function tstg74()
847 * Check fix for inaccurate areas, bug introduced in v1.46, fixed
848 * 2015-10-16.
849  double precision azi1, azi2, s12, a12, m12, MM12, MM21, SS12
850  double precision a, f
851  integer r, assert, omask
852  include 'geodesic.inc'
853 
854 * WGS84 values
855  a = 6378137d0
856  f = 1/298.257223563d0
857  omask = 1 + 2 + 4 + 8
858  r = 0
859  call invers(a, f, 54.1589d0, 15.3872d0, 54.1591d0, 15.3877d0,
860  + s12, azi1, azi2, omask, a12, m12, mm12, mm21, ss12)
861  r = r + assert(azi1, 55.723110355d0, 5d-9)
862  r = r + assert(azi2, 55.723515675d0, 5d-9)
863  r = r + assert(s12, 39.527686385d0, 5d-9)
864  r = r + assert(a12, 0.000355495d0, 5d-9)
865  r = r + assert(m12, 39.527686385d0, 5d-9)
866  r = r + assert(mm12, 0.999999995d0, 5d-9)
867  r = r + assert(mm21, 0.999999995d0, 5d-9)
868  r = r + assert(ss12, 286698586.30197d0, 5d-4)
869 
870  tstg74 = r
871  return
872  end
873 
874  integer function tstg76()
875 * The distance from Wellington and Salamanca (a classic failure of
876 * Vincenty
877  double precision azi1, azi2, s12, a12, m12, MM12, MM21, SS12
878  double precision a, f
879  integer r, assert, omask
880  include 'geodesic.inc'
881 
882 * WGS84 values
883  a = 6378137d0
884  f = 1/298.257223563d0
885  omask = 0
886  r = 0
887  call invers(a, f,
888  + -(41+19/60d0), 174+49/60d0, 40+58/60d0, -(5+30/60d0),
889  + s12, azi1, azi2, omask, a12, m12, mm12, mm21, ss12)
890  r = r + assert(azi1, 160.39137649664d0, 0.5d-11)
891  r = r + assert(azi2, 19.50042925176d0, 0.5d-11)
892  r = r + assert(s12, 19960543.857179d0, 0.5d-6)
893 
894  tstg76 = r
895  return
896  end
897 
898  integer function tstg78()
899 * An example where the NGS calculator fails to converge
900  double precision azi1, azi2, s12, a12, m12, MM12, MM21, SS12
901  double precision a, f
902  integer r, assert, omask
903  include 'geodesic.inc'
904 
905 * WGS84 values
906  a = 6378137d0
907  f = 1/298.257223563d0
908  omask = 0
909  r = 0
910  call invers(a, f, 27.2d0, 0d0, -27.1d0, 179.5d0,
911  + s12, azi1, azi2, omask, a12, m12, mm12, mm21, ss12)
912  r = r + assert(azi1, 45.82468716758d0, 0.5d-11)
913  r = r + assert(azi2, 134.22776532670d0, 0.5d-11)
914  r = r + assert(s12, 19974354.765767d0, 0.5d-6)
915 
916  tstg78 = r
917  return
918  end
919 
920  integer function tstg80()
921 * Some tests to add code coverage: computing scale in special cases + zero
922 * length geodesic (includes GeodSolve80 - GeodSolve83).
923  double precision azi1, azi2, s12, a12, m12, MM12, MM21, SS12
924  double precision a, f
925  integer r, assert, omask
926  include 'geodesic.inc'
927 
928 * WGS84 values
929  a = 6378137d0
930  f = 1/298.257223563d0
931  omask = 4
932  r = 0
933 
934  call invers(a, f, 0d0, 0d0, 0d0, 90d0,
935  + s12, azi1, azi2, omask, a12, m12, mm12, mm21, ss12)
936  r = r + assert(mm12, -0.00528427534d0, 0.5d-10)
937  r = r + assert(mm21, -0.00528427534d0, 0.5d-10)
938 
939  call invers(a, f, 0d0, 0d0, 1d-6, 1d-6,
940  + s12, azi1, azi2, omask, a12, m12, mm12, mm21, ss12)
941  r = r + assert(mm12, 1d0, 0.5d-10)
942  r = r + assert(mm21, 1d0, 0.5d-10)
943 
944  omask = 15
945  call invers(a, f, 20.001d0, 0d0, 20.001d0, 0d0,
946  + s12, azi1, azi2, omask, a12, m12, mm12, mm21, ss12)
947  r = r + assert(a12, 0d0, 1d-13)
948  r = r + assert(s12, 0d0, 1d-8)
949  r = r + assert(azi1, 180d0, 1d-13)
950  r = r + assert(azi2, 180d0, 1d-13)
951  r = r + assert(m12, 0d0, 1d-8)
952  r = r + assert(mm12, 1d0, 1d-15)
953  r = r + assert(mm21, 1d0, 1d-15)
954  r = r + assert(ss12, 0d0, 1d-10)
955  r = r + assert(sign(1d0, a12), 1d0, 0d0)
956  r = r + assert(sign(1d0, s12), 1d0, 0d0)
957  r = r + assert(sign(1d0, m12), 1d0, 0d0)
958 
959  call invers(a, f, 90d0, 0d0, 90d0, 180d0,
960  + s12, azi1, azi2, omask, a12, m12, mm12, mm21, ss12)
961  r = r + assert(a12, 0d0, 1d-13)
962  r = r + assert(s12, 0d0, 1d-8)
963  r = r + assert(azi1, 0d0, 1d-13)
964  r = r + assert(azi2, 180d0, 1d-13)
965  r = r + assert(m12, 0d0, 1d-8)
966  r = r + assert(mm12, 1d0, 1d-15)
967  r = r + assert(mm21, 1d0, 1d-15)
968  r = r + assert(ss12, 127516405431022d0, 0.5d0)
969 
970  tstg80 = r
971  return
972  end
973 
974  integer function tstg84()
975 * Tests for python implementation to check fix for range errors with
976 * {fmod,sin,cos}(inf) (includes GeodSolve84 - GeodSolve86).
977  double precision lat2, lon2, azi2, a12, m12, MM12, MM21, SS12
978  double precision a, f, nan, inf, LatFix
979  integer r, assert, chknan, omask, flags
980  include 'geodesic.inc'
981 
982 * WGS84 values
983  a = 6378137d0
984  f = 1/298.257223563d0
985  omask = 0
986  flags = 0
987  inf = 1d0/latfix(0d0)
988  nan = latfix(91d0)
989  r = 0
990  call direct(a, f, 0d0, 0d0, 90d0, inf,
991  + flags, lat2, lon2, azi2, omask, a12, m12, mm12, mm21, ss12)
992  r = r + chknan(lat2)
993  r = r + chknan(lon2)
994  r = r + chknan(azi2)
995  call direct(a, f, 0d0, 0d0, 90d0, nan,
996  + flags, lat2, lon2, azi2, omask, a12, m12, mm12, mm21, ss12)
997  r = r + chknan(lat2)
998  r = r + chknan(lon2)
999  r = r + chknan(azi2)
1000  call direct(a, f, 0d0, 0d0, inf, 1000d0,
1001  + flags, lat2, lon2, azi2, omask, a12, m12, mm12, mm21, ss12)
1002  r = r + chknan(lat2)
1003  r = r + chknan(lon2)
1004  r = r + chknan(azi2)
1005  call direct(a, f, 0d0, 0d0, nan, 1000d0,
1006  + flags, lat2, lon2, azi2, omask, a12, m12, mm12, mm21, ss12)
1007  r = r + chknan(lat2)
1008  r = r + chknan(lon2)
1009  r = r + chknan(azi2)
1010  call direct(a, f, 0d0, inf, 90d0, 1000d0,
1011  + flags, lat2, lon2, azi2, omask, a12, m12, mm12, mm21, ss12)
1012  r = r + assert(lat2, 0d0, 0d0)
1013  r = r + chknan(lon2)
1014  r = r + assert(azi2, 90d0, 0d0)
1015  call direct(a, f, 0d0, nan, 90d0, 1000d0,
1016  + flags, lat2, lon2, azi2, omask, a12, m12, mm12, mm21, ss12)
1017  r = r + assert(lat2, 0d0, 0d0)
1018  r = r + chknan(lon2)
1019  r = r + assert(azi2, 90d0, 0d0)
1020  call direct(a, f, inf, 0d0, 90d0, 1000d0,
1021  + flags, lat2, lon2, azi2, omask, a12, m12, mm12, mm21, ss12)
1022  r = r + chknan(lat2)
1023  r = r + chknan(lon2)
1024  r = r + chknan(azi2)
1025  call direct(a, f, nan, 0d0, 90d0, 1000d0,
1026  + flags, lat2, lon2, azi2, omask, a12, m12, mm12, mm21, ss12)
1027  r = r + chknan(lat2)
1028  r = r + chknan(lon2)
1029  r = r + chknan(azi2)
1030 
1031  tstg84 = r
1032  return
1033  end
1034 
1035  integer function tstg92()
1036 * Check fix for inaccurate hypot with python 3.[89]. Problem reported
1037 * by agdhruv https://github.com/geopy/geopy/issues/466 ; see
1038 * https://bugs.python.org/issue43088
1039  double precision azi1, azi2, s12, a12, m12, MM12, MM21, SS12
1040  double precision a, f
1041  integer r, assert, omask
1042  include 'geodesic.inc'
1043 
1044 * WGS84 values
1045  a = 6378137d0
1046  f = 1/298.257223563d0
1047  omask = 0
1048  r = 0
1049  call invers(a, f,
1050  + 37.757540000000006d0, -122.47018d0,
1051  + 37.75754d0, -122.470177d0,
1052  + s12, azi1, azi2, omask, a12, m12, mm12, mm21, ss12)
1053  r = r + assert(azi1, 89.99999923d0, 1d-7 )
1054  r = r + assert(azi2, 90.00000106d0, 1d-7 )
1055  r = r + assert(s12, 0.264d0, 0.5d-3)
1056 
1057  tstg92 = r
1058  return
1059  end
1060 
1061  integer function tstp0()
1062 * Check fix for pole-encircling bug found 2011-03-16
1063  double precision lata(4), lona(4)
1064  data lata / 89d0, 89d0, 89d0, 89d0 /
1065  data lona / 0d0, 90d0, 180d0, 270d0 /
1066  double precision latb(4), lonb(4)
1067  data latb / -89d0, -89d0, -89d0, -89d0 /
1068  data lonb / 0d0, 90d0, 180d0, 270d0 /
1069  double precision latc(4), lonc(4)
1070  data latc / 0d0, -1d0, 0d0, 1d0 /
1071  data lonc / -1d0, 0d0, 1d0, 0d0 /
1072  double precision latd(3), lond(3)
1073  data latd / 90d0, 0d0, 0d0 /
1074  data lond / 0d0, 0d0, 90d0 /
1075  double precision a, f, AA, PP
1076  integer r, assert
1077  include 'geodesic.inc'
1078 
1079 * WGS84 values
1080  a = 6378137d0
1081  f = 1/298.257223563d0
1082  r = 0
1083 
1084  call area(a, f, lata, lona, 4, aa, pp)
1085  r = r + assert(pp, 631819.8745d0, 1d-4)
1086  r = r + assert(aa, 24952305678.0d0, 1d0)
1087 
1088  call area(a, f, latb, lonb, 4, aa, pp)
1089  r = r + assert(pp, 631819.8745d0, 1d-4)
1090  r = r + assert(aa, -24952305678.0d0, 1d0)
1091 
1092  call area(a, f, latc, lonc, 4, aa, pp)
1093  r = r + assert(pp, 627598.2731d0, 1d-4)
1094  r = r + assert(aa, 24619419146.0d0, 1d0)
1095 
1096  call area(a, f, latd, lond, 3, aa, pp)
1097  r = r + assert(pp, 30022685d0, 1d0)
1098  r = r + assert(aa, 63758202715511.0d0, 1d0)
1099 
1100  tstp0 = r
1101  return
1102  end
1103 
1104  integer function tstp5()
1105 * Check fix for Planimeter pole crossing bug found 2011-06-24
1106  double precision lat(3), lon(3)
1107  data lat / 89d0, 89d0, 89d0 /
1108  data lon / 0.1d0, 90.1d0, -179.9d0 /
1109  double precision a, f, AA, PP
1110  integer r, assert
1111  include 'geodesic.inc'
1112 
1113 * WGS84 values
1114  a = 6378137d0
1115  f = 1/298.257223563d0
1116  r = 0
1117 
1118  call area(a, f, lat, lon, 3, aa, pp)
1119  r = r + assert(pp, 539297d0, 1d0)
1120  r = r + assert(aa, 12476152838.5d0, 1d0)
1121 
1122  tstp5 = r
1123  return
1124  end
1125 
1126  integer function tstp6()
1127 * Check fix for pole-encircling bug found 2011-03-16
1128  double precision lata(3), lona(3)
1129  data lata / 9d0, 9d0, 9d0 /
1130  data lona / -0.00000000000001d0, 180d0, 0d0 /
1131  double precision latb(3), lonb(3)
1132  data latb / 9d0, 9d0, 9d0 /
1133  data lonb / 0.00000000000001d0, 0d0, 180d0 /
1134  double precision latc(3), lonc(3)
1135  data latc / 9d0, 9d0, 9d0 /
1136  data lonc / 0.00000000000001d0, 180d0, 0d0 /
1137  double precision latd(3), lond(3)
1138  data latd / 9d0, 9d0, 9d0 /
1139  data lond / -0.00000000000001d0, 0d0, 180d0 /
1140  double precision a, f, AA, PP
1141  integer r, assert
1142  include 'geodesic.inc'
1143 
1144 * WGS84 values
1145  a = 6378137d0
1146  f = 1/298.257223563d0
1147  r = 0
1148 
1149  call area(a, f, lata, lona, 3, aa, pp)
1150  r = r + assert(pp, 36026861d0, 1d0)
1151  r = r + assert(aa, 0d0, 1d0)
1152 
1153  tstp6 = r
1154  return
1155  end
1156 
1157  integer function tstp12()
1158 * AA of arctic circle (not really -- adjunct to rhumb-AA test)
1159  double precision lat(2), lon(2)
1160  data lat / 66.562222222d0, 66.562222222d0 /
1161  data lon / 0d0, 180d0 /
1162  double precision a, f, AA, PP
1163  integer r, assert
1164  include 'geodesic.inc'
1165 
1166 * WGS84 values
1167  a = 6378137d0
1168  f = 1/298.257223563d0
1169  r = 0
1170 
1171  call area(a, f, lat, lon, 2, aa, pp)
1172  r = r + assert(pp, 10465729d0, 1d0)
1173  r = r + assert(aa, 0d0, 1d0)
1174 
1175  tstp12 = r
1176  return
1177  end
1178 
1179  integer function tstp13()
1180 * Check encircling pole twice
1181  double precision lat(6), lon(6)
1182  data lat / 89d0, 89d0, 89d0, 89d0, 89d0, 89d0 /
1183  data lon / -360d0, -240d0, -120d0, 0d0, 120d0, 240d0 /
1184  double precision a, f, AA, PP
1185  integer r, assert
1186  include 'geodesic.inc'
1187 
1188 * WGS84 values
1189  a = 6378137d0
1190  f = 1/298.257223563d0
1191  r = 0
1192 
1193  call area(a, f, lat, lon, 6, aa, pp)
1194  r = r + assert(pp, 1160741d0, 1d0)
1195  r = r + assert(aa, 32415230256.0d0, 1d0)
1196 
1197  tstp13 = r
1198  return
1199  end
1200 
1201  integer function tstp15()
1202 * Coverage tests, includes Planimeter15 - Planimeter18 (combinations of
1203 * reverse and sign). But flags aren't supported in the Fortran
1204 * implementation.
1205  double precision lat(3), lon(3)
1206  data lat / 2d0, 1d0, 3d0 /
1207  data lon / 1d0, 2d0, 3d0 /
1208  double precision a, f, AA, PP
1209  integer r, assert
1210  include 'geodesic.inc'
1211 
1212 * WGS84 values
1213  a = 6378137d0
1214  f = 1/298.257223563d0
1215  r = 0
1216 
1217  call area(a, f, lat, lon, 3, aa, pp)
1218  r = r + assert(aa, 18454562325.45119d0, 1d0)
1219 * Interchanging lat and lon is equivalent to traversing the polygon
1220 * backwards.
1221  call area(a, f, lon, lat, 3, aa, pp)
1222  r = r + assert(aa, -18454562325.45119d0, 1d0)
1223 
1224  tstp15 = r
1225  return
1226  end
1227 
1228  integer function tstp19()
1229 * Coverage tests, includes Planimeter19 - Planimeter20 (degenerate
1230 * polygons).
1231  double precision lat(1), lon(1)
1232  data lat / 1d0 /
1233  data lon / 1d0 /
1234  double precision a, f, AA, PP
1235  integer r, assert
1236  include 'geodesic.inc'
1237 
1238 * WGS84 values
1239  a = 6378137d0
1240  f = 1/298.257223563d0
1241  r = 0
1242 
1243  call area(a, f, lat, lon, 1, aa, pp)
1244  r = r + assert(aa, 0d0, 0d0)
1245  r = r + assert(pp, 0d0, 0d0)
1246 
1247  tstp19 = r
1248  return
1249  end
1250 
1251  integer function tstp21()
1252 * Some test to add code coverage: multiple circlings of pole (includes
1253 * Planimeter21 - Planimeter28).
1254  double precision lat(12), lon(12), lonr(12)
1255  data lat / 12*45d0 /
1256  data lon / 60d0, 180d0, -60d0,
1257  + 60d0, 180d0, -60d0,
1258  + 60d0, 180d0, -60d0,
1259  + 60d0, 180d0, -60d0 /
1260  data lonr / -60d0, 180d0, 60d0,
1261  + -60d0, 180d0, 60d0,
1262  + -60d0, 180d0, 60d0,
1263  + -60d0, 180d0, 60d0 /
1264  double precision a, f, AA, PP, AA1
1265  integer r, assert
1266  include 'geodesic.inc'
1267 
1268 * WGS84 values
1269  a = 6378137d0
1270  f = 1/298.257223563d0
1271  r = 0
1272 * Area for one circuit
1273  aa1 = 39433884866571.4277d0
1274 
1275  do 10 i = 3,4
1276  call area(a, f, lat, lon, 3*i, aa, pp)
1277  r = r + assert(aa, aa1*i, 0.5d0)
1278  call area(a, f, lat, lonr, 3*i, aa, pp)
1279  r = r + assert(aa, -aa1*i, 0.5d0)
1280  10 continue
1281 
1282  tstp21 = r
1283  return
1284  end
1285 
1286  program geodtest
1287  integer n, i
1288  integer tstinv, tstdir, tstarc,
1289  + tstg0, tstg1, tstg2, tstg5, tstg6, tstg9, tstg10, tstg11,
1290  + tstg12, tstg14, tstg15, tstg17, tstg26, tstg28, tstg33,
1291  + tstg55, tstg59, tstg61, tstg73, tstg74, tstg76, tstg78,
1292  + tstg80, tstg84, tstg92,
1293  + tstp0, tstp5, tstp6, tstp12, tstp13, tstp15, tstp19, tstp21
1294 
1295  n = 0
1296  i = tstinv()
1297  if (i .gt. 0) then
1298  n = n + 1
1299  print *, 'tstinv fail:', i
1300  end if
1301  i = tstdir()
1302  if (i .gt. 0) then
1303  n = n + 1
1304  print *, 'tstdir fail:', i
1305  end if
1306  i = tstarc()
1307  if (i .gt. 0) then
1308  n = n + 1
1309  print *, 'tstarc fail:', i
1310  end if
1311  i = tstg0()
1312  if (i .gt. 0) then
1313  n = n + 1
1314  print *, 'tstg0 fail:', i
1315  end if
1316  i = tstg1()
1317  if (i .gt. 0) then
1318  n = n + 1
1319  print *, 'tstg1 fail:', i
1320  end if
1321  i = tstg2()
1322  if (i .gt. 0) then
1323  n = n + 1
1324  print *, 'tstg2 fail:', i
1325  end if
1326  i = tstg5()
1327  if (i .gt. 0) then
1328  n = n + 1
1329  print *, 'tstg5 fail:', i
1330  end if
1331  i = tstg6()
1332  if (i .gt. 0) then
1333  n = n + 1
1334  print *, 'tstg6 fail:', i
1335  end if
1336  i = tstg9()
1337  if (i .gt. 0) then
1338  n = n + 1
1339  print *, 'tstg9 fail:', i
1340  end if
1341  i = tstg10()
1342  if (i .gt. 0) then
1343  n = n + 1
1344  print *, 'tstg10 fail:', i
1345  end if
1346  i = tstg11()
1347  if (i .gt. 0) then
1348  n = n + 1
1349  print *, 'tstg11 fail:', i
1350  end if
1351  i = tstg12()
1352  if (i .gt. 0) then
1353  n = n + 1
1354  print *, 'tstg12 fail:', i
1355  end if
1356  i = tstg14()
1357  if (i .gt. 0) then
1358  n = n + 1
1359  print *, 'tstg14 fail:', i
1360  end if
1361  i = tstg15()
1362  if (i .gt. 0) then
1363  n = n + 1
1364  print *, 'tstg15 fail:', i
1365  end if
1366  i = tstg17()
1367  if (i .gt. 0) then
1368  n = n + 1
1369  print *, 'tstg17 fail:', i
1370  end if
1371  i = tstg26()
1372  if (i .gt. 0) then
1373  n = n + 1
1374  print *, 'tstg26 fail:', i
1375  end if
1376  i = tstg28()
1377  if (i .gt. 0) then
1378  n = n + 1
1379  print *, 'tstg28 fail:', i
1380  end if
1381  i = tstg33()
1382  if (i .gt. 0) then
1383  n = n + 1
1384  print *, 'tstg33 fail:', i
1385  end if
1386  i = tstg55()
1387  if (i .gt. 0) then
1388  n = n + 1
1389  print *, 'tstg55 fail:', i
1390  end if
1391  i = tstg59()
1392  if (i .gt. 0) then
1393  n = n + 1
1394  print *, 'tstg59 fail:', i
1395  end if
1396  i = tstg61()
1397  if (i .gt. 0) then
1398  n = n + 1
1399  print *, 'tstg61 fail:', i
1400  end if
1401  i = tstg73()
1402  if (i .gt. 0) then
1403  n = n + 1
1404  print *, 'tstg73 fail:', i
1405  end if
1406  i = tstg74()
1407  if (i .gt. 0) then
1408  n = n + 1
1409  print *, 'tstg74 fail:', i
1410  end if
1411  i = tstg76()
1412  if (i .gt. 0) then
1413  n = n + 1
1414  print *, 'tstg76 fail:', i
1415  end if
1416  i = tstg78()
1417  if (i .gt. 0) then
1418  n = n + 1
1419  print *, 'tstg78 fail:', i
1420  end if
1421  i = tstg80()
1422  if (i .gt. 0) then
1423  n = n + 1
1424  print *, 'tstg80 fail:', i
1425  end if
1426  i = tstg84()
1427  if (i .gt. 0) then
1428  n = n + 1
1429  print *, 'tstg84 fail:', i
1430  end if
1431  i = tstg92()
1432  if (i .gt. 0) then
1433  n = n + 1
1434  print *, 'tstg92 fail:', i
1435  end if
1436  i = tstp0()
1437  if (i .gt. 0) then
1438  n = n + 1
1439  print *, 'tstp0 fail:', i
1440  end if
1441  i = tstp5()
1442  if (i .gt. 0) then
1443  n = n + 1
1444  print *, 'tstp5 fail:', i
1445  end if
1446  i = tstp6()
1447  if (i .gt. 0) then
1448  n = n + 1
1449  print *, 'tstp6 fail:', i
1450  end if
1451  i = tstp12()
1452  if (i .gt. 0) then
1453  n = n + 1
1454  print *, 'tstp12 fail:', i
1455  end if
1456  i = tstp13()
1457  if (i .gt. 0) then
1458  n = n + 1
1459  print *, 'tstp13 fail:', i
1460  end if
1461  i = tstp15()
1462  if (i .gt. 0) then
1463  n = n + 1
1464  print *, 'tstp15 fail:', i
1465  end if
1466  i = tstp19()
1467  if (i .gt. 0) then
1468  n = n + 1
1469  print *, 'tstp19 fail:', i
1470  end if
1471  i = tstp21()
1472  if (i .gt. 0) then
1473  n = n + 1
1474  print *, 'tstp21 fail:', i
1475  end if
1476 
1477  if (n .gt. 0) then
1478  stop 1
1479  end if
1480 
1481  stop
1482  end
1483 
1484 *> @endcond SKIP