Differences

This shows you the differences between two versions of the page.

--- bufr.pm:bufrdump.pl_source [2010-03-10 09:26:46]
pals
+++ bufr.pm:bufrdump.pl_source [2022-05-31 09:29:31]
@@ Line 1: / Line 1: @@
-<code>
-#!/usr/bin/perl -w
-# (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 'parameter=value' lines. See
-# usage_verbose for explanation of the options allowed.
-# Author: P. Sannes met.no 2010
-use strict;
-use Getopt::Long;
-my $DEFAULT_TABLE_PATH = '/usr/local/lib/bufrtables';
-my $BUFRDUMP = '/metno/local/bin/bufrdump';
-# Parse command line options
-my %option = ();
-GetOptions(
-           \%option,
-           'help',
-           'tablepath=s', # Set BUFR table path
-           'filter=s',    # Decode observations meeting criteria in <filter file> only
-           'param=s',     # Decode the parameters in <parameter file> only
-           'lon1=i',
-           'lat1=i',
-           'lon2=i',
-           'lat2=i',
-       ) 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} = 'false';
-# 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} ? "--filter $option{filter}" : '';
-my $lon1 = $option{lon1} ? "--lon1 $option{lon1}" : '';
-my $lat1 = $option{lat1} ? "--lat1 $option{lat1}" : '';
-my $lon2 = $option{lon2} ? "--lon2 $option{lon2}" : '';
-my $lat2 = $option{lat2} ? "--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, $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 '=' are removed
-        foreach my $line (@lines) {
-            $line =~ s/=\s+/=/;
-            print $line, "\n";
-        }
-    } else { # Options has been used which the Fortran program doesn't
-             # 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, $line;
-                my ($name, $value) = ($line =~ /^(.+)=\s*(.*)$/);
-                $message{$name} = $value;
-            }
-            if ($line =~ /^\s*$/ or @lines == 0) {
-                # A full message has been completed. Should it be printed?
-                if ($filter && filter_obs(\%message, $criteria_ref)) {
-                    # Skip this message
-                    @lines_to_print = ();
-                    %message = ();
-                    next LINE;
-                }
-                # Print the message
-                print "\n";
-                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 "$name=$message{$name}\n";
-                        } elsif ($forced_params_ref->{$name}) {
-                            print "$name=-32767\n";
-                        }
-                    }
-                } else {
-                    foreach my $line2 (@lines_to_print) {
-                        $line2 =~ s/=\s+/=/;
-                        print $line2, "\n";
-                    }
-                }
-                @lines_to_print = ();
-                %message = ();
-            }
-        }
-    }
-}
-sub read_param_file {
-    my $parameter_file = shift;
-    open my $PARAM, '<', $parameter_file
-        or die "Cannot open $parameter_file: $!";
-    my %forced_params;
-    my @params;
-    while (my $name = <$PARAM>) {
-        chomp $name;
-        if ($name =~ /^!/) {
-            $name = substr $name, 1;
-            $forced_params{$name} = 1;
-        }
-        push @params, $name;
-    }
-    close $PARAM or die "Cannot close $parameter_file: $!";
-    return \%forced_params, \@params;
-}
-sub read_filter_file {
-    my $filter_file = shift;
-    my @allowed_operators =
-        ('=',
-         '<',
-         '<=',
-         '>',
-         '>=',
-         '!=',
-     );
-    my @criteria;
-    open my $FILTER, '<', $filter_file
-        or die "Cannot open $filter_file: $!";
-    # Skip the criteria meant for Fortran parsing, i.e. proceed to
-    # first line following a blank line
-    while (<$FILTER>) {
-        last if $_ =~ /^\s*$/;
-    }
-    # Read the filter criteria meant for Perl parsing, skipping blank
-    # lines and comment lines
-    if (not eof) {
-        while (my $line = <$FILTER>) {
-            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(/^$op$/, @allowed_operators) ) {
-            print "Error in $filter_file, line $. is badly formatted:\n$criterium";
-            exit 1;
-        }
-    }
-    return \@criteria;
-}
-# Return true (1) if observation is to be filtered, i.e. does not
-# comply with at least one of the <param> <operator> <value> filter
-# 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, $f_value) = split / +/, $criterium, 3;
-        chomp $f_value;
-        if ($f_operator eq '=') {
-            return 1 unless exists $message_ref->{$f_param};
-            if (grep {$_ eq $f_param} @ascii_params) {
-                $message_ref->{$f_param} =~ s/\s*$//;
-                return 1 unless $message_ref->{$f_param} eq $f_value;
-            } else {
-                return 1 unless $message_ref->{$f_param} == $f_value;
-            }
-        } elsif ($f_operator eq '<') {
-            return 1 unless (exists $message_ref->{$f_param}
-                             and $message_ref->{$f_param} < $f_value);
-        } elsif ($f_operator eq '<=') {
-            return 1 unless (exists $message_ref->{$f_param}
-                             and $message_ref->{$f_param} <= $f_value);
-        } elsif ($f_operator eq '>') {
-            return 1 unless (exists $message_ref->{$f_param}
-                             and $message_ref->{$f_param} > $f_value);
-        } elsif ($f_operator eq '>=') {
-            return 1 unless (exists $message_ref->{$f_param}
-                             and $message_ref->{$f_param} >= $f_value);
-        } elsif ($f_operator eq '!=') {
-            return 1 unless exists $message_ref->{$f_param};
-            if (grep {$_ eq $f_param} @ascii_params) {
-                $message_ref->{$f_param} =~ s/\s*$//;
-                return 1 unless $message_ref->{$f_param} ne $f_value;
-            } else {
-                return 1 unless $message_ref->{$f_param} != $f_value;
-            }
-        }
-    }
-    # All filter conditions have been fullfilled
-    return 0;
-}
-sub usage {
-    print <<"EOF";
-Usage: $0 <bufr file(s)>
-        [--filter <filter file>]
-        [--param <parameter file>]
-        [--lon1 x1]
-        [--lat1 y1]
-        [--lon2 x2]
-        [--lat2 x2]
-        [--tablepath <path to BUFR tables>]
-        [--help]
-EOF
-    exit 0;
-}
-sub usage_verbose {
-    print <<"EOF";
-Usage: $0 <bufr file(s)> [options]
-Will print section 4 in BUFR messages in <bufr file(s)> as "parameter=value" lines.
-Options (may be abbreviated, e.g. --h for --help) are:
-        --filter <filter file>
-                        Decode observations meeting criteria in <filter file> only
-        --param <parameter file>
-                        Print parameters in <parameter file> only, in same order
-                        as they occur in <parameter file>
-        --lon1 x1       Decode observations with longitude >= x1 only
-        --lat1 y1       Decode observations with latitude >= y1 only
-        --lon2 x2       Decode observations with longitude <= x2 only
-        --lat2 y2       Decode observations with latitude <= y2 only
-                        x1,y1,x2,y2 should be decimal degrees
-        --tablepath <path to BUFR tables>
-                        Set path to BUFR tables (overrides ENV{BUFR_TABLES})
-        --help          Print this Usage
-You should probably set
-        export BUFR_TABLES=$DEFAULT_TABLE_PATH
-or use the --tablepath option.
-The lines in <parameter file> should be name of the parameters you
-want to be printed. For example, if you want only station
-identification and temperature to be printed for a BUFR SYNOP file,
-the <parameter file> should look like this:
-wmonr
-DDDD
-TA
-If you want "parameter=value" to be printed also when value is missing
-in BUFR message, precede the parameter name with an exclamation mark
-(e.g. '!TA').  Missing values will then be displayed as -32767.
-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 <param> <operator> <value> where operator
-is one of =, !=, <, <=, > and >=. An example filter file is
-D: 001001 I2.2
-D: 001001 I2.2 001002 I3.3
-895
-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;
-}
-</code>