#!/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 ); }