Differences

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

--- bufr.pm:bufrread.pl [2010-09-21 08:07:02]
pals
+++ bufr.pm:bufrread.pl [2023-02-05 10:14:41] (current)
pals
@@ Line 1: / Line 1: @@
-<code>
+<code perl>
-#!/usr/bin/perl -w
+#!/usr/bin/perl
-# (C) Copyright 2010, met.no
+# (C) Copyright 2010-2023 MET Norway
 #
 # This program is free software; you can redistribute it and/or modify
@@ Line 22: / Line 22: @@
 use strict;
+use warnings;
 use Getopt::Long;
 use Pod::Usage qw(pod2usage);
+use Geo::BUFR;
-use constant DEFAULT_TABLE_PATH => '/usr/local/lib/bufrtables';
+# This is actually default in BUFR.pm, but provided here to make it
-my $BUFRDUMP = '/metno/local/bin/bufrdump';
+# easier for users to change to 'ECCODES' if preferred
+use constant DEFAULT_TABLE_FORMAT => 'BUFRDC';
+# Will be used if neither --tablepath nor $ENV{BUFR_TABLES} is set
+use constant DEFAULT_TABLE_PATH_BUFRDC => '/usr/local/lib/bufrtables';
+use constant DEFAULT_TABLE_PATH_ECCODES => '/usr/local/share/eccodes/definitions/bufr/tables';
+# Ought to be your most up-to-date code table(s)
+use constant DEFAULT_CTABLE_BUFRDC => 'C0000000000000037000';
+use constant DEFAULT_CTABLE_ECCODES => '0/wmo/37';
 # Parse command line options
@@ Line 32: / Line 42: @@
 GetOptions(
            \%option,
-           'help',
+           'ahl=s',        # Decode BUFR messages with AHL matching <ahl_regexp> only
-           'tablepath=s', # Set BUFR table path
+           'all_operators',# Show replication descriptors and all operator descriptors
-           'filter=s',    # Decode observations meeting criteria in <filter file> only
+                           # when printing section 4
-           'param=s',     # Decode the parameters in <parameter file> only
+           'bitmap',       # Display bit-mapped values on same line
-           'csv',         # Use CSV format for printing
+           'codetables',   # Use code and flag tables to resolve values
-           'sort',        # Sort on stationid (wmonr/call_sign/buoy_id)
+           'data_only',    # Print section 4 (data section) only
-           'sort_on=s',   # Sort on specified parameter
+           'filter=s',     # Decode observations meeting criteria in <filter file> only
-           'transform=s', # Do the transformations in <transformation file>
+           'help',         # Print help information and exit
-           'lon1=i',
+           'nodata',       # Do not print (nor decode) section 4 (data section)
-           'lat1=i',
+           'noqc',         # Do not decode quality control
-           'lon2=i',
+           'on_error_stop', # Stop processing if an error occurs
-           'lat2=i',
+           'optional_section',  # Display a hex dump of optional section if present
+           'outfile=s',    # Print to file instead of STDOUT
+           'param=s',      # Decode parameters with descriptors in <descriptor file> only
+           'strict_checking=i', # Enable/disable strict checking of BUFR format
+           'tableformat=s',  # Set BUFR table format
+           'tablepath=s',  # Set BUFR table path
+           'verbose=i',    # Set verbose level to n, 0<=n<=6 (default 0)
+           'width=i',      # Set width of values field (default is 15 characters)
        ) or pod2usage(-verbose => 0);
@@ Line 52: / Line 69: @@
 pod2usage(-verbose => 0) unless @ARGV;
-# --csv can only be used together with --param
+# Set verbosity level
-pod2usage(-verbose => 0) if $option{csv} && !$option{param};
+Geo::BUFR->set_verbose($option{verbose}) if $option{verbose};
+# Set whether section 4 should be decoded for the BUFR module
+Geo::BUFR->set_nodata() if ($option{nodata});
+# Set whether quality information should be decoded for the BUFR module
+Geo::BUFR->set_noqc() if ($option{noqc});
+Geo::BUFR->set_strict_checking($option{strict_checking}) if defined $option{strict_checking};
-# --sort and --sort_on are exclusive
+Geo::BUFR->set_show_all_operators($option{all_operators}) if defined $option{all_operators};
-pod2usage(-verbose => 0) if $option{sort} && $option{sort_on};
-# Prevent ECMWF software from printing table info
+# Set BUFR table format
-$ENV{PRINT_TABLE_NAMES} = 'false';
+my $tableformat = (defined $option{tableformat}) ? uc $option{tableformat} : DEFAULT_TABLE_FORMAT;
+Geo::BUFR->set_tableformat($tableformat);
-# Set BUFR table path environment variable used by bufrdump
+# Set BUFR table path
 if ($option{tablepath}) {
     # Command line option --tablepath overrides all
-    $ENV{BUFR_TABLES} = $option{tablepath};
+    Geo::BUFR->set_tablepath($option{tablepath});
-} elsif (!$ENV{BUFR_TABLES}) {
+} elsif ($ENV{BUFR_TABLES}) {
-    $ENV{BUFR_TABLES} = DEFAULT_TABLE_PATH;
+    # If no --tablepath option, use the BUFR_TABLES environment variable
+    Geo::BUFR->set_tablepath($ENV{BUFR_TABLES});
+} else {
+    # If all else fails, use the default tablepath in BUFRDC/ECCODES
+    if ($tableformat eq 'BUFRDC') {
+        Geo::BUFR->set_tablepath(DEFAULT_TABLE_PATH_BUFRDC);
+    } elsif ($tableformat eq 'ECCODES')  {
+        Geo::BUFR->set_tablepath(DEFAULT_TABLE_PATH_ECCODES);
+    }
 }
-# ECMWF software requires trailing '/' in bufrpath
-$ENV{BUFR_TABLES} .= '/' if substr($ENV{BUFR_TABLES},-1) ne '/';
-my $filter = $option{filter} ? "--filter $option{filter}" : '';
+my $ahl_regexp;
-my $lon1 = $option{lon1} ? "--lon1 $option{lon1}" : '';
+if ($option{ahl}) {
-my $lat1 = $option{lat1} ? "--lat1 $option{lat1}" : '';
+    eval { $ahl_regexp = qr/$option{ahl}/ };
-my $lon2 = $option{lon2} ? "--lon2 $option{lon2}" : '';
+    die "Argument to --ahl is not a valid Perl regular expression: $@" if $@;
-my $lat2 = $option{lat2} ? "--lat2 $option{lat2}" : '';
+}
-my $criteria_ref;
+# Where to direct output (including verbose output, but not output to STDERR)
-$criteria_ref = read_filter_file($option{filter}) if $filter;
+my $OUT;
+if ($option{outfile}) {
+    open($OUT, '>', $option{outfile})
+        or die "Cannot open $option{outfile} for writing: $!";
+} else {
+    $OUT = *STDOUT;
+}
-my $param_file = $option{param} ? $option{param} : '';
+my @requested_desc;
-my ($forced_params_ref, $params_ref);
+if ($option{param}) {
-($forced_params_ref, $params_ref)
+    @requested_desc = read_descriptor_file($option{param});
-    = read_param_file($param_file) if $param_file;
+}
-my $csv = $option{csv} ? 1 : 0;
+# Arrays over filter criteria, used if option --filter is set
-# First line in CSV should be the parameters
+my @fid;      # Filter descriptors, e.g. $fid[1] = [ 001001, 001002 ]
-print join(',', @$params_ref) . "\n" if $csv;
+my @fiv;      # Filter values, e.g. $fiv[1] = [ [ 3, 895 ], [ 6 252 ] ]
+my @num_desc; # Number of filter descriptors for each criterion, e.g. $num_desc[1] = 2
+my @num_val;  # Number of filter value lines for each criterion, e.g. $num_val[1] = 2
+my @required; # 1 for required criteria (D!: in filter file), 0 for others
+my $num_criteria = 0;
+my $num_required_criteria = 0;
+if ($option{filter}) {
+    read_filter_file($option{filter});
+}
-my $transform_file = $option{transform} ? $option{transform} : 0;
+my $width = $option{width} ? $option{width} : 15;
-my $transform_ref;
-$transform_ref = read_transformation_file($transform_file) if $transform_file;
-my $sort = $option{sort} ? 1 : 0;
+# Used to display section 2 if --optional_section is set
-my $sort_on = $option{sort_on} ? $option{sort_on} : '';
+my $sec2_code_ref = sub {return '    Hex dump:'.' 'x26 . unpack('H*',substr(shift,4))};
-# What kind of sorting is required?
+# Loop for processing of BUFR input files
-my $sort_by;
+foreach my $inputfname ( @ARGV ) {
-if ($sort_on) {
+    my $bufr = Geo::BUFR->new();
-    my @ascii_params = qw(call_sign icao_id obstime name type);
+    $bufr->set_filter_cb(\&filter_on_ahl,$ahl_regexp) if $option{ahl};
-    my $ascending_sort = 1;
-    # A minus sign appended to the sort parameter means descending sort
+    # Open BUFR file
-    if ($sort_on =~ /-$/) {
+    $bufr->fopen($inputfname);
-        $ascending_sort = 0;
-        chop $sort_on;
+    # Process input file
-    }
+    decode($bufr);
-    # Just in case someone adds a '+' to signify ascending sort
+    $bufr->fclose();
-    if ($sort_on =~ /[+]$/) {
+}
-        $ascending_sort = 1;
-        chop $sort_on;
-    }
+# Extract data from BUFR file. Print AHL for first message in each GTS
-    if (grep {$_ eq $sort_on} @ascii_params) {
+# bulletin, print message number for each new message, print subset
-        if ($ascending_sort) {
+# number for each subset.
-            $sort_by = sub {$a cmp $b};
+sub decode {
-        } else {
+    my $bufr = shift;          # BUFR object
-            $sort_by = sub {$b cmp $a};
+    my ($message_header, $current_message_number, $current_ahl);
+    my $section013_dumped = 0; # Used to keep track of whether sections
+                               # 0-3 have been printed when --filter
+                               # option has been used
+  READLOOP:
+    while (not $bufr->eof()) {
+        # Read next observation. If an error is encountered during
+        # decoding, skip this observation while printing the error
+        # message to STDERR, also displaying ahl of bulletin if found
+        # (but skip error message if the message should be skipped on
+        # --ahl anyway).
+        my ($data, $descriptors);
+        eval {
+            ($data, $descriptors) = $bufr->next_observation();
+        };
+        if ($@) {
+            $current_ahl = $bufr->get_current_ahl() || '';
+            next READLOOP if $option{ahl} && $current_ahl !~ $ahl_regexp;
+            warn $@;
+            # Try to extract message number and ahl of the bulletin
+            # where the error occurred
+            $current_message_number = $bufr->get_current_message_number();
+            if (defined $current_message_number) {
+                my $error_msg = "In message $current_message_number";
+                $error_msg .= " contained in bulletin with ahl $current_ahl\n"
+                    if $current_ahl;
+                warn $error_msg if $error_msg;
+            }
+            exit(1) if $option{on_error_stop};
+            next READLOOP;
         }
-    } else {
-        if ($ascending_sort) {
+        next if $option{ahl} && $bufr->is_filtered();
-            $sort_by = sub {$a <=> $b};
-        } else {
+        if ($option{codetables} && !$option{nodata}) {
-            $sort_by = sub {$b <=> $a};
+            # Load C table, trying first to use same table version as
+            # the B and D tables loaded in next_observation, or if
+            # this C table file does not exist, loads DEFAULT_CTABLE
+            # instead.
+            my $table_version = $bufr->get_table_version();
+            my $tableformat = Geo::BUFR->get_tableformat();
+            if ($tableformat eq 'BUFRDC') {
+                $bufr->load_Ctable("C$table_version", DEFAULT_CTABLE_BUFRDC);
+            } elsif ($tableformat eq 'ECCODES')  {
+                $bufr->load_Ctable("$table_version", DEFAULT_CTABLE_ECCODES);
+            }
         }
-    }
-}
-# Loop for processing of BUFR input files
+        my $current_subset_number = $bufr->get_current_subset_number();
-my %data_of = ();
+        # If next_observation() did find a BUFR message, subset number
-foreach my $inputfname (@ARGV) {
+        # should have been set to at least 1 (even in a 0 subset message)
+        last READLOOP if $current_subset_number == 0;
-    # Dump the content of the BUFR file using the Fortran program $BUFRDUMP
+        if ($current_subset_number == 1 || $option{nodata}) {
-    my $dump = `$BUFRDUMP $filter $lon1 $lat1 $lon2 $lat2 $inputfname`;
+            $current_message_number = $bufr->get_current_message_number();
-    die if $?; # Reason for bufrdump failing should have been printed to STDERR
+            $current_ahl = $bufr->get_current_ahl() || '';
+            $message_header = sprintf "\nMessage %d", $current_message_number;
+            $message_header .= (defined $current_ahl)
+                ? "  $current_ahl\n" : "\n";
-    # Then process the output from the dump
+            $section013_dumped = 0;
-    my @lines = split /\n/, $dump;
+            next READLOOP if ($option{filter}
-    # Add an empty line to simplify processing
+                && filter_observation($bufr, $data, $descriptors));
-    push @lines, '';
-    my $station = '';
-    # Skip first(blank) line
+            print $OUT $message_header;
-    shift @lines;
-    my @lines_to_print;
+            if (not $option{data_only}) {
-    my %msg; # Hash with parameter name as key, parameter value as value
+                print $OUT $bufr->dumpsection0();
+                print $OUT $bufr->dumpsection1();
+                print $OUT $bufr->dumpsection2($sec2_code_ref)
+                    if $option{optional_section};
+                print $OUT $bufr->dumpsection3();
+                $section013_dumped = 1;
+            }
+            next READLOOP if $option{nodata};
+        } else { # subset number > 1
+            next READLOOP if ($option{filter}
+                && filter_observation($bufr, $data, $descriptors));
-  LINE:while (defined(my $line = shift @lines)) {
+            # If subset 1 was filtered away, section 0-3 might not
-        # Each new message starts with a blank line
+            # have been printed yet
-        if ($line !~ /^\s*$/) {
+            if ($option{filter} and not $option{data_only}
-            # Build up the message to be (possibly) printed
+                 and not $section013_dumped)  {
-            my ($param, $value) = ($line =~ /^(.+)=\s*(.*)$/);
+                print $OUT $bufr->dumpsection0();
-            if ($transform_file && $transform_ref->{$param}) {
+                print $OUT $bufr->dumpsection1();
-                # Replace value with transformed value
+                print $OUT $bufr->dumpsection2($sec2_code_ref)
-                my $transform = $transform_ref->{$param};
+                    if $option{optional_section};
-                $transform =~ s/\$x/$value/g;
+                print $OUT $bufr->dumpsection3();
-                $value = eval $transform;
+                $section013_dumped = 1;
-                die "Couldn't parse following transform:\n"
-                    . $transform . "\nReason:\n$@" if $@;
-                $line =~ s/=.*/=$value/;
             }
-            $msg{$param} = $value;
-            push @lines_to_print, $line;
         }
-        if ($line =~ /^\s*$/ or @lines == 0) {
+        if ($option{param}) {
-            # A full message has been completed. Should it be printed?
+            # Reduce data and descriptors to those requested only
-            if ($filter && filter_obs(\%msg, $criteria_ref)) {
+            ($data, $descriptors)
-                # Skip this message
+                = param($data, $descriptors, @requested_desc);
-            } else {
+        }
-                # Print the message (or if --sort or --sort_on: save the message)
-                my $txt = '';
+        printf $OUT "\nSubset %d\n", $current_subset_number;
-                if ($param_file) {
-                    # Print the params in @$params_ref if exists in
+        # If an error is encountered during dumping of section 4, skip
-                    # message, in same order as in @$params_ref
+        # this subset while printing the error message to STDERR, also
-                    foreach my $name (@$params_ref) {
+        # displaying ahl of bulletin if found.
-                        if (exists $msg{$name}) {
+        my $dump;
-                            $txt .= $csv ? $msg{$name} . ',' : "$name=$msg{$name}\n";
+        eval {
-                        } elsif ($forced_params_ref->{$name}) {
+            $dump = ( $option{bitmap} )
-                            $txt .= $csv ? '-32767,' : "$name=-32767\n";
+                ? $bufr->dumpsection4_with_bitmaps($data, $descriptors,
-                        } elsif ($csv) {
+                                                   $current_subset_number, $width)
-                            $txt .= ',';
+                : $bufr->dumpsection4($data, $descriptors, $width);
-                        }
+        };
-                    }
+        if ($@) {
-                } else {
+            warn $@;
-                    foreach my $line2 (@lines_to_print) {
+            my $error_msg = "In message $current_message_number"
-                        $line2 =~ s/=\s+/=/;
+                . " and subset $current_subset_number";
-                        $txt .= $line2 . "\n";
+            $error_msg .= " contained in bulletin with ahl $current_ahl\n"
-                    }
+                if $current_ahl;
-                }
+            warn $error_msg;
-                chop $txt if $csv; # removes last ','
+            exit(1) if $option{on_error_stop};
-                if ($txt) {
+            next READLOOP;
-                    if ($sort) {
+        } else {
-                        # Sort wmonr before call signs before buoy_id
+            print $OUT $dump;
-                        if ($msg{wmonr}) {
-                            $station = '00_' . $msg{wmonr};
-                        } elsif ($msg{call_sign}) {
-                            $station = '10_' . $msg{call_sign};
-                        } elsif ($msg{buoy}) {
-                            $station = '10_' . $msg{buoy_id};
-                        } else {
-                            # Skip observation if no station identification found
-                            next LINE;
-                        }
-                        $data_of{$station} = exists $data_of{$station}
-                            ? $data_of{$station} . "$txt \n" : "$txt \n";
-                    } elsif ($sort_on) {
-                        my $val = exists $msg{$sort_on} ? $msg{$sort_on} : '';
-                        $data_of{$val} = exists $data_of{$val}
-                            ? $data_of{$val} . "$txt \n" : "$txt \n";
-                    } else {
-                        # No sorting. We can print the line immediately
-                        print $txt .= "\n" if $txt;
-                    }
-                }
-                $txt = '';
-            }               # Finished message
-            @lines_to_print = ();
-            %msg = ();
         }
     }
 }
-# If sorting requested, we cannot print before now
+sub read_descriptor_file {
-if ($sort) {
+    my $descriptor_file = shift;
-    for (sort keys %data_of) {
-        print $data_of{$_};
+    open my $fh, '<', $descriptor_file
+        or die "Cannot open $descriptor_file: $!";
+    my @requested_desc;
+    while (<$fh>) {
+        next unless /^\s*(\d{6})/;
+        push @requested_desc, $1;
     }
-} elsif ($sort_on) {
+    close $fh or die "Cannot close $descriptor_file: $!";
-    # Print observations with missing value for the sort parameter lastly
+    return @requested_desc;
-    my $data_of_missing_value = $data_of{''} || '';
-    delete $data_of{''};
-    for (sort $sort_by keys %data_of) {
-        print $data_of{$_};
-    }
-    print $data_of_missing_value if $data_of_missing_value;
 }
+# Reduce the data to those corresponding to the requested descriptors
+# only.
+sub param {
+    my ($data, $descriptors, @requested_desc) = @_;
-sub read_param_file {
+    my (@req_data, @req_desc);
-    my $parameter_file = shift;
+    my $i = 0;
+    foreach my $id ( @{$descriptors} ) {
-    open my $PARAM, '<', $parameter_file
+        if (grep { $id == $_ } @requested_desc) {
-        or die "Cannot open $parameter_file: $!";
+            push @req_data, $data->[$i];
+            push @req_desc, $id;
-    my %forced_params;
-    my @params;
-    # Read the parameters into @params, those preceded by an
-    # exclamation mark also into %forced_params, skipping blank lines
-    # and comment lines
-    while (my $name = <$PARAM>) {
-        $name =~ s/^\s+//;
-        $name =~ s/\s+$//;
-        next if !$name || $name =~ /^#/;
-        if ($name =~ /^!/) {
-            $name = substr $name, 1;
-            $forced_params{$name} = 1;
         }
-        push @params, $name;
+        $i++;
     }
-    close $PARAM or die "Cannot close $parameter_file: $!";
+    return (\@req_data, \@req_desc);
-    return \%forced_params, \@params;
 }
-sub read_transformation_file {
-    my $transform_file = shift;
-    open my $TRANSFORM, '<', $transform_file
+###################################################################################
-        or die "Cannot open $transform_file: $!";
-    # Read in the transformations, skipping blank lines and comment
+# Filter routines
-    # lines
-    my %transform_of;
+sub filter_on_ahl {
-    while (my $line = <$TRANSFORM>) {
+    my $obj = shift;
-        $line =~ s/^\s+//;
+    my $ahl_regexp = shift;
-        $line =~ s/\s+$//;
+    my $ahl = $obj->get_current_ahl() || '';
-         next if !$line || $line =~ /^#/;
+    return $ahl =~ $ahl_regexp ? 0 : 1;
-        my ($param, $transform) = split /=/, $line, 2;
-        die "Invalid transformation in $transform_file:\n$line\n"
-            unless $transform;
-        $param =~ s/\s+$//;
-        $transform =~ s/^\s+//;
-        $transform_of{$param} = $transform;
-    }
-    return \%transform_of;
 }
+# Read in contents of $filter_file into variables @fid, @fiv,
+# @num_desc, @num_val and $num_criteria, which are defined above.
+# Note that index 0 of the arrays is not used.
 sub read_filter_file {
     my $filter_file = shift;
-    my @allowed_operators =
-        ('=',
-         '<',
-         '<=',
-         '>',
-         '>=',
-         '!=',
-     );
-    my @criteria;
-    open my $FILTER, '<', $filter_file
+    open my $fh, '<', $filter_file
         or die "Cannot open $filter_file: $!";
-    # Skip the criteria meant for Fortran parsing, i.e. proceed to
+    while (<$fh>) {
-    # first line following a blank line
+        # Remove comments and skip blank lines
-    while (<$FILTER>) {
+        s/#.*//;
-        last if $_ =~ /^\s*$/;
+        next if /^\s*$/;
-    }
-    # Read the filter criteria meant for Perl parsing, skipping blank
+        if (s/^\s*D(!)?://) {
-    # lines and comment lines
+            my @desc = split;
-    while (my $line = <$FILTER>) {
+            # Check that all descriptors are numbers
-        $line =~ s/^\s+//;
+            foreach my $desc (@desc) {
-        $line =~ s/\s+$//;
+                die "'$desc' cannot be a descriptor in line $. in filter file '$filter_file'"
-        next if !$line || $line =~ /^#/;
+                    if $desc !~/^\d+$/;
-        push @criteria, $line;
+            }
-    }
+            # Save the criterium
+            $num_desc[++$num_criteria] = @desc;
-    # Check that the criteria are properly formatted
+            $num_val[$num_criteria] = 0;
-    foreach my $criterium (@criteria) {
+            $fid[$num_criteria] = \@desc;
-        # Naked parameter is ok
+            $required[$num_criteria] = $1 ? 1 : 0;
-        next if $criterium =~ /^\w+$/;
+            $num_required_criteria++ if $1;
+        } else {
-        my $op = (split / +/, $criterium)[1];
+            my @values = split;
-        if (!defined($op) or grep(/[+*?\\]/, $op) or !grep(/^$op$/, @allowed_operators) ) {
+            # Check that value line contains correct number of values
-            print "Error in $filter_file, line $. is badly formatted"
+            die "Number of values doesn't match number of descriptors"
-                . " or operator not supported:\n$criterium";
+                . " for line $. in filter file '$filter_file'"
-            exit 1;
+                if scalar @values != scalar @{$fid[$num_criteria]};
+            # Remove leading 0's in numerical values (to prepare for string comparison)
+            for $_ (@values) { s/^0+(\d+)$/$1/ };
+            $fiv[$num_criteria]->[++$num_val[$num_criteria]] = \@values;
         }
     }
-    return \@criteria;
+    close $fh or die "Cannot close $filter_file: $!";
+    return;
 }
-# Return true (1) if observation is to be filtered, i.e. does not
+# Return true (observations should be filtered) if the observation
-# comply with at least one of the <param> or <param> <operator>
+# does not meet all of the D! criteria (if exists) and does not meet
-# <value> filter criteria in filter file
+# any one of the other criteria (if exists) in filter file.
-sub filter_obs {
+sub filter_observation {
-    my $msg_ref = shift;
+    my $bufr = shift;
-    my $criteria_ref = shift;
+    die "Error in filter_observation: argument not a BUFR object"
+        unless ref($bufr) eq 'Geo::BUFR';
+    my ($data, $descriptors) = @_;
-    my @ascii_params = qw(call_sign icao_id name obstime type);
+    my $num_ordinary_criteria = $#fid - $num_required_criteria;
+    my $num_success_req_criteria = 0; # Number of required criteria successfully fulfilled
+    my $num_success_ord_criteria = 0; # Number of ordinary criteria successfully fulfilled
-    foreach my $criterium (@$criteria_ref) {
+    # loop through all different criteria:
-        my ($f_param, $f_operator, $f_value) = split / +/, $criterium, 3;
+  CRITERIA: foreach my $filter_criterion (1 .. $num_criteria) {
-        return 1 unless exists $msg_ref->{$f_param};
+        if ($num_val[$filter_criterion] == 0) {
-        next if not defined $f_operator; # Naked parameter criterium. Parameter
+            # Enough to check that the descriptor(s) are present in observation
-                                         # present, so criterium fulfilled
+            my $nmatch = 0;
-        chomp $f_value;
+            # loop through all descriptors in criterion:
-        if ($f_operator eq '=') {
+            foreach my $idesc (0 .. $num_desc[$filter_criterion] - 1) {
-            if (grep {$_ eq $f_param} @ascii_params) {
+                my $filter_desc = $fid[$filter_criterion]->[$idesc];
-                $msg_ref->{$f_param} =~ s/\s*$//;
+                for (my $j = 0; $j < @{$descriptors}; $j++) {
-                return 1 unless $msg_ref->{$f_param} eq $f_value;
+                    if ($descriptors->[$j] == $filter_desc) {
-            } else {
+                        $nmatch++; # Matched!
-                return 1 unless $msg_ref->{$f_param} == $f_value;
+                        if ($nmatch == $num_desc[$filter_criterion]) {
-            }
+                            # All descriptors for this line in this criterion matched.
-        } elsif ($f_operator eq '<') {
+                            # Do we need to check more criteria?
-            return 1 unless $msg_ref->{$f_param} < $f_value;
+                            if ($required[$filter_criterion]) {
-        } elsif ($f_operator eq '<=') {
+                                $num_success_req_criteria++;
-            return 1 unless $msg_ref->{$f_param} <= $f_value;
+                                if ($num_success_req_criteria == $num_required_criteria
-        } elsif ($f_operator eq '>') {
+                                    and ($num_ordinary_criteria == 0
-            return 1 unless $msg_ref->{$f_param} > $f_value;
+                                         or $num_success_ord_criteria > 0)) {
-        } elsif ($f_operator eq '>=') {
+                                    return 0; # Don't filter this observation
-            return 1 unless $msg_ref->{$f_param} >= $f_value;
+                                }
-        } elsif ($f_operator eq '!=') {
+                            } else {
-            if (grep {$_ eq $f_param} @ascii_params) {
+                                $num_success_ord_criteria++;
-                $msg_ref->{$f_param} =~ s/\s*$//;
+                                if ($num_success_req_criteria == $num_required_criteria) {
-                return 1 unless $msg_ref->{$f_param} ne $f_value;
+                                    return 0; # Don't filter this observation
-            } else {
+                                }
-                return 1 unless $msg_ref->{$f_param} != $f_value;
+                            }
+                        }
+                    }
+                }
             }
+        } else {
+            # loop through all filter values lines (for given) criterion:
+          LINE: foreach my $line (1 .. $num_val[$filter_criterion]) {
+                my $nmatch = 0;
+                # loop through all descriptors in criterion:
+              DESC: foreach my $idesc (0 .. $num_desc[$filter_criterion] - 1) {
+                    my $filter_desc = $fid[$filter_criterion]->[$idesc];
+                    # loop through all data in subset:
+                    for (my $j = 0; $j < @{$descriptors}; $j++) {
+                        if ($descriptors->[$j] == $filter_desc) {
+                            next DESC if !defined $data->[$j];
+                            (my $val = $data->[$j]) =~ s/^\s*(.*?)\s*$/$1/;
+                            if ($val eq $fiv[$filter_criterion]->[$line]->[$idesc]) {
+                                $nmatch++; # Matched!
+                                if ($nmatch == $num_desc[$filter_criterion]) {
+                                    # All descriptors for this line in this criterion matched.
+                                    # Do we need to check more criteria?
+                                    if ($required[$filter_criterion]) {
+                                        $num_success_req_criteria++;
+                                        if ($num_success_req_criteria == $num_required_criteria
+                                            and ($num_ordinary_criteria == 0
+                                                 or $num_success_ord_criteria > 0)) {
+                                            return 0; # Don't filter this observation
+                                        } else {
+                                            next DESC;
+                                        }
+                                    } else {
+                                        $num_success_ord_criteria++;
+                                        if ($num_success_req_criteria == $num_required_criteria) {
+                                            return 0; # Don't filter this observation
+                                        }
+                                    }
+                                } else {
+                                    next DESC;
+                                }
+                            } else {
+                                # Found the descriptor, but wrong value
+                                next LINE;
+                            }
+                        }
+                    }
+                } # End of filter descriptor loop
+            } # End of value line loop
         }
-    }
+    } # End of criteria loop
-    # All filter conditions have been fullfilled
+    # One required criterion not fulfilled, or if there are no
-    return 0;
+    # required criteria: none of the non-required criteria fulfilled
+    # (so the observation should be filtered away)
+    return 1;
 }
 =pod
+=encoding utf8
 =head1 SYNOPSIS
-  bufrdump.pl <bufr file(s)>
+  bufrread.pl <bufr file(s)>
+      [--ahl <ahl_regexp>]
+      [--all_operators]
+      [--bitmap]
+      [--codetables]
+      [--data_only]
       [--filter <filter file>]
-      [--param <parameter file> [--csv]]
-      [--sort | --sort_on <parameter>[-]]
-      [--transform <transformation file>]
-      [--lon1 x1]
-      [--lat1 y1]
-      [--lon2 x2]
-      [--lat2 x2]
-      [--tablepath <path to BUFR tables>]
       [--help]
+      [--nodata]
+      [--noqc]
+      [--on_error_stop]
+      [--optional_section]
+      [--outfile <filename>]
+      [--param <descriptor file>]
+      [--strict_checking n]
+      [--tableformat <BUFRDC|ECCODES>]
+      [--tablepath <path to BUFR tables>]
+      [--verbose n]
+      [--width n]
 =head1 DESCRIPTION
-Extracts BUFR messages from BUFR file(s) and prints section 4 as
+Extract BUFR messages from BUFR file(s) and print the decoded content
-"parameter=value" lines. Calls the Fortran program bufrdump
+to screen, including AHL (Abbreviated Header Line) if present.
-internally, so this program must be installed at the location set in
-variable $BUFRDUMP in source code.
 Execute without arguments for Usage, with option C<--help> for some
-additional info. See also L</https://wiki.met.no/bufr.pm/start> for
+additional info. See also L<https://wiki.met.no/bufr.pm/start> for
 examples of use.
@@ Line 405: / Line 504: @@
 =head1 OPTIONS
+   --ahl <ahl_regexp>
+                   Decode BUFR messages with AHL matching <ahl_regexp> only
+   --all_operators Show replication descriptors and all operator descriptors
+                   when printing section 4
+   --bitmap        Display bit-mapped values on same line
+   --codetables    Use code and flag tables to resolve values when unit
+                   is [CODE TABLE] or [FLAG TABLE]
+   --data_only     Print section 4 (data section) only
+   --filter <filter file>
+                   Decode observations meeting criteria in <filter file> only
+   --help          Display Usage and explain the options used. For even
+                   more info you might prefer to consult perldoc bufrread.pl
+   --nodata        Do not print (nor decode) section 4 (data section)
+   --noqc          Do not decode quality control
+                   (or any descriptors following 222000)
+   --on_error_stop Stop processing as soon as an error occurs during decoding
+   --outfile <filename>
+                   Will print to <filename> instead of STDOUT
+   --optional_section
+                   Display a hex dump of optional section if present
+   --param <descriptor file>
+                   Display parameters with descriptors in <descriptor file> only
+   --strict_checking n n=0 (default) Disable strict checking of BUFR format
+                       n=1 Issue warning if (recoverable) error in
+                           BUFR format
+                       n=2 Croak if (recoverable) error in BUFR format.
+                           Nothing more in this message/subset will be decoded.
+   --tableformat   Currently supported are BUFRDC and ECCODES (default is BUFRDC)
+   --tablepath <path to BUFR tables>
+                   Set path to BUFR tables (overrides ENV{BUFR_TABLES})
+   --verbose n     Set verbose level to n, 0<=n<=6 (default 0). n=1 will
+                   show the tables loaded.
+   --width n       Set width of field used for data values to n characters
+                   (default is 15)
-  --filter <filter file>
+Options may be abbreviated, e.g. C<--h> or C<-h> for C<--help>.
-                  Decode observations meeting criteria in <filter file> only
-  --param <parameter file> [--csv]
-                  Print parameters in <parameter file> only, in same order
-                  as they occur in <parameter file>. If --csv, the parameters
-                  vill be printed using the CSV (comma separated values) format
-  --sort          Sort the decoded observations on station identification;
-                  first stations with wmonr, then stations with call sign,
-                  then stations with buoy_id (others left out)
-  --sort_on <parameter>[-] Sort the decoded observations on increasing
-                  values of <parameter>, or decreasing values if a '-'
-                  follows the parameter name. Observations not containing
-                  the parameter at all will be printed lastly. E.g.
-                  --sort_on TA- will sort on decreasing temperatures
-  --transform <transformation file>
-                  Do the transformations of parameter values listed in
-                  <transformation 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
-Options may be abbreviated, e.g. --h or -h for --help.
 To avoid having to use the C<--tablepath> option, you are adviced to
-set the invironment variable BUFR_TABLES to the directory where your
+set the environment variable BUFR_TABLES to the directory where your
 BUFR tables are located (unless the default path provided by
-bufrdump.pl works for you).
+bufrread.pl works for you). For tableformat ECCODES, se
+L<http://search.cpan.org/dist/Geo-BUFR/lib/Geo/BUFR.pm#BUFR-TABLE-FILES>
+for more info on how to set C<--tablepath> (or BUFR_TABLES).
-The lines in <parameter file> should be name of the parameters you
+For option C<--ahl> the <ahl_regexp> should be a Perl regular
-want to be printed. For example, if you want only station
+expression. E.g. C<--ahl "ISS... ENMI"> will decode only BUFR SHIP
-identification and temperature to be printed for a BUFR SYNOP file,
+(ISS) from CCCC=ENMI. This is the only case where a little knowledge
-the <parameter file> should look like this:
+of Perl might possibly be required when using the utility programs
+included in Geo::BUFR.
-  wmonr
+For option C<--param> each line in <descriptor file> should start with
-  call_sign
+a BUFR descriptor (6 digits).  Rest of line will be ignored.
-  TA
+bufrread.pl will display values for these descriptors only.
-If you want "parameter=value" to be printed also when value is missing
+Using C<--filter> will decode only those observations that meet one of
-in BUFR message, precede the parameter name with an exclamation mark
+the criteria in <filter file> marked D: and all of those criteria
-(e.g. '!TA').  Missing values will then be displayed as -32767.
+marked D!:. Comments (starting with #) are ignored. An example of a
+filter file is
-If --csv is used in conjunction with --param, all values will be
+  D: 001001
-printed using the CSV format, with first line listing the parameters,
-and with missing fields printed as -32767 if the parameter is marked
+  D: 001001 001002
-with '!' in parameter file. With the parameter file above, the listing
+ 895
-may for example start like
+ 252
+  D: 001011
-  wmonr,call_sign,TA
+  LF5U       # Ekofisk
-,,-1.5
+  D!: 004004
-  ,LF5U,9.0
-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> or <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
-  LF5U
-  type = Manned
-  NN != 8
-  TA >= 5
-  TA < 9.5
-  RR_24
 which decodes all observations with block number 01, two other
-specific wmo stations and one specific ship, being manned stations and
+specific WMO stations and one specific ship, all of which having hour
-having cloud cover different from 8 (but NN must be part of the
+(004004) equal to 6 or 7. If there is no value line after a
-message) and temperature between 5 and 9.5 degrees Celsius and
+descriptor line, it is enough that the observation contains the
-containing precipitation for last 24 hours. Comment lines starting
+descriptor(s), whatever the values are. So to extract all ship
-with # will be ignored.
+messages from a BUFR file, the filter file should contain this single
+line only:
-Another example: the simple filter file (starting with a blank line!)
-  wmonr
-will print only those observations containing a wmonr (skipping
-ships).
-The --transform option is provided mainly to be able to use other
-units than what is default in bufrdump.pl. The transformation file
-should list the transformations wanted, one per line as
-  <parameter> = <perl expression involving $x>
-where $x is original value of the parameter.
+  D: 001011
-For example, the following transformation file will display wind speed
+If an error occurs during decoding (typically because the required
-FF and wind gust FG in knots instead of m/s, rounded to one decimal,
+BUFR table is missing or message is corrupt), the BUFR message is
-and cloud cover NN in % (instead of the default which is using WMO
+skipped with an error message printed to STDERR, and processing then
-code table 2700, roughly counting octas):
+continues with the next BUFR message. You can change this default
+behaviour, however, by setting C<--on_error_stop>.
-  FF = sprintf("%.1f", $x*1.9438)
+=head1 CAVEAT
-  FG = sprintf("%.1f", $x*1.9438)
-  NN = int($x*12.5 + .5)
-If --transform is combined with --filter, the filter criteria should
+Option C<--bitmap> may not work properly for complicated BUFR messages.
-refer to the transformed values. E.g. if the above NN transform to %
+Namely, when the first bit-map is encountered, no more data values (or
-is to be applied for sky not all covered by clouds, you should use NN
+their descriptors) will be displayed unless they refer to the
-!= 100 instead of NN != 8 in filter file.
+preceding data values by a bit-map. And output is not to be trusted
+if a bit-map refers to another bit-map or the bit-mapped values are
+combined with 204YYY (add associated field operator).
 =head1 AUTHOR
@@ Line 527: / Line 605: @@
 =head1 COPYRIGHT
-Copyright (C) 2010 met.no
+Copyright (C) 2010-2023 MET Norway
 =cut
 </code>