Differences
This shows you the differences between two versions of the page.
bufr.pm:bufrdump.pl_source [2010-02-24 12:53:01] pals created |
bufr.pm:bufrdump.pl_source [2022-05-31 09:29:31] |
||
---|---|---|---|
Line 1: | Line 1: | ||
- | < | ||
- | # | ||
- | # (C) Copyright 2010, met.no | ||
- | # | ||
- | # This program is free software; you can redistribute it and/or modify | ||
- | # it under the terms of the GNU General Public License as published by | ||
- | # the Free Software Foundation; either version 2 of the License, or | ||
- | # (at your option) any later version. | ||
- | # | ||
- | # This program is distributed in the hope that it will be useful, but | ||
- | # WITHOUT ANY WARRANTY; without even the implied warranty of | ||
- | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | ||
- | # General Public License for more details. | ||
- | # | ||
- | # You should have received a copy of the GNU General Public License | ||
- | # along with this program; if not, write to the Free Software | ||
- | # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA | ||
- | # 02110-1301, USA. | ||
- | |||
- | # Extract BUFR messages from bufr file(s) using the Fortran program | ||
- | # bufrdump and print the data as ' | ||
- | # usage_verbose for explanation of the options allowed. | ||
- | |||
- | # Author: P. Sannes IT-div Nov 2009 | ||
- | |||
- | use strict; | ||
- | use Getopt:: | ||
- | |||
- | my $DEFAULT_TABLE_PATH = '/ | ||
- | my $BUFRDUMP = '/ | ||
- | |||
- | # Parse command line options | ||
- | my %option = (); | ||
- | |||
- | GetOptions( | ||
- | | ||
- | ' | ||
- | ' | ||
- | ' | ||
- | ' | ||
- | ' | ||
- | ' | ||
- | ' | ||
- | ' | ||
- | ) or die "Wrong option(s), execute $0 without arguments for Usage\n"; | ||
- | |||
- | # User asked for help | ||
- | usage_verbose() if $option{help}; | ||
- | |||
- | # Make sure there is at least one input file | ||
- | usage() unless @ARGV; | ||
- | |||
- | # Prevent ECMWF software from printing table info | ||
- | $ENV{PRINT_TABLE_NAMES} = ' | ||
- | |||
- | # Set BUFR table path environment variable used by bufrdump | ||
- | if ($option{tablepath}) { | ||
- | # Command line option --tablepath overrides all | ||
- | $ENV{BUFR_TABLES} = $option{tablepath}; | ||
- | } elsif (!$ENV{BUFR_TABLES}) { | ||
- | # Use the libemos bufrtables | ||
- | $ENV{BUFR_TABLES} = $DEFAULT_TABLE_PATH; | ||
- | } | ||
- | |||
- | my $filter = $option{filter} ? " | ||
- | my $lon1 = $option{lon1} ? " | ||
- | my $lat1 = $option{lat1} ? " | ||
- | my $lon2 = $option{lon2} ? " | ||
- | my $lat2 = $option{lat2} ? " | ||
- | |||
- | my $criteria_ref = []; | ||
- | if ($filter) { | ||
- | $criteria_ref = read_filter_file($option{filter}) | ||
- | } | ||
- | |||
- | my $forced_params_ref; | ||
- | my $params_ref; | ||
- | if ($option{param}) { | ||
- | ($forced_params_ref, | ||
- | = read_param_file($option{param}); | ||
- | } | ||
- | |||
- | # Loop for processing of BUFR input files | ||
- | foreach my $inputfname (@ARGV) { | ||
- | |||
- | # Dump the content of the BUFR file using the Fortran program $BUFRDUMP | ||
- | my $dump = `$BUFRDUMP $filter $lon1 $lat1 $lon2 $lat2 $inputfname`; | ||
- | |||
- | # Then process the output from the dump | ||
- | my @lines = split /\n/, $dump; | ||
- | |||
- | if (!$option{param} && !@$criteria_ref) { | ||
- | # Same output as from bufrdump, except that spaces after ' | ||
- | foreach my $line (@lines) { | ||
- | $line =~ s/=\s+/=/; | ||
- | print $line, " | ||
- | } | ||
- | } else { # Options has been used which the Fortran program doesn' | ||
- | # handle, so special massaging is necessary | ||
- | |||
- | # Skip first(blank) line | ||
- | shift @lines; | ||
- | |||
- | my @lines_to_print; | ||
- | my %message; # Hash with parameter name as key, parameter value as value | ||
- | |||
- | LINE:while (defined(my $line = shift @lines)) { | ||
- | # Each new message starts with a blank line | ||
- | if ($line !~ /^\s*$/) { | ||
- | # Build up the message to be (possibly) printed | ||
- | push @lines_to_print, | ||
- | my ($name, $value) = ($line =~ / | ||
- | $message{$name} = $value; | ||
- | } | ||
- | |||
- | if ($line =~ /^\s*$/ or @lines == 0) { | ||
- | # A full message has been completed. Should it be printed? | ||
- | if ($filter && filter_obs(\%message, | ||
- | # Skip this message | ||
- | @lines_to_print = (); | ||
- | %message = (); | ||
- | next LINE; | ||
- | } | ||
- | # Print the message | ||
- | print " | ||
- | if ($option{param}) { | ||
- | # Print the params in @$params_ref if exists in | ||
- | # message, in same order as in @$params_ref | ||
- | foreach my $name (@$params_ref) { | ||
- | if (exists $message{$name}) { | ||
- | print " | ||
- | } elsif ($forced_params_ref-> | ||
- | print " | ||
- | } | ||
- | } | ||
- | } else { | ||
- | foreach my $line2 (@lines_to_print) { | ||
- | $line2 =~ s/=\s+/=/; | ||
- | print $line2, " | ||
- | } | ||
- | } | ||
- | @lines_to_print = (); | ||
- | %message = (); | ||
- | } | ||
- | } | ||
- | } | ||
- | } | ||
- | |||
- | |||
- | sub read_param_file { | ||
- | my $parameter_file = shift; | ||
- | |||
- | open my $PARAM, '<', | ||
- | or die " | ||
- | |||
- | my %forced_params; | ||
- | my @params; | ||
- | while (my $name = < | ||
- | chomp $name; | ||
- | if ($name =~ /^!/) { | ||
- | $name = substr $name, 1; | ||
- | $forced_params{$name} = 1; | ||
- | } | ||
- | push @params, $name; | ||
- | } | ||
- | close $PARAM or die " | ||
- | |||
- | return \%forced_params, | ||
- | } | ||
- | |||
- | sub read_filter_file { | ||
- | my $filter_file = shift; | ||
- | my @allowed_operators = | ||
- | (' | ||
- | '<', | ||
- | '< | ||
- | '>', | ||
- | '> | ||
- | ' | ||
- | ); | ||
- | my @criteria; | ||
- | |||
- | open my $FILTER, '<', | ||
- | or die " | ||
- | # Skip the criteria meant for Fortran parsing, i.e. proceed to | ||
- | # first line following a blank line | ||
- | while (< | ||
- | last if $_ =~ /^\s*$/; | ||
- | } | ||
- | |||
- | # Read the filter criteria meant for Perl parsing, skipping blank | ||
- | # lines and comment lines | ||
- | if (not eof) { | ||
- | while (my $line = < | ||
- | push @criteria, $line | ||
- | if $line !~ /^\s*$/ && $line !~ /^\s*#/; | ||
- | } | ||
- | } | ||
- | |||
- | # Check that the criteria are properly formatted | ||
- | foreach my $criterium (@criteria) { | ||
- | my $op = (split / +/, $criterium)[1]; | ||
- | if (!defined($op) or not grep(/ | ||
- | print "Error in $filter_file, | ||
- | exit 1; | ||
- | } | ||
- | } | ||
- | return \@criteria; | ||
- | } | ||
- | |||
- | # Return true (1) if observation is to be filtered, i.e. does not | ||
- | # comply with at least one of the < | ||
- | # criteria in filter file | ||
- | sub filter_obs { | ||
- | my $message_ref = shift; | ||
- | my $criteria_ref = shift; | ||
- | |||
- | my @ascii_params = qw(DDDD icao_id name obstime type); | ||
- | |||
- | foreach my $criterium (@$criteria_ref) { | ||
- | my ($f_param, $f_operator, | ||
- | chomp $f_value; | ||
- | if ($f_operator eq ' | ||
- | return 1 unless exists $message_ref-> | ||
- | if (grep {$_ eq $f_param} @ascii_params) { | ||
- | $message_ref-> | ||
- | return 1 unless $message_ref-> | ||
- | } else { | ||
- | return 1 unless $message_ref-> | ||
- | } | ||
- | } elsif ($f_operator eq '<' | ||
- | return 1 unless (exists $message_ref-> | ||
- | and $message_ref-> | ||
- | } elsif ($f_operator eq '< | ||
- | return 1 unless (exists $message_ref-> | ||
- | and $message_ref-> | ||
- | } elsif ($f_operator eq '>' | ||
- | return 1 unless (exists $message_ref-> | ||
- | and $message_ref-> | ||
- | } elsif ($f_operator eq '> | ||
- | return 1 unless (exists $message_ref-> | ||
- | and $message_ref-> | ||
- | } elsif ($f_operator eq ' | ||
- | return 1 unless exists $message_ref-> | ||
- | if (grep {$_ eq $f_param} @ascii_params) { | ||
- | $message_ref-> | ||
- | return 1 unless $message_ref-> | ||
- | } else { | ||
- | return 1 unless $message_ref-> | ||
- | } | ||
- | } | ||
- | } | ||
- | |||
- | # All filter conditions have been fullfilled | ||
- | return 0; | ||
- | } | ||
- | |||
- | sub usage { | ||
- | print <<" | ||
- | Usage: $0 <bufr file(s)> | ||
- | [--filter <filter file>] | ||
- | [--param < | ||
- | [--lon1 x1] | ||
- | [--lat1 y1] | ||
- | [--lon2 x2] | ||
- | [--lat2 x2] | ||
- | [--tablepath <path to BUFR tables>] | ||
- | [--help] | ||
- | EOF | ||
- | exit 0; | ||
- | } | ||
- | |||
- | sub usage_verbose { | ||
- | print <<" | ||
- | |||
- | Usage: $0 <bufr file(s)> [options] | ||
- | |||
- | Will print section 4 in BUFR messages in <bufr file(s)> as " | ||
- | |||
- | Options (may be abbreviated, | ||
- | |||
- | --filter <filter file> | ||
- | Decode observations meeting criteria in <filter file> only | ||
- | --param < | ||
- | Print parameters in < | ||
- | as they occur in < | ||
- | --lon1 x1 | ||
- | --lat1 y1 | ||
- | --lon2 x2 | ||
- | --lat2 y2 | ||
- | x1,y1,x2,y2 should be decimal degrees | ||
- | --tablepath <path to BUFR tables> | ||
- | Set path to BUFR tables (overrides ENV{BUFR_TABLES}) | ||
- | --help | ||
- | |||
- | |||
- | You should probably set | ||
- | export BUFR_TABLES=$DEFAULT_TABLE_PATH | ||
- | or use the --tablepath option. | ||
- | |||
- | The lines in < | ||
- | want to be printed. For example, if you want only station | ||
- | identification and temperature to be printed for a BUFR SYNOP file, | ||
- | the < | ||
- | |||
- | wmonr | ||
- | DDDD | ||
- | TA | ||
- | |||
- | If you want " | ||
- | in BUFR message, precede the parameter name with an exclamation mark | ||
- | (e.g. ' | ||
- | |||
- | Using --filter will decode only those observations that meet at least | ||
- | one of the BUFR descriptor criteria and all of the parameter criteria | ||
- | in <filter file>, where the BUFR descriptor criteria should come first | ||
- | in filter file followed by a blank line, then comes the parameter | ||
- | criteria which should match < | ||
- | is one of =, !=, <, <=, > and >=. An example filter file is | ||
- | |||
- | D: 001001 I2.2 | ||
- | 01 | ||
- | D: 001001 I2.2 001002 I3.3 | ||
- | 03 895 | ||
- | 06 252 | ||
- | D: 001011 A9 | ||
- | LDWR | ||
- | |||
- | NN != 0 | ||
- | TA >= 5 | ||
- | TA < 9.5 | ||
- | |||
- | which decodes all observations with block number 01, two other | ||
- | specific wmo stations and one specific ship, having cloud cover | ||
- | different from 0 (but NN must be part of the message) and temperature | ||
- | between 5 and 9.5 degrees Celsius. Comment lines starting with # | ||
- | will be ignored. | ||
- | |||
- | EOF | ||
- | exit 0; | ||
- | } | ||
- | </ |