File Coverage

blib/lib/Geo/Ellipsoid.pm
Criterion Covered Total %
statement 296 334 88.6
branch 82 138 59.4
condition 3 6 50.0
subroutine 25 25 100.0
pod 15 15 100.0
total 421 518 81.2


line stmt bran cond sub pod time code
1             # Geo::Ellipsoid
2             #
3             # This package implements an Ellipsoid class to perform latitude
4             # and longitude calculations on the surface of an ellipsoid.
5             #
6             # This is a Perl conversion of existing Fortran code (see
7             # ACKNOWLEDGEMENTS) and the author of this class makes no
8             # claims of originality. Nor can he even vouch for the
9             # results of the calculations, although they do seem to
10             # work for him and have been tested against other methods.
11              
12             package Geo::Ellipsoid;
13              
14 12     12   205433 use warnings;
  12         19  
  12         350  
15 12     12   46 use strict;
  12         19  
  12         176  
16 12     12   182 use 5.006_00;
  12         31  
17              
18 12     12   66 use Scalar::Util 'looks_like_number';
  12         26  
  12         1070  
19 12     12   5673 use Math::Trig;
  12         138783  
  12         1419  
20 12     12   95 use Carp;
  12         17  
  12         37447  
21              
22             =pod
23              
24             =head1 NAME
25              
26             Geo::Ellipsoid - Longitude and latitude calculations using an ellipsoid model.
27              
28             =head1 VERSION
29              
30             Version 1.13, released Sep 07, 2016.
31              
32             =cut
33              
34             our $VERSION = '1.13';
35             our $DEBUG = 0;
36              
37             =pod
38              
39             =head1 SYNOPSIS
40              
41             use Geo::Ellipsoid;
42             $geo = Geo::Ellipsoid->new(ellipsoid=>'NAD27', units=>'degrees');
43             @origin = ( 37.619002, -122.374843 ); # SFO
44             @dest = ( 33.942536, -118.408074 ); # LAX
45             ( $range, $bearing ) = $geo->to( @origin, @dest );
46             ($lat,$lon) = $geo->at( @origin, 2000, 45.0 );
47             ( $x, $y ) = $geo->displacement( @origin, $lat, $lon );
48             @pos = $geo->location( $lat, $lon, $x, $y );
49              
50             =head1 DESCRIPTION
51              
52             Geo::Ellipsoid performs geometrical calculations on the surface of
53             an ellipsoid. An ellipsoid is a three-dimension object formed from
54             the rotation of an ellipse about one of its axes. The approximate
55             shape of the earth is an ellipsoid, so Geo::Ellipsoid can accurately
56             calculate distance and bearing between two widely-separated locations
57             on the earth's surface.
58              
59             The shape of an ellipsoid is defined by the lengths of its
60             semi-major and semi-minor axes. The shape may also be specifed by
61             the flattening ratio C as:
62              
63             f = ( semi-major - semi-minor ) / semi-major
64              
65             which, since f is a small number, is normally given as the reciprocal
66             of the flattening C<1/f>.
67              
68             The shape of the earth has been surveyed and estimated differently
69             at different times over the years. The two most common sets of values
70             used to describe the size and shape of the earth in the United States
71             are 'NAD27', dating from 1927, and 'WGS84', from 1984. United States
72             Geological Survey topographical maps, for example, use one or the
73             other of these values, and commonly-available Global Positioning
74             System (GPS) units can be set to use one or the other.
75             See L<"DEFINED ELLIPSOIDS"> below for the ellipsoid survey values
76             that may be selected for use by Geo::Ellipsoid.
77              
78             =cut
79              
80             # class data and constants
81             our $degrees_per_radian = 180/pi;
82             our $eps = 1.0e-23;
83             our $max_loop_count = 20;
84             our $twopi = 2 * pi;
85             our $halfpi = pi/2;
86             our %defaults = (
87             ellipsoid => 'WGS84',
88             units => 'radians',
89             distance_units => 'meter',
90             longitude => 0,
91             latitude => 1, # allows use of _normalize_output
92             bearing => 0,
93             );
94             our %distance = (
95             'foot' => 0.3048,
96             'kilometer' => 1_000,
97             'meter' => 1.0,
98             'mile' => 1_609.344,
99             'nm' => 1_852,
100             );
101              
102             # set of ellipsoids that can be used.
103             # values are
104             # 1) a = semi-major (equatorial) radius of Ellipsoid
105             # 2) 1/f = reciprocal of flattening (f), the ratio of the semi-minor
106             # (polar) radius to the semi-major (equatorial) axis, or
107             # polar radius = equatorial radius * ( 1 - f )
108              
109             our %ellipsoids = (
110             'AIRY' => [ 6377563.396, 299.3249646 ],
111             'AIRY-MODIFIED' => [ 6377340.189, 299.3249646 ],
112             'AUSTRALIAN' => [ 6378160.0, 298.25 ],
113             'BESSEL-1841' => [ 6377397.155, 299.1528128 ],
114             'CLARKE-1880' => [ 6378249.145, 293.465 ],
115             'EVEREST-1830' => [ 6377276.345, 300.8017 ],
116             'EVEREST-MODIFIED' => [ 6377304.063, 300.8017 ],
117             'FISHER-1960' => [ 6378166.0, 298.3 ],
118             'FISHER-1968' => [ 6378150.0, 298.3 ],
119             'GRS80' => [ 6378137.0, 298.25722210088 ],
120             'HOUGH-1956' => [ 6378270.0, 297.0 ],
121             'HAYFORD' => [ 6378388.0, 297.0 ],
122             'IAU76' => [ 6378140.0, 298.257 ],
123             'KRASSOVSKY-1938' => [ 6378245.0, 298.3 ],
124             'NAD27' => [ 6378206.4, 294.9786982138 ],
125             'NWL-9D' => [ 6378145.0, 298.25 ],
126             'SOUTHAMERICAN-1969' => [ 6378160.0, 298.25 ],
127             'SOVIET-1985' => [ 6378136.0, 298.257 ],
128             'WGS72' => [ 6378135.0, 298.26 ],
129             'WGS84' => [ 6378137.0, 298.257223563 ],
130             );
131              
132             =pod
133              
134             =head1 CONSTRUCTOR
135              
136             =head2 new
137              
138             The new() constructor may be called with a hash list to set the value of the
139             ellipsoid to be used, the value of the units to be used for angles and
140             distances, and whether or not the output range of longitudes and bearing
141             angles should be symmetric around zero or always greater than zero.
142             The initial default constructor is equivalent to the following:
143              
144             my $geo = Geo::Ellipsoid->new(
145             ellipsoid => 'WGS84',
146             units => 'radians' ,
147             distance_units => 'meter',
148             longitude => 0,
149             bearing => 0,
150             );
151              
152             The constructor arguments may be of any case and, with the exception of
153             the ellipsoid value, abbreviated to their first three characters.
154             Thus, ( UNI => 'DEG', DIS => 'FEE', Lon => 1, ell => 'NAD27', bEA => 0 )
155             is valid.
156              
157             =cut
158              
159             sub new
160             {
161 94     94 1 98418 my( $class, %args ) = @_;
162 94         458 my $self = {%defaults};
163 94 50       249 print "new: @_\n" if $DEBUG;
164 94         252 while (my ($key, $val) = each %args) {
165 47 100       207 if( $key =~ /^ell/i ) {
    100          
    100          
    100          
    50          
166 20         66 $self->{ellipsoid} = uc $val;
167             }elsif( $key =~ /^uni/i ) {
168 16         52 $self->{units} = $val;
169             }elsif( $key =~ /^dis/i ) {
170 5         12 $self->{distance_units} = $val;
171             }elsif( $key =~ /^lon/i ) {
172 4         13 $self->{longitude} = $val;
173             }elsif( $key =~ /^bea/i ) {
174 2         6 $self->{bearing} = $val;
175             }else{
176 0         0 carp("Unknown argument: $key => $val");
177             }
178             }
179 94         101 bless $self, $class;
180 94         247 $self->set_ellipsoid($self->{ellipsoid});
181 94         162 $self->set_units($self->{units});
182 94         160 $self->set_distance_unit($self->{distance_units});
183 94         191 $self->set_longitude_symmetric($self->{longitude});
184 94         183 $self->set_bearing_symmetric($self->{bearing});
185 94 50       141 print
186             "Ellipsoid(units=>$self->{units},distance_units=>" .
187             "$self->{distance_units},ellipsoid=>$self->{ellipsoid}," .
188             "longitude=>$self->{longitude},bearing=>$self->{bearing})\n" if $DEBUG;
189 94         200 return $self;
190             }
191              
192             =pod
193              
194             =head1 METHODS
195              
196             =head2 set_units
197              
198             Set the angle units used by the Geo::Ellipsoid object. The units may
199             also be set in the constructor of the object. The allowable values are
200             'degrees' or 'radians'. The default is 'radians'. The units value is
201             not case sensitive and may be abbreviated to 3 letters. The units of
202             angle apply to both input and output latitude, longitude, and bearing
203             values.
204              
205             $geo->set_units('degrees');
206              
207             =cut
208              
209             sub set_units
210             {
211 111     111 1 796 my $self = shift;
212 111         91 my $units = shift;
213 111 100       347 if( $units =~ /deg/i ) {
    50          
214 45         51 $units = 'degrees';
215             }elsif( $units =~ /rad/i ) {
216 66         69 $units = 'radians';
217             }else{
218 0 0       0 croak("Invalid units specifier '$units' - please use either " .
219             "degrees or radians (the default)") unless $units =~ /rad/i;
220             }
221 111         143 $self->{units} = $units;
222             }
223              
224             =pod
225              
226             =head2 set_distance_unit
227              
228             Set the distance unit used by the Geo::Ellipsoid object. The unit of
229             distance may also be set in the constructor of the object. The recognized
230             values are 'meter', 'kilometer', 'mile', 'nm' (nautical mile), or 'foot'.
231             The default is 'meter'. The value is not case sensitive and may be
232             abbreviated to 3 letters.
233              
234             $geo->set_distance_unit('kilometer');
235              
236             For any other unit of distance not recogized by this method, pass a
237             numerical argument representing the length of the distance unit in
238             meters. For example, to use units of furlongs, call
239              
240             $geo->set_distance_unit(201.168);
241              
242             The distance conversion factors used by this module are as follows:
243              
244             Unit Units per meter
245             -------- ---------------
246             foot 0.3048
247             kilometer 1000.0
248             mile 1609.344
249             nm 1852.0
250              
251             =cut
252              
253             sub set_distance_unit
254             {
255 95     95 1 80 my $self = shift;
256 95         83 my $unit = shift;
257 95 50       296 print "distance unit = $unit\n" if $DEBUG;
258              
259 95         83 my $conversion = 0;
260              
261 95 50       180 if( defined $unit ) {
262              
263 95         69 my( $key, $val );
264 95         277 while( ($key,$val) = each %distance ) {
265 143         202 my $re = substr($key,0,3);
266 143 50       194 print "trying ($key,$re,$val)\n" if $DEBUG;
267 143 100       799 if( $unit =~ /^$re/i ) {
268 95         102 $self->{distance_units} = $unit;
269 95         84 $conversion = $val;
270              
271             # finish iterating to reset 'each' function call
272 95         484 while( each %distance ) {}
273 95         127 last;
274             }
275             }
276              
277 95 50       179 if( $conversion == 0 ) {
278 0 0       0 if( looks_like_number($unit) ) {
279 0         0 $conversion = $unit;
280             }else{
281 0         0 carp("Unknown argument to set_distance_unit: $unit\nAssuming meters");
282 0         0 $conversion = 1.0;
283             }
284             }
285             }else{
286 0         0 carp("Missing or undefined argument to set_distance_unit: ".
287             "$unit\nAssuming meters");
288 0         0 $conversion = 1.0;
289             }
290 95         135 $self->{conversion} = $conversion;
291             }
292              
293             =pod
294              
295             =head2 set_ellipsoid
296              
297             Set the ellipsoid to be used by the Geo::Ellipsoid object. See
298             L<"DEFINED ELLIPSOIDS"> below for the allowable values. The value
299             may also be set by the constructor. The default value is 'WGS84'.
300              
301             $geo->set_ellipsoid('NAD27');
302              
303             =cut
304              
305             sub set_ellipsoid
306             {
307 137     137 1 175 my $self = shift;
308 137   33     308 my $ellipsoid = uc shift || $defaults{ellipsoid};
309 137 50       222 print " set ellipsoid to $ellipsoid\n" if $DEBUG;
310 137 50       257 unless( exists $ellipsoids{$ellipsoid} ) {
311 0         0 croak("Ellipsoid $ellipsoid does not exist - please use " .
312             "set_custom_ellipsoid to use an ellipsoid not in valid set");
313             }
314 137         146 $self->{ellipsoid} = $ellipsoid;
315 137         116 my( $major, $recip ) = @{$ellipsoids{$ellipsoid}};
  137         206  
316 137         153 $self->{equatorial} = $major;
317 137 100       221 if( $recip == 0 ) {
318 1         144 carp("Infinite flattening specified by ellipsoid -- assuming a sphere");
319 1         83 $self->{polar} = $self->{equatorial};
320 1         1 $self->{flattening} = 0;
321 1         3 $self->{eccentricity} = 0;
322             }else{
323 136         281 $self->{flattening} = ( 1.0 / $ellipsoids{$ellipsoid}[1]);
324 136         227 $self->{polar} = $self->{equatorial} * ( 1.0 - $self->{flattening} );
325             $self->{eccentricity} = sqrt( 2.0 * $self->{flattening} -
326 136         280 ( $self->{flattening} * $self->{flattening} ) );
327             }
328             }
329              
330             =pod
331              
332             =head2 set_custom_ellipsoid
333              
334             Sets the ellipsoid parameters to the specified ( major semiaxis and
335             reciprocal flattening. A zero value for the reciprocal flattening
336             will result in a sphere for the ellipsoid, and a warning message
337             will be issued.
338              
339             $geo->set_custom_ellipsoid( 'sphere', 6378137, 0 );
340              
341             =cut
342              
343             sub set_custom_ellipsoid
344             {
345 3     3 1 13 my $self = shift;
346 3         4 my( $name, $major, $recip ) = @_;
347 3         4 $name = uc $name;
348 3 50       11 $recip = 0 unless defined $recip;
349 3 50       12 if( $major ) {
350 3         8 $ellipsoids{$name} = [ $major, $recip ];
351             }else{
352 0         0 croak("set_custom_ellipsoid called without semi-major radius parameter");
353             }
354 3         8 $self->set_ellipsoid($name);
355             }
356              
357             =pod
358              
359             =head2 set_longitude_symmetric
360              
361             If called with no argument or a true argument, sets the range of output
362             values for longitude to be in the range [-pi,+pi) radians. If called with
363             a false or undefined argument, sets the output angle range to be
364             [0,2*pi) radians.
365              
366             $geo->set_longitude_symmetric(1);
367              
368             =cut
369              
370             sub set_longitude_symmetric
371             {
372 94     94 1 109 my( $self, $sym ) = @_;
373             # see if argument passed
374 94 50       163 if( $#_ > 0 ) {
375             # yes -- use value passed
376 94         110 $self->{longitude} = $sym;
377             }else{
378             # no -- set to true
379 0         0 $self->{longitude} = 1;
380             }
381             }
382              
383             =pod
384              
385             =head2 set_bearing_symmetric
386              
387             If called with no argument or a true argument, sets the range of output
388             values for bearing to be in the range [-pi,+pi) radians. If called with
389             a false or undefined argument, sets the output angle range to be
390             [0,2*pi) radians.
391              
392             $geo->set_bearing_symmetric(1);
393              
394             =cut
395              
396             sub set_bearing_symmetric
397             {
398 94     94 1 87 my( $self, $sym ) = @_;
399             # see if argument passed
400 94 50       139 if( $#_ > 0 ) {
401             # yes -- use value passed
402 94         99 $self->{bearing} = $sym;
403             }else{
404             # no -- set to true
405 0         0 $self->{bearing} = 1;
406             }
407             }
408              
409             =pod
410              
411             =head2 set_defaults
412              
413             Sets the defaults for the new method. Call with key, value pairs similar to
414             new.
415              
416             $Geo::Ellipsoid->set_defaults(
417             units => 'degrees',
418             ellipsoid => 'GRS80',
419             distance_units => 'kilometer',
420             longitude => 1,
421             bearing => 0
422             );
423              
424             Keys and string values (except for the ellipsoid identifier) may be shortened
425             to their first three letters and are case-insensitive:
426              
427             $Geo::Ellipsoid->set_defaults(
428             uni => 'deg',
429             ell => 'GRS80',
430             dis => 'kil',
431             lon => 1,
432             bea => 0
433             );
434              
435             =cut
436              
437             sub set_defaults
438             {
439 21     21 1 38803 my $self = shift;
440 21         57 my %args = @_;
441 21         68 while (my ($key, $val) = each %args) {
442 45 100       121 if( $key =~ /^ell/i ) {
    100          
    100          
    100          
    50          
443 21         71 $defaults{ellipsoid} = uc $val;
444             }elsif( $key =~ /^uni/i ) {
445 21         55 $defaults{units} = $val;
446             }elsif( $key =~ /^dis/i ) {
447 1         3 $defaults{distance_units} = $val;
448             }elsif( $key =~ /^lon/i ) {
449 1         2 $defaults{longitude} = $val;
450             }elsif( $key =~ /^bea/i ) {
451 1         3 $defaults{bearing} = $val;
452             }else{
453 0         0 croak("Geo::Ellipsoid::set_defaults called with invalid key: $key");
454             }
455             }
456 21 50       59 print "Defaults set to ($defaults{ellipsoid},$defaults{units}\n"
457             if $DEBUG;
458             }
459              
460             =pod
461              
462             =head2 scales
463              
464             Returns a list consisting of the distance unit per angle of latitude
465             and longitude (degrees or radians) at the specified latitude.
466             These values may be used for fast approximations of distance
467             calculations in the vicinity of some location.
468              
469             ( $lat_scale, $lon_scale ) = $geo->scales($lat0);
470             $x = $lon_scale * ($lon - $lon0);
471             $y = $lat_scale * ($lat - $lat0);
472              
473             =cut
474              
475             sub scales
476             {
477 90     90 1 49960 my $self = shift;
478 90         99 my $units = $self->{units};
479 90         63 my $lat = $_[0];
480 90 50       131 if( defined $lat ) {
481 90 50       206 $lat /= $degrees_per_radian if( $units eq 'degrees' );
482             }else{
483 0         0 carp("scales() method requires latitude argument; assuming 0");
484 0         0 $lat = 0;
485             }
486              
487 90         111 my $aa = $self->{equatorial};
488 90         117 my $bb = $self->{polar};
489 90         94 my $a2 = $aa*$aa;
490 90         71 my $b2 = $bb*$bb;
491 90         161 my $d1 = $aa * cos($lat);
492 90         78 my $d2 = $bb * sin($lat);
493 90         76 my $d3 = $d1*$d1 + $d2*$d2;
494 90         65 my $d4 = sqrt($d3);
495 90         59 my $n1 = $aa * $bb;
496 90         103 my $latscl = ( $n1 * $n1 ) / ( $d3 * $d4 * $self->{conversion} );
497 90         79 my $lonscl = ( $aa * $d1 ) / ( $d4 * $self->{conversion} );
498              
499 90 50       140 if( $DEBUG ) {
500 0         0 print "lat=$lat, aa=$aa, bb=$bb\nd1=$d1, d2=$d2, d3=$d3, d4=$d4\n";
501 0         0 print "latscl=$latscl, lonscl=$lonscl\n";
502             }
503              
504 90 50       128 if( $self->{units} eq 'degrees' ) {
505 90         62 $latscl /= $degrees_per_radian;
506 90         66 $lonscl /= $degrees_per_radian;
507             }
508 90         195 return ( $latscl, $lonscl );
509             }
510              
511             =pod
512              
513             =head2 range
514              
515             Returns the range in distance units between two specified locations given
516             as latitude, longitude pairs.
517              
518             my $dist = $geo->range( $lat1, $lon1, $lat2, $lon2 );
519             my $dist = $geo->range( @origin, @destination );
520              
521             =cut
522              
523             sub range
524             {
525 1220     1220 1 290392 my $self = shift;
526 1220         2152 my @args = _normalize_input($self->{units},@_);
527 1220         1719 my($range,$bearing) = $self->_inverse(@args);
528 1220 50       1498 print "inverse(@_[1..4]) returns($range,$bearing)\n" if $DEBUG;
529 1220         2003 return $range;
530             }
531              
532             =pod
533              
534             =head2 bearing
535              
536             Returns the bearing in degrees or radians from the first location to
537             the second. Zero bearing is true north.
538              
539             my $bearing = $geo->bearing( $lat1, $lon1, $lat2, $lon2 );
540              
541             =cut
542              
543             sub bearing
544             {
545 432     432 1 138938 my $self = shift;
546 432         568 my $units = $self->{units};
547 432         709 my @args = _normalize_input($units,@_);
548 432         797 my($range,$bearing) = $self->_inverse(@args);
549 432 50       571 print "inverse(@args) returns($range,$bearing)\n" if $DEBUG;
550 432         329 my $t = $bearing;
551 432         683 $self->_normalize_output('bearing',$bearing);
552 432 50       2953 print "_normalize_output($t) returns($bearing)\n" if $DEBUG;
553 432         822 return $bearing;
554             }
555              
556             =pod
557              
558             =head2 at
559              
560             Returns the list (latitude,longitude) in degrees or radians that is a
561             specified range and bearing from a given location.
562              
563             my( $lat2, $lon2 ) = $geo->at( $lat1, $lon1, $range, $bearing );
564              
565             =cut
566              
567             sub at
568             {
569 408     408 1 107154 my $self = shift;
570 408         374 my $units = $self->{units};
571 408         686 my( $lat, $lon, $az ) = _normalize_input($units,@_[0,1,3]);
572 408         360 my $r = $_[2];
573 408 50       553 print "at($lat,$lon,$r,$az)\n" if $DEBUG;
574 408         564 my( $lat2, $lon2 ) = $self->_forward($lat,$lon,$r,$az);
575 408 50       664 print "_forward returns ($lat2,$lon2)\n" if $DEBUG;
576 408         543 $self->_normalize_output('longitude',$lon2);
577 408         2341 $self->_normalize_output('latitude',$lat2);
578 408         2071 return ( $lat2, $lon2 );
579             }
580              
581             =pod
582              
583             =head2 to
584              
585             In list context, returns (range, bearing) between two specified locations.
586             In scalar context, returns just the range.
587              
588             my( $dist, $theta ) = $geo->to( $lat1, $lon1, $lat2, $lon2 );
589             my $dist = $geo->to( $lat1, $lon1, $lat2, $lon2 );
590              
591             =cut
592              
593             sub to
594             {
595 252     252 1 149180 my $self = shift;
596 252         308 my $units = $self->{units};
597 252         431 my @args = _normalize_input($units,@_);
598 252 50       477 print "to($units,@args)\n" if $DEBUG;
599 252         437 my($range,$bearing) = $self->_inverse(@args);
600 252 50       417 print "to: inverse(@args) returns($range,$bearing)\n" if $DEBUG;
601             #$bearing *= $degrees_per_radian if $units eq 'degrees';
602 252         402 $self->_normalize_output('bearing',$bearing);
603 252 50       1602 if( wantarray() ) {
604 252         631 return ( $range, $bearing );
605             }else{
606 0         0 return $range;
607             }
608             }
609              
610             =pod
611              
612             =head2 displacement
613              
614             Returns the (x,y) displacement in distance units between the two specified
615             locations.
616              
617             my( $x, $y ) = $geo->displacement( $lat1, $lon1, $lat2, $lon2 );
618              
619             NOTE: The x and y displacements are only approximations and only valid
620             between two locations that are fairly near to each other. Beyond 10 kilometers
621             or more, the concept of X and Y on a curved surface loses its meaning.
622              
623             =cut
624              
625             sub displacement
626             {
627 100     100 1 56483 my $self = shift;
628 100 50       198 print "displacement(",join(',',@_),"\n" if $DEBUG;
629 100         196 my @args = _normalize_input($self->{units},@_);
630 100 50       147 print "call _inverse(@args)\n" if $DEBUG;
631 100         140 my( $range, $bearing ) = $self->_inverse(@args);
632 100 50       125 print "disp: _inverse(@args) returns ($range,$bearing)\n" if $DEBUG;
633 100         115 my $x = $range * sin($bearing);
634 100         92 my $y = $range * cos($bearing);
635 100         211 return ($x,$y);
636             }
637              
638             =pod
639              
640             =head2 location
641              
642             Returns the list (latitude,longitude) of a location at a given (x,y)
643             displacement from a given location.
644              
645             my @loc = $geo->location( $lat, $lon, $x, $y );
646              
647             =cut
648              
649             sub location
650             {
651 200     200 1 116646 my $self = shift;
652 200         245 my $units = $self->{units};
653 200         192 my($lat,$lon,$x,$y) = @_;
654 200         246 my $range = sqrt( $x*$x+ $y*$y );
655 200         282 my $bearing = atan2($x,$y);
656 200 50       378 $bearing *= $degrees_per_radian if $units eq 'degrees';
657 200 50       285 print "location($lat,$lon,$x,$y,$range,$bearing)\n" if $DEBUG;
658 200         334 return $self->at($lat,$lon,$range,$bearing);
659             }
660              
661             ########################################################################
662             #
663             # internal functions
664             #
665             # inverse
666             #
667             # Calculate the displacement from origin to destination.
668             # The input to this subroutine is
669             # ( latitude-1, longitude-1, latitude-2, longitude-2 ) in radians.
670             #
671             # Return the results as the list (range,bearing) with range in the
672             # current specified distance unit and bearing in radians.
673              
674             sub _inverse()
675             {
676 1996     1996   1529 my $self = shift;
677 1996         1878 my( $lat1, $lon1, $lat2, $lon2 ) = (@_);
678 1996 50       2651 print "_inverse($lat1,$lon1,$lat2,$lon2)\n" if $DEBUG;
679              
680 1996         1884 my $a = $self->{equatorial};
681 1996         1567 my $f = $self->{flattening};
682              
683 1996         1527 my $r = 1.0 - $f;
684 1996         3231 my $tu1 = $r * sin($lat1) / cos($lat1);
685 1996         2059 my $tu2 = $r * sin($lat2) / cos($lat2);
686 1996         1972 my $cu1 = 1.0 / ( sqrt(($tu1*$tu1) + 1.0) );
687 1996         1463 my $su1 = $cu1 * $tu1;
688 1996         1786 my $cu2 = 1.0 / ( sqrt( ($tu2*$tu2) + 1.0 ));
689 1996         1516 my $s = $cu1 * $cu2;
690 1996         1408 my $baz = $s * $tu2;
691 1996         1273 my $faz = $baz * $tu1;
692 1996         1438 my $dlon = $lon2 - $lon1;
693              
694 1996 50       2345 if( $DEBUG ) {
695 0         0 printf "lat1=%.8f, lon1=%.8f\n", $lat1, $lon1;
696 0         0 printf "lat2=%.8f, lon2=%.8f\n", $lat2, $lon2;
697 0         0 printf "r=%.8f, tu1=%.8f, tu2=%.8f\n", $r, $tu1, $tu2;
698 0         0 printf "faz=%.8f, dlon=%.8f\n", $faz, $dlon;
699             }
700              
701 1996         1395 my $x = $dlon;
702 1996         1366 my $cnt = 0;
703 1996 50       2379 print "enter loop:\n" if $DEBUG;
704 1996         1450 my( $c2a, $c, $cx, $cy, $cz, $d, $del, $e, $sx, $sy, $y );
705 1996   66     1506 do {
706 9413 50       10730 printf " x=%.8f\n", $x if $DEBUG;
707 9413         6577 $sx = sin($x);
708 9413         6242 $cx = cos($x);
709 9413         5962 $tu1 = $cu2*$sx;
710 9413         7121 $tu2 = $baz - ($su1*$cu2*$cx);
711              
712 9413 50       10547 printf " sx=%.8f, cx=%.8f, tu1=%.8f, tu2=%.8f\n",
713             $sx, $cx, $tu1, $tu2 if $DEBUG;
714              
715 9413         7424 $sy = sqrt( $tu1*$tu1 + $tu2*$tu2 );
716 9413         5867 $cy = $s*$cx + $faz;
717 9413         8031 $y = atan2($sy,$cy);
718 9413         5226 my $sa;
719 9413 100       9643 if( $sy == 0.0 ) {
720 72         78 $sa = 1.0;
721             }else{
722 9341         7019 $sa = ($s*$sx) / $sy;
723             }
724              
725 9413 50       10769 printf " sy=%.8f, cy=%.8f, y=%.8f, sa=%.8f\n", $sy, $cy, $y, $sa
726             if $DEBUG;
727              
728 9413         6367 $c2a = 1.0 - ($sa*$sa);
729 9413         6046 $cz = $faz + $faz;
730 9413 100       11159 if( $c2a > 0.0 ) {
731 8669         7125 $cz = ((-$cz)/$c2a) + $cy;
732             }
733 9413         6748 $e = ( 2.0 * $cz * $cz ) - 1.0;
734 9413         8128 $c = ( ((( (-3.0 * $c2a) + 4.0)*$f) + 4.0) * $c2a * $f )/16.0;
735 9413         6323 $d = $x;
736 9413         7671 $x = ( ($e * $cy * $c + $cz) * $sy * $c + $y) * $sa;
737 9413         7234 $x = ( 1.0 - $c ) * $x * $f + $dlon;
738 9413         6419 $del = $d - $x;
739              
740 9413 50       30264 if( $DEBUG ) {
741 0         0 printf " c2a=%.8f, cz=%.8f\n", $c2a, $cz;
742 0         0 printf " e=%.8f, d=%.8f\n", $e, $d;
743 0         0 printf " (d-x)=%.8g\n", $del;
744             }
745              
746             }while( (abs($del) > $eps) && ( ++$cnt <= $max_loop_count ) );
747              
748 1996         1829 $faz = atan2($tu1,$tu2);
749 1996         2173 $baz = atan2($cu1*$sx,($baz*$cx - $su1*$cu2)) + pi;
750 1996         2118 $x = sqrt( ((1.0/($r*$r)) -1.0 ) * $c2a+1.0 ) + 1.0;
751 1996         1567 $x = ($x-2.0)/$x;
752 1996         1407 $c = 1.0 - $x;
753 1996         1779 $c = (($x*$x)/4.0 + 1.0)/$c;
754 1996         1564 $d = ((0.375*$x*$x) - 1.0)*$x;
755 1996         1206 $x = $e*$cy;
756              
757 1996 50       2542 if( $DEBUG ) {
758 0         0 printf "e=%.8f, cy=%.8f, x=%.8f\n", $e, $cy, $x;
759 0         0 printf "sy=%.8f, c=%.8f, d=%.8f\n", $sy, $c, $d;
760 0         0 printf "cz=%.8f, a=%.8f, r=%.8f\n", $cz, $a, $r;
761             }
762              
763 1996         1582 $s = 1.0 - $e - $e;
764 1996         3079 $s = (((((((( $sy * $sy * 4.0 ) - 3.0) * $s * $cz * $d/6.0) - $x) *
765             $d /4.0) + $cz) * $sy * $d) + $y ) * $c * $a * $r;
766              
767 1996 50       2216 printf "s=%.8f\n", $s if $DEBUG;
768              
769             # adjust azimuth to (0,360) or (-180,180) as specified
770 1996 50       2592 if( $self->{symmetric} ) {
771 0 0       0 $faz += $twopi if $faz < -(pi);
772 0 0       0 $faz -= $twopi if $faz >= pi;
773             }else{
774 1996 100       2845 $faz += $twopi if $faz < 0;
775 1996 50       2647 $faz -= $twopi if $faz >= $twopi;
776             }
777              
778             # return result
779 1996         3371 my @disp = ( ($s/$self->{conversion}), $faz );
780 1996 50       2421 print "disp = (@disp)\n" if $DEBUG;
781 1996         3753 return @disp;
782             }
783              
784             # _forward
785             #
786             # Calculate the location (latitue,longitude) of a point
787             # given a starting point and a displacement from that
788             # point as (range,bearing)
789             #
790             sub _forward
791             {
792 400     400   324 my $self = shift;
793 400         340 my( $lat1, $lon1, $range, $bearing ) = @_;
794              
795 400 50       604 if( $DEBUG ) {
796 0         0 printf "_forward(lat1=%.8f,lon1=%.8f,range=%.8f,bearing=%.8f)\n",
797             $lat1, $lon1, $range, $bearing;
798             }
799              
800 400         276 my $eps = 0.5e-13;
801              
802 400         354 my $a = $self->{equatorial};
803 400         301 my $f = $self->{flattening};
804 400         310 my $r = 1.0 - $f;
805              
806 400         633 my $tu = $r * sin($lat1) / cos($lat1);
807 400         262 my $faz = $bearing;
808 400         352 my $s = $self->{conversion} * $range;
809 400         348 my $sf = sin($faz);
810 400         327 my $cf = cos($faz);
811              
812 400         270 my $baz = 0.0;
813 400 50       803 $baz = 2.0 * atan2($tu,$cf) if( $cf != 0.0 );
814              
815 400         402 my $cu = 1.0 / sqrt(1.0 + $tu*$tu);
816 400         295 my $su = $tu * $cu;
817 400         246 my $sa = $cu * $sf;
818 400         283 my $c2a = 1.0 - ($sa*$sa);
819 400         417 my $x = 1.0 + sqrt( (((1.0/($r*$r)) - 1.0 )*$c2a) +1.0);
820 400         309 $x = ($x-2.0)/$x;
821 400         276 my $c = 1.0 - $x;
822 400         321 $c = ((($x*$x)/4.0) + 1.0)/$c;
823 400         334 my $d = $x * ((0.375*$x*$x)-1.0);
824 400         321 $tu = (($s/$r)/$a)/$c;
825 400         266 my $y = $tu;
826              
827 400 50       504 if( $DEBUG ) {
828 0         0 printf "r=%.8f, tu=%.8f, faz=%.8f\n", $r, $tu, $faz;
829 0         0 printf "baz=%.8f, sf=%.8f, cf=%.8f\n", $baz, $sf, $cf;
830 0         0 printf "cu=%.8f, su=%.8f, sa=%.8f\n", $cu, $su, $sa;
831 0         0 printf "x=%.8f, c=%.8f, y=%.8f\n", $x, $c, $y;
832             }
833              
834 400         277 my( $cy, $cz, $e, $sy );
835 400         262 do {
836 1484         901 $sy = sin($y);
837 1484         895 $cy = cos($y);
838 1484         989 $cz = cos($baz+$y);
839 1484         1037 $e = (2.0*$cz*$cz)-1.0;
840 1484         847 $c = $y;
841 1484         842 $x = $e * $cy;
842 1484         915 $y = (2.0 * $e) - 1.0;
843 1484         2840 $y = ((((((((($sy*$sy*4.0)-3.0)*$y*$cz*$d)/6.0)+$x)*$d)/4.0)-$cz)*$sy*$d) +
844             $tu;
845             } while( abs($y-$c) > $eps );
846              
847 400         314 $baz = ($cu*$cy*$cf) - ($su*$sy);
848 400         354 $c = $r*sqrt(($sa*$sa) + ($baz*$baz));
849 400         271 $d = $su*$cy + $cu*$sy*$cf;
850 400         389 my $lat2 = atan2($d,$c);
851 400         293 $c = $cu*$cy - $su*$sy*$cf;
852 400         317 $x = atan2($sy*$sf,$c);
853 400         357 $c = (((((-3.0*$c2a)+4.0)*$f)+4.0)*$c2a*$f)/16.0;
854 400         336 $d = (((($e*$cy*$c) + $cz)*$sy*$c)+$y)*$sa;
855 400         306 my $lon2 = $lon1 + $x - (1.0-$c)*$d*$f;
856             #$baz = atan2($sa,$baz) + pi;
857              
858             # return result
859 400         558 return ($lat2,$lon2);
860              
861             }
862              
863             # _normalize_input
864             #
865             # Normalize a set of input angle values by converting to
866             # radians if given in degrees and by converting to the
867             # range [0,2pi), i.e. greater than or equal to zero and
868             # less than two pi.
869             #
870             sub _normalize_input
871             {
872 2412     2412   1985 my $units = shift;
873 2412         3159 my @args = @_;
874             return map {
875 2412 100       2621 $_ = deg2rad($_) if $units eq 'degrees';
  9240         18463  
876 9240         44516 while( $_ < 0 ) { $_ += $twopi }
  1908         2987  
877 9240         12165 while( $_ >= $twopi ) { $_ -= $twopi }
  0         0  
878             $_
879 9240         11350 } @args;
880             }
881              
882             # _normalize_output
883             #
884             # Normalize a set of output angle values by converting to
885             # degrees if needed and by converting to the range [-pi,+pi) or
886             # [0,2pi) as needed.
887             #
888             sub _normalize_output
889             {
890 1500     1500   1162 my $self = shift;
891 1500         1138 my $elem = shift; # 'bearing' or 'longitude'
892             # adjust remaining input values by reference
893 1500         2069 for ( @_ ) {
894 1500 100       2171 if( $self->{$elem} ) {
895             # normalize to range [-pi,pi)
896 824         1264 while( $_ < -(pi) ) { $_ += $twopi }
  0         0  
897 824         1120 while( $_ >= pi ) { $_ -= $twopi }
  209         346  
898             }else{
899             # normalize to range [0,2*pi)
900 676         1131 while( $_ < 0 ) { $_ += $twopi }
  3         7  
901 676         963 while( $_ >= $twopi ) { $_ -= $twopi }
  0         0  
902             }
903 1500 100       3639 $_ = rad2deg($_) if $self->{units} eq 'degrees';
904             }
905             }
906              
907             =pod
908              
909             =head1 DEFINED ELLIPSOIDS
910              
911             The following ellipsoids are defined in Geo::Ellipsoid, with the
912             semi-major axis in meters and the reciprocal flattening as shown.
913             The default ellipsoid is WGS84.
914              
915             Ellipsoid Semi-Major Axis (m.) 1/Flattening
916             --------- ------------------- ---------------
917             AIRY 6377563.396 299.3249646
918             AIRY-MODIFIED 6377340.189 299.3249646
919             AUSTRALIAN 6378160.0 298.25
920             BESSEL-1841 6377397.155 299.1528128
921             CLARKE-1880 6378249.145 293.465
922             EVEREST-1830 6377276.345 290.8017
923             EVEREST-MODIFIED 6377304.063 290.8017
924             FISHER-1960 6378166.0 298.3
925             FISHER-1968 6378150.0 298.3
926             GRS80 6378137.0 298.25722210088
927             HOUGH-1956 6378270.0 297.0
928             HAYFORD 6378388.0 297.0
929             IAU76 6378140.0 298.257
930             KRASSOVSKY-1938 6378245.0 298.3
931             NAD27 6378206.4 294.9786982138
932             NWL-9D 6378145.0 298.25
933             SOUTHAMERICAN-1969 6378160.0 298.25
934             SOVIET-1985 6378136.0 298.257
935             WGS72 6378135.0 298.26
936             WGS84 6378137.0 298.257223563
937              
938             =head1 LIMITATIONS
939              
940             The methods should not be used on points which are too near the poles
941             (above or below 89 degrees), and should not be used on points which
942             are antipodal, i.e., exactly on opposite sides of the ellipsoid. The
943             methods will not return valid results in these cases.
944              
945             =head1 ACKNOWLEDGEMENTS
946              
947             The conversion algorithms used here are Perl translations of Fortran
948             routines written by LCDR S NGS Rockville MD that implement
949             S Modified Rainsford's method with Helmert's elliptical
950             terms as published in "Direct and Inverse Solutions of Ellipsoid on
951             the Ellipsoid with Application of Nested Equations", S
952             Survey Review, April 1975.
953              
954             The Fortran source code files inverse.for and forward.for
955             may be obtained from
956              
957             ftp://ftp.ngs.noaa.gov/pub/pcsoft/for_inv.3d/source/
958              
959             =head1 AUTHOR
960              
961             Jim Gibson, C<< >>
962              
963             =head1 BUGS
964              
965             See LIMITATIONS, above.
966              
967             Please report any bugs or feature requests to
968             C, or through the web interface at
969             L.
970              
971             =head1 COPYRIGHT & LICENSE
972              
973             Copyright 2005-2008 Jim Gibson, all rights reserved.
974              
975             Copyright 2016 Peter John Acklam
976              
977             This program is free software; you can redistribute it and/or modify it
978             under the same terms as Perl itself.
979              
980             =head1 SEE ALSO
981              
982             Geo::Distance, Geo::Ellipsoids
983              
984             =cut
985              
986             1; # End of Geo::Ellipsoid