#!/usr/bin/perl
# Make a KMZ file containing the data for the Terra Nova in 1910-11
# Together with HadISST SST and sea-ice fields.
use strict;
use warnings;
use IMMA;
use Getopt::Long;
use Date::Calc qw(Delta_Days Add_Delta_Days Days_in_Month Day_of_Year);
# HadISST image locations
my $Image_base = "/home/h03/hadpb/tasks/HadISST_kml";
my $Title = "Terra Nova 1910-11";
# Group the IMMA data by ship and sort by date
my %Ships;
while ( my $Record = imma_read( \*STDIN ) ) {
unless ( defined( $Record->{LAT} ) && defined( $Record->{LON} ) ) {
next;
}
if ( defined( $Record->{ID} ) ) {
push @{ $Ships{ $Record->{ID} } }, $Record;
}
else { push @{ $Ships{' '} }, $Record; }
}
for my $Ship ( keys %Ships ) {
@{ $Ships{$Ship} } = sort by_date @{ $Ships{$Ship} };
}
# Output the KML file header
print "\n";
print "\n";
print " \n";
print " $Title\n";
print " 1\n";
# Position the viewpoint over the route
print " \n";
print " -175\n";
print " -70\n";
print " 5385000\n";
print " 0\n";
print " 0\n";
print " 0\n";
print " absolute\n";
print " \n";
# Add a style for the placemarks
print "\n";
# Add a style for ship route lines
print "\n";
# Add the SST
print " \n";
print " SST\n";
print " 1\n";
print " 0\n";
for ( my $yr = 1910 ; $yr <= 1911 ; $yr++ ) {
for ( my $p = 1 ; $p <= 73 ; $p++ ) {
if ( ( $yr == 1910 && $p < 67 ) || ( $yr == 1911 && $p > 18 ) ) {
next;
}
my @Dm = pentad_getdates($p);
my ( $yr2, $mo2, $dy2 ) = Add_Delta_Days( $yr, $Dm[3], $Dm[2], 1 );
print " \n";
print " 0\n";
print " 0\n";
printf " %04d/%02d/%02d\n", $yr, $Dm[1], $Dm[0];
print " \n";
printf " %04d-%02d-%02dT00:00Z\n", $yr, $Dm[1],
$Dm[0];
printf " %04d-%02d-%02dT00:01Z\n", $yr2, $mo2, $dy2;
print " \n";
print " \n";
printf " images/%04d/SST_%03d.png\n", $yr, $p - 1;
print " \n";
print " \n";
print " 90.0\n";
print " -90.0\n";
print " 180\n";
print " -180\n";
print " 0.0\n";
print " \n";
print " \n";
}
}
print " \n";
# Add the sea-ice cover
print " \n";
print " Sea-Ice\n";
print " 1\n";
print " 0\n";
for ( my $yr = 1910 ; $yr <= 1911 ; $yr++ ) {
for ( my $p = 1 ; $p <= 73 ; $p++ ) {
if ( ( $yr == 1910 && $p < 67 ) || ( $yr == 1911 && $p > 18 ) ) {
next;
}
my @Dm = pentad_getdates($p);
my ( $yr2, $mo2, $dy2 ) = Add_Delta_Days( $yr, $Dm[3], $Dm[2], 1 );
print " \n";
print " 0\n";
print " 0\n";
printf " %04d/%02d/%02d\n", $yr, $Dm[1], $Dm[0];
print " \n";
printf " %04d-%02d-%02dT00:00Z\n", $yr, $Dm[1],
$Dm[0];
printf " %04d-%02d-%02dT00:01Z\n", $yr2, $mo2, $dy2;
print " \n";
print " \n";
printf " images/%04d/ice_%03d.png\n", $yr, $p - 1;
print " \n";
print " \n";
print " 90.0\n";
print " -90.0\n";
print " 180\n";
print " -180\n";
print " 0.0\n";
print " \n";
print " \n";
}
}
print " \n";
# Add the ship placemarks
foreach my $Ship ( sort ( keys %Ships ) ) {
if ( $Ship eq ' ' ) { next; } # Leave nameless ships until later
makePlacemarks($Ship);
}
if ( defined( $Ships{' '} ) ) {
makePlacemarks(' '); # Nameless ships
}
# KML file footer
print "\n";
print "\n";
# Sort IMMA records by date
sub by_date {
my $aYR = $a->{YR};
unless ( defined($aYR) ) { $aYR = 0; }
my $aMO = $a->{MO};
unless ( defined($aMO) ) { $aMO = 0; }
my $aDY = $a->{DY};
unless ( defined($aDY) ) { $aDY = 0; }
my $aHR = $a->{HR};
unless ( defined($aHR) ) { $aHR = 0; }
my $bYR = $b->{YR};
unless ( defined($bYR) ) { $bYR = 0; }
my $bMO = $b->{MO};
unless ( defined($bMO) ) { $bMO = 0; }
my $bDY = $b->{DY};
unless ( defined($bDY) ) { $bDY = 0; }
my $bHR = $b->{HR};
unless ( defined($bHR) ) { $bHR = 0; }
return $bYR <=> $aYR
or $bMO <=> $aMO
or $bDY <=> $aDY
or $bHR <=> $aHR;
}
# Make the placemarks for a ship
sub makePlacemarks {
my $Ship = shift;
print " \n";
print " $Ship\n";
print " 1\n";
print " 0\n";
# One placemark for each IMMA record with a position
for ( my $i = 0 ; $i < scalar( @{ $Ships{$Ship} } ) ; $i++ ) {
unless ( defined( $Ships{$Ship}[$i]->{LAT} )
&& defined( $Ships{$Ship}[$i]->{LON} ) )
{
next;
}
if ( $Ships{$Ship}[$i]->{LON} > 180 ) {
$Ships{$Ship}[$i]->{LON} -= 360;
}
print " \n";
print " Ship\n";
print " \n";
print makeDescription( $Ships{$Ship}[$i] );
print "\n \n";
print " \n";
print
" $Ships{$Ship}[$i]->{LON},$Ships{$Ship}[$i]->{LAT},0\n";
print " \n";
my $Ts;
if ( defined( $Ships{$Ship}[$i]->{YR} ) ) {
$Ts = sprintf "%04d", $Ships{$Ship}[$i]->{YR};
if ( defined( $Ships{$Ship}[$i]->{MO} ) ) {
$Ts .= sprintf "-%02d", $Ships{$Ship}[$i]->{MO};
if ( defined( $Ships{$Ship}[$i]->{DY} ) ) {
$Ts .= sprintf "-%02d", $Ships{$Ship}[$i]->{DY};
if ( defined( $Ships{$Ship}[$i]->{HR} ) ) {
$Ts .= sprintf "T%02d", int( $Ships{$Ship}[$i]->{HR} );
my $Minute =
( $Ships{$Ship}[$i]->{HR} -
int( $Ships{$Ship}[$i]->{HR} ) ) * 60;
$Ts .= sprintf ":%02d", int($Minute);
my $Second = ( $Minute - int($Minute) );
$Ts .= sprintf ":%02dZ", $Second;
}
}
}
}
if ( defined($Ts) ) {
print " \n";
print " $Ts\n";
print " \n";
}
print " \n";
# Add a route link if no discontinuity in position
if ( $Ship ne ' '
&& $i > 0
&& areClose( $Ships{$Ship}[$i], $Ships{$Ship}[ $i - 1 ] ) )
{
print " \n";
print " Route\n";
print " \n";
print " ";
my $Record = $Ships{$Ship}[ $i - 1 ];
print "$Record->{LON},$Record->{LAT},0 ";
$Record = $Ships{$Ship}[$i];
print "$Record->{LON},$Record->{LAT},0";
print "\n";
print " \n";
if ( defined($Ts) ) {
print " \n";
print " $Ts\n";
print " \n";
}
print " \n";
}
}
print " \n";
}
# Are two ships close enough to draw a route line linking their positions
sub areClose {
my $First = shift;
my $Second = shift;
unless ( defined( $First->{YR} )
&& defined( $Second->{YR} )
&& defined( $First->{MO} )
&& defined( $Second->{MO} )
&& defined( $First->{DY} )
&& defined( $Second->{DY} ) )
{
return;
}
# my $deltaT = abs(
# Delta_Days(
# $First->{YR}, $First->{MO}, $First->{DY},
# $Second->{YR}, $Second->{MO}, $Second->{DY}
# )
# );
# if ( $deltaT > 2 ) { return; }
if ( abs( $First->{LAT} - $Second->{LAT} ) > 5 ) { return; }
my $Diff_lon = $First->{LON} - $Second->{LON};
if ( abs($Diff_lon) > 5 ) {
return;
}
return 1;
}
# Make the HTML to go in the description element for a placemark
# this is what appears in the pop-up window when the icon is
# selected
sub makeDescription {
my $Record = shift;
my $Attachment = 0;
my $Description = "";
for ( my $i = 0 ;
$i < scalar( @{ $IMMA::parameters[$Attachment] } ) ; $i++ )
{
if ( $i % 4 == 0 ) { $Description .= "
"; }
#;. $IMMA::parameters[$Attachment][$i] . ":";
if ( defined( $Record->{ $IMMA::parameters[$Attachment][$i] } ) ) {
$Description .= "";
$Description .= sprintf "%-5s%10s | ",
$IMMA::parameters[$Attachment][$i] . ":",
$Record->{ $IMMA::parameters[$Attachment][$i] };
}
else {
# $Description .= sprintf "%10s | ", "N/A";
$Description .= "";
$Description .= sprintf "%-5s%10s | ",
$IMMA::parameters[$Attachment][$i] . ":", "N/A";
}
if ( $i % 4 == 4
|| $i == scalar( @{ $IMMA::parameters[$Attachment] } ) - 1 )
{
$Description .= "
";
}
}
$Description .= "";
$Description .= "]]>";
return $Description;
}
sub pentad_getdates {
my @Ranges =
qw(01/01-05/01 06/01-10/01 11/01-15/01 16/01-20/01 21/01-25/01 26/01-30/01
31/01-04/02 05/02-09/02 10/02-14/02 15/02-19/02 20/02-24/02 25/02-01/03
02/03-06/03 07/03-11/03 12/03-16/03 17/03-21/03 22/03-26/03 27/03-31/03
01/04-05/04 06/04-10/04 11/04-15/04 16/04-20/04 21/04-25/04 26/04-30/04
01/05-05/05 06/05-10/05 11/05-15/05 16/05-20/05 21/05-25/05 26/05-30/05
31/05-04/06 05/06-09/06 10/06-14/06 15/06-19/06 20/06-24/06 25/06-29/06
30/06-04/07 05/07-09/07 10/07-14/07 15/07-19/07 20/07-24/07 25/07-29/07
30/07-03/08 04/08-08/08 09/08-13/08 14/08-18/08 19/08-23/08 24/08-28/08
29/08-02/09 03/09-07/09 08/09-12/09 13/09-17/09 18/09-22/09 23/09-27/09
28/09-02/10 03/10-07/10 08/10-12/10 13/10-17/10 18/10-22/10 23/10-27/10
28/10-01/11 02/11-06/11 07/11-11/11 12/11-16/11 17/11-21/11 22/11-26/11
27/11-01/12 02/12-06/12 07/12-11/12 12/12-16/12 17/12-21/12 22/12-26/12
27/12-31/12);
my $Pentad = shift;
unless ( defined($Pentad) && $Pentad >= 1 && $Pentad <= 73 ) {
die "Bad pentad";
}
$Ranges[ $Pentad - 1 ] =~ /(\d\d)\/(\d\d)\-(\d\d)\/(\d\d)/;
return ( $1, $2, $3, $4 );
}