CHECK: QC1-1-110 - RANGE_CHECK
Abstract signature: obs;X;;|meta;X_1,X_2,X_3,X_4,X_5,X_6;;
Concrete signature: obs;RR_24;;|meta;RR_24_max,RR_24_highest,RR_24_high,RR_24_low,RR_24_lowest,RR_24_min;;
SCRIPT:
use strict;
# general
my @obstime = (2010, 7, 16, 6, 0, 0);
# obs
my $obs_missing = 0;
my $obs_numtimes = 1;
my @X = (10.5);
my @X_controlinfo = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @X_missing = (0);
my @obs_timeoffset = (0);
# meta
my $meta_missing = 0;
my $meta_numtimes = 1;
my @X_1 = (150);
my @X_2 = (120);
my @X_3 = (100);
my @X_4 = (-1);
my @X_5 = (-1);
my @X_6 = (-1);
my @meta_timeoffset = (0);
# Kvalobs_Metadata - Free Quality Control Algorithms for Meteorological Observations
#
# $Id: RANGE_CHECK.pl,v 1.2 2007/10/22 16:21:07 paule Exp $
#
# Copyright (C) 2007 met.no
#
# Contact information:
# Norwegian Meteorological Institute
# Box 43 Blindern
# 0313 OSLO
# NORWAY
# email: kvalobs-dev@met.no
#
# This file is part of KVALOBS_METADATA
#
# KVALOBS_METADATA 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.
#
# KVALOBS_METADATA 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 KVALOBS_METADATA; if not, write to the Free Software Foundation Inc.,
# 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
#checkname: RANGE_CHECK
#signature: obs;X;;|meta;X_1,X_2,X_3,X_4,X_5,X_6;;
# Grenseverdikontroll
# gjør noen tester og returner en ny verdi for flag
sub check {
#tolererer ingen manglende observasjoner:
if ( $X_missing[0] > 0 ) {
return 0;
}
my $flag = 1;
if ( $X[0] < $X_6[0] || $X[0] > $X_1[0] ) {
$flag = 6;
$X_missing[0] = 2;
}
elsif ( $X[0] <= $X_1[0] && $X[0] > $X_2[0] ) {
$flag = 4;
}
elsif ( $X[0] <= $X_2[0] && $X[0] > $X_3[0] ) {
$flag = 2;
}
elsif ( $X[0] < $X_4[0] && $X[0] >= $X_5[0] ) {
$flag = 3;
}
elsif ( $X[0] < $X_5[0] && $X[0] >= $X_6[0] ) {
$flag = 5;
}
my @retvector;
push(@retvector,"X_0_0_flag");
push(@retvector,$flag);
if ( $X_missing[0] > 0 ) {
push(@retvector,"X_0_0_missing");
push(@retvector,$X_missing[0]);
}
my $numout = @retvector;
return (@retvector, $numout);
}
RESULT:
X_0_0_flag = 1
Modified data:
[sid: 100 otime: 2010-07-16 06:00:00 tid: 302 pid: 110 lvl: 0 sen: 0 orig: 10.5 cor: 10.5 cinfo: [0|1|0|0|0|0|0|0|0|0|0|0|0|0|0|0] uinfo: [9|9|9|9|9|0|0|0|0|0|0|0|0|0|0|0]]
-------------------------------------------------------------------------------
CHECK: QC1-1-110x - logger_t
Abstract signature: obs;X;;|meta;X_1,X_2,X_3,X_4,X_5;;
Concrete signature: obs;RR_24;;|meta;RR_24_1,RR_24_2,RR_24_3,RR_24_4,RR_24_5;;
SCRIPT:
use strict;
# general
my @obstime = (2010, 7, 16, 6, 0, 0);
# obs
my $obs_missing = 0;
my $obs_numtimes = 1;
my @X = (10.5);
my @X_controlinfo = (0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @X_missing = (0);
my @obs_timeoffset = (0);
# meta
my $meta_missing = 0;
my $meta_numtimes = 1;
my @X_1 = (-6999);
my @X_2 = (-99.9);
my @X_3 = (999);
my @X_4 = (6999);
my @X_5 = (9999);
my @meta_timeoffset = (0);
# Kvalobs_Metadata - Free Quality Control Algorithms for Meteorological Observations
#
# $Id: logger_t.pl,v 1.9 2010-06-22 07:08:08 oysteinl Exp $
#
# Copyright (C) 2007 met.no
#
# Contact information:
# Norwegian Meteorological Institute
# Box 43 Blindern
# 0313 OSLO
# NORWAY
# email: kvalobs-dev@met.no
#
# This file is part of KVALOBS_METADATA
#
# KVALOBS_METADATA 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.
#
# KVALOBS_METADATA 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 KVALOBS_METADATA; if not, write to the Free Software Foundation Inc.,
# 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
# checkname : logger_t
# signature: obs;X;;|meta;X_1,X_2,X_3,X_4,X_5;;
# Grenseverdikontroll
# Gjoer tester paa 9999-verdier og returner en ny verdi for grenseverdi-flagg
# (fr=7) og missing-flagg (fmis=3)
# Oystein Lie 2010-02-25
sub check {
##tolererer ingen manglende observasjoner:
#if ( $X_missing[0] > 0 ) {
#return 0;
#}
my $flag=1;
my $missingflag=2;
if ($X_controlinfo[1] == 6 && ($X[0] == X_1 || $X[0] == X_2 || $X[0] == X_3 || $X[0] == X_4 || $X[0] == X_5)) {
$flag=7;
#$X_missing[0]=3;
$missingflag=3;
}
my $retvector;
push (@retvector,"X_0_0_flag");
push (@retvector,$flag);
#if ($X_missing[0]>0) {
if ($missingflag == 3) {
push (@retvector,"X_0_0_missing");
#push (@retvector,$X_missing[0]);
push (@retvector,$missingflag);
}
my $numout = @retvector;
return (@retvector,$numout);
}
-------------------------------------------------------------------------------
CHECK: QC1-1-112 - RANGE_CHECK
Abstract signature: obs;X;;|meta;X_1,X_2,X_3,X_4,X_5,X_6;;
Concrete signature: obs;SA;;|meta;SA_max,SA_highest,SA_high,SA_low,SA_lowest,SA_min;;
SCRIPT:
use strict;
# general
my @obstime = (2010, 7, 16, 6, 0, 0);
# obs
my $obs_missing = 0;
my $obs_numtimes = 1;
my @X = (-1);
my @X_controlinfo = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @X_missing = (0);
my @obs_timeoffset = (0);
# meta
my $meta_missing = 0;
my $meta_numtimes = 1;
my @X_1 = (200);
my @X_2 = (200);
my @X_3 = (200);
my @X_4 = (-3);
my @X_5 = (-3);
my @X_6 = (-3);
my @meta_timeoffset = (0);
# Kvalobs_Metadata - Free Quality Control Algorithms for Meteorological Observations
#
# $Id: RANGE_CHECK.pl,v 1.2 2007/10/22 16:21:07 paule Exp $
#
# Copyright (C) 2007 met.no
#
# Contact information:
# Norwegian Meteorological Institute
# Box 43 Blindern
# 0313 OSLO
# NORWAY
# email: kvalobs-dev@met.no
#
# This file is part of KVALOBS_METADATA
#
# KVALOBS_METADATA 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.
#
# KVALOBS_METADATA 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 KVALOBS_METADATA; if not, write to the Free Software Foundation Inc.,
# 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
#checkname: RANGE_CHECK
#signature: obs;X;;|meta;X_1,X_2,X_3,X_4,X_5,X_6;;
# Grenseverdikontroll
# gjør noen tester og returner en ny verdi for flag
sub check {
#tolererer ingen manglende observasjoner:
if ( $X_missing[0] > 0 ) {
return 0;
}
my $flag = 1;
if ( $X[0] < $X_6[0] || $X[0] > $X_1[0] ) {
$flag = 6;
$X_missing[0] = 2;
}
elsif ( $X[0] <= $X_1[0] && $X[0] > $X_2[0] ) {
$flag = 4;
}
elsif ( $X[0] <= $X_2[0] && $X[0] > $X_3[0] ) {
$flag = 2;
}
elsif ( $X[0] < $X_4[0] && $X[0] >= $X_5[0] ) {
$flag = 3;
}
elsif ( $X[0] < $X_5[0] && $X[0] >= $X_6[0] ) {
$flag = 5;
}
my @retvector;
push(@retvector,"X_0_0_flag");
push(@retvector,$flag);
if ( $X_missing[0] > 0 ) {
push(@retvector,"X_0_0_missing");
push(@retvector,$X_missing[0]);
}
my $numout = @retvector;
return (@retvector, $numout);
}
RESULT:
X_0_0_flag = 1
Modified data:
[sid: 100 otime: 2010-07-16 06:00:00 tid: 302 pid: 112 lvl: 0 sen: 0 orig: -1 cor: -1 cinfo: [0|1|0|0|0|0|0|0|0|0|0|0|0|0|0|0] uinfo: [9|9|9|9|9|0|0|0|0|0|0|0|0|0|0|0]]
-------------------------------------------------------------------------------
CHECK: QC1-1-112x - logger_t
Abstract signature: obs;X;;|meta;X_1,X_2,X_3,X_4,X_5;;
Concrete signature: obs;SA;;|meta;SA_1,SA_2,SA_3,SA_4,SA_5;;
SCRIPT:
use strict;
# general
my @obstime = (2010, 7, 16, 6, 0, 0);
# obs
my $obs_missing = 0;
my $obs_numtimes = 1;
my @X = (-1);
my @X_controlinfo = (0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @X_missing = (0);
my @obs_timeoffset = (0);
# meta
my $meta_missing = 0;
my $meta_numtimes = 1;
my @X_1 = (-6999);
my @X_2 = (-99.9);
my @X_3 = (999);
my @X_4 = (6999);
my @X_5 = (9999);
my @meta_timeoffset = (0);
# Kvalobs_Metadata - Free Quality Control Algorithms for Meteorological Observations
#
# $Id: logger_t.pl,v 1.9 2010-06-22 07:08:08 oysteinl Exp $
#
# Copyright (C) 2007 met.no
#
# Contact information:
# Norwegian Meteorological Institute
# Box 43 Blindern
# 0313 OSLO
# NORWAY
# email: kvalobs-dev@met.no
#
# This file is part of KVALOBS_METADATA
#
# KVALOBS_METADATA 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.
#
# KVALOBS_METADATA 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 KVALOBS_METADATA; if not, write to the Free Software Foundation Inc.,
# 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
# checkname : logger_t
# signature: obs;X;;|meta;X_1,X_2,X_3,X_4,X_5;;
# Grenseverdikontroll
# Gjoer tester paa 9999-verdier og returner en ny verdi for grenseverdi-flagg
# (fr=7) og missing-flagg (fmis=3)
# Oystein Lie 2010-02-25
sub check {
##tolererer ingen manglende observasjoner:
#if ( $X_missing[0] > 0 ) {
#return 0;
#}
my $flag=1;
my $missingflag=2;
if ($X_controlinfo[1] == 6 && ($X[0] == X_1 || $X[0] == X_2 || $X[0] == X_3 || $X[0] == X_4 || $X[0] == X_5)) {
$flag=7;
#$X_missing[0]=3;
$missingflag=3;
}
my $retvector;
push (@retvector,"X_0_0_flag");
push (@retvector,$flag);
#if ($X_missing[0]>0) {
if ($missingflag == 3) {
push (@retvector,"X_0_0_missing");
#push (@retvector,$X_missing[0]);
push (@retvector,$missingflag);
}
my $numout = @retvector;
return (@retvector,$numout);
}
-------------------------------------------------------------------------------
CHECK: QC1-1-117 - RANGE_CHECK
Abstract signature: obs;X;;|meta;X_1,X_2,X_3,X_4,X_5,X_6;;
Concrete signature: obs;RR_X;;|meta;RR_X_max,RR_X_highest,RR_X_high,RR_X_low,RR_X_lowest,RR_X_min;;
SCRIPT:
use strict;
# general
my @obstime = (2010, 7, 16, 6, 0, 0);
# obs
my $obs_missing = 1;
my $obs_numtimes = 1;
my @X = (-32767);
my @X_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @X_missing = (3);
my @obs_timeoffset = (0);
# meta
my $meta_missing = 0;
my $meta_numtimes = 1;
my @X_1 = (10000);
my @X_2 = (500);
my @X_3 = (500);
my @X_4 = (-1);
my @X_5 = (-1);
my @X_6 = (-1);
my @meta_timeoffset = (0);
# Kvalobs_Metadata - Free Quality Control Algorithms for Meteorological Observations
#
# $Id: RANGE_CHECK.pl,v 1.2 2007/10/22 16:21:07 paule Exp $
#
# Copyright (C) 2007 met.no
#
# Contact information:
# Norwegian Meteorological Institute
# Box 43 Blindern
# 0313 OSLO
# NORWAY
# email: kvalobs-dev@met.no
#
# This file is part of KVALOBS_METADATA
#
# KVALOBS_METADATA 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.
#
# KVALOBS_METADATA 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 KVALOBS_METADATA; if not, write to the Free Software Foundation Inc.,
# 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
#checkname: RANGE_CHECK
#signature: obs;X;;|meta;X_1,X_2,X_3,X_4,X_5,X_6;;
# Grenseverdikontroll
# gjør noen tester og returner en ny verdi for flag
sub check {
#tolererer ingen manglende observasjoner:
if ( $X_missing[0] > 0 ) {
return 0;
}
my $flag = 1;
if ( $X[0] < $X_6[0] || $X[0] > $X_1[0] ) {
$flag = 6;
$X_missing[0] = 2;
}
elsif ( $X[0] <= $X_1[0] && $X[0] > $X_2[0] ) {
$flag = 4;
}
elsif ( $X[0] <= $X_2[0] && $X[0] > $X_3[0] ) {
$flag = 2;
}
elsif ( $X[0] < $X_4[0] && $X[0] >= $X_5[0] ) {
$flag = 3;
}
elsif ( $X[0] < $X_5[0] && $X[0] >= $X_6[0] ) {
$flag = 5;
}
my @retvector;
push(@retvector,"X_0_0_flag");
push(@retvector,$flag);
if ( $X_missing[0] > 0 ) {
push(@retvector,"X_0_0_missing");
push(@retvector,$X_missing[0]);
}
my $numout = @retvector;
return (@retvector, $numout);
}
RESULT:
-------------------------------------------------------------------------------
CHECK: QC1-1-18 - RANGE_CHECK
Abstract signature: obs;X;;|meta;X_1,X_2,X_3,X_4,X_5,X_6;;
Concrete signature: obs;SD;;|meta;SD_max,SD_highest,SD_high,SD_low,SD_lowest,SD_min;;
SCRIPT:
use strict;
# general
my @obstime = (2010, 7, 16, 6, 0, 0);
# obs
my $obs_missing = 0;
my $obs_numtimes = 1;
my @X = (-1);
my @X_controlinfo = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @X_missing = (0);
my @obs_timeoffset = (0);
# meta
my $meta_missing = 0;
my $meta_numtimes = 1;
my @X_1 = (9);
my @X_2 = (9);
my @X_3 = (9);
my @X_4 = (-1);
my @X_5 = (-1);
my @X_6 = (-1);
my @meta_timeoffset = (0);
# Kvalobs_Metadata - Free Quality Control Algorithms for Meteorological Observations
#
# $Id: RANGE_CHECK.pl,v 1.2 2007/10/22 16:21:07 paule Exp $
#
# Copyright (C) 2007 met.no
#
# Contact information:
# Norwegian Meteorological Institute
# Box 43 Blindern
# 0313 OSLO
# NORWAY
# email: kvalobs-dev@met.no
#
# This file is part of KVALOBS_METADATA
#
# KVALOBS_METADATA 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.
#
# KVALOBS_METADATA 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 KVALOBS_METADATA; if not, write to the Free Software Foundation Inc.,
# 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
#checkname: RANGE_CHECK
#signature: obs;X;;|meta;X_1,X_2,X_3,X_4,X_5,X_6;;
# Grenseverdikontroll
# gjør noen tester og returner en ny verdi for flag
sub check {
#tolererer ingen manglende observasjoner:
if ( $X_missing[0] > 0 ) {
return 0;
}
my $flag = 1;
if ( $X[0] < $X_6[0] || $X[0] > $X_1[0] ) {
$flag = 6;
$X_missing[0] = 2;
}
elsif ( $X[0] <= $X_1[0] && $X[0] > $X_2[0] ) {
$flag = 4;
}
elsif ( $X[0] <= $X_2[0] && $X[0] > $X_3[0] ) {
$flag = 2;
}
elsif ( $X[0] < $X_4[0] && $X[0] >= $X_5[0] ) {
$flag = 3;
}
elsif ( $X[0] < $X_5[0] && $X[0] >= $X_6[0] ) {
$flag = 5;
}
my @retvector;
push(@retvector,"X_0_0_flag");
push(@retvector,$flag);
if ( $X_missing[0] > 0 ) {
push(@retvector,"X_0_0_missing");
push(@retvector,$X_missing[0]);
}
my $numout = @retvector;
return (@retvector, $numout);
}
RESULT:
X_0_0_flag = 1
Modified data:
[sid: 100 otime: 2010-07-16 06:00:00 tid: 302 pid: 18 lvl: 0 sen: 0 orig: -1 cor: -1 cinfo: [0|1|0|0|0|0|0|0|0|0|0|0|0|0|0|0] uinfo: [9|9|9|9|9|0|0|0|0|0|0|0|0|0|0|0]]
-------------------------------------------------------------------------------
CHECK: QC1-1-34 - RANGE_CHECK
Abstract signature: obs;X;;|meta;X_1,X_2,X_3,X_4,X_5,X_6;;
Concrete signature: obs;V4;;|meta;V4_max,V4_highest,V4_high,V4_low,V4_lowest,V4_min;;
SCRIPT:
use strict;
# general
my @obstime = (2010, 7, 16, 6, 0, 0);
# obs
my $obs_missing = 1;
my $obs_numtimes = 1;
my @X = (-32767);
my @X_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @X_missing = (3);
my @obs_timeoffset = (0);
# meta
my $meta_missing = 0;
my $meta_numtimes = 1;
my @X_1 = (29);
my @X_2 = (29);
my @X_3 = (29);
my @X_4 = (1);
my @X_5 = (1);
my @X_6 = (1);
my @meta_timeoffset = (0);
# Kvalobs_Metadata - Free Quality Control Algorithms for Meteorological Observations
#
# $Id: RANGE_CHECK.pl,v 1.2 2007/10/22 16:21:07 paule Exp $
#
# Copyright (C) 2007 met.no
#
# Contact information:
# Norwegian Meteorological Institute
# Box 43 Blindern
# 0313 OSLO
# NORWAY
# email: kvalobs-dev@met.no
#
# This file is part of KVALOBS_METADATA
#
# KVALOBS_METADATA 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.
#
# KVALOBS_METADATA 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 KVALOBS_METADATA; if not, write to the Free Software Foundation Inc.,
# 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
#checkname: RANGE_CHECK
#signature: obs;X;;|meta;X_1,X_2,X_3,X_4,X_5,X_6;;
# Grenseverdikontroll
# gjør noen tester og returner en ny verdi for flag
sub check {
#tolererer ingen manglende observasjoner:
if ( $X_missing[0] > 0 ) {
return 0;
}
my $flag = 1;
if ( $X[0] < $X_6[0] || $X[0] > $X_1[0] ) {
$flag = 6;
$X_missing[0] = 2;
}
elsif ( $X[0] <= $X_1[0] && $X[0] > $X_2[0] ) {
$flag = 4;
}
elsif ( $X[0] <= $X_2[0] && $X[0] > $X_3[0] ) {
$flag = 2;
}
elsif ( $X[0] < $X_4[0] && $X[0] >= $X_5[0] ) {
$flag = 3;
}
elsif ( $X[0] < $X_5[0] && $X[0] >= $X_6[0] ) {
$flag = 5;
}
my @retvector;
push(@retvector,"X_0_0_flag");
push(@retvector,$flag);
if ( $X_missing[0] > 0 ) {
push(@retvector,"X_0_0_missing");
push(@retvector,$X_missing[0]);
}
my $numout = @retvector;
return (@retvector, $numout);
}
RESULT:
-------------------------------------------------------------------------------
CHECK: QC1-1-35 - RANGE_CHECK
Abstract signature: obs;X;;|meta;X_1,X_2,X_3,X_4,X_5,X_6;;
Concrete signature: obs;V4S;;|meta;V4S_max,V4S_highest,V4S_high,V4S_low,V4S_lowest,V4S_min;;
SCRIPT:
use strict;
# general
my @obstime = (2010, 7, 16, 6, 0, 0);
# obs
my $obs_missing = 1;
my $obs_numtimes = 1;
my @X = (-32767);
my @X_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @X_missing = (3);
my @obs_timeoffset = (0);
# meta
my $meta_missing = 0;
my $meta_numtimes = 1;
my @X_1 = (2);
my @X_2 = (2);
my @X_3 = (2);
my @X_4 = (0);
my @X_5 = (0);
my @X_6 = (0);
my @meta_timeoffset = (0);
# Kvalobs_Metadata - Free Quality Control Algorithms for Meteorological Observations
#
# $Id: RANGE_CHECK.pl,v 1.2 2007/10/22 16:21:07 paule Exp $
#
# Copyright (C) 2007 met.no
#
# Contact information:
# Norwegian Meteorological Institute
# Box 43 Blindern
# 0313 OSLO
# NORWAY
# email: kvalobs-dev@met.no
#
# This file is part of KVALOBS_METADATA
#
# KVALOBS_METADATA 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.
#
# KVALOBS_METADATA 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 KVALOBS_METADATA; if not, write to the Free Software Foundation Inc.,
# 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
#checkname: RANGE_CHECK
#signature: obs;X;;|meta;X_1,X_2,X_3,X_4,X_5,X_6;;
# Grenseverdikontroll
# gjør noen tester og returner en ny verdi for flag
sub check {
#tolererer ingen manglende observasjoner:
if ( $X_missing[0] > 0 ) {
return 0;
}
my $flag = 1;
if ( $X[0] < $X_6[0] || $X[0] > $X_1[0] ) {
$flag = 6;
$X_missing[0] = 2;
}
elsif ( $X[0] <= $X_1[0] && $X[0] > $X_2[0] ) {
$flag = 4;
}
elsif ( $X[0] <= $X_2[0] && $X[0] > $X_3[0] ) {
$flag = 2;
}
elsif ( $X[0] < $X_4[0] && $X[0] >= $X_5[0] ) {
$flag = 3;
}
elsif ( $X[0] < $X_5[0] && $X[0] >= $X_6[0] ) {
$flag = 5;
}
my @retvector;
push(@retvector,"X_0_0_flag");
push(@retvector,$flag);
if ( $X_missing[0] > 0 ) {
push(@retvector,"X_0_0_missing");
push(@retvector,$X_missing[0]);
}
my $numout = @retvector;
return (@retvector, $numout);
}
RESULT:
-------------------------------------------------------------------------------
CHECK: QC1-1-36 - RANGE_CHECK
Abstract signature: obs;X;;|meta;X_1,X_2,X_3,X_4,X_5,X_6;;
Concrete signature: obs;V5;;|meta;V5_max,V5_highest,V5_high,V5_low,V5_lowest,V5_min;;
SCRIPT:
use strict;
# general
my @obstime = (2010, 7, 16, 6, 0, 0);
# obs
my $obs_missing = 1;
my $obs_numtimes = 1;
my @X = (-32767);
my @X_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @X_missing = (3);
my @obs_timeoffset = (0);
# meta
my $meta_missing = 0;
my $meta_numtimes = 1;
my @X_1 = (29);
my @X_2 = (29);
my @X_3 = (29);
my @X_4 = (1);
my @X_5 = (1);
my @X_6 = (1);
my @meta_timeoffset = (0);
# Kvalobs_Metadata - Free Quality Control Algorithms for Meteorological Observations
#
# $Id: RANGE_CHECK.pl,v 1.2 2007/10/22 16:21:07 paule Exp $
#
# Copyright (C) 2007 met.no
#
# Contact information:
# Norwegian Meteorological Institute
# Box 43 Blindern
# 0313 OSLO
# NORWAY
# email: kvalobs-dev@met.no
#
# This file is part of KVALOBS_METADATA
#
# KVALOBS_METADATA 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.
#
# KVALOBS_METADATA 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 KVALOBS_METADATA; if not, write to the Free Software Foundation Inc.,
# 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
#checkname: RANGE_CHECK
#signature: obs;X;;|meta;X_1,X_2,X_3,X_4,X_5,X_6;;
# Grenseverdikontroll
# gjør noen tester og returner en ny verdi for flag
sub check {
#tolererer ingen manglende observasjoner:
if ( $X_missing[0] > 0 ) {
return 0;
}
my $flag = 1;
if ( $X[0] < $X_6[0] || $X[0] > $X_1[0] ) {
$flag = 6;
$X_missing[0] = 2;
}
elsif ( $X[0] <= $X_1[0] && $X[0] > $X_2[0] ) {
$flag = 4;
}
elsif ( $X[0] <= $X_2[0] && $X[0] > $X_3[0] ) {
$flag = 2;
}
elsif ( $X[0] < $X_4[0] && $X[0] >= $X_5[0] ) {
$flag = 3;
}
elsif ( $X[0] < $X_5[0] && $X[0] >= $X_6[0] ) {
$flag = 5;
}
my @retvector;
push(@retvector,"X_0_0_flag");
push(@retvector,$flag);
if ( $X_missing[0] > 0 ) {
push(@retvector,"X_0_0_missing");
push(@retvector,$X_missing[0]);
}
my $numout = @retvector;
return (@retvector, $numout);
}
RESULT:
-------------------------------------------------------------------------------
CHECK: QC1-1-37 - RANGE_CHECK
Abstract signature: obs;X;;|meta;X_1,X_2,X_3,X_4,X_5,X_6;;
Concrete signature: obs;V5S;;|meta;V5S_max,V5S_highest,V5S_high,V5S_low,V5S_lowest,V5S_min;;
SCRIPT:
use strict;
# general
my @obstime = (2010, 7, 16, 6, 0, 0);
# obs
my $obs_missing = 1;
my $obs_numtimes = 1;
my @X = (-32767);
my @X_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @X_missing = (3);
my @obs_timeoffset = (0);
# meta
my $meta_missing = 0;
my $meta_numtimes = 1;
my @X_1 = (2);
my @X_2 = (2);
my @X_3 = (2);
my @X_4 = (0);
my @X_5 = (0);
my @X_6 = (0);
my @meta_timeoffset = (0);
# Kvalobs_Metadata - Free Quality Control Algorithms for Meteorological Observations
#
# $Id: RANGE_CHECK.pl,v 1.2 2007/10/22 16:21:07 paule Exp $
#
# Copyright (C) 2007 met.no
#
# Contact information:
# Norwegian Meteorological Institute
# Box 43 Blindern
# 0313 OSLO
# NORWAY
# email: kvalobs-dev@met.no
#
# This file is part of KVALOBS_METADATA
#
# KVALOBS_METADATA 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.
#
# KVALOBS_METADATA 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 KVALOBS_METADATA; if not, write to the Free Software Foundation Inc.,
# 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
#checkname: RANGE_CHECK
#signature: obs;X;;|meta;X_1,X_2,X_3,X_4,X_5,X_6;;
# Grenseverdikontroll
# gjør noen tester og returner en ny verdi for flag
sub check {
#tolererer ingen manglende observasjoner:
if ( $X_missing[0] > 0 ) {
return 0;
}
my $flag = 1;
if ( $X[0] < $X_6[0] || $X[0] > $X_1[0] ) {
$flag = 6;
$X_missing[0] = 2;
}
elsif ( $X[0] <= $X_1[0] && $X[0] > $X_2[0] ) {
$flag = 4;
}
elsif ( $X[0] <= $X_2[0] && $X[0] > $X_3[0] ) {
$flag = 2;
}
elsif ( $X[0] < $X_4[0] && $X[0] >= $X_5[0] ) {
$flag = 3;
}
elsif ( $X[0] < $X_5[0] && $X[0] >= $X_6[0] ) {
$flag = 5;
}
my @retvector;
push(@retvector,"X_0_0_flag");
push(@retvector,$flag);
if ( $X_missing[0] > 0 ) {
push(@retvector,"X_0_0_missing");
push(@retvector,$X_missing[0]);
}
my $numout = @retvector;
return (@retvector, $numout);
}
RESULT:
-------------------------------------------------------------------------------
CHECK: QC1-1-38 - RANGE_CHECK
Abstract signature: obs;X;;|meta;X_1,X_2,X_3,X_4,X_5,X_6;;
Concrete signature: obs;V6;;|meta;V6_max,V6_highest,V6_high,V6_low,V6_lowest,V6_min;;
SCRIPT:
use strict;
# general
my @obstime = (2010, 7, 16, 6, 0, 0);
# obs
my $obs_missing = 1;
my $obs_numtimes = 1;
my @X = (-32767);
my @X_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @X_missing = (3);
my @obs_timeoffset = (0);
# meta
my $meta_missing = 0;
my $meta_numtimes = 1;
my @X_1 = (29);
my @X_2 = (29);
my @X_3 = (29);
my @X_4 = (1);
my @X_5 = (1);
my @X_6 = (1);
my @meta_timeoffset = (0);
# Kvalobs_Metadata - Free Quality Control Algorithms for Meteorological Observations
#
# $Id: RANGE_CHECK.pl,v 1.2 2007/10/22 16:21:07 paule Exp $
#
# Copyright (C) 2007 met.no
#
# Contact information:
# Norwegian Meteorological Institute
# Box 43 Blindern
# 0313 OSLO
# NORWAY
# email: kvalobs-dev@met.no
#
# This file is part of KVALOBS_METADATA
#
# KVALOBS_METADATA 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.
#
# KVALOBS_METADATA 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 KVALOBS_METADATA; if not, write to the Free Software Foundation Inc.,
# 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
#checkname: RANGE_CHECK
#signature: obs;X;;|meta;X_1,X_2,X_3,X_4,X_5,X_6;;
# Grenseverdikontroll
# gjør noen tester og returner en ny verdi for flag
sub check {
#tolererer ingen manglende observasjoner:
if ( $X_missing[0] > 0 ) {
return 0;
}
my $flag = 1;
if ( $X[0] < $X_6[0] || $X[0] > $X_1[0] ) {
$flag = 6;
$X_missing[0] = 2;
}
elsif ( $X[0] <= $X_1[0] && $X[0] > $X_2[0] ) {
$flag = 4;
}
elsif ( $X[0] <= $X_2[0] && $X[0] > $X_3[0] ) {
$flag = 2;
}
elsif ( $X[0] < $X_4[0] && $X[0] >= $X_5[0] ) {
$flag = 3;
}
elsif ( $X[0] < $X_5[0] && $X[0] >= $X_6[0] ) {
$flag = 5;
}
my @retvector;
push(@retvector,"X_0_0_flag");
push(@retvector,$flag);
if ( $X_missing[0] > 0 ) {
push(@retvector,"X_0_0_missing");
push(@retvector,$X_missing[0]);
}
my $numout = @retvector;
return (@retvector, $numout);
}
RESULT:
-------------------------------------------------------------------------------
CHECK: QC1-1-39 - RANGE_CHECK
Abstract signature: obs;X;;|meta;X_1,X_2,X_3,X_4,X_5,X_6;;
Concrete signature: obs;V6S;;|meta;V6S_max,V6S_highest,V6S_high,V6S_low,V6S_lowest,V6S_min;;
SCRIPT:
use strict;
# general
my @obstime = (2010, 7, 16, 6, 0, 0);
# obs
my $obs_missing = 1;
my $obs_numtimes = 1;
my @X = (-32767);
my @X_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @X_missing = (3);
my @obs_timeoffset = (0);
# meta
my $meta_missing = 0;
my $meta_numtimes = 1;
my @X_1 = (2);
my @X_2 = (2);
my @X_3 = (2);
my @X_4 = (0);
my @X_5 = (0);
my @X_6 = (0);
my @meta_timeoffset = (0);
# Kvalobs_Metadata - Free Quality Control Algorithms for Meteorological Observations
#
# $Id: RANGE_CHECK.pl,v 1.2 2007/10/22 16:21:07 paule Exp $
#
# Copyright (C) 2007 met.no
#
# Contact information:
# Norwegian Meteorological Institute
# Box 43 Blindern
# 0313 OSLO
# NORWAY
# email: kvalobs-dev@met.no
#
# This file is part of KVALOBS_METADATA
#
# KVALOBS_METADATA 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.
#
# KVALOBS_METADATA 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 KVALOBS_METADATA; if not, write to the Free Software Foundation Inc.,
# 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
#checkname: RANGE_CHECK
#signature: obs;X;;|meta;X_1,X_2,X_3,X_4,X_5,X_6;;
# Grenseverdikontroll
# gjør noen tester og returner en ny verdi for flag
sub check {
#tolererer ingen manglende observasjoner:
if ( $X_missing[0] > 0 ) {
return 0;
}
my $flag = 1;
if ( $X[0] < $X_6[0] || $X[0] > $X_1[0] ) {
$flag = 6;
$X_missing[0] = 2;
}
elsif ( $X[0] <= $X_1[0] && $X[0] > $X_2[0] ) {
$flag = 4;
}
elsif ( $X[0] <= $X_2[0] && $X[0] > $X_3[0] ) {
$flag = 2;
}
elsif ( $X[0] < $X_4[0] && $X[0] >= $X_5[0] ) {
$flag = 3;
}
elsif ( $X[0] < $X_5[0] && $X[0] >= $X_6[0] ) {
$flag = 5;
}
my @retvector;
push(@retvector,"X_0_0_flag");
push(@retvector,$flag);
if ( $X_missing[0] > 0 ) {
push(@retvector,"X_0_0_missing");
push(@retvector,$X_missing[0]);
}
my $numout = @retvector;
return (@retvector, $numout);
}
RESULT:
-------------------------------------------------------------------------------
CHECK: QC1-2-72.a - snowdepth_snowcover
Abstract signature: obs;SD,SA;;
Concrete signature: obs;SD,SA;;
SCRIPT:
use strict;
# general
my @obstime = (2010, 7, 16, 6, 0, 0);
# obs
my $obs_missing = 0;
my $obs_numtimes = 1;
my @SA = (-1);
my @SA_controlinfo = (0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @SA_missing = (0);
my @SD = (-1);
my @SD_controlinfo = (0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @SD_missing = (0);
my @obs_timeoffset = (0);
# Kvalobs_Metadata - Free Quality Control Algorithms for Meteorological Observations
#
# $Id: snowdepth_snowcover.pl,v 1.4 2007/10/22 16:21:12 paule Exp $
#
# Copyright (C) 2007 met.no
#
# Contact information:
# Norwegian Meteorological Institute
# Box 43 Blindern
# 0313 OSLO
# NORWAY
# email: kvalobs-dev@met.no
#
# This file is part of KVALOBS_METADATA
#
# KVALOBS_METADATA 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.
#
# KVALOBS_METADATA 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 KVALOBS_METADATA; if not, write to the Free Software Foundation Inc.,
# 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
#checkname: snowdepth_snowcover
#signature: obs;SD,SA;;
#Konsistenskontroll check Appendix 5
sub check {
if ($SD_missing[0] > 0) {
# aborter..
return 0;
}
if ($SA_missing[0] > 0) {
# aborter..
return 0;
}
my $flag = 1;
if (($SD[0] < 1 && $SA[0] > 0) || ($SD[0] == 1 && $SA[0] >= 15)) {
$flag= 3;
}
my @retvector;
push(@retvector, "SD_0_0_flag");
push(@retvector, $flag);
push(@retvector, "SA_0_0_flag");
push(@retvector, $flag);
my $numout= @retvector; # antall returverdier
return (@retvector, $numout);
}
RESULT:
SA_0_0_flag = 1
SD_0_0_flag = 1
Modified data:
[sid: 100 otime: 2010-07-16 06:00:00 tid: 302 pid: 18 lvl: 0 sen: 0 orig: -1 cor: -1 cinfo: [0|1|1|0|0|0|0|0|0|0|0|0|0|0|0|0] uinfo: [7|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0]]
[sid: 100 otime: 2010-07-16 06:00:00 tid: 302 pid: 112 lvl: 0 sen: 0 orig: -1 cor: -1 cinfo: [0|1|1|0|0|0|0|0|0|0|0|0|0|0|0|0] uinfo: [7|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0]]
-------------------------------------------------------------------------------
CHECK: QC1-2-72.b1 - geok01_sms_notonly_dew_hoarfrost
Abstract signature: obs;RR,SA,V4,V5,V6;;
Concrete signature: obs;RR_24&&&302,SA&&&302,V4&&&302,V5&&&302,V6&&&302;;0,-1501
SCRIPT:
use strict;
# general
my @obstime = (2010, 7, 16, 6, 0, 0);
# obs
my $obs_missing = 9;
my $obs_numtimes = 3;
my @RR = (10.5, -32767, 0.1);
my @RR_controlinfo = (0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0);
my @RR_missing = (0, 3, 0);
my @SA = (-1, -32767, -1);
my @SA_controlinfo = (0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @SA_missing = (0, 3, 0);
my @V4 = (-32767, 7, 7);
my @V4_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V4_missing = (3, 0, 0);
my @V5 = (-32767, -32767, -32767);
my @V5_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V5_missing = (3, 3, 3);
my @V6 = (-32767, -32767, -32767);
my @V6_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V6_missing = (3, 3, 3);
my @obs_timeoffset = (0, -720, -1440);
# Kvalobs_Metadata - Free Quality Control Algorithms for Meteorological Observations
#
# $Id: geok01_sms_notonly_dew_hoarfrost.pl,v 1.8 2007/10/22 16:21:09 paule Exp $
#
# Copyright (C) 2007 met.no
#
# Contact information:
# Norwegian Meteorological Institute
# Box 43 Blindern
# 0313 OSLO
# NORWAY
# email: kvalobs-dev@met.no
#
# This file is part of KVALOBS_METADATA
#
# KVALOBS_METADATA 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.
#
# KVALOBS_METADATA 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 KVALOBS_METADATA; if not, write to the Free Software Foundation Inc.,
# 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
#language : 1
#checkname : geok01_sms_notonly_dew_hoarfrost
#signature : obs;RR,SA,V4,V5,V6;;
# Konsistenskontroll check Appendix 5
# Kode hentet fra "snowdepth_precip_weather.pl", subcheck 1 (geok)
# Original laget av Per Ove Kjensli i fortran.
# Siva konverterte koden til perl.
# Rettet på av Øystein Lie 14/12-2004
# Ny versjon Terje Reite og Bjørn Nordin 17.6.2005
# Ny versjon Bjørn Nordin 02.12.2005
# Ny versjon Bjørn Nordin 19.12.2005 - Geok splittet opp.
sub check {
my @index_list;
my @index_list2;
my @XRR;
my @XSA;
my @XV4;
my @XV5;
my @XV6;
# my @XX_1;
my @XSA_missing;
my @XV4_missing;
my @XV5_missing;
my @XV6_missing;
my @retvector;
# Tester om controlinfo(4)=6: Skal ikke teste, avbryter.
if ($RR_controlinfo[4] == 6) {
return 0;
}
# Hvis alle parametre mangler: Avbryt, Returverdi-flag=0.
my $b=1;
for(my $i=0; $i< $obs_numtimes; $i++) {
if( $RR_missing[$i] > 0 &&
$SA_missing[$i] > 0 &&
$V4_missing[$i] > 0 &&
$V5_missing[$i] > 0 &&
$V6_missing[$i] > 0 ){
;
}else{
$b=0;
last;
}
}
if( $b == 1 ){
return 0;
}
# Initierer parameter-arrayene:
for(my $i=0; $i<=3; $i++) {
$XRR[$i] = -32767;
$XSA[$i] = -32767;
$XV4[$i] = -32767;
$XV5[$i] = -32767;
$XV6[$i] = -32767;
$XSA_missing[$i] = -32767;
$XV4_missing[$i] = -32767;
$XV5_missing[$i] = -32767;
$XV6_missing[$i] = -32767;
}
# Lager indeks-tabell.
my $N = $obs_numtimes;
for(my $i=0; $i<$N; $i++) {
if($obs_timeoffset[$i]==0) {
push(@index_list,0);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-720) {
push(@index_list,1);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1080) {
push(@index_list,2);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1440) {
push(@index_list,3);
push(@index_list2,$i);
}
}
$N = @index_list;
# Sorterer parametrene på rett plass i tid i parameterarrayene.
for(my $i=0; $i<$N; $i++) {
$XRR[$index_list[$i]] = $RR[$index_list2[$i]];
$XSA[$index_list[$i]] = $SA[$index_list2[$i]];
$XV4[$index_list[$i]] = $V4[$index_list2[$i]];
$XV5[$index_list[$i]] = $V5[$index_list2[$i]];
$XV6[$index_list[$i]] = $V6[$index_list2[$i]];
$XSA_missing[$index_list[$i]] = $SA_missing[$index_list2[$i]];
$XV4_missing[$index_list[$i]] = $V4_missing[$index_list2[$i]];
$XV5_missing[$index_list[$i]] = $V5_missing[$index_list2[$i]];
$XV6_missing[$index_list[$i]] = $V6_missing[$index_list2[$i]];
}
my $sst;
my $regn = "N"; my $sne = "N"; my $sludd = "N";
my $duri = "N"; my $hagl = "N"; my $tord = "N";
my $tosym;
my $hosym;
my $bisym;
my $dk;
my $tolerans;
my @retvector;
my @vx =($XV4[2],$XV5[2],$XV6[2],$XV4[1],$XV5[1],$XV6[1],$XV4[0],$XV5[0],$XV6[0]);
#my @vx_missing =( $V4_missing[2],$V5_missing[2],$V6_missing[2],
# $V4_missing[1],$V5_missing[1],$V6_missing[1],
# $V4_missing[0],$V5_missing[0],$V6_missing[0]);
# the following convention for the hours is used::
# $VX[0] is 0600 today, $VX[1] is 1800 yesterday,$VX[2] is 1200 yesterday, $VX[3] is 0600 yesterday, where X={4,5,6}
# to make this comparison possible @SA is made such that:
# $SA[0] is 0600 today, $SA[1] and $SA[2] is not defined, $SA[3] is 0600 yesterday
$dk = "INGEN";
if ($XSA_missing[0]>0 || $XSA_missing[3]>0) {
$sst = undef;
}else{
if ($XSA[0] ne undef && $XSA[3] ne undef ) {
if ($XSA[3] < 0) {
$XSA[3] = 0;
}
if ($XSA[0] < 0) {
$XSA[0] = 0;
}
$sst = $XSA[0] - $XSA[3];
# $XSA[3] = $XSA[0];
}else{
$sst = undef;
}
}
for(my $i=0; $i<=8; $i++) {
# if( $vx[$i] ne undef && $vx_missing[$i] == 0 ){
if ($vx[$i]==3 || $vx[$i]==7 || $vx[$i]==8) {
$regn = "J";
}
if ($vx[$i]==2 || $vx[$i]==5 || $vx[$i]==6) {
$sne = "J";
}
if ($vx[$i]==1 || $vx[$i]==4) {
$sludd = "J";
}
if ($vx[$i]==17 || $vx[$i]==12 || $vx[$i]==31) {
$duri = "J";
}
if ($vx[$i]==10) {
$hagl = "J";
}
}
$tosym = $regn . $sludd . $sne . $duri . $hagl;
if ($tosym eq "NNNNN") {
$dk = "INGEN";
}
else {
$hosym = $regn . $sludd . $sne;
$dk = "MIKS";
if ($hosym eq "JNN") {
$dk = "REGN";
}
if ($hosym eq "NNJ") {
$dk = "SNE";
}
if ($hosym eq "NNN") {
$bisym = $duri . $hagl;
if ($bisym eq "JN") {
$dk = "DURI";
}
if ($bisym eq "NN") {
$dk = "INGEN";
}
}
if ($dk eq "MIKS") {
if ($sst > 0) {
$dk = "SNE";
} else {
$dk = "REGN";
}
}
}
my $flag = 1;
my $RRfla3 = 1;
my $RRfla4 = 1;
# my @sjekk_flag;
# Initierer sjekk_flag:
# for(my $i=0; $i<=12; $i++) {
# $sjekk_flag[$i] = 0;
# }
# Check no. 72.1 Not only dew / hoar frost --------------------------
if (($XRR[0] == 0.0 || $XRR[0] > 0.5) && $dk eq "DURI") {
$flag = 4;
if ($XV4_missing[0]==0) {
if ($XV4[0]==17 || $XV4[0]==12 || $XV4[0]==31) {
push(@retvector, "V4_0_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V4_0_0_flag", "1");
}
}
if ($XV4_missing[1]==0) {
if ($XV4[1]==17 || $XV4[1]==12 || $XV4[1]==31) {
push(@retvector, "V4_1_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V4_1_0_flag", "1");
}
}
if ($XV4_missing[2]==0) {
if ($XV4[2]==17 || $XV4[2]==12 || $XV4[2]==31) {
push(@retvector, "V4_2_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V4_2_0_flag", "1");
}
}
if ($XV5_missing[0]==0) {
if ($XV5[0]==17 || $XV5[0]==12 || $XV5[0]==31) {
push(@retvector, "V5_0_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V5_0_0_flag", "1");
}
}
if ($XV5_missing[1]==0) {
if ($XV5[1]==17 || $XV5[1]==12 || $XV5[1]==31) {
push(@retvector, "V5_1_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V5_1_0_flag", "1");
}
}
if ($XV5_missing[2]==0) {
if ($XV5[2]==17 || $XV5[2]==12 || $XV5[2]==31) {
push(@retvector, "V5_2_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V5_2_0_flag", "1");
}
}
if ($XV6_missing[0]==0) {
if ($XV6[0]==17 || $XV6[0]==12 || $XV6[0]==31) {
push(@retvector, "V6_0_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V6_0_0_flag", "1");
}
}
if ($XV6_missing[1]==0) {
if ($XV6[1]==17 || $XV6[1]==12 || $XV6[1]==31) {
push(@retvector, "V6_1_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V6_1_0_flag", "1");
}
}
if ($XV6_missing[2]==0) {
if ($XV6[2]==17 || $XV6[2]==12 || $XV6[2]==31) {
push(@retvector, "V6_2_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V6_2_0_flag", "1");
}
}
}
#---------------------------------------------------------------------------------
if ($RR_missing[0]==0) {
if ($RRfla3 == 3 && $RRfla4 != 4) {
push(@retvector, "RR_0_0_flag", $RRfla3);
} elsif ($RRfla4 == 4) {
push(@retvector, "RR_0_0_flag", $RRfla4);
} elsif ($RRfla3 == 1 && $RRfla4 == 1) {
push(@retvector, "RR_0_0_flag", "1");
}
}
#---------------------------------------------------------------------------------
my $numout= @retvector; # antall returverdier
if ($numout == 0) {
# print "Alt er OK";
return 0;
}
return (@retvector, $numout);
}
RESULT:
RR_0_0_flag = 1
Modified data:
[sid: 100 otime: 2010-07-16 06:00:00 tid: 302 pid: 110 lvl: 0 sen: 0 orig: 10.5 cor: 10.5 cinfo: [0|1|1|0|0|0|0|0|0|0|0|0|0|0|0|0] uinfo: [7|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0]]
-------------------------------------------------------------------------------
CHECK: QC1-2-72.b10 - geok10_sms_snowdepth_decreasing_to_0
Abstract signature: obs;RR,SA,V4,V5,V6;;0,-1501
Concrete signature: obs;RR_24&&&302,SA&&&302,V4&&&302,V5&&&302,V6&&&302;;0,-1501
SCRIPT:
use strict;
# general
my @obstime = (2010, 7, 16, 6, 0, 0);
# obs
my $obs_missing = 9;
my $obs_numtimes = 3;
my @RR = (10.5, -32767, 0.1);
my @RR_controlinfo = (0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0);
my @RR_missing = (0, 3, 0);
my @SA = (-1, -32767, -1);
my @SA_controlinfo = (0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @SA_missing = (0, 3, 0);
my @V4 = (-32767, 7, 7);
my @V4_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V4_missing = (3, 0, 0);
my @V5 = (-32767, -32767, -32767);
my @V5_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V5_missing = (3, 3, 3);
my @V6 = (-32767, -32767, -32767);
my @V6_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V6_missing = (3, 3, 3);
my @obs_timeoffset = (0, -720, -1440);
# Kvalobs_Metadata - Free Quality Control Algorithms for Meteorological Observations
#
# $Id: geok10_sms_snowdepth_decreasing_to_0.pl,v 1.7 2007/10/22 16:21:09 paule Exp $
#
# Copyright (C) 2007 met.no
#
# Contact information:
# Norwegian Meteorological Institute
# Box 43 Blindern
# 0313 OSLO
# NORWAY
# email: kvalobs-dev@met.no
#
# This file is part of KVALOBS_METADATA
#
# KVALOBS_METADATA 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.
#
# KVALOBS_METADATA 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 KVALOBS_METADATA; if not, write to the Free Software Foundation Inc.,
# 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
#language : 1
#checkname: geok10_sms_snowdepth_decreasing_to_0
#signature: obs;RR,SA,V4,V5,V6;;0,-1501
# Konsistenskontroll check Appendix 5
# Kode hentet fra "snowdepth_precip_weather.pl", subcheck 10 (geok)
# Original laget av Per Ove Kjensli i fortran.
# Siva konverterte koden til perl.
# Rettet på av Øystein Lie 14/12-2004
# Ny versjon Terje Reite og Bjørn Nordin 17.6.2005
# Ny versjon Bjørn Nordin 02.12.2005
# Ny versjon Bjørn Nordin 02.01.2006 - Geok splittet opp.
sub check {
my @index_list;
my @index_list2;
my @XRR;
my @XSA;
my @XV4;
my @XV5;
my @XV6;
# my @XX_1;
my @XSA_missing;
my @XV4_missing;
my @XV5_missing;
my @XV6_missing;
my @retvector;
# Tester om controlinfo(4)=6: Skal ikke teste, avbryter.
if ($RR_controlinfo[4] == 6) {
return 0;
}
# Tester om SA mangler: Skal ikke teste, avbryter.
for(my $i=0; $i< $obs_numtimes; $i++) {
if ($SA_missing[$i] > 0 && ($obs_timeoffset[$i] == 0 || $obs_timeoffset[$i] == -1440)) {
return 0;
}
}
# Hvis alle parametre mangler: Avbryt, Returverdi-flag=0.
my $b=1;
for(my $i=0; $i< $obs_numtimes; $i++) {
if( $RR_missing[$i] > 0 &&
$SA_missing[$i] > 0 &&
$V4_missing[$i] > 0 &&
$V5_missing[$i] > 0 &&
$V6_missing[$i] > 0 ){
;
}else{
$b=0;
last;
}
}
if( $b == 1 ){
return 0;
}
# Initierer parameter-arrayene:
for(my $i=0; $i<=3; $i++) {
$XRR[$i] = -32767;
$XSA[$i] = -32767;
$XV4[$i] = -32767;
$XV5[$i] = -32767;
$XV6[$i] = -32767;
$XSA_missing[$i] = -32767;
$XV4_missing[$i] = -32767;
$XV5_missing[$i] = -32767;
$XV6_missing[$i] = -32767;
}
# Lager indeks-tabell.
my $N = $obs_numtimes;
for(my $i=0; $i<$N; $i++) {
if($obs_timeoffset[$i]==0) {
push(@index_list,0);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-720) {
push(@index_list,1);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1080) {
push(@index_list,2);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1440) {
push(@index_list,3);
push(@index_list2,$i);
}
}
$N = @index_list;
# Sorterer parametrene på rett plass i tid i parameterarrayene.
for(my $i=0; $i<$N; $i++) {
$XRR[$index_list[$i]] = $RR[$index_list2[$i]];
$XSA[$index_list[$i]] = $SA[$index_list2[$i]];
$XV4[$index_list[$i]] = $V4[$index_list2[$i]];
$XV5[$index_list[$i]] = $V5[$index_list2[$i]];
$XV6[$index_list[$i]] = $V6[$index_list2[$i]];
$XSA_missing[$index_list[$i]] = $SA_missing[$index_list2[$i]];
$XV4_missing[$index_list[$i]] = $V4_missing[$index_list2[$i]];
$XV5_missing[$index_list[$i]] = $V5_missing[$index_list2[$i]];
$XV6_missing[$index_list[$i]] = $V6_missing[$index_list2[$i]];
}
my $sst;
my $regn = "N"; my $sne = "N"; my $sludd = "N";
my $duri = "N"; my $hagl = "N"; my $tord = "N";
my $tosym;
my $hosym;
my $bisym;
my $dk;
my $tolerans;
my @retvector;
my @vx =($XV4[2],$XV5[2],$XV6[2],$XV4[1],$XV5[1],$XV6[1],$XV4[0],$XV5[0],$XV6[0]);
#my @vx_missing =( $V4_missing[2],$V5_missing[2],$V6_missing[2],
# $V4_missing[1],$V5_missing[1],$V6_missing[1],
# $V4_missing[0],$V5_missing[0],$V6_missing[0]);
# the following convention for the hours is used::
# $VX[0] is 0600 today, $VX[1] is 1800 yesterday,$VX[2] is 1200 yesterday, $VX[3] is 0600 yesterday, where X={4,5,6}
# to make this comparison possible @SA is made such that:
# $SA[0] is 0600 today, $SA[1] and $SA[2] is not defined, $SA[3] is 0600 yesterday
$dk = "INGEN";
if ($XSA_missing[0]>0 || $XSA_missing[3]>0) {
$sst = undef;
}else{
if ($XSA[0] ne undef && $XSA[3] ne undef ) {
if ($XSA[3] < 0) {
$XSA[3] = 0;
}
if ($XSA[0] < 0) {
$XSA[0] = 0;
}
$sst = $XSA[0] - $XSA[3];
# $XSA[3] = $XSA[0];
}else{
$sst = undef;
}
}
for(my $i=0; $i<=8; $i++) {
# if( $vx[$i] ne undef && $vx_missing[$i] == 0 ){
if ($vx[$i]==3 || $vx[$i]==7 || $vx[$i]==8) {
$regn = "J";
}
if ($vx[$i]==2 || $vx[$i]==5 || $vx[$i]==6) {
$sne = "J";
}
if ($vx[$i]==1 || $vx[$i]==4) {
$sludd = "J";
}
if ($vx[$i]==17 || $vx[$i]==12 || $vx[$i]==31) {
$duri = "J";
}
if ($vx[$i]==10) {
$hagl = "J";
}
}
$tosym = $regn . $sludd . $sne . $duri . $hagl;
if ($tosym eq "NNNNN") {
$dk = "INGEN";
}
else {
$hosym = $regn . $sludd . $sne;
$dk = "MIKS";
if ($hosym eq "JNN") {
$dk = "REGN";
}
if ($hosym eq "NNJ") {
$dk = "SNE";
}
if ($hosym eq "NNN") {
$bisym = $duri . $hagl;
if ($bisym eq "JN") {
$dk = "DURI";
}
if ($bisym eq "NN") {
$dk = "INGEN";
}
}
if ($dk eq "MIKS") {
if ($sst > 0) {
$dk = "SNE";
} else {
$dk = "REGN";
}
}
}
my $flag = 1;
my $RRfla3 = 1;
my $RRfla4 = 1;
# Check no. 72.10 Snow depth decreasing to 0 ------------------------
if ($sst < -15 && $XSA[0] <= 0 && $dk eq "SNE") {
$flag = 4;
if ($XV4_missing[0]==0) {
if ($XV4[0]==2 || $XV4[0]==5 || $XV4[0]==6) {
push(@retvector, "V4_0_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V4_0_0_flag", "1");
}
}
if ($XV4_missing[1]==0) {
if ($XV4[1]==2 || $XV4[1]==5 || $XV4[1]==6) {
push(@retvector, "V4_1_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V4_1_0_flag", "1");
}
}
if ($XV4_missing[2]==0) {
if ($XV4[2]==2 || $XV4[2]==5 || $XV4[2]==6) {
push(@retvector, "V4_2_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V4_2_0_flag", "1");
}
}
if ($XV5_missing[0]==0) {
if ($XV5[0]==2 || $XV5[0]==5 || $XV5[0]==6) {
push(@retvector, "V5_0_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V5_0_0_flag", "1");
}
}
if ($XV5_missing[1]==0) {
if ($XV5[1]==2 || $XV5[1]==5 || $XV5[1]==6) {
push(@retvector, "V5_1_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V5_1_0_flag", "1");
}
}
if ($XV5_missing[2]==0) {
if ($XV5[2]==2 || $XV5[2]==5 || $XV5[2]==6) {
push(@retvector, "V5_2_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V5_2_0_flag", "1");
}
}
if ($XV6_missing[0]==0) {
if ($XV6[0]==2 || $XV6[0]==5 || $XV6[0]==6) {
push(@retvector, "V6_0_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V6_0_0_flag", "1");
}
}
if ($XV6_missing[1]==0) {
if ($XV6[1]==2 || $XV6[1]==5 || $XV6[1]==6) {
push(@retvector, "V6_1_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V6_1_0_flag", "1");
}
}
if ($XV6_missing[2]==0) {
if ($XV6[2]==2 || $XV6[2]==5 || $XV6[2]==6) {
push(@retvector, "V6_2_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V6_2_0_flag", "1");
}
}
}
#---------------------------------------------------------------------------------
if ($RR_missing[0]==0) {
if ($RRfla3 == 3 && $RRfla4 != 4) {
push(@retvector, "RR_0_0_flag", $RRfla3);
} elsif ($RRfla4 == 4) {
push(@retvector, "RR_0_0_flag", $RRfla4);
} elsif ($RRfla3 == 1 && $RRfla4 == 1) {
push(@retvector, "RR_0_0_flag", "1");
}
}
#---------------------------------------------------------------------------------
if ($XSA_missing[0]==0) {
if ($flag == 4) {
push(@retvector, "SA_0_0_flag", "4");
} elsif ($flag == 1) {
push(@retvector, "SA_0_0_flag", "1");
}
}
#---------------------------------------------------------------------------------
# else {
# print "manglende defaulthåndtering";
# }
my $numout= @retvector; # antall returverdier
if ($numout == 0) {
# print "Alt er OK";
return 0;
}
return (@retvector, $numout);
}
RESULT:
RR_0_0_flag = 1
SA_0_0_flag = 1
-------------------------------------------------------------------------------
CHECK: QC1-2-72.b11 - geok11_sms_noprecip_but_precipsymbol
Abstract signature: obs;RR,SA,V4,V5,V6;;
Concrete signature: obs;RR_24&&&302,SA&&&302,V4&&&302,V5&&&302,V6&&&302;;0,-1501
SCRIPT:
use strict;
# general
my @obstime = (2010, 7, 16, 6, 0, 0);
# obs
my $obs_missing = 9;
my $obs_numtimes = 3;
my @RR = (10.5, -32767, 0.1);
my @RR_controlinfo = (0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0);
my @RR_missing = (0, 3, 0);
my @SA = (-1, -32767, -1);
my @SA_controlinfo = (0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @SA_missing = (0, 3, 0);
my @V4 = (-32767, 7, 7);
my @V4_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V4_missing = (3, 0, 0);
my @V5 = (-32767, -32767, -32767);
my @V5_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V5_missing = (3, 3, 3);
my @V6 = (-32767, -32767, -32767);
my @V6_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V6_missing = (3, 3, 3);
my @obs_timeoffset = (0, -720, -1440);
# Kvalobs_Metadata - Free Quality Control Algorithms for Meteorological Observations
#
# $Id: geok11_sms_noprecip_but_precipsymbol.pl,v 1.6 2007/10/22 16:21:10 paule Exp $
#
# Copyright (C) 2007 met.no
#
# Contact information:
# Norwegian Meteorological Institute
# Box 43 Blindern
# 0313 OSLO
# NORWAY
# email: kvalobs-dev@met.no
#
# This file is part of KVALOBS_METADATA
#
# KVALOBS_METADATA 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.
#
# KVALOBS_METADATA 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 KVALOBS_METADATA; if not, write to the Free Software Foundation Inc.,
# 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
#language : 1
#checkname: geok11_sms_noprecip_but_precipsymbol
#signature: obs;RR,SA,V4,V5,V6;;
# Konsistenskontroll check Appendix 5
# Kode hentet fra "snowdepth_precip_weather.pl", subcheck 11 (geok)
# Original laget av Per Ove Kjensli i fortran.
# Siva konverterte koden til perl.
# Rettet på av Øystein Lie 14/12-2004
# Ny versjon Terje Reite og Bjørn Nordin 17.6.2005
# Ny versjon Bjørn Nordin 02.12.2005
# Ny versjon Bjørn Nordin 02.01.2006 - Geok splittet opp.
sub check {
my @index_list;
my @index_list2;
my @XRR;
my @XSA;
my @XV4;
my @XV5;
my @XV6;
# my @XX_1;
my @XSA_missing;
my @XV4_missing;
my @XV5_missing;
my @XV6_missing;
my @retvector;
# Tester om controlinfo(4)=6: Skal ikke teste, avbryter.
if ($RR_controlinfo[4] == 6) {
return 0;
}
# Hvis alle parametre mangler: Avbryt, Returverdi-flag=0.
my $b=1;
for(my $i=0; $i< $obs_numtimes; $i++) {
if( $RR_missing[$i] > 0 &&
$SA_missing[$i] > 0 &&
$V4_missing[$i] > 0 &&
$V5_missing[$i] > 0 &&
$V6_missing[$i] > 0 ){
;
}else{
$b=0;
last;
}
}
if( $b == 1 ){
return 0;
}
# Initierer parameter-arrayene:
for(my $i=0; $i<=3; $i++) {
$XRR[$i] = -32767;
$XSA[$i] = -32767;
$XV4[$i] = -32767;
$XV5[$i] = -32767;
$XV6[$i] = -32767;
$XSA_missing[$i] = -32767;
$XV4_missing[$i] = -32767;
$XV5_missing[$i] = -32767;
$XV6_missing[$i] = -32767;
}
# Lager indeks-tabell.
my $N = $obs_numtimes;
for(my $i=0; $i<$N; $i++) {
if($obs_timeoffset[$i]==0) {
push(@index_list,0);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-720) {
push(@index_list,1);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1080) {
push(@index_list,2);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1440) {
push(@index_list,3);
push(@index_list2,$i);
}
}
$N = @index_list;
# Sorterer parametrene på rett plass i tid i parameterarrayene.
for(my $i=0; $i<$N; $i++) {
$XRR[$index_list[$i]] = $RR[$index_list2[$i]];
$XSA[$index_list[$i]] = $SA[$index_list2[$i]];
$XV4[$index_list[$i]] = $V4[$index_list2[$i]];
$XV5[$index_list[$i]] = $V5[$index_list2[$i]];
$XV6[$index_list[$i]] = $V6[$index_list2[$i]];
$XSA_missing[$index_list[$i]] = $SA_missing[$index_list2[$i]];
$XV4_missing[$index_list[$i]] = $V4_missing[$index_list2[$i]];
$XV5_missing[$index_list[$i]] = $V5_missing[$index_list2[$i]];
$XV6_missing[$index_list[$i]] = $V6_missing[$index_list2[$i]];
}
my $sst;
my $regn = "N"; my $sne = "N"; my $sludd = "N";
my $duri = "N"; my $hagl = "N"; my $tord = "N";
my $tosym;
my $hosym;
my $bisym;
my $dk;
my $tolerans;
my @retvector;
my @vx =($XV4[2],$XV5[2],$XV6[2],$XV4[1],$XV5[1],$XV6[1],$XV4[0],$XV5[0],$XV6[0]);
#my @vx_missing =( $V4_missing[2],$V5_missing[2],$V6_missing[2],
# $V4_missing[1],$V5_missing[1],$V6_missing[1],
# $V4_missing[0],$V5_missing[0],$V6_missing[0]);
# the following convention for the hours is used::
# $VX[0] is 0600 today, $VX[1] is 1800 yesterday,$VX[2] is 1200 yesterday, $VX[3] is 0600 yesterday, where X={4,5,6}
# to make this comparison possible @SA is made such that:
# $SA[0] is 0600 today, $SA[1] and $SA[2] is not defined, $SA[3] is 0600 yesterday
$dk = "INGEN";
if ($XSA_missing[0]>0 || $XSA_missing[3]>0) {
$sst = undef;
}else{
if ($XSA[0] ne undef && $XSA[3] ne undef ) {
if ($XSA[3] < 0) {
$XSA[3] = 0;
}
if ($XSA[0] < 0) {
$XSA[0] = 0;
}
$sst = $XSA[0] - $XSA[3];
# $XSA[3] = $XSA[0];
}else{
$sst = undef;
}
}
for(my $i=0; $i<=8; $i++) {
# if( $vx[$i] ne undef && $vx_missing[$i] == 0 ){
if ($vx[$i]==3 || $vx[$i]==7 || $vx[$i]==8) {
$regn = "J";
}
if ($vx[$i]==2 || $vx[$i]==5 || $vx[$i]==6) {
$sne = "J";
}
if ($vx[$i]==1 || $vx[$i]==4) {
$sludd = "J";
}
if ($vx[$i]==17 || $vx[$i]==12 || $vx[$i]==31) {
$duri = "J";
}
if ($vx[$i]==10) {
$hagl = "J";
}
}
$tosym = $regn . $sludd . $sne . $duri . $hagl;
if ($tosym eq "NNNNN") {
$dk = "INGEN";
}
else {
$hosym = $regn . $sludd . $sne;
$dk = "MIKS";
if ($hosym eq "JNN") {
$dk = "REGN";
}
if ($hosym eq "NNJ") {
$dk = "SNE";
}
if ($hosym eq "NNN") {
$bisym = $duri . $hagl;
if ($bisym eq "JN") {
$dk = "DURI";
}
if ($bisym eq "NN") {
$dk = "INGEN";
}
}
if ($dk eq "MIKS") {
if ($sst > 0) {
$dk = "SNE";
} else {
$dk = "REGN";
}
}
}
my $flag = 1;
my $RRfla3 = 1;
my $RRfla4 = 1;
# Check no. 72.11 No precipitation / but precipitation symbol ------------
if ((($XRR[0] > -2 && $XRR[0] < 0) || ($RR_missing[0] > 0)) && $dk ne "INGEN" ) {
$flag = 4;
if ($XV4_missing[0]==0) {
if (($XV4[0]>=1 && $XV4[0]<=8) || $XV4[0]==10 || $XV4[0]==12 || $XV4[0]==17 || $XV4[0]==31) {
push(@retvector, "V4_0_0_flag", "4");
if ($RR_missing[0] == 0) {
$RRfla4 = 4;
}
} else {
push(@retvector, "V4_0_0_flag", "1");
}
}
if ($XV4_missing[1]==0) {
if (($XV4[1]>=1 && $XV4[1]<=8) || $XV4[1]==10 || $XV4[1]==12 || $XV4[1]==17 || $XV4[1]==31) {
push(@retvector, "V4_1_0_flag", "4");
if ($RR_missing[0] == 0) {
$RRfla4 = 4;
}
} else {
push(@retvector, "V4_1_0_flag", "1");
}
}
if ($XV4_missing[2]==0) {
if (($XV4[2]>=1 && $XV4[2]<=8) || $XV4[2]==10 || $XV4[2]==12 || $XV4[2]==17 || $XV4[2]==31) {
push(@retvector, "V4_2_0_flag", "4");
if ($RR_missing[0] == 0) {
$RRfla4 = 4;
}
} else {
push(@retvector, "V4_2_0_flag", "1");
}
}
if ($XV5_missing[0]==0) {
if (($XV5[0]>=1 && $XV5[0]<=8) || $XV5[0]==10 || $XV5[0]==12 || $XV5[0]==17 || $XV5[0]==31) {
push(@retvector, "V5_0_0_flag", "4");
if ($RR_missing[0] == 0) {
$RRfla4 = 4;
}
} else {
push(@retvector, "V5_0_0_flag", "1");
}
}
if ($XV5_missing[1]==0) {
if (($XV5[1]>=1 && $XV5[1]<=8) || $XV5[1]==10 || $XV5[1]==12 || $XV5[1]==17 || $XV5[1]==31) {
push(@retvector, "V5_1_0_flag", "4");
if ($RR_missing[0] == 0) {
$RRfla4 = 4;
}
} else {
push(@retvector, "V5_1_0_flag", "1");
}
}
if ($XV5_missing[2]==0) {
if (($XV5[2]>=1 && $XV5[2]<=8) || $XV5[2]==10 || $XV5[2]==12 || $XV5[2]==17 || $XV5[2]==31) {
push(@retvector, "V5_2_0_flag", "4");
if ($RR_missing[0] == 0) {
$RRfla4 = 4;
}
} else {
push(@retvector, "V5_2_0_flag", "1");
}
}
if ($XV6_missing[0]==0) {
if (($XV6[0]>=1 && $XV6[0]<=8) || $XV6[0]==10 || $XV6[0]==12 || $XV6[0]==17 || $XV6[0]==31) {
push(@retvector, "V6_0_0_flag", "4");
if ($RR_missing[0] == 0) {
$RRfla4 = 4;
}
} else {
push(@retvector, "V6_0_0_flag", "1");
}
}
if ($XV6_missing[1]==0) {
if (($XV6[1]>=1 && $XV6[1]<=8) || $XV6[1]==10 || $XV6[1]==12 || $XV6[1]==17 || $XV6[1]==31) {
push(@retvector, "V6_1_0_flag", "4");
if ($RR_missing[0] == 0) {
$RRfla4 = 4;
}
} else {
push(@retvector, "V6_1_0_flag", "1");
}
}
if ($XV6_missing[2]==0) {
if (($XV6[2]>=1 && $XV6[2]<=8) || $XV6[2]==10 || $XV6[2]==12 || $XV6[2]==17 || $XV6[2]==31) {
push(@retvector, "V6_2_0_flag", "4");
if ($RR_missing[0] == 0) {
$RRfla4 = 4;
}
} else {
push(@retvector, "V6_2_0_flag", "1");
}
}
}
#---------------------------------------------------------------------------------
if ($RR_missing[0]==0) {
if ($RRfla3 == 3 && $RRfla4 != 4) {
push(@retvector, "RR_0_0_flag", $RRfla3);
} elsif ($RRfla4 == 4) {
push(@retvector, "RR_0_0_flag", $RRfla4);
} elsif ($RRfla3 == 1 && $RRfla4 == 1) {
push(@retvector, "RR_0_0_flag", "1");
}
}
#---------------------------------------------------------------------------------
# else {
# print "manglende defaulthåndtering";
# }
my $numout= @retvector; # antall returverdier
if ($numout == 0) {
# print "Alt er OK";
return 0;
}
return (@retvector, $numout);
}
RESULT:
RR_0_0_flag = 1
-------------------------------------------------------------------------------
CHECK: QC1-2-72.b12 - geok12_sms_precip_but_noprecipsymbol
Abstract signature: obs;RR,SA,V4,V5,V6;;
Concrete signature: obs;RR_24&&&302,SA&&&302,V4&&&302,V5&&&302,V6&&&302;;0,-1501
SCRIPT:
use strict;
# general
my @obstime = (2010, 7, 16, 6, 0, 0);
# obs
my $obs_missing = 9;
my $obs_numtimes = 3;
my @RR = (10.5, -32767, 0.1);
my @RR_controlinfo = (0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0);
my @RR_missing = (0, 3, 0);
my @SA = (-1, -32767, -1);
my @SA_controlinfo = (0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @SA_missing = (0, 3, 0);
my @V4 = (-32767, 7, 7);
my @V4_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V4_missing = (3, 0, 0);
my @V5 = (-32767, -32767, -32767);
my @V5_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V5_missing = (3, 3, 3);
my @V6 = (-32767, -32767, -32767);
my @V6_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V6_missing = (3, 3, 3);
my @obs_timeoffset = (0, -720, -1440);
# Kvalobs_Metadata - Free Quality Control Algorithms for Meteorological Observations
#
# $Id: geok12_sms_precip_but_noprecipsymbol.pl,v 1.7 2007/10/22 16:21:10 paule Exp $
#
# Copyright (C) 2007 met.no
#
# Contact information:
# Norwegian Meteorological Institute
# Box 43 Blindern
# 0313 OSLO
# NORWAY
# email: kvalobs-dev@met.no
#
# This file is part of KVALOBS_METADATA
#
# KVALOBS_METADATA 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.
#
# KVALOBS_METADATA 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 KVALOBS_METADATA; if not, write to the Free Software Foundation Inc.,
# 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
#language : 1
#checkname: geok12_sms_precip_but_noprecipsymbol
#signature: obs;RR,SA,V4,V5,V6;;
#Konsistenskontroll check Appendix 5
# Kode hentet fra "snowdepth_precip_weather.pl", subcheck 12 (geok)
# Original laget av Per Ove Kjensli i fortran.
# Siva konverterte koden til perl.
# Rettet på av Øystein Lie 14/12-2004
# Ny versjon Terje Reite og Bjørn Nordin 17.6.2005
# Ny versjon Bjørn Nordin 02.12.2005
# Ny versjon Bjørn Nordin 02.01.2006 - Geok splittet opp.
sub check {
my @index_list;
my @index_list2;
my @XRR;
my @XSA;
my @XV4;
my @XV5;
my @XV6;
# my @XX_1;
my @XSA_missing;
my @XV4_missing;
my @XV5_missing;
my @XV6_missing;
my @retvector;
# Tester om controlinfo(4)=6: Skal ikke teste, avbryter.
if ($RR_controlinfo[4] == 6) {
return 0;
}
# Hvis alle parametre mangler: Avbryt, Returverdi-flag=0.
my $b=1;
for(my $i=0; $i< $obs_numtimes; $i++) {
if( $RR_missing[$i] > 0 &&
$SA_missing[$i] > 0 &&
$V4_missing[$i] > 0 &&
$V5_missing[$i] > 0 &&
$V6_missing[$i] > 0 ){
;
}else{
$b=0;
last;
}
}
if( $b == 1 ){
return 0;
}
# Initierer parameter-arrayene:
for(my $i=0; $i<=3; $i++) {
$XRR[$i] = -32767;
$XSA[$i] = -32767;
$XV4[$i] = -32767;
$XV5[$i] = -32767;
$XV6[$i] = -32767;
$XSA_missing[$i] = -32767;
$XV4_missing[$i] = -32767;
$XV5_missing[$i] = -32767;
$XV6_missing[$i] = -32767;
}
# Lager indeks-tabell.
my $N = $obs_numtimes;
for(my $i=0; $i<$N; $i++) {
if($obs_timeoffset[$i]==0) {
push(@index_list,0);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-720) {
push(@index_list,1);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1080) {
push(@index_list,2);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1440) {
push(@index_list,3);
push(@index_list2,$i);
}
}
$N = @index_list;
# Sorterer parametrene på rett plass i tid i parameterarrayene.
for(my $i=0; $i<$N; $i++) {
$XRR[$index_list[$i]] = $RR[$index_list2[$i]];
$XSA[$index_list[$i]] = $SA[$index_list2[$i]];
$XV4[$index_list[$i]] = $V4[$index_list2[$i]];
$XV5[$index_list[$i]] = $V5[$index_list2[$i]];
$XV6[$index_list[$i]] = $V6[$index_list2[$i]];
$XSA_missing[$index_list[$i]] = $SA_missing[$index_list2[$i]];
$XV4_missing[$index_list[$i]] = $V4_missing[$index_list2[$i]];
$XV5_missing[$index_list[$i]] = $V5_missing[$index_list2[$i]];
$XV6_missing[$index_list[$i]] = $V6_missing[$index_list2[$i]];
}
my $sst;
my $regn = "N"; my $sne = "N"; my $sludd = "N";
my $duri = "N"; my $hagl = "N"; my $tord = "N";
my $tosym;
my $hosym;
my $bisym;
my $dk;
my $tolerans;
my @retvector;
my @vx =($XV4[2],$XV5[2],$XV6[2],$XV4[1],$XV5[1],$XV6[1],$XV4[0],$XV5[0],$XV6[0]);
#my @vx_missing =( $V4_missing[2],$V5_missing[2],$V6_missing[2],
# $V4_missing[1],$V5_missing[1],$V6_missing[1],
# $V4_missing[0],$V5_missing[0],$V6_missing[0]);
# the following convention for the hours is used::
# $VX[0] is 0600 today, $VX[1] is 1800 yesterday,$VX[2] is 1200 yesterday, $VX[3] is 0600 yesterday, where X={4,5,6}
# to make this comparison possible @SA is made such that:
# $SA[0] is 0600 today, $SA[1] and $SA[2] is not defined, $SA[3] is 0600 yesterday
$dk = "INGEN";
if ($XSA_missing[0]>0 || $XSA_missing[3]>0) {
$sst = undef;
}else{
if ($XSA[0] ne undef && $XSA[3] ne undef ) {
if ($XSA[3] < 0) {
$XSA[3] = 0;
}
if ($XSA[0] < 0) {
$XSA[0] = 0;
}
$sst = $XSA[0] - $XSA[3];
# $XSA[3] = $XSA[0];
}else{
$sst = undef;
}
}
for(my $i=0; $i<=8; $i++) {
# if( $vx[$i] ne undef && $vx_missing[$i] == 0 ){
if ($vx[$i]==3 || $vx[$i]==7 || $vx[$i]==8) {
$regn = "J";
}
if ($vx[$i]==2 || $vx[$i]==5 || $vx[$i]==6) {
$sne = "J";
}
if ($vx[$i]==1 || $vx[$i]==4) {
$sludd = "J";
}
if ($vx[$i]==17 || $vx[$i]==12 || $vx[$i]==31) {
$duri = "J";
}
if ($vx[$i]==10) {
$hagl = "J";
}
}
$tosym = $regn . $sludd . $sne . $duri . $hagl;
if ($tosym eq "NNNNN") {
$dk = "INGEN";
}
else {
$hosym = $regn . $sludd . $sne;
$dk = "MIKS";
if ($hosym eq "JNN") {
$dk = "REGN";
}
if ($hosym eq "NNJ") {
$dk = "SNE";
}
if ($hosym eq "NNN") {
$bisym = $duri . $hagl;
if ($bisym eq "JN") {
$dk = "DURI";
}
if ($bisym eq "NN") {
$dk = "INGEN";
}
}
if ($dk eq "MIKS") {
if ($sst > 0) {
$dk = "SNE";
} else {
$dk = "REGN";
}
}
}
my $flag = 1;
my $RRfla3 = 1;
my $RRfla4 = 1;
# Check no. 72.12 Precipitation / but no precipitation symbol --------------
if (($XRR[0] >= 0 && $dk eq "INGEN") || (($XRR[0] == 0 || $XRR[0] > 0.5) && $dk eq "DURI")) {
$flag = 4;
$RRfla4 = 4;
if ($XV4_missing[0]==0) {
if ($XV4[0]>8 && $XV4[0]!=10 && $XV4[0]!=12 && $XV4[0]!=17 && $XV4[0]!=31) {
push(@retvector, "V4_0_0_flag", "4");
} else {
push(@retvector, "V4_0_0_flag", "1");
}
}
if ($XV4_missing[1]==0) {
if ($XV4[1]>8 && $XV4[1]!=10 && $XV4[1]!=12 && $XV4[1]!=17 && $XV4[1]!=31) {
push(@retvector, "V4_1_0_flag", "4");
} else {
push(@retvector, "V4_1_0_flag", "1");
}
}
if ($XV4_missing[2]==0) {
if ($XV4[2]>8 && $XV4[2]!=10 && $XV4[2]!=12 && $XV4[2]!=17 && $XV4[2]!=31) {
push(@retvector, "V4_2_0_flag", "4");
} else {
push(@retvector, "V4_2_0_flag", "1");
}
}
if ($XV5_missing[0]==0) {
if ($XV5[0]>8 && $XV5[0]!=10 && $XV5[0]!=12 && $XV5[0]!=17 && $XV5[0]!=31) {
push(@retvector, "V5_0_0_flag", "4");
} else {
push(@retvector, "V5_0_0_flag", "1");
}
}
if ($XV5_missing[1]==0) {
if ($XV5[1]>8 && $XV5[1]!=10 && $XV5[1]!=12 && $XV5[1]!=17 && $XV5[1]!=31) {
push(@retvector, "V5_1_0_flag", "4");
} else {
push(@retvector, "V5_1_0_flag", "1");
}
}
if ($XV5_missing[2]==0) {
if ($XV5[2]>8 && $XV5[2]!=10 && $XV5[2]!=12 && $XV5[2]!=17 && $XV5[2]!=31) {
push(@retvector, "V5_2_0_flag", "4");
} else {
push(@retvector, "V5_2_0_flag", "1");
}
}
if ($XV6_missing[0]==0) {
if ($XV6[0]>8 && $XV6[0]!=10 && $XV6[0]!=12 && $XV6[0]!=17 && $XV6[0]!=31) {
push(@retvector, "V6_0_0_flag", "4");
} else {
push(@retvector, "V6_0_0_flag", "1");
}
}
if ($XV6_missing[1]==0) {
if ($XV6[1]>8 && $XV6[1]!=10 && $XV6[1]!=12 && $XV6[1]!=17 && $XV6[1]!=31) {
push(@retvector, "V6_1_0_flag", "4");
} else {
push(@retvector, "V6_1_0_flag", "1");
}
}
if ($XV6_missing[2]==0) {
if ($XV6[2]>8 && $XV6[2]!=10 && $XV6[2]!=12 && $XV6[2]!=17 && $XV6[2]!=31) {
push(@retvector, "V6_2_0_flag", "4");
} else {
push(@retvector, "V6_2_0_flag", "1");
}
}
}
#---------------------------------------------------------------------------------
if ($RR_missing[0]==0) {
if ($RRfla3 == 3 && $RRfla4 != 4) {
push(@retvector, "RR_0_0_flag", $RRfla3);
} elsif ($RRfla4 == 4) {
push(@retvector, "RR_0_0_flag", $RRfla4);
} elsif ($RRfla3 == 1 && $RRfla4 == 1) {
push(@retvector, "RR_0_0_flag", "1");
}
}
#---------------------------------------------------------------------------------
# else {
# print "manglende defaulthåndtering";
# }
my $numout= @retvector; # antall returverdier
if ($numout == 0) {
# print "Alt er OK";
return 0;
}
return (@retvector, $numout);
}
RESULT:
RR_0_0_flag = 1
-------------------------------------------------------------------------------
CHECK: QC1-2-72.b4 - geok04_sms_snowsymbol_without_snowdepth
Abstract signature: obs;RR,SA,V4,V5,V6;;|meta;X_1;;
Concrete signature: obs;RR_24&&&302,SA&&&302,V4&&&302,V5&&&302,V6&&&302;;0,-1501|meta;RR_24_R1;;
CHECK: QC1-2-72.b5 - geok05_sms_snowdepth_not_increasing
Abstract signature: obs;RR,SA,V4,V5,V6;;
Concrete signature: obs;RR_24&&&302,SA&&&302,V4&&&302,V5&&&302,V6&&&302;;0,-1501
SCRIPT:
use strict;
# general
my @obstime = (2010, 7, 16, 6, 0, 0);
# obs
my $obs_missing = 9;
my $obs_numtimes = 3;
my @RR = (10.5, -32767, 0.1);
my @RR_controlinfo = (0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0);
my @RR_missing = (0, 3, 0);
my @SA = (-1, -32767, -1);
my @SA_controlinfo = (0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @SA_missing = (0, 3, 0);
my @V4 = (-32767, 7, 7);
my @V4_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V4_missing = (3, 0, 0);
my @V5 = (-32767, -32767, -32767);
my @V5_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V5_missing = (3, 3, 3);
my @V6 = (-32767, -32767, -32767);
my @V6_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V6_missing = (3, 3, 3);
my @obs_timeoffset = (0, -720, -1440);
# Kvalobs_Metadata - Free Quality Control Algorithms for Meteorological Observations
#
# $Id: geok05_sms_snowdepth_not_increasing.pl,v 1.8 2007/10/22 16:21:09 paule Exp $
#
# Copyright (C) 2007 met.no
#
# Contact information:
# Norwegian Meteorological Institute
# Box 43 Blindern
# 0313 OSLO
# NORWAY
# email: kvalobs-dev@met.no
#
# This file is part of KVALOBS_METADATA
#
# KVALOBS_METADATA 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.
#
# KVALOBS_METADATA 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 KVALOBS_METADATA; if not, write to the Free Software Foundation Inc.,
# 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
#language : 1
#checkname: geok05_sms_snowdepth_not_increasing
#signature: obs;RR,SA,V4,V5,V6;;
# Konsistenskontroll check Appendix 5
# Kode hentet fra "snowdepth_precip_weather.pl", subcheck 5 (geok)
# Original laget av Per Ove Kjensli i fortran.
# Siva konverterte koden til perl.
# Rettet på av Øystein Lie 14/12-2004
# Ny versjon Terje Reite og Bjørn Nordin 17.6.2005
# Ny versjon Bjørn Nordin 02.12.2005
# Ny versjon Bjørn Nordin 29.12.2005 - Geok splittet opp.
sub check {
my @index_list;
my @index_list2;
my @XRR;
my @XSA;
my @XV4;
my @XV5;
my @XV6;
# my @XX_1;
my @XSA_missing;
my @XV4_missing;
my @XV5_missing;
my @XV6_missing;
my @retvector;
my $SAmflag=0;
# Tester om controlinfo(4)=6: Skal ikke teste, avbryter.
if ($RR_controlinfo[4] == 6) {
return 0;
}
# Tester om SA mangler: Skal ikke teste, avbryter.
for(my $i=0; $i< $obs_numtimes; $i++) {
if ($SA_missing[$i] > 0 && ($obs_timeoffset[$i] == 0 || $obs_timeoffset[$i] == -1440)) {
$SAmflag=3;
# return 0;
}
}
if ($SAmflag=3) {
return 0;
}
# Hvis alle parametre mangler: Avbryt, Returverdi-flag=0.
my $b=1;
for(my $i=0; $i< $obs_numtimes; $i++) {
if( $RR_missing[$i] > 0 &&
$SA_missing[$i] > 0 &&
$V4_missing[$i] > 0 &&
$V5_missing[$i] > 0 &&
$V6_missing[$i] > 0 ){
;
}else{
$b=0;
last;
}
}
if( $b == 1 ){
return 0;
}
# Initierer parameter-arrayene:
for(my $i=0; $i<=3; $i++) {
$XRR[$i] = -32767;
$XSA[$i] = -32767;
$XV4[$i] = -32767;
$XV5[$i] = -32767;
$XV6[$i] = -32767;
$XSA_missing[$i] = -32767;
$XV4_missing[$i] = -32767;
$XV5_missing[$i] = -32767;
$XV6_missing[$i] = -32767;
}
# Lager indeks-tabell.
my $N = $obs_numtimes;
for(my $i=0; $i<$N; $i++) {
if($obs_timeoffset[$i]==0) {
push(@index_list,0);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-720) {
push(@index_list,1);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1080) {
push(@index_list,2);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1440) {
push(@index_list,3);
push(@index_list2,$i);
}
}
$N = @index_list;
# Sorterer parametrene på rett plass i tid i parameterarrayene.
for(my $i=0; $i<$N; $i++) {
$XRR[$index_list[$i]] = $RR[$index_list2[$i]];
$XSA[$index_list[$i]] = $SA[$index_list2[$i]];
$XV4[$index_list[$i]] = $V4[$index_list2[$i]];
$XV5[$index_list[$i]] = $V5[$index_list2[$i]];
$XV6[$index_list[$i]] = $V6[$index_list2[$i]];
$XSA_missing[$index_list[$i]] = $SA_missing[$index_list2[$i]];
$XV4_missing[$index_list[$i]] = $V4_missing[$index_list2[$i]];
$XV5_missing[$index_list[$i]] = $V5_missing[$index_list2[$i]];
$XV6_missing[$index_list[$i]] = $V6_missing[$index_list2[$i]];
}
my $sst;
my $regn = "N"; my $sne = "N"; my $sludd = "N";
my $duri = "N"; my $hagl = "N"; my $tord = "N";
my $tosym;
my $hosym;
my $bisym;
my $dk;
my $tolerans;
my @retvector;
my @vx =($XV4[2],$XV5[2],$XV6[2],$XV4[1],$XV5[1],$XV6[1],$XV4[0],$XV5[0],$XV6[0]);
#my @vx_missing =( $V4_missing[2],$V5_missing[2],$V6_missing[2],
# $V4_missing[1],$V5_missing[1],$V6_missing[1],
# $V4_missing[0],$V5_missing[0],$V6_missing[0]);
# the following convention for the hours is used::
# $VX[0] is 0600 today, $VX[1] is 1800 yesterday,$VX[2] is 1200 yesterday, $VX[3] is 0600 yesterday, where X={4,5,6}
# to make this comparison possible @SA is made such that:
# $SA[0] is 0600 today, $SA[1] and $SA[2] is not defined, $SA[3] is 0600 yesterday
$dk = "INGEN";
if ($XSA_missing[0]>0 || $XSA_missing[3]>0) {
$sst = undef;
}else{
if ($XSA[0] ne undef && $XSA[3] ne undef ) {
if ($XSA[3] < 0) {
$XSA[3] = 0;
}
if ($XSA[0] < 0) {
$XSA[0] = 0;
}
$sst = $XSA[0] - $XSA[3];
# $XSA[3] = $XSA[0];
}else{
$sst = undef;
}
}
for(my $i=0; $i<=8; $i++) {
# if( $vx[$i] ne undef && $vx_missing[$i] == 0 ){
if ($vx[$i]==3 || $vx[$i]==7 || $vx[$i]==8) {
$regn = "J";
}
if ($vx[$i]==2 || $vx[$i]==5 || $vx[$i]==6) {
$sne = "J";
}
if ($vx[$i]==1 || $vx[$i]==4) {
$sludd = "J";
}
if ($vx[$i]==17 || $vx[$i]==12 || $vx[$i]==31) {
$duri = "J";
}
if ($vx[$i]==10) {
$hagl = "J";
}
}
$tosym = $regn . $sludd . $sne . $duri . $hagl;
if ($tosym eq "NNNNN") {
$dk = "INGEN";
}
else {
$hosym = $regn . $sludd . $sne;
$dk = "MIKS";
if ($hosym eq "JNN") {
$dk = "REGN";
}
if ($hosym eq "NNJ") {
$dk = "SNE";
}
if ($hosym eq "NNN") {
$bisym = $duri . $hagl;
if ($bisym eq "JN") {
$dk = "DURI";
}
if ($bisym eq "NN") {
$dk = "INGEN";
}
}
if ($dk eq "MIKS") {
if ($sst > 0) {
$dk = "SNE";
} else {
$dk = "REGN";
}
}
}
my $flag = 1;
my $RRfla3 = 1;
my $RRfla4 = 1;
# my @sjekk_flag;
# Initierer sjekk_flag:
# for(my $i=0; $i<=12; $i++) {
# $sjekk_flag[$i] = 0;
# }
# Check no. 72.5 Snow depth not increasing --------------------------
if (($sst <= 0 || $sst eq undef) && $XSA[0] > 0 && $XRR[0] >= 10 && $dk eq "SNE") {
$flag = 4;
if ($XV4_missing[0]==0) {
if ($XV4[0]==2 || $XV4[0]==5 || $XV4[0]==6) {
push(@retvector, "V4_0_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V4_0_0_flag", "1");
}
}
if ($XV4_missing[1]==0) {
if ($XV4[1]==2 || $XV4[1]==5 || $XV4[1]==6) {
push(@retvector, "V4_1_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V4_1_0_flag", "1");
}
}
if ($XV4_missing[2]==0) {
if ($XV4[2]==2 || $XV4[2]==5 || $XV4[2]==6) {
push(@retvector, "V4_2_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V4_2_0_flag", "1");
}
}
if ($XV5_missing[0]==0) {
if ($XV5[0]==2 || $XV5[0]==5 || $XV5[0]==6) {
push(@retvector, "V5_0_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V5_0_0_flag", "1");
}
}
if ($XV5_missing[1]==0) {
if ($XV5[1]==2 || $XV5[1]==5 || $XV5[1]==6) {
push(@retvector, "V5_1_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V5_1_0_flag", "1");
}
}
if ($XV5_missing[2]==0) {
if ($XV5[2]==2 || $XV5[2]==5 || $XV5[2]==6) {
push(@retvector, "V5_2_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V5_2_0_flag", "1");
}
}
if ($XV6_missing[0]==0) {
if ($XV6[0]==2 || $XV6[0]==5 || $XV6[0]==6) {
push(@retvector, "V6_0_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V6_0_0_flag", "1");
}
}
if ($XV6_missing[1]==0) {
if ($XV6[1]==2 || $XV6[1]==5 || $XV6[1]==6) {
push(@retvector, "V6_1_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V6_1_0_flag", "1");
}
}
if ($XV6_missing[2]==0) {
if ($XV6[2]==2 || $XV6[2]==5 || $XV6[2]==6) {
push(@retvector, "V6_2_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V6_2_0_flag", "1");
}
}
}
#---------------------------------------------------------------------------------
if ($RR_missing[0]==0) {
if ($RRfla3 == 3 && $RRfla4 != 4) {
push(@retvector, "RR_0_0_flag", $RRfla3);
} elsif ($RRfla4 == 4) {
push(@retvector, "RR_0_0_flag", $RRfla4);
} elsif ($RRfla3 == 1 && $RRfla4 == 1) {
push(@retvector, "RR_0_0_flag", "1");
}
}
#---------------------------------------------------------------------------------
# Hvis SA ikke mangler: Sett flagg for begge to.
my $IN = 0;
my $SAflag=0;
for(my $i=0; $i< $obs_numtimes; $i++) {
if ($SA_missing[$i] == 0 && $obs_timeoffset[$i] == -1440) {
$SAflag=4;
$IN = $i;
}
}
if ($SAflag=4) {
if ($flag == 4) {
push(@retvector, "SA_0_0_flag", "4");
my $SA_tidIndex = "SA_$IN" . "_0_flag";
push(@retvector, $SA_tidIndex);
push(@retvector, $flag);
} elsif ($flag == 1) {
push(@retvector, "SA_0_0_flag", "1");
my $SA_tidIndex = "SA_$IN" . "_0_flag";
push(@retvector, $SA_tidIndex);
push(@retvector, $flag);
}
}
my $numout= @retvector; # antall returverdier
if ($numout == 0) {
# print "Alt er OK";
return 0;
}
return (@retvector, $numout);
}
RESULT:
-------------------------------------------------------------------------------
CHECK: QC1-2-72.b6 - geok06_sms_snowdepth_increase_no_snowsymbol
Abstract signature: obs;RR,SA,V4,V5,V6;;
Concrete signature: obs;RR_24&&&302,SA&&&302,V4&&&302,V5&&&302,V6&&&302;;0,-1501
SCRIPT:
use strict;
# general
my @obstime = (2010, 7, 16, 6, 0, 0);
# obs
my $obs_missing = 9;
my $obs_numtimes = 3;
my @RR = (10.5, -32767, 0.1);
my @RR_controlinfo = (0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0);
my @RR_missing = (0, 3, 0);
my @SA = (-1, -32767, -1);
my @SA_controlinfo = (0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @SA_missing = (0, 3, 0);
my @V4 = (-32767, 7, 7);
my @V4_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V4_missing = (3, 0, 0);
my @V5 = (-32767, -32767, -32767);
my @V5_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V5_missing = (3, 3, 3);
my @V6 = (-32767, -32767, -32767);
my @V6_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V6_missing = (3, 3, 3);
my @obs_timeoffset = (0, -720, -1440);
# Kvalobs_Metadata - Free Quality Control Algorithms for Meteorological Observations
#
# $Id: geok06_sms_snowdepth_increase_no_snowsymbol.pl,v 1.7 2010-02-24 14:58:36 bjornn Exp $
#
# Copyright (C) 2007 met.no
#
# Contact information:
# Norwegian Meteorological Institute
# Box 43 Blindern
# 0313 OSLO
# NORWAY
# email: kvalobs-dev@met.no
#
# This file is part of KVALOBS_METADATA
#
# KVALOBS_METADATA 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.
#
# KVALOBS_METADATA 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 KVALOBS_METADATA; if not, write to the Free Software Foundation Inc.,
# 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
#language : 1
#checkname: geok06_sms_snowdepth_increase_no_snowsymbol
#signature: obs;RR,SA,V4,V5,V6;;
# Konsistenskontroll check Appendix 5
# Kode hentet fra "snowdepth_precip_weather.pl", subcheck 6 (geok)
# Original laget av Per Ove Kjensli i fortran.
# Siva konverterte koden til perl.
# Rettet på av Øystein Lie 14/12-2004
# Ny versjon Terje Reite og Bjørn Nordin 17.6.2005
# Ny versjon Bjørn Nordin 02.12.2005
# Ny versjon Bjørn Nordin 29.12.2005 - Geok splittet opp.
sub check {
my @index_list;
my @index_list2;
my @XRR;
my @XSA;
my @XV4;
my @XV5;
my @XV6;
# my @XX_1;
my @XSA_missing;
my @XV4_missing;
my @XV5_missing;
my @XV6_missing;
my @retvector;
# Tester om controlinfo(4)=6: Skal ikke teste, avbryter.
if ($RR_controlinfo[4] == 6) {
return 0;
}
# Tester om SA mangler: Skal ikke teste, avbryter.
for(my $i=0; $i< $obs_numtimes; $i++) {
if ($SA_missing[$i] > 0 && ($obs_timeoffset[$i] == 0 || $obs_timeoffset[$i] == -1440)) {
return 0;
}
}
# Hvis alle parametre mangler: Avbryt, Returverdi-flag=0.
my $b=1;
for(my $i=0; $i< $obs_numtimes; $i++) {
if( $RR_missing[$i] > 0 &&
$SA_missing[$i] > 0 &&
$V4_missing[$i] > 0 &&
$V5_missing[$i] > 0 &&
$V6_missing[$i] > 0 ){
;
}else{
$b=0;
last;
}
}
if( $b == 1 ){
return 0;
}
# Initierer parameter-arrayene:
for(my $i=0; $i<=3; $i++) {
$XRR[$i] = -32767;
$XSA[$i] = -32767;
$XV4[$i] = -32767;
$XV5[$i] = -32767;
$XV6[$i] = -32767;
$XSA_missing[$i] = -32767;
$XV4_missing[$i] = -32767;
$XV5_missing[$i] = -32767;
$XV6_missing[$i] = -32767;
}
# Lager indeks-tabell.
my $N = $obs_numtimes;
for(my $i=0; $i<$N; $i++) {
if($obs_timeoffset[$i]==0) {
push(@index_list,0);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-720) {
push(@index_list,1);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1080) {
push(@index_list,2);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1440) {
push(@index_list,3);
push(@index_list2,$i);
}
}
$N = @index_list;
# Sorterer parametrene på rett plass i tid i parameterarrayene.
for(my $i=0; $i<$N; $i++) {
$XRR[$index_list[$i]] = $RR[$index_list2[$i]];
$XSA[$index_list[$i]] = $SA[$index_list2[$i]];
$XV4[$index_list[$i]] = $V4[$index_list2[$i]];
$XV5[$index_list[$i]] = $V5[$index_list2[$i]];
$XV6[$index_list[$i]] = $V6[$index_list2[$i]];
$XSA_missing[$index_list[$i]] = $SA_missing[$index_list2[$i]];
$XV4_missing[$index_list[$i]] = $V4_missing[$index_list2[$i]];
$XV5_missing[$index_list[$i]] = $V5_missing[$index_list2[$i]];
$XV6_missing[$index_list[$i]] = $V6_missing[$index_list2[$i]];
}
# The value -32767 indicates that the entire row of the parameter (SA) is missing.
# Jump out if that is the situation.
if ($XSA[0] == -32767 || $XSA[3] == -32767) {
return 0;
}
my $sst;
my $regn = "N"; my $sne = "N"; my $sludd = "N";
my $duri = "N"; my $hagl = "N"; my $tord = "N";
my $tosym;
my $hosym;
my $bisym;
my $dk;
my $tolerans;
my @retvector;
my @vx =($XV4[2],$XV5[2],$XV6[2],$XV4[1],$XV5[1],$XV6[1],$XV4[0],$XV5[0],$XV6[0]);
#my @vx_missing =( $V4_missing[2],$V5_missing[2],$V6_missing[2],
# $V4_missing[1],$V5_missing[1],$V6_missing[1],
# $V4_missing[0],$V5_missing[0],$V6_missing[0]);
# the following convention for the hours is used::
# $VX[0] is 0600 today, $VX[1] is 1800 yesterday,$VX[2] is 1200 yesterday, $VX[3] is 0600 yesterday, where X={4,5,6}
# to make this comparison possible @SA is made such that:
# $SA[0] is 0600 today, $SA[1] and $SA[2] is not defined, $SA[3] is 0600 yesterday
$dk = "INGEN";
if ($XSA_missing[0]>0 || $XSA_missing[3]>0) {
$sst = undef;
}else{
if ($XSA[0] ne undef && $XSA[3] ne undef ) {
if ($XSA[3] < 0) {
$XSA[3] = 0;
}
if ($XSA[0] < 0) {
$XSA[0] = 0;
}
$sst = $XSA[0] - $XSA[3];
# $XSA[3] = $XSA[0];
}else{
$sst = undef;
}
}
for(my $i=0; $i<=8; $i++) {
# if( $vx[$i] ne undef && $vx_missing[$i] == 0 ){
if ($vx[$i]==3 || $vx[$i]==7 || $vx[$i]==8) {
$regn = "J";
}
if ($vx[$i]==2 || $vx[$i]==5 || $vx[$i]==6) {
$sne = "J";
}
if ($vx[$i]==1 || $vx[$i]==4) {
$sludd = "J";
}
if ($vx[$i]==17 || $vx[$i]==12 || $vx[$i]==31) {
$duri = "J";
}
if ($vx[$i]==10) {
$hagl = "J";
}
}
$tosym = $regn . $sludd . $sne . $duri . $hagl;
if ($tosym eq "NNNNN") {
$dk = "INGEN";
}
else {
$hosym = $regn . $sludd . $sne;
$dk = "MIKS";
if ($hosym eq "JNN") {
$dk = "REGN";
}
if ($hosym eq "NNJ") {
$dk = "SNE";
}
if ($hosym eq "NNN") {
$bisym = $duri . $hagl;
if ($bisym eq "JN") {
$dk = "DURI";
}
if ($bisym eq "NN") {
$dk = "INGEN";
}
}
if ($dk eq "MIKS") {
if ($sst > 0) {
$dk = "SNE";
} else {
$dk = "REGN";
}
}
}
my $flag = 1;
my $RRfla3 = 1;
my $RRfla4 = 1;
# Check no. 72.6 Snow depth increasing without weather symbol -------
if ($dk ne "SNE" && $sst > 0) {
$flag = 4;
if ($XV4_missing[0]==0) {
if ($XV4[0]!=2 && $XV4[0]!=5 && $XV4[0]!=6 && $XV4_missing[0]==0) {
push(@retvector, "V4_0_0_flag", "4");
} else {
push(@retvector, "V4_0_0_flag", "1");
}
}
if ($XV4_missing[1]==0) {
if ($XV4[1]!=2 && $XV4[1]!=5 && $XV4[1]!=6 && $XV4_missing[1]==0) {
push(@retvector, "V4_1_0_flag", "4");
} else {
push(@retvector, "V4_1_0_flag", "1");
}
}
if ($XV4_missing[2]==0) {
if ($XV4[2]!=2 && $XV4[2]!=5 && $XV4[2]!=6 && $XV4_missing[2]==0) {
push(@retvector, "V4_2_0_flag", "4");
} else {
push(@retvector, "V4_2_0_flag", "1");
}
}
if ($XV5_missing[0]==0) {
if ($XV5[0]!=2 && $XV5[0]!=5 && $XV5[0]!=6 && $XV5_missing[0]==0) {
push(@retvector, "V5_0_0_flag", "4");
} else {
push(@retvector, "V5_0_0_flag", "1");
}
}
if ($XV5_missing[1]==0) {
if ($XV5[1]!=2 && $XV5[1]!=5 && $XV5[1]!=6 && $XV5_missing[1]==0) {
push(@retvector, "V5_1_0_flag", "4");
} else {
push(@retvector, "V5_1_0_flag", "1");
}
}
if ($XV5_missing[2]==0) {
if ($XV5[2]!=2 && $XV5[2]!=5 && $XV5[2]!=6 && $XV5_missing[2]==0) {
push(@retvector, "V5_2_0_flag", "4");
} else {
push(@retvector, "V5_2_0_flag", "1");
}
}
if ($XV6_missing[0]==0) {
if ($XV6[0]!=2 && $XV6[0]!=5 && $XV6[0]!=6 && $XV6_missing[0]==0) {
push(@retvector, "V6_0_0_flag", "4");
} else {
push(@retvector, "V6_0_0_flag", "1");
}
}
if ($XV6_missing[1]==0) {
if ($XV6[1]!=2 && $XV6[1]!=5 && $XV6[1]!=6 && $XV6_missing[1]==0) {
push(@retvector, "V6_1_0_flag", "4");
} else {
push(@retvector, "V6_1_0_flag", "1");
}
}
if ($XV6_missing[2]==0) {
if ($XV6[2]!=2 && $XV6[2]!=5 && $XV6[2]!=6 && $XV6_missing[2]==0) {
push(@retvector, "V6_2_0_flag", "4");
} else {
push(@retvector, "V6_2_0_flag", "1");
}
}
}
#---------------------------------------------------------------------------------
# if ($RR_missing[0]==0) {
# if ($RRfla3 == 3 && $RRfla4 != 4) {
# push(@retvector, "RR_0_0_flag", $RRfla3);
# } elsif ($RRfla4 == 4) {
# push(@retvector, "RR_0_0_flag", $RRfla4);
# } elsif ($RRfla3 == 1 && $RRfla4 == 1) {
# push(@retvector, "RR_0_0_flag", "1");
# }
# }
#---------------------------------------------------------------------------------
if ($XSA_missing[0]==0) {
if ($flag == 4) {
push(@retvector, "SA_0_0_flag", "4");
} elsif ($flag == 1) {
push(@retvector, "SA_0_0_flag", "1");
}
}
#---------------------------------------------------------------------------------
# else {
# print "manglende defaulthåndtering";
# }
my $numout= @retvector; # antall returverdier
if ($numout == 0) {
# print "Alt er OK";
return 0;
}
return (@retvector, $numout);
}
RESULT:
SA_0_0_flag = 1
-------------------------------------------------------------------------------
CHECK: QC1-2-72.b7 - geok07_sms_snowdepth_increase_toomuch
Abstract signature: obs;RR,SA,V4,V5,V6;;
Concrete signature: obs;RR_24&&&302,SA&&&302,V4&&&302,V5&&&302,V6&&&302;;0,-1501
SCRIPT:
use strict;
# general
my @obstime = (2010, 7, 16, 6, 0, 0);
# obs
my $obs_missing = 9;
my $obs_numtimes = 3;
my @RR = (10.5, -32767, 0.1);
my @RR_controlinfo = (0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0);
my @RR_missing = (0, 3, 0);
my @SA = (-1, -32767, -1);
my @SA_controlinfo = (0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @SA_missing = (0, 3, 0);
my @V4 = (-32767, 7, 7);
my @V4_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V4_missing = (3, 0, 0);
my @V5 = (-32767, -32767, -32767);
my @V5_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V5_missing = (3, 3, 3);
my @V6 = (-32767, -32767, -32767);
my @V6_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V6_missing = (3, 3, 3);
my @obs_timeoffset = (0, -720, -1440);
# Kvalobs_Metadata - Free Quality Control Algorithms for Meteorological Observations
#
# $Id: geok07_sms_snowdepth_increase_toomuch.pl,v 1.6 2007/10/22 16:21:09 paule Exp $
#
# Copyright (C) 2007 met.no
#
# Contact information:
# Norwegian Meteorological Institute
# Box 43 Blindern
# 0313 OSLO
# NORWAY
# email: kvalobs-dev@met.no
#
# This file is part of KVALOBS_METADATA
#
# KVALOBS_METADATA 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.
#
# KVALOBS_METADATA 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 KVALOBS_METADATA; if not, write to the Free Software Foundation Inc.,
# 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
#language : 1
#checkname: geok07_sms_snowdepth_increase_toomuch
#signature: obs;RR,SA,V4,V5,V6;;
# Konsistenskontroll check Appendix 5
# Kode hentet fra "snowdepth_precip_weather.pl", subcheck 7 (geok)
# Original laget av Per Ove Kjensli i fortran.
# Siva konverterte koden til perl.
# Rettet på av Øystein Lie 14/12-2004
# Ny versjon Terje Reite og Bjørn Nordin 17.6.2005
# Ny versjon Bjørn Nordin 02.12.2005
# Ny versjon Bjørn Nordin 02.01.2006 - Geok splittet opp.
sub check {
my @index_list;
my @index_list2;
my @XRR;
my @XSA;
my @XV4;
my @XV5;
my @XV6;
# my @XX_1;
my @XSA_missing;
my @XV4_missing;
my @XV5_missing;
my @XV6_missing;
my @retvector;
# Tester om controlinfo(4)=6: Skal ikke teste, avbryter.
if ($RR_controlinfo[4] == 6) {
return 0;
}
# Tester om SA mangler: Skal ikke teste, avbryter.
for(my $i=0; $i< $obs_numtimes; $i++) {
if ($SA_missing[$i] > 0 && ($obs_timeoffset[$i] == 0 || $obs_timeoffset[$i] == -1440)) {
return 0;
}
}
# Hvis alle parametre mangler: Avbryt, Returverdi-flag=0.
my $b=1;
for(my $i=0; $i< $obs_numtimes; $i++) {
if( $RR_missing[$i] > 0 &&
$SA_missing[$i] > 0 &&
$V4_missing[$i] > 0 &&
$V5_missing[$i] > 0 &&
$V6_missing[$i] > 0 ){
;
}else{
$b=0;
last;
}
}
if( $b == 1 ){
return 0;
}
# Initierer parameter-arrayene:
for(my $i=0; $i<=3; $i++) {
$XRR[$i] = -32767;
$XSA[$i] = -32767;
$XV4[$i] = -32767;
$XV5[$i] = -32767;
$XV6[$i] = -32767;
$XSA_missing[$i] = -32767;
$XV4_missing[$i] = -32767;
$XV5_missing[$i] = -32767;
$XV6_missing[$i] = -32767;
}
# Lager indeks-tabell.
my $N = $obs_numtimes;
for(my $i=0; $i<$N; $i++) {
if($obs_timeoffset[$i]==0) {
push(@index_list,0);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-720) {
push(@index_list,1);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1080) {
push(@index_list,2);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1440) {
push(@index_list,3);
push(@index_list2,$i);
}
}
$N = @index_list;
# Sorterer parametrene på rett plass i tid i parameterarrayene.
for(my $i=0; $i<$N; $i++) {
$XRR[$index_list[$i]] = $RR[$index_list2[$i]];
$XSA[$index_list[$i]] = $SA[$index_list2[$i]];
$XV4[$index_list[$i]] = $V4[$index_list2[$i]];
$XV5[$index_list[$i]] = $V5[$index_list2[$i]];
$XV6[$index_list[$i]] = $V6[$index_list2[$i]];
$XSA_missing[$index_list[$i]] = $SA_missing[$index_list2[$i]];
$XV4_missing[$index_list[$i]] = $V4_missing[$index_list2[$i]];
$XV5_missing[$index_list[$i]] = $V5_missing[$index_list2[$i]];
$XV6_missing[$index_list[$i]] = $V6_missing[$index_list2[$i]];
}
my $sst;
my $regn = "N"; my $sne = "N"; my $sludd = "N";
my $duri = "N"; my $hagl = "N"; my $tord = "N";
my $tosym;
my $hosym;
my $bisym;
my $dk;
my $tolerans;
my @retvector;
my @vx =($XV4[2],$XV5[2],$XV6[2],$XV4[1],$XV5[1],$XV6[1],$XV4[0],$XV5[0],$XV6[0]);
#my @vx_missing =( $V4_missing[2],$V5_missing[2],$V6_missing[2],
# $V4_missing[1],$V5_missing[1],$V6_missing[1],
# $V4_missing[0],$V5_missing[0],$V6_missing[0]);
# the following convention for the hours is used::
# $VX[0] is 0600 today, $VX[1] is 1800 yesterday,$VX[2] is 1200 yesterday, $VX[3] is 0600 yesterday, where X={4,5,6}
# to make this comparison possible @SA is made such that:
# $SA[0] is 0600 today, $SA[1] and $SA[2] is not defined, $SA[3] is 0600 yesterday
$dk = "INGEN";
if ($XSA_missing[0]>0 || $XSA_missing[3]>0) {
$sst = undef;
}else{
if ($XSA[0] ne undef && $XSA[3] ne undef ) {
if ($XSA[3] < 0) {
$XSA[3] = 0;
}
if ($XSA[0] < 0) {
$XSA[0] = 0;
}
$sst = $XSA[0] - $XSA[3];
# $XSA[3] = $XSA[0];
}else{
$sst = undef;
}
}
for(my $i=0; $i<=8; $i++) {
# if( $vx[$i] ne undef && $vx_missing[$i] == 0 ){
if ($vx[$i]==3 || $vx[$i]==7 || $vx[$i]==8) {
$regn = "J";
}
if ($vx[$i]==2 || $vx[$i]==5 || $vx[$i]==6) {
$sne = "J";
}
if ($vx[$i]==1 || $vx[$i]==4) {
$sludd = "J";
}
if ($vx[$i]==17 || $vx[$i]==12 || $vx[$i]==31) {
$duri = "J";
}
if ($vx[$i]==10) {
$hagl = "J";
}
}
$tosym = $regn . $sludd . $sne . $duri . $hagl;
if ($tosym eq "NNNNN") {
$dk = "INGEN";
}
else {
$hosym = $regn . $sludd . $sne;
$dk = "MIKS";
if ($hosym eq "JNN") {
$dk = "REGN";
}
if ($hosym eq "NNJ") {
$dk = "SNE";
}
if ($hosym eq "NNN") {
$bisym = $duri . $hagl;
if ($bisym eq "JN") {
$dk = "DURI";
}
if ($bisym eq "NN") {
$dk = "INGEN";
}
}
if ($dk eq "MIKS") {
if ($sst > 0) {
$dk = "SNE";
} else {
$dk = "REGN";
}
}
}
my $flag = 1;
my $RRfla3 = 1;
my $RRfla4 = 1;
# Check no. 72.7 Snow depth increasing too much ---------------------
if ($XRR[0]>0 && ($sst*$sst)>($XRR[0]*100 + 25) && $sst>4 && $dk eq "SNE") {
$flag = 4;
if ($XV4_missing[0]==0) {
if ($XV4[0]==2 || $XV4[0]==5 || $XV4[0]==6) {
push(@retvector, "V4_0_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V4_0_0_flag", "1");
}
}
if ($XV4_missing[1]==0) {
if ($XV4[1]==2 || $XV4[1]==5 || $XV4[1]==6) {
push(@retvector, "V4_1_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V4_1_0_flag", "1");
}
}
if ($XV4_missing[2]==0) {
if ($XV4[2]==2 || $XV4[2]==5 || $XV4[2]==6) {
push(@retvector, "V4_2_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V4_2_0_flag", "1");
}
}
if ($XV5_missing[0]==0) {
if ($XV5[0]==2 || $XV5[0]==5 || $XV5[0]==6) {
push(@retvector, "V5_0_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V5_0_0_flag", "1");
}
}
if ($XV5_missing[1]==0) {
if ($XV5[1]==2 || $XV5[1]==5 || $XV5[1]==6) {
push(@retvector, "V5_1_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V5_1_0_flag", "1");
}
}
if ($XV5_missing[2]==0) {
if ($XV5[2]==2 || $XV5[2]==5 || $XV5[2]==6) {
push(@retvector, "V5_2_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V5_2_0_flag", "1");
}
}
if ($XV6_missing[0]==0) {
if ($XV6[0]==2 || $XV6[0]==5 || $XV6[0]==6) {
push(@retvector, "V6_0_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V6_0_0_flag", "1");
}
}
if ($XV6_missing[1]==0) {
if ($XV6[1]==2 || $XV6[1]==5 || $XV6[1]==6) {
push(@retvector, "V6_1_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V6_1_0_flag", "1");
}
}
if ($XV6_missing[2]==0) {
if ($XV6[2]==2 || $XV6[2]==5 || $XV6[2]==6) {
push(@retvector, "V6_2_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V6_2_0_flag", "1");
}
}
}
#---------------------------------------------------------------------------------
if ($RR_missing[0]==0) {
if ($RRfla3 == 3 && $RRfla4 != 4) {
push(@retvector, "RR_0_0_flag", $RRfla3);
} elsif ($RRfla4 == 4) {
push(@retvector, "RR_0_0_flag", $RRfla4);
} elsif ($RRfla3 == 1 && $RRfla4 == 1) {
push(@retvector, "RR_0_0_flag", "1");
}
}
#---------------------------------------------------------------------------------
if ($XSA_missing[0]==0) {
if ($flag == 4) {
push(@retvector, "SA_0_0_flag", "4");
} elsif ($flag == 1) {
push(@retvector, "SA_0_0_flag", "1");
}
}
#---------------------------------------------------------------------------------
# else {
# print "manglende defaulthåndtering";
# }
my $numout= @retvector; # antall returverdier
if ($numout == 0) {
# print "Alt er OK";
return 0;
}
return (@retvector, $numout);
}
RESULT:
RR_0_0_flag = 1
SA_0_0_flag = 1
-------------------------------------------------------------------------------
CHECK: QC1-2-72.b8 - geok08_sms_snowdepth_decrease_toomuch_snow
Abstract signature: obs;RR,SA,V4,V5,V6;;
Concrete signature: obs;RR_24&&&302,SA&&&302,V4&&&302,V5&&&302,V6&&&302;;0,-1501
SCRIPT:
use strict;
# general
my @obstime = (2010, 7, 16, 6, 0, 0);
# obs
my $obs_missing = 9;
my $obs_numtimes = 3;
my @RR = (10.5, -32767, 0.1);
my @RR_controlinfo = (0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0);
my @RR_missing = (0, 3, 0);
my @SA = (-1, -32767, -1);
my @SA_controlinfo = (0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @SA_missing = (0, 3, 0);
my @V4 = (-32767, 7, 7);
my @V4_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V4_missing = (3, 0, 0);
my @V5 = (-32767, -32767, -32767);
my @V5_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V5_missing = (3, 3, 3);
my @V6 = (-32767, -32767, -32767);
my @V6_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V6_missing = (3, 3, 3);
my @obs_timeoffset = (0, -720, -1440);
# Kvalobs_Metadata - Free Quality Control Algorithms for Meteorological Observations
#
# $Id: geok08_sms_snowdepth_decrease_toomuch_snow.pl,v 1.7 2007/10/22 16:21:09 paule Exp $
#
# Copyright (C) 2007 met.no
#
# Contact information:
# Norwegian Meteorological Institute
# Box 43 Blindern
# 0313 OSLO
# NORWAY
# email: kvalobs-dev@met.no
#
# This file is part of KVALOBS_METADATA
#
# KVALOBS_METADATA 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.
#
# KVALOBS_METADATA 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 KVALOBS_METADATA; if not, write to the Free Software Foundation Inc.,
# 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
#language : 1
#checkname: geok08_sms_snowdepth_decrease_toomuch_snow
#signature: obs;RR,SA,V4,V5,V6;;
# Konsistenskontroll check Appendix 5
# Kode hentet fra "snowdepth_precip_weather.pl", subcheck 8 (geok)
# Original laget av Per Ove Kjensli i fortran.
# Siva konverterte koden til perl.
# Rettet på av Øystein Lie 14/12-2004
# Ny versjon Terje Reite og Bjørn Nordin 17.6.2005
# Ny versjon Bjørn Nordin 02.12.2005
# Ny versjon Bjørn Nordin 02.01.2006 - Geok splittet opp.
sub check {
my @index_list;
my @index_list2;
my @XRR;
my @XSA;
my @XV4;
my @XV5;
my @XV6;
# my @XX_1;
my @XSA_missing;
my @XV4_missing;
my @XV5_missing;
my @XV6_missing;
my @retvector;
# Tester om controlinfo(4)=6: Skal ikke teste, avbryter.
if ($RR_controlinfo[4] == 6) {
return 0;
}
# Tester om SA mangler: Skal ikke teste, avbryter.
for(my $i=0; $i< $obs_numtimes; $i++) {
if ($SA_missing[$i] > 0 && ($obs_timeoffset[$i] == 0 || $obs_timeoffset[$i] == -1440)) {
return 0;
}
}
# Hvis alle parametre mangler: Avbryt, Returverdi-flag=0.
my $b=1;
for(my $i=0; $i< $obs_numtimes; $i++) {
if( $RR_missing[$i] > 0 &&
$SA_missing[$i] > 0 &&
$V4_missing[$i] > 0 &&
$V5_missing[$i] > 0 &&
$V6_missing[$i] > 0 ){
;
}else{
$b=0;
last;
}
}
if( $b == 1 ){
return 0;
}
# Initierer parameter-arrayene:
for(my $i=0; $i<=3; $i++) {
$XRR[$i] = -32767;
$XSA[$i] = -32767;
$XV4[$i] = -32767;
$XV5[$i] = -32767;
$XV6[$i] = -32767;
$XSA_missing[$i] = -32767;
$XV4_missing[$i] = -32767;
$XV5_missing[$i] = -32767;
$XV6_missing[$i] = -32767;
}
# Lager indeks-tabell.
my $N = $obs_numtimes;
for(my $i=0; $i<$N; $i++) {
if($obs_timeoffset[$i]==0) {
push(@index_list,0);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-720) {
push(@index_list,1);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1080) {
push(@index_list,2);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1440) {
push(@index_list,3);
push(@index_list2,$i);
}
}
$N = @index_list;
# Sorterer parametrene på rett plass i tid i parameterarrayene.
for(my $i=0; $i<$N; $i++) {
$XRR[$index_list[$i]] = $RR[$index_list2[$i]];
$XSA[$index_list[$i]] = $SA[$index_list2[$i]];
$XV4[$index_list[$i]] = $V4[$index_list2[$i]];
$XV5[$index_list[$i]] = $V5[$index_list2[$i]];
$XV6[$index_list[$i]] = $V6[$index_list2[$i]];
$XSA_missing[$index_list[$i]] = $SA_missing[$index_list2[$i]];
$XV4_missing[$index_list[$i]] = $V4_missing[$index_list2[$i]];
$XV5_missing[$index_list[$i]] = $V5_missing[$index_list2[$i]];
$XV6_missing[$index_list[$i]] = $V6_missing[$index_list2[$i]];
}
my $sst;
my $regn = "N"; my $sne = "N"; my $sludd = "N";
my $duri = "N"; my $hagl = "N"; my $tord = "N";
my $tosym;
my $hosym;
my $bisym;
my $dk;
my $tolerans;
my @retvector;
my @vx =($XV4[2],$XV5[2],$XV6[2],$XV4[1],$XV5[1],$XV6[1],$XV4[0],$XV5[0],$XV6[0]);
#my @vx_missing =( $V4_missing[2],$V5_missing[2],$V6_missing[2],
# $V4_missing[1],$V5_missing[1],$V6_missing[1],
# $V4_missing[0],$V5_missing[0],$V6_missing[0]);
# the following convention for the hours is used::
# $VX[0] is 0600 today, $VX[1] is 1800 yesterday,$VX[2] is 1200 yesterday, $VX[3] is 0600 yesterday, where X={4,5,6}
# to make this comparison possible @SA is made such that:
# $SA[0] is 0600 today, $SA[1] and $SA[2] is not defined, $SA[3] is 0600 yesterday
$dk = "INGEN";
if ($XSA_missing[0]>0 || $XSA_missing[3]>0) {
$sst = undef;
}else{
if ($XSA[0] ne undef && $XSA[3] ne undef ) {
if ($XSA[3] < 0) {
$XSA[3] = 0;
}
if ($XSA[0] < 0) {
$XSA[0] = 0;
}
$sst = $XSA[0] - $XSA[3];
# $XSA[3] = $XSA[0];
}else{
$sst = undef;
}
}
for(my $i=0; $i<=8; $i++) {
# if( $vx[$i] ne undef && $vx_missing[$i] == 0 ){
if ($vx[$i]==3 || $vx[$i]==7 || $vx[$i]==8) {
$regn = "J";
}
if ($vx[$i]==2 || $vx[$i]==5 || $vx[$i]==6) {
$sne = "J";
}
if ($vx[$i]==1 || $vx[$i]==4) {
$sludd = "J";
}
if ($vx[$i]==17 || $vx[$i]==12 || $vx[$i]==31) {
$duri = "J";
}
if ($vx[$i]==10) {
$hagl = "J";
}
}
$tosym = $regn . $sludd . $sne . $duri . $hagl;
if ($tosym eq "NNNNN") {
$dk = "INGEN";
}
else {
$hosym = $regn . $sludd . $sne;
$dk = "MIKS";
if ($hosym eq "JNN") {
$dk = "REGN";
}
if ($hosym eq "NNJ") {
$dk = "SNE";
}
if ($hosym eq "NNN") {
$bisym = $duri . $hagl;
if ($bisym eq "JN") {
$dk = "DURI";
}
if ($bisym eq "NN") {
$dk = "INGEN";
}
}
if ($dk eq "MIKS") {
if ($sst > 0) {
$dk = "SNE";
} else {
$dk = "REGN";
}
}
}
my $flag = 1;
my $RRfla3 = 1;
my $RRfla4 = 1;
# Check no. 72.8 Snow depth decreasing too much ---------------------
# if (($sst < -15 || $sst eq undef) && $XRR[0] > 1 && $dk eq "SNE") {
if ($sst < -15 && $XRR[0] > 1 && $dk eq "SNE") {
$flag = 4;
if ($XV4_missing[0]==0) {
if ($XV4[0]==2 || $XV4[0]==5 || $XV4[0]==6) {
push(@retvector, "V4_0_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V4_0_0_flag", "1");
}
}
if ($XV4_missing[1]==0) {
if ($XV4[1]==2 || $XV4[1]==5 || $XV4[1]==6) {
push(@retvector, "V4_1_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V4_1_0_flag", "1");
}
}
if ($XV4_missing[2]==0) {
if ($XV4[2]==2 || $XV4[2]==5 || $XV4[2]==6) {
push(@retvector, "V4_2_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V4_2_0_flag", "1");
}
}
if ($XV5_missing[0]==0) {
if ($XV5[0]==2 || $XV5[0]==5 || $XV5[0]==6) {
push(@retvector, "V5_0_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V5_0_0_flag", "1");
}
}
if ($XV5_missing[1]==0) {
if ($XV5[1]==2 || $XV5[1]==5 || $XV5[1]==6) {
push(@retvector, "V5_1_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V5_1_0_flag", "1");
}
}
if ($XV5_missing[2]==0) {
if ($XV5[2]==2 || $XV5[2]==5 || $XV5[2]==6) {
push(@retvector, "V5_2_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V5_2_0_flag", "1");
}
}
if ($XV6_missing[0]==0) {
if ($XV6[0]==2 || $XV6[0]==5 || $XV6[0]==6) {
push(@retvector, "V6_0_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V6_0_0_flag", "1");
}
}
if ($XV6_missing[1]==0) {
if ($XV6[1]==2 || $XV6[1]==5 || $XV6[1]==6) {
push(@retvector, "V6_1_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V6_1_0_flag", "1");
}
}
if ($XV6_missing[2]==0) {
if ($XV6[2]==2 || $XV6[2]==5 || $XV6[2]==6) {
push(@retvector, "V6_2_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V6_2_0_flag", "1");
}
}
}
#---------------------------------------------------------------------------------
if ($RR_missing[0]==0) {
if ($RRfla3 == 3 && $RRfla4 != 4) {
push(@retvector, "RR_0_0_flag", $RRfla3);
} elsif ($RRfla4 == 4) {
push(@retvector, "RR_0_0_flag", $RRfla4);
} elsif ($RRfla3 == 1 && $RRfla4 == 1) {
push(@retvector, "RR_0_0_flag", "1");
}
}
#---------------------------------------------------------------------------------
if ($XSA_missing[0]==0) {
if ($flag == 4) {
push(@retvector, "SA_0_0_flag", "4");
} elsif ($flag == 1) {
push(@retvector, "SA_0_0_flag", "1");
}
}
#---------------------------------------------------------------------------------
# else {
# print "manglende defaulthåndtering";
# }
my $numout= @retvector; # antall returverdier
if ($numout == 0) {
# print "Alt er OK";
return 0;
}
return (@retvector, $numout);
}
RESULT:
RR_0_0_flag = 1
SA_0_0_flag = 1
-------------------------------------------------------------------------------
CHECK: QC1-2-72.b9 - geok09_sms_snowdepth_decrease_toomuch_rain
Abstract signature: obs;RR,SA,V4,V5,V6;;
Concrete signature: obs;RR_24&&&302,SA&&&302,V4&&&302,V5&&&302,V6&&&302;;0,-1501
SCRIPT:
use strict;
# general
my @obstime = (2010, 7, 16, 6, 0, 0);
# obs
my $obs_missing = 9;
my $obs_numtimes = 3;
my @RR = (10.5, -32767, 0.1);
my @RR_controlinfo = (0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0);
my @RR_missing = (0, 3, 0);
my @SA = (-1, -32767, -1);
my @SA_controlinfo = (0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @SA_missing = (0, 3, 0);
my @V4 = (-32767, 7, 7);
my @V4_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V4_missing = (3, 0, 0);
my @V5 = (-32767, -32767, -32767);
my @V5_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V5_missing = (3, 3, 3);
my @V6 = (-32767, -32767, -32767);
my @V6_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V6_missing = (3, 3, 3);
my @obs_timeoffset = (0, -720, -1440);
# Kvalobs_Metadata - Free Quality Control Algorithms for Meteorological Observations
#
# $Id: geok09_sms_snowdepth_decrease_toomuch_rain.pl,v 1.6 2007/10/22 16:21:09 paule Exp $
#
# Copyright (C) 2007 met.no
#
# Contact information:
# Norwegian Meteorological Institute
# Box 43 Blindern
# 0313 OSLO
# NORWAY
# email: kvalobs-dev@met.no
#
# This file is part of KVALOBS_METADATA
#
# KVALOBS_METADATA 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.
#
# KVALOBS_METADATA 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 KVALOBS_METADATA; if not, write to the Free Software Foundation Inc.,
# 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
#language : 1
#checkname: geok09_sms_snowdepth_decrease_toomuch_rain
#signature: obs;RR,SA,V4,V5,V6;;
# Konsistenskontroll check Appendix 5
# Kode hentet fra "snowdepth_precip_weather.pl", subcheck 9 (geok)
# Original laget av Per Ove Kjensli i fortran.
# Siva konverterte koden til perl.
# Rettet på av Øystein Lie 14/12-2004
# Ny versjon Terje Reite og Bjørn Nordin 17.6.2005
# Ny versjon Bjørn Nordin 02.12.2005
# Ny versjon Bjørn Nordin 02.01.2006 - Geok splittet opp.
sub check {
my @index_list;
my @index_list2;
my @XRR;
my @XSA;
my @XV4;
my @XV5;
my @XV6;
# my @XX_1;
my @XSA_missing;
my @XV4_missing;
my @XV5_missing;
my @XV6_missing;
my @retvector;
# Tester om controlinfo(4)=6: Skal ikke teste, avbryter.
if ($RR_controlinfo[4] == 6) {
return 0;
}
# Tester om SA mangler: Skal ikke teste, avbryter.
for(my $i=0; $i< $obs_numtimes; $i++) {
if ($SA_missing[$i] > 0 && ($obs_timeoffset[$i] == 0 || $obs_timeoffset[$i] == -1440)) {
return 0;
}
}
# Hvis alle parametre mangler: Avbryt, Returverdi-flag=0.
my $b=1;
for(my $i=0; $i< $obs_numtimes; $i++) {
if( $RR_missing[$i] > 0 &&
$SA_missing[$i] > 0 &&
$V4_missing[$i] > 0 &&
$V5_missing[$i] > 0 &&
$V6_missing[$i] > 0 ){
;
}else{
$b=0;
last;
}
}
if( $b == 1 ){
return 0;
}
# Initierer parameter-arrayene:
for(my $i=0; $i<=3; $i++) {
$XRR[$i] = -32767;
$XSA[$i] = -32767;
$XV4[$i] = -32767;
$XV5[$i] = -32767;
$XV6[$i] = -32767;
$XSA_missing[$i] = -32767;
$XV4_missing[$i] = -32767;
$XV5_missing[$i] = -32767;
$XV6_missing[$i] = -32767;
}
# Lager indeks-tabell.
my $N = $obs_numtimes;
for(my $i=0; $i<$N; $i++) {
if($obs_timeoffset[$i]==0) {
push(@index_list,0);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-720) {
push(@index_list,1);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1080) {
push(@index_list,2);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1440) {
push(@index_list,3);
push(@index_list2,$i);
}
}
$N = @index_list;
# Sorterer parametrene på rett plass i tid i parameterarrayene.
for(my $i=0; $i<$N; $i++) {
$XRR[$index_list[$i]] = $RR[$index_list2[$i]];
$XSA[$index_list[$i]] = $SA[$index_list2[$i]];
$XV4[$index_list[$i]] = $V4[$index_list2[$i]];
$XV5[$index_list[$i]] = $V5[$index_list2[$i]];
$XV6[$index_list[$i]] = $V6[$index_list2[$i]];
$XSA_missing[$index_list[$i]] = $SA_missing[$index_list2[$i]];
$XV4_missing[$index_list[$i]] = $V4_missing[$index_list2[$i]];
$XV5_missing[$index_list[$i]] = $V5_missing[$index_list2[$i]];
$XV6_missing[$index_list[$i]] = $V6_missing[$index_list2[$i]];
}
my $sst;
my $regn = "N"; my $sne = "N"; my $sludd = "N";
my $duri = "N"; my $hagl = "N"; my $tord = "N";
my $tosym;
my $hosym;
my $bisym;
my $dk;
my $tolerans;
my @retvector;
my @vx =($XV4[2],$XV5[2],$XV6[2],$XV4[1],$XV5[1],$XV6[1],$XV4[0],$XV5[0],$XV6[0]);
#my @vx_missing =( $V4_missing[2],$V5_missing[2],$V6_missing[2],
# $V4_missing[1],$V5_missing[1],$V6_missing[1],
# $V4_missing[0],$V5_missing[0],$V6_missing[0]);
# the following convention for the hours is used::
# $VX[0] is 0600 today, $VX[1] is 1800 yesterday,$VX[2] is 1200 yesterday, $VX[3] is 0600 yesterday, where X={4,5,6}
# to make this comparison possible @SA is made such that:
# $SA[0] is 0600 today, $SA[1] and $SA[2] is not defined, $SA[3] is 0600 yesterday
$dk = "INGEN";
if ($XSA_missing[0]>0 || $XSA_missing[3]>0) {
$sst = undef;
}else{
if ($XSA[0] ne undef && $XSA[3] ne undef ) {
if ($XSA[3] < 0) {
$XSA[3] = 0;
}
if ($XSA[0] < 0) {
$XSA[0] = 0;
}
$sst = $XSA[0] - $XSA[3];
# $XSA[3] = $XSA[0];
}else{
$sst = undef;
}
}
for(my $i=0; $i<=8; $i++) {
# if( $vx[$i] ne undef && $vx_missing[$i] == 0 ){
if ($vx[$i]==3 || $vx[$i]==7 || $vx[$i]==8) {
$regn = "J";
}
if ($vx[$i]==2 || $vx[$i]==5 || $vx[$i]==6) {
$sne = "J";
}
if ($vx[$i]==1 || $vx[$i]==4) {
$sludd = "J";
}
if ($vx[$i]==17 || $vx[$i]==12 || $vx[$i]==31) {
$duri = "J";
}
if ($vx[$i]==10) {
$hagl = "J";
}
}
$tosym = $regn . $sludd . $sne . $duri . $hagl;
if ($tosym eq "NNNNN") {
$dk = "INGEN";
}
else {
$hosym = $regn . $sludd . $sne;
$dk = "MIKS";
if ($hosym eq "JNN") {
$dk = "REGN";
}
if ($hosym eq "NNJ") {
$dk = "SNE";
}
if ($hosym eq "NNN") {
$bisym = $duri . $hagl;
if ($bisym eq "JN") {
$dk = "DURI";
}
if ($bisym eq "NN") {
$dk = "INGEN";
}
}
if ($dk eq "MIKS") {
if ($sst > 0) {
$dk = "SNE";
} else {
$dk = "REGN";
}
}
}
my $flag = 1;
my $RRfla3 = 1;
my $RRfla4 = 1;
# Check no. 72.9 Snow depth decreasing too much ---------------------
if (($sst*$sst)>($XRR[0]*100 + 225) && $sst<0 && $XRR[0]>0 && $dk eq "REGN") {
$flag = 4;
if ($XV4_missing[0]==0) {
if ($XV4[0]==3 || $XV4[0]==7 || $XV4[0]==8) {
push(@retvector, "V4_0_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V4_0_0_flag", "1");
}
}
if ($XV4_missing[1]==0) {
if ($XV4[1]==3 || $XV4[1]==7 || $XV4[1]==8) {
push(@retvector, "V4_1_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V4_1_0_flag", "1");
}
}
if ($XV4_missing[2]==0) {
if ($XV4[2]==3 || $XV4[2]==7 || $XV4[2]==8) {
push(@retvector, "V4_2_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V4_2_0_flag", "1");
}
}
if ($XV5_missing[0]==0) {
if ($XV5[0]==3 || $XV5[0]==7 || $XV5[0]==8) {
push(@retvector, "V5_0_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V5_0_0_flag", "1");
}
}
if ($XV5_missing[1]==0) {
if ($XV5[1]==3 || $XV5[1]==7 || $XV5[1]==8) {
push(@retvector, "V5_1_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V5_1_0_flag", "1");
}
}
if ($XV5_missing[2]==0) {
if ($XV5[2]==3 || $XV5[2]==7 || $XV5[2]==8) {
push(@retvector, "V5_2_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V5_2_0_flag", "1");
}
}
if ($XV6_missing[0]==0) {
if ($XV6[0]==3 || $XV6[0]==7 || $XV6[0]==8) {
push(@retvector, "V6_0_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V6_0_0_flag", "1");
}
}
if ($XV6_missing[1]==0) {
if ($XV6[1]==3 || $XV6[1]==7 || $XV6[1]==8) {
push(@retvector, "V6_1_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V6_1_0_flag", "1");
}
}
if ($XV6_missing[2]==0) {
if ($XV6[2]==3 || $XV6[2]==7 || $XV6[2]==8) {
push(@retvector, "V6_2_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V6_2_0_flag", "1");
}
}
}
#---------------------------------------------------------------------------------
if ($RR_missing[0]==0) {
if ($RRfla3 == 3 && $RRfla4 != 4) {
push(@retvector, "RR_0_0_flag", $RRfla3);
} elsif ($RRfla4 == 4) {
push(@retvector, "RR_0_0_flag", $RRfla4);
} elsif ($RRfla3 == 1 && $RRfla4 == 1) {
push(@retvector, "RR_0_0_flag", "1");
}
}
#---------------------------------------------------------------------------------
if ($XSA_missing[0]==0) {
if ($flag == 4) {
push(@retvector, "SA_0_0_flag", "4");
} elsif ($flag == 1) {
push(@retvector, "SA_0_0_flag", "1");
}
}
#---------------------------------------------------------------------------------
# else {
# print "manglende defaulthåndtering";
# }
my $numout= @retvector; # antall returverdier
if ($numout == 0) {
# print "Alt er OK";
return 0;
}
return (@retvector, $numout);
}
RESULT:
RR_0_0_flag = 1
SA_0_0_flag = 1
-------------------------------------------------------------------------------
CHECK: QC1-2-72.c1 - geok01_card_notonly_dew_hoarfrost
Abstract signature: obs;RR,SA,V4,V5,V6;;
Concrete signature: obs;RR_24&&&402,SA&&&402,V4&&&402,V5&&&402,V6&&&402;;0,-1501
SCRIPT:
use strict;
# general
my @obstime = (2010, 7, 16, 6, 0, 0);
# obs
my $obs_missing = 5;
my $obs_numtimes = 1;
my @RR = (-32767);
my @RR_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @RR_missing = (3);
my @SA = (-32767);
my @SA_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @SA_missing = (3);
my @V4 = (-32767);
my @V4_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V4_missing = (3);
my @V5 = (-32767);
my @V5_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V5_missing = (3);
my @V6 = (-32767);
my @V6_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V6_missing = (3);
my @obs_timeoffset = (0);
# Kvalobs_Metadata - Free Quality Control Algorithms for Meteorological Observations
#
# $Id: geok01_card_notonly_dew_hoarfrost.pl,v 1.6 2007/10/22 16:21:09 paule Exp $
#
# Copyright (C) 2007 met.no
#
# Contact information:
# Norwegian Meteorological Institute
# Box 43 Blindern
# 0313 OSLO
# NORWAY
# email: kvalobs-dev@met.no
#
# This file is part of KVALOBS_METADATA
#
# KVALOBS_METADATA 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.
#
# KVALOBS_METADATA 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 KVALOBS_METADATA; if not, write to the Free Software Foundation Inc.,
# 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
#language : 1
#checkname : geok01_card_notonly_dew_hoarfrost
#signature : obs;RR,SA,V4,V5,V6;;
# Konsistenskontroll check Appendix 5
# Kode hentet fra "snowdepth_precip_weather.pl", subcheck 1 (geok)
# Original laget av Per Ove Kjensli i fortran.
# Siva konverterte koden til perl.
# Rettet på av Øystein Lie 14/12-2004
# Ny versjon Terje Reite og Bjørn Nordin 17.6.2005
# Ny versjon Bjørn Nordin 02.12.2005
# Ny versjon Bjørn Nordin 19.12.2005 - Geok splittet opp.
sub check {
my @index_list;
my @index_list2;
my @XRR;
my @XSA;
my @XV4;
my @XV5;
my @XV6;
# my @XX_1;
my @XSA_missing;
my @XV4_missing;
my @XV5_missing;
my @XV6_missing;
my @retvector;
# Tester om controlinfo(4)=6: Skal ikke teste, avbryter.
if ($RR_controlinfo[4] == 6) {
return 0;
}
# Hvis alle parametre mangler: Avbryt, Returverdi-flag=0.
my $b=1;
for(my $i=0; $i< $obs_numtimes; $i++) {
if( $RR_missing[$i] > 0 &&
$SA_missing[$i] > 0 &&
$V4_missing[$i] > 0 &&
$V5_missing[$i] > 0 &&
$V6_missing[$i] > 0 ){
;
}else{
$b=0;
last;
}
}
if( $b == 1 ){
return 0;
}
# Initierer parameter-arrayene:
for(my $i=0; $i<=3; $i++) {
$XRR[$i] = -32767;
$XSA[$i] = -32767;
$XV4[$i] = -32767;
$XV5[$i] = -32767;
$XV6[$i] = -32767;
$XSA_missing[$i] = -32767;
$XV4_missing[$i] = -32767;
$XV5_missing[$i] = -32767;
$XV6_missing[$i] = -32767;
}
# Lager indeks-tabell.
my $arstid = "VINT";
my $N = $obs_numtimes;
if($obstime[3]==6) {
$arstid = "SOMM";
}
for(my $i=0; $i<$N; $i++) {
if($obs_timeoffset[$i]==-660 && $obstime[3]==6) {
$arstid = "VAAR";
}
if($obs_timeoffset[$i]==-1020 && $obstime[3]==6) {
$arstid = "VAAR";
}
if($obs_timeoffset[$i]==-720 && $obstime[3]==6) {
$arstid = "SOMM";
}
if($obs_timeoffset[$i]==-1080 && $obstime[3]==6) {
$arstid = "SOMM";
}
if($obs_timeoffset[$i]==-1500 && $obstime[3]==7) {
$arstid = "HOST";
}
}
if($arstid=="VAAR") {
for(my $i=0; $i<$N; $i++) {
if($obs_timeoffset[$i]==0) {
push(@index_list,0);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-660) {
push(@index_list,1);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1020) {
push(@index_list,2);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1380) {
push(@index_list,3);
push(@index_list2,$i);
}
}
}
if($arstid=="SOMM") {
for(my $i=0; $i<$N; $i++) {
if($obs_timeoffset[$i]==0) {
push(@index_list,0);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-720) {
push(@index_list,1);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1080) {
push(@index_list,2);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1440) {
push(@index_list,3);
push(@index_list2,$i);
}
}
}
if($arstid=="HOST") {
for(my $i=0; $i<$N; $i++) {
if($obs_timeoffset[$i]==0) {
push(@index_list,0);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-780) {
push(@index_list,1);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1140) {
push(@index_list,2);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1500) {
push(@index_list,3);
push(@index_list2,$i);
}
}
}
if($arstid=="VINT") {
for(my $i=0; $i<$N; $i++) {
if($obs_timeoffset[$i]==0) {
push(@index_list,0);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-780) {
push(@index_list,1);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1140) {
push(@index_list,2);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1440) {
push(@index_list,3);
push(@index_list2,$i);
}
}
}
$N = @index_list;
# Sorterer parametrene på rett plass i tid i parameterarrayene.
for(my $i=0; $i<$N; $i++) {
$XRR[$index_list[$i]] = $RR[$index_list2[$i]];
$XSA[$index_list[$i]] = $SA[$index_list2[$i]];
$XV4[$index_list[$i]] = $V4[$index_list2[$i]];
$XV5[$index_list[$i]] = $V5[$index_list2[$i]];
$XV6[$index_list[$i]] = $V6[$index_list2[$i]];
$XSA_missing[$index_list[$i]] = $SA_missing[$index_list2[$i]];
$XV4_missing[$index_list[$i]] = $V4_missing[$index_list2[$i]];
$XV5_missing[$index_list[$i]] = $V5_missing[$index_list2[$i]];
$XV6_missing[$index_list[$i]] = $V6_missing[$index_list2[$i]];
}
my $sst;
my $regn = "N"; my $sne = "N"; my $sludd = "N";
my $duri = "N"; my $hagl = "N"; my $tord = "N";
my $tosym;
my $hosym;
my $bisym;
my $dk;
my $tolerans;
my @retvector;
my @vx =($XV4[2],$XV5[2],$XV6[2],$XV4[1],$XV5[1],$XV6[1],$XV4[0],$XV5[0],$XV6[0]);
#my @vx_missing =( $V4_missing[2],$V5_missing[2],$V6_missing[2],
# $V4_missing[1],$V5_missing[1],$V6_missing[1],
# $V4_missing[0],$V5_missing[0],$V6_missing[0]);
# the following convention for the hours is used::
# $VX[0] is 0600 today, $VX[1] is 1800 yesterday,$VX[2] is 1200 yesterday, $VX[3] is 0600 yesterday, where X={4,5,6}
# to make this comparison possible @SA is made such that:
# $SA[0] is 0600 today, $SA[1] and $SA[2] is not defined, $SA[3] is 0600 yesterday
$dk = "INGEN";
if ($XSA_missing[0]>0 || $XSA_missing[3]>0) {
$sst = undef;
}else{
if ($XSA[0] ne undef && $XSA[3] ne undef ) {
if ($XSA[3] < 0) {
$XSA[3] = 0;
}
if ($XSA[0] < 0) {
$XSA[0] = 0;
}
$sst = $XSA[0] - $XSA[3];
# $XSA[3] = $XSA[0];
}else{
$sst = undef;
}
}
for(my $i=0; $i<=8; $i++) {
# if( $vx[$i] ne undef && $vx_missing[$i] == 0 ){
if ($vx[$i]==3 || $vx[$i]==7 || $vx[$i]==8) {
$regn = "J";
}
if ($vx[$i]==2 || $vx[$i]==5 || $vx[$i]==6) {
$sne = "J";
}
if ($vx[$i]==1 || $vx[$i]==4) {
$sludd = "J";
}
if ($vx[$i]==17 || $vx[$i]==12 || $vx[$i]==31) {
$duri = "J";
}
if ($vx[$i]==10) {
$hagl = "J";
}
}
$tosym = $regn . $sludd . $sne . $duri . $hagl;
if ($tosym eq "NNNNN") {
$dk = "INGEN";
}
else {
$hosym = $regn . $sludd . $sne;
$dk = "MIKS";
if ($hosym eq "JNN") {
$dk = "REGN";
}
if ($hosym eq "NNJ") {
$dk = "SNE";
}
if ($hosym eq "NNN") {
$bisym = $duri . $hagl;
if ($bisym eq "JN") {
$dk = "DURI";
}
if ($bisym eq "NN") {
$dk = "INGEN";
}
}
if ($dk eq "MIKS") {
if ($sst > 0) {
$dk = "SNE";
} else {
$dk = "REGN";
}
}
}
my $flag = 1;
my $RRfla3 = 1;
my $RRfla4 = 1;
# my @sjekk_flag;
# Initierer sjekk_flag:
# for(my $i=0; $i<=12; $i++) {
# $sjekk_flag[$i] = 0;
# }
# Check no. 72.1 Not only dew / hoar frost --------------------------
if (($XRR[0] == 0.0 || $XRR[0] > 0.5) && $dk eq "DURI") {
$flag = 4;
if ($XV4_missing[0]==0) {
if ($XV4[0]==17 || $XV4[0]==12 || $XV4[0]==31) {
push(@retvector, "V4_0_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V4_0_0_flag", "1");
}
}
if ($XV4_missing[1]==0) {
if ($XV4[1]==17 || $XV4[1]==12 || $XV4[1]==31) {
push(@retvector, "V4_1_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V4_1_0_flag", "1");
}
}
if ($XV4_missing[2]==0) {
if ($XV4[2]==17 || $XV4[2]==12 || $XV4[2]==31) {
push(@retvector, "V4_2_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V4_2_0_flag", "1");
}
}
if ($XV5_missing[0]==0) {
if ($XV5[0]==17 || $XV5[0]==12 || $XV5[0]==31) {
push(@retvector, "V5_0_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V5_0_0_flag", "1");
}
}
if ($XV5_missing[1]==0) {
if ($XV5[1]==17 || $XV5[1]==12 || $XV5[1]==31) {
push(@retvector, "V5_1_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V5_1_0_flag", "1");
}
}
if ($XV5_missing[2]==0) {
if ($XV5[2]==17 || $XV5[2]==12 || $XV5[2]==31) {
push(@retvector, "V5_2_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V5_2_0_flag", "1");
}
}
if ($XV6_missing[0]==0) {
if ($XV6[0]==17 || $XV6[0]==12 || $XV6[0]==31) {
push(@retvector, "V6_0_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V6_0_0_flag", "1");
}
}
if ($XV6_missing[1]==0) {
if ($XV6[1]==17 || $XV6[1]==12 || $XV6[1]==31) {
push(@retvector, "V6_1_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V6_1_0_flag", "1");
}
}
if ($XV6_missing[2]==0) {
if ($XV6[2]==17 || $XV6[2]==12 || $XV6[2]==31) {
push(@retvector, "V6_2_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V6_2_0_flag", "1");
}
}
}
#---------------------------------------------------------------------------------
if ($RR_missing[0]==0) {
if ($RRfla3 == 3 && $RRfla4 != 4) {
push(@retvector, "RR_0_0_flag", $RRfla3);
} elsif ($RRfla4 == 4) {
push(@retvector, "RR_0_0_flag", $RRfla4);
} elsif ($RRfla3 == 1 && $RRfla4 == 1) {
push(@retvector, "RR_0_0_flag", "1");
}
}
#---------------------------------------------------------------------------------
my $numout= @retvector; # antall returverdier
if ($numout == 0) {
# print "Alt er OK";
return 0;
}
return (@retvector, $numout);
}
RESULT:
-------------------------------------------------------------------------------
CHECK: QC1-2-72.c10 - geok10_card_snowdepth_decreasing_to_0
Abstract signature: obs;RR,SA,V4,V5,V6;;
Concrete signature: obs;RR_24&&&402,SA&&&402,V4&&&402,V5&&&402,V6&&&402;;0,-1501
SCRIPT:
use strict;
# general
my @obstime = (2010, 7, 16, 6, 0, 0);
# obs
my $obs_missing = 5;
my $obs_numtimes = 1;
my @RR = (-32767);
my @RR_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @RR_missing = (3);
my @SA = (-32767);
my @SA_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @SA_missing = (3);
my @V4 = (-32767);
my @V4_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V4_missing = (3);
my @V5 = (-32767);
my @V5_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V5_missing = (3);
my @V6 = (-32767);
my @V6_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V6_missing = (3);
my @obs_timeoffset = (0);
# Kvalobs_Metadata - Free Quality Control Algorithms for Meteorological Observations
#
# $Id: geok10_card_snowdepth_decreasing_to_0.pl,v 1.6 2007/10/22 16:21:09 paule Exp $
#
# Copyright (C) 2007 met.no
#
# Contact information:
# Norwegian Meteorological Institute
# Box 43 Blindern
# 0313 OSLO
# NORWAY
# email: kvalobs-dev@met.no
#
# This file is part of KVALOBS_METADATA
#
# KVALOBS_METADATA 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.
#
# KVALOBS_METADATA 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 KVALOBS_METADATA; if not, write to the Free Software Foundation Inc.,
# 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
#language : 1
#checkname: geok10_card_snowdepth_decreasing_to_0
#signature: obs;RR,SA,V4,V5,V6;;
# Konsistenskontroll check Appendix 5
# Kode hentet fra "snowdepth_precip_weather.pl", subcheck 10 (geok)
# Original laget av Per Ove Kjensli i fortran.
# Siva konverterte koden til perl.
# Rettet på av Øystein Lie 14/12-2004
# Ny versjon Terje Reite og Bjørn Nordin 17.6.2005
# Ny versjon Bjørn Nordin 02.12.2005
# Ny versjon Bjørn Nordin 02.01.2006 - Geok splittet opp.
sub check {
my @index_list;
my @index_list2;
my @XRR;
my @XSA;
my @XV4;
my @XV5;
my @XV6;
# my @XX_1;
my @XSA_missing;
my @XV4_missing;
my @XV5_missing;
my @XV6_missing;
my @retvector;
# Tester om controlinfo(4)=6: Skal ikke teste, avbryter.
if ($RR_controlinfo[4] == 6) {
return 0;
}
# Tester om SA mangler: Skal ikke teste, avbryter.
for(my $i=0; $i< $obs_numtimes; $i++) {
if ($SA_missing[$i] > 0 && ($obs_timeoffset[$i] == 0 || $obs_timeoffset[$i] == -1440)) {
return 0;
}
}
# Hvis alle parametre mangler: Avbryt, Returverdi-flag=0.
my $b=1;
for(my $i=0; $i< $obs_numtimes; $i++) {
if( $RR_missing[$i] > 0 &&
$SA_missing[$i] > 0 &&
$V4_missing[$i] > 0 &&
$V5_missing[$i] > 0 &&
$V6_missing[$i] > 0 ){
;
}else{
$b=0;
last;
}
}
if( $b == 1 ){
return 0;
}
# Initierer parameter-arrayene:
for(my $i=0; $i<=3; $i++) {
$XRR[$i] = -32767;
$XSA[$i] = -32767;
$XV4[$i] = -32767;
$XV5[$i] = -32767;
$XV6[$i] = -32767;
$XSA_missing[$i] = -32767;
$XV4_missing[$i] = -32767;
$XV5_missing[$i] = -32767;
$XV6_missing[$i] = -32767;
}
# Lager indeks-tabell.
my $N = $obs_numtimes;
for(my $i=0; $i<$N; $i++) {
if($obs_timeoffset[$i]==0) {
push(@index_list,0);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-780) {
push(@index_list,1);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1140) {
push(@index_list,2);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1440) {
push(@index_list,3);
push(@index_list2,$i);
}
}
$N = @index_list;
# Sorterer parametrene på rett plass i tid i parameterarrayene.
for(my $i=0; $i<$N; $i++) {
$XRR[$index_list[$i]] = $RR[$index_list2[$i]];
$XSA[$index_list[$i]] = $SA[$index_list2[$i]];
$XV4[$index_list[$i]] = $V4[$index_list2[$i]];
$XV5[$index_list[$i]] = $V5[$index_list2[$i]];
$XV6[$index_list[$i]] = $V6[$index_list2[$i]];
$XSA_missing[$index_list[$i]] = $SA_missing[$index_list2[$i]];
$XV4_missing[$index_list[$i]] = $V4_missing[$index_list2[$i]];
$XV5_missing[$index_list[$i]] = $V5_missing[$index_list2[$i]];
$XV6_missing[$index_list[$i]] = $V6_missing[$index_list2[$i]];
}
my $sst;
my $regn = "N"; my $sne = "N"; my $sludd = "N";
my $duri = "N"; my $hagl = "N"; my $tord = "N";
my $tosym;
my $hosym;
my $bisym;
my $dk;
my $tolerans;
my @retvector;
my @vx =($XV4[2],$XV5[2],$XV6[2],$XV4[1],$XV5[1],$XV6[1],$XV4[0],$XV5[0],$XV6[0]);
#my @vx_missing =( $V4_missing[2],$V5_missing[2],$V6_missing[2],
# $V4_missing[1],$V5_missing[1],$V6_missing[1],
# $V4_missing[0],$V5_missing[0],$V6_missing[0]);
# the following convention for the hours is used::
# $VX[0] is 0600 today, $VX[1] is 1800 yesterday,$VX[2] is 1200 yesterday, $VX[3] is 0600 yesterday, where X={4,5,6}
# to make this comparison possible @SA is made such that:
# $SA[0] is 0600 today, $SA[1] and $SA[2] is not defined, $SA[3] is 0600 yesterday
$dk = "INGEN";
if ($XSA_missing[0]>0 || $XSA_missing[3]>0) {
$sst = undef;
}else{
if ($XSA[0] ne undef && $XSA[3] ne undef ) {
if ($XSA[3] < 0) {
$XSA[3] = 0;
}
if ($XSA[0] < 0) {
$XSA[0] = 0;
}
$sst = $XSA[0] - $XSA[3];
# $XSA[3] = $XSA[0];
}else{
$sst = undef;
}
}
for(my $i=0; $i<=8; $i++) {
# if( $vx[$i] ne undef && $vx_missing[$i] == 0 ){
if ($vx[$i]==3 || $vx[$i]==7 || $vx[$i]==8) {
$regn = "J";
}
if ($vx[$i]==2 || $vx[$i]==5 || $vx[$i]==6) {
$sne = "J";
}
if ($vx[$i]==1 || $vx[$i]==4) {
$sludd = "J";
}
if ($vx[$i]==17 || $vx[$i]==12 || $vx[$i]==31) {
$duri = "J";
}
if ($vx[$i]==10) {
$hagl = "J";
}
}
$tosym = $regn . $sludd . $sne . $duri . $hagl;
if ($tosym eq "NNNNN") {
$dk = "INGEN";
}
else {
$hosym = $regn . $sludd . $sne;
$dk = "MIKS";
if ($hosym eq "JNN") {
$dk = "REGN";
}
if ($hosym eq "NNJ") {
$dk = "SNE";
}
if ($hosym eq "NNN") {
$bisym = $duri . $hagl;
if ($bisym eq "JN") {
$dk = "DURI";
}
if ($bisym eq "NN") {
$dk = "INGEN";
}
}
if ($dk eq "MIKS") {
if ($sst > 0) {
$dk = "SNE";
} else {
$dk = "REGN";
}
}
}
my $flag = 1;
my $RRfla3 = 1;
my $RRfla4 = 1;
# Check no. 72.10 Snow depth decreasing to 0 ------------------------
if ($sst < -15 && $XSA[0] <= 0 && $dk eq "SNE") {
$flag = 4;
if ($XV4_missing[0]==0) {
if ($XV4[0]==2 || $XV4[0]==5 || $XV4[0]==6) {
push(@retvector, "V4_0_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V4_0_0_flag", "1");
}
}
if ($XV4_missing[1]==0) {
if ($XV4[1]==2 || $XV4[1]==5 || $XV4[1]==6) {
push(@retvector, "V4_1_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V4_1_0_flag", "1");
}
}
if ($XV4_missing[2]==0) {
if ($XV4[2]==2 || $XV4[2]==5 || $XV4[2]==6) {
push(@retvector, "V4_2_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V4_2_0_flag", "1");
}
}
if ($XV5_missing[0]==0) {
if ($XV5[0]==2 || $XV5[0]==5 || $XV5[0]==6) {
push(@retvector, "V5_0_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V5_0_0_flag", "1");
}
}
if ($XV5_missing[1]==0) {
if ($XV5[1]==2 || $XV5[1]==5 || $XV5[1]==6) {
push(@retvector, "V5_1_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V5_1_0_flag", "1");
}
}
if ($XV5_missing[2]==0) {
if ($XV5[2]==2 || $XV5[2]==5 || $XV5[2]==6) {
push(@retvector, "V5_2_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V5_2_0_flag", "1");
}
}
if ($XV6_missing[0]==0) {
if ($XV6[0]==2 || $XV6[0]==5 || $XV6[0]==6) {
push(@retvector, "V6_0_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V6_0_0_flag", "1");
}
}
if ($XV6_missing[1]==0) {
if ($XV6[1]==2 || $XV6[1]==5 || $XV6[1]==6) {
push(@retvector, "V6_1_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V6_1_0_flag", "1");
}
}
if ($XV6_missing[2]==0) {
if ($XV6[2]==2 || $XV6[2]==5 || $XV6[2]==6) {
push(@retvector, "V6_2_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V6_2_0_flag", "1");
}
}
}
#---------------------------------------------------------------------------------
if ($RR_missing[0]==0) {
if ($RRfla3 == 3 && $RRfla4 != 4) {
push(@retvector, "RR_0_0_flag", $RRfla3);
} elsif ($RRfla4 == 4) {
push(@retvector, "RR_0_0_flag", $RRfla4);
} elsif ($RRfla3 == 1 && $RRfla4 == 1) {
push(@retvector, "RR_0_0_flag", "1");
}
}
#---------------------------------------------------------------------------------
if ($XSA_missing[0]==0) {
if ($flag == 4) {
push(@retvector, "SA_0_0_flag", "4");
} elsif ($flag == 1) {
push(@retvector, "SA_0_0_flag", "1");
}
}
#---------------------------------------------------------------------------------
# else {
# print "manglende defaulthåndtering";
# }
my $numout= @retvector; # antall returverdier
if ($numout == 0) {
# print "Alt er OK";
return 0;
}
return (@retvector, $numout);
}
RESULT:
-------------------------------------------------------------------------------
CHECK: QC1-2-72.c11 - geok11_card_noprecip_but_precipsymbol
Abstract signature: obs;RR,SA,V4,V5,V6;;
Concrete signature: obs;RR_24&&&402,SA&&&402,V4&&&402,V5&&&402,V6&&&402;;0,-1501
SCRIPT:
use strict;
# general
my @obstime = (2010, 7, 16, 6, 0, 0);
# obs
my $obs_missing = 5;
my $obs_numtimes = 1;
my @RR = (-32767);
my @RR_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @RR_missing = (3);
my @SA = (-32767);
my @SA_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @SA_missing = (3);
my @V4 = (-32767);
my @V4_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V4_missing = (3);
my @V5 = (-32767);
my @V5_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V5_missing = (3);
my @V6 = (-32767);
my @V6_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V6_missing = (3);
my @obs_timeoffset = (0);
# Kvalobs_Metadata - Free Quality Control Algorithms for Meteorological Observations
#
# $Id: geok11_card_noprecip_but_precipsymbol.pl,v 1.6 2007/10/22 16:21:10 paule Exp $
#
# Copyright (C) 2007 met.no
#
# Contact information:
# Norwegian Meteorological Institute
# Box 43 Blindern
# 0313 OSLO
# NORWAY
# email: kvalobs-dev@met.no
#
# This file is part of KVALOBS_METADATA
#
# KVALOBS_METADATA 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.
#
# KVALOBS_METADATA 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 KVALOBS_METADATA; if not, write to the Free Software Foundation Inc.,
# 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
#language : 1
#checkname: geok11_card_noprecip_but_precipsymbol
#signature: obs;RR,SA,V4,V5,V6;;
# Konsistenskontroll check Appendix 5
# Kode hentet fra "snowdepth_precip_weather.pl", subcheck 11 (geok)
# Original laget av Per Ove Kjensli i fortran.
# Siva konverterte koden til perl.
# Rettet på av Øystein Lie 14/12-2004
# Ny versjon Terje Reite og Bjørn Nordin 17.6.2005
# Ny versjon Bjørn Nordin 02.12.2005
# Ny versjon Bjørn Nordin 02.01.2006 - Geok splittet opp.
sub check {
my @index_list;
my @index_list2;
my @XRR;
my @XSA;
my @XV4;
my @XV5;
my @XV6;
# my @XX_1;
my @XSA_missing;
my @XV4_missing;
my @XV5_missing;
my @XV6_missing;
my @retvector;
# Tester om controlinfo(4)=6: Skal ikke teste, avbryter.
if ($RR_controlinfo[4] == 6) {
return 0;
}
# Hvis alle parametre mangler: Avbryt, Returverdi-flag=0.
my $b=1;
for(my $i=0; $i< $obs_numtimes; $i++) {
if( $RR_missing[$i] > 0 &&
$SA_missing[$i] > 0 &&
$V4_missing[$i] > 0 &&
$V5_missing[$i] > 0 &&
$V6_missing[$i] > 0 ){
;
}else{
$b=0;
last;
}
}
if( $b == 1 ){
return 0;
}
# Initierer parameter-arrayene:
for(my $i=0; $i<=3; $i++) {
$XRR[$i] = -32767;
$XSA[$i] = -32767;
$XV4[$i] = -32767;
$XV5[$i] = -32767;
$XV6[$i] = -32767;
$XSA_missing[$i] = -32767;
$XV4_missing[$i] = -32767;
$XV5_missing[$i] = -32767;
$XV6_missing[$i] = -32767;
}
# Lager indeks-tabell.
my $arstid = "VINT";
my $N = $obs_numtimes;
if($obstime[3]==6) {
$arstid = "SOMM";
}
for(my $i=0; $i<$N; $i++) {
if($obs_timeoffset[$i]==-660 && $obstime[3]==6) {
$arstid = "VAAR";
}
if($obs_timeoffset[$i]==-1020 && $obstime[3]==6) {
$arstid = "VAAR";
}
if($obs_timeoffset[$i]==-720 && $obstime[3]==6) {
$arstid = "SOMM";
}
if($obs_timeoffset[$i]==-1080 && $obstime[3]==6) {
$arstid = "SOMM";
}
if($obs_timeoffset[$i]==-1500 && $obstime[3]==7) {
$arstid = "HOST";
}
}
if($arstid=="VAAR") {
for(my $i=0; $i<$N; $i++) {
if($obs_timeoffset[$i]==0) {
push(@index_list,0);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-660) {
push(@index_list,1);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1020) {
push(@index_list,2);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1380) {
push(@index_list,3);
push(@index_list2,$i);
}
}
}
if($arstid=="SOMM") {
for(my $i=0; $i<$N; $i++) {
if($obs_timeoffset[$i]==0) {
push(@index_list,0);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-720) {
push(@index_list,1);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1080) {
push(@index_list,2);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1440) {
push(@index_list,3);
push(@index_list2,$i);
}
}
}
if($arstid=="HOST") {
for(my $i=0; $i<$N; $i++) {
if($obs_timeoffset[$i]==0) {
push(@index_list,0);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-780) {
push(@index_list,1);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1140) {
push(@index_list,2);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1500) {
push(@index_list,3);
push(@index_list2,$i);
}
}
}
if($arstid=="VINT") {
for(my $i=0; $i<$N; $i++) {
if($obs_timeoffset[$i]==0) {
push(@index_list,0);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-780) {
push(@index_list,1);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1140) {
push(@index_list,2);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1440) {
push(@index_list,3);
push(@index_list2,$i);
}
}
}
$N = @index_list;
# Sorterer parametrene på rett plass i tid i parameterarrayene.
for(my $i=0; $i<$N; $i++) {
$XRR[$index_list[$i]] = $RR[$index_list2[$i]];
$XSA[$index_list[$i]] = $SA[$index_list2[$i]];
$XV4[$index_list[$i]] = $V4[$index_list2[$i]];
$XV5[$index_list[$i]] = $V5[$index_list2[$i]];
$XV6[$index_list[$i]] = $V6[$index_list2[$i]];
$XSA_missing[$index_list[$i]] = $SA_missing[$index_list2[$i]];
$XV4_missing[$index_list[$i]] = $V4_missing[$index_list2[$i]];
$XV5_missing[$index_list[$i]] = $V5_missing[$index_list2[$i]];
$XV6_missing[$index_list[$i]] = $V6_missing[$index_list2[$i]];
}
my $sst;
my $regn = "N"; my $sne = "N"; my $sludd = "N";
my $duri = "N"; my $hagl = "N"; my $tord = "N";
my $tosym;
my $hosym;
my $bisym;
my $dk;
my $tolerans;
my @retvector;
my @vx =($XV4[2],$XV5[2],$XV6[2],$XV4[1],$XV5[1],$XV6[1],$XV4[0],$XV5[0],$XV6[0]);
#my @vx_missing =( $V4_missing[2],$V5_missing[2],$V6_missing[2],
# $V4_missing[1],$V5_missing[1],$V6_missing[1],
# $V4_missing[0],$V5_missing[0],$V6_missing[0]);
# the following convention for the hours is used::
# $VX[0] is 0600 today, $VX[1] is 1800 yesterday,$VX[2] is 1200 yesterday, $VX[3] is 0600 yesterday, where X={4,5,6}
# to make this comparison possible @SA is made such that:
# $SA[0] is 0600 today, $SA[1] and $SA[2] is not defined, $SA[3] is 0600 yesterday
$dk = "INGEN";
if ($XSA_missing[0]>0 || $XSA_missing[3]>0) {
$sst = undef;
}else{
if ($XSA[0] ne undef && $XSA[3] ne undef ) {
if ($XSA[3] < 0) {
$XSA[3] = 0;
}
if ($XSA[0] < 0) {
$XSA[0] = 0;
}
$sst = $XSA[0] - $XSA[3];
# $XSA[3] = $XSA[0];
}else{
$sst = undef;
}
}
for(my $i=0; $i<=8; $i++) {
# if( $vx[$i] ne undef && $vx_missing[$i] == 0 ){
if ($vx[$i]==3 || $vx[$i]==7 || $vx[$i]==8) {
$regn = "J";
}
if ($vx[$i]==2 || $vx[$i]==5 || $vx[$i]==6) {
$sne = "J";
}
if ($vx[$i]==1 || $vx[$i]==4) {
$sludd = "J";
}
if ($vx[$i]==17 || $vx[$i]==12 || $vx[$i]==31) {
$duri = "J";
}
if ($vx[$i]==10) {
$hagl = "J";
}
}
$tosym = $regn . $sludd . $sne . $duri . $hagl;
if ($tosym eq "NNNNN") {
$dk = "INGEN";
}
else {
$hosym = $regn . $sludd . $sne;
$dk = "MIKS";
if ($hosym eq "JNN") {
$dk = "REGN";
}
if ($hosym eq "NNJ") {
$dk = "SNE";
}
if ($hosym eq "NNN") {
$bisym = $duri . $hagl;
if ($bisym eq "JN") {
$dk = "DURI";
}
if ($bisym eq "NN") {
$dk = "INGEN";
}
}
if ($dk eq "MIKS") {
if ($sst > 0) {
$dk = "SNE";
} else {
$dk = "REGN";
}
}
}
my $flag = 1;
my $RRfla3 = 1;
my $RRfla4 = 1;
# Check no. 72.11 No precipitation / but precipitation symbol ------------
if ((($XRR[0] > -2 && $XRR[0] < 0) || ($RR_missing[0] > 0)) && $dk ne "INGEN" ) {
$flag = 4;
if ($XV4_missing[0]==0) {
if (($XV4[0]>=1 && $XV4[0]<=8) || $XV4[0]==10 || $XV4[0]==12 || $XV4[0]==17 || $XV4[0]==31) {
push(@retvector, "V4_0_0_flag", "4");
if ($RR_missing[0] == 0) {
$RRfla4 = 4;
}
} else {
push(@retvector, "V4_0_0_flag", "1");
}
}
if ($XV4_missing[1]==0) {
if (($XV4[1]>=1 && $XV4[1]<=8) || $XV4[1]==10 || $XV4[1]==12 || $XV4[1]==17 || $XV4[1]==31) {
push(@retvector, "V4_1_0_flag", "4");
if ($RR_missing[0] == 0) {
$RRfla4 = 4;
}
} else {
push(@retvector, "V4_1_0_flag", "1");
}
}
if ($XV4_missing[2]==0) {
if (($XV4[2]>=1 && $XV4[2]<=8) || $XV4[2]==10 || $XV4[2]==12 || $XV4[2]==17 || $XV4[2]==31) {
push(@retvector, "V4_2_0_flag", "4");
if ($RR_missing[0] == 0) {
$RRfla4 = 4;
}
} else {
push(@retvector, "V4_2_0_flag", "1");
}
}
if ($XV5_missing[0]==0) {
if (($XV5[0]>=1 && $XV5[0]<=8) || $XV5[0]==10 || $XV5[0]==12 || $XV5[0]==17 || $XV5[0]==31) {
push(@retvector, "V5_0_0_flag", "4");
if ($RR_missing[0] == 0) {
$RRfla4 = 4;
}
} else {
push(@retvector, "V5_0_0_flag", "1");
}
}
if ($XV5_missing[1]==0) {
if (($XV5[1]>=1 && $XV5[1]<=8) || $XV5[1]==10 || $XV5[1]==12 || $XV5[1]==17 || $XV5[1]==31) {
push(@retvector, "V5_1_0_flag", "4");
if ($RR_missing[0] == 0) {
$RRfla4 = 4;
}
} else {
push(@retvector, "V5_1_0_flag", "1");
}
}
if ($XV5_missing[2]==0) {
if (($XV5[2]>=1 && $XV5[2]<=8) || $XV5[2]==10 || $XV5[2]==12 || $XV5[2]==17 || $XV5[2]==31) {
push(@retvector, "V5_2_0_flag", "4");
if ($RR_missing[0] == 0) {
$RRfla4 = 4;
}
} else {
push(@retvector, "V5_2_0_flag", "1");
}
}
if ($XV6_missing[0]==0) {
if (($XV6[0]>=1 && $XV6[0]<=8) || $XV6[0]==10 || $XV6[0]==12 || $XV6[0]==17 || $XV6[0]==31) {
push(@retvector, "V6_0_0_flag", "4");
if ($RR_missing[0] == 0) {
$RRfla4 = 4;
}
} else {
push(@retvector, "V6_0_0_flag", "1");
}
}
if ($XV6_missing[1]==0) {
if (($XV6[1]>=1 && $XV6[1]<=8) || $XV6[1]==10 || $XV6[1]==12 || $XV6[1]==17 || $XV6[1]==31) {
push(@retvector, "V6_1_0_flag", "4");
if ($RR_missing[0] == 0) {
$RRfla4 = 4;
}
} else {
push(@retvector, "V6_1_0_flag", "1");
}
}
if ($XV6_missing[2]==0) {
if (($XV6[2]>=1 && $XV6[2]<=8) || $XV6[2]==10 || $XV6[2]==12 || $XV6[2]==17 || $XV6[2]==31) {
push(@retvector, "V6_2_0_flag", "4");
if ($RR_missing[0] == 0) {
$RRfla4 = 4;
}
} else {
push(@retvector, "V6_2_0_flag", "1");
}
}
}
#---------------------------------------------------------------------------------
if ($RR_missing[0]==0) {
if ($RRfla3 == 3 && $RRfla4 != 4) {
push(@retvector, "RR_0_0_flag", $RRfla3);
} elsif ($RRfla4 == 4) {
push(@retvector, "RR_0_0_flag", $RRfla4);
} elsif ($RRfla3 == 1 && $RRfla4 == 1) {
push(@retvector, "RR_0_0_flag", "1");
}
}
#---------------------------------------------------------------------------------
# else {
# print "manglende defaulthåndtering";
# }
my $numout= @retvector; # antall returverdier
if ($numout == 0) {
# print "Alt er OK";
return 0;
}
return (@retvector, $numout);
}
RESULT:
-------------------------------------------------------------------------------
CHECK: QC1-2-72.c12 - geok12_card_precip_but_noprecipsymbol
Abstract signature: obs;RR,SA,V4,V5,V6;;
Concrete signature: obs;RR_24&&&402,SA&&&402,V4&&&402,V5&&&402,V6&&&402;;0,-1501
SCRIPT:
use strict;
# general
my @obstime = (2010, 7, 16, 6, 0, 0);
# obs
my $obs_missing = 5;
my $obs_numtimes = 1;
my @RR = (-32767);
my @RR_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @RR_missing = (3);
my @SA = (-32767);
my @SA_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @SA_missing = (3);
my @V4 = (-32767);
my @V4_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V4_missing = (3);
my @V5 = (-32767);
my @V5_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V5_missing = (3);
my @V6 = (-32767);
my @V6_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V6_missing = (3);
my @obs_timeoffset = (0);
# Kvalobs_Metadata - Free Quality Control Algorithms for Meteorological Observations
#
# $Id: geok12_card_precip_but_noprecipsymbol.pl,v 1.8 2007/10/22 16:21:10 paule Exp $
#
# Copyright (C) 2007 met.no
#
# Contact information:
# Norwegian Meteorological Institute
# Box 43 Blindern
# 0313 OSLO
# NORWAY
# email: kvalobs-dev@met.no
#
# This file is part of KVALOBS_METADATA
#
# KVALOBS_METADATA 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.
#
# KVALOBS_METADATA 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 KVALOBS_METADATA; if not, write to the Free Software Foundation Inc.,
# 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
#language : 1
#checkname: geok12_card_precip_but_noprecipsymbol
#signature: obs;RR,SA,V4,V5,V6;;
# Konsistenskontroll check Appendix 5
# Kode hentet fra "snowdepth_precip_weather.pl", subcheck 12 (geok)
# Original laget av Per Ove Kjensli i fortran.
# Siva konverterte koden til perl.
# Rettet på av Øystein Lie 14/12-2004
# Ny versjon Terje Reite og Bjørn Nordin 17.6.2005
# Ny versjon Bjørn Nordin 02.12.2005
# Ny versjon Bjørn Nordin 02.01.2006 - Geok splittet opp.
sub check {
my @index_list;
my @index_list2;
my @XRR;
my @XSA;
my @XV4;
my @XV5;
my @XV6;
# my @XX_1;
my @XSA_missing;
my @XV4_missing;
my @XV5_missing;
my @XV6_missing;
my @retvector;
# Tester om controlinfo(4)=6: Skal ikke teste, avbryter.
if ($RR_controlinfo[4] == 6) {
return 0;
}
# Hvis alle parametre mangler: Avbryt, Returverdi-flag=0.
my $b=1;
for(my $i=0; $i< $obs_numtimes; $i++) {
if( $RR_missing[$i] > 0 &&
$SA_missing[$i] > 0 &&
$V4_missing[$i] > 0 &&
$V5_missing[$i] > 0 &&
$V6_missing[$i] > 0 ){
;
}else{
$b=0;
last;
}
}
if( $b == 1 ){
return 0;
}
# Initierer parameter-arrayene:
for(my $i=0; $i<=3; $i++) {
$XRR[$i] = -32767;
$XSA[$i] = -32767;
$XV4[$i] = -32767;
$XV5[$i] = -32767;
$XV6[$i] = -32767;
$XSA_missing[$i] = -32767;
$XV4_missing[$i] = -32767;
$XV5_missing[$i] = -32767;
$XV6_missing[$i] = -32767;
}
# Lager indeks-tabell.
my $arstid = "VINT";
my $N = $obs_numtimes;
if($obstime[3]==6) {
$arstid = "SOMM";
}
for(my $i=0; $i<$N; $i++) {
if($obs_timeoffset[$i]==-660 && $obstime[3]==6) {
$arstid = "VAAR";
}
if($obs_timeoffset[$i]==-1020 && $obstime[3]==6) {
$arstid = "VAAR";
}
if($obs_timeoffset[$i]==-720 && $obstime[3]==6) {
$arstid = "SOMM";
}
if($obs_timeoffset[$i]==-1080 && $obstime[3]==6) {
$arstid = "SOMM";
}
if($obs_timeoffset[$i]==-1500 && $obstime[3]==7) {
$arstid = "HOST";
}
}
if($arstid=="VAAR") {
for(my $i=0; $i<$N; $i++) {
if($obs_timeoffset[$i]==0) {
push(@index_list,0);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-660) {
push(@index_list,1);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1020) {
push(@index_list,2);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1380) {
push(@index_list,3);
push(@index_list2,$i);
}
}
}
if($arstid=="SOMM") {
for(my $i=0; $i<$N; $i++) {
if($obs_timeoffset[$i]==0) {
push(@index_list,0);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-720) {
push(@index_list,1);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1080) {
push(@index_list,2);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1440) {
push(@index_list,3);
push(@index_list2,$i);
}
}
}
if($arstid=="HOST") {
for(my $i=0; $i<$N; $i++) {
if($obs_timeoffset[$i]==0) {
push(@index_list,0);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-780) {
push(@index_list,1);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1140) {
push(@index_list,2);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1500) {
push(@index_list,3);
push(@index_list2,$i);
}
}
}
if($arstid=="VINT") {
for(my $i=0; $i<$N; $i++) {
if($obs_timeoffset[$i]==0) {
push(@index_list,0);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-780) {
push(@index_list,1);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1140) {
push(@index_list,2);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1440) {
push(@index_list,3);
push(@index_list2,$i);
}
}
}
$N = @index_list;
# Sorterer parametrene på rett plass i tid i parameterarrayene.
for(my $i=0; $i<$N; $i++) {
$XRR[$index_list[$i]] = $RR[$index_list2[$i]];
$XSA[$index_list[$i]] = $SA[$index_list2[$i]];
$XV4[$index_list[$i]] = $V4[$index_list2[$i]];
$XV5[$index_list[$i]] = $V5[$index_list2[$i]];
$XV6[$index_list[$i]] = $V6[$index_list2[$i]];
$XSA_missing[$index_list[$i]] = $SA_missing[$index_list2[$i]];
$XV4_missing[$index_list[$i]] = $V4_missing[$index_list2[$i]];
$XV5_missing[$index_list[$i]] = $V5_missing[$index_list2[$i]];
$XV6_missing[$index_list[$i]] = $V6_missing[$index_list2[$i]];
}
my $sst;
my $regn = "N"; my $sne = "N"; my $sludd = "N";
my $duri = "N"; my $hagl = "N"; my $tord = "N";
my $tosym;
my $hosym;
my $bisym;
my $dk;
my $tolerans;
my @retvector;
my @vx =($XV4[2],$XV5[2],$XV6[2],$XV4[1],$XV5[1],$XV6[1],$XV4[0],$XV5[0],$XV6[0]);
#my @vx_missing =( $V4_missing[2],$V5_missing[2],$V6_missing[2],
# $V4_missing[1],$V5_missing[1],$V6_missing[1],
# $V4_missing[0],$V5_missing[0],$V6_missing[0]);
# the following convention for the hours is used::
# $VX[0] is 0600 today, $VX[1] is 1800 yesterday,$VX[2] is 1200 yesterday, $VX[3] is 0600 yesterday, where X={4,5,6}
# to make this comparison possible @SA is made such that:
# $SA[0] is 0600 today, $SA[1] and $SA[2] is not defined, $SA[3] is 0600 yesterday
$dk = "INGEN";
if ($XSA_missing[0]>0 || $XSA_missing[3]>0) {
$sst = undef;
}else{
if ($XSA[0] ne undef && $XSA[3] ne undef ) {
if ($XSA[3] < 0) {
$XSA[3] = 0;
}
if ($XSA[0] < 0) {
$XSA[0] = 0;
}
$sst = $XSA[0] - $XSA[3];
# $XSA[3] = $XSA[0];
}else{
$sst = undef;
}
}
for(my $i=0; $i<=8; $i++) {
# if( $vx[$i] ne undef && $vx_missing[$i] == 0 ){
if ($vx[$i]==3 || $vx[$i]==7 || $vx[$i]==8) {
$regn = "J";
}
if ($vx[$i]==2 || $vx[$i]==5 || $vx[$i]==6) {
$sne = "J";
}
if ($vx[$i]==1 || $vx[$i]==4) {
$sludd = "J";
}
if ($vx[$i]==17 || $vx[$i]==12 || $vx[$i]==31) {
$duri = "J";
}
if ($vx[$i]==10) {
$hagl = "J";
}
}
$tosym = $regn . $sludd . $sne . $duri . $hagl;
if ($tosym eq "NNNNN") {
$dk = "INGEN";
}
else {
$hosym = $regn . $sludd . $sne;
$dk = "MIKS";
if ($hosym eq "JNN") {
$dk = "REGN";
}
if ($hosym eq "NNJ") {
$dk = "SNE";
}
if ($hosym eq "NNN") {
$bisym = $duri . $hagl;
if ($bisym eq "JN") {
$dk = "DURI";
}
if ($bisym eq "NN") {
$dk = "INGEN";
}
}
if ($dk eq "MIKS") {
if ($sst > 0) {
$dk = "SNE";
} else {
$dk = "REGN";
}
}
}
my $flag = 1;
my $RRfla3 = 1;
my $RRfla4 = 1;
# Check no. 72.12 Precipitation / but no precipitation symbol --------------
if (($XRR[0] >= 0 && $dk eq "INGEN") || (($XRR[0] == 0 || $XRR[0] > 0.5) && $dk eq "DURI")) {
$flag = 4;
$RRfla4 = 4;
if ($XV4_missing[0]==0) {
if ($XV4[0]>8 && $XV4[0]!=10 && $XV4[0]!=12 && $XV4[0]!=17 && $XV4[0]!=31) {
push(@retvector, "V4_0_0_flag", "4");
} else {
push(@retvector, "V4_0_0_flag", "1");
}
}
if ($XV4_missing[1]==0) {
if ($XV4[1]>8 && $XV4[1]!=10 && $XV4[1]!=12 && $XV4[1]!=17 && $XV4[1]!=31) {
push(@retvector, "V4_1_0_flag", "4");
} else {
push(@retvector, "V4_1_0_flag", "1");
}
}
if ($XV4_missing[2]==0) {
if ($XV4[2]>8 && $XV4[2]!=10 && $XV4[2]!=12 && $XV4[2]!=17 && $XV4[2]!=31) {
push(@retvector, "V4_2_0_flag", "4");
} else {
push(@retvector, "V4_2_0_flag", "1");
}
}
if ($XV5_missing[0]==0) {
if ($XV5[0]>8 && $XV5[0]!=10 && $XV5[0]!=12 && $XV5[0]!=17 && $XV5[0]!=31) {
push(@retvector, "V5_0_0_flag", "4");
} else {
push(@retvector, "V5_0_0_flag", "1");
}
}
if ($XV5_missing[1]==0) {
if ($XV5[1]>8 && $XV5[1]!=10 && $XV5[1]!=12 && $XV5[1]!=17 && $XV5[1]!=31) {
push(@retvector, "V5_1_0_flag", "4");
} else {
push(@retvector, "V5_1_0_flag", "1");
}
}
if ($XV5_missing[2]==0) {
if ($XV5[2]>8 && $XV5[2]!=10 && $XV5[2]!=12 && $XV5[2]!=17 && $XV5[2]!=31) {
push(@retvector, "V5_2_0_flag", "4");
} else {
push(@retvector, "V5_2_0_flag", "1");
}
}
if ($XV6_missing[0]==0) {
if ($XV6[0]>8 && $XV6[0]!=10 && $XV6[0]!=12 && $XV6[0]!=17 && $XV6[0]!=31) {
push(@retvector, "V6_0_0_flag", "4");
} else {
push(@retvector, "V6_0_0_flag", "1");
}
}
if ($XV6_missing[1]==0) {
if ($XV6[1]>8 && $XV6[1]!=10 && $XV6[1]!=12 && $XV6[1]!=17 && $XV6[1]!=31) {
push(@retvector, "V6_1_0_flag", "4");
} else {
push(@retvector, "V6_1_0_flag", "1");
}
}
if ($XV6_missing[2]==0) {
if ($XV6[2]>8 && $XV6[2]!=10 && $XV6[2]!=12 && $XV6[2]!=17 && $XV6[2]!=31) {
push(@retvector, "V6_2_0_flag", "4");
} else {
push(@retvector, "V6_2_0_flag", "1");
}
}
}
#---------------------------------------------------------------------------------
if ($RR_missing[0]==0) {
if ($RRfla3 == 3 && $RRfla4 != 4) {
push(@retvector, "RR_0_0_flag", $RRfla3);
} elsif ($RRfla4 == 4) {
push(@retvector, "RR_0_0_flag", $RRfla4);
} elsif ($RRfla3 == 1 && $RRfla4 == 1) {
push(@retvector, "RR_0_0_flag", "1");
}
}
#---------------------------------------------------------------------------------
# else {
# print "manglende defaulthåndtering";
# }
my $numout= @retvector; # antall returverdier
if ($numout == 0) {
# print "Alt er OK";
return 0;
}
return (@retvector, $numout);
}
RESULT:
-------------------------------------------------------------------------------
CHECK: QC1-2-72.c4 - geok04_card_snowsymbol_without_snowdepth
Abstract signature: obs;RR,SA,V4,V5,V6;;|meta;X_1;;
Concrete signature: obs;RR_24&&&402,SA&&&402,V4&&&402,V5&&&402,V6&&&402;;0,-1501|meta;RR_24_R1;;
CHECK: QC1-2-72.c5 - geok05_card_snowdepth_not_increasing
Abstract signature: obs;RR,SA,V4,V5,V6;;
Concrete signature: obs;RR_24&&&402,SA&&&402,V4&&&402,V5&&&402,V6&&&402;;0,-1501
SCRIPT:
use strict;
# general
my @obstime = (2010, 7, 16, 6, 0, 0);
# obs
my $obs_missing = 5;
my $obs_numtimes = 1;
my @RR = (-32767);
my @RR_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @RR_missing = (3);
my @SA = (-32767);
my @SA_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @SA_missing = (3);
my @V4 = (-32767);
my @V4_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V4_missing = (3);
my @V5 = (-32767);
my @V5_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V5_missing = (3);
my @V6 = (-32767);
my @V6_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V6_missing = (3);
my @obs_timeoffset = (0);
# Kvalobs_Metadata - Free Quality Control Algorithms for Meteorological Observations
#
# $Id: geok05_card_snowdepth_not_increasing.pl,v 1.6 2007/10/22 16:21:09 paule Exp $
#
# Copyright (C) 2007 met.no
#
# Contact information:
# Norwegian Meteorological Institute
# Box 43 Blindern
# 0313 OSLO
# NORWAY
# email: kvalobs-dev@met.no
#
# This file is part of KVALOBS_METADATA
#
# KVALOBS_METADATA 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.
#
# KVALOBS_METADATA 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 KVALOBS_METADATA; if not, write to the Free Software Foundation Inc.,
# 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
#language : 1
#checkname: geok05_card_snowdepth_not_increasing
#signature: obs;RR,SA,V4,V5,V6;;
# Konsistenskontroll check Appendix 5
# Kode hentet fra "snowdepth_precip_weather.pl", subcheck 5 (geok)
# Original laget av Per Ove Kjensli i fortran.
# Siva konverterte koden til perl.
# Rettet på av Øystein Lie 14/12-2004
# Ny versjon Terje Reite og Bjørn Nordin 17.6.2005
# Ny versjon Bjørn Nordin 02.12.2005
# Ny versjon Bjørn Nordin 29.12.2005 - Geok splittet opp.
sub check {
my @index_list;
my @index_list2;
my @XRR;
my @XSA;
my @XV4;
my @XV5;
my @XV6;
# my @XX_1;
my @XSA_missing;
my @XV4_missing;
my @XV5_missing;
my @XV6_missing;
my @retvector;
# Tester om controlinfo(4)=6: Skal ikke teste, avbryter.
if ($RR_controlinfo[4] == 6) {
return 0;
}
# Tester om SA mangler: Skal ikke teste, avbryter.
for(my $i=0; $i< $obs_numtimes; $i++) {
if ($SA_missing[$i] > 0 && ($obs_timeoffset[$i] == 0 || $obs_timeoffset[$i] == -1440)) {
return 0;
}
}
# Hvis alle parametre mangler: Avbryt, Returverdi-flag=0.
my $b=1;
for(my $i=0; $i< $obs_numtimes; $i++) {
if( $RR_missing[$i] > 0 &&
$SA_missing[$i] > 0 &&
$V4_missing[$i] > 0 &&
$V5_missing[$i] > 0 &&
$V6_missing[$i] > 0 ){
;
}else{
$b=0;
last;
}
}
if( $b == 1 ){
return 0;
}
# Initierer parameter-arrayene:
for(my $i=0; $i<=3; $i++) {
$XRR[$i] = -32767;
$XSA[$i] = -32767;
$XV4[$i] = -32767;
$XV5[$i] = -32767;
$XV6[$i] = -32767;
$XSA_missing[$i] = -32767;
$XV4_missing[$i] = -32767;
$XV5_missing[$i] = -32767;
$XV6_missing[$i] = -32767;
}
# Lager indeks-tabell.
my $N = $obs_numtimes;
for(my $i=0; $i<$N; $i++) {
if($obs_timeoffset[$i]==0) {
push(@index_list,0);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-780) {
push(@index_list,1);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1140) {
push(@index_list,2);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1440) {
push(@index_list,3);
push(@index_list2,$i);
}
}
$N = @index_list;
# Sorterer parametrene på rett plass i tid i parameterarrayene.
for(my $i=0; $i<$N; $i++) {
$XRR[$index_list[$i]] = $RR[$index_list2[$i]];
$XSA[$index_list[$i]] = $SA[$index_list2[$i]];
$XV4[$index_list[$i]] = $V4[$index_list2[$i]];
$XV5[$index_list[$i]] = $V5[$index_list2[$i]];
$XV6[$index_list[$i]] = $V6[$index_list2[$i]];
$XSA_missing[$index_list[$i]] = $SA_missing[$index_list2[$i]];
$XV4_missing[$index_list[$i]] = $V4_missing[$index_list2[$i]];
$XV5_missing[$index_list[$i]] = $V5_missing[$index_list2[$i]];
$XV6_missing[$index_list[$i]] = $V6_missing[$index_list2[$i]];
}
my $sst;
my $regn = "N"; my $sne = "N"; my $sludd = "N";
my $duri = "N"; my $hagl = "N"; my $tord = "N";
my $tosym;
my $hosym;
my $bisym;
my $dk;
my $tolerans;
my @retvector;
my @vx =($XV4[2],$XV5[2],$XV6[2],$XV4[1],$XV5[1],$XV6[1],$XV4[0],$XV5[0],$XV6[0]);
#my @vx_missing =( $V4_missing[2],$V5_missing[2],$V6_missing[2],
# $V4_missing[1],$V5_missing[1],$V6_missing[1],
# $V4_missing[0],$V5_missing[0],$V6_missing[0]);
# the following convention for the hours is used::
# $VX[0] is 0600 today, $VX[1] is 1800 yesterday,$VX[2] is 1200 yesterday, $VX[3] is 0600 yesterday, where X={4,5,6}
# to make this comparison possible @SA is made such that:
# $SA[0] is 0600 today, $SA[1] and $SA[2] is not defined, $SA[3] is 0600 yesterday
$dk = "INGEN";
if ($XSA_missing[0]>0 || $XSA_missing[3]>0) {
$sst = undef;
}else{
if ($XSA[0] ne undef && $XSA[3] ne undef ) {
if ($XSA[3] < 0) {
$XSA[3] = 0;
}
if ($XSA[0] < 0) {
$XSA[0] = 0;
}
$sst = $XSA[0] - $XSA[3];
# $XSA[3] = $XSA[0];
}else{
$sst = undef;
}
}
for(my $i=0; $i<=8; $i++) {
# if( $vx[$i] ne undef && $vx_missing[$i] == 0 ){
if ($vx[$i]==3 || $vx[$i]==7 || $vx[$i]==8) {
$regn = "J";
}
if ($vx[$i]==2 || $vx[$i]==5 || $vx[$i]==6) {
$sne = "J";
}
if ($vx[$i]==1 || $vx[$i]==4) {
$sludd = "J";
}
if ($vx[$i]==17 || $vx[$i]==12 || $vx[$i]==31) {
$duri = "J";
}
if ($vx[$i]==10) {
$hagl = "J";
}
}
$tosym = $regn . $sludd . $sne . $duri . $hagl;
if ($tosym eq "NNNNN") {
$dk = "INGEN";
}
else {
$hosym = $regn . $sludd . $sne;
$dk = "MIKS";
if ($hosym eq "JNN") {
$dk = "REGN";
}
if ($hosym eq "NNJ") {
$dk = "SNE";
}
if ($hosym eq "NNN") {
$bisym = $duri . $hagl;
if ($bisym eq "JN") {
$dk = "DURI";
}
if ($bisym eq "NN") {
$dk = "INGEN";
}
}
if ($dk eq "MIKS") {
if ($sst > 0) {
$dk = "SNE";
} else {
$dk = "REGN";
}
}
}
my $flag = 1;
my $RRfla3 = 1;
my $RRfla4 = 1;
# my @sjekk_flag;
# Initierer sjekk_flag:
# for(my $i=0; $i<=12; $i++) {
# $sjekk_flag[$i] = 0;
# }
# Check no. 72.5 Snow depth not increasing --------------------------
if (($sst <= 0 || $sst eq undef) && $XSA[0] > 0 && $XRR[0] >= 10 && $dk eq "SNE") {
$flag = 4;
if ($XV4_missing[0]==0) {
if ($XV4[0]==2 || $XV4[0]==5 || $XV4[0]==6) {
push(@retvector, "V4_0_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V4_0_0_flag", "1");
}
}
if ($XV4_missing[1]==0) {
if ($XV4[1]==2 || $XV4[1]==5 || $XV4[1]==6) {
push(@retvector, "V4_1_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V4_1_0_flag", "1");
}
}
if ($XV4_missing[2]==0) {
if ($XV4[2]==2 || $XV4[2]==5 || $XV4[2]==6) {
push(@retvector, "V4_2_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V4_2_0_flag", "1");
}
}
if ($XV5_missing[0]==0) {
if ($XV5[0]==2 || $XV5[0]==5 || $XV5[0]==6) {
push(@retvector, "V5_0_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V5_0_0_flag", "1");
}
}
if ($XV5_missing[1]==0) {
if ($XV5[1]==2 || $XV5[1]==5 || $XV5[1]==6) {
push(@retvector, "V5_1_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V5_1_0_flag", "1");
}
}
if ($XV5_missing[2]==0) {
if ($XV5[2]==2 || $XV5[2]==5 || $XV5[2]==6) {
push(@retvector, "V5_2_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V5_2_0_flag", "1");
}
}
if ($XV6_missing[0]==0) {
if ($XV6[0]==2 || $XV6[0]==5 || $XV6[0]==6) {
push(@retvector, "V6_0_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V6_0_0_flag", "1");
}
}
if ($XV6_missing[1]==0) {
if ($XV6[1]==2 || $XV6[1]==5 || $XV6[1]==6) {
push(@retvector, "V6_1_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V6_1_0_flag", "1");
}
}
if ($XV6_missing[2]==0) {
if ($XV6[2]==2 || $XV6[2]==5 || $XV6[2]==6) {
push(@retvector, "V6_2_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V6_2_0_flag", "1");
}
}
}
#---------------------------------------------------------------------------------
if ($RR_missing[0]==0) {
if ($RRfla3 == 3 && $RRfla4 != 4) {
push(@retvector, "RR_0_0_flag", $RRfla3);
} elsif ($RRfla4 == 4) {
push(@retvector, "RR_0_0_flag", $RRfla4);
} elsif ($RRfla3 == 1 && $RRfla4 == 1) {
push(@retvector, "RR_0_0_flag", "1");
}
}
#---------------------------------------------------------------------------------
if ($XSA_missing[0]==0) {
if ($flag == 4) {
push(@retvector, "SA_0_0_flag", "4");
} elsif ($flag == 1) {
push(@retvector, "SA_0_0_flag", "1");
}
}
#---------------------------------------------------------------------------------
my $numout= @retvector; # antall returverdier
if ($numout == 0) {
# print "Alt er OK";
return 0;
}
return (@retvector, $numout);
}
RESULT:
-------------------------------------------------------------------------------
CHECK: QC1-2-72.c6 - geok06_card_snowdepth_increase_no_snowsymbol
Abstract signature: obs;RR,SA,V4,V5,V6;;
Concrete signature: obs;RR_24&&&402,SA&&&402,V4&&&402,V5&&&402,V6&&&402;;0,-1501
SCRIPT:
use strict;
# general
my @obstime = (2010, 7, 16, 6, 0, 0);
# obs
my $obs_missing = 5;
my $obs_numtimes = 1;
my @RR = (-32767);
my @RR_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @RR_missing = (3);
my @SA = (-32767);
my @SA_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @SA_missing = (3);
my @V4 = (-32767);
my @V4_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V4_missing = (3);
my @V5 = (-32767);
my @V5_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V5_missing = (3);
my @V6 = (-32767);
my @V6_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V6_missing = (3);
my @obs_timeoffset = (0);
# Kvalobs_Metadata - Free Quality Control Algorithms for Meteorological Observations
#
# $Id: geok06_card_snowdepth_increase_no_snowsymbol.pl,v 1.6 2007/10/22 16:21:09 paule Exp $
#
# Copyright (C) 2007 met.no
#
# Contact information:
# Norwegian Meteorological Institute
# Box 43 Blindern
# 0313 OSLO
# NORWAY
# email: kvalobs-dev@met.no
#
# This file is part of KVALOBS_METADATA
#
# KVALOBS_METADATA 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.
#
# KVALOBS_METADATA 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 KVALOBS_METADATA; if not, write to the Free Software Foundation Inc.,
# 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
#language : 1
#checkname: geok06_card_snowdepth_increase_no_snowsymbol
#signature: obs;RR,SA,V4,V5,V6;;
# Konsistenskontroll check Appendix 5
# Kode hentet fra "snowdepth_precip_weather.pl", subcheck 6 (geok)
# Original laget av Per Ove Kjensli i fortran.
# Siva konverterte koden til perl.
# Rettet på av Øystein Lie 14/12-2004
# Ny versjon Terje Reite og Bjørn Nordin 17.6.2005
# Ny versjon Bjørn Nordin 02.12.2005
# Ny versjon Bjørn Nordin 29.12.2005 - Geok splittet opp.
sub check {
my @index_list;
my @index_list2;
my @XRR;
my @XSA;
my @XV4;
my @XV5;
my @XV6;
# my @XX_1;
my @XSA_missing;
my @XV4_missing;
my @XV5_missing;
my @XV6_missing;
my @retvector;
# Tester om controlinfo(4)=6: Skal ikke teste, avbryter.
if ($RR_controlinfo[4] == 6) {
return 0;
}
# Tester om SA mangler: Skal ikke teste, avbryter.
for(my $i=0; $i< $obs_numtimes; $i++) {
if ($SA_missing[$i] > 0 && ($obs_timeoffset[$i] == 0 || $obs_timeoffset[$i] == -1440)) {
return 0;
}
}
# Hvis alle parametre mangler: Avbryt, Returverdi-flag=0.
my $b=1;
for(my $i=0; $i< $obs_numtimes; $i++) {
if( $RR_missing[$i] > 0 &&
$SA_missing[$i] > 0 &&
$V4_missing[$i] > 0 &&
$V5_missing[$i] > 0 &&
$V6_missing[$i] > 0 ){
;
}else{
$b=0;
last;
}
}
if( $b == 1 ){
return 0;
}
# Initierer parameter-arrayene:
for(my $i=0; $i<=3; $i++) {
$XRR[$i] = -32767;
$XSA[$i] = -32767;
$XV4[$i] = -32767;
$XV5[$i] = -32767;
$XV6[$i] = -32767;
$XSA_missing[$i] = -32767;
$XV4_missing[$i] = -32767;
$XV5_missing[$i] = -32767;
$XV6_missing[$i] = -32767;
}
# Lager indeks-tabell.
my $N = $obs_numtimes;
for(my $i=0; $i<$N; $i++) {
if($obs_timeoffset[$i]==0) {
push(@index_list,0);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-780) {
push(@index_list,1);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1140) {
push(@index_list,2);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1440) {
push(@index_list,3);
push(@index_list2,$i);
}
}
$N = @index_list;
# Sorterer parametrene på rett plass i tid i parameterarrayene.
for(my $i=0; $i<$N; $i++) {
$XRR[$index_list[$i]] = $RR[$index_list2[$i]];
$XSA[$index_list[$i]] = $SA[$index_list2[$i]];
$XV4[$index_list[$i]] = $V4[$index_list2[$i]];
$XV5[$index_list[$i]] = $V5[$index_list2[$i]];
$XV6[$index_list[$i]] = $V6[$index_list2[$i]];
$XSA_missing[$index_list[$i]] = $SA_missing[$index_list2[$i]];
$XV4_missing[$index_list[$i]] = $V4_missing[$index_list2[$i]];
$XV5_missing[$index_list[$i]] = $V5_missing[$index_list2[$i]];
$XV6_missing[$index_list[$i]] = $V6_missing[$index_list2[$i]];
}
my $sst;
my $regn = "N"; my $sne = "N"; my $sludd = "N";
my $duri = "N"; my $hagl = "N"; my $tord = "N";
my $tosym;
my $hosym;
my $bisym;
my $dk;
my $tolerans;
my @retvector;
my @vx =($XV4[2],$XV5[2],$XV6[2],$XV4[1],$XV5[1],$XV6[1],$XV4[0],$XV5[0],$XV6[0]);
#my @vx_missing =( $V4_missing[2],$V5_missing[2],$V6_missing[2],
# $V4_missing[1],$V5_missing[1],$V6_missing[1],
# $V4_missing[0],$V5_missing[0],$V6_missing[0]);
# the following convention for the hours is used::
# $VX[0] is 0600 today, $VX[1] is 1800 yesterday,$VX[2] is 1200 yesterday, $VX[3] is 0600 yesterday, where X={4,5,6}
# to make this comparison possible @SA is made such that:
# $SA[0] is 0600 today, $SA[1] and $SA[2] is not defined, $SA[3] is 0600 yesterday
$dk = "INGEN";
if ($XSA_missing[0]>0 || $XSA_missing[3]>0) {
$sst = undef;
}else{
if ($XSA[0] ne undef && $XSA[3] ne undef ) {
if ($XSA[3] < 0) {
$XSA[3] = 0;
}
if ($XSA[0] < 0) {
$XSA[0] = 0;
}
$sst = $XSA[0] - $XSA[3];
# $XSA[3] = $XSA[0];
}else{
$sst = undef;
}
}
for(my $i=0; $i<=8; $i++) {
# if( $vx[$i] ne undef && $vx_missing[$i] == 0 ){
if ($vx[$i]==3 || $vx[$i]==7 || $vx[$i]==8) {
$regn = "J";
}
if ($vx[$i]==2 || $vx[$i]==5 || $vx[$i]==6) {
$sne = "J";
}
if ($vx[$i]==1 || $vx[$i]==4) {
$sludd = "J";
}
if ($vx[$i]==17 || $vx[$i]==12 || $vx[$i]==31) {
$duri = "J";
}
if ($vx[$i]==10) {
$hagl = "J";
}
}
$tosym = $regn . $sludd . $sne . $duri . $hagl;
if ($tosym eq "NNNNN") {
$dk = "INGEN";
}
else {
$hosym = $regn . $sludd . $sne;
$dk = "MIKS";
if ($hosym eq "JNN") {
$dk = "REGN";
}
if ($hosym eq "NNJ") {
$dk = "SNE";
}
if ($hosym eq "NNN") {
$bisym = $duri . $hagl;
if ($bisym eq "JN") {
$dk = "DURI";
}
if ($bisym eq "NN") {
$dk = "INGEN";
}
}
if ($dk eq "MIKS") {
if ($sst > 0) {
$dk = "SNE";
} else {
$dk = "REGN";
}
}
}
my $flag = 1;
my $RRfla3 = 1;
my $RRfla4 = 1;
# Check no. 72.6 Snow depth increasing without weather symbol -------
if ($dk ne "SNE" && $sst > 0) {
$flag = 4;
if ($XV4_missing[0]==0) {
if ($XV4[0]!=2 && $XV4[0]!=5 && $XV4[0]!=6 && $XV4_missing[0]==0) {
push(@retvector, "V4_0_0_flag", "4");
} else {
push(@retvector, "V4_0_0_flag", "1");
}
}
if ($XV4_missing[1]==0) {
if ($XV4[1]!=2 && $XV4[1]!=5 && $XV4[1]!=6 && $XV4_missing[1]==0) {
push(@retvector, "V4_1_0_flag", "4");
} else {
push(@retvector, "V4_1_0_flag", "1");
}
}
if ($XV4_missing[2]==0) {
if ($XV4[2]!=2 && $XV4[2]!=5 && $XV4[2]!=6 && $XV4_missing[2]==0) {
push(@retvector, "V4_2_0_flag", "4");
} else {
push(@retvector, "V4_2_0_flag", "1");
}
}
if ($XV5_missing[0]==0) {
if ($XV5[0]!=2 && $XV5[0]!=5 && $XV5[0]!=6 && $XV5_missing[0]==0) {
push(@retvector, "V5_0_0_flag", "4");
} else {
push(@retvector, "V5_0_0_flag", "1");
}
}
if ($XV5_missing[1]==0) {
if ($XV5[1]!=2 && $XV5[1]!=5 && $XV5[1]!=6 && $XV5_missing[1]==0) {
push(@retvector, "V5_1_0_flag", "4");
} else {
push(@retvector, "V5_1_0_flag", "1");
}
}
if ($XV5_missing[2]==0) {
if ($XV5[2]!=2 && $XV5[2]!=5 && $XV5[2]!=6 && $XV5_missing[2]==0) {
push(@retvector, "V5_2_0_flag", "4");
} else {
push(@retvector, "V5_2_0_flag", "1");
}
}
if ($XV6_missing[0]==0) {
if ($XV6[0]!=2 && $XV6[0]!=5 && $XV6[0]!=6 && $XV6_missing[0]==0) {
push(@retvector, "V6_0_0_flag", "4");
} else {
push(@retvector, "V6_0_0_flag", "1");
}
}
if ($XV6_missing[1]==0) {
if ($XV6[1]!=2 && $XV6[1]!=5 && $XV6[1]!=6 && $XV6_missing[1]==0) {
push(@retvector, "V6_1_0_flag", "4");
} else {
push(@retvector, "V6_1_0_flag", "1");
}
}
if ($XV6_missing[2]==0) {
if ($XV6[2]!=2 && $XV6[2]!=5 && $XV6[2]!=6 && $XV6_missing[2]==0) {
push(@retvector, "V6_2_0_flag", "4");
} else {
push(@retvector, "V6_2_0_flag", "1");
}
}
}
#---------------------------------------------------------------------------------
# if ($RR_missing[0]==0) {
# if ($RRfla3 == 3 && $RRfla4 != 4) {
# push(@retvector, "RR_0_0_flag", $RRfla3);
# } elsif ($RRfla4 == 4) {
# push(@retvector, "RR_0_0_flag", $RRfla4);
# } elsif ($RRfla3 == 1 && $RRfla4 == 1) {
# push(@retvector, "RR_0_0_flag", "1");
# }
# }
#---------------------------------------------------------------------------------
if ($XSA_missing[0]==0) {
if ($flag == 4) {
push(@retvector, "SA_0_0_flag", "4");
} elsif ($flag == 1) {
push(@retvector, "SA_0_0_flag", "1");
}
}
#---------------------------------------------------------------------------------
# else {
# print "manglende defaulthåndtering";
# }
my $numout= @retvector; # antall returverdier
if ($numout == 0) {
# print "Alt er OK";
return 0;
}
return (@retvector, $numout);
}
RESULT:
-------------------------------------------------------------------------------
CHECK: QC1-2-72.c7 - geok07_card_snowdepth_increase_toomuch
Abstract signature: obs;RR,SA,V4,V5,V6;;
Concrete signature: obs;RR_24&&&402,SA&&&402,V4&&&402,V5&&&402,V6&&&402;;0,-1501
SCRIPT:
use strict;
# general
my @obstime = (2010, 7, 16, 6, 0, 0);
# obs
my $obs_missing = 5;
my $obs_numtimes = 1;
my @RR = (-32767);
my @RR_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @RR_missing = (3);
my @SA = (-32767);
my @SA_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @SA_missing = (3);
my @V4 = (-32767);
my @V4_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V4_missing = (3);
my @V5 = (-32767);
my @V5_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V5_missing = (3);
my @V6 = (-32767);
my @V6_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V6_missing = (3);
my @obs_timeoffset = (0);
# Kvalobs_Metadata - Free Quality Control Algorithms for Meteorological Observations
#
# $Id: geok07_card_snowdepth_increase_toomuch.pl,v 1.6 2007/10/22 16:21:09 paule Exp $
#
# Copyright (C) 2007 met.no
#
# Contact information:
# Norwegian Meteorological Institute
# Box 43 Blindern
# 0313 OSLO
# NORWAY
# email: kvalobs-dev@met.no
#
# This file is part of KVALOBS_METADATA
#
# KVALOBS_METADATA 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.
#
# KVALOBS_METADATA 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 KVALOBS_METADATA; if not, write to the Free Software Foundation Inc.,
# 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
#language : 1
#checkname: geok07_card_snowdepth_increase_toomuch
#signature: obs;RR,SA,V4,V5,V6;;
# Konsistenskontroll check Appendix 5
# Kode hentet fra "snowdepth_precip_weather.pl", subcheck 7 (geok)
# Original laget av Per Ove Kjensli i fortran.
# Siva konverterte koden til perl.
# Rettet på av Øystein Lie 14/12-2004
# Ny versjon Terje Reite og Bjørn Nordin 17.6.2005
# Ny versjon Bjørn Nordin 02.12.2005
# Ny versjon Bjørn Nordin 02.01.2006 - Geok splittet opp.
sub check {
my @index_list;
my @index_list2;
my @XRR;
my @XSA;
my @XV4;
my @XV5;
my @XV6;
# my @XX_1;
my @XSA_missing;
my @XV4_missing;
my @XV5_missing;
my @XV6_missing;
my @retvector;
# Tester om controlinfo(4)=6: Skal ikke teste, avbryter.
if ($RR_controlinfo[4] == 6) {
return 0;
}
# Tester om SA mangler: Skal ikke teste, avbryter.
for(my $i=0; $i< $obs_numtimes; $i++) {
if ($SA_missing[$i] > 0 && ($obs_timeoffset[$i] == 0 || $obs_timeoffset[$i] == -1440)) {
return 0;
}
}
# Hvis alle parametre mangler: Avbryt, Returverdi-flag=0.
my $b=1;
for(my $i=0; $i< $obs_numtimes; $i++) {
if( $RR_missing[$i] > 0 &&
$SA_missing[$i] > 0 &&
$V4_missing[$i] > 0 &&
$V5_missing[$i] > 0 &&
$V6_missing[$i] > 0 ){
;
}else{
$b=0;
last;
}
}
if( $b == 1 ){
return 0;
}
# Initierer parameter-arrayene:
for(my $i=0; $i<=3; $i++) {
$XRR[$i] = -32767;
$XSA[$i] = -32767;
$XV4[$i] = -32767;
$XV5[$i] = -32767;
$XV6[$i] = -32767;
$XSA_missing[$i] = -32767;
$XV4_missing[$i] = -32767;
$XV5_missing[$i] = -32767;
$XV6_missing[$i] = -32767;
}
# Lager indeks-tabell.
my $N = $obs_numtimes;
for(my $i=0; $i<$N; $i++) {
if($obs_timeoffset[$i]==0) {
push(@index_list,0);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-780) {
push(@index_list,1);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1140) {
push(@index_list,2);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1440) {
push(@index_list,3);
push(@index_list2,$i);
}
}
$N = @index_list;
# Sorterer parametrene på rett plass i tid i parameterarrayene.
for(my $i=0; $i<$N; $i++) {
$XRR[$index_list[$i]] = $RR[$index_list2[$i]];
$XSA[$index_list[$i]] = $SA[$index_list2[$i]];
$XV4[$index_list[$i]] = $V4[$index_list2[$i]];
$XV5[$index_list[$i]] = $V5[$index_list2[$i]];
$XV6[$index_list[$i]] = $V6[$index_list2[$i]];
$XSA_missing[$index_list[$i]] = $SA_missing[$index_list2[$i]];
$XV4_missing[$index_list[$i]] = $V4_missing[$index_list2[$i]];
$XV5_missing[$index_list[$i]] = $V5_missing[$index_list2[$i]];
$XV6_missing[$index_list[$i]] = $V6_missing[$index_list2[$i]];
}
my $sst;
my $regn = "N"; my $sne = "N"; my $sludd = "N";
my $duri = "N"; my $hagl = "N"; my $tord = "N";
my $tosym;
my $hosym;
my $bisym;
my $dk;
my $tolerans;
my @retvector;
my @vx =($XV4[2],$XV5[2],$XV6[2],$XV4[1],$XV5[1],$XV6[1],$XV4[0],$XV5[0],$XV6[0]);
#my @vx_missing =( $V4_missing[2],$V5_missing[2],$V6_missing[2],
# $V4_missing[1],$V5_missing[1],$V6_missing[1],
# $V4_missing[0],$V5_missing[0],$V6_missing[0]);
# the following convention for the hours is used::
# $VX[0] is 0600 today, $VX[1] is 1800 yesterday,$VX[2] is 1200 yesterday, $VX[3] is 0600 yesterday, where X={4,5,6}
# to make this comparison possible @SA is made such that:
# $SA[0] is 0600 today, $SA[1] and $SA[2] is not defined, $SA[3] is 0600 yesterday
$dk = "INGEN";
if ($XSA_missing[0]>0 || $XSA_missing[3]>0) {
$sst = undef;
}else{
if ($XSA[0] ne undef && $XSA[3] ne undef ) {
if ($XSA[3] < 0) {
$XSA[3] = 0;
}
if ($XSA[0] < 0) {
$XSA[0] = 0;
}
$sst = $XSA[0] - $XSA[3];
# $XSA[3] = $XSA[0];
}else{
$sst = undef;
}
}
for(my $i=0; $i<=8; $i++) {
# if( $vx[$i] ne undef && $vx_missing[$i] == 0 ){
if ($vx[$i]==3 || $vx[$i]==7 || $vx[$i]==8) {
$regn = "J";
}
if ($vx[$i]==2 || $vx[$i]==5 || $vx[$i]==6) {
$sne = "J";
}
if ($vx[$i]==1 || $vx[$i]==4) {
$sludd = "J";
}
if ($vx[$i]==17 || $vx[$i]==12 || $vx[$i]==31) {
$duri = "J";
}
if ($vx[$i]==10) {
$hagl = "J";
}
}
$tosym = $regn . $sludd . $sne . $duri . $hagl;
if ($tosym eq "NNNNN") {
$dk = "INGEN";
}
else {
$hosym = $regn . $sludd . $sne;
$dk = "MIKS";
if ($hosym eq "JNN") {
$dk = "REGN";
}
if ($hosym eq "NNJ") {
$dk = "SNE";
}
if ($hosym eq "NNN") {
$bisym = $duri . $hagl;
if ($bisym eq "JN") {
$dk = "DURI";
}
if ($bisym eq "NN") {
$dk = "INGEN";
}
}
if ($dk eq "MIKS") {
if ($sst > 0) {
$dk = "SNE";
} else {
$dk = "REGN";
}
}
}
my $flag = 1;
my $RRfla3 = 1;
my $RRfla4 = 1;
# Check no. 72.7 Snow depth increasing too much ---------------------
if ($XRR[0]>0 && ($sst*$sst)>($XRR[0]*100 + 25) && $sst>4 && $dk eq "SNE") {
$flag = 4;
if ($XV4_missing[0]==0) {
if ($XV4[0]==2 || $XV4[0]==5 || $XV4[0]==6) {
push(@retvector, "V4_0_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V4_0_0_flag", "1");
}
}
if ($XV4_missing[1]==0) {
if ($XV4[1]==2 || $XV4[1]==5 || $XV4[1]==6) {
push(@retvector, "V4_1_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V4_1_0_flag", "1");
}
}
if ($XV4_missing[2]==0) {
if ($XV4[2]==2 || $XV4[2]==5 || $XV4[2]==6) {
push(@retvector, "V4_2_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V4_2_0_flag", "1");
}
}
if ($XV5_missing[0]==0) {
if ($XV5[0]==2 || $XV5[0]==5 || $XV5[0]==6) {
push(@retvector, "V5_0_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V5_0_0_flag", "1");
}
}
if ($XV5_missing[1]==0) {
if ($XV5[1]==2 || $XV5[1]==5 || $XV5[1]==6) {
push(@retvector, "V5_1_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V5_1_0_flag", "1");
}
}
if ($XV5_missing[2]==0) {
if ($XV5[2]==2 || $XV5[2]==5 || $XV5[2]==6) {
push(@retvector, "V5_2_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V5_2_0_flag", "1");
}
}
if ($XV6_missing[0]==0) {
if ($XV6[0]==2 || $XV6[0]==5 || $XV6[0]==6) {
push(@retvector, "V6_0_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V6_0_0_flag", "1");
}
}
if ($XV6_missing[1]==0) {
if ($XV6[1]==2 || $XV6[1]==5 || $XV6[1]==6) {
push(@retvector, "V6_1_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V6_1_0_flag", "1");
}
}
if ($XV6_missing[2]==0) {
if ($XV6[2]==2 || $XV6[2]==5 || $XV6[2]==6) {
push(@retvector, "V6_2_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V6_2_0_flag", "1");
}
}
}
#---------------------------------------------------------------------------------
if ($RR_missing[0]==0) {
if ($RRfla3 == 3 && $RRfla4 != 4) {
push(@retvector, "RR_0_0_flag", $RRfla3);
} elsif ($RRfla4 == 4) {
push(@retvector, "RR_0_0_flag", $RRfla4);
} elsif ($RRfla3 == 1 && $RRfla4 == 1) {
push(@retvector, "RR_0_0_flag", "1");
}
}
#---------------------------------------------------------------------------------
if ($XSA_missing[0]==0) {
if ($flag == 4) {
push(@retvector, "SA_0_0_flag", "4");
} elsif ($flag == 1) {
push(@retvector, "SA_0_0_flag", "1");
}
}
#---------------------------------------------------------------------------------
# else {
# print "manglende defaulthåndtering";
# }
my $numout= @retvector; # antall returverdier
if ($numout == 0) {
# print "Alt er OK";
return 0;
}
return (@retvector, $numout);
}
RESULT:
-------------------------------------------------------------------------------
CHECK: QC1-2-72.c8 - geok08_card_snowdepth_decrease_toomuch_snow
Abstract signature: obs;RR,SA,V4,V5,V6;;
Concrete signature: obs;RR_24&&&402,SA&&&402,V4&&&402,V5&&&402,V6&&&402;;0,-1501
SCRIPT:
use strict;
# general
my @obstime = (2010, 7, 16, 6, 0, 0);
# obs
my $obs_missing = 5;
my $obs_numtimes = 1;
my @RR = (-32767);
my @RR_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @RR_missing = (3);
my @SA = (-32767);
my @SA_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @SA_missing = (3);
my @V4 = (-32767);
my @V4_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V4_missing = (3);
my @V5 = (-32767);
my @V5_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V5_missing = (3);
my @V6 = (-32767);
my @V6_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V6_missing = (3);
my @obs_timeoffset = (0);
# Kvalobs_Metadata - Free Quality Control Algorithms for Meteorological Observations
#
# $Id: geok08_card_snowdepth_decrease_toomuch_snow.pl,v 1.7 2007/10/22 16:21:09 paule Exp $
#
# Copyright (C) 2007 met.no
#
# Contact information:
# Norwegian Meteorological Institute
# Box 43 Blindern
# 0313 OSLO
# NORWAY
# email: kvalobs-dev@met.no
#
# This file is part of KVALOBS_METADATA
#
# KVALOBS_METADATA 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.
#
# KVALOBS_METADATA 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 KVALOBS_METADATA; if not, write to the Free Software Foundation Inc.,
# 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
#language : 1
#checkname: geok08_card_snowdepth_decrease_toomuch_snow
#signature: obs;RR,SA,V4,V5,V6;;
# Konsistenskontroll check Appendix 5
# Kode hentet fra "snowdepth_precip_weather.pl", subcheck 8 (geok)
# Original laget av Per Ove Kjensli i fortran.
# Siva konverterte koden til perl.
# Rettet på av Øystein Lie 14/12-2004
# Ny versjon Terje Reite og Bjørn Nordin 17.6.2005
# Ny versjon Bjørn Nordin 02.12.2005
# Ny versjon Bjørn Nordin 02.01.2006 - Geok splittet opp.
sub check {
my @index_list;
my @index_list2;
my @XRR;
my @XSA;
my @XV4;
my @XV5;
my @XV6;
# my @XX_1;
my @XSA_missing;
my @XV4_missing;
my @XV5_missing;
my @XV6_missing;
my @retvector;
# Tester om controlinfo(4)=6: Skal ikke teste, avbryter.
if ($RR_controlinfo[4] == 6) {
return 0;
}
# Tester om SA mangler: Skal ikke teste, avbryter.
for(my $i=0; $i< $obs_numtimes; $i++) {
if ($SA_missing[$i] > 0 && ($obs_timeoffset[$i] == 0 || $obs_timeoffset[$i] == -1440)) {
return 0;
}
}
# Hvis alle parametre mangler: Avbryt, Returverdi-flag=0.
my $b=1;
for(my $i=0; $i< $obs_numtimes; $i++) {
if( $RR_missing[$i] > 0 &&
$SA_missing[$i] > 0 &&
$V4_missing[$i] > 0 &&
$V5_missing[$i] > 0 &&
$V6_missing[$i] > 0 ){
;
}else{
$b=0;
last;
}
}
if( $b == 1 ){
return 0;
}
# Initierer parameter-arrayene:
for(my $i=0; $i<=3; $i++) {
$XRR[$i] = -32767;
$XSA[$i] = -32767;
$XV4[$i] = -32767;
$XV5[$i] = -32767;
$XV6[$i] = -32767;
$XSA_missing[$i] = -32767;
$XV4_missing[$i] = -32767;
$XV5_missing[$i] = -32767;
$XV6_missing[$i] = -32767;
}
# Lager indeks-tabell.
my $N = $obs_numtimes;
for(my $i=0; $i<$N; $i++) {
if($obs_timeoffset[$i]==0) {
push(@index_list,0);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-780) {
push(@index_list,1);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1140) {
push(@index_list,2);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1440) {
push(@index_list,3);
push(@index_list2,$i);
}
}
$N = @index_list;
# Sorterer parametrene på rett plass i tid i parameterarrayene.
for(my $i=0; $i<$N; $i++) {
$XRR[$index_list[$i]] = $RR[$index_list2[$i]];
$XSA[$index_list[$i]] = $SA[$index_list2[$i]];
$XV4[$index_list[$i]] = $V4[$index_list2[$i]];
$XV5[$index_list[$i]] = $V5[$index_list2[$i]];
$XV6[$index_list[$i]] = $V6[$index_list2[$i]];
$XSA_missing[$index_list[$i]] = $SA_missing[$index_list2[$i]];
$XV4_missing[$index_list[$i]] = $V4_missing[$index_list2[$i]];
$XV5_missing[$index_list[$i]] = $V5_missing[$index_list2[$i]];
$XV6_missing[$index_list[$i]] = $V6_missing[$index_list2[$i]];
}
my $sst;
my $regn = "N"; my $sne = "N"; my $sludd = "N";
my $duri = "N"; my $hagl = "N"; my $tord = "N";
my $tosym;
my $hosym;
my $bisym;
my $dk;
my $tolerans;
my @retvector;
my @vx =($XV4[2],$XV5[2],$XV6[2],$XV4[1],$XV5[1],$XV6[1],$XV4[0],$XV5[0],$XV6[0]);
#my @vx_missing =( $V4_missing[2],$V5_missing[2],$V6_missing[2],
# $V4_missing[1],$V5_missing[1],$V6_missing[1],
# $V4_missing[0],$V5_missing[0],$V6_missing[0]);
# the following convention for the hours is used::
# $VX[0] is 0600 today, $VX[1] is 1800 yesterday,$VX[2] is 1200 yesterday, $VX[3] is 0600 yesterday, where X={4,5,6}
# to make this comparison possible @SA is made such that:
# $SA[0] is 0600 today, $SA[1] and $SA[2] is not defined, $SA[3] is 0600 yesterday
$dk = "INGEN";
if ($XSA_missing[0]>0 || $XSA_missing[3]>0) {
$sst = undef;
}else{
if ($XSA[0] ne undef && $XSA[3] ne undef ) {
if ($XSA[3] < 0) {
$XSA[3] = 0;
}
if ($XSA[0] < 0) {
$XSA[0] = 0;
}
$sst = $XSA[0] - $XSA[3];
# $XSA[3] = $XSA[0];
}else{
$sst = undef;
}
}
for(my $i=0; $i<=8; $i++) {
# if( $vx[$i] ne undef && $vx_missing[$i] == 0 ){
if ($vx[$i]==3 || $vx[$i]==7 || $vx[$i]==8) {
$regn = "J";
}
if ($vx[$i]==2 || $vx[$i]==5 || $vx[$i]==6) {
$sne = "J";
}
if ($vx[$i]==1 || $vx[$i]==4) {
$sludd = "J";
}
if ($vx[$i]==17 || $vx[$i]==12 || $vx[$i]==31) {
$duri = "J";
}
if ($vx[$i]==10) {
$hagl = "J";
}
}
$tosym = $regn . $sludd . $sne . $duri . $hagl;
if ($tosym eq "NNNNN") {
$dk = "INGEN";
}
else {
$hosym = $regn . $sludd . $sne;
$dk = "MIKS";
if ($hosym eq "JNN") {
$dk = "REGN";
}
if ($hosym eq "NNJ") {
$dk = "SNE";
}
if ($hosym eq "NNN") {
$bisym = $duri . $hagl;
if ($bisym eq "JN") {
$dk = "DURI";
}
if ($bisym eq "NN") {
$dk = "INGEN";
}
}
if ($dk eq "MIKS") {
if ($sst > 0) {
$dk = "SNE";
} else {
$dk = "REGN";
}
}
}
my $flag = 1;
my $RRfla3 = 1;
my $RRfla4 = 1;
# Check no. 72.8 Snow depth decreasing too much ---------------------
# if (($sst < -15 || $sst eq undef) && $XRR[0] > 1 && $dk eq "SNE") {
if ($sst < -15 && $XRR[0] > 1 && $dk eq "SNE") {
$flag = 4;
if ($XV4_missing[0]==0) {
if ($XV4[0]==2 || $XV4[0]==5 || $XV4[0]==6) {
push(@retvector, "V4_0_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V4_0_0_flag", "1");
}
}
if ($XV4_missing[1]==0) {
if ($XV4[1]==2 || $XV4[1]==5 || $XV4[1]==6) {
push(@retvector, "V4_1_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V4_1_0_flag", "1");
}
}
if ($XV4_missing[2]==0) {
if ($XV4[2]==2 || $XV4[2]==5 || $XV4[2]==6) {
push(@retvector, "V4_2_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V4_2_0_flag", "1");
}
}
if ($XV5_missing[0]==0) {
if ($XV5[0]==2 || $XV5[0]==5 || $XV5[0]==6) {
push(@retvector, "V5_0_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V5_0_0_flag", "1");
}
}
if ($XV5_missing[1]==0) {
if ($XV5[1]==2 || $XV5[1]==5 || $XV5[1]==6) {
push(@retvector, "V5_1_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V5_1_0_flag", "1");
}
}
if ($XV5_missing[2]==0) {
if ($XV5[2]==2 || $XV5[2]==5 || $XV5[2]==6) {
push(@retvector, "V5_2_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V5_2_0_flag", "1");
}
}
if ($XV6_missing[0]==0) {
if ($XV6[0]==2 || $XV6[0]==5 || $XV6[0]==6) {
push(@retvector, "V6_0_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V6_0_0_flag", "1");
}
}
if ($XV6_missing[1]==0) {
if ($XV6[1]==2 || $XV6[1]==5 || $XV6[1]==6) {
push(@retvector, "V6_1_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V6_1_0_flag", "1");
}
}
if ($XV6_missing[2]==0) {
if ($XV6[2]==2 || $XV6[2]==5 || $XV6[2]==6) {
push(@retvector, "V6_2_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V6_2_0_flag", "1");
}
}
}
#---------------------------------------------------------------------------------
if ($RR_missing[0]==0) {
if ($RRfla3 == 3 && $RRfla4 != 4) {
push(@retvector, "RR_0_0_flag", $RRfla3);
} elsif ($RRfla4 == 4) {
push(@retvector, "RR_0_0_flag", $RRfla4);
} elsif ($RRfla3 == 1 && $RRfla4 == 1) {
push(@retvector, "RR_0_0_flag", "1");
}
}
#---------------------------------------------------------------------------------
if ($XSA_missing[0]==0) {
if ($flag == 4) {
push(@retvector, "SA_0_0_flag", "4");
} elsif ($flag == 1) {
push(@retvector, "SA_0_0_flag", "1");
}
}
#---------------------------------------------------------------------------------
# else {
# print "manglende defaulthåndtering";
# }
my $numout= @retvector; # antall returverdier
if ($numout == 0) {
# print "Alt er OK";
return 0;
}
return (@retvector, $numout);
}
RESULT:
-------------------------------------------------------------------------------
CHECK: QC1-2-72.c9 - geok09_card_snowdepth_decrease_toomuch_rain
Abstract signature: obs;RR,SA,V4,V5,V6;;
Concrete signature: obs;RR_24&&&402,SA&&&402,V4&&&402,V5&&&402,V6&&&402;;0,-1501
SCRIPT:
use strict;
# general
my @obstime = (2010, 7, 16, 6, 0, 0);
# obs
my $obs_missing = 5;
my $obs_numtimes = 1;
my @RR = (-32767);
my @RR_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @RR_missing = (3);
my @SA = (-32767);
my @SA_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @SA_missing = (3);
my @V4 = (-32767);
my @V4_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V4_missing = (3);
my @V5 = (-32767);
my @V5_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V5_missing = (3);
my @V6 = (-32767);
my @V6_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @V6_missing = (3);
my @obs_timeoffset = (0);
# Kvalobs_Metadata - Free Quality Control Algorithms for Meteorological Observations
#
# $Id: geok09_card_snowdepth_decrease_toomuch_rain.pl,v 1.6 2007/10/22 16:21:09 paule Exp $
#
# Copyright (C) 2007 met.no
#
# Contact information:
# Norwegian Meteorological Institute
# Box 43 Blindern
# 0313 OSLO
# NORWAY
# email: kvalobs-dev@met.no
#
# This file is part of KVALOBS_METADATA
#
# KVALOBS_METADATA 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.
#
# KVALOBS_METADATA 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 KVALOBS_METADATA; if not, write to the Free Software Foundation Inc.,
# 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
#language : 1
#checkname: geok09_card_snowdepth_decrease_toomuch_rain
#signature: obs;RR,SA,V4,V5,V6;;
# Konsistenskontroll check Appendix 5
# Kode hentet fra "snowdepth_precip_weather.pl", subcheck 9 (geok)
# Original laget av Per Ove Kjensli i fortran.
# Siva konverterte koden til perl.
# Rettet på av Øystein Lie 14/12-2004
# Ny versjon Terje Reite og Bjørn Nordin 17.6.2005
# Ny versjon Bjørn Nordin 02.12.2005
# Ny versjon Bjørn Nordin 02.01.2006 - Geok splittet opp.
sub check {
my @index_list;
my @index_list2;
my @XRR;
my @XSA;
my @XV4;
my @XV5;
my @XV6;
# my @XX_1;
my @XSA_missing;
my @XV4_missing;
my @XV5_missing;
my @XV6_missing;
my @retvector;
# Tester om controlinfo(4)=6: Skal ikke teste, avbryter.
if ($RR_controlinfo[4] == 6) {
return 0;
}
# Tester om SA mangler: Skal ikke teste, avbryter.
for(my $i=0; $i< $obs_numtimes; $i++) {
if ($SA_missing[$i] > 0 && ($obs_timeoffset[$i] == 0 || $obs_timeoffset[$i] == -1440)) {
return 0;
}
}
# Hvis alle parametre mangler: Avbryt, Returverdi-flag=0.
my $b=1;
for(my $i=0; $i< $obs_numtimes; $i++) {
if( $RR_missing[$i] > 0 &&
$SA_missing[$i] > 0 &&
$V4_missing[$i] > 0 &&
$V5_missing[$i] > 0 &&
$V6_missing[$i] > 0 ){
;
}else{
$b=0;
last;
}
}
if( $b == 1 ){
return 0;
}
# Initierer parameter-arrayene:
for(my $i=0; $i<=3; $i++) {
$XRR[$i] = -32767;
$XSA[$i] = -32767;
$XV4[$i] = -32767;
$XV5[$i] = -32767;
$XV6[$i] = -32767;
$XSA_missing[$i] = -32767;
$XV4_missing[$i] = -32767;
$XV5_missing[$i] = -32767;
$XV6_missing[$i] = -32767;
}
# Lager indeks-tabell.
my $N = $obs_numtimes;
for(my $i=0; $i<$N; $i++) {
if($obs_timeoffset[$i]==0) {
push(@index_list,0);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-780) {
push(@index_list,1);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1140) {
push(@index_list,2);
push(@index_list2,$i);
}
if($obs_timeoffset[$i]==-1440) {
push(@index_list,3);
push(@index_list2,$i);
}
}
$N = @index_list;
# Sorterer parametrene på rett plass i tid i parameterarrayene.
for(my $i=0; $i<$N; $i++) {
$XRR[$index_list[$i]] = $RR[$index_list2[$i]];
$XSA[$index_list[$i]] = $SA[$index_list2[$i]];
$XV4[$index_list[$i]] = $V4[$index_list2[$i]];
$XV5[$index_list[$i]] = $V5[$index_list2[$i]];
$XV6[$index_list[$i]] = $V6[$index_list2[$i]];
$XSA_missing[$index_list[$i]] = $SA_missing[$index_list2[$i]];
$XV4_missing[$index_list[$i]] = $V4_missing[$index_list2[$i]];
$XV5_missing[$index_list[$i]] = $V5_missing[$index_list2[$i]];
$XV6_missing[$index_list[$i]] = $V6_missing[$index_list2[$i]];
}
my $sst;
my $regn = "N"; my $sne = "N"; my $sludd = "N";
my $duri = "N"; my $hagl = "N"; my $tord = "N";
my $tosym;
my $hosym;
my $bisym;
my $dk;
my $tolerans;
my @retvector;
my @vx =($XV4[2],$XV5[2],$XV6[2],$XV4[1],$XV5[1],$XV6[1],$XV4[0],$XV5[0],$XV6[0]);
#my @vx_missing =( $V4_missing[2],$V5_missing[2],$V6_missing[2],
# $V4_missing[1],$V5_missing[1],$V6_missing[1],
# $V4_missing[0],$V5_missing[0],$V6_missing[0]);
# the following convention for the hours is used::
# $VX[0] is 0600 today, $VX[1] is 1800 yesterday,$VX[2] is 1200 yesterday, $VX[3] is 0600 yesterday, where X={4,5,6}
# to make this comparison possible @SA is made such that:
# $SA[0] is 0600 today, $SA[1] and $SA[2] is not defined, $SA[3] is 0600 yesterday
$dk = "INGEN";
if ($XSA_missing[0]>0 || $XSA_missing[3]>0) {
$sst = undef;
}else{
if ($XSA[0] ne undef && $XSA[3] ne undef ) {
if ($XSA[3] < 0) {
$XSA[3] = 0;
}
if ($XSA[0] < 0) {
$XSA[0] = 0;
}
$sst = $XSA[0] - $XSA[3];
# $XSA[3] = $XSA[0];
}else{
$sst = undef;
}
}
for(my $i=0; $i<=8; $i++) {
# if( $vx[$i] ne undef && $vx_missing[$i] == 0 ){
if ($vx[$i]==3 || $vx[$i]==7 || $vx[$i]==8) {
$regn = "J";
}
if ($vx[$i]==2 || $vx[$i]==5 || $vx[$i]==6) {
$sne = "J";
}
if ($vx[$i]==1 || $vx[$i]==4) {
$sludd = "J";
}
if ($vx[$i]==17 || $vx[$i]==12 || $vx[$i]==31) {
$duri = "J";
}
if ($vx[$i]==10) {
$hagl = "J";
}
}
$tosym = $regn . $sludd . $sne . $duri . $hagl;
if ($tosym eq "NNNNN") {
$dk = "INGEN";
}
else {
$hosym = $regn . $sludd . $sne;
$dk = "MIKS";
if ($hosym eq "JNN") {
$dk = "REGN";
}
if ($hosym eq "NNJ") {
$dk = "SNE";
}
if ($hosym eq "NNN") {
$bisym = $duri . $hagl;
if ($bisym eq "JN") {
$dk = "DURI";
}
if ($bisym eq "NN") {
$dk = "INGEN";
}
}
if ($dk eq "MIKS") {
if ($sst > 0) {
$dk = "SNE";
} else {
$dk = "REGN";
}
}
}
my $flag = 1;
my $RRfla3 = 1;
my $RRfla4 = 1;
# Check no. 72.9 Snow depth decreasing too much ---------------------
if (($sst*$sst)>($XRR[0]*100 + 225) && $sst<0 && $XRR[0]>0 && $dk eq "REGN") {
$flag = 4;
if ($XV4_missing[0]==0) {
if ($XV4[0]==3 || $XV4[0]==7 || $XV4[0]==8) {
push(@retvector, "V4_0_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V4_0_0_flag", "1");
}
}
if ($XV4_missing[1]==0) {
if ($XV4[1]==3 || $XV4[1]==7 || $XV4[1]==8) {
push(@retvector, "V4_1_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V4_1_0_flag", "1");
}
}
if ($XV4_missing[2]==0) {
if ($XV4[2]==3 || $XV4[2]==7 || $XV4[2]==8) {
push(@retvector, "V4_2_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V4_2_0_flag", "1");
}
}
if ($XV5_missing[0]==0) {
if ($XV5[0]==3 || $XV5[0]==7 || $XV5[0]==8) {
push(@retvector, "V5_0_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V5_0_0_flag", "1");
}
}
if ($XV5_missing[1]==0) {
if ($XV5[1]==3 || $XV5[1]==7 || $XV5[1]==8) {
push(@retvector, "V5_1_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V5_1_0_flag", "1");
}
}
if ($XV5_missing[2]==0) {
if ($XV5[2]==3 || $XV5[2]==7 || $XV5[2]==8) {
push(@retvector, "V5_2_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V5_2_0_flag", "1");
}
}
if ($XV6_missing[0]==0) {
if ($XV6[0]==3 || $XV6[0]==7 || $XV6[0]==8) {
push(@retvector, "V6_0_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V6_0_0_flag", "1");
}
}
if ($XV6_missing[1]==0) {
if ($XV6[1]==3 || $XV6[1]==7 || $XV6[1]==8) {
push(@retvector, "V6_1_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V6_1_0_flag", "1");
}
}
if ($XV6_missing[2]==0) {
if ($XV6[2]==3 || $XV6[2]==7 || $XV6[2]==8) {
push(@retvector, "V6_2_0_flag", "4");
$RRfla4 = 4;
} else {
push(@retvector, "V6_2_0_flag", "1");
}
}
}
#---------------------------------------------------------------------------------
if ($RR_missing[0]==0) {
if ($RRfla3 == 3 && $RRfla4 != 4) {
push(@retvector, "RR_0_0_flag", $RRfla3);
} elsif ($RRfla4 == 4) {
push(@retvector, "RR_0_0_flag", $RRfla4);
} elsif ($RRfla3 == 1 && $RRfla4 == 1) {
push(@retvector, "RR_0_0_flag", "1");
}
}
#---------------------------------------------------------------------------------
if ($XSA_missing[0]==0) {
if ($flag == 4) {
push(@retvector, "SA_0_0_flag", "4");
} elsif ($flag == 1) {
push(@retvector, "SA_0_0_flag", "1");
}
}
#---------------------------------------------------------------------------------
# else {
# print "manglende defaulthåndtering";
# }
my $numout= @retvector; # antall returverdier
if ($numout == 0) {
# print "Alt er OK";
return 0;
}
return (@retvector, $numout);
}
RESULT:
-------------------------------------------------------------------------------
CHECK: QC1-7-110 - precipcollected_flag
Abstract signature: obs;RR;;|refobs;Rstart,Robs;;
Concrete signature: obs;RR_24&&&302;;0,-46080|refobs;KLSTART,KLOBS;;
SCRIPT:
use strict;
# general
my @obstime = (2010, 7, 16, 6, 0, 0);
# obs
my $obs_missing = 0;
my $obs_numtimes = 3;
my @RR = (10.5, 0.1, 1.4);
my @RR_controlinfo = (0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0);
my @RR_missing = (0, 0, 0);
my @obs_timeoffset = (0, -1440, -2880);
# refobs
my $refobs_missing = 2;
my $refobs_numtimes = 1;
my @Robs_missing = (3);
my @Rstart_missing = (3);
my @refobs_timeoffset = (0);
my @Robs = ("");
my @Rstart = ("");
# Kvalobs_Metadata - Free Quality Control Algorithms for Meteorological Observations
#
# $Id: precipcollected_flag.pl,v 1.7 2008/02/20 17:19:53 bjornn Exp $
#
# Copyright (C) 2007 met.no
#
# Contact information:
# Norwegian Meteorological Institute
# Box 43 Blindern
# 0313 OSLO
# NORWAY
# email: kvalobs-dev@met.no
#
# This file is part of KVALOBS_METADATA
#
# KVALOBS_METADATA 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.
#
# KVALOBS_METADATA 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 KVALOBS_METADATA; if not, write to the Free Software Foundation Inc.,
# 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
# checkname : precipcollected_flag
# signature : obs;RR;;|refobs;Rstart,Robs;;
#
# Detektering av oppsamlet verdi basert på observatørens anvisning.
# Gabriel Kielland 22. desember 2004
# signaturen korrigert 27. mai 2005
# Siste endring av Bjørn Nordin 2007 06 21.
# Benytter forsøksvis den rene perl-modulen Time::Local istedet for C-programmet Date::Calc 18. mai 2006
#
# Environmentid kan kanskje brukes til å skille ut ikke-daglige stasjoner.
# Bør kunne brukes i checks-filer eller station_param-filer?
sub check {
use Time::Local qw(timegm);
my $flag=0;
my $Dh;
my $Dm2;
my $Dh2;
my $IN;
my $IN2;
my @retvector;
# Hopper ut ved manglende eller forkastet nedbørmengde.
# 1 = Grenseverdikontroll, 4 = Numerisk Romkontroll, 13 = Forhandskvalifisering.
if ($RR_missing[0]>0 || $RR_controlinfo[13] == 6 || $RR_controlinfo[13] == 7) {
return 0;
}
# Hopper ut ved vanlig nedbørregistrering.
if ($Rstart_missing[0] > 0 && $Robs_missing[0] > 0) {
$flag = 1;
push(@retvector,"RR_0_0_flag");
push(@retvector,$flag);
my $numout = @retvector;
return(@retvector,$numout);
}
# Pakker ut klokkene.
my ($year0,$month0,$day0,$hour0) = $Rstart[0] =~ /^(\\d\\d\\d\\d)(\\d\\d)(\\d\\d)(\\d\\d)$/;
my ($year1,$month1,$day1,$hour1) = $Robs[0] =~ /^(\\d\\d\\d\\d)(\\d\\d)(\\d\\d)(\\d\\d)$/;
if ( $Rstart_missing[0] > 0 || $Robs_missing[0] > 0 ) {
$flag = 3;
push(@retvector,"RR_0_0_flag");
push(@retvector,$flag);
my $numout = @retvector;
return(@retvector,$numout);
} elsif ( not $year0 or not $year1 ) {
# Feil klokkesyntaks (ikke 10 sifre).
$flag = 3;
push(@retvector,"RR_0_0_flag");
push(@retvector,$flag);
my $numout = @retvector;
return(@retvector,$numout);
} else {
# Beregner oppsamlingsperioden i hele timer.
eval {
my $epoch_seconds0 = timegm(0,0,$hour0,$day0,$month0-1,$year0-1900);
my $epoch_seconds1 = timegm(0,0,$hour1,$day1,$month1-1,$year1-1900);
$Dh = sprintf("%.0f",($epoch_seconds1-$epoch_seconds0)/3600);
# Setter flagg.
if ( $Dh <= 19 ) {
# Mindre enn 1 Døgn med Feil angitt Fra - Til Tidspunkt.
$flag = 3;
} elsif ( $Dh >= 20 && $Dh <= 35 ) {
# 1 Døgn med Ukurant Obstid, Ukurant Sending, Korreksjon.
$flag = 1;
} elsif ( $Dh >= 36 && $Dh < 768 ) {
$flag = 2; # 2-32 døgn med Oppsamling.
}
}; # end eval
$flag = 3 if $@; # eval failet, høyst trolig pga ugyldig dato
# (timegm vil da protestere)
# Ved flagverdi = 1 eller 3 : Pusher retvector og returnerer.
if ( $flag == 1 || $flag == 3 ) {
push(@retvector,"RR_0_0_flag");
push(@retvector,$flag);
my $numout = @retvector;
return(@retvector,$numout);
}
# Tildeler $NT antall RR-verdier som er funnet.
my $NT = @RR;
# Starter med den første forrige ($i=1).
for (my $i=1; $i < $NT; $i++) {
if ($RR_missing[$i]>0) {
# $IN er antall tilfeller med mangel-verdier/-flagg for RR.
$IN = $i;
}
last if ($RR_missing[$i] == 0);
}
# $Dh = Antall timer med oppsamling i følge Observatør.
# $IN2 = Antall dager med oppsamling i følge Observatør.
# $Dh2 = Antall timer med oppsamling i følge Databasen.
$IN2 = int($Dh/24);
$Dm2 = abs $obs_timeoffset[$IN+1];
$Dh2 = $Dm2/60;
# $ARMDobs = Oppsamlingsperiodens Slutt i følge Observatør.
# $Xobstime = Oppsamlingsperiodens Slutt i følge Databasen.
my $ARMDobs = int($Robs[0]/100);
my $Xobstime = ($obstime[0]*10000)+($obstime[1]*100)+($obstime[2]);
# Sjekker antall timer og obstidspunkter.
if($Dh >= ($Dh2-4) && $Dh <= ($Dh2+4) && $ARMDobs == $Xobstime) {
for (my $i=0; $i <= $IN; $i++) {
# Setter flagg for hele oppsamlingsperioden.
my $RR_tidIndex = "RR_$i" . "_0_flag";
$flag = 2; # 2-32 døgn med Oppsamling.
push(@retvector, $RR_tidIndex);
push(@retvector,$flag);
}
} else {
#-----------------------------------------------------------------------
# Inkonsistens: Oppsamlingsperiode Observatør vs. DB.
# Setter 3-flagg for hele mulige Oppsamlingsperiode.
# Begrenset av sammenhengende periode med mangler bakover.
for (my $i=0; $i <= $IN; $i++) {
my $RR_tidIndex = "RR_$i" . "_0_flag";
$flag = 3; # 2-32 døgn med unormal observasjon.
push(@retvector, $RR_tidIndex);
push(@retvector,$flag);
}
}
my $numout = @retvector;
return(@retvector,$numout);
}
}
RESULT:
RR_0_0_flag = 1
Modified data:
[sid: 100 otime: 2010-07-16 06:00:00 tid: 302 pid: 110 lvl: 0 sen: 0 orig: 10.5 cor: 10.5 cinfo: [0|1|1|0|0|0|0|0|0|0|0|0|1|0|0|0] uinfo: [7|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0]]
-------------------------------------------------------------------------------
CHECK: QC1-7-117 - precipcollected
Abstract signature: obs;R;;|refobs;Rstart,Robs;;
Concrete signature: obs;RR_X;;|refobs;KLSTART,KLOBS;;
SCRIPT:
use strict;
# general
my @obstime = (2010, 7, 16, 6, 0, 0);
# obs
my $obs_missing = 1;
my $obs_numtimes = 1;
my @R = (-32767);
my @R_controlinfo = (0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my @R_missing = (3);
my @obs_timeoffset = (0);
# refobs
my $refobs_missing = 2;
my $refobs_numtimes = 1;
my @Robs_missing = (3);
my @Rstart_missing = (3);
my @refobs_timeoffset = (0);
my @Robs = ("");
my @Rstart = ("");
# Kvalobs_Metadata - Free Quality Control Algorithms for Meteorological Observations
#
# $Id: precipcollected.pl,v 1.3 2007/10/22 16:21:12 paule Exp $
#
# Copyright (C) 2007 met.no
#
# Contact information:
# Norwegian Meteorological Institute
# Box 43 Blindern
# 0313 OSLO
# NORWAY
# email: kvalobs-dev@met.no
#
# This file is part of KVALOBS_METADATA
#
# KVALOBS_METADATA 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.
#
# KVALOBS_METADATA 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 KVALOBS_METADATA; if not, write to the Free Software Foundation Inc.,
# 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
# checkname : precipcollected
# signature : obs;R;;|refobs;Rstart,Robs;;
#
# Detektering av oppsamlet verdi basert på observatørens anvisning.
# Gabriel Kielland 22. desember 2004
# signaturen korrigert 27. mai 2005
# Benytter forsøksvis den rene perl-modulen Time::Local istedet for C-programmet Date::Calc 18. mai 2006
#
sub check {
use Time::Local qw(timegm);
my $flag;
# Tolererer ikke manglende nedbørmengde
if ($R_missing[0]>0) {
return;
}
# Pakk ut klokkene
my ($year0,$month0,$day0,$hour0) = $Rstart[0] =~ /^(\\d\\d\\d\\d)(\\d\\d)(\\d\\d)(\\d\\d)$/;
my ($year1,$month1,$day1,$hour1) = $Robs[0] =~ /^(\\d\\d\\d\\d)(\\d\\d)(\\d\\d)(\\d\\d)$/;
if ( $Rstart_missing[0] > 0 || $Robs_missing[0] > 0 ) {
$flag = 3;
} elsif ( not $year0 or not $year1 ) {
# Feil klokkesyntaks (ikke 10 siffre)
$flag = 3;
} else {
# Beregner oppsamlingsperioden i hele timer
eval {
my $epoch_seconds0 = timegm(0,0,$hour0,$day0,$month0-1,$year0-1900);
my $epoch_seconds1 = timegm(0,0,$hour1,$day1,$month1-1,$year1-1900);
my $Dh = sprintf("%.0f",($epoch_seconds1-$epoch_seconds0)/3600);
# Sett flagg
if ( $Dh == 24 || $Dh == 23 || $Dh == 25 ) {
$flag = 1;
} elsif ( $Dh >= 47 && $Dh < 74 ) {
$flag = 2;
} else {
$flag = 3;
}
}; # end eval
$flag = 3 if $@; # eval failet, høyst trolig pga ugyldig dato
# (timegm vil da protestere)
}
my @retvector;
push(@retvector,"R_0_0_flag");
push(@retvector,$flag);
my $numout = @retvector;
return(@retvector,$numout);
}
RESULT:
-------------------------------------------------------------------------------
Saving 3 elements to database:
[sid: 100 otime: 2010-07-16 06:00:00 tid: 302 pid: 18 lvl: 0 sen: 0 orig: -1 cor: -1 cinfo: [0|1|1|0|0|0|0|0|0|0|0|0|0|0|0|0] uinfo: [7|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0]]
[sid: 100 otime: 2010-07-16 06:00:00 tid: 302 pid: 110 lvl: 0 sen: 0 orig: 10.5 cor: 10.5 cinfo: [0|1|1|0|0|0|0|0|0|0|0|0|1|0|0|0] uinfo: [7|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0]]
[sid: 100 otime: 2010-07-16 06:00:00 tid: 302 pid: 112 lvl: 0 sen: 0 orig: -1 cor: -1 cinfo: [0|1|1|0|0|0|0|0|0|0|0|0|0|0|0|0] uinfo: [7|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0]]