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   178747 use warnings;
  12         15  
  12         305  
15 12     12   38 use strict;
  12         14  
  12         165  
16 12     12   151 use 5.006_00;
  12         27  
17              
18 12     12   43 use Scalar::Util 'looks_like_number';
  12         20  
  12         845  
19 12     12   5305 use Math::Trig;
  12         122910  
  12         1280  
20 12     12   59 use Carp;
  12         13  
  12         33443  
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.14, released Sun Sep 18 2016.
31              
32             =cut
33              
34             our $VERSION = '1.14';
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 84789 my( $class, %args ) = @_;
162 94         387 my $self = {%defaults};
163 94 50       226 print "new: @_\n" if $DEBUG;
164 94         236 while (my ($key, $val) = each %args) {
165 47 100       186 if( $key =~ /^ell/i ) {
    100          
    100          
    100          
    50          
166 20         63 $self->{ellipsoid} = uc $val;
167             }elsif( $key =~ /^uni/i ) {
168 16         50 $self->{units} = $val;
169             }elsif( $key =~ /^dis/i ) {
170 5         11 $self->{distance_units} = $val;
171             }elsif( $key =~ /^lon/i ) {
172 4         12 $self->{longitude} = $val;
173             }elsif( $key =~ /^bea/i ) {
174 2         7 $self->{bearing} = $val;
175             }else{
176 0         0 carp("Unknown argument: $key => $val");
177             }
178             }
179 94         105 bless $self, $class;
180 94         190 $self->set_ellipsoid($self->{ellipsoid});
181 94         139 $self->set_units($self->{units});
182 94         131 $self->set_distance_unit($self->{distance_units});
183 94         186 $self->set_longitude_symmetric($self->{longitude});
184 94         131 $self->set_bearing_symmetric($self->{bearing});
185 94 50       129 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         191 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 514 my $self = shift;
212 111         80 my $units = shift;
213 111 100       318 if( $units =~ /deg/i ) {
    50          
214 45         42 $units = 'degrees';
215             }elsif( $units =~ /rad/i ) {
216 66         65 $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         116 $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 78 my $self = shift;
256 95         71 my $unit = shift;
257 95 50       231 print "distance unit = $unit\n" if $DEBUG;
258              
259 95         77 my $conversion = 0;
260              
261 95 50       153 if( defined $unit ) {
262              
263 95         74 my( $key, $val );
264 95         232 while( ($key,$val) = each %distance ) {
265 285         350 my $re = substr($key,0,3);
266 285 50       336 print "trying ($key,$re,$val)\n" if $DEBUG;
267 285 100       1872 if( $unit =~ /^$re/i ) {
268 95         100 $self->{distance_units} = $unit;
269 95         72 $conversion = $val;
270              
271             # finish iterating to reset 'each' function call
272 95         356 while( each %distance ) {}
273 95         115 last;
274             }
275             }
276              
277 95 50       165 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         128 $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 164 my $self = shift;
308 137   33     267 my $ellipsoid = uc shift || $defaults{ellipsoid};
309 137 50       182 print " set ellipsoid to $ellipsoid\n" if $DEBUG;
310 137 50       218 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         126 $self->{ellipsoid} = $ellipsoid;
315 137         387 my( $major, $recip ) = @{$ellipsoids{$ellipsoid}};
  137         201  
316 137         131 $self->{equatorial} = $major;
317 137 100       211 if( $recip == 0 ) {
318 1         137 carp("Infinite flattening specified by ellipsoid -- assuming a sphere");
319 1         58 $self->{polar} = $self->{equatorial};
320 1         2 $self->{flattening} = 0;
321 1         2 $self->{eccentricity} = 0;
322             }else{
323 136         251 $self->{flattening} = ( 1.0 / $ellipsoids{$ellipsoid}[1]);
324 136         195 $self->{polar} = $self->{equatorial} * ( 1.0 - $self->{flattening} );
325             $self->{eccentricity} = sqrt( 2.0 * $self->{flattening} -
326 136         246 ( $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 12 my $self = shift;
346 3         5 my( $name, $major, $recip ) = @_;
347 3         5 $name = uc $name;
348 3 50       12 $recip = 0 unless defined $recip;
349 3 50       7 if( $major ) {
350 3         7 $ellipsoids{$name} = [ $major, $recip ];
351             }else{
352 0         0 croak("set_custom_ellipsoid called without semi-major radius parameter");
353             }
354 3         9 $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 88 my( $self, $sym ) = @_;
373             # see if argument passed
374 94 50       138 if( $#_ > 0 ) {
375             # yes -- use value passed
376 94         101 $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 78 my( $self, $sym ) = @_;
399             # see if argument passed
400 94 50       110 if( $#_ > 0 ) {
401             # yes -- use value passed
402 94         83 $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 22964 my $self = shift;
440 21         46 my %args = @_;
441 21         49 while (my ($key, $val) = each %args) {
442 45 100       104 if( $key =~ /^ell/i ) {
    100          
    100          
    100          
    50          
443 21         63 $defaults{ellipsoid} = uc $val;
444             }elsif( $key =~ /^uni/i ) {
445 21         47 $defaults{units} = $val;
446             }elsif( $key =~ /^dis/i ) {
447 1         2 $defaults{distance_units} = $val;
448             }elsif( $key =~ /^lon/i ) {
449 1         3 $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       43 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 46011 my $self = shift;
478 90         88 my $units = $self->{units};
479 90         72 my $lat = $_[0];
480 90 50       114 if( defined $lat ) {
481 90 50       196 $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         88 my $aa = $self->{equatorial};
488 90         79 my $bb = $self->{polar};
489 90         98 my $a2 = $aa*$aa;
490 90         59 my $b2 = $bb*$bb;
491 90         134 my $d1 = $aa * cos($lat);
492 90         84 my $d2 = $bb * sin($lat);
493 90         75 my $d3 = $d1*$d1 + $d2*$d2;
494 90         58 my $d4 = sqrt($d3);
495 90         60 my $n1 = $aa * $bb;
496 90         90 my $latscl = ( $n1 * $n1 ) / ( $d3 * $d4 * $self->{conversion} );
497 90         80 my $lonscl = ( $aa * $d1 ) / ( $d4 * $self->{conversion} );
498              
499 90 50       130 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         55 $latscl /= $degrees_per_radian;
506 90         66 $lonscl /= $degrees_per_radian;
507             }
508 90         167 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 207372 my $self = shift;
526 1220         1603 my @args = _normalize_input($self->{units},@_);
527 1220         1529 my($range,$bearing) = $self->_inverse(@args);
528 1220 50       1382 print "inverse(@_[1..4]) returns($range,$bearing)\n" if $DEBUG;
529 1220         1595 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 73680 my $self = shift;
546 432         410 my $units = $self->{units};
547 432         608 my @args = _normalize_input($units,@_);
548 432         607 my($range,$bearing) = $self->_inverse(@args);
549 432 50       495 print "inverse(@args) returns($range,$bearing)\n" if $DEBUG;
550 432         312 my $t = $bearing;
551 432         515 $self->_normalize_output('bearing',$bearing);
552 432 50       2333 print "_normalize_output($t) returns($bearing)\n" if $DEBUG;
553 432         620 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 105839 my $self = shift;
570 408         339 my $units = $self->{units};
571 408         629 my( $lat, $lon, $az ) = _normalize_input($units,@_[0,1,3]);
572 408         327 my $r = $_[2];
573 408 50       483 print "at($lat,$lon,$r,$az)\n" if $DEBUG;
574 408         500 my( $lat2, $lon2 ) = $self->_forward($lat,$lon,$r,$az);
575 408 50       627 print "_forward returns ($lat2,$lon2)\n" if $DEBUG;
576 408         511 $self->_normalize_output('longitude',$lon2);
577 408         1966 $self->_normalize_output('latitude',$lat2);
578 408         1987 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 111945 my $self = shift;
596 252         280 my $units = $self->{units};
597 252         372 my @args = _normalize_input($units,@_);
598 252 50       342 print "to($units,@args)\n" if $DEBUG;
599 252         359 my($range,$bearing) = $self->_inverse(@args);
600 252 50       342 print "to: inverse(@args) returns($range,$bearing)\n" if $DEBUG;
601             #$bearing *= $degrees_per_radian if $units eq 'degrees';
602 252         348 $self->_normalize_output('bearing',$bearing);
603 252 50       1373 if( wantarray() ) {
604 252         523 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 32696 my $self = shift;
628 100 50       181 print "displacement(",join(',',@_),"\n" if $DEBUG;
629 100         149 my @args = _normalize_input($self->{units},@_);
630 100 50       118 print "call _inverse(@args)\n" if $DEBUG;
631 100         150 my( $range, $bearing ) = $self->_inverse(@args);
632 100 50       118 print "disp: _inverse(@args) returns ($range,$bearing)\n" if $DEBUG;
633 100         87 my $x = $range * sin($bearing);
634 100         95 my $y = $range * cos($bearing);
635 100         180 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 77759 my $self = shift;
652 200         193 my $units = $self->{units};
653 200         180 my($lat,$lon,$x,$y) = @_;
654 200         217 my $range = sqrt( $x*$x+ $y*$y );
655 200         247 my $bearing = atan2($x,$y);
656 200 50       330 $bearing *= $degrees_per_radian if $units eq 'degrees';
657 200 50       279 print "location($lat,$lon,$x,$y,$range,$bearing)\n" if $DEBUG;
658 200         270 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   1341 my $self = shift;
677 1996         1613 my( $lat1, $lon1, $lat2, $lon2 ) = (@_);
678 1996 50       2437 print "_inverse($lat1,$lon1,$lat2,$lon2)\n" if $DEBUG;
679              
680 1996         1713 my $a = $self->{equatorial};
681 1996         1341 my $f = $self->{flattening};
682              
683 1996         1385 my $r = 1.0 - $f;
684 1996         2676 my $tu1 = $r * sin($lat1) / cos($lat1);
685 1996         1697 my $tu2 = $r * sin($lat2) / cos($lat2);
686 1996         1649 my $cu1 = 1.0 / ( sqrt(($tu1*$tu1) + 1.0) );
687 1996         1400 my $su1 = $cu1 * $tu1;
688 1996         1550 my $cu2 = 1.0 / ( sqrt( ($tu2*$tu2) + 1.0 ));
689 1996         1322 my $s = $cu1 * $cu2;
690 1996         1278 my $baz = $s * $tu2;
691 1996         1294 my $faz = $baz * $tu1;
692 1996         1250 my $dlon = $lon2 - $lon1;
693              
694 1996 50       2199 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         1256 my $x = $dlon;
702 1996         1249 my $cnt = 0;
703 1996 50       2139 print "enter loop:\n" if $DEBUG;
704 1996         1274 my( $c2a, $c, $cx, $cy, $cz, $d, $del, $e, $sx, $sy, $y );
705 1996   66     1258 do {
706 9413 50       9958 printf " x=%.8f\n", $x if $DEBUG;
707 9413         6028 $sx = sin($x);
708 9413         5696 $cx = cos($x);
709 9413         5712 $tu1 = $cu2*$sx;
710 9413         6363 $tu2 = $baz - ($su1*$cu2*$cx);
711              
712 9413 50       9763 printf " sx=%.8f, cx=%.8f, tu1=%.8f, tu2=%.8f\n",
713             $sx, $cx, $tu1, $tu2 if $DEBUG;
714              
715 9413         6771 $sy = sqrt( $tu1*$tu1 + $tu2*$tu2 );
716 9413         5596 $cy = $s*$cx + $faz;
717 9413         6854 $y = atan2($sy,$cy);
718 9413         5034 my $sa;
719 9413 100       8911 if( $sy == 0.0 ) {
720 72         44 $sa = 1.0;
721             }else{
722 9341         6336 $sa = ($s*$sx) / $sy;
723             }
724              
725 9413 50       9828 printf " sy=%.8f, cy=%.8f, y=%.8f, sa=%.8f\n", $sy, $cy, $y, $sa
726             if $DEBUG;
727              
728 9413         6001 $c2a = 1.0 - ($sa*$sa);
729 9413         5437 $cz = $faz + $faz;
730 9413 100       10562 if( $c2a > 0.0 ) {
731 8669         6367 $cz = ((-$cz)/$c2a) + $cy;
732             }
733 9413         6385 $e = ( 2.0 * $cz * $cz ) - 1.0;
734 9413         7196 $c = ( ((( (-3.0 * $c2a) + 4.0)*$f) + 4.0) * $c2a * $f )/16.0;
735 9413         5509 $d = $x;
736 9413         7200 $x = ( ($e * $cy * $c + $cz) * $sy * $c + $y) * $sa;
737 9413         6591 $x = ( 1.0 - $c ) * $x * $f + $dlon;
738 9413         5584 $del = $d - $x;
739              
740 9413 50       26565 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         1562 $faz = atan2($tu1,$tu2);
749 1996         1884 $baz = atan2($cu1*$sx,($baz*$cx - $su1*$cu2)) + pi;
750 1996         1929 $x = sqrt( ((1.0/($r*$r)) -1.0 ) * $c2a+1.0 ) + 1.0;
751 1996         1343 $x = ($x-2.0)/$x;
752 1996         1285 $c = 1.0 - $x;
753 1996         1606 $c = (($x*$x)/4.0 + 1.0)/$c;
754 1996         1482 $d = ((0.375*$x*$x) - 1.0)*$x;
755 1996         1149 $x = $e*$cy;
756              
757 1996 50       2283 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         1333 $s = 1.0 - $e - $e;
764 1996         2782 $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       2117 printf "s=%.8f\n", $s if $DEBUG;
768              
769             # adjust azimuth to (0,360) or (-180,180) as specified
770 1996 50       2146 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       2447 $faz += $twopi if $faz < 0;
775 1996 50       2365 $faz -= $twopi if $faz >= $twopi;
776             }
777              
778             # return result
779 1996         2557 my @disp = ( ($s/$self->{conversion}), $faz );
780 1996 50       2250 print "disp = (@disp)\n" if $DEBUG;
781 1996         3030 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   275 my $self = shift;
793 400         346 my( $lat1, $lon1, $range, $bearing ) = @_;
794              
795 400 50       446 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         261 my $eps = 0.5e-13;
801              
802 400         320 my $a = $self->{equatorial};
803 400         308 my $f = $self->{flattening};
804 400         281 my $r = 1.0 - $f;
805              
806 400         615 my $tu = $r * sin($lat1) / cos($lat1);
807 400         264 my $faz = $bearing;
808 400         297 my $s = $self->{conversion} * $range;
809 400         316 my $sf = sin($faz);
810 400         284 my $cf = cos($faz);
811              
812 400         260 my $baz = 0.0;
813 400 50       738 $baz = 2.0 * atan2($tu,$cf) if( $cf != 0.0 );
814              
815 400         346 my $cu = 1.0 / sqrt(1.0 + $tu*$tu);
816 400         282 my $su = $tu * $cu;
817 400         263 my $sa = $cu * $sf;
818 400         295 my $c2a = 1.0 - ($sa*$sa);
819 400         406 my $x = 1.0 + sqrt( (((1.0/($r*$r)) - 1.0 )*$c2a) +1.0);
820 400         291 $x = ($x-2.0)/$x;
821 400         258 my $c = 1.0 - $x;
822 400         304 $c = ((($x*$x)/4.0) + 1.0)/$c;
823 400         320 my $d = $x * ((0.375*$x*$x)-1.0);
824 400         288 $tu = (($s/$r)/$a)/$c;
825 400         248 my $y = $tu;
826              
827 400 50       495 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         249 my( $cy, $cz, $e, $sy );
835 400         260 do {
836 1484         880 $sy = sin($y);
837 1484         839 $cy = cos($y);
838 1484         1001 $cz = cos($baz+$y);
839 1484         1017 $e = (2.0*$cz*$cz)-1.0;
840 1484         857 $c = $y;
841 1484         852 $x = $e * $cy;
842 1484         904 $y = (2.0 * $e) - 1.0;
843 1484         2770 $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         312 $baz = ($cu*$cy*$cf) - ($su*$sy);
848 400         341 $c = $r*sqrt(($sa*$sa) + ($baz*$baz));
849 400         290 $d = $su*$cy + $cu*$sy*$cf;
850 400         346 my $lat2 = atan2($d,$c);
851 400         294 $c = $cu*$cy - $su*$sy*$cf;
852 400         282 $x = atan2($sy*$sf,$c);
853 400         358 $c = (((((-3.0*$c2a)+4.0)*$f)+4.0)*$c2a*$f)/16.0;
854 400         337 $d = (((($e*$cy*$c) + $cz)*$sy*$c)+$y)*$sa;
855 400         343 my $lon2 = $lon1 + $x - (1.0-$c)*$d*$f;
856             #$baz = atan2($sa,$baz) + pi;
857              
858             # return result
859 400         524 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   1659 my $units = shift;
873 2412         2685 my @args = @_;
874             return map {
875 2412 100       2288 $_ = deg2rad($_) if $units eq 'degrees';
  9240         16301  
876 9240         38994 while( $_ < 0 ) { $_ += $twopi }
  1908         2671  
877 9240         10360 while( $_ >= $twopi ) { $_ -= $twopi }
  0         0  
878             $_
879 9240         9818 } @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   1049 my $self = shift;
891 1500         991 my $elem = shift; # 'bearing' or 'longitude'
892             # adjust remaining input values by reference
893 1500         1779 for ( @_ ) {
894 1500 100       1819 if( $self->{$elem} ) {
895             # normalize to range [-pi,pi)
896 824         1113 while( $_ < -(pi) ) { $_ += $twopi }
  0         0  
897 824         1039 while( $_ >= pi ) { $_ -= $twopi }
  209         283  
898             }else{
899             # normalize to range [0,2*pi)
900 676         991 while( $_ < 0 ) { $_ += $twopi }
  3         5  
901 676         902 while( $_ >= $twopi ) { $_ -= $twopi }
  0         0  
902             }
903 1500 100       3155 $_ = 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