GribView.pl - metacpan.org

#!/usr/local/perl5/bin/perl
=head1 NAME

GribView.pl - script to view Grib Record Headers

=head1 DESCRIPTION

GribView.pl currently allows the user to browse Grib record headers and 
view the fields as interpreted by the PDL::IO::Grib package.  Maybe one day 
it could also edit the headers, view the data, and allow exports to other formats.

=cut
use blib;
use strict;
use warnings;
use Tk;
use Tk::FileDialog;
use PDL::IO::Grib;

$PDL::IO::Grib::debug=1;

my $pgplot;
my $trid;
BEGIN{
  $ENV{PGPLOT_DEV}=$^O =~ /MSWin32/ ? '/GW' : "/XSERVE";
  $ENV{PGPLOT_DIR}="/usr/local/pgplot/" if(!defined($ENV{PGPLOT_DIR}) and -e "/usr/local/pgplot");
  eval "use PGPLOT";
  if($@ ne ""){
    print "Could not load PGPLOT\n";
  }else{
    eval "use PDL::Graphics::PGPLOT";
    if($@ ne ""){
      print "PDL::Graphics::PGPLOT not found \n";
    }else{
      $pgplot=1;
    }
  }
  eval "use PDL::Graphics::TriD";
  if($@ ne ""){
    print "Could not load TriD\n";
  }else{
	 $trid=1;
  } 
}

my $TkObjects;
my $GribFile;
my $Field;
my $section;
my $debug;

$TkObjects->{MainWindow} = MainWindow->new( );

$TkObjects->{TLFrame1} = $TkObjects->{MainWindow}->Frame()->pack(-side=>'top',-fill=>'x');
$TkObjects->{TLFrame2} = $TkObjects->{MainWindow}->Frame(-width=>100,
																			-height=>300,
																		  -label=>'Field Identifiers')->pack(-side=>'left',-fill=>'both');
$TkObjects->{TLFrame3} = $TkObjects->{MainWindow}->Frame()->pack(-side=>'top',-fill=>'both');
$TkObjects->{TLFrame4} = $TkObjects->{MainWindow}->Frame()->pack(-side=>'top',-fill=>'both');


$TkObjects->{PDSFrame} = $TkObjects->{TLFrame3}->Frame(-label=>'PDS Section'
																		  )->pack(-side=>'left',
																					 -fill=>'both');
$TkObjects->{GDSFrame} = $TkObjects->{TLFrame3}->Frame(
																			-label=>'GDS Section'
																		  )->pack(-side=>'left',
																					 -fill=>'both');
$TkObjects->{BMSFrame} = $TkObjects->{TLFrame4}->Frame(-label=>'BMS Section'
																		  )->pack(-side=>'left',
																					 -fill=>'both');
$TkObjects->{BDSFrame} = $TkObjects->{TLFrame4}->Frame(
																			-label=>'BDS Section'
																		  )->pack(-side=>'left',
																					 -fill=>'both');

use constant PDS_DEFAULTS => {1=> {name=> 'PDS Length',
											  type=> 'uint3'},
										4=> {name=> 'Parameter Table Version'},
										5=> {name=> 'Center ID'},
										6=> {name=> 'Generating Process ID'},
										7=> {name=> 'Grid ID'},
										8=> {name=> 'GDS/BMS Flag',
											  type=>'bits'},
										9=> {name=> 'Parameter and units ID'},
										10=> {name=> 'Type of level or layer'},
										11=> {name=> 'Level top'},
										12=> {name=> 'Level bottom'},
										13=> {name=> 'Year'},
										14=> {name=> 'Month'},
										15=> {name=> 'Day'},
										16=> {name=> 'Hour'},
										17=> {name=> 'Minute'},
										18=> {name=> 'Forecast time unit'},
										19=> {name=> 'Forecast Time'},
										20=> {name=> 'Time Step'},
										21=> {name=> 'Time Range'},
										22=> {name=> 'Number in Average',
												type=> 'uint2'},
										24=> {name=> 'Number missing from Average'},
										25=> {name=> 'Century of initial time'},
										26=> {name=> 'Sub-center ID'},
										27=> {name=> 'Decimal Scale Factor',
												type=> 'int2'}};



use constant GDS_DEFAULTS => {1=> {name=>'GDS Length',
											  type=>'uint3'},
										4=> {name=>'Number of vertical coordinate parameters'},
										5=> {name=>'Location of vertical coordinate parameters'}, 	  
										6=> {name=>'Data representation type'},
										7=> {name=>'Ni Number of points on a Latitude',
											  type=>'uint2'},
										9=>  {name=>'Nj Number of points on a Longitude',
												type => 'uint2'},
										11=> {name=>'latitude of first point',
												type => 'int3'},
										14=> {name=>'longitude of first point',
												type => 'int3'},
										17=> {name=>'Resolution and component flag',
												type=>'bits'},
										18=> {name=>'latitude of last gridpoint',
												type => 'int3'},
										21=> {name=>'longitude of last gridpoint',
												type => 'int3'},
										24=> {name=>'Longitude increment',
												type => 'int2'},
										26=> {name=>'Latitude direction increment',
												type => 'int2'},
										28=> {name=>'Scanning mode flags',
												type => 'bits'}};

use constant BMS_DEFAULTS => {1=> {name=>'BMS Length',
											  type=>'uint3'},
										4=> {name=>'unused bit count'},
										5=> {name=>'bms usage flag',
											  type=>'uint2'}};


use constant BDS_DEFAULTS => {1=> {name=>'BDS Length',
											  type=>'uint3'},
										4=> {name=>'flags',
											  type=>'bits'},
										5=> {name=>'binary scale factor',
											  type=>'int2'},
										7=> {name=>'reference value',
											  type=>'float'},
										11=>{name=>'bits per value'}};

my $types={PDS=>PDS_DEFAULTS,
			  GDS=>GDS_DEFAULTS,
			  BMS=>BMS_DEFAULTS,
			  BDS=>BDS_DEFAULTS};

						  

$TkObjects->{Open} =  $TkObjects->{TLFrame1}->Menubutton(-text=>'FILE ',
							 -relief=>'raised',
							 -menuitems => [[ command => "Open",
									  -command=>[\&opengrib]],
									[ command => "Exit",-command=> sub {exit}]]);
$TkObjects->{Open}->pack(-side=>'left',-anchor=>'nw',-fill=>'y');
if($pgplot or $trid){
  $TkObjects->{View} =  $TkObjects->{TLFrame1}->Menubutton(-text=>'VIEW DATA',
																			-relief=>'raised')->pack(-side=>'left',-anchor=>'nw',-fill=>'y');
  if($pgplot){																									
	 $TkObjects->{View}->command(-label=>'PGPLOT Contour', -command=>[\&pgplot_contour]);
  }
  if($trid){
	 $TkObjects->{View}->command(-label=>'TriD Contour', -command=>[\&trid_contour]);
  }
#  $TkObjects->{View_mb}->pack(-side=>'left',-anchor=>'nw',-fill=>'y');
}


$TkObjects->{ListBox} =  $TkObjects->{TLFrame2}->Scrolled("Listbox",
																			 -scrollbars=>"oe",
																			 -height=>22,
																			 -width=>26);
$TkObjects->{ListBox}->pack(-fill=>'both');

$TkObjects->{ListBox}->bind('<Button-1>', 
									 [ \&FieldSelect, Ev('y') ]);

foreach my $section (qw(PDS GDS BMS BDS)){
  
  $TkObjects->{$section."Scroll"} = $TkObjects->{$section."Frame"}->Scrollbar();
  $TkObjects->{$section."Listboxes"} = [ $TkObjects->{$section."Frame"}->Listbox(-width=>30),
													  $TkObjects->{$section."Frame"}->Listbox() ];
  
  foreach my $list (@{$TkObjects->{$section."Listboxes"}}){
	 $list->configure(-yscrollcommand => [ \&scroll_listboxes, 
														$TkObjects->{$section."Scroll"},
														$list, $TkObjects->{$section."Listboxes"}]);
  }
  $TkObjects->{$section."Scroll"}->configure(-command=> sub { 
															  foreach my $list (@{$TkObjects->{$section."Listboxes"}}){
																 $list->yview(@_);}});

  foreach my $list (@{$TkObjects->{$section."Listboxes"}}){
	 $list->pack(-side=>'left'); 
  }
  $TkObjects->{$section."Scroll"}->pack(-side=>'left',-fill=>'y');

}


MainLoop;



sub opengrib {
  my $path = '.';
  
  my($LoadDialog) = $TkObjects->{MainWindow}->FileDialog(-Title =>'Choose an input file',
												-Create => 0);

  my $file = $LoadDialog->Show(-Path=>$path);
  return unless(defined $file);

  
  print "HERE $path $file\n" if($debug);

  if($file =~ /([^\/]+).gz$/){
	 my $nfile="/tmp/$1";
	 system("gzip -cd $file > $nfile");
	 if(-e $nfile){
		$file = $nfile;
	 }else{
		print "Unable to decompress $file at ",__FILE__," ",__LINE__,"\n";
		return;
	 }
  }

    
  $GribFile = new PDL::IO::Grib($file);

  $TkObjects->{MainWindow}->title("GribView: $file");  
  
  
  $TkObjects->{ListBox}->delete(0,"end");
  foreach(sort idsort keys %$GribFile){
	 next if(/^_/);
    my $name = $GribFile->{$_}->name();
	 if(defined $name){
		$TkObjects->{ListBox}->insert("end",sprintf("%-16.16s %s",$_,$name));
	 }else{
		$TkObjects->{ListBox}->insert("end",$_);
	 }
  }

}

sub FieldSelect{
  my($lb,$y) = @_;

  my $val = $lb->get($lb->nearest($y));
  $val =~ s/\s+.*$//;

  $Field=$GribFile->{$val};

  foreach (qw(PDS GDS BMS BDS)){
#  foreach (qw(PDS )){
	 $section = $_;
	 ShowSection();
  }
  my $data = $Field->read_data($GribFile->{_FILEHANDLE});
  print join(' ',$data->stats),"\n";

}

sub ShowSection{
  
  my $f = $Field;
  return unless defined $f->{$section};
  
  my $wcnt = $f->{$section}->nelem;

  my $shown=0;

  $types->{GDS} = lookup_gds_types($f->gds_attribute(4),
											  $f->gds_attribute(5),
											  $f->gds_attribute(6)) if($section eq 'GDS');

  foreach(@ { $TkObjects->{$section."Listboxes"}}){
	 # empty before refilling
	 $_->delete(0,'end');
  }

  foreach my $num (1..$wcnt){
	 my $val;

    my $dtype = $types->{$section}{$num}{type};

 	 if($shown-- <= 0){
		if(defined $dtype){
		  my($o,$l);
		  $o=$num-1;
		  if($dtype eq 'uint3'){
			 $l=$o+2;
			 $val = $f->{$section}->slice("$o:$l")->unpackint3();
			 $shown=2;
		  }elsif($dtype eq 'int3'){
			 $l=$o+2;
			 $val = $f->{$section}->slice("$o:$l")->unpackint3('signed');
			 $shown=2;
		  }elsif($dtype eq 'uint2'){
			 $l=$o+1;
			 $val = $f->{$section}->slice("$o:$l")->unpackint2();
			 $shown=1;
		  }elsif($dtype eq 'int2'){
			 $l=$o+1;
			 $val = $f->{$section}->slice("$o:$l")->unpackint2('signed');
			 $shown=1;
		  }elsif($dtype eq 'float'){
			 $l=$o+3;
			 $val = sprintf("%f",PDL::IO::Grib::Wgrib::decode_ref_val($f->{$section}->slice("$o:$l")));
			 $shown=3;
		  }elsif($dtype eq 'char'){
			 $val = unpack "C",$f->{$section}->slice("($o)");
		  }elsif($dtype eq 'bits'){
			 $val = '';
			 my $tval = $f->{$section}->slice("($o)");
			 my @twos = (128,64,32,16,8,4,2,1);
          for(my $i=0;$i<8;$i++){
				if($tval & $twos[$i]){
				  $val .= '1';
				}else{
				  $val .= '0';
				}
			 }
		  }
		}else{
		  $val = $f->{$section}->at($num-1);
		}
	 }
    next unless (defined $val);
	 my $name = "$num ";
	 if(defined $types->{$section}{$num}{name}){
		$name .= $types->{$section}{$num}{name};
	 }

	 $TkObjects->{$section."Listboxes"}[0]->insert('end',$name);
	 $TkObjects->{$section."Listboxes"}[1]->insert('end',$val);

  }
  

}
			
	
sub idsort{

  my(@a) = split(/:/,$a);
  my(@b) = split(/:/,$b);

  $#a<=1
	 or
  $#b<=1
	 or
  $a[0] <=> $b[0]
    or
  $a[1] <=> $b[1]
    or
  $a[2] <=> $b[2]
    or
  $a[3] <=> $b[3]
    or
  $a[4] <=> $b[4]
    or
  $a cmp $b;
}

sub scroll_listboxes {
  my ($sb,$scrolled,$lbs,@args) = @_;
  $sb->set(@args);
  my($top,$bottom) = $scrolled->yview();
  foreach my $list (@$lbs){
	 $list->yviewMoveto($top);
  }
}

sub lookup_gds_types{
  my($gds4, $gds5, $gds6) = @_;
  
  my $types;

  $types = GDS_DEFAULTS;

  if($gds6 == 5){
    for(7..27){
		undef $types->{$_};
	 }
	 $types->{7}{name}='NX ';
	 $types->{7}{type}='uint2';
	 $types->{9}{name}='NY ';
	 $types->{9}{type}='uint2';
	 $types->{11}{name}='Lat of first grid point';
	 $types->{11}{type}='int3';
	 $types->{14}{name}='Lon of first grid point';
	 $types->{14}{type}='int3';
	 $types->{17}{name}='Resolution and componet flags';
	 $types->{17}{type}='bits';
	 $types->{18}{name}='grid orientation';
	 $types->{18}{type}='int3';
	 $types->{21}{name}='X-direction grid length';
	 $types->{21}{type}='int3';
	 $types->{23}{name}='Y-direction grid length';
	 $types->{23}{type}='int3';
	 $types->{27}{name}='Projection Center flag';
	 $types->{27}{type}='bits';
	 $types->{28}{name}='Scanning Mode';
	 $types->{28}{type}='bits';
  }elsif($gds6 == 192){
    for(7..27){
		undef $types->{$_};
	 }
	 $types->{11}{type}='int3';
	 $types->{11}{name}='ND: number of diamonds';
	 $types->{14}{type}='int3';
	 $types->{14}{name}='NI: intervals on a main side';
	 $types->{17}{name}='Resolution and componet flags';
	 $types->{17}{type}='bits';
	 $types->{18}{name}='LAPP: Location of Isocondrahedral';
	 $types->{18}{type}='int3';
	 $types->{21}{name}='LOPP: pole point';
	 $types->{21}{type}='int3';
	 $types->{24}{name}='LAMPL';
	 $types->{24}{type}='int3';

	 $types->{28}{name}='Scanning Mode';
	 $types->{28}{type}='bits';
  }	 

  for(my $i=0; $i<=$gds4; $i++){
	 $types->{4*$i+$gds5}{name}="vertical parm $i";
	 $types->{4*$i+$gds5}{type}='float';
  }
  return $types;
}

sub pgplot_contour{
  my(@args) = @_;

  return unless defined $Field;

  my $data = $Field->read_data($GribFile->{_FILEHANDLE});
  
  cont $data;
  
}

sub trid_contour{
  my(@args) = @_;

  return unless defined $Field;

  my $data = $Field->read_data($GribFile->{_FILEHANDLE});
  
  
  my @stats = $data->stats;
  print $Field->name," @stats\n";
 
  
  PDL::Graphics::TriD::contour3d($data,undef,undef, {Labels=>[]});
  
}
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)