magvar.pl to HTML.

index -|- end

Generated: Mon Aug 29 19:34:47 2016 from magvar.pl 2014/10/10 28.3 KB. text copy

#!/usr/bin/perl -w
# NAME: magvar.pl
# AIM: Given lat, lon, hh dd mm yy output magnetic variation
# 09/10/2014 - Attempt to fix 
# Use of uninitialized value in multiplication (*) at magvar.pl line 335.
# Use of uninitialized value in multiplication (*) at magvar.pl line 338.
# 13/11/2013 geoff mclane http://geoffair.net/mperl
use strict;
use warnings;
use File::Basename;  # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] )
use Data::Dumper;
use Cwd;
my $os = $^O;
my $perl_dir = '/home/geoff/bin';
my $PATH_SEP = '/';
my $temp_dir = '/tmp';
if ($os =~ /win/i) {
    $perl_dir = 'C:\GTools\perl';
    $temp_dir = $perl_dir;
    $PATH_SEP = "\\";
}
unshift(@INC, $perl_dir);
require 'lib_utils.pl' or die "Unable to load 'lib_utils.pl' Check paths in \@INC...\n";
# log file stuff
our ($LF);
my $pgmname = $0;
if ($pgmname =~ /(\\|\/)/) {
    my @tmpsp = split(/(\\|\/)/,$pgmname);
    $pgmname = $tmpsp[-1];
}
my $outfile = $temp_dir.$PATH_SEP."temp.$pgmname.txt";
open_log($outfile);

# user variables
my $VERS = "0.0.1 2013-03-17";
my $load_log = 0;
my $in_file = '';
my $verbosity = 0;
my $out_file = '';

# ### DEBUG ###
my $debug_on = 0;
my $def_file = 'def_file';

### program variables
my @warnings = ();
my $cwd = cwd();

sub VERB1() { return $verbosity >= 1; }
sub VERB2() { return $verbosity >= 2; }
sub VERB5() { return $verbosity >= 5; }
sub VERB9() { return $verbosity >= 9; }

sub show_warnings($) {
    my ($val) = @_;
    if (@warnings) {
        prt( "\nGot ".scalar @warnings." WARNINGS...\n" );
        foreach my $itm (@warnings) {
           prt("$itm\n");
        }
        prt("\n");
    } else {
        prt( "\nNo warnings issued.\n\n" ) if (VERB9());
    }
}

sub pgm_exit($$) {
    my ($val,$msg) = @_;
    if (length($msg)) {
        $msg .= "\n" if (!($msg =~ /\n$/));
        prt($msg);
    }
    show_warnings($val);
    close_log($outfile,$load_log);
    exit($val);
}


sub prtw($) {
   my ($tx) = shift;
   $tx =~ s/\n$//;
   prt("$tx\n");
   push(@warnings,$tx);
}

sub process_in_file($) {
    my ($inf) = @_;
    if (! open INF, "<$inf") {
        pgm_exit(1,"ERROR: Unable to open file [$inf]\n"); 
    }
    my @lines = <INF>;
    close INF;
    my $lncnt = scalar @lines;
    prt("Processing $lncnt lines, from [$inf]...\n");
    my ($line,$inc,$lnn);
    $lnn = 0;
    foreach $line (@lines) {
        chomp $line;
        $lnn++;
        if ($line =~ /\s*#\s*include\s+(.+)$/) {
            $inc = $1;
            prt("$lnn: $inc\n");
        }
    }
}

my $lat_deg = 9999;
my $lon_deg = 9999;
my $hour = 0;
my $day2 = 13;
my $month2 = 11;
my $year2 = 13;  ### 2013;
my $day = 10;
my $month = 10;
my $year = 14;  ### 2013;
#/* Convert date to Julian day    1950-2049 */
sub yymmdd_to_julian_days($$$) {
    my ($yy, $mm, $dd) = @_;
    my $jd;
 
    $yy = ($yy < 50) ? (2000 + $yy) : (1900 + $yy);
    $jd = $dd - 32075 + 1461 * ($yy + 4800 + ($mm - 14) / 12 ) / 4;
    $jd = $jd + 367 * ($mm - 2 - ($mm - 14) / 12*12) / 12;
    $jd = $jd - 3 * (($yy + 4900 + ($mm - 14) / 12) / 100) / 4;
    #/* printf("julian date = %d\n", jd ); */
    return $jd;
} 

my $SGD_PI = 3.1415926535;
my $SGD_DEGREES_TO_RADIANS = $SGD_PI / 180.0;
my $SGD_RADIANS_TO_DEGREES = 180.0 / $SGD_PI;
#var = calc_magvar( SGD_DEGREES_TO_RADIANS * lat_deg, SGD_DEGREES_TO_RADIANS * lon_deg, h,
#         yymmdd_to_julian_days(yy,mm,dd), field );

my $nmax = 12;
my $a = 6378.137;       #/* semi-major axis (equatorial radius) of WGS84 ellipsoid */
my $b = 6356.7523142;   #/* semi-minor axis referenced to the WGS84 ellipsoid */
my $r_0 = 6371.2;       #/* standard Earth magnetic reference radius  */

my @gnm_wmm2005 =
(
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [-29556.8, -1671.7, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [-2340.6, 3046.9, 1657.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [1335.4, -2305.1, 1246.7, 674.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [919.8, 798.1, 211.3, -379.4, 100.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [-227.4, 354.6, 208.7, -136.5, -168.3, -14.1, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [73.2, 69.7, 76.7, -151.2, -14.9, 14.6, -86.3, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [80.1, -74.5, -1.4, 38.5, 12.4, 9.5, 5.7, 1.8, 0.0, 0.0, 0.0, 0.0, 0.0],
    [24.9, 7.7, -11.6, -6.9, -18.2, 10.0, 9.2, -11.6, -5.2, 0.0, 0.0, 0.0, 0.0],
    [5.6, 9.9, 3.5, -7.0, 5.1, -10.8, -1.3, 8.8, -6.7, -9.1, 0.0, 0.0, 0.0],
    [-2.3, -6.3, 1.6, -2.6, 0.0, 3.1, 0.4, 2.1, 3.9, -0.1, -2.3, 0.0, 0.0],
    [2.8, -1.6, -1.7, 1.7, -0.1, 0.1, -0.7, 0.7, 1.8, 0.0, 1.1, 4.1, 0.0],
    [-2.4, -0.4, 0.2, 0.8, -0.3, 1.1, -0.5, 0.4, -0.3, -0.3, -0.1, -0.3, -0.1]
);

my @hnm_wmm2005 =
(
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 5079.8, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, -2594.7, -516.7, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, -199.9, 269.3, -524.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 281.5, -226.0, 145.8, -304.7, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 42.4, 179.8, -123.0, -19.5, 103.6, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, -20.3, 54.7, 63.6, -63.4, -0.1, 50.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, -61.5, -22.4, 7.2, 25.4, 11.0, -26.4, -5.1, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 11.2, -21.0, 9.6, -19.8, 16.1, 7.7, -12.9, -0.2, 0.0, 0.0, 0.0, 0.0],
    [0.0, -20.1, 12.9, 12.6, -6.7, -8.1, 8.0, 2.9, -7.9, 6.0, 0.0, 0.0, 0.0],
    [0.0, 2.4, 0.2, 4.4, 4.8, -6.5, -1.1, -3.4, -0.8, -2.3, -7.9, 0.0, 0.0],
    [0.0, 0.3, 1.2, -0.8, -2.5, 0.9, -0.6, -2.7, -0.9, -1.3, -2.0, -1.2, 0.0],
    [0.0, -0.4, 0.3, 2.4, -2.6, 0.6, 0.3, 0.0, 0.0, 0.3, -0.9, -0.4, 0.8]
);

my @gtnm_wmm2005 =
(
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [8.0, 10.6, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [-15.1, -7.8, -0.8, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.4, -2.6, -1.2, -6.5, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [-2.5, 2.8, -7.0, 6.2, -3.8, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [-2.8, 0.7, -3.2, -1.1, 0.1, -0.8, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [-0.7, 0.4, -0.3, 2.3, -2.1, -0.6, 1.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.2, -0.1, -0.3, 1.1, 0.6, 0.5, -0.4, 0.6, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.1, 0.3, -0.4, 0.3, -0.3, 0.2, 0.4, -0.7, 0.4, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
);

my @htnm_wmm2005 =
(
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, -20.9, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, -23.2, -14.6, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 5.0, -7.0, -0.6, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 2.2, 1.6, 5.8, 0.1, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 1.7, 2.1, 4.8, -1.1, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, -0.6, -1.9, -0.4, -0.5, -0.3, 0.7, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.6, 0.4, 0.2, 0.3, -0.8, -0.2, 0.1, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, -0.2, 0.1, 0.3, 0.4, 0.1, -0.2, 0.4, 0.4, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0]
);



my @P =
(
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0]
);
my @DP =
(
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0]
);
my @gnm =
(
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0]
);

my @hnm =
(
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0],
    [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0]
);

my @sm = ([1,2,3,4,5,6,7,8,9,10,11,12,13]);
my @cm = ([1,2,3,4,5,6,7,8,9,10,11,12,13]);
my @root = ([1,2,3,4,5,6,7,8,9,10,11,12,13]);
my @roots = ();

sub create_roots_array() {
    my ($i,$j,$k,$n);
    prt("Create roots array for nmax $nmax\n");
    for ($i = 0; $i <= $nmax; $i++) {
        for ($j = 0; $j <= $nmax; $j++) {
            for ($k = 0; $k < 2; $k++) {
                $roots[$i][$j][$k] = 1;
            }
        }
    }
    for ($i = 0; $i <= $nmax; $i++) {
        my $ii = $i*$i;
        ##$j = ((($i + 1) > 2) ? ($i + 1) : 2);
        for ($j = 0; $j <= $nmax; $j++) {
            $n = (($i + $j + 1) > 2) ? ($i + $j + 1) : 2;
            my $s1 = sqrt(($n-1)*($n-1) - $ii);
            my $s2 = (1.0 / sqrt( $n*$n - $ii));
            $roots[$i][$j][0] = $s1;
            $roots[$i][$j][1] = $s2;
        }
    }
}

#/*
# * return variation (in radians) given geodetic latitude (radians),
# * longitude(radians), height (km) and (Julian) date
# * N and E lat and long are positive, S and W negative
#*/

sub calc_magvar($$$$) {
    my ($lat, $lon, $h, $dat ) = @_;
    #/* output field B_r,B_th,B_phi,B_x,B_y,B_z */
    my ($n,$m);
    #/* reference date for current model is 1 januari 2005 */
    my $date0_wmm2005 = yymmdd_to_julian_days(5,1,1);

    my ($yearfrac,$sr,$r,$theta,$c,$s,$psi,$fn,$fn_0,$B_r,$B_theta,$B_phi,$X,$Y,$Z);
    my ($sinpsi, $cospsi, $inv_s);
    my ($msg);
    #static int been_here = 0;

    my $sinlat = sin($lat);
    my $coslat = cos($lat);

    #/* convert to geocentric coords: */
    #// sr = sqrt(pow(a*coslat,2.0)+pow(b*sinlat,2.0));
    $sr = sqrt($a*$a*$coslat*$coslat + $b*$b*$sinlat*$sinlat);
    #/* sr is effective radius */
    $theta = atan2($coslat * ($h*$sr + $a*$a),
        $sinlat * ($h*$sr + $b*$b));
    #/* theta is geocentric co-latitude */

    $r = $h*$h + 2.0*$h * $sr +
   ($a*$a*$a*$a - ( $a*$a*$a*$a - $b*$b*$b*$b ) * $sinlat*$sinlat ) / 
   ($a*$a - ($a*$a - $b*$b) * $sinlat*$sinlat );

    $r = sqrt($r);

    #/* r is geocentric radial distance */
    $c = cos($theta);
    $s = sin($theta);
    #/* protect against zero divide at geographic poles */
    $inv_s =  1.0 / ($s + ($s == 0.0)*1.0e-8); 

    #/* zero out arrays */
    for ( $n = 0; $n <= $nmax; $n++ ) {
       ### for ( $m = 0; $m <= $n; $m++ ) {  # CHECK ME
       for ( $m = 0; $m <= $nmax; $m++ ) {
           $P[$n][$m] = 0;
           $DP[$n][$m] = 0;
            #if (($m == 0) && ($n == 2)) {
            #    prt("For m=$m, n=$n set DP[n][m] = 0\n");
            #}
       }
    }

    #/* diagonal elements */
    $P[0][0] = 1;
    $P[1][0] = $c;
    $P[1][1] = $s;

    $DP[0][0] = 0;
    $DP[1][0] = -$s;
    $DP[1][1] = $c;

    #// these values will not change for subsequent function calls
    #if( !been_here ) {
        for ( $n = 2; $n <= $nmax; $n++ ) {
            $root[$n] = sqrt((2.0*$n-1) / (2.0*$n));
        }

#        for ( $m = 0; $m <= $nmax; $m++ ) {
#            my $mm = $m*$m;
#            my ($s1,$s2);
#            $n = ((($m + 1) > 2) ? ($m + 1) : 2);
#            ##for ( $n = SG_MAX2($m + 1, 2); $n <= $nmax; $n++ ) {
#            for ( ; $n <= $nmax; $n++ ) {
#                $s1 = sqrt(($n-1)*($n-1) - $mm);
#                $s2 = (1.0 / sqrt( $n*$n - $mm));
#                $roots[$m][$n][0] = $s1;
#                $roots[$m][$n][1] = $s2;
#            }
#        }
   #been_here = 1;
    #}

    for ( $n = 2; $n <= $nmax; $n++ ) {
       #// double root = sqrt((2.0*n-1) / (2.0*n));
       $P[$n][$n] = $P[$n-1][$n-1] * $s * $root[$n];
       $DP[$n][$n] = ($DP[$n-1][$n-1] * $s + $P[$n-1][$n-1] * $c) * $root[$n];
    }

    #/* lower triangle */
    for ( $m = 0; $m <= $nmax; $m++ ) {
        #// double mm = m*m;
        $n = ((($m + 1) > 2) ? $m + 1 : 2);
        #for ( $n = SG_MAX2($m + 1, 2); $n <= $nmax; n++ ) {
        for ( ; $n <= $nmax; $n++ ) {
            #// double root1 = sqrt((n-1)*(n-1) - mm);
            #// double root2 = 1.0 / sqrt( n*n - mm);
            my $rv0 = $roots[$m][$n][0];
            my $rv1 = $roots[$m][$n][1];
            my $p1 = $P[$n-1][$m];
            my $p2 = $P[$n-2][$m];
            my $dp1 = $DP[$n-1][$m];
            my $dp2 = $DP[$n-2][$m];
            if (defined $rv0 && defined $rv1 && defined $p1 && defined $p2 && defined $dp1 && defined $dp2) {
                ### prt("m=$m, n=$n, rv0=$rv0, rv1=$rv1, c=$c, s=$s\n");
                $P[$n][$m] = ($P[$n-1][$m] * $c * (2.0*$n-1) -
                       $P[$n-2][$m] * $rv0) * $rv1;

                $DP[$n][$m] = (($DP[$n-1][$m] * $c - $P[$n-1][$m] * $s) *
                    (2.0*$n-1) - $DP[$n-2][$m] * $rv0) * $rv1;
            } else {
                $msg = '';
                $msg .= "no rv0 " if ( !(defined $rv0) );
                $msg .= "no rv1 " if ( !(defined $rv1) );
                $msg .= "no p1 " if ( !(defined $p1) );
                $msg .= "no p2 " if ( !(defined $p2) );
                $msg .= "no dp1 " if ( !(defined $dp1) );
                $msg .= "no dp2 " if ( !(defined $dp2) );
                pgm_exit(1,"Error: NOT set for m=$m, n=$n $msg\n");
            }
        }
    }

    #/* compute Gauss coefficients gnm and hnm of degree n and order m for the desired time
    #   achieved by adjusting the coefficients at time t0 for linear secular variation */
    #/* WMM2005 */
    $yearfrac = ($dat - $date0_wmm2005) / 365.25;
    for ( $n = 1; $n <= $nmax; $n++ ) {
   for ( $m = 0; $m <= $nmax; $m++ ) {
       $gnm[$n][$m] = $gnm_wmm2005[$n][$m] + $yearfrac * $gtnm_wmm2005[$n][$m];
       $hnm[$n][$m] = $hnm_wmm2005[$n][$m] + $yearfrac * $htnm_wmm2005[$n][$m];
   }
    }

    #/* compute sm (sin(m lon) and cm (cos(m lon)) */
    for ( $m = 0; $m <= $nmax; $m++ ) {
       $sm[$m] = sin($m * $lon);
       $cm[$m] = cos($m * $lon);
    }

    #/* compute B fields */
    $B_r = 0.0;
    $B_theta = 0.0;
    $B_phi = 0.0;
    $fn_0 = $r_0/$r;
    $fn = $fn_0 * $fn_0;

    for ( $n = 1; $n <= $nmax; $n++ ) {
        my $c1_n=0;
        my $c2_n=0;
        my $c3_n=0;
        for ( $m = 0; $m <= $n; $m++ ) {
            my $tmp = ($gnm[$n][$m] * $cm[$m] + $hnm[$n][$m] * $sm[$m]); 
            $c1_n=$c1_n + $tmp * $P[$n][$m];
            $c2_n=$c2_n + $tmp * $DP[$n][$m];
            $c3_n=$c3_n + $m * ($gnm[$n][$m] * $sm[$m] - $hnm[$n][$m] * $cm[$m]) * $P[$n][$m];
        }
        #// fn=pow(r_0/r,n+2.0);
        $fn *= $fn_0;
        $B_r = $B_r + ($n + 1) * $c1_n * $fn;
        $B_theta = $B_theta - $c2_n * $fn;
        $B_phi = $B_phi + $c3_n * $fn * $inv_s;
    }

    #/* Find geodetic field components: */
    $psi = $theta - (($SGD_PI / 2.0) - $lat);
    $sinpsi = sin($psi);
    $cospsi = cos($psi);
    $X = -$B_theta * $cospsi - $B_r * $sinpsi;
    $Y = $B_phi;
    $Z = $B_theta * $sinpsi - $B_r * $cospsi;

    #field[0]=B_r;
    #field[1]=B_theta;
    #field[2]=B_phi;
    #field[3]=X;
    #field[4]=Y;
    #field[5]=Z;   /* output fields */

    #/* find variation in radians */
    #/* return zero variation at magnetic pole X=Y=0. */
    #/* E is positive */
    return ($X != 0. || $Y != 0.0) ? atan2($Y, $X) : 0.0;  
}

########################################################################################
### Another try to convert C++ code to perl
#/*
# * return variation (in radians) given geodetic latitude (radians),
# * longitude(radians), height (km) and (Julian) date
# * N and E lat and long are positive, S and W negative
#*/
# double calc_magvar( double lat, double lon, double h, long dat, double* field )
my $been_here = 0;

sub SG_MAX2($$) {
    my ($a,$b) = @_;
    return ($a > $b) ? $a : $b;
}

sub calc_magvar2($$$$$) {
    my ($lat, $lon, $h, $dat, $field) = @_;
    #/* output field B_r,B_th,B_phi,B_x,B_y,B_z */
    my ($n,$m);
    #/* reference date for current model is 1 januari 2005 */
    my $date0_wmm2005 = yymmdd_to_julian_days(5,1,1);

    my ($yearfrac,$sr,$r,$theta,$c,$s,$psi,$fn,$fn_0,$B_r,$B_theta,$B_phi,$X,$Y,$Z);
    my ($sinpsi, $cospsi, $inv_s);


    my $sinlat = sin($lat);
    my $coslat = cos($lat);

    #/* convert to geocentric coords: */
    #// sr = sqrt(pow(a*coslat,2.0)+pow(b*sinlat,2.0));
    $sr = sqrt($a*$a*$coslat*$coslat + $b*$b*$sinlat*$sinlat);
    #/* sr is effective radius */
    $theta = atan2($coslat * ($h*$sr + $a*$a),
        $sinlat * ($h*$sr + $b*$b));
    #/* theta is geocentric co-latitude */

    $r = $h*$h + 2.0*$h * $sr +
       ($a*$a*$a*$a - ( $a*$a*$a*$a - $b*$b*$b*$b ) * $sinlat*$sinlat ) / 
       ($a*$a - ($a*$a - $b*$b) * $sinlat*$sinlat );

    $r = sqrt($r);

    #/* r is geocentric radial distance */
    $c = cos($theta);
    $s = sin($theta);
    #/* protect against zero divide at geographic poles */
    $inv_s =  1.0 / ($s + ($s == 0.)*1.0e-8); 

    #/* zero out arrays */
    for ( $n = 0; $n <= $nmax; $n++ ) {
        for ( $m = 0; $m <= $n; $m++ ) {
            $P[$n][$m] = 0;
            $DP[$n][$m] = 0;
        }
    }

    #/* diagonal elements */
    $P[0][0] = 1;
    $P[1][1] = $s;
    $DP[0][0] = 0;
    $DP[1][1] = $c;
    $P[1][0] = $c ;
    $DP[1][0] = -$s;

    #// these values will not change for subsequent function calls
    if( !$been_here ) {
        for ( $n = 2; $n <= $nmax; $n++ ) {
            $root[$n] = sqrt((2.0*$n-1) / (2.0*$n));
        }

        for ( $m = 0; $m <= $nmax; $m++ ) {
            my $mm = $m*$m;
            for ( $n = SG_MAX2($m + 1, 2); $n <= $nmax; $n++ ) {
                $roots[$m][$n][0] = sqrt(($n-1)*($n-1) - $mm);
                $roots[$m][$n][1] = 1.0 / sqrt( $n*$n - $mm);
            }
        }
        $been_here = 1;
    }

    for ( $n=2; $n <= $nmax; $n++ ) {
       #// double root = sqrt((2.0*n-1) / (2.0*n));
       $P[$n][$n] = $P[$n-1][$n-1] * $s * $root[$n];
       $DP[$n][$n] = ($DP[$n-1][$n-1] * $s + $P[$n-1][$n-1] * $c) *
           $root[$n];
    }

    #/* lower triangle */
    for ( $m = 0; $m <= $nmax; $m++ ) {
        #// double mm = m*m;
        for ( $n = SG_MAX2($m + 1, 2); $n <= $nmax; $n++ ) {
            #// double root1 = sqrt((n-1)*(n-1) - mm);
            #// double root2 = 1.0 / sqrt( n*n - mm);
            $P[$n][$m] = ($P[$n-1][$m] * $c * (2.0*$n-1) -
                   $P[$n-2][$m] * $roots[$m][$n][0]) *
            $roots[$m][$n][1];

            $DP[$n][$m] = (($DP[$n-1][$m] * $c - $P[$n-1][$m] * $s) *
                (2.0*$n-1) - $DP[$n-2][$m] * $roots[$m][$n][0]) *
            $roots[$m][$n][1];
        }
    }

    #/* compute Gauss coefficients gnm and hnm of degree n and order m for the desired time
    #   achieved by adjusting the coefficients at time t0 for linear secular variation */
    #/* WMM2005 */
    $yearfrac = ($dat - $date0_wmm2005) / 365.25;
    for ( $n = 1; $n <= $nmax; $n++ ) {
        for ( $m = 0; $m <= $nmax; $m++ ) {
            $gnm[$n][$m] = $gnm_wmm2005[$n][$m] + $yearfrac * $gtnm_wmm2005[$n][$m];
            $hnm[$n][$m] = $hnm_wmm2005[$n][$m] + $yearfrac * $htnm_wmm2005[$n][$m];
        }
    }

    #/* compute sm (sin(m lon) and cm (cos(m lon)) */
    for ( $m = 0; $m <= $nmax; $m++ ) {
        $sm[$m] = sin($m * $lon);
        $cm[$m] = cos($m * $lon);
    }

    #/* compute B fields */
    $B_r = 0.0;
    $B_theta = 0.0;
    $B_phi = 0.0;
    $fn_0 = $r_0/$r;
    $fn = $fn_0 * $fn_0;

    for ( $n = 1; $n <= $nmax; $n++ ) {
        my $c1_n=0;
        my $c2_n=0;
        my $c3_n=0;
        for ( $m = 0; $m <= $n; $m++ ) {
            my $tmp = ($gnm[$n][$m] * $cm[$m] + $hnm[$n][$m] * $sm[$m]); 
            $c1_n=$c1_n + $tmp * $P[$n][$m];
            $c2_n=$c2_n + $tmp * $DP[$n][$m];
            $c3_n=$c3_n + $m * ($gnm[$n][$m] * $sm[$m] - $hnm[$n][$m] * $cm[$m]) * $P[$n][$m];
        }
        #// fn=pow(r_0/r,n+2.0);
        $fn *= $fn_0;
        $B_r = $B_r + ($n + 1) * $c1_n * $fn;
        $B_theta = $B_theta - $c2_n * $fn;
        $B_phi = $B_phi + $c3_n * $fn * $inv_s;
    }

    #/* Find geodetic field components: */
    $psi = $theta - (($SGD_PI / 2.0) - $lat);
    $sinpsi = sin($psi);
    $cospsi = cos($psi);
    $X = -$B_theta * $cospsi - $B_r * $sinpsi;
    $Y = $B_phi;
    $Z = $B_theta * $sinpsi - $B_r * $cospsi;

    ${$field}[0] = $B_r;
    ${$field}[1] = $B_theta;
    ${$field}[2] = $B_phi;
    ${$field}[3] = $X;
    ${$field}[4] = $Y;
    ${$field}[5] = $Z;   #/* output fields */

    #/* find variation in radians */
    #/* return zero variation at magnetic pole X=Y=0. */
    #/* E is positive */
    return ($X != 0 || $Y != 0) ? atan2($Y,$X) : 0;  
}


########################################################################################



sub do_test() {
    create_roots_array();
    ##prt(Dumper(\@roots));
    ##exit(0);
    my $lat = 48.7269692925;
    my $lon = 2.3699923175;
    my $alt = 0;    # km
    my $yy = ($year < 50) ? (2000 + $year) : (1900 + $year);

    my $jdate = yymmdd_to_julian_days($year, $month, $day);
    my $var = calc_magvar( $SGD_DEGREES_TO_RADIANS * 48.7269692925,
        $SGD_DEGREES_TO_RADIANS * 2.3699923175, 0, $jdate );

    prt("For lat,lon,alt $lat,$lon,$alt, date $yy/$month/$day, jdata $jdate,\nvar = ".$SGD_RADIANS_TO_DEGREES * $var." degrees\n");
}

sub do_test2() {
    ##prt(Dumper(\@roots));
    ##exit(0);
    my $lat = 48.7269692925;
    my $lon = 2.3699923175;
    my $alt = 0;    # km
    my @fields = ();
    my $yy = ($year < 50) ? (2000 + $year) : (1900 + $year);
    my $jdate = yymmdd_to_julian_days($year, $month, $day);
    my ($i,$len,$var);

    $var = calc_magvar2( $SGD_DEGREES_TO_RADIANS * $lat,
        $SGD_DEGREES_TO_RADIANS * $lon, $alt, $jdate, \@fields );
    prt("For lat,lon,alt $lat,$lon,$alt, date $yy/$month/$day, jdata $jdate,\nvar = ".$SGD_RADIANS_TO_DEGREES * $var." degrees\n");
    $len = scalar @fields;
    prt("$len fields: ");
    for ($i = 0; $i < $len; $i++) {
        prt(" ".$fields[$i]);
    }
    prt("\n");

    $lat = 37.618674211;
    $lon = -122.375007609;
    $var = calc_magvar2( $SGD_DEGREES_TO_RADIANS * $lat,
        $SGD_DEGREES_TO_RADIANS * $lon, $alt, $jdate, \@fields );
    prt("For lat,lon,alt $lat,$lon,$alt, date $yy/$month/$day, jdata $jdate,\nvar = ".$SGD_RADIANS_TO_DEGREES * $var." degrees\n");
    $len = scalar @fields;
    prt("$len fields: ");
    for ($i = 0; $i < $len; $i++) {
        prt(" ".$fields[$i]);
    }
    prt("\n");
}

#########################################
### MAIN ###
#parse_args(@ARGV);
#process_in_file($in_file);
#do_test();
do_test2();
pgm_exit(0,"");
########################################

sub need_arg {
    my ($arg,@av) = @_;
    pgm_exit(1,"ERROR: [$arg] must have a following argument!\n") if (!@av);
}

sub parse_args {
    my (@av) = @_;
    my ($arg,$sarg);
    while (@av) {
        $arg = $av[0];
        if ($arg =~ /^-/) {
            $sarg = substr($arg,1);
            $sarg = substr($sarg,1) while ($sarg =~ /^-/);
            if (($sarg =~ /^h/i)||($sarg eq '?')) {
                give_help();
                pgm_exit(0,"Help exit(0)");
            } elsif ($sarg =~ /^v/) {
                if ($sarg =~ /^v.*(\d+)$/) {
                    $verbosity = $1;
                } else {
                    while ($sarg =~ /^v/) {
                        $verbosity++;
                        $sarg = substr($sarg,1);
                    }
                }
                prt("Verbosity = $verbosity\n") if (VERB1());
            } elsif ($sarg =~ /^l/) {
                if ($sarg =~ /^ll/) {
                    $load_log = 2;
                } else {
                    $load_log = 1;
                }
                prt("Set to load log at end. ($load_log)\n") if (VERB1());
            } elsif ($sarg =~ /^o/) {
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                $out_file = $sarg;
                prt("Set out file to [$out_file].\n") if (VERB1());
            } else {
                pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n");
            }
        } else {
            $in_file = $arg;
            prt("Set input to [$in_file]\n") if (VERB1());
        }
        shift @av;
    }

    if ($debug_on) {
        prtw("WARNING: DEBUG is ON!\n");
        if ((length($in_file) ==  0) && $debug_on) {
            $in_file = $def_file;
            prt("Set DEFAULT input to [$in_file]\n");
        }
    }
    if (length($in_file) ==  0) {
        pgm_exit(1,"ERROR: No input files found in command!\n");
    }
    if (! -f $in_file) {
        pgm_exit(1,"ERROR: Unable to find in file [$in_file]! Check name, location...\n");
    }
}

sub give_help {
    prt("$pgmname: version $VERS\n");
    prt("Usage: $pgmname [options] in-file\n");
    prt("Options:\n");
    prt(" --help  (-h or -?) = This help, and exit 0.\n");
    prt(" --verb[n]     (-v) = Bump [or set] verbosity. def=$verbosity\n");
    prt(" --load        (-l) = Load LOG at end. ($outfile)\n");
    prt(" --out <file>  (-o) = Write output to this file.\n");
}

# eof - template.pl

index -|- top

checked by tidy  Valid HTML 4.01 Transitional