File Coverage

blib/lib/Geo/GNUPlot.pm

Criterion	Covered	Total	%
statement	12	483	2.4
branch	0	182	0.0
condition	0	63	0.0
subroutine	4	21	19.0
pod	4	4	100.0
total	20	753	2.6

package Geo::GNUPlot;

use strict;
use Carp;
use IO::File;
use vars qw($VERSION $DEBUG);

$VERSION = '0.01';
#$DEBUG = 0;

#-------------------------------------------------------
#New method for Geo::GNUPlot
#Notice that it has a mandatory configuration file argument.
sub new {
	my $self=shift;
	my $option_HR=shift;

	my ($grid_HR, $msg, $grid_file, $map_file, $gnuplot)=undef;

	$grid_file=$option_HR->{'grid_file'};
	$map_file=$option_HR->{'map_file'};
	$gnuplot=$option_HR->{'gnuplot'};

	unless (defined $grid_file){
		$msg="new method called without the mandatory grid_file option key!";
		carp $msg,"\n";
		return (undef,$msg);
	}#unless

	unless (defined $map_file){
		$msg="new method called without the mandatory map_file option key!";
		carp $msg,"\n";
		return (undef,$msg);
	}#unless

	unless (defined $gnuplot){
		$msg="new method called without the mandatory gnuplot option key!";
		carp $msg,"\n";
		return (undef,$msg);
	}#unless

	$self={};
	bless($self,'Geo::GNUPlot');

	($grid_HR,$msg)=$self->_read_grid($grid_file);
	return (undef,$msg) unless (defined $grid_HR);

	$self->{'grid_HR'}=$grid_HR;
	$self->{'map_file'}=$map_file;
	$self->{'gnuplot'}=$gnuplot;

	return ($self,undef);
}#new
#------------------------------------------------------
#If $track_AR has 2 elements in the first point in the track it is assumed
#the incomming position data is in x,y form.
#Otherwise it is assumed the incomming position data is in
#($long, $long_dir, $lat, $lat_dir) form.
sub plot_track {
	my $self=shift;
	my $track_AR=shift;
	my $output_file=shift;
	my $option_HR=shift;

	my ($success, $error, $xy_data_AR, $radius, $temp_dir, $ppm_file)=undef;
	my ($data_file, $config_file, $msg, $x_range_AR, $y_range_AR)=undef;
	my ($x_pad, $y_pad, $x_scale, $y_scale, $term, $title)=undef;

	#Determine x_pad, y_pad, x_scale, y_scale, and term
	if (defined $option_HR->{'x_pad'}){
		$x_pad=$option_HR->{'x_pad'};
	}
	else {
		$x_pad=0;
	}#if/else

	if (defined $option_HR->{'y_pad'}){
		$y_pad=$option_HR->{'y_pad'};
	}
	else {
		$y_pad=0;
	}#if/else

	if (defined $option_HR->{'x_scale'}){
		$x_scale=$option_HR->{'x_scale'};
	}
	else {
		$x_scale=1;
	}#if/else

	if (defined $option_HR->{'y_scale'}){
		$y_scale=$option_HR->{'y_scale'};
	}
	else {
		$y_scale=1;
	}#if/else

	if (defined $option_HR->{'title'}){
		$title=$option_HR->{'title'};
	}
	else {
		$title='Storm Tracking Map';
	}#if/else

	if (defined $option_HR->{'term'}){
		$term=$option_HR->{'term'};
	}
	else {
		$term='gif';
	}#if/else

	#Determine names for $data_file and $config_file.
	if (defined $option_HR->{'temp_dir'}){
		$temp_dir=$option_HR->{'temp_dir'};
	}
	else {
		$temp_dir='/tmp/';
	}

	$temp_dir =~ s!/*!/!;
	$data_file=$temp_dir."datafile_$$";
	$config_file=$temp_dir."configfile_$$";

	#Figure out what kind of track was passed.
	#If necessary convert ($long, $long_dir, $lat, $lat_dir) form to xy form.
	if (scalar(@{${$track_AR}[0]}) == 2){
		$xy_data_AR=$track_AR;
	}
	else {
		#Get the track in x,y form as well as check the syntax of the position arrays.
		($xy_data_AR,$error)=$self->_generate_xy_data($track_AR);

		#Abort if _generage_xy_data had a problem.
		return (0,$error) unless (defined $xy_data_AR);
	}#if/else

	#Write out the data file for gnuplot to plot.
	($success, $error)=$self->_write_plot_data_file($xy_data_AR,$data_file);
	return (0,$error) unless ($success);


	($x_range_AR,$y_range_AR,$error)=$self->_get_range({
								x_pad => $x_pad,
								y_pad => $y_pad,
								x_scale => $x_scale,
								y_scale => $y_scale,
								center_point => ${$xy_data_AR}[0],
								});

	return (0, $error) unless ( (defined $x_range_AR) and (defined $y_range_AR) );

	#Write out the config file for gnuplot.
	($success, $error)=$self->_write_plot_config_file({
							'config_file'=>$config_file,
							'data_file'=>$data_file,
							'output'=>$output_file,
							'xrange' => $x_range_AR,
							'yrange' => $y_range_AR,
							'term' => $term,
							'title' => $title,
							});
	return (0,$error) unless ($success);

	#Call gnuplot on the config file.
	($success, $error)=$self->_call_gnuplot($config_file);
	return (0,$error) unless ($success);

	#Erase temporary files
	($success, $error)=$self->_wack_files($data_file, $config_file);
	return (0,$error) unless ($success);

	return (1,undef);

}#plot_track
#-------------------------------------------------------
sub plot_radius_function {
	my $self=shift;
	my $output_file=shift;
	my $output_file2=shift;
	my $option_HR=shift;

	my ($term, $temp_dir)=undef;
	my ($data_file, $data_file2, $config_file, $config_file2, $config_file3, $map_file)=undef;
	my ($gnuplot_script, $gnuplot_script2, $gnuplot_script3)=undef;
	my ($success, $error)=undef;

	if (defined $option_HR->{'term'}){
		$term=$option_HR->{'term'};
	}
	else {
		$term='gif';
	}#if/else

	#Determine names for $data_file and $config_file.
	if (defined $option_HR->{'temp_dir'}){
		$temp_dir=$option_HR->{'temp_dir'};
	}
	else {
		$temp_dir='/tmp/';
	}

	$temp_dir =~ s!/*!/!;

	$data_file=$temp_dir."datafile_$$";
	$data_file2=$temp_dir."datafile2_$$";

	$config_file=$temp_dir."configfile_$$";
	$config_file2=$temp_dir."configfile2_$$";
	$config_file3=$temp_dir."configfile3_$$";

	$map_file=$self->{'map_file'};

	#######
	#Generate 3d radius data
	($success, $error)=$self->_generate_radius_data_file($data_file);

	########
	#Create a 2d contour file from the 3d data

	$gnuplot_script="set nosurface\nset contour\nset cntrparam levels 15\nset term table\nset output \'$data_file2\'\nsplot \'$data_file\'\n";

	($success,$error)=$self->_make_file($config_file,$gnuplot_script);
	return (0,$error) unless ($success);

	#Call gnuplot on the config file.
	($success, $error)=$self->_call_gnuplot($config_file);
	return (0,$error) unless ($success);


	########
	#Plot the contour ontop of the world map
	$gnuplot_script2 = "set nokey\nset border\nset xtics\nset ytics\nset term $term\n";
	$gnuplot_script2 .= "set output \'$output_file\'\nplot \'$data_file2\' with lines, \'$map_file\' with lines\n";

	($success,$error)=$self->_make_file($config_file2,$gnuplot_script2);
	return (0,$error) unless ($success);

	#Call gnuplot on the config file.
	($success, $error)=$self->_call_gnuplot($config_file2);
	return (0,$error) unless ($success);

	#######
	#Plot the 3d contour plot
	$gnuplot_script3 = "set key\nset hidden\nset border\nset xtics\nset ytics\nset term $term\n";
	$gnuplot_script3 .= "set contour base\nset cntrparam levels 15\nset autoscale\n";
	$gnuplot_script3 .= "set output \'$output_file2\'\nsplot \'$data_file\' with lines\n";

	($success,$error)=$self->_make_file($config_file3,$gnuplot_script3);
	return (0,$error) unless ($success);

	#Call gnuplot on the config file.
	($success, $error)=$self->_call_gnuplot($config_file3);
	return (0,$error) unless ($success);


	########
	#Erase temporary files
	($success, $error)=$self->_wack_files($data_file, $data_file2, $config_file, $config_file2, $config_file3);
	return (0,$error) unless ($success);

	#######
	#All done
	return (1,undef);

}#plot_radius_function
#-------------------------------------------------------
sub _make_file {
	my $self=shift;
	my $filename=shift;
	my $string=shift;

	my ($io, $msg)=undef;

	$io=IO::File->new();
	unless ($io->open(">$filename")){
		$msg = "Had trouble writting to $filename!";
                carp $msg,"\n";
                return (0, $msg);
        }#unless
	$io->print($string);
	$io->close();

	return (1,undef);

}#_make_file
#-------------------------------------------------------
sub _wack_files {
	my $self=shift;
	my @files=@_;

	my ($msg, $file)=undef;

	unless ($DEBUG) {
		foreach $file (@files){
			unless(unlink $file){
				$msg="The $file file could not be erased!";
				carp $msg,"\n";
				return (0,$msg);
			}#unless
		}#foreach
	}#unless

	return (1, undef);
}#_wack_files
#-------------------------------------------------------
sub _generate_radius_data_file {
	my $self=shift;
	my $data_file=shift;

	my ($io, $x, $y, $radius, $error, $msg)=undef;

	$io=IO::File->new() or croak "Couldn't create new io object!";
	unless ($io->open(">$data_file")){
		$msg="Couldn't open $data_file for writing!";
		carp $msg, "\n";
		return (0, $msg);
	}#unless

	for ($x=-180; $x<=180; $x+=3){
		for ($y=-90; $y<=90; $y+=3){
			($radius, $error)=$self->radius_function([$x, $y]);
                        return (0, $error) unless (defined $radius);
                        $io->print("$x\t$y\t$radius\n");
		}#for
		$io->print("\n");
	}#for

	$io->close();

	return (1,undef);
}#_generate_radius_data_file
#-------------------------------------------------------
#($x_range_AR,$y_range_AR,$error)=$self->_get_range({
#							x_pad => 1,
#							y_pad => 1,
#							x_scale => 2.5,
#							y_scale => 2.5,
#							center_pont => ${$xy_data_AR}[0]), # or [2,5]
#							});
sub _get_range {
	my $self=shift;
	my $option_HR=shift;

	my ($radius, $error, $x_pad, $y_pad, $x_scale, $y_scale, $center_point)=undef;
	my ($x_low, $x_high, $y_low, $y_high, $x_center, $y_center, $msg)=undef;

	$x_pad=$option_HR->{'x_pad'};
	$y_pad=$option_HR->{'y_pad'};
	$x_scale=$option_HR->{'x_scale'};
	$y_scale=$option_HR->{'y_scale'};
	$center_point=$option_HR->{'center_point'};
	$x_center=${$center_point}[0];
	$y_center=${$center_point}[1];

	unless ((defined $x_pad) and (defined $y_pad) and
		(defined $x_scale) and (defined $y_scale) and
		(defined $center_point)){
		$msg="_get_range requires valid x_pad, y_pad, x_scale, y_scale, and ";
		$msg .= "center_point keys in its mandatory hash reference argument.  ";
		$msg .= "At least one of these was ill defined!";
		carp $msg, "\n";
		return (undef, undef, $msg);
	}#unless

	#Determine the plot radius.
	($radius, $error)=$self->radius_function($center_point);

	unless (defined $radius){
		return (undef, undef, $error);
	}

	$y_low=$y_center-$radius*$y_scale-$y_pad;
	if ($y_low < -90){
		$y_low= -90;
	}#if

	$y_high=$y_center+$radius*$y_scale+$y_pad;

	if ($y_high > 90){
		$y_high=90;
	}#if

	$x_low=$x_center-$radius*$x_scale-$x_pad;
	if ($x_low < -180){
		$x_low=180;
	}#if

	$x_high=$x_center+$radius*$x_scale+$x_pad;
	if ($x_high > 180){
		$x_high=180;
	}#if


	return ([$x_low, $x_high],[$y_low, $y_high], undef);

}#_get_range
#-------------------------------------------------------
sub _call_gnuplot {
	my $self=shift;
	my $config_file=shift;

	my ($gnuplot, $msg, $exit_status, $error)=undef;

	$gnuplot=$self->{'gnuplot'};

	unless (-e $gnuplot){
		$msg="Gnuplot executable could not be found at $gnuplot!";
		$msg.="  Examine new method of Geo::GNUPlot!";
		carp $msg,"\n";
		return (0,$msg);
	}#unless

	$exit_status=system("$gnuplot $config_file");
	$error=$!;
	$exit_status=$exit_status/256;
	unless ($exit_status == 0){
		$msg="Execution of gnuplot failed.  Exit status was $exit_status.  Error was $error";
		carp $msg,"\n";
		return (0,$msg);
	}#unless

	return (1,undef);
}#_call_gnuplot
#-------------------------------------------------------
sub _write_plot_config_file {
	my $self=shift;
	my $option_HR=shift;

	my ($io, $msg)=undef;

	$io=IO::File->new();
	unless ($io->open($option_HR->{'config_file'},'w')){
		$msg="Couldn't open ".$option_HR->{'configfile'}." for writting!";
		carp $msg,"\n";
		return (0,$msg);
	}#unless

	#Key option
	if (!defined $option_HR->{'key'}){
		$io->print("set nokey\n");
	}
	elsif ($option_HR->{'key'}){
		$io->print("set key\n");
	}
	else {
		$io->print("set nokey\n");
	}#if/elsif/else

	#Border option
	if (!defined $option_HR->{'border'}){
		$io->print("set border\n");
	}
	elsif ($option_HR->{'border'}){
		$io->print("set border\n");
	}
	else {
		$io->print("set noborder\n");
	}#if/elsif/else

	#Yzeroaxis option
	if (!defined $option_HR->{'yzeroaxis'}){
		$io->print("set yzeroaxis\n");
	}
	elsif ($option_HR->{'yzeroaxis'}){
		$io->print("set yzeroaxis\n");
	}
	else {
		$io->print("set noyzeroaxis\n");
	}#if/elsif/else

	#Xzeroaxis option
	if (!defined $option_HR->{'xzeroaxis'}){
		$io->print("set noxzeroaxis\n");
	}
	elsif ($option_HR->{'xzeroaxis'}){
		$io->print("set xzeroaxis\n");
	}
	else {
		$io->print("set noxzeroaxis\n");
	}#if/elsif/else

	#X and Y range
	if((defined $option_HR->{'xrange'}) and (defined $option_HR->{'yrange'})){
		$io->print("set xrange \[",${$option_HR->{'xrange'}}[0],":",${$option_HR->{'xrange'}}[1],"\]\n");
		$io->print("set yrange \[",${$option_HR->{'yrange'}}[0],":",${$option_HR->{'yrange'}}[1],"\]\n");
	}
	else {
		$io->print("set autoscale\n");
	}#if/else

	#Xtics option
	if (!defined $option_HR->{'xtics'}){
		$io->print("set xtics\n");
	}
	elsif ($option_HR->{'xtics'}){
		$io->print("set xtics\n");
	}
	else {
		$io->print("set noxtics\n");
	}#if/elsif/else

	#Ytics option
	if (!defined $option_HR->{'ytics'}){
		$io->print("set ytics\n");
	}
	elsif ($option_HR->{'ytics'}){
		$io->print("set ytics\n");
	}
	else {
		$io->print("set noytics\n");
	}#if/elsif/else

	if ($option_HR->{'title'}){
		$io->print("set title \'".$option_HR->{'title'}."\'\n");
	}#if

	if (!defined $option_HR->{'output'}){
		$msg="output option to _write_plot_config_file must be set!";
		carp $msg,"\n";
		return (0,$msg);
	}
	elsif ($option_HR->{'output'}){
		$io->print("set output \'".$option_HR->{'output'}."\'\n");
	}#if/elsif

	#set term
	if (defined $option_HR->{'term'}){
		$io->print("set term ",$option_HR->{'term'},"\n");
	}
	else {
		$io->print("set term gif\n");
	}#if/else

	#Check to make sure datafile exists.
	unless ( (defined $option_HR->{'data_file'}) and (-e $option_HR->{'data_file'}) ){
		$msg="data_file option to _write_plot_config_file is not set or the file doesn't exist!";
		carp $msg,"\n";
		return (0,$msg);
	}#unless

	$io->print("plot \'",$self->{'map_file'},"\' with lines 1 2\, \'",
			$option_HR->{'data_file'},"\' using 1:2 with lines 3 4\n");

	$io->close();

	return (1,undef);
}#_write_plot_config_file
#-------------------------------------------------------
sub _generate_xy_data {
	my $self=shift;
	my $track_AR=shift;

	my ($position_AR, $xy_AR, $error)=undef;
	my @xy_data=();

	foreach $position_AR (@{$track_AR}){
		($xy_AR, $error)=$self->_position_to_xy($position_AR);
		return (undef, $error) unless (defined $xy_AR);
		push (@xy_data,$xy_AR);
	}#foreach

	return (\@xy_data,undef);
}#_generate_xy_data
#-------------------------------------------------------
sub _write_plot_data_file {
	my $self=shift;
	my $xy_data_AR=shift;
	my $filename=shift;

	my ($io, $msg, $xy_AR)=undef;

	$io=IO::File->new();
	unless ( $io->open(">$filename") ) {
		$msg="Couldn't open $filename for writting in _write_plot_data_file!";
		carp $msg,"\n";
		return (0,$msg);
	}#unless
	foreach $xy_AR (@{$xy_data_AR}){
		$io->print(join("\t",@{$xy_AR}),"\n");
	}#foreach
	$io->close();

	return (1,undef);
}#_write_plot_data_file
#-------------------------------------------------------
sub _read_grid {
	my $self=shift;
	my $config_file=shift;

	my ($io, $msg, $anon_HR, $y_index, $in_line, $xtics, $ytics, $radius_grid)=undef;
	my ($matches, $i)=undef;
	my @xtics=();
	my @ytics=();
	my @x_array=();
	my $grid_HR={};

	$io=IO::File->new();
	unless($io->open("<$config_file")){
		$msg="Couldn't open $config_file!";
		carp $msg,"\n";
		return (undef, $msg);
	}#unless;

	$y_index=-1;

	while (defined($in_line=$io->getline)){
		chomp $in_line;

		#Watch for comment lines
		next if (($in_line =~ m!^\s*#!) or ($in_line =~ m!^\s*$!));

		unless ($xtics){
			$matches=($in_line=~ m!^xtics\:(.*)!i);
			if ($matches){
				@xtics=split(',',$1);
				$xtics=scalar(@xtics);
				#get rid of any spaces around the numbers.
				map {s!([\d\.]*)!$1!} @xtics;
				if ($self->_is_assending(@xtics)){
					next;
				}
				else {
					$msg="xtics are not in numerically assending order ";
					$msg.="or has undefined values!";
					carp $msg,"\n";
					return (undef,$msg);
				}#if/else
			}
			else {
				next;
			}#if/else
		}#unless

		unless ($ytics){
			$matches=($in_line=~ m!^ytics\:(.*)!i);
			if ($matches){
				@ytics=split(',',$1);
				$ytics=scalar(@ytics);
				#get rid of any spaces around the numbers.
				map {s!([\d\.]*)!$1!} @ytics;
				if ($self->_is_descending(@ytics)){
					next;
				}
				else {
					$msg="ytics are not in numerically descending order ";
					$msg.="or has undefined values!";
					carp $msg,"\n";
					return (undef,$msg);
				}#if/else
			}
			else {
				next;
			}#if/else
		}#unless

		unless ($radius_grid){
			$matches=($in_line=~ m!^radius_grid\:!i);
			$radius_grid=1 if ($matches);
			next;
		}#unless

		@x_array=split("\t",$in_line);
		unless (scalar(@x_array) == $xtics){
			$msg="Badly formed radius_grid!  Too many columns!";
			carp $msg,"\n";
			return (undef,$msg);
		}#unless

		#get rid of any spaces around the numbers.
		map {s!([\d\.]*)!$1!} @x_array;


		#Increment y_index
		$y_index++;

		#Make sure there are not too many rows.
		if ($y_index >= $ytics){
			$msg="Badly formed radius_grid!  Too many rows!";
			carp $msg, "\n";
			return (undef,$msg);
		}#if

		$anon_HR={};
		for ($i=0; $i<$xtics; $i++){
			$anon_HR->{${xtics}[$i]}=$x_array[$i];
		}#for

		$grid_HR->{${ytics}[$y_index]}=$anon_HR;

	}#while

	return ($grid_HR,undef);

}#_read_grid
#-------------------------------------------------------
#Returns 1 only if all elements of the input array
#are numerically decreasing and defined.
#Returns 0 otherwise.
sub _is_descending {
	my $self=shift;
	my @array=@_;

	my ($last_elem, $elem)=undef;

	foreach $elem (@array){
		return 0 if (!defined $elem);
		if (defined $last_elem){
			if ($elem < $last_elem){
				$last_elem=$elem;
				next;
			}
			else {
				return 0;
			}#if/else
		}
		else{
			$last_elem=$elem;
		}#if/else
	}#foreach
	return 1;
}#_is_descending
#-------------------------------------------------------
#Returns 1 only if all elements of the input array
#are numerically increasing and defined.
#Returns 0 otherwise.
sub _is_assending {
	my $self=shift;
	my @array=@_;

	my ($last_elem, $elem)=undef;

	foreach $elem (@array){
		return 0 if (!defined $elem);
		if (defined $last_elem){
			if ($elem > $last_elem){
				$last_elem=$elem;
				next;
			}
			else {
				return 0;
			}#if/else
		}
		else{
			$last_elem=$elem;
		}#if/else
	}#foreach
	return 1;
}#_is_assending
#-------------------------------------------------------
#If $position_AR has 2 elements it is assumed the incomming position is in x,y form.
#Otherwise it is assumed the incomming position is in ($long, $long_dir, $lat, $lat_dir) form.
sub radius_function {
	my $self=shift;
	my $position_AR=shift;

	my ($xkey1, $xkey2, $ykey1, $ykey2, $xy_AR, $x, $y, $msg)=undef;
	my ($grid_HR, $x_delta_from_xkey1, $delta_xkey, $y_delta_from_ykey1, $delta_ykey)=undef;
	my ($f1, $f2, $f3, $f4, $t, $u, $f_interpolated)=undef;

	if (scalar(@{$position_AR}) == 2){
		$xy_AR=$position_AR;
	}
	else {
		#Get the postion in x,y form as well as check the syntax of the referenced position array.
		($xy_AR,$msg)=$self->_position_to_xy($position_AR);

		#Abort if _position_to_xy had a problem.
		return (undef,$msg) unless (defined $xy_AR);
	}#if/else

	#Determine high and low key values for both the y and the x axis.
	$x=${$xy_AR}[0];
	$y=${$xy_AR}[1];

	($xkey1,$xkey2,$ykey1,$ykey2)=$self->_find_grid_square($x,$y);

	#Using equation 3.6.3, 3.6.4, and 3.6.5 on page 117 of
	#Numerical Recipes in Fortran 77 (Second Edition)
	#ISBN 0-521-43064-X

	$grid_HR=$self->{'grid_HR'};

	#Using f instead of y in eq. 3.6.3

	$f1=$grid_HR->{$ykey1}->{$xkey1};
	$f2=$grid_HR->{$ykey1}->{$xkey2};
	$f3=$grid_HR->{$ykey2}->{$xkey2};
	$f4=$grid_HR->{$ykey2}->{$xkey1};

	if ($xkey1 > $x){
		$x_delta_from_xkey1=(180-$xkey1)+$x;
		$delta_xkey=(180-$xkey1)+$xkey2;
	}
	else {
		$x_delta_from_xkey1=$x-$xkey1;
		$delta_xkey=$xkey2-$xkey1;
	}#if/else

	$t=$x_delta_from_xkey1/$delta_xkey;

	if ($ykey1 == $ykey2){
		#deal with infinity problem by just interpolating x values.
		$f_interpolated=$x_delta_from_xkey1*($f1-$f2)/$delta_xkey + $f1;
		return ($f_interpolated,undef);
	}
	else {
		$y_delta_from_ykey1=$y-$ykey1;
		$delta_ykey=$ykey2-$ykey1;
	}#if/else

	$u=$y_delta_from_ykey1/$delta_ykey;

	$f_interpolated=(1-$t)*(1-$u)*$f1+$t*(1-$u)*$f2+$t*$u*$f3+(1-$t)*$u*$f4;

	return ($f_interpolated,undef);

}#radius_function
#-------------------------------------------------------------------------------
sub _position_to_xy {
	my $self=shift;
	my $position_AR=shift;

	my ($lat, $lat_dir, $long, $long_dir, $msg, $x, $y)=undef;

        #Check the argument for problems.
        ($lat,$lat_dir,$long,$long_dir)=@{$position_AR};
        unless (
                ($lat =~ m!^\d+(\.\d*)?$!) and
                ($long =~ m!^\d+(\.\d*)?$!) and
                ($lat_dir =~ m!^[NS]$!) and
                ($long_dir =~ m!^[WE]$!) and
                (($lat <= 90) and ($lat >= 0)) and
                (($long <= 180) and ($long >= 0))
                ){
                $msg="Bad arguments passed to radius_function!";
                carp $msg,"\n";
                return (undef,$msg);
        }#unless

        #Translate longitude and latitude into x,y values.
        if ($lat_dir eq 'N'){
                $y=$lat;
        }
        else {
                $y=-$lat;
        }#if/else

        if ($long_dir eq 'E'){
                $x=$long;
        }
        else {
                $x=-$long;
        }#if/else

	return ([$x,$y],undef);

}#_position_to_xy
#-------------------------------------------------------------------------------
sub _find_grid_square {
	my $self=shift;
	my $x=shift;
	my $y=shift;

	my ($xval, $yval, $xkey1, $xkey2, $ykey1, $ykey2)=undef;
	my ($xtics, $ytics, $i, $grid_HR)=undef;
	my @ykeys=();
	my @sorted_ykeys=();
	my @xkeys=();
	my @sorted_xkeys=();

	$grid_HR=$self->{'grid_HR'};

	@ykeys=keys %{$grid_HR};
	@sorted_ykeys = sort {$a<=>$b} @ykeys;

	$ytics=scalar(@sorted_ykeys);

	for ($i=0; $i <= $ytics; $i++){
		$yval=$sorted_ykeys[$i];
		if (
			( ($i == $ytics-1) and ($yval <= $y) ) or
			( ($i == 0) and ($yval > $y) )
			){
			$ykey1=$sorted_ykeys[$i];
			$ykey2=$sorted_ykeys[$i];
			last;
		}
		elsif ($yval <= $y){
			$ykey1=$yval;
			next;
		}
		else {
			$ykey2=$yval;
			last;
		}#if/elsif/else
	}#for

	@xkeys=keys %{$grid_HR->{$ykey1}};
	@sorted_xkeys = sort {$a<=>$b} @xkeys;


	$xtics=scalar(@sorted_xkeys);

	for ($i=0; $i <= $xtics; $i++){
		$xval=$sorted_xkeys[$i];
		if (
			( ($i == $xtics-1) and ($xval <= $x) ) or
			( ($i == 0) and ($xval > $x) )
			){
			$xkey1=$sorted_xkeys[$xtics-1];
			$xkey2=$sorted_xkeys[0];
			last;
		}
		elsif ($xval <= $x){
			$xkey1=$xval;
			next;
		}
		else {
			$xkey2=$xval;
			last;
		}#if/elsif/else
	}#for

	return ($xkey1,$xkey2,$ykey1,$ykey2);

}#_find_grid_square
#-------------------------------------------------------
1;

__END__