1#!/usr/bin/env perl
2#
3# (C) Copyright 2005- ECMWF.
4#
5# This software is licensed under the terms of the Apache Licence Version 2.0
6# which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
7#
8# In applying this licence, ECMWF does not waive the privileges and immunities
9# granted to it by virtue of its status as an intergovernmental organisation
10# nor does it submit to any jurisdiction.
11#
12#######################################################################
13# Script for GRIB2 parameter definitions
14# Can either write the *.def files or push to the Parameter DB
15#
16# Reads an input TSV (tab-separated-value) file which should contain
17# parameter keys as columns. See the @columns variable for expected contents
18#
19#######################################################################
20$|=1;
21use strict;
22use warnings;
23use DBI;
24use Time::localtime;
25
26$ARGV[0] or die "USAGE: $0 input.tsv\n";
27
28my $SANITY_CHECK     = 0;
29my $WRITE_TO_FILES   = 1;
30my $WRITE_TO_PARAMDB = 0; # Be careful. Fill in $contactId before proceeding
31
32my ($paramId, $shortName, $name, $units, $cfVarName, $interpol);
33my ($discipline, $pcategory, $pnumber, $type1, $type2, $scaledValue1, $scaleFactor1, $scaledValue2, $scaleFactor2);
34my ($stat, $aero, $constit);
35my ($typeGen, $localTV, $typeOfWLInt, $scaleFactorWL1, $scaledValueWL1, $scaleFactorWL2, $scaledValueWL2, $sourceSink);
36
37my @columns = ("paramId", "shortName", "name", "units", "interpolation",
38    "discipline", "parameterCategory", "parameterNumber",
39    "typeOfFirstFixedSurface", "scaleFactorOfFirstFixedSurface", "scaledValueOfFirstFixedSurface",
40    "typeOfSecondFixedSurface", "scaleFactorOfSecondFixedSurface", "scaledValueOfSecondFixedSurface",
41    "typeOfStatisticalProcessing", "aerosolType", "constituentType", "typeOfGeneratingProcess", "localTablesVersion",
42    "typeOfWavelengthInterval", "scaleFactorOfFirstWavelength", "scaledValueOfFirstWavelength",
43    "scaleFactorOfSecondWavelength", "scaledValueOfSecondWavelength", "sourceSinkChemicalPhysicalProcess");
44
45my %key_to_attrib_map = (
46    'discipline'         => 4,
47    'parameterCategory'  => 8,
48    'parameterNumber'    => 5,
49    'localTablesVersion' => 16,
50    'typeOfFirstFixedSurface' => 6,
51    'scaleFactorOfFirstFixedSurface' => 7,
52    'scaledValueOfFirstFixedSurface' => 9,
53    'typeOfStatisticalProcessing' => 11,
54    'typeOfSecondFixedSurface' => 13,
55    'scaledValueOfSecondFixedSurface' => 14,
56    'scaleFactorOfSecondFixedSurface' => 15,
57    'typeOfGeneratingProcess' => 28,
58    'constituentType' => 40,
59    'aerosolType' => 46
60);
61my $db   = "param";
62my $host = $ENV{'PARAM_DB_HOST'} || 'unknown';
63my $user = $ENV{'PARAM_DB_USER'} || 'unknown';
64my $pass = $ENV{'PARAM_DB_PASS'} || 'unknown';
65my $dbh  = 0;
66my $centre_wmo   = -3; # WMO centre ID
67my $centre_ecmwf = 98; # ECMWF centre ID
68my $edition = 2; # GRIB edition 2
69my $contactId;   # JIRA issue ID
70
71my $PARAMID_FILENAME   = "paramId.def";
72my $SHORTNAME_FILENAME = "shortName.def";
73my $NAME_FILENAME      = "name.def";
74my $UNITS_FILENAME     = "units.def";
75my $CFVARNAME_FILENAME = "cfVarName.def";
76
77my $tm = localtime;
78my $today_date = sprintf("%04d-%02d-%02d", $tm->year+1900, ($tm->mon)+1, $tm->mday);
79
80if ($WRITE_TO_FILES) {
81    create_or_append(\*OUT_PARAMID,   "$PARAMID_FILENAME");
82    create_or_append(\*OUT_SHORTNAME, "$SHORTNAME_FILENAME");
83    create_or_append(\*OUT_NAME,      "$NAME_FILENAME");
84    create_or_append(\*OUT_UNITS,     "$UNITS_FILENAME");
85    create_or_append(\*OUT_CFVARNAME, "$CFVARNAME_FILENAME");
86}
87if ($WRITE_TO_PARAMDB) {
88    $dbh = DBI->connect("dbi:mysql(RaiseError=>1):database=$db;host=$host",$user,$pass) or die $DBI::errstr;
89}
90
91my $first = 1;
92my $lcount = 0;
93
94if ($SANITY_CHECK) {
95    print "Checking sanity: uniqueness of paramId and shortName keys ...\n";
96    while (<>) {
97        chomp;
98        s/\r//g;  # Remove DOS carriage returns
99        if ($first == 1) {
100            $first = 0;
101            next;
102        }
103        $lcount++;
104        ($paramId, $shortName) = split(/\t/);
105        my $x = $dbh->selectrow_array("select * from param.param where id = ?",undef,$paramId);
106        die "Error: paramId=$x already exists (line ", $lcount+1, ")\n" if (defined $x);
107        $x = $dbh->selectrow_array("select shortName from param.param where shortName = ?",undef,$shortName);
108        die "Error: shortName=$x already exists (line ", $lcount+1, ")\n" if (defined $x);
109    }
110    print "Sanity checking completed. $lcount rows checked. No errors\n";
111    exit 0;
112}
113
114while (<>) {
115    chomp;
116    s/\r//g;  # Remove DOS carriage returns
117    if ($first == 1) {
118        check_first_row_column_names($_);
119        $first = 0;
120        next;
121    }
122    $lcount++;
123
124    ($paramId, $shortName, $name, $units, $interpol,
125     $discipline, $pcategory, $pnumber,
126     $type1, $scaleFactor1, $scaledValue1, $type2, $scaleFactor2, $scaledValue2,
127     $stat, $aero, $constit,
128     $typeGen, $localTV, $typeOfWLInt, $scaleFactorWL1, $scaledValueWL1, $scaleFactorWL2, $scaledValueWL2, $sourceSink
129     ) = split(/\t/);
130
131    die "Error: paramID \"$paramId\" is not an integer (input row=$lcount)!\n"             if (!is_integer($paramId));
132    die "Error: shortName \"$shortName\" has an invalid character (input row=$lcount)!\n"  if ($shortName =~ /[ '"]/);
133    die "Error: name \"$name\" should have uppercase 1st letter or digit (input row=$lcount)!\n"   if ($name !~ /^[A-Z0-9]/);
134    die "Error: typeOfFirstFixedSurface \"$type1\" is not an integer (input row=$lcount)!\tPick a value from Code Table 4.5\n"
135        if ($type1 ne "" && !is_integer($type1));
136    die "Error: typeOfSecondFixedSurface \"$type2\" is not an integer (input row=$lcount)!\tPick a value from Code Table 4.5\n"
137        if ($type2 ne "" && !is_integer($type2));
138
139    $units = "~" if ($units eq "");
140    $cfVarName = $shortName;
141    $cfVarName = '\\'.$shortName if ($shortName =~ /^[0-9]/);
142    $scaleFactorWL1 = undef if ($scaleFactorWL1 =~ /missing/);
143    $scaledValueWL1 = undef if ($scaledValueWL1 =~ /missing/);
144    $scaleFactorWL2 = undef if ($scaleFactorWL2 =~ /missing/);
145    $scaledValueWL2 = undef if ($scaledValueWL2 =~ /missing/);
146
147    if ($WRITE_TO_FILES) {
148        write_out_file(\*OUT_PARAMID,   $name, $paramId);
149        write_out_file(\*OUT_SHORTNAME, $name, $shortName);
150        write_out_file(\*OUT_NAME,      $name, $name);
151        write_out_file(\*OUT_UNITS,     $name, $units);
152        write_out_file(\*OUT_CFVARNAME, $name, $cfVarName);
153    }
154
155    if ($WRITE_TO_PARAMDB) {
156        my $units_code = get_db_units_code($units);
157        my $is_chem = "";
158        my $is_aero = "";
159        my $is_srcsink = "";
160        if ($aero ne "") {
161            $is_aero = "1";
162            $is_chem = "";
163            $is_srcsink = "";
164        }
165        if ($constit ne "") {
166            $is_aero = "";
167            $is_chem = "1";
168            $is_srcsink = "";
169        }
170        if ($sourceSink ne "") {
171            $is_aero = "";
172            $is_chem = "";
173            $is_srcsink = "1";
174        }
175        my $centre = $localTV ne "" ? $centre_ecmwf : $centre_wmo;
176
177        die "Error: Both aerosolType and constituentType cannot be set!" if ($constit ne "" && $aero ne "");
178        die "Error: No contact ID provided\n" if (!$contactId);
179        print "Inserting paramId $paramId (centre=$centre) ...\n";
180        $dbh->do("insert into param(id,shortName,name,units_id,insert_date,update_date,contact) values (?,?,?,?,?,?,?)",undef,
181            $paramId, $shortName, $name , $units_code, $today_date, $today_date, $contactId);
182
183        # Table 'grib' columns: param_id  edition  centre  attribute_id  attribute_value  param_version
184        $dbh->do("insert into grib values (?,?,?,?,?,?)",undef, $paramId,$edition,$centre,4, $discipline,0);
185        $dbh->do("insert into grib values (?,?,?,?,?,?)",undef, $paramId,$edition,$centre,8, $pcategory,0);
186        $dbh->do("insert into grib values (?,?,?,?,?,?)",undef, $paramId,$edition,$centre,5, $pnumber,0);
187        $dbh->do("insert into grib values (?,?,?,?,?,?)",undef, $paramId,$edition,$centre,6, $type1,0)        if ($type1 ne "");
188        $dbh->do("insert into grib values (?,?,?,?,?,?)",undef, $paramId,$edition,$centre,13,$type2,0)        if ($type2 ne "");
189        $dbh->do("insert into grib values (?,?,?,?,?,?)",undef, $paramId,$edition,$centre,9, $scaledValue1,0) if ($scaledValue1 ne "");
190        $dbh->do("insert into grib values (?,?,?,?,?,?)",undef, $paramId,$edition,$centre,7, $scaleFactor1,0) if ($scaleFactor1 ne "");
191        $dbh->do("insert into grib values (?,?,?,?,?,?)",undef, $paramId,$edition,$centre,14,$scaledValue2,0) if ($scaledValue2 ne "");
192        $dbh->do("insert into grib values (?,?,?,?,?,?)",undef, $paramId,$edition,$centre,15,$scaleFactor2,0) if ($scaleFactor2 ne "");
193        $dbh->do("insert into grib values (?,?,?,?,?,?)",undef, $paramId,$edition,$centre,11,$stat,0)         if ($stat ne "");
194
195        $dbh->do("insert into grib values (?,?,?,?,?,?)",undef, $paramId,$edition,$centre,46,$aero,0)         if ($aero ne "");
196        $dbh->do("insert into grib values (?,?,?,?,?,?)",undef, $paramId,$edition,$centre,40,$constit,0)      if ($constit ne "");
197
198        $dbh->do("insert into grib values (?,?,?,?,?,?)",undef, $paramId,$edition,$centre,53,$is_chem,0)      if ($is_chem ne "");
199        $dbh->do("insert into grib values (?,?,?,?,?,?)",undef, $paramId,$edition,$centre,54,$is_aero,0)      if ($is_aero ne "");
200        $dbh->do("insert into grib values (?,?,?,?,?,?)",undef, $paramId,$edition,$centre,28,$typeGen,0)      if ($typeGen ne "");
201
202        $dbh->do("insert into grib values (?,?,?,?,?,?)",undef, $paramId,$edition,$centre,16,$localTV,0)      if ($localTV ne "");
203        $dbh->do("insert into grib values (?,?,?,?,?,?)",undef, $paramId,$edition,$centre,57,$typeOfWLInt,0)  if ($typeOfWLInt ne "");
204
205        if (! defined $scaleFactorWL1 || $scaleFactorWL1 ne "") {
206            $dbh->do("insert into grib values (?,?,?,?,?,?)",undef, $paramId,$edition,$centre,58,$scaleFactorWL1,0);
207        }
208        if (! defined $scaledValueWL1 || $scaledValueWL1 ne "") {
209            $dbh->do("insert into grib values (?,?,?,?,?,?)",undef, $paramId,$edition,$centre,59,$scaledValueWL1,0);
210        }
211        if (! defined $scaleFactorWL2 ||$scaleFactorWL2 ne "") {
212            $dbh->do("insert into grib values (?,?,?,?,?,?)",undef, $paramId,$edition,$centre,60,$scaleFactorWL2,0);
213        }
214        if (! defined $scaledValueWL2 || $scaledValueWL2 ne "") {
215            $dbh->do("insert into grib values (?,?,?,?,?,?)",undef, $paramId,$edition,$centre,61,$scaledValueWL2,0);
216        }
217        $dbh->do("insert into grib values (?,?,?,?,?,?)",undef, $paramId,$edition,$centre,64,$sourceSink,0)  if ($is_srcsink ne "");
218
219        # format is only GRIB2 hence grib1 entry=0 and grib2=1
220        $dbh->do("insert into param_format(param_id,grib1,grib2) values (?,?,?)",undef,$paramId,0,1);
221    }
222} # for each input line
223
224if ($WRITE_TO_FILES) {
225    print "Wrote output files: $PARAMID_FILENAME $SHORTNAME_FILENAME $NAME_FILENAME $UNITS_FILENAME $CFVARNAME_FILENAME\n";
226    close(OUT_PARAMID)   or die "$PARAMID_FILENAME: $!";
227    close(OUT_SHORTNAME) or die "$SHORTNAME_FILENAME: $!";
228    close(OUT_NAME)      or die "$NAME_FILENAME: $!";
229    close(OUT_UNITS)     or die "$UNITS_FILENAME: $!";
230    close(OUT_CFVARNAME) or die "$CFVARNAME_FILENAME: $!";
231}
232if ($WRITE_TO_PARAMDB) {
233    print "Wrote to Parameter Database. Number of rows processed = $lcount\n";
234}
235
236# -------------------------------------------------------------------
237sub get_db_units_code {
238    my $u = shift;
239    my $unit_id = $dbh->selectrow_array("select id from units where name = ?",undef,$u);
240    die "Error: Unit not found: '$u'\n" if (!$unit_id);
241    return $unit_id;
242}
243
244sub write_out_file {
245    my $outfile = $_[0];
246    my $name    = $_[1];
247    my $key     = $_[2];
248
249    # Assuming every parameter definition has at least discipline, category and number
250    print $outfile "#$name\n";
251    print $outfile "'$key' = {\n";
252    print $outfile "  discipline = $discipline ;\n";
253    print $outfile "  parameterCategory = $pcategory ;\n";
254    print $outfile "  parameterNumber = $pnumber ;\n";
255
256    # Optional keys
257    print $outfile "  typeOfFirstFixedSurface = $type1 ;\n"                if ($type1 ne "");
258    print $outfile "  typeOfSecondFixedSurface = $type2 ;\n"               if ($type2 ne "");
259    print $outfile "  scaledValueOfFirstFixedSurface = $scaledValue1 ;\n"  if ($scaledValue1 ne "");
260    print $outfile "  scaleFactorOfFirstFixedSurface = $scaleFactor1 ;\n"  if ($scaleFactor1 ne "");
261    print $outfile "  scaledValueOfSecondFixedSurface = $scaledValue2 ;\n" if ($scaledValue2 ne "");
262    print $outfile "  scaleFactorOfSecondFixedSurface = $scaleFactor2 ;\n" if ($scaleFactor2 ne "");
263    print $outfile "  typeOfStatisticalProcessing = $stat ;\n"             if ($stat ne "");
264
265    print $outfile "  aerosolType = $aero ;\n"         if ($aero ne "");
266    print $outfile "  constituentType = $constit ;\n"  if ($constit ne "");
267    if ($sourceSink eq "") {
268        print $outfile "  is_aerosol = 1 ;\n"              if ($aero ne "");
269        print $outfile "  is_chemical = 1 ;\n"             if ($constit ne "");
270    } else {
271        print $outfile "  is_chemical_srcsink = 1 ;\n";
272        print $outfile "  sourceSinkChemicalPhysicalProcess = $sourceSink ;\n";
273    }
274    print $outfile "  typeOfGeneratingProcess = $typeGen ;\n"  if ($typeGen ne "");
275    print $outfile "  localTablesVersion = $localTV ;\n"       if ($localTV ne "");
276
277    print $outfile "  typeOfWavelengthInterval = $typeOfWLInt ;\n"          if ($typeOfWLInt ne "");
278    print $outfile "  scaleFactorOfFirstWavelength = $scaleFactorWL1 ;\n"   if ($scaleFactorWL1 ne "");
279    print $outfile "  scaledValueOfFirstWavelength = $scaledValueWL1 ;\n"   if ($scaledValueWL1 ne "");
280    print $outfile "  scaleFactorOfSecondWavelength = $scaleFactorWL2 ;\n"  if ($scaleFactorWL2 ne "");
281    print $outfile "  scaledValueOfSecondWavelength = $scaledValueWL2 ;\n"  if ($scaledValueWL2 ne "");
282
283    print $outfile "}\n";
284}
285
286sub check_first_row_column_names {
287    my $line = shift; # This is the first row
288    my @keys = split(/\t/, $line);
289    my $c = 0;
290    my $numkeys = scalar @keys;
291    my $numcols = scalar @columns;
292    die "Error: 1st row column titles wrong: Expected $numcols columns, got $numkeys.\nColumns should be:\n@columns\n"
293        if ($numkeys != $numcols);
294    for ( my $i = 0; $i < $numkeys; $i++ ) {
295        if ( $keys[$i] ne $columns[$i] ) {
296            die "Error: 1st row column titles wrong: check column ", $i+1, ". Expected '$columns[$i]', got '$keys[$i]'.\n";
297        }
298    }
299    #if (@keys ~~ @columns) {
300    #    print "[@keys] and [@columns] match\n";
301    #} else {
302    #    die "Error: must use these columns: @columns\n";
303    #}
304}
305
306sub create_or_append {
307    my $outfile = $_[0];
308    my $fname   = $_[1];
309
310    if (-f "$fname") {
311        open($outfile,  ">>$fname") or die "Error: $fname: $!";
312    } else {
313        open($outfile,  ">$fname")  or die "Error: $fname: $!";
314    }
315}
316
317sub is_integer {
318    my $val = shift;
319    return ($val =~ /^\d+$/);
320}
321