File Coverage

blib/lib/PDL/Transform/Cartography.pm
Criterion Covered Total %
statement 204 852 23.9
branch 59 366 16.1
condition 6 53 11.3
subroutine 22 75 29.3
pod 24 25 96.0
total 315 1371 22.9


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             PDL::Transform::Cartography - Useful cartographic projections
4              
5             =head1 SYNOPSIS
6              
7             # make a Mercator map of Earth
8             use PDL::Transform::Cartography;
9             use PDL::Graphics::Simple;
10             $x = earth_coast();
11             $x = graticule(10,2)->glue(1,$x);
12             $t = t_mercator;
13             $w = pgswin();
14             $w->plot(with=>'polylines', $t->apply($x)->clean_lines);
15              
16             =head1 DESCRIPTION
17              
18             PDL::Transform::Cartography includes a variety of useful cartographic
19             and observing projections (mappings of the surface of a sphere),
20             including reprojected observer coordinates. See L
21             for more information about image transforms in general.
22              
23             Cartographic transformations are used for projecting not just
24             terrestrial maps, but also any nearly spherical surface including the
25             Sun, the Celestial sphere, various moons and planets, distant stars,
26             etc. They also are useful for interpreting scientific images, which
27             are themselves generally projections of a sphere onto a flat focal
28             plane (e.g. the L projection).
29              
30             Unless otherwise noted, all the transformations in this file convert
31             from (theta,phi) coordinates on the unit sphere (e.g. (lon,lat) on a
32             planet or (RA,dec) on the celestial sphere) into some sort of
33             projected coordinates, and have inverse transformations that convert
34             back to (theta,phi). This is equivalent to working from the
35             equidistant cylindrical (or L<"plate carree"|/t_carree>) projection, if
36             you are a cartography wonk.
37              
38             The projected coordinates are generally in units of body radii
39             (radians), so that multiplying the output by the scale of the map
40             yields physical units that are correct wherever the scale is correct
41             for that projection. For example, areas should be correct everywhere
42             in the authalic projections; and linear scales are correct along
43             meridians in the equidistant projections and along the standard
44             parallels in all the projections.
45              
46             The transformations that are authalic (equal-area), conformal
47             (equal-angle), azimuthal (circularly symmetric), or perspective (true
48             perspective on a focal plane from some viewpoint) are marked. The
49             first two categories are mutually exclusive for all but the
50             L<"unit sphere"|/t_unit_sphere> 3-D projection.
51              
52             Extra dimensions tacked on to each point to be transformed are, in
53             general, ignored. That is so that you can add on an extra index
54             to keep track of pen color. For example, L
55             returns a 3x ndarray containing (lon, lat, pen) at each list location.
56             Transforming the vector list retains the pen value as the first index
57             after the dimensional directions.
58              
59             =head1 GENERAL NOTES ON CARTOGRAPHY
60              
61             Unless otherwise noted, the transformations and miscellaneous
62             information in this section are taken from Snyder & Voxland 1989: "An
63             Album of Map Projections", US Geological Survey Professional Paper
64             1453, US Printing Office (Denver); and from Snyder 1987: "Map
65             Projections - A Working Manual", US Geological Survey Professional
66             Paper 1395, US Printing Office (Denver, USA). You can obtain your own
67             copy of both by contacting the U.S. Geological Survey, Federal Center,
68             Box 25425, Denver, CO 80225 USA.
69              
70             The mathematics of cartography have a long history, and the details
71             are far trickier than the broad overview. For terrestrial (and, in
72             general, planetary) cartography, the best reference datum is not a
73             sphere but an oblate ellipsoid due to centrifugal force from the
74             planet's rotation. Furthermore, because all rocky planets, including
75             Earth, have randomly placed mass concentrations that affect the
76             gravitational field, the reference gravitational isosurface (sea level
77             on Earth) is even more complex than an ellipsoid and, in general,
78             different ellipsoids have been used for different locations at the
79             same time and for the same location at different times.
80              
81             The transformations in this package use a spherical datum and hence
82             include global distortion at about the 0.5% level for terrestrial maps
83             (Earth's oblateness is ~1/300). This is roughly equal to the
84             dimensional precision of physical maps printed on paper (due to
85             stretching and warping of the paper) but is significant at larger
86             scales (e.g. for regional maps). If you need more precision than
87             that, you will want to implement and use the ellipsoidal
88             transformations from Snyder 1987 or another reference work on geodesy.
89             A good name for that package would be C<...::Cartography::Geodetic>.
90              
91             =head1 GENERAL NOTES ON PERSPECTIVE AND SCIENTIFIC IMAGES
92              
93             Cartographic transformations are useful for interpretation of
94             scientific images, as all cameras produce projections of the celestial
95             sphere onto the focal plane of the camera. A simple (single-element)
96             optical system with a planar focal plane generates
97             L images -- that is to say, gnomonic projections
98             of a portion of the celestial sphere near the paraxial direction.
99             This is the projection that most consumer grade cameras produce.
100              
101             Magnification in an optical system changes the angle of incidence
102             of the rays on the focal plane for a given angle of incidence at the
103             aperture. For example, a 10x telescope with a 2 degree field of view
104             exhibits the same gnomonic distortion as a simple optical system with
105             a 20 degree field of view. Wide-angle optics typically have magnification
106             less than 1 ('fisheye lenses'), reducing the gnomonic distortion
107             considerably but introducing L<"equidistant azimuthal"|/t_az_eqd> distortion --
108             there's no such thing as a free lunch!
109              
110             Because many solar-system objects are spherical,
111             PDL::Transform::Cartography includes perspective projections for
112             producing maps of spherical bodies from perspective views. Those
113             projections are L<"t_vertical"|/t_vertical> and
114             L<"t_perspective"|/t_perspective>. They map between (lat,lon) on the
115             spherical body and planar projected coordinates at the viewpoint.
116             L<"t_vertical"|/t_vertical> is the vertical perspective projection
117             given by Snyder, but L<"t_perspective"|/t_perspective> is a fully
118             general perspective projection that also handles magnification correction.
119              
120             =head1 TRANSVERSE & OBLIQUE PROJECTIONS; STANDARD OPTIONS
121              
122             Oblique projections rotate the sphere (and graticule) to an arbitrary
123             angle before generating the projection; transverse projections rotate
124             the sphere exactly 90 degrees before generating the projection.
125              
126             Most of the projections accept the following standard options,
127             useful for making transverse and oblique projection maps.
128              
129             =over 3
130              
131             =item o, origin, Origin [default (0,0,0)]
132              
133             The origin of the oblique map coordinate system, in (old-theta, old-phi)
134             coordinates.
135              
136             =item r, roll, Roll [default 0.0]
137              
138             The roll angle of the sphere about the origin, measured CW from (N = up)
139             for reasonable values of phi and CW from (S = up) for unreasonable
140             values of phi. This is equivalent to observer roll angle CCW from the
141             same direction.
142              
143             =item u, unit, Unit [default 'degree']
144              
145             This is the name of the angular unit to use in the lon/lat coordinate system.
146              
147             =item b, B
148              
149             The "B" angle of the body -- used for extraterrestrial maps. Setting
150             this parameter is exactly equivalent to setting the phi component
151             of the origin, and in fact overrides it.
152              
153             =item l,L
154              
155             The longitude of the central meridian as observed -- used for extraterrestrial
156             maps. Setting this parameter is exactly equivalent to setting the theta
157             component of the origin, and in fact overrides it.
158              
159             =item p,P
160              
161             The "P" (or position) angle of the body -- used for extraterrestrial maps.
162             This parameter is a synonym for the roll angle, above.
163              
164             =item bad, Bad, missing, Missing [default nan]
165              
166             This is the value that missing points get. Mainly useful for the
167             inverse transforms. (This should work fine if set to BAD, if you have
168             bad-value support compiled in). The default nan is asin(1.2), calculated
169             at load time.
170              
171             =back
172              
173             =head1 EXAMPLES
174              
175             Draw a Mercator map of the world on-screen:
176              
177             $w = pgswin();
178             $w->plot(with=>'polylines', earth_coast->apply(t_mercator)->clean_lines);
179              
180             Here, C returns a 3xn ndarray containing (lon, lat, pen)
181             values for the included world coastal outline; C converts
182             the values to projected Mercator coordinates, and C breaks
183             lines that cross the 180th meridian.
184              
185             Draw a Mercator map of the world, with lon/lat at 10 degree intervals:
186              
187             $w = pgswin();
188             $x = earth_coast()->glue(1,graticule(10,1));
189             $w->plot(with=>'polylines', $x->apply(t_mercator)->clean_lines);
190              
191             This works just the same as the first example, except that a map graticule
192             has been applied with interline spacing of 10 degrees lon/lat and
193             inter-vertex spacing of 1 degree (so that each meridian contains 181 points,
194             and each parallel contains 361 points).
195              
196             =head1 NOTES
197              
198             Currently angular conversions are rather simpleminded. A list of
199             common conversions is present in the main constructor, which inserts a
200             conversion constant to radians into the {params} field of the new
201             transform. Something like Math::Convert::Units should be used instead
202             to generate the conversion constant.
203              
204             A cleaner higher-level interface is probably needed (see the examples);
205             for example, earth_coast could return a graticule if asked, instead of
206             needing one to be glued on.
207              
208             The class structure is somewhat messy because of the varying needs of
209             the different transformations. PDL::Transform::Cartography is a base
210             class that interprets the origin options and sets up the basic
211             machinery of the Transform. The conic projections have their
212             own subclass, PDL::Transform::Conic, that interprets the standard
213             parallels. Since the cylindrical and azimuthal projections are pretty
214             simple, they are not subclassed.
215              
216             The perl 5.6.1 compiler is quite slow at adding new classes to the
217             structure, so it does not makes sense to subclass new transformations
218             merely for the sake of pedantry.
219              
220             =head1 AUTHOR
221              
222             Copyright 2002, Craig DeForest (deforest@boulder.swri.edu). This
223             module may be modified and distributed under the same terms as PDL
224             itself. The module comes with NO WARRANTY.
225              
226             The included digital world map is derived from the 1987 CIA World Map,
227             translated to ASCII in 1988 by Joe Dellinger (geojoe@freeusp.org) and
228             simplified in 1995 by Kirk Johnson (tuna@indra.com) for the program
229             XEarth. The map comes with NO WARRANTY. An ASCII version of the map,
230             and a sample PDL function to read it, may be found in the Demos
231             subdirectory of the PDL source distribution.
232              
233             =head1 FUNCTIONS
234              
235             The module exports both transform constructors ('t_') and some
236             auxiliary functions (no leading 't_').
237              
238             =cut
239              
240             # Import PDL::Transform into the calling package -- the cartography
241             # stuff isn't much use without it.
242 1     1   893 use PDL::Transform;
  1         3  
  1         5  
243              
244             package PDL::Transform::Cartography;
245 1     1   5 use strict;
  1         2  
  1         18  
246 1     1   3 use warnings;
  1         1  
  1         70  
247 1     1   5 use PDL::Core ':Internal'; # Load 'topdl' (internal routine)
  1         1  
  1         6  
248              
249 1     1   5 use Exporter ();
  1         1  
  1         18  
250 1     1   4 use PDL::LiteF;
  1         2  
  1         4  
251 1     1   3 use PDL::Math;
  1         2  
  1         7  
252 1     1   4 use PDL::Transform;
  1         2  
  1         3  
253 1     1   5 use PDL::MatrixOps;
  1         1  
  1         4  
254 1     1   4 use Carp;
  1         1  
  1         177  
255              
256             our @ISA = ( 'Exporter','PDL::Transform' );
257             our $VERSION = "0.6";
258             $VERSION = eval $VERSION;
259             our @EXPORT_OK = qw(
260             graticule earth_image earth_coast earth_shape clean_lines t_unit_sphere
261             raster2fits
262             t_orthographic t_rot_sphere t_caree t_carree t_mercator t_utm t_sin_lat
263             t_sinusoidal t_conic t_albers t_lambert t_stereographic t_gnomonic
264             t_az_eqd t_az_eqa t_vertical t_perspective t_hammer t_aitoff
265             );
266             our @EXPORT = @EXPORT_OK;
267             our %EXPORT_TAGS = (Func=>\@EXPORT_OK);
268              
269             our @PLATE_CARREE = ([qw(Longitude Latitude RGB)],
270             [qw(degrees degrees index)], [[-180,180], [-90,90], [0,2]]);
271              
272             ##############################
273             # Steal _opt from PDL::Transform.
274             *PDL::Transform::Cartography::_opt = \&PDL::Transform::_opt;
275 1     1   5 use overload '""' => \&_strval;
  1         1  
  1         7  
276              
277             our $PI = $PDL::Transform::PI;
278             our $DEG2RAD = $PDL::Transform::DEG2RAD;
279             our $RAD2DEG = $PDL::Transform::RAD2DEG;
280              
281             sub _strval {
282 0     0   0 my($me) = shift;
283 0         0 $me->stringify();
284             }
285              
286             ######################################################################
287              
288             =head2 graticule
289              
290             =for usage
291              
292             $lonlatp = graticule(,);
293             $lonlatp = graticule(,,1);
294              
295             =for ref
296              
297             (Cartography) PDL constructor - generate a lat/lon grid.
298              
299             Returns a grid of meridians and parallels as a list of vectors suitable
300             for sending to
301             L
302             for plotting.
303             The grid is in degrees in (theta, phi) coordinates -- this is (E lon, N lat)
304             for terrestrial grids or (RA, dec) for celestial ones. You must then
305             transform the graticule in the same way that you transform the map.
306              
307             You can attach the graticule to a vector map using the syntax:
308              
309             $out = graticule(10,2)->glue(1,$map);
310              
311             In array context you get back a 2-element list containing an ndarray of
312             the (theta,phi) pairs and an ndarray of the pen values (1 or 0) suitable for
313             calling
314             L.
315             In scalar context the two elements are combined into a single ndarray.
316              
317             The pen values associated with the graticule are negative, which will cause
318             L
319             to plot them as hairlines.
320              
321             If a third argument is given, it is a hash of options, which can be:
322              
323             =over 3
324              
325             =item nan - if true, use two columns instead of three, and separate lines with a 'nan' break
326              
327             =item lonpos - if true, all reported longitudes are positive (0 to 360) instead of (-180 to 180).
328              
329             =item dup - if true, the meridian at the far boundary is duplicated.
330              
331             =back
332              
333             =cut
334              
335             sub graticule {
336 0     0 1 0 my $grid = shift;
337 0         0 my $step = shift;
338 0 0       0 my $hash = shift; $hash = {} unless defined($hash); # avoid // for ancient compatibility
  0         0  
339 0   0     0 my $two_cols = $hash->{nan} || 0;
340 0   0     0 my $lonpos = $hash->{lonpos} || 0;
341 0   0     0 my $dup = $hash->{dup} || 0;
342              
343 0 0       0 $grid = 10 unless defined($grid);
344 0 0       0 $grid = $grid->at(0) if(ref($grid) eq 'PDL');
345            
346 0 0       0 $step = $grid/2 unless defined($step);
347 0 0       0 $step = $step->at(0) if(ref($step) eq 'PDL');
348              
349             # Figure number of parallels and meridians
350 0         0 my $np = 2 * int(90/$grid);
351 0         0 my $nm = 2 * int(180/$grid);
352            
353             # First do parallels.
354 0         0 my $xp = xvals(360/$step + 1 + !!$two_cols, $np + 1) * $step - 180 * (!$lonpos);
355 0         0 my $yp = yvals(360/$step + 1 + !!$two_cols, $np + 1) * 180/$np - 90;
356 0 0       0 $xp->slice("-1,:") .= $yp->slice("-1,:") .= asin(pdl(1.1)) if($two_cols);
357              
358             # Next do meridians.
359 0         0 my $xm = yvals( 180/$step + 1 + !!$two_cols, $nm + !!$dup ) * 360/$nm - 180 * (!$lonpos);
360 0         0 my $ym = xvals( 180/$step + 1 + !!$two_cols, $nm + !!$dup ) * $step - 90;
361 0 0       0 $xm->slice("-1,:") .= $ym->slice("-1,:") .= asin(pdl(1.1)) if($two_cols);
362              
363            
364 0 0       0 if($two_cols) {
365 0         0 return pdl( $xp->flat->append($xm->flat),
366             $yp->flat->append($ym->flat)
367             )->mv(1,0);
368             } else {
369 0         0 our $pp = zeroes($xp)-1; $pp->slice("(-1)") .= 0;
  0         0  
370 0         0 our $pm = zeroes($xm)-1; $pm->slice("(-1)") .= 0;
  0         0  
371              
372 0 0       0 if(wantarray) {
373 0         0 return ( pdl( $xp->flat->append($xm->flat),
374             $yp->flat->append($ym->flat)
375             )->mv(1,0),
376            
377             $pp->flat->append($pm->flat)
378             );
379             } else {
380 0         0 return pdl( $xp->flat->append($xm->flat),
381             $yp->flat->append($ym->flat),
382             $pp->flat->append($pm->flat)
383             )->mv(1,0);
384             }
385 0         0 barf "This can't happen";
386             }
387             }
388              
389             =head2 earth_coast
390              
391             =for usage
392              
393             $x = earth_coast()
394              
395             =for ref
396              
397             (Cartography) PDL constructor - coastline map of Earth
398              
399             Returns a vector coastline map based on the 1987 CIA World Coastline
400             database (see author information). The vector coastline data are in
401             plate carree format so they can be converted to other projections via
402             the L method and cartographic transforms,
403             and are suitable for plotting with the
404             L
405             plot type in the PDL::Graphics::Simple
406             output library: the first dimension is (X,Y,pen) with breaks having
407             a pen value of 0 and hairlines having negative pen values. The second
408             dimension broadcasts over all the points in the data set.
409              
410             The vector map includes lines that pass through the antipodean
411             meridian, so if you want to plot it without reprojecting, you should
412             run it through L first:
413              
414             $w = pgswin();
415             $w->plot(with=>'polylines',
416             earth_coast->clean_lines); # plot plate carree map of world
417             $w->plot(with=>'polylines',
418             earth_coast->apply(t_gnomonic)->clean_lines)# plot gnomonic map of world
419              
420             C is just a quick-and-dirty way of loading the file
421             "earth_coast.vec.fits" that is part of the normal installation tree.
422              
423             =cut
424              
425             sub earth_coast {
426 1     1 1 820 my $fn = "PDL/Transform/Cartography/earth_coast.vec.fits";
427 1         2 local $_;
428 1         6 require PDL::IO::FITS;
429 1         3 foreach(@INC) {
430 2         5 my $file = "$_/$fn";
431 2 100       59 next if !-e $file;
432 1         6 my $val = PDL::IO::FITS::rfits($file);
433 1         5 $val->hdrcpy(1);
434 1         6 return $val;
435             }
436 0         0 barf("earth_coast: $fn not found in \@INC.\n");
437             }
438              
439             =head2 earth_image
440              
441             =for usage
442              
443             $rgb = earth_image()
444              
445             =for ref
446              
447             (Cartography) PDL constructor - RGB pixel map of Earth
448              
449             Returns an RGB image of Earth based on data from the MODIS instrument
450             on the NASA EOS/Terra satellite. (You can get a full-resolution
451             image from L).
452             The image is a plate carree map, so you can convert it to other
453             projections via the L method and cartographic
454             transforms.
455              
456             This is just a quick-and-dirty way of loading the earth-image files that
457             are distributed along with PDL.
458              
459             =cut
460              
461             sub earth_image {
462 0     0 1 0 my($nd) = shift;
463 0         0 my $f;
464 0         0 require PDL::IO::Pic;
465 0         0 my $dir = "PDL/Transform/Cartography/earth_";
466 0 0 0     0 $f = (($nd//'') =~ m/^n/i) ? "${dir}night.jpg" : "${dir}day.jpg";
467 0         0 local $_;
468 0         0 my $im;
469 0         0 my $found = 0;
470 0         0 foreach(@INC) {
471 0         0 my $file = "$_/$f";
472 0 0       0 if(-e $file) {
473 0         0 $found = 1;
474 0         0 $im = PDL::IO::Pic::rpic($file);
475             }
476 0 0       0 last if defined($im);
477             }
478 0 0       0 barf("earth_image: $f not found in \@INC\n") if !$found;
479 0 0       0 barf("earth_image: couldn't load $f; you may need to install netpbm.\n")
480             unless defined($im);
481 0         0 raster2fits($im, @PLATE_CARREE);
482             }
483              
484             =head2 earth_shape
485              
486             =for usage
487              
488             $fits_shape = earth_shape()
489              
490             =for ref
491              
492             (Cartography) PDL constructor - height map of Earth
493              
494             Returns a height map of Earth based on data from the General
495             Bathymetric Chart of the Oceans (GEBCO) produced by the British
496             Oceanographic Data Centre. (You can get a full-resolution image from
497             L). The image is a
498             plate carree map, so you can convert it to other projections via the
499             L method and cartographic transforms.
500             The data is from 8-bit grayscale (so only 256 levels), but is returned
501             as float, values in Earth radii, in dimensions (2048,1024), like
502             L. The range represents a span of 6400m, so Everest and
503             the Marianas Trench are not accurately represented.
504              
505             Value Hex value Float From centre in km Float as radius
506             Base 00 0.0 6370.69873km 0.99995
507             Sea level 0C 0.04705 6371km 1.0
508             Highest FF 1.0 6377.09863km 1.00096
509              
510             Code:
511              
512             $shape = earth_shape();
513              
514             =cut
515              
516             sub earth_shape {
517 0     0 1 0 my($nd) = shift;
518 0         0 require PDL::IO::Pic;
519 0         0 my $f = "PDL/Transform/Cartography/earth_height-2048x1024.jpg";
520 0         0 local $_;
521 0         0 my $im;
522 0         0 my $found = 0;
523 0         0 foreach (@INC) {
524 0         0 my $file = "$_/$f";
525 0 0       0 if(-e $file) {
526 0         0 $found = 1;
527 0         0 $im = PDL::IO::Pic::rpic($file);
528             }
529 0 0       0 last if defined($im);
530             }
531 0 0       0 barf("earth_shape: $f not found in \@INC\n")
532             unless defined($found);
533 0 0       0 barf("earth_shape: couldn't load $f; you may need to install netpbm.\n")
534             unless defined($im);
535 0         0 ((raster2fits($im, @PLATE_CARREE)->float - float(0x0C)) / float(255*6400))
536             + float(1);
537             }
538              
539             =head2 raster2fits
540              
541             =for usage
542              
543             $pdl_fits = raster2fits($pdl, \@axislabels, \@axisunits, \@axisranges);
544             $pdl_fits = raster2fits($pdl, @PDL::Transform::Cartography::PLATE_CARREE);
545              
546             =for ref
547              
548             Convert a raster ([3,]x,y) to FITS (x,y[,3]), with a suitable header
549             for the given parameters.
550              
551             =cut
552              
553             sub raster2fits {
554 3 50   3 1 12 die "Usage: raster2fits(\$d, \\\@axislabels, \\\@axisunits, \\\@axisranges)\n" if @_ != 4;
555 3         11 my ($d, $axislabels, $axisunits, $axisranges) = @_;
556 3         15 my $is_single_plane = (my $ndims = $d->ndims) <= 2;
557 3 50       11 my $out = $is_single_plane ? $d : $d->mv(0,2);
558 3         15 my $h = $out->fhdr;
559 3         22 $h->{SIMPLE} = 'T';
560 3         171 $h->{NAXIS} = $ndims;
561 3         768 local $_;
562 3         17 my @dims = $out->dims;
563 3         22 $h->{"NAXIS".($_+1)} = $dims[$_] for 0..$ndims-1;
564 3         1364 $h->{"CRVAL".($_+1)} = 0 for 0..$ndims-1;
565 3 50       1547 $h->{"CRPIX".($_+1)} = $_<2 ? ($dims[$_]+1)/2 : 1 for 0..$ndims-1;
566 3         1730 $h->{"CTYPE".($_+1)} = $axislabels->[$_] for 0..$ndims-1;
567 3         1832 $h->{"CUNIT".($_+1)} = $axisunits->[$_] for 0..$ndims-1;
568             $h->{"CDELT".($_+1)} = ($axisranges->[$_][1]-$axisranges->[$_][0])/$dims[$_]
569 3         1925 for 0..$ndims-1;
570 3         2008 $h->{HISTORY}='PDL conversion from raster image';
571 3         1014 $out;
572             }
573              
574             =head2 clean_lines
575              
576             =for usage
577              
578             $x = clean_lines(t_mercator->apply(scalar(earth_coast())));
579             $x = $lines->clean_lines; # same as above, both "first (scalar) form"
580             $x = clean_lines($line_pen[,threshold][,opt]); # also same but threshold given
581             $x = clean_lines($line,$pen[,threshold][,opt]); # "second (list) form"
582              
583             =for ref
584              
585             (Cartography) PDL method - remove projection irregularities
586              
587             C massages vector data to remove jumps due to singularities
588             in the transform.
589              
590             In the first (scalar) form, C<$line_pen> contains both (X,Y) points and pen
591             values in the 3rd column suitable to be fed to
592             the L
593             plot type in the PDL::Graphics::Simple.
594              
595             In the second (list) form, C<$lines> contains the (X,Y) points and C<$pen>
596             contains the pen values, in one less dimension than the C<$lines>.
597              
598             C assumes that all the outline polylines are local --
599             that is to say, there are no large jumps. Any jumps larger than a
600             threshold size are broken by setting the appropriate pen values to 0.
601              
602             The C parameter sets the relative size of the largest jump, relative
603             to the map range (as determined by a min/max operation). The default size is
604             0.1. If C is greater than or equal to 1, lines will not be
605             broken based on point separation.
606              
607             =for options
608              
609             The following options are interpreted:
610              
611             =over 3
612              
613             =item or, orange, output_range, Output_Range
614              
615             $lp = $lp->clean_lines(1.1,{or=>[[178.9,179.7], [62.8,64.5]]})
616              
617             This sets the window of output space, similar to that in
618             L. As there, it specifies a quadrilateral in
619             output space. Any points not in that will be removed from the output,
620             and line breaks (0 pen values) will be inserted before.
621              
622             Because this returns a selection of the inputs, it will not broadcast.
623              
624             =item fn, filter_nan
625              
626             Defaults to true. Will break before any points with bad/C/C
627             coordinates, and remove those points from the output.
628              
629             Because this returns a selection of the inputs, it will not broadcast.
630              
631             =back
632              
633             NOTES
634              
635             This almost never catches stuff near the apex of cylindrical maps,
636             because the anomalous vectors get arbitrarily small. This could be
637             improved somewhat by looking at individual runs of the pen and using
638             a relative length scale that is calibrated to the rest of each run.
639             it is probably not worth the computational overhead.
640              
641             =cut
642              
643             *PDL::clean_lines = *PDL::clean_lines = \&clean_lines;
644             sub clean_lines {
645 26 100   26 1 3676 my $opt = ref($_[-1]) eq 'HASH' ? pop : {};
646 26 100       105 my $th = !UNIVERSAL::isa($_[-1],'PDL') ? pop : 0.1;
647 26 50 33     144 die "Usage: clean_lines(\$line[, \$pen][, \$thresh])\n"
648             if @_ > 2 || !@_;
649 26 50       123 die "clean_lines: all non-threshold args must be ndarrays\n"
650             if grep !UNIVERSAL::isa($_,'PDL'), @_;
651 26 50 66     133 die "clean_lines: need lines[3,n...] in single-arg case\n"
652             if @_ == 1 and $_[0]->dim(0) != 3;
653 26 50       175 my ($l, $p) = @_ == 1
    50          
    100          
654             ? ($_[0]->slice("0:1"), $_[0]->is_inplace ? $_[0]->slice("(2)") : $_[0]->slice("(2)")->sever)
655             : ($_[0], $_[1]->is_inplace ? $_[1] : $_[1]->copy);
656 26         601 my $break_mask = !isfinite($p); # break on NaN/Inf/BAD
657 26         798 $break_mask |= !isfinite($l)->orover; # break on either coord NaN/Inf/BAD
658 26 100       194 if ($th < 1) {
659 24         101 my ($mins, $maxes) = $l->t->whereND(($p != 0) & isfinite($p))->minmaxover;
660 24         319 my $threshes = abs($maxes-$mins) * $th;
661 24         135 my $diff = $l->t->diff2->abs->t;
662 24         122 $break_mask |= ($diff > $threshes)->orover->append(pdl(0));
663             }
664 26         215 $p->whereND($break_mask) .= 0;
665 26         242 my $fn = PDL::Transform::_opt($opt, ['fn','filter_nan'], 1);
666 26 100       68 if ($fn) {
667 2 50       15 die "clean_lines: no broadcasting with filter_nan\n" if $p->ndims > 1;
668 2         54 my $nonfinite_mask = (!$l->isfinite)->orover;
669 2         23 $break_mask = $nonfinite_mask->slice('1:-1')->append(pdl(0)); # break before
670 2         18 $p->whereND($break_mask) .= 0;
671 2         18 my $keep_inds = (!$nonfinite_mask)->which;
672 2         15 $l = $l->dice_axis(1, $keep_inds)->sever;
673 2         11 $p = $p->dice_axis(0, $keep_inds)->sever;
674             }
675 26         73 my $orange = PDL::Transform::_opt($opt, ['or','orange','output_range','Output_Range']);
676 26 100       80 if (defined $orange) {
677 1 50       7 die "clean_lines: no broadcasting with orange\n" if $p->ndims > 1;
678 1 50       5 die "clean_lines: orange must be array-ref\n" if ref($orange) ne 'ARRAY';
679 1 50       6 die "clean_lines: orange must have two elements" if @$orange != 2;
680 1 50       29 die "clean_lines: orange must have two array-refs\n"
681             if grep ref() ne 'ARRAY', @$orange;
682 1 50       6 die "clean_lines: orange must have two array-refs each with two elements\n"
683             if grep @$_ != 2, @$orange;
684 1         7 my ($mins, $maxes) = PDL->pdl($orange)->using(0,1);
685 1         10 my $outside_mask = (($l < $mins) | ($l > $maxes))->orover;
686 1         14 $break_mask = $outside_mask->slice('1:-1')->append(pdl(0)); # break before
687 1         12 $p->whereND($break_mask) .= 0;
688 1         28 my $keep_inds = (!$outside_mask)->which;
689 1         8 $l = $l->dice_axis(1, $keep_inds)->sever;
690 1         9 $p = $p->dice_axis(0, $keep_inds)->sever;
691             }
692 26 100       542 wantarray ? ($l,$p) : $l->append($p->dummy(0,1));
693             }
694              
695             ######################################################################
696              
697             ###
698             # Units parser
699             # Get unit, return conversion factor to radii, or undef if no match found.
700             #
701             sub _uconv{
702             ###
703             # Replace this with a more general units resolver call!
704             ###
705 3     3   8 local($_) = shift;
706 3         7 my($silent) =shift;
707              
708 3 0       47 my($x) =
    0          
    0          
    0          
    0          
    50          
    50          
    50          
    50          
    50          
    50          
    100          
    100          
709             ( m/^deg/i ? $DEG2RAD :
710             m/^arcmin/i ? $DEG2RAD / 60 :
711             m/^arcsec/i ? $DEG2RAD / 3600 :
712             m/^hour/i ? $DEG2RAD * 15 : # Right ascension
713             m/^min/i ? $DEG2RAD * 15/60 : # Right ascension
714             m/^microrad/i ? 1e-6 :
715             m/^millirad/i ? 1e-3 :
716             m/^rad(ian)?s?$/i ? 1.0 :
717             m/^meter/ ? 1.0/6371000 : # Assuming Earth cartography!
718             m/^kilometer/ ? 1.0/6371 :
719             m/^km/ ? 1.0/6371 :
720             m/^Mm/ ? 1.0/6.371 :
721             m/^mile/ ? 1.0/(637100000/2.54/12/5280) :
722             undef
723             );
724 3 0 33     14 print STDERR "Cartography: unrecognized unit '$_'\n"
      0        
      33        
725             if( (!defined $x) && !$silent && ($PDL::debug || $PDL::verbose));
726 3         16 $x;
727             }
728              
729             ###
730             #
731             # Cartography general constructor -- called by the individual map
732             # constructors. Not underscored because it's certainly OK to call from
733             # outside -- but the *last* argument is the name of the transform.
734             #
735             # The options list is put into the {options} field of the newly constructed
736             # Transform -- fastidious subclass constructors will want to delete it before
737             # returning.
738             #
739              
740              
741 2     2   21 sub _new { __PACKAGE__->new(@_); } # not exported
742             sub new {
743 2     2 0 8 my($class) = shift;
744 2         8 my($name) = pop;
745              
746 2         7 my($o) = $_[0];
747 2 50       20 $o = {@_}
748             unless(ref $o eq 'HASH');
749              
750 2         23 my($me) = __PACKAGE__->SUPER::new;
751 2         116 $me->{idim} = $me->{odim} = 2;
752 2         5 $me->{name} = $name;
753            
754             ####
755             # Parse origin and units arguments
756             #
757 2         16 my $or = _opt($o,['o','origin','Origin'],zeroes(2));
758 2 50       23 if($or->nelem != 2) {
759 0         0 croak("PDL::Transform::Cartography: origin must have 2 elements\n");
760             }
761              
762 2         11 my($l) = _opt($o,['l','L']);
763 2         10 my($b_angle) = _opt($o,['b','B']);
764              
765 2 50       8 $or->slice("0") .= $l if defined($l);
766 2 50       7 $or->slice("1") .= $b_angle if defined($b_angle);
767              
768 2         15 my $roll = topdl(_opt($o,['r','roll','Roll','P'],0));
769 2         13 my $unit = _opt($o,['u','unit','Unit'],'degrees');
770              
771 2         10 $me->{params}->{conv} = my $conv = _uconv($unit);
772 2         7 $me->{params}->{u} = $unit;
773              
774 2         9 $me->{itype} = ['longitude','latitude'];
775 2         10 $me->{iunit} = [$me->{params}->{u},$me->{params}->{u}];
776              
777 2         10 my($ou) = _opt($o,['ou','ounit','OutputUnit'],undef);
778 2         7 $me->{params}->{ou} = $ou;
779 2 50       7 if(defined $ou) {
780 0 0       0 if(!(ref $ou)) {
781 0         0 $me->{params}->{oconv} = _uconv($ou);
782             } else {
783 0         0 my @oconv;
784 0         0 map {push(@oconv,_uconv($_))} @$ou;
  0         0  
785 0         0 $me->{params}->{oconv} = topdl([@oconv]);
786             }
787             } else {
788 2         8 $me->{params}->{oconv} = undef;
789             }
790 2         7 $me->{ounit} = $me->{params}->{ou};
791              
792 2         11 $me->{params}->{o} = $or * $conv;
793 2         7 $me->{params}->{roll} = $roll * $conv;
794              
795 2         12 $me->{params}->{bad} = _opt($o,['b','bad','Bad','missing','Missing'],
796             asin(pdl(1.1)));
797              
798             # Get the standard parallel (in general there's only one; the conics
799             # have two but that's handled by _c_new)
800             $me->{params}->{std} = topdl(_opt($me->{options},
801             ['s','std','standard','Standard'],
802 2         26 0))->at(0) * $me->{params}->{conv};
803              
804 2         16 $me->{options} = $o;
805 2         13 $me;
806             }
807              
808             # Compose self with t_rot_sphere if necessary -- useful for
809             # finishing off the transformations that accept the origin and roll
810             # options.
811             sub PDL::Transform::Cartography::_finish {
812 0     0   0 my($me) = shift;
813 0 0 0     0 if( ($me->{params}->{o}->slice("0") != 0) ||
      0        
814             ($me->{params}->{o}->slice("1") != 0) ||
815             ($me->{params}->{roll} != 0)
816             ) {
817 0         0 my $out = t_compose($me,t_rot_sphere($me->{options}));
818 0         0 $out->{itype} = $me->{itype};
819 0         0 $out->{iunit} = $me->{iunit};
820 0         0 $out->{otype} = $me->{otype};
821 0         0 $out->{ounit} = $me->{ounit};
822 0         0 $out->{odim} = 2;
823 0         0 $out->{idim} = 2;
824 0         0 return $out;
825             }
826 0         0 return $me;
827             }
828              
829             ######################################################################
830              
831             =head2 t_unit_sphere
832              
833             =for usage
834              
835             $t = t_unit_sphere();
836              
837             =for ref
838              
839             (Cartography) 3-D globe projection (conformal; authalic)
840              
841             This is similar to the inverse of
842             L,
843             but the
844             inverse transform projects 3-D coordinates onto the unit sphere,
845             yielding only a 2-D (lon/lat) output. Similarly, the forward
846             transform deprojects 2-D (lon/lat) coordinates onto the surface of a
847             unit sphere.
848              
849             The cartesian system has its Z axis pointing through the pole of the
850             (lon,lat) system, and its X axis pointing through the equator at the
851             prime meridian.
852              
853             Unit sphere mapping is unusual in that it is both conformal and authalic.
854             That is possible because it properly embeds the sphere in 3-space, as a
855             notional globe.
856              
857             This is handy as an intermediate step in lots of transforms, as
858             Cartesian 3-space is cleaner to work with than spherical 2-space.
859              
860             Higher dimensional indices are preserved, so that "rider" indices (such as
861             pen value) are propagated.
862              
863             There is no oblique transform for t_unit_sphere, largely because
864             it's so easy to rotate the output using t_linear once it's out into
865             Cartesian space. In fact, the other projections implement oblique
866             transforms by
867             L
868             L with
869             L.
870              
871             OPTIONS:
872              
873             =over 3
874              
875             =item radius, Radius (default 1.0)
876              
877             The radius of the sphere, for the inverse transform. (Radius is ignored
878             in the forward transform). Defaults to 1.0 so that the resulting Cartesian
879             coordinates are in units of "body radii".
880              
881             =back
882              
883             =cut
884              
885             sub t_unit_sphere {
886 1     1 1 7 my($me) = _new(@_,'Unit Sphere Projection');
887 1         5 $me->{odim} = 3;
888              
889 1         6 $me->{params}->{otype} = ['X','Y','Z'];
890 1         4 $me->{params}->{ounit} = ['body radii','body radii','body radii'];
891              
892             $me->{params}->{r} = topdl(_opt($me->{options},
893 1         7 ['r','radius','Radius'],
894             1.0)
895             )->at(0);
896            
897            
898             $me->{func} = sub {
899 8     8   21 my($d,$o) = @_;
900 8         33 my(@dims) = $d->dims;
901 8         15 $dims[0] ++;
902 8         28 my $out = zeroes(@dims);
903            
904             my($thetaphi) = ((defined $o->{conv} && $o->{conv} != 1.0) ?
905 8 50 33     72 $d->slice("0:1") * $o->{conv} : $d->slice("0:1")
906             );
907              
908 8         24 my $th = $thetaphi->slice("(0)");
909 8         21 my $ph = $thetaphi->slice("(1)");
910              
911             # use x as a holding tank for the cos-phi multiplier
912 8         26 $out->slice("(0)") .= $o->{r} * cos($ph) ;
913 8         102 $out->slice("(1)") .= $out->slice("(0)") * sin($th);
914 8         79 $out->slice("(0)") *= cos($th);
915              
916 8         56 $out->slice("(2)") .= $o->{r} * sin($ph);
917              
918 8 50       73 if($d->dim(0) > 2) {
919 0         0 $out->slice("3:-1") .= $d->slice("2:-1");
920             }
921              
922 8         75 $out;
923              
924 1         12 };
925              
926             $me->{inv} = sub {
927 0     0   0 my($d,$o) = @_;
928            
929 0         0 my($d0,$d1,$d2) = ($d->slice("(0)"),$d->slice("(1)"),$d->slice("(2)"));
930 0         0 my($r) = $d->slice("0:2")->magnover;
931 0         0 my(@dims) = $d->dims;
932 0         0 $dims[0]--;
933 0         0 my($out) = zeroes(@dims);
934            
935 0         0 $out->slice("(0)") .= atan2($d1,$d0);
936 0         0 $out->slice("(1)") .= asin($d2/$r);
937              
938 0 0       0 if($d->dim(0) > 3) {
939 0         0 $out->slice("2:-1") .= $d->slice("3:-1");
940             }
941              
942             $out->slice("0:1") /= $o->{conv}
943 0 0 0     0 if(defined $o->{conv} && $o->{conv} != 1.0);
944              
945 0         0 $out;
946 1         22 };
947              
948            
949 1         9 $me;
950             }
951              
952             ######################################################################
953              
954             =head2 t_rot_sphere
955              
956             =for usage
957              
958             $t = t_rot_sphere({origin=>[,],roll=>[]});
959              
960             =for ref
961              
962             (Cartography) Generate oblique projections
963              
964             You feed in the origin in (theta,phi) and a roll angle, and you get back
965             out (theta', phi') coordinates. This is useful for making oblique or
966             transverse projections: just compose t_rot_sphere with your favorite
967             projection and you get an oblique one.
968              
969             Most of the projections automagically compose themselves with t_rot_sphere
970             if you feed in an origin or roll angle.
971              
972             t_rot_sphere converts the base plate carree projection (straight lon, straight
973             lat) to a Cassini projection.
974              
975             OPTIONS
976              
977             =over 3
978              
979             =item STANDARD POSITIONAL OPTIONS
980              
981             =back
982              
983             =cut
984              
985             # helper routine for making the rotation matrix
986             sub _rotmat {
987 2     2   9 my($th,$ph,$r) = @_;
988            
989 2         16 pdl( [ cos($th) , -sin($th), 0 ], # apply theta
990             [ sin($th) , cos($th), 0 ],
991             [ 0, 0, 1 ] )
992             x
993             pdl( [ cos($ph), 0, -sin($ph) ], # apply phi
994             [ 0, 1, 0 ],
995             [ sin($ph), 0, cos($ph) ] )
996             x
997             pdl( [ 1, 0 , 0 ], # apply roll last
998             [ 0, cos($r), -sin($r) ],
999             [ 0, sin($r), cos($r) ])
1000             ;
1001             }
1002              
1003             sub t_rot_sphere {
1004 0     0 1 0 my($me) = _new(@_,'Spherical rotation');
1005              
1006              
1007 0         0 my($th,$ph) = $me->{params}->{o}->list;
1008 0         0 my($r) = $me->{params}->{roll}->at(0);
1009              
1010 0         0 my($rotmat) = _rotmat($th,$ph,$r);
1011              
1012 0         0 my $out = t_wrap( t_linear(m=>$rotmat, d=>3), t_unit_sphere());
1013 0         0 $out->{itype} = $me->{itype};
1014 0         0 $out->{iunit} = $me->{iunit};
1015 0         0 $out->{otype} = ['rotated longitude','rotated latitude'];
1016 0         0 $out->{ounit} = $me->{iunit};
1017              
1018 0         0 $out;
1019             }
1020              
1021              
1022             ######################################################################
1023              
1024             =head2 t_orthographic
1025              
1026             =for usage
1027              
1028             $t = t_orthographic();
1029              
1030             =for ref
1031              
1032             (Cartography) Ortho. projection (azimuthal; perspective)
1033              
1034             This is a perspective view as seen from infinite distance. You
1035             can specify the sub-viewer point in (lon,lat) coordinates, and a rotation
1036             angle of the map CW from (north=up). This is equivalent to specify
1037             viewer roll angle CCW from (north=up).
1038              
1039             t_orthographic is a convenience interface to t_unit_sphere -- it is implemented
1040             as a composition of a t_unit_sphere call, a rotation, and a slice.
1041              
1042             [*] In the default case where the near hemisphere is mapped, the
1043             inverse exists. There is no single inverse for the whole-sphere case,
1044             so the inverse transform superimposes everything on a single
1045             hemisphere. If you want an invertible 3-D transform, you want
1046             L.
1047              
1048             OPTIONS
1049              
1050             =over 3
1051              
1052             =item STANDARD POSITIONAL OPTIONS
1053              
1054             =item m, mask, Mask, h, hemisphere, Hemisphere [default 'near']
1055              
1056             The hemisphere to keep in the projection (see L).
1057              
1058             =back
1059              
1060             NOTES
1061              
1062             Alone of the various projections, this one does not use
1063             L to handle the standard options, because
1064             the cartesian coordinates of the rotated sphere are already correctly
1065             projected -- t_rot_sphere would put them back into (theta', phi')
1066             coordinates.
1067              
1068             =cut
1069              
1070             sub t_orthographic {
1071 0     0 1 0 my($me) = _new(@_,'Orthographic Projection');
1072            
1073 0         0 $me->{otype} = ['projected X','projected Y'];
1074 0         0 $me->{ounit} = ['body radii','body radii'];
1075              
1076             my $m= _opt($me->{options},
1077 0         0 ['m','mask','Mask','h','hemi','hemisphere','Hemisphere'],
1078             1);
1079 0 0       0 if($m=~m/^b/i) {
    0          
    0          
1080 0         0 $me->{params}->{m} = 0;
1081             } elsif($m=~m/^n/i) {
1082 0         0 $me->{params}->{m} = 1;
1083             } elsif($m=~m/^f/i) {
1084 0         0 $me->{params}->{m} = 2;
1085             } else {
1086 0         0 $me->{params}->{m} = $m;
1087             }
1088              
1089 0         0 my $origin= $me->{params}->{o} * $RAD2DEG;
1090 0         0 my $roll = $me->{params}->{roll} * $RAD2DEG;
1091              
1092             $me->{params}->{t_int} =
1093             t_compose(
1094             t_linear(rot=>[90 - $origin->at(1),
1095             0,
1096             90 + $origin->at(0)],
1097             d=>3),
1098             t_unit_sphere(u=>$me->{params}->{u})
1099 0         0 );
1100            
1101             $me->{params}->{t_int} =
1102             t_compose(
1103             t_linear(rot=>[0,0,$roll->at(0)],d=>3),
1104             $me->{params}->{t_int}
1105             )
1106 0 0       0 if($roll->at(0));
1107              
1108 0         0 $me->{name} = "orthographic";
1109              
1110 0         0 $me->{idim} = 2;
1111 0         0 $me->{odim} = 2;
1112              
1113             $me->{func} = sub {
1114 0     0   0 my ($d,$o) = @_ ;
1115 0         0 my ($out) = $o->{t_int}->apply($d);
1116 0 0       0 if($o->{m}) {
1117 0         0 my $idx;
1118             $idx = whichND($out->slice("(2)") < 0)
1119 0 0       0 if($o->{m} == 1);
1120             $idx = whichND($out->slice("(2)") > 0)
1121 0 0       0 if($o->{m} == 2);
1122 0 0 0     0 if(defined $idx && ref $idx eq 'PDL' && $idx->nelem){
      0        
1123 0         0 $out->slice("(0)")->range($idx) .= $o->{bad};
1124 0         0 $out->slice("(1)")->range($idx) .= $o->{bad};
1125             }
1126             }
1127              
1128 0         0 my($d0) = $out->dim(0);
1129              
1130             # Remove the Z direction
1131 0 0       0 ($d0 > 3) ? $out->slice(pdl(0,1,3..$d0-1)) : $out->slice("0:1");
1132              
1133 0         0 };
1134              
1135             # This is slow to run, quick to code -- could be made better by
1136             # having its own 2-d inverse instead of calling the internal one.
1137             $me->{inv} = sub {
1138 0     0   0 my($d,$o) = @_;
1139 0         0 my($d1) = $d->slice("0:1");
1140 0         0 my(@dims) = $d->dims;
1141 0         0 $dims[0]++;
1142 0         0 my($out) = zeroes(@dims);
1143 0         0 $out->slice("0:1") .= $d1;
1144 0 0       0 $out->slice("3:-1") .= $d->slice("2:-1")
1145             if($dims[0] > 3);
1146              
1147 0         0 $out->slice("(2)") .= sqrt(1 - ($d1*$d1)->sumover);
1148 0 0       0 $out->slice("(2)") *= -1 if($o->{m} == 2);
1149              
1150 0         0 $o->{t_int}->invert($out);
1151 0         0 };
1152              
1153 0         0 $me;
1154             }
1155              
1156             ######################################################################
1157              
1158             =head2 t_carree
1159              
1160             =for usage
1161              
1162             $t = t_carree();
1163              
1164             =for ref
1165              
1166             (Cartography) Plate Carree projection (cylindrical; equidistant)
1167              
1168             This is the simple Plate Carree projection -- also called a "lat/lon plot".
1169             The horizontal axis is theta; the vertical axis is phi. This is a no-op
1170             if the angular unit is radians; it is a simple scale otherwise.
1171              
1172             OPTIONS
1173              
1174             =over 3
1175              
1176             =item STANDARD POSITIONAL OPTIONS
1177              
1178             =item s, std, standard, Standard (default 0)
1179              
1180             The standard parallel where the transformation is conformal. Conformality
1181             is achieved by shrinking of the horizontal scale to match the
1182             vertical scale (which is correct everywhere).
1183              
1184             =back
1185              
1186             =cut
1187              
1188             @PDL::Transform::Cartography::Carree::ISA = ('PDL::Transform::Cartography');
1189              
1190             *t_caree = *t_carree; # compat alias for poor spellers
1191             sub t_carree {
1192 0     0 1 0 my($me) = _new(@_,'Plate Carree Projection');
1193 0         0 my $p = $me->{params};
1194              
1195 0         0 $me->{otype} = ['projected longitude','latitude'];
1196 0         0 $me->{ounit} = ['proj. body radii','body radii'];
1197              
1198 0         0 $p->{stretch} = cos($p->{std});
1199              
1200             $me->{func} = sub {
1201 0     0   0 my($d,$o) = @_;
1202 0 0       0 my($out) = $d->is_inplace ? $d : $d->copy;
1203 0         0 $out->slice("0:1") *= $o->{conv};
1204 0         0 $out->slice("0") *= $p->{stretch};
1205 0         0 $out;
1206 0         0 };
1207            
1208             $me->{inv} = sub {
1209 0     0   0 my($d,$o)= @_;
1210 0 0       0 my($out) = $d->is_inplace ? $d : $d->copy;
1211 0         0 $out->slice("0:1") /= $o->{conv};
1212 0         0 $out->slice("0") /= $p->{stretch};
1213 0         0 $out;
1214 0         0 };
1215            
1216 0         0 $me->_finish;
1217             }
1218              
1219             ######################################################################
1220              
1221             =head2 t_mercator
1222              
1223             =for usage
1224              
1225             $t = t_mercator();
1226              
1227             =for ref
1228              
1229             (Cartography) Mercator projection (cylindrical; conformal)
1230              
1231             This is perhaps the most famous of all map projections: meridians are mapped
1232             to parallel vertical lines and parallels are unevenly spaced horizontal lines.
1233             The poles are shifted to +/- infinity. The output values are in units of
1234             globe-radii for easy conversion to kilometers; hence the horizontal extent
1235             is -pi to pi.
1236              
1237             You can get oblique Mercator projections by specifying the C or
1238             C options; this is implemented via L.
1239              
1240             OPTIONS
1241              
1242             =over 3
1243              
1244             =item STANDARD POSITIONAL OPTIONS
1245              
1246             =item c, clip, Clip (default 75 [degrees])
1247              
1248             The north/south clipping boundary of the transformation. Because the poles are
1249             displaced to infinity, many applications require a clipping boundary. The
1250             value is in whatever angular unit you set with the standard 'units' option.
1251             The default roughly matches interesting landforms on Earth.
1252             For no clipping at all, set b=>0. For asymmetric clipping, use a 2-element
1253             list ref or ndarray.
1254              
1255             =item s, std, Standard (default 0)
1256              
1257             This is the parallel at which the map has correct scale. The scale
1258             is also correct at the parallel of opposite sign.
1259              
1260             =back
1261              
1262             =cut
1263              
1264              
1265             @PDL::Transform::Cartography::Mercator::ISA = ('PDL::Transform::Cartography');
1266              
1267             sub t_mercator {
1268 0     0 1 0 my($me) = _new(@_,'Mercator Projection');
1269 0         0 my $p = $me->{params};
1270              
1271             # This is a lot of shenanigans just to get the clip parallels, but what the
1272             # heck -- it's not a hot spot and it saves copying the input data (for
1273             # nondestructive clipping).
1274             $p->{c} = _opt($me->{options},
1275 0         0 ['c','clip','Clip'],
1276             undef);
1277 0 0       0 if(defined($p->{c})) {
1278 0         0 $p->{c} = topdl($p->{c});
1279 0         0 $p->{c} *= $p->{conv};
1280             } else {
1281 0         0 $p->{c} = pdl($DEG2RAD * 75);
1282             }
1283 0 0       0 $p->{c} = abs($p->{c}) * pdl(-1,1) if($p->{c}->nelem == 1);
1284              
1285 0         0 $p->{c} = log(tan(($p->{c}/2) + $PI/4));
1286 0         0 $p->{c} = [$p->{c}->list];
1287              
1288             $p->{std} = topdl(_opt($me->{options},
1289             ['s','std','standard','Standard'],
1290 0         0 0))->at(0) * $p->{conv};
1291              
1292 0 0       0 if($p->{std} == 0) {
1293 0         0 $me->{otype} = ['longitude','tan latitude'];
1294 0 0       0 $me->{ounit} = ['radians',' '] unless(defined $me->{ounit});
1295             } else {
1296 0         0 $me->{otype} = ['proj. longitude','proj. tan latitude'];
1297 0 0       0 $me->{ounit} = ['radians',' '] unless(defined $me->{ounit});
1298             }
1299              
1300 0         0 $p->{stretch} = cos($p->{std});
1301              
1302             $me->{func} = sub {
1303 0     0   0 my($d,$o) = @_;
1304              
1305 0 0       0 my($out) = $d->is_inplace ? $d : $d->copy;
1306              
1307 0         0 $out->slice("0:1") *= $o->{conv};
1308              
1309 0         0 $out->slice("(1)") .= log(tan($out->slice("(1)")/2 + $PI/4));
1310 0         0 $out->slice("(1)") .= $out->slice("(1)")->clip(@{$o->{c}})
1311 0 0       0 unless($o->{c}->[0] == $o->{c}->[1]);
1312              
1313 0         0 $out->slice("0:1") *= $o->{stretch};
1314 0 0       0 $out->slice("0:1") /= $o->{oconv} if(defined $o->{oconv});
1315            
1316 0         0 $out;
1317 0         0 };
1318              
1319             $me->{inv} = sub {
1320 0     0   0 my($d,$o) = @_;
1321 0 0       0 my($out) = $d->is_inplace? $d : $d->copy;
1322              
1323 0 0       0 $out->slice("0:1") *= $o->{oconv} if defined($o->{oconv});
1324 0         0 $out->slice("0:1") /= $o->{stretch};
1325 0         0 $out->slice("(1)") .= (atan(exp($out->slice("(1)"))) - $PI/4)*2;
1326 0         0 $out->slice("0:1") /= $o->{conv};
1327              
1328 0         0 $out;
1329 0         0 };
1330              
1331 0         0 $me->_finish;
1332             }
1333              
1334             ######################################################################
1335              
1336             =head2 t_utm
1337              
1338             =for usage
1339              
1340             $t = t_utm(,);
1341              
1342             =for ref
1343              
1344             (Cartography) Universal Transverse Mercator projection (cylindrical)
1345              
1346             This is the internationally used UTM projection, with 2 subzones
1347             (North/South). The UTM zones are parametrized individually, so if you
1348             want a Zone 30 map you should use C. By default you get
1349             the northern subzone, so that locations in the southern hemisphere get
1350             negative Y coordinates. If you select the southern subzone (with the
1351             "subzone=>-1" option), you get offset southern UTM coordinates.
1352              
1353             The 20-subzone military system is not yet supported. If/when it is
1354             implemented, you will be able to enter "subzone=>[a-t]" to select a N/S
1355             subzone.
1356              
1357             Note that UTM is really a family of transverse Mercator projections
1358             with different central meridia. Each zone properly extends for six
1359             degrees of longitude on either side of its appropriate central meridian,
1360             with Zone 1 being centered at -177 degrees longitude (177 west).
1361             Properly speaking, the zones only extend from 80 degrees south to 84 degrees
1362             north; but this implementation lets you go all the way to 90 degrees.
1363             The default UTM coordinates are meters. The origin for each zone is
1364             on the equator, at an easting of -500,000 meters.
1365              
1366             The default output units are meters, assuming that you are wanting a
1367             map of the Earth. This will break for bodies other than Earth (which
1368             have different radii and hence different conversions between lat/lon
1369             angle and meters).
1370              
1371             The standard UTM projection has a slight reduction in scale at the
1372             prime meridian of each zone: the transverse Mercator projection's
1373             standard "parallels" are 180km e/w of the central meridian. However,
1374             many Europeans prefer the "Gauss-Kruger" system, which is virtually
1375             identical to UTM but with a normal tangent Mercator (standard parallel
1376             on the prime meridian). To get this behavior, set "gk=>1".
1377              
1378             Like the rest of the PDL::Transform::Cartography package, t_utm uses a
1379             spherical datum rather than the "official" ellipsoidal datums for the
1380             UTM system.
1381              
1382             This implementation was derived from the rather nice description by
1383             Denis J. Dean, located on the web at:
1384             http://www.cnr.colostate.edu/class_info/nr502/lg3/datums_coordinates/utm.html
1385              
1386             OPTIONS
1387              
1388             =over 3
1389              
1390             =item STANDARD OPTIONS
1391              
1392             (No positional options -- Origin and Roll are ignored)
1393              
1394             =item ou, ounit, OutputUnit (default 'meters')
1395              
1396             (This is likely to become a standard option in a future release) The
1397             unit of the output map. By default, this is 'meters' for UTM, but you
1398             may specify 'deg' or 'km' or even (heaven help us) 'miles' if you
1399             prefer.
1400              
1401             =item sz, subzone, SubZone (default 1)
1402              
1403             Set this to -1 for the southern hemisphere subzone. Ultimately you
1404             should be able to set it to a letter to get the corresponding military
1405             subzone, but that's too much effort for now.
1406              
1407             =item gk, gausskruger (default 0)
1408              
1409             Set this to 1 to get the (European-style) tangent-plane Mercator with
1410             standard parallel on the prime meridian. The default of 0 places the
1411             standard parallels 180km east/west of the prime meridian, yielding better
1412             average scale across the zone. Setting gk=>1 makes the scale exactly 1.0
1413             at the central meridian, and >1.0 everywhere else on the projection.
1414             The difference in scale is about 0.3%.
1415              
1416             =back
1417              
1418             =cut
1419              
1420             sub t_utm {
1421 0     0 1 0 my $zone = (int(shift)-1) % 60 + 1;
1422 0         0 my($x) = _new(@_,"UTM-$zone");
1423 0         0 my $opt = $x->{options};
1424              
1425             ## Make sure that there is a conversion (default is 'meters')
1426 0 0       0 $x->{ounit} = ['meter','meter'] unless defined($x->{ounit});
1427 0 0       0 $x->{ounit} = [$x->{ounit},$x->{ounit}] unless ref($x->{ounit});
1428 0         0 $x->{params}->{oconv} = _uconv($x->{ounit}->[0]);
1429              
1430             ## Define our zone and NS offset
1431 0         0 my $subzone = _opt($opt,['sz', 'subzone', 'SubZone'],1);
1432 0         0 my $offset = zeroes(2);
1433 0         0 $offset->slice("0") .= 5e5*(2*$PI/40e6)/$x->{params}->{oconv};
1434 0 0       0 $offset->slice("1") .= ($subzone < 0) ? $PI/2/$x->{params}->{oconv} : 0;
1435              
1436 0         0 my $merid = ($zone * 6) - 183;
1437              
1438 0         0 my $gk = _opt($opt,['gk','gausskruger'],0);
1439            
1440             my($me) = t_compose(t_linear(post=>$offset,
1441             rot=>-90
1442             ),
1443              
1444             t_mercator(o=>[$merid,0],
1445             r=>90,
1446             ou=>$x->{ounit},
1447 0 0       0 s=>$gk ? 0 : ($RAD2DEG * (180/6371))
1448             )
1449             );
1450              
1451              
1452 0 0       0 my $s = ($zone < 0) ? "S Hemisphere " : "";
1453 0         0 $me->{otype} = ["UTM-$zone Easting","${s}Northing"];
1454 0         0 $me->{ounit} = $x->{ounit};
1455              
1456 0         0 return $me;
1457             }
1458              
1459             ######################################################################
1460              
1461             =head2 t_sin_lat
1462              
1463             =for usage
1464              
1465             $t = t_sin_lat();
1466              
1467             =for ref
1468              
1469             (Cartography) Cyl. equal-area projection (cyl.; authalic)
1470              
1471             This projection is commonly used in solar Carrington plots; but not much
1472             for terrestrial mapping.
1473              
1474             OPTIONS
1475              
1476             =over 3
1477              
1478             =item STANDARD POSITIONAL OPTIONS
1479              
1480             =item s,std, Standard (default 0)
1481              
1482             This is the parallel at which the map is conformal. It is also conformal
1483             at the parallel of opposite sign. The conformality is achieved by matched
1484             vertical stretching and horizontal squishing (to achieve constant area).
1485              
1486             =back
1487              
1488             =cut
1489              
1490             @PDL::Transform::Cartography::SinLat::ISA = ('PDL::Transform::Cartography');
1491             sub t_sin_lat {
1492 0     0 1 0 my($me) = _new(@_,"Sine-Latitude Projection");
1493              
1494             $me->{params}->{std} = topdl(_opt($me->{options},
1495             ['s','std','standard','Standard'],
1496 0         0 0))->at(0) * $me->{params}->{conv};
1497              
1498 0 0       0 if($me->{params}->{std} == 0) {
1499 0         0 $me->{otype} = ['longitude','sin latitude'];
1500 0         0 $me->{ounit} = ['radians',' ']; # nonzero but blank!
1501             } else {
1502 0         0 $me->{otype} = ['proj. longitude','proj. sin latitude'];
1503 0         0 $me->{ounit} = ['radians',' '];
1504             }
1505              
1506 0         0 $me->{params}->{stretch} = sqrt(cos($me->{params}->{std}));
1507              
1508             $me->{func} = sub {
1509 0     0   0 my($d,$o) = @_;
1510 0 0       0 my($out) = $d->is_inplace ? $d : $d->copy;
1511              
1512 0         0 $out->slice("0:1") *= $me->{params}->{conv};
1513 0         0 $out->slice("(1)") .= sin($out->slice("(1)")) / $o->{stretch};
1514 0         0 $out->slice("(0)") *= $o->{stretch};
1515 0         0 $out;
1516 0         0 };
1517              
1518             $me->{inv} = sub {
1519 0     0   0 my($d,$o) = @_;
1520 0 0       0 my($out) = $d->is_inplace ? $d : $d->copy;
1521 0         0 $out->slice("(1)") .= asin($out->slice("(1)") * $o->{stretch});
1522 0         0 $out->slice("(0)") /= $o->{stretch};
1523 0         0 $out->slice("0:1") /= $me->{params}->{conv};
1524 0         0 $out;
1525 0         0 };
1526              
1527 0         0 $me->_finish;
1528             }
1529              
1530             ######################################################################
1531              
1532             =head2 t_sinusoidal
1533              
1534             =for usage
1535              
1536             $t = t_sinusoidal();
1537              
1538             =for ref
1539              
1540             (Cartography) Sinusoidal projection (authalic)
1541              
1542             Sinusoidal projection preserves the latitude scale but scales
1543             longitude according to sin(lat); in this respect it is the companion to
1544             L, which is also authalic but preserves the
1545             longitude scale instead.
1546              
1547             OPTIONS
1548              
1549             =over 3
1550              
1551             =item STANDARD POSITIONAL OPTIONS
1552              
1553             =back
1554              
1555             =cut
1556              
1557             sub t_sinusoidal {
1558 0     0 1 0 my($me) = _new(@_,"Sinusoidal Projection");
1559 0         0 $me->{otype} = ['longitude','latitude'];
1560 0         0 $me->{ounit} = [' ','radians'];
1561            
1562             $me->{func} = sub {
1563 0     0   0 my($d,$o) = @_;
1564 0 0       0 my($out) = $d->is_inplace ? $d : $d->copy;
1565 0         0 $out->slice("0:1") *= $o->{conv};
1566              
1567 0         0 $out->slice("(0)") *= cos($out->slice("(1)"));
1568 0         0 $out;
1569 0         0 };
1570              
1571             $me->{inv} = sub {
1572 0     0   0 my($d,$o) = @_;
1573 0 0       0 my($out) = $d->is_inplace ? $d : $d->copy;
1574 0         0 my($x) = $out->slice("(0)");
1575 0         0 my($y) = $out->slice("(1)");
1576            
1577 0         0 $x /= cos($out->slice("(1)"));
1578              
1579 0         0 my($rej) = ( (abs($x)>$PI) | (abs($y)>($PI/2)) )->flat;
1580 0         0 $x->flat->slice($rej) .= $o->{bad};
1581 0         0 $y->flat->slice($rej) .= $o->{bad};
1582            
1583 0         0 $out->slice("0:1") /= $o->{conv};
1584 0         0 $out;
1585 0         0 };
1586              
1587 0         0 $me->_finish;
1588             }
1589            
1590              
1591              
1592              
1593              
1594             ######################################################################
1595             #
1596             # Conic projections are subclassed for easier stringification and
1597             # parsing of the standard parallels. The constructor gets copied
1598             # into the current package for ease of hackage.
1599             #
1600             # This is a little kludgy -- it's intended for direct calling
1601             # rather than method calling, and it puts its own class name on the
1602             # front of the argument list. But, hey, it works...
1603             #
1604             @PDL::Transform::Cartography::Conic::ISA = ('PDL::Transform::Cartography');
1605             sub _c_new {
1606 0     0   0 my($def_std) = pop;
1607 0         0 my $me = PDL::Transform::Cartography::Conic->new(@_);
1608              
1609 0         0 my($p) = $me->{params};
1610 0         0 $p->{std} = _opt($me->{options},['s','std','standard','Standard'],
1611             $def_std);
1612 0         0 $p->{std} = topdl($p->{std}) * $me->{params}->{conv};
1613             $p->{std} = topdl([$PI/2 * ($p->{std}<0 ? -1 : 1), $p->{std}->at(0)])
1614 0 0       0 if($p->{std}->nelem == 1);
    0          
1615            
1616             $me->{params}->{cylindrical} = 1
1617 0 0       0 if(approx($p->{std}->slice("0"),-$p->{std}->slice("1")));
1618              
1619 0         0 $me;
1620             }
1621              
1622             sub PDL::Transform::Cartography::Conic::stringify {
1623 0     0   0 my($me) = shift;
1624 0         0 my($out) = $me->SUPER::stringify;
1625              
1626             $out .= sprintf("\tStd parallels: %6.2f,%6.2f %s\n",
1627             $me->{params}->{std}->at(0) / $me->{params}->{conv},
1628             $me->{params}->{std}->at(1) / $me->{params}->{conv},
1629 0         0 $me->{params}->{u});
1630 0         0 $out;
1631             }
1632              
1633             ######################################################################
1634              
1635             =head2 t_conic
1636              
1637             =for usage
1638              
1639             $t = t_conic()
1640              
1641             =for ref
1642              
1643             (Cartography) Simple conic projection (conic; equidistant)
1644              
1645             This is the simplest conic projection, with parallels mapped to
1646             equidistant concentric circles. It is neither authalic nor conformal.
1647             This transformation is also referred to as the "Modified Transverse
1648             Mercator" projection in several maps of Alaska published by the USGS;
1649             and the American State of New Mexico re-invented the projection in
1650             1936 for an official map of that State.
1651              
1652             OPTIONS
1653              
1654             =over 3
1655              
1656             =item STANDARD POSITIONAL OPTIONS
1657              
1658             =item s, std, Standard (default 29.5, 45.5)
1659              
1660             The locations of the standard parallel(s) (where the cone intersects
1661             the surface of the sphere). If you specify only one then the other is
1662             taken to be the nearest pole. If you specify both of them to be one
1663             pole then you get an equidistant azimuthal map. If you specify both
1664             of them to be opposite and equidistant from the equator you get a
1665             Plate Carree projection.
1666              
1667             =back
1668              
1669             =cut
1670              
1671             sub t_conic {
1672 0     0 1 0 my($me) = _c_new(@_,"Simple Conic Projection",[29.5,45.5]);
1673              
1674 0         0 my($p) = $me->{params};
1675              
1676 0 0       0 if($p->{cylindrical}) {
1677 0 0       0 print STDERR "Simple conic: degenerate case; using Plate Carree\n"
1678             if($PDL::verbose);
1679 0         0 return t_carree($me->{options});
1680             }
1681              
1682             $p->{n} = ((cos($p->{std}->slice("(0)")) - cos($p->{std}->slice("(1)")))
1683             /
1684 0         0 ($p->{std}->slice("(1)") - $p->{std}->slice("(0)")));
1685              
1686 0         0 $p->{G} = cos($p->{std}->slice("(0)"))/$p->{n} + $p->{std}->slice("(0)");
1687              
1688 0         0 $me->{otype} = ['Conic X','Conic Y'];
1689 0         0 $me->{ounit} = ['Proj. radians','Proj. radians'];
1690              
1691             $me->{func} = sub {
1692 0     0   0 my($d,$o) = @_;
1693 0 0       0 my($out) = $d->is_inplace ? $d : $d->copy;
1694              
1695 0         0 my($rho) = $o->{G} - $d->slice("(1)") * $o->{conv};
1696 0         0 my($theta) = $o->{n} * $d->slice("(0)") * $o->{conv};
1697            
1698 0         0 $out->slice("(0)") .= $rho * sin($theta);
1699 0         0 $out->slice("(1)") .= $o->{G} - $rho * cos($theta);
1700              
1701 0         0 $out;
1702 0         0 };
1703              
1704             $me->{inv} = sub {
1705 0     0   0 my($d,$o) = @_;
1706 0 0       0 my($out) = $d->is_inplace ? $d : $d->copy;
1707              
1708 0         0 my($x) = $d->slice("(0)");
1709 0         0 my($y) = $o->{G} - $d->slice("(1)");
1710 0         0 my($rho) = sqrt($x*$x + $y*$y);
1711 0 0       0 $rho *= -1 if($o->{n}<0);
1712              
1713 0 0       0 my($theta) = ($o->{n} < 0) ? atan2(-$x,-$y) : atan2($x,$y);
1714            
1715 0         0 $out->slice("(1)") .= $o->{G} - $rho;
1716             $out->slice("(1)")->where(($out->slice("(1)") < -$PI/2) | ($out->slice("(1)") > $PI/2))
1717 0         0 .= $o->{bad};
1718              
1719 0         0 $out->slice("(0)") .= $theta / $o->{n};
1720             $out->slice("(0)")->where(($out->slice("(0)") < -$PI) | ($out->slice("(0)") > $PI/2))
1721 0         0 .= $o->{bad};
1722              
1723 0         0 $out->slice("0:1") /= $o->{conv};
1724              
1725 0         0 $out;
1726 0         0 };
1727              
1728 0         0 $me->_finish;
1729             }
1730              
1731              
1732              
1733              
1734             ######################################################################
1735              
1736             =head2 t_albers
1737              
1738             =for usage
1739              
1740             $t = t_albers()
1741              
1742             =for ref
1743              
1744             (Cartography) Albers conic projection (conic; authalic)
1745              
1746             This is the standard projection used by the US Geological Survey for
1747             sectionals of the 50 contiguous United States of America.
1748              
1749             The projection reduces to the Lambert equal-area conic (infrequently
1750             used and not to be confused with the Lambert conformal conic,
1751             L!) if the pole is used as one of the two
1752             standard parallels.
1753              
1754             Notionally, this is a conic projection onto a cone that intersects the
1755             sphere at the two standard parallels; it works best when the two parallels
1756             straddle the region of interest.
1757              
1758             OPTIONS
1759              
1760             =over 3
1761              
1762             =item STANDARD POSITIONAL OPTIONS
1763              
1764             =item s, std, standard, Standard (default (29.5,45.5))
1765              
1766             The locations of the standard parallel(s). If you specify only one then
1767             the other is taken to be the nearest pole and a Lambert Equal-Area Conic
1768             map results. If you specify both standard parallels to be the same pole,
1769             then the projection reduces to the Lambert Azimuthal Equal-Area map as
1770             aq special case. (Note that L is Lambert's
1771             Conformal Conic, the most commonly used of Lambert's projections.)
1772              
1773             The default values for the standard parallels are those chosen by Adams
1774             for maps of the lower 48 US states: (29.5,45.5). The USGS recommends
1775             (55,65) for maps of Alaska and (8,18) for maps of Hawaii -- these latter
1776             are chosen to also include the Canal Zone and Philippine Islands farther
1777             south, which is why both of those parallels are south of the Hawaiian islands.
1778              
1779             The transformation reduces to the cylindrical equal-area (sin-lat)
1780             transformation in the case where the standard parallels are opposite and
1781             equidistant from the equator, and in fact this is implemented by a call to
1782             t_sin_lat.
1783              
1784             =back
1785              
1786             =cut
1787              
1788             sub t_albers {
1789 0     0 1 0 my($me) = _c_new(@_,"Albers Equal-Area Conic Projection",[29.5,45.5]);
1790              
1791 0         0 my($p) = $me->{params};
1792              
1793 0 0       0 if($p->{cylindrical}) {
1794 0 0       0 print STDERR "Albers equal-area conic: degenerate case; using equal-area cylindrical\n"
1795             if($PDL::verbose);
1796 0         0 return t_sin_lat($me->{options});
1797             }
1798              
1799 0         0 $p->{n} = sin($p->{std})->sumover / 2;
1800             $p->{C} = (cos($p->{std}->slice("(1)"))*cos($p->{std}->slice("(1)")) +
1801 0         0 2 * $p->{n} * sin($p->{std}->slice("(1)")) );
1802 0         0 $p->{rho0} = sqrt($p->{C}) / $p->{n};
1803              
1804 0         0 $me->{otype} = ['Conic X','Conic Y'];
1805 0         0 $me->{ounit} = ['Proj. radians','Proj. radians'];
1806              
1807             $me->{func} = sub {
1808 0     0   0 my($d,$o) = @_;
1809 0 0       0 my($out) = $d->is_inplace ? $d : $d->copy;
1810              
1811 0         0 my($rho) = sqrt( $o->{C} - 2 * $o->{n} * sin($d->slice("(1)") * $o->{conv}) ) / $o->{n};
1812 0         0 my($theta) = $o->{n} * $d->slice("(0)") * $o->{conv};
1813              
1814 0         0 $out->slice("(0)") .= $rho * sin($theta);
1815 0         0 $out->slice("(1)") .= $p->{rho0} - $rho * cos($theta);
1816 0         0 $out;
1817 0         0 };
1818              
1819             $me->{inv} = sub {
1820 0     0   0 my($d,$o) = @_;
1821              
1822 0 0       0 my($out) = $d->is_inplace ? $d : $d->copy;
1823              
1824 0         0 my($x) = $d->slice("(0)");
1825 0         0 my($y) = $o->{rho0} - $d->slice("(1)");
1826              
1827 0 0       0 my($theta) = ($o->{n} < 0) ? atan2 -$x,-$y : atan2 $x, $y;
1828 0         0 my($rho) = sqrt( $x*$x + $y*$y ) * $o->{n};
1829              
1830 0         0 $out->slice("(1)") .= asin( ( $o->{C} - ( $rho * $rho ) ) / (2 * $o->{n}) );
1831              
1832 0         0 $out->slice("(0)") .= $theta / $o->{n};
1833 0         0 $out->slice("(0)")->where(($out->slice("(0)")>$PI) | ($out->slice("(0)")<-$PI)) .= $o->{bad};
1834              
1835 0         0 $out->slice("0:1") /= $o->{conv};
1836              
1837 0         0 $out;
1838 0         0 };
1839              
1840 0         0 $me->_finish;
1841             }
1842              
1843             ######################################################################
1844              
1845             =head2 t_lambert
1846              
1847             =for usage
1848              
1849             $t = t_lambert();
1850              
1851             =for ref
1852              
1853             (Cartography) Lambert conic projection (conic; conformal)
1854              
1855             Lambert conformal conic projection is widely used in aeronautical
1856             charts and state base maps published by the USA's FAA and USGS. It's
1857             especially useful for mid-latitude charts. In particular, straight lines
1858             approximate (but are not exactly) great circle routes of up to ~2 radians.
1859              
1860             The default standard parallels are 33 and 45 to match the USGS state
1861             1:500,000 base maps of the United States. At scales of 1:500,000 and
1862             larger, discrepancies between the spherical and ellipsoidal projections
1863             become important; use care with this projection on spheres.
1864              
1865             OPTIONS
1866              
1867             =over 3
1868              
1869             =item STANDARD POSITIONAL OPTIONS
1870              
1871             =item s, std, standard, Standard (default (33,45))
1872              
1873             The locations of the standard parallel(s) for the conic projection.
1874             The transform reduces to the Mercator projection in the case where the
1875             standard parallels are opposite and equidistant from the equator, and
1876             in fact this is implemented by a call to t_mercator.
1877              
1878             =item c, clip, Clip (default [-75,75])
1879              
1880             Because the transform is conformal, the distant pole is displaced to
1881             infinity. Many applications require a clipping boundary. The value
1882             is in whatever angular unit you set with the standard 'unit' option.
1883             For consistency with L, clipping works the same
1884             way even though in most cases only one pole needs it. Set this to 0
1885             for no clipping at all.
1886              
1887             =back
1888              
1889             =cut
1890              
1891             sub t_lambert {
1892 0     0 1 0 my($me)= _c_new(@_,"Lambert Conformal Conic Projection",[33,45]);
1893 0         0 my($p) = $me->{params};
1894              
1895 0 0       0 if($p->{cylindrical}){
1896 0 0       0 print STDERR "Lambert conformal conic: std parallels are opposite & equal; using Mercator\n"
1897             if($PDL::verbose);
1898 0         0 return t_mercator($me->{options});
1899             }
1900            
1901             # Find clipping parallels
1902 0         0 $p->{c} = _opt($me->{options},['c','clip','Clip'],undef);
1903 0 0       0 if(defined($p->{c})) {
1904 0         0 $p->{c} = topdl($p->{c});
1905             } else {
1906 0         0 $p->{c} = topdl([-75,75]);
1907             }
1908 0 0       0 $p->{c} = abs($p->{c}) * topdl([-1,1]) if($p->{c}->nelem == 1);
1909 0         0 $p->{c} = [$p->{c}->list];
1910              
1911             # Prefrobnicate
1912 0 0       0 if(approx($p->{std}->slice("(0)"),$p->{std}->slice("(1)"))) {
1913 0         0 $p->{n} = sin($p->{std}->slice("(0)"));
1914             } else {
1915             $p->{n} = (log(cos($p->{std}->slice("(0)"))/cos($p->{std}->slice("(1)")))
1916             /
1917             log( tan( $PI/4 + $p->{std}->slice("(1)")/2 )
1918             /
1919 0         0 tan( $PI/4 + $p->{std}->slice("(0)")/2 )
1920             )
1921             );
1922             }
1923              
1924             $p->{F} = ( cos($p->{std}->slice("(0)"))
1925             *
1926             ( tan( $PI/4 + $p->{std}->slice("(0)")/2 ) ** $p->{n} ) / $p->{n}
1927 0         0 );
1928              
1929 0         0 $p->{rho0} = $p->{F};
1930              
1931 0         0 $me->{otype} = ['Conic X','Conic Y'];
1932 0         0 $me->{ounit} = ['Proj. radians','Proj. radians'];
1933              
1934             $me->{func} = sub {
1935 0     0   0 my($d,$o) = @_;
1936 0 0       0 my($out) = $d->is_inplace ? $d : $d->copy;
1937              
1938             my($cl) = ( ($o->{c}->[0] == $o->{c}->[1]) ?
1939             $d->slice("(1)")*$o->{conv} :
1940 0         0 ($d->slice("(1)")->clip(@{$o->{c}}) * $o->{conv})
1941 0 0       0 );
1942              
1943 0         0 my($rho) = $o->{F} / ( tan($PI/4 + ($cl)/2 ) ** $o->{n} );
1944 0         0 my($theta) = $o->{n} * $d->slice("(0)") * $o->{conv};
1945              
1946 0         0 $out->slice("(0)") .= $rho * sin($theta);
1947 0         0 $out->slice("(1)") .= $o->{rho0} - $rho * cos($theta);
1948 0         0 $out;
1949 0         0 };
1950              
1951             $me->{inv} = sub {
1952 0     0   0 my($d,$o) = @_;
1953 0 0       0 my($out) = $d->is_inplace ? $d : $d->copy;
1954            
1955 0         0 my($x) = $d->slice("(0)");
1956 0         0 my($y) = $o->{rho0} - $d->slice("(1)");
1957              
1958 0         0 my($rho) = sqrt($x * $x + $y * $y);
1959 0 0       0 $rho *= -1 if($o->{n} < 0);
1960 0 0       0 my($theta) = ($o->{n} < 0) ? atan2(-$x,-$y):(atan2 $x,$y);
1961              
1962              
1963 0         0 $out->slice("(0)") .= $theta / $o->{n};
1964 0         0 $out->slice("(0)")->where(($out->slice("(0)") > $PI) | ($out->slice("(0)") < -$PI)) .= $o->{bad};
1965              
1966              
1967 0         0 $out->slice("(1)") .= 2 * atan(($o->{F}/$rho)**(1.0/$o->{n})) - $PI/2;
1968 0         0 $out->slice("(1)")->where(($out->slice("(1)") > $PI/2) | ($out->slice("(1)") < -$PI/2)) .= $o->{bad};
1969              
1970 0         0 $out->slice("0:1") /= $o->{conv};
1971              
1972 0         0 $out;
1973 0         0 };
1974              
1975              
1976 0         0 $me->_finish;
1977             }
1978              
1979             ######################################################################
1980              
1981             =head2 t_stereographic
1982              
1983             =for usage
1984              
1985             $t = t_stereographic();
1986              
1987             =for ref
1988              
1989             (Cartography) Stereographic projection (az.; conf.; persp.)
1990              
1991             The stereographic projection is a true perspective (planar) projection
1992             from a point on the spherical surface opposite the origin of the map.
1993              
1994             OPTIONS
1995              
1996             =over 3
1997              
1998             =item STANDARD POSITIONAL OPTIONS
1999              
2000             =item c, clip, Clip (default 120)
2001              
2002             This is the angular distance from the center to the edge of the
2003             projected map. The default 120 degrees gives you most of the opposite
2004             hemisphere but avoids the hugely distorted part near the antipodes.
2005              
2006             =back
2007              
2008             =cut
2009              
2010             sub t_stereographic {
2011 0     0 1 0 my($me) = _new(@_,"Stereographic Projection");
2012            
2013 0         0 $me->{params}->{k0} = 1.0;
2014             $me->{params}->{c} = _opt($me->{options},
2015             ['c','clip','Clip'],
2016 0         0 120) * $me->{params}->{conv};
2017              
2018 0         0 $me->{otype} = ['Stereo X','Stereo Y'];
2019 0         0 $me->{ounit} = ['Proj. body radii','Proj. radians'];
2020              
2021             $me->{func} = sub {
2022 0     0   0 my($d,$o) = @_;
2023 0 0       0 my($out) = $d->is_inplace ? $d : $d->copy;
2024              
2025             my($th,$ph) = ($out->slice("(0)") * $o->{conv},
2026 0         0 $out->slice("(1)") * $o->{conv});
2027              
2028 0         0 my($cph) = cos($ph); # gets re-used
2029 0         0 my($k) = 2 * $o->{k0} / (1 + cos($th) * $cph);
2030 0         0 $out->slice("(0)") .= $k * $cph * sin($th);
2031 0         0 $out->slice("(1)") .= $k * sin($ph);
2032              
2033 0         0 my($cl0) = 2*$o->{k0} / (1 + cos($o->{c}));
2034 0         0 $out->slice("(0)")->where($k>$cl0) .= $o->{bad};
2035 0         0 $out->slice("(1)")->where($k>$cl0) .= $o->{bad};
2036 0         0 $out;
2037 0         0 };
2038              
2039             $me->{inv} = sub {
2040 0     0   0 my($d,$o) = @_;
2041 0 0       0 my($out) = $d->is_inplace ? $d : $d->copy;
2042            
2043 0         0 my($x) = $d->slice("(0)");
2044 0         0 my($y) = $d->slice("(1)");
2045 0         0 my($rho) = sqrt($x*$x + $y*$y);
2046 0         0 my($c) = 2 * atan2($rho,2*$o->{k0});
2047            
2048 0         0 $out->slice("(0)") .= atan2($x * sin($c), $rho * cos($c));
2049 0         0 $out->slice("(1)") .= asin($y * sin($c) / $rho);
2050            
2051 0         0 $out ->slice("0:1") /= $o->{conv};
2052 0         0 $out;
2053 0         0 };
2054              
2055 0         0 $me->_finish;
2056             }
2057            
2058             ######################################################################
2059              
2060             =head2 t_gnomonic
2061              
2062             =for usage
2063              
2064             $t = t_gnomonic();
2065              
2066             =for ref
2067              
2068             (Cartography) Gnomonic (focal-plane) projection (az.; persp.)
2069              
2070             The gnomonic projection projects a hemisphere onto a tangent plane.
2071             It is useful in cartography for the property that straight lines are
2072             great circles; and it is useful in scientific imaging because
2073             it is the projection generated by a simple optical system with a flat
2074             focal plane.
2075              
2076             OPTIONS
2077              
2078             =over 3
2079              
2080             =item STANDARD POSITIONAL OPTIONS
2081              
2082             =item c, clip, Clip (default 75)
2083              
2084             This is the angular distance from the center to the edge of the
2085             projected map. The default 75 degrees gives you most of the
2086             hemisphere but avoids the hugely distorted part near the horizon.
2087              
2088             =back
2089              
2090             =cut
2091              
2092             sub t_gnomonic {
2093 0     0 1 0 my($me) = _new(@_,"Gnomonic Projection");
2094            
2095 0         0 $me->{params}->{k0} = 1.0; # Useful for standard parallel (TBD: add one)
2096              
2097             $me->{params}->{c} = topdl(_opt($me->{options},
2098             ['c','clip','Clip'],
2099 0         0 75) * $me->{params}->{conv});
2100              
2101 0         0 $me->{params}->{c} .= $me->{params}->{c}->clip(undef,(90-1e-6)*$me->{params}->{conv});
2102              
2103 0         0 $me->{otype} = ['Tangent-plane X','Tangent-plane Y'];
2104 0         0 $me->{ounit} = ['Proj. radians','Proj. radians'];
2105              
2106             $me->{func} = sub {
2107 0     0   0 my($d,$o) = @_;
2108 0 0       0 my($out) = $d->is_inplace ? $d : $d->copy;
2109              
2110             my($th,$ph) = ($out->slice("(0)") * $o->{conv},
2111 0         0 $out->slice("(1)") * $o->{conv});
2112              
2113 0         0 my($cph) = cos($ph); # gets re-used
2114              
2115 0         0 my($k) = $o->{k0} / (cos($th) * $cph);
2116 0         0 my($cl0) = $o->{k0} / (cos($o->{c}));
2117              
2118 0         0 $out->slice("(0)") .= $k * $cph * sin($th);
2119 0         0 $out->slice("(1)") .= $k * sin($ph);
2120              
2121 0         0 my $idx = whichND(($k > $cl0) | ($k < 0) | (!isfinite($k)));
2122 0 0       0 if($idx->nelem) {
2123 0         0 $out->slice("(0)")->range($idx) .= $o->{bad};
2124 0         0 $out->slice("(1)")->range($idx) .= $o->{bad};
2125             }
2126              
2127 0         0 $out;
2128 0         0 };
2129              
2130             $me->{inv} = sub {
2131 0     0   0 my($d,$o) = @_;
2132 0 0       0 my($out) = $d->is_inplace ? $d : $d->copy;
2133              
2134 0         0 my($x) = $d->slice("(0)");
2135 0         0 my($y) = $d->slice("(1)");
2136              
2137 0         0 my($rho) = sqrt($x*$x + $y*$y);
2138 0         0 my($c) = atan($rho/$o->{k0});
2139              
2140 0         0 $out->slice("(0)") .= atan2($x * sin($c), $rho * cos($c));
2141 0         0 $out->slice("(1)") .= asin($y * sin($c) / $rho);
2142              
2143 0         0 my $idx = whichND($rho==0);
2144              
2145 0 0       0 if($idx->nelem) {
2146 0         0 $out->slice("(0)")->range($idx) .= 0;
2147 0         0 $out->slice("(1)")->range($idx) .= 0;
2148             }
2149 0         0 $out->slice("0:1") /= $o->{conv};
2150 0         0 $out;
2151 0         0 };
2152              
2153 0         0 $me->_finish;
2154             }
2155              
2156             ######################################################################
2157              
2158             =head2 t_az_eqd
2159              
2160             =for usage
2161              
2162             $t = t_az_eqd();
2163              
2164             =for ref
2165              
2166             (Cartography) Azimuthal equidistant projection (az.; equi.)
2167              
2168             Basic azimuthal projection preserving length along radial lines from
2169             the origin (meridians, in the original polar aspect). Hence, both
2170             azimuth and distance are correct for journeys beginning at the origin.
2171              
2172             Applied to the celestial sphere, this is the projection made by
2173             fisheye lenses; it is also the projection into which C
2174             puts perspective views.
2175              
2176             The projected plane scale is normally taken to be planetary radii;
2177             this is useful for cartographers but not so useful for scientific
2178             observers. Setting the 't=>1' option causes the output scale to shift
2179             to camera angular coordinates (the angular unit is determined by the
2180             standard 'Units' option; default is degrees).
2181              
2182             OPTIONS
2183              
2184             =over 3
2185              
2186             =item STANDARD POSITIONAL OPTIONS
2187              
2188             =item c, clip, Clip (default 180 degrees)
2189              
2190             The largest angle relative to the origin. Default is the whole sphere.
2191              
2192             =back
2193              
2194             =cut
2195              
2196             sub t_az_eqd {
2197 0     0 1 0 my($me) = _new(@_,"Equidistant Azimuthal Projection");
2198              
2199             $me->{params}->{c} = topdl(_opt($me->{options},
2200             ['c','clip','Clip'],
2201 0         0 180) * $me->{params}->{conv});
2202              
2203 0         0 $me->{otype} = ['X distance','Y distance'];
2204 0         0 $me->{ounit} = ['radians','radians'];
2205              
2206             $me->{func} = sub {
2207 0     0   0 my($d,$o) = @_;
2208 0 0       0 my($out) = $d->is_inplace ? $d : $d->copy;
2209            
2210 0         0 my($ph) = $d->slice("(1)") * $o->{conv};
2211 0         0 my($th) = $d->slice("(0)") * $o->{conv};
2212              
2213 0         0 my $cos_c = cos($ph) * cos($th);
2214 0         0 my $c = acos($cos_c);
2215 0         0 my $k = $c / sin($c);
2216 0         0 $k->where($c==0) .= 1;
2217            
2218 0         0 my($x,$y) = ($out->slice("(0)"), $out->slice("(1)"));
2219              
2220 0         0 $x .= $k * cos($ph) * sin($th);
2221 0         0 $y .= $k * sin($ph);
2222              
2223 0         0 my $idx = whichND($c > $o->{c});
2224 0 0       0 if($idx->nelem) {
2225 0         0 $x->range($idx) .= $o->{bad};
2226 0         0 $y->range($idx) .= $o->{bad};
2227             }
2228              
2229 0         0 $out;
2230 0         0 };
2231              
2232             $me->{inv} = sub {
2233 0     0   0 my($d,$o) = @_;
2234 0 0       0 my($out) = $d->is_inplace ? $d : $d->copy;
2235 0         0 my($x) = $d->slice("(0)");
2236 0         0 my($y) = $d->slice("(1)");
2237              
2238 0         0 my $rho = $d->slice("0:1")->magnover;
2239             # Order is important -- ((0)) overwrites $x if is_inplace!
2240 0         0 $out->slice("(0)") .= atan2( $x * sin($rho), $rho * cos $rho );
2241 0         0 $out->slice("(1)") .= asin( $y * sin($rho) / $rho );
2242              
2243 0         0 my $idx = whichND($rho == 0);
2244 0 0       0 if($idx->nelem) {
2245 0         0 $out->slice("(0)")->range($idx) .= 0;
2246 0         0 $out->slice("(1)")->range($idx) .= 0;
2247             }
2248              
2249 0         0 $out->slice("0:1") /= $o->{conv};
2250              
2251 0         0 $out;
2252 0         0 };
2253              
2254 0         0 $me->_finish;
2255             }
2256              
2257              
2258             ######################################################################
2259              
2260             =head2 t_az_eqa
2261              
2262             =for usage
2263              
2264             $t = t_az_eqa();
2265              
2266             =for ref
2267              
2268             (Cartography) Azimuthal equal-area projection (az.; auth.)
2269              
2270             OPTIONS
2271              
2272             =over 3
2273              
2274             =item STANDARD POSITIONAL OPTIONS
2275              
2276             =item c, clip, Clip (default 180 degrees)
2277              
2278             The largest angle relative to the origin. Default is the whole sphere.
2279              
2280             =back
2281              
2282             =cut
2283              
2284             sub t_az_eqa {
2285 0     0 1 0 my($me) = _new(@_,"Equal-Area Azimuthal Projection");
2286            
2287             $me->{params}->{c} = topdl(_opt($me->{options},
2288             ['c','clip','Clip'],
2289 0         0 180) * $me->{params}->{conv});
2290              
2291 0         0 $me->{otype} = ['Azimuthal X','Azimuthal Y'];
2292 0         0 $me->{ounit} = ['Proj. radians','Proj. radians'];
2293              
2294             $me->{func} = sub {
2295 0     0   0 my($d,$o) = @_;
2296 0 0       0 my($out) = $d->is_inplace ? $d : $d->copy;
2297            
2298 0         0 my($ph) = $d->slice("(1)") * $o->{conv};
2299 0         0 my($th) = $d->slice("(0)") * $o->{conv};
2300            
2301 0         0 my($c) = acos(cos($ph) * cos($th));
2302 0         0 my($rho) = 2 * sin($c/2);
2303 0         0 my($k) = 1.0/cos($c/2);
2304              
2305 0         0 my($x,$y) = ($out->slice("(0)"),$out->slice("(1)"));
2306 0         0 $x .= $k * cos($ph) * sin($th);
2307 0         0 $y .= $k * sin($ph);
2308              
2309 0         0 my $idx = whichND($c > $o->{c});
2310 0 0       0 if($idx->nelem) {
2311 0         0 $x->range($idx) .= $o->{bad};
2312 0         0 $y->range($idx) .= $o->{bad};
2313             }
2314              
2315 0         0 $out;
2316 0         0 };
2317              
2318             $me->{inv} = sub {
2319 0     0   0 my($d,$o) = @_;
2320 0 0       0 my($out) = $d->is_inplace ? $d : $d->copy;
2321              
2322 0         0 my($x,$y) = ($d->slice("(0)"),$d->slice("(1)"));
2323 0         0 my($ph,$th) = ($out->slice("(0)"),$out->slice("(1)"));
2324 0         0 my($rho) = sqrt($x*$x + $y*$y);
2325 0         0 my($c) = 2 * asin($rho/2);
2326              
2327 0         0 $ph .= asin($d->slice("(1)") * sin($c) / $rho);
2328 0         0 $th .= atan2($x * sin($c),$rho * cos($c));
2329              
2330 0         0 $ph /= $o->{conv};
2331 0         0 $th /= $o->{conv};
2332            
2333 0         0 $out;
2334 0         0 };
2335              
2336 0         0 $me->_finish;
2337             }
2338              
2339              
2340             ######################################################################
2341              
2342             =head2 t_aitoff
2343              
2344             C in an alias for C
2345              
2346             =head2 t_hammer
2347              
2348             =for ref
2349              
2350             (Cartography) Hammer/Aitoff elliptical projection (az.; auth.)
2351              
2352             The Hammer/Aitoff projection is often used to display the Celestial
2353             sphere. It is mathematically related to the Lambert Azimuthal Equal-Area
2354             projection (L), and maps the sphere to an ellipse of unit
2355             eccentricity, with vertical radius sqrt(2) and horizontal radius of
2356             2 sqrt(2).
2357              
2358             OPTIONS
2359              
2360             =over 3
2361              
2362             =item STANDARD POSITIONAL OPTIONS
2363              
2364             =back
2365              
2366             =cut
2367              
2368             *t_aitoff = *t_aitoff = \&t_hammer;
2369              
2370             sub t_hammer {
2371 0     0 1 0 my($me) = _new(@_,"Hammer/Aitoff Projection");
2372            
2373 0         0 $me->{otype} = ['Longitude','Latitude'];
2374 0         0 $me->{ounit} = [' ',' '];
2375 0         0 $me->{odim} = 2;
2376 0         0 $me->{idim} = 2;
2377              
2378             $me->{func} = sub {
2379 0     0   0 my($d,$o) = @_;
2380 0 0       0 my($out) = $d->is_inplace ? $d : $d->copy;
2381 0         0 $out->slice("0:1") *= $o->{conv};
2382 0         0 my($th) = $out->slice("(0)");
2383 0         0 my($ph) = $out->slice("(1)");
2384 0         0 my($t) = sqrt( 2 / (1 + cos($ph) * cos($th/2)));
2385 0         0 $th .= 2 * $t * cos($ph) * sin($th/2);
2386 0         0 $ph .= $t * sin($ph);
2387 0         0 $out;
2388             }
2389 0         0 ;
2390              
2391             $me->{inv} = sub {
2392 0     0   0 my($d,$o) = @_;
2393 0 0       0 my($out) = $d->is_inplace ? $d : $d->copy;
2394 0         0 my($x) = $out->slice("(0)");
2395 0         0 my($y) = $out->slice("(1)");
2396              
2397 0         0 my($rej) = which(($x*$x/8 + $y*$y/2)->flat > 1);
2398            
2399 0         0 my($zz);
2400 0         0 my($z) = sqrt( $zz = (1 - $x*$x/16 - $y*$y/4) );
2401 0         0 $x .= 2 * atan( ($z * $x) / (4 * $zz - 2) );
2402 0         0 $y .= asin($y * $z);
2403            
2404 0         0 $out->slice("0:1") /= $o->{conv};
2405              
2406 0         0 $x->flat->slice($rej) .= $o->{bad};
2407 0         0 $y->flat->slice($rej) .= $o->{bad};
2408              
2409 0         0 $out;
2410 0         0 };
2411              
2412 0         0 $me->_finish;
2413             }
2414              
2415              
2416             ######################################################################
2417              
2418             =head2 t_zenithal
2419              
2420             Vertical projections are also called "zenithal", and C is an
2421             alias for C.
2422              
2423             =head2 t_vertical
2424              
2425             =for usage
2426              
2427             $t = t_vertical();
2428              
2429             =for ref
2430              
2431             (Cartography) Vertical perspective projection (az.; persp.)
2432              
2433             Vertical perspective projection is a generalization of L
2434             and L projection, and a special case of
2435             L projection. It is a projection from the
2436             sphere onto a tangent plane from a point at the camera location.
2437              
2438             OPTIONS
2439              
2440             =over 3
2441              
2442             =item STANDARD POSITIONAL OPTIONS
2443              
2444             =item m, mask, Mask, h, hemisphere, Hemisphere [default 'near']
2445              
2446             The hemisphere to keep in the projection (see L).
2447              
2448             =item r0, R0, radius, d, dist, distance [default 2.0]
2449              
2450             The altitude of the focal plane above the center of the sphere. The default
2451             places the point of view one radius above the surface.
2452              
2453             =item t, telescope, Telescope, cam, Camera (default '')
2454              
2455             If this is set, then the central scale is in telescope or camera
2456             angular units rather than in planetary radii. The angular units are
2457             parsed as with the normal 'u' option for the lon/lat specification.
2458             If you specify a non-string value (such as 1) then you get telescope-frame
2459             radians, suitable for working on with other transformations.
2460              
2461             =item f, fish, fisheye (default '')
2462              
2463             If this is set then the output is in azimuthal equidistant coordinates
2464             instead of in tangent-plane coordinates. This is a convenience function
2465             for '(t_az_eqd) x !(t_gnomonic) x (t_vertical)'.
2466              
2467             =back
2468              
2469             =cut
2470              
2471             sub t_vertical {
2472 0     0 1 0 my($me) = _new(@_,'Vertical Perspective');
2473 0         0 my $p = $me->{params};
2474            
2475             my $m= _opt($me->{options},
2476 0         0 ['m','mask','Mask','h','hemi','hemisphere','Hemisphere'],
2477             1);
2478              
2479 0         0 $me->{otype} = ['Perspective X','Perspective Y'];
2480 0         0 $me->{ounit} = ['Body radii','Body radii'];
2481              
2482 0 0       0 if($m=~m/^b/i) {
    0          
    0          
2483 0         0 $p->{m} = 0;
2484             } elsif($m=~m/^n/i) {
2485 0         0 $p->{m} = 1;
2486             } elsif($m=~m/^f/i) {
2487 0         0 $p->{m} = 2;
2488             } else {
2489 0         0 $p->{m} = $m;
2490             }
2491              
2492             $p->{r0} = _opt($me->{options},
2493 0         0 ['r0','R0','radius','Radius',
2494             'd','dist','distance','Distance'],
2495             2.0
2496             );
2497            
2498 0 0       0 if($p->{r0} == 0) {
2499 0 0       0 print "t_vertical: r0 = 0; using t_gnomonic instead\n"
2500             if($PDL::verbose);
2501 0         0 return t_gnomonic($me->{options});
2502             }
2503            
2504 0 0       0 if($p->{r0} == 1) {
2505 0 0       0 print "t_vertical: r0 = 1; using t_stereographic instead\n"
2506             if($PDL::verbose);
2507 0         0 return t_stereographic($me->{options});
2508             }
2509            
2510            
2511             $p->{t} = _opt($me->{options},
2512 0         0 ['t','tele','telescope','Telescope',
2513             'cam','camera','Camera'],
2514             undef);
2515            
2516             $p->{f} = _opt($me->{options},
2517 0         0 ['f','fish','fisheye','Fisheye'],
2518             undef);
2519            
2520             $p->{t} = 'rad'
2521 0 0 0     0 if($p->{f} && !defined($p->{t}));
2522            
2523             $p->{tconv} = _uconv($p->{t},1) || _uconv('rad')
2524 0 0 0     0 if(defined $p->{t});
2525              
2526             $me->{func} = sub {
2527 0     0   0 my($d,$o) = @_;
2528 0 0       0 my($out) = $d->is_inplace ? $d : $d->copy;
2529 0         0 my($th) = $d->slice("(0)")*$o->{conv};
2530 0         0 my($ph) = $d->slice("(1)")*$o->{conv};
2531              
2532 0         0 my($cph) = cos($ph);
2533              
2534 0         0 my($cos_c) = $cph * cos($th);
2535              
2536             my($k) = (($o->{r0} - 1) /
2537 0         0 ($o->{r0} - $cos_c));
2538              
2539             # If it's a telescope perspective, figure the apparent size
2540             # of the globe and scale accordingly.
2541 0 0       0 if($o->{t}) {
2542 0         0 my($theta) = asin(1/$o->{r0});
2543             }
2544            
2545             $out->slice("0:1") /= ($o->{r0} - 1.0) * ($o->{f} ? 1.0 : $o->{tconv})
2546 0 0       0 if($o->{t});
    0          
2547              
2548              
2549              
2550 0         0 $out->slice("(0)") .= $cph * sin($th);
2551 0         0 $out->slice("(1)") .= sin($ph);
2552              
2553             # Handle singularity at the origin
2554 0         0 $k->where(($out->slice("(0)") == 0) & ($out->slice("(1)") == 0)) .= 0;
2555 0         0 $out->slice("0:1") *= $k->dummy(0,2);
2556              
2557 0 0       0 if($o->{m}) {
2558 0         0 my $idx;
2559             $idx = whichND($cos_c < 1.0/$o->{r0})
2560 0 0       0 if($o->{m} == 1);
2561             $idx = whichND($cos_c > 1.0/$o->{r0})
2562 0 0       0 if($o->{m} == 2);
2563              
2564 0 0 0     0 if(defined $idx && ref $idx eq 'PDL' && $idx->nelem){
      0        
2565 0         0 $out->slice("(0)")->range($idx) .= $o->{bad};
2566 0         0 $out->slice("(1)")->range($idx) .= $o->{bad};
2567             }
2568             }
2569              
2570              
2571 0         0 $out;
2572 0         0 };
2573              
2574             $me->{inv} = sub {
2575 0     0   0 my($d,$o) = @_;
2576 0 0       0 my($out) = $d->is_inplace ? $d : $d->copy;
2577              
2578             # Reverse the hemisphere if the mask is set to 'far'
2579 0 0       0 my($P) = ($o->{m} == 2) ? -$o->{r0} : $o->{r0};
2580              
2581             $out->slice("0:1") *= ($P - 1.0) * ($o->{f} ? 1.0 : $o->{tconv})
2582 0 0       0 if($o->{t});
    0          
2583              
2584 0         0 my $rho = $d->slice("0:1")->magnover;
2585 0         0 my($sin_c) = ( ( $P - sqrt( 1 - ($rho*$rho * ($P+1)/($P-1)) ) ) /
2586             ( ($P-1)/$rho + $rho/($P-1) )
2587             );
2588              
2589 0         0 my($cos_c) = sqrt(1 - $sin_c*$sin_c);
2590              
2591             # Switch c's quadrant where necessary, by inverting cos(c).
2592 0 0       0 if($P<0) {
2593 0         0 my $idx = whichND($rho > ($P-1/$P));
2594 0 0       0 $cos_c->range($idx) *= -1
2595             if($idx->nelem > 0);
2596             }
2597              
2598            
2599 0         0 $out->slice("(0)") .= atan( $d->slice("(0)") * $sin_c / ($rho * $cos_c) );
2600 0         0 $out->slice("(1)") .= asin( $d->slice("(1)") * $sin_c / $rho );
2601              
2602 0         0 $out->slice("0:1") /= $o->{conv};
2603              
2604 0         0 $out;
2605 0         0 };
2606            
2607              
2608             # Compose on both front and back as necessary.
2609             return t_compose( t_scale(1.0/$p->{tconv}),
2610             t_az_eqd,
2611             t_gnomonic->inverse,
2612             $me->_finish )
2613 0 0       0 if($p->{f});
2614              
2615 0         0 $me->_finish;
2616             }
2617              
2618             *t_zenithal = *t_zenithal = \&t_vertical;
2619              
2620             ######################################################################
2621              
2622             =head2 t_perspective
2623              
2624             =for usage
2625              
2626             $t = t_perspective();
2627              
2628             =for ref
2629              
2630             (Cartography) Arbitrary perspective projection
2631              
2632             Perspective projection onto a focal plane from an arbitrary location
2633             within or without the sphere, with an arbitrary central look direction,
2634             and with correction for magnification within the optical system.
2635              
2636             In the forward direction, t_perspective generates perspective views of
2637             a sphere given (lon/lat) mapping or vector information. In the reverse
2638             direction, t_perspective produces (lon/lat) maps from aerial or distant
2639             photographs of spherical objects.
2640              
2641             Viewpoints outside the sphere treat the sphere as opaque by default,
2642             though you can use the 'm' option to specify either the near or far
2643             surface (relative to the origin). Viewpoints below the surface treat
2644             the sphere as transparent and undergo a mirror reversal for
2645             consistency with projections that are special cases of the perspective
2646             projection (e.g. t_gnomonic for r0=0 or t_stereographic for r0=-1).
2647              
2648             Magnification correction handles the extra edge distortion due to
2649             higher angles between the focal plane and focused rays within the
2650             optical system of your camera. If you do not happen to know the
2651             magnification of your camera, a simple rule of thumb is that the
2652             magnification of a reflective telescope is roughly its focal length
2653             (plate scale) divided by its physical length; and the magnification of
2654             a compound refractive telescope is roughly twice its physical length divided
2655             by its focal length. Simple optical systems with a single optic have
2656             magnification = 1. Fisheye lenses have magnification < 1.
2657              
2658             This transformation was derived by direct geometrical calculation
2659             rather than being translated from Voxland & Snyder.
2660              
2661             OPTIONS
2662              
2663             =over 3
2664              
2665             =item STANDARD POSITIONAL OPTIONS
2666              
2667             As always, the 'origin' field specifies the sub-camera point on the
2668             sphere.
2669              
2670             The 'roll' option is the roll angle about the sub-camera point, for
2671             consistency with the other projectons.
2672              
2673             =item p, ptg, pointing, Pointing (default (0,0,0))
2674              
2675             The pointing direction, in (horiz. offset, vert. offset, roll) of the
2676             camera relative to the center of the sphere. This is a spherical
2677             coordinate system with the origin pointing directly at the sphere and
2678             the pole pointing north in the pre-rolled coordinate system set by the
2679             standard origin. It's most useful for space-based images taken some distance
2680             from the body in question (e.g. images of other planets or the Sun).
2681              
2682             Be careful not to confuse 'p' (pointing) with 'P' (P angle, a standard
2683             synonym for roll).
2684              
2685             =item c, cam, camera, Camera (default undef)
2686              
2687             Alternate way of specifying the camera pointing, using a spherical
2688             coordinate system with poles at the zenith (positive) and nadir
2689             (negative) -- this is useful for aerial photographs and such, where
2690             the point of view is near the surface of the sphere. You specify
2691             (azimuth from N, altitude from horizontal, roll from vertical=up). If
2692             you specify pointing by this method, it overrides the 'pointing'
2693             option, above. This coordinate system is most useful for aerial photography
2694             or low-orbit work, where the nadir is not necessarily the most interesting
2695             part of the scene.
2696              
2697             =item r0, R0, radius, d, dist, distance [default 2.0]
2698              
2699             The altitude of the point of view above the center of the sphere.
2700             The default places the point of view 1 radius aboove the surface.
2701             Do not confuse this with 'r', the standard origin roll angle! Setting
2702             r0 < 1 gives a viewpoint inside the sphere. In that case, the images are
2703             mirror-reversed to preserve the chiralty of the perspective. Setting
2704             r0=0 gives gnomonic projections; setting r0=-1 gives stereographic projections.
2705             Setting r0 < -1 gives strange results.
2706              
2707             =item iu, im_unit, image_unit, Image_Unit (default 'degrees')
2708              
2709             This is the angular units in which the viewing camera is calibrated
2710             at the center of the image.
2711              
2712             =item mag, magnification, Magnification (default 1.0)
2713              
2714             This is the magnification factor applied to the optics -- it affects the
2715             amount of tangent-plane distortion within the telescope.
2716             1.0 yields the view from a simple optical system; higher values are
2717             telescopic, while lower values are wide-angle (fisheye). Higher
2718             magnification leads to higher angles within the optical system, and more
2719             tangent-plane distortion at the edges of the image.
2720             The magnification is applied to the incident angles themselves, rather than
2721             to their tangents (simple two-element telescopes magnify tan(theta) rather
2722             than theta itself); this is appropriate because wide-field optics more
2723             often conform to the equidistant azimuthal approximation than to the
2724             tangent plane approximation. If you need more detailed control of
2725             the relationship between incident angle and focal-plane position,
2726             use mag=1.0 and compose the transform with something else to tweak the
2727             angles.
2728              
2729             =item m, mask, Mask, h, hemisphere, Hemisphere [default 'near']
2730              
2731             'hemisphere' is by analogy to other cartography methods although the two
2732             regions to be selected are not really hemispheres.
2733              
2734             =item f, fov, field_of_view, Field_Of_View [default 60 degrees]
2735              
2736             The field of view of the telescope -- sets the crop radius on the
2737             focal plane. If you pass in a scalar, you get a circular crop. If you
2738             pass in a 2-element list ref, you get a rectilinear crop, with the
2739             horizontal 'radius' and vertical 'radius' set separately.
2740              
2741             =back
2742              
2743             EXAMPLES
2744              
2745             Model a camera looking at the Sun through a 10x telescope from Earth
2746             (~230 solar radii from the Sun), with an 0.5 degree field of view and
2747             a solar P (roll) angle of 30 degrees, in February (sub-Earth solar
2748             latitude is 7 degrees south). Convert a solar FITS image taken with
2749             that camera to a FITS lon/lat map of the Sun with 20 pixels/degree
2750             latitude:
2751              
2752             # Define map output header (no need if you don't want a FITS output map)
2753             $maphdr = {NAXIS1=>7200,NAXIS2=>3600, # Size of image
2754             CTYPE1=>longitude,CTYPE2=>latitude, # Type of axes
2755             CUNIT1=>deg,CUNIT2=>deg, # Unit of axes
2756             CDELT1=>0.05,CDELT2=>0.05, # Scale of axes
2757             CRPIX1=>3601,CRPIX2=>1801, # Center of map
2758             CRVAL1=>0,CRVAL2=>0 # (lon,lat) of center
2759             };
2760              
2761             # Set up the perspective transformation, and apply it.
2762             $t = t_perspective(r0=>229,fov=>0.5,mag=>10,P=>30,B=>-7);
2763             $map = $im->map( $t , $maphdr );
2764              
2765             Draw an aerial-view map of the Chesapeake Bay, as seen from a sounding
2766             rocket at an altitude of 100km, looking NNE from ~200km south of
2767             Washington (the radius of Earth is 6378 km; Washington D.C. is at
2768             roughly 77W,38N). Superimpose a linear coastline map on a photographic map.
2769              
2770             $x = graticule(1,0.1)->glue(1,earth_coast());
2771             $t = t_perspective(r0=>6478/6378.0,fov=>60,cam=>[22.5,-20],o=>[-77,36])
2772             $w = pgswin(size=>[10,6],J=>1);
2773             $w->plot(with=>'fits', earth_image()->map($t,[800,500],{m=>linear}),
2774             with=>'polylines', $x->apply($t)->clean_lines);
2775              
2776             Model a 5x telescope looking at Betelgeuse with a 10 degree field of view
2777             (since the telescope is looking at the Celestial sphere, r is 0 and this
2778             is just an expensive modified-gnomonic projection).
2779              
2780             $t = t_perspective(r0=>0,fov=>10,mag=>5,o=>[88.79,7.41])
2781              
2782             =cut
2783              
2784             sub t_perspective {
2785 1     1 1 14 my($me) = _new(@_,'Focal-Plane Perspective');
2786 1         4 my $p = $me->{params};
2787            
2788             my $m= _opt($me->{options},
2789 1         7 ['m','mask','Mask','h','hemi','hemisphere','Hemisphere'],
2790             1);
2791 1         7 $p->{m} = $m;
2792 1 50       7 $p->{m} = 0 if($m=~m/^b/i);
2793 1 50       5 $p->{m} = 1 if($m=~m/^n/i);
2794 1 50       5 $p->{m} = 2 if($m=~m/^f/i);
2795              
2796             $p->{r0} = _opt($me->{options},
2797 1         6 ['r0','R0','radius','Radius',
2798             'd','dist','distance','Distance'],
2799             2.0
2800             );
2801            
2802             $p->{iu} = _opt($me->{options},
2803 1         6 ['i','iu','image_unit','Image_Unit'],
2804             'degrees');
2805            
2806 1         6 $p->{tconv} = _uconv($p->{iu});
2807              
2808             $p->{mag} = _opt($me->{options},
2809 1         7 ['mag','magnification','Magnification'],
2810             1.0);
2811              
2812             # Regular pointing pseudovector -- make sure there are exactly 3 elements
2813             $p->{p} = (topdl(_opt($me->{options},
2814             ['p','ptg','pointing','Pointing'],
2815             [0,0,0])
2816             )
2817             * $p->{tconv}
2818 1         7 )->append(zeroes(3))->slice("0:2");
2819              
2820 1         15 $p->{pmat} = _rotmat( (- $p->{p})->list );
2821            
2822             # Funky camera pointing pseudovector overrides normal pointing option
2823             $p->{c} = _opt($me->{options},
2824 1         21 ['c','cam','camera','Camera'],
2825             undef
2826             );
2827              
2828 1 50       7 if(defined($p->{c})) {
2829 0         0 $p->{c} = (topdl($p->{c}) * $p->{tconv})->append(zeroes(3))->slice("0:2");
2830              
2831             $p->{pmat} = ( _rotmat( 0,-$PI/2,0 ) x
2832 0         0 _rotmat( (-$p->{c})->list )
2833             );
2834             }
2835              
2836             # Reflect X axis if we're inside the sphere.
2837 1 50       5 if($p->{r0}<1) {
2838 0         0 $p->{pmat} = topdl([[-1,0,0],[0,1,0],[0,0,1]]) x $p->{pmat};
2839             }
2840              
2841             $p->{f} = ( _opt($me->{options},
2842             ['f','fov','field_of_view','Field_of_View'],
2843             topdl($PI*2/3) / $p->{tconv} / $p->{mag} )
2844             * $p->{tconv}
2845 1         10 );
2846            
2847 1         14 $me->{otype} = ['Tan X','Tan Y'];
2848 1         5 $me->{ounit} = [$p->{iu},$p->{iu}];
2849              
2850             # "Prefilter" -- subsidiary transform to convert the
2851             # spherical coordinates to 3-D coords in the viewer's
2852             # reference frame (Y,Z are more-or-less tangent-plane X and Y,
2853             # and -X is the direction toward the planet, before rotation
2854             # to account for pointing).
2855              
2856             $me->{params}->{prefilt} =
2857             t_compose(
2858             # Offset for the camera pointing.
2859             t_linear(m=>$p->{pmat},
2860             d=>3),
2861              
2862             # Rotate the sphere so the correct origin is at the
2863             # maximum-X point, then move the whole thing in the
2864             # -X direction by r0.
2865             t_linear(m=>(_rotmat($p->{o}->at(0),
2866             $p->{o}->at(1),
2867             $p->{roll}->at(0))
2868             ),
2869             d=>3,
2870 1         8 post=> topdl( [- $me->{params}->{r0},0,0] )
2871             ),
2872              
2873             # Put initial sci. coords into Cartesian space
2874             t_unit_sphere(u=>'radian')
2875             );
2876              
2877             # Store the origin of the sphere -- useful for the inverse function
2878             $me->{params}->{sph_origin} = (
2879             topdl([-$me->{params}->{r0},0,0]) x
2880             $p->{pmat}
2881 1         25 )->slice(":,(0)");
2882              
2883             #
2884             # Finally, the meat -- the forward function!
2885             #
2886             $me->{func} = sub {
2887 8     8   20 my($d,$o) = @_;
2888              
2889 8 50       46 my($out) = $d->is_inplace ? $d : $d->copy;
2890 8         35 $out->slice("0:1") *= $o->{conv};
2891              
2892             # If we're outside the sphere, do hemisphere filtering
2893 8         41 my $idx;
2894 8 50       51 if(abs($o->{r0}) < 1 ) {
2895 0         0 $idx = null;
2896             } else {
2897             # Great-circle distance to origin
2898             my($cos_c) = ( sin($o->{o}->slice("(1)")) * sin($out->slice("(1)"))
2899             +
2900             cos($o->{o}->slice("(1)")) * cos($out->slice("(1)")) *
2901 8         37 cos($out->slice("(0)") - $o->{o}->slice("(0)"))
2902             );
2903              
2904 8         184 my($thresh) = (1.0/$o->{r0});
2905            
2906 8 50       32 if($o->{m}==1) {
    0          
2907 8         26 $idx = whichND($cos_c < $thresh);
2908             } elsif($o->{m}==2) {
2909 0         0 $idx = whichND($cos_c > $thresh);
2910             } else {
2911 0         0 $idx = null;
2912             }
2913             }
2914              
2915             ### Transform everything -- just chuck out the bad points at the end.
2916              
2917             ## convert to 3-D viewer coordinates (there's a dimension change!)
2918 8         84 my $dc = $out->apply($o->{prefilt});
2919              
2920             ## Apply the tangent-plane transform, and scale by the magnification.
2921 8         28 my $dcyz = $dc->slice("1:2");
2922              
2923 8         243 my $r = $dcyz->magnover;
2924 8         20 my $rscale;
2925 8 50       36 if( $o->{mag} == 1.0 ) {
2926 8         25 $rscale = - 1.0 / $dc->slice("(0)");
2927             } else {
2928 0 0       0 print "(using magnification...)\n" if $PDL::verbose;
2929 0         0 $rscale = - tan( $o->{mag} * atan( $r / $dc->slice("(0)") ) ) / $r;
2930             }
2931 8         50 $r *= $rscale;
2932 8         25 $out->slice("0:1") .= $dcyz * $rscale->dummy(0,1);
2933              
2934             # Chuck points that are outside the FOV: glue those points
2935             # onto the removal list. The conditional works around a bug
2936             # in 2.3.4cvs and earlier: null ndarrays make append() crash.
2937 8         93 my $w;
2938 8 50       34 if(ref $o->{f} eq 'ARRAY') {
2939             $w = whichND( ( abs($dcyz->slice("(0)")) > $o->{f}->[0] ) |
2940 0         0 ( abs($dcyz->slice("(1)")) > $o->{f}->[1] ) |
2941             ($r < 0)
2942             );
2943             } else {
2944 8         29 $w = whichND( ($r > $o->{f}) | ($r < 0) );
2945             }
2946            
2947 8 0       96 $idx = ($idx->nelem) ? $idx->glue(1,$w) : $w
    50          
2948             if($w->nelem);
2949              
2950 8 50       30 if($idx->nelem) {
2951 0         0 $out->slice("(0)")->range($idx) .= $o->{bad};
2952 0         0 $out->slice("(1)")->range($idx) .= $o->{bad};
2953             }
2954              
2955             ## Scale by the output conversion factor
2956 8         26 $out->slice("0:1") /= $o->{tconv};
2957              
2958 8         111 $out;
2959 1         13 };
2960              
2961            
2962             #
2963             # Inverse function
2964             #
2965             $me->{inv} = sub {
2966 0     0   0 my($d,$o) = @_;
2967              
2968 0 0       0 my($out) = $d->is_inplace ? $d : $d->copy;
2969 0         0 $out->slice("0:1") *= $o->{tconv};
2970              
2971 0         0 my $oyz = $out->slice("0:1") ;
2972              
2973             ## Inverse-magnify if required
2974 0 0       0 if($o->{mag} != 1.0) {
2975 0         0 my $r = $oyz->magnover;
2976 0         0 my $scale = tan( atan( $r ) / $o->{mag} ) / $r;
2977 0         0 $out->slice("0:1") *= $scale->dummy(0,1);
2978             }
2979            
2980             ## Solve for the X coordinate of the surface.
2981             ## This is a quadratic in the tangent-plane coordinates;
2982             ## so here we just figure out the coefficients and plug into
2983             ## the quadratic formula. $y here is actually -B/2.
2984 0         0 my $a1 = ($oyz * $oyz)->sumover + 1;
2985             my $y = ( $o->{sph_origin}->slice("(0)")
2986 0         0 - ($o->{sph_origin}->slice("1:2") * $oyz)->sumover
2987             );
2988 0         0 my $c = topdl($o->{r0}*$o->{r0} - 1);
2989            
2990 0         0 my $x;
2991 0 0       0 if($o->{m} == 2) {
2992             # Exceptional case: mask asks for the far hemisphere
2993 0         0 $x = - ( $y - sqrt($y*$y - $a1 * $c) ) / $a1;
2994             } else {
2995             # normal case: mask asks for the near hemisphere
2996 0         0 $x = - ( $y + sqrt($y*$y - $a1 * $c) ) / $a1;
2997             }
2998              
2999             ## Assemble the 3-space coordinates of the points
3000 0         0 my $int = $out->slice("0")->append($out);
3001 0         0 $int->sever;
3002 0         0 $int->slice("(0)") .= -1.0;
3003 0         0 $int->slice("0:2") *= $x->dummy(0,3);
3004              
3005             ## convert back to (lon,lat) coordinates...
3006 0         0 $out .= $int->invert($o->{prefilt});
3007              
3008             # If we're outside the sphere, do hemisphere filtering
3009 0         0 my $idx;
3010 0 0       0 if(abs($o->{r0}) < 1 ) {
3011 0         0 $idx = null;
3012             } else {
3013             # Great-circle distance to origin
3014             my($cos_c) = ( sin($o->{o}->slice("(1)")) * sin($out->slice("(1)"))
3015             +
3016             cos($o->{o}->slice("(1)")) * cos($out->slice("(1)")) *
3017 0         0 cos($out->slice("(0)") - $o->{o}->slice("(0)"))
3018             );
3019            
3020 0         0 my($thresh) = (1.0/$o->{r0});
3021            
3022 0 0       0 if($o->{m}==1) {
    0          
3023 0         0 $idx = whichND($cos_c < $thresh);
3024             } elsif($o->{m}==2) {
3025 0         0 $idx = whichND($cos_c > $thresh);
3026             }
3027             else {
3028 0         0 $idx = null;
3029             }
3030             }
3031              
3032             ## Convert to the units the user requested
3033 0         0 $out->slice("0:1") /= $o->{conv};
3034              
3035             ## Mark bad values
3036 0 0       0 if($idx->nelem) {
3037 0         0 $out->slice("(0)")->range($idx) .= $o->{bad};
3038 0         0 $out->slice("(1)")->range($idx) .= $o->{bad};
3039             }
3040              
3041 0         0 $out;
3042              
3043 1         25 };
3044            
3045 1         8 $me;
3046             }
3047              
3048             1;