libsim Versione 7.2.6
|
◆ qcsummaryflagi()
Check data validity based on multiple confidences. Compute final decision boolean flag Quality control is complete if one of 3 conditions is verified: a) invalidated data b) gross error check failed c) tot variable less -1 Controllo di validita' del dato basato su test multipli. Per il calcolo della validita' del dato (flag booleano B33007), si prendono in considerazione 3 test; il dato risulta invalidato (flag booleano posto a false) se e solo se uno dei test risulta soddisfatto: a) il dato e' stato invalidato a mano (flag0=B33196=0) b) il dato non ha passato il gross erro check (flag1=B33192=0) c) la variabile tot risulta minore a -1 La variabile tot e' il risultato del confronto tra controllo climatologico (flag1, B33192), controllo temporale (flag2, B33193) e controllo spaziale (flag3, B33194). Ad ognuno di tali controlli e' stato attribuito un punteggio a seconda che ciascuno dei valori relativi ai flag di qualita' risulti inferiore od uguale-maggiore di 10. Nel dettaglio: se B33192 < 10 tot=-1; se B33192>=10 tot=0 se B33193 < 10 tot=-1; se B33193>=10 tot=1 se B33194 < 10 tot=-1; se B33194>=10 tot=1 Ogni dato e' controllato nei 3 flag di qualita' presenti, e viene valutata la somma risultante di tot. Se tot risulta inferiore a -1, qcsummaryflag e' posto a false ed il dato e' invalitato (B33007=0). Se tot risulta maggiore od uguale a -1 qcsummaryflag e' true ed il dato e' valido. Definizione alla linea 931 del file modqc.F90. 932! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
933! authors:
934! Davide Cesari <dcesari@arpa.emr.it>
935! Paolo Patruno <ppatruno@arpa.emr.it>
936
937! This program is free software; you can redistribute it and/or
938! modify it under the terms of the GNU General Public License as
939! published by the Free Software Foundation; either version 2 of
940! the License, or (at your option) any later version.
941
942! This program is distributed in the hope that it will be useful,
943! but WITHOUT ANY WARRANTY; without even the implied warranty of
944! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
945! GNU General Public License for more details.
946
947! You should have received a copy of the GNU General Public License
948! along with this program. If not, see <http://www.gnu.org/licenses/>.
949#include "config.h"
950!> \defgroup qc Libsim package, qc library.
951!! Procedures for data quality control.
952!! At the moment only climatological quality control is implemented
953
954!> Utilities and defines for quality control.
955!!
956!! Concise, high-value definitions of Data Quality by expert users,
957!! analysts, implementers and journalists. This is a great starting point
958!! to learn about Data Quality.
959!!
960!! Data Quality: The Accuracy Dimension
961!!
962!! "Data quality is defined as follows: data has quality if it satisfies
963!! the requirements of its intended use. It lacks quality to the extent
964!! that it does not satisfy the requirement. In other words, data quality
965!! depends as much on the intended use as it does on the data itself. To
966!! satisfy the intended use, the data must be accurate, timely, relevant,
967!! complete, understood, and trusted." Jack E. Olson
968!!
969!! No Data Left Behind: Federal Student Aid - A Case History
970!!
971!! "Data quality institutionalizes a set of repeatable processes to
972!! continuously monitor data and improve data accuracy, completeness,
973!! timeliness and relevance." Holly Hyland and Lisa Elliott, Federal
974!! Student Aid
975!!
976!! Data Quality: It's a Family Affair
977!!
978!! Data Quality definition: "The state of completeness, consistency,
979!! timeliness and accuracy that makes data appropriate for a specific
980!! use." Wim Helmer, Dun & Bradstreet
981!!
982!! Data Quality and Quality Management - Examples of Quality Evaluation
983!! Procedures and Quality Management in European National Mapping
984!! Agencies
985!!
986!! "Quality is defined as the totality of characteristics of a product
987!! that bear on its ability to satisfy stated and implied needs (ISO
988!! 8402, 1994). In the new ISO/DIS 9000:2000 standard (2000) the
989!! definition of quality is: 'Ability of a set of inherent
990!! characteristics of a product, system or process to fulfill
991!! requirements of customers and other interested parties.' This
992!! indicates that data quality and quality management are very closely
993!! related. Data quality is part of the organisation's total quality
994!! management." Antti Jakobsson
995!!
996!! text below from Wikipedia
997!! http://it.wikipedia.org/wiki/Test_di_verifica_d%27ipotesi
998!! http://creativecommons.org/licenses/by-sa/3.0/deed.it
999!! L'ambito statistico
1000!!
1001!! Nel secondo caso la situazione è modificata in quanto interviene un
1002!! elemento nuovo, ovvero il caso. Si supponga di avere una moneta
1003!! recante due facce contrassegnate con testa e croce. Volendo verificare
1004!! l'ipotesi di bilanciamento della moneta si eseguono 20 lanci e si
1005!! contano quelli che danno esito testa. La conseguenza del bilanciamento
1006!! consiste nell'osservare un valore di teste attorno a 10. Tuttavia
1007!! anche in ipotesi di bilanciamento non si può escludere di osservare 20
1008!! teste. D'altronde, l'ipotesi di bilanciamento è logicamente
1009!! compatibile con un numero di teste variante da 0 a 20. In tale
1010!! contesto una qualsiasi decisione in merito all'ipotesi da verificare
1011!! comporta un rischio di errore. Ad esempio rigettare l'ipotesi di
1012!! bilanciamento della moneta avendo osservato 20 teste su 20 lanci
1013!! comporta il rischio di prendere una decisione errata. Nel procedere
1014!! alla verifica dell'ipotesi di bilanciamento della moneta, si ricorre a
1015!! una variabile casuale X. Tale variabile casuale X è una variabile
1016!! aleatoria discreta con distribuzione binomiale B(20; 0,5), dove 20
1017!! indica il numero di lanci e 0,5 la probabilità che si verifichi
1018!! l'evento "testa".
1019!!
1020!! Il risultato sperimentale si deve quindi confrontare con tale
1021!! distribuzione: quanto è distante tale risultato dal valore medio della
1022!! distribuzione B(20; 0,5)? Per rispondere alla domanda si deve
1023!! individuare un valore caratteristico della distribuzione B(20;
1024!! 0,5). Nel nostro caso tale valore caratteristico è il valore medio
1025!! 20/2 = 10. Per valutare la distanza tra il valore sperimentale e
1026!! quello atteso si valuta la probabilità di ottenere un valore
1027!! sperimentale lontano dal valore medio di B(20; 0,5), ossia nel caso
1028!! che dal nostro esperimento risulti X=15 (15 teste dopo 20 lanci), si
1029!! calcola P{|X-10|>=15-10} quindi P{X<=5 oppure X>=15}=0,041.
1030!!
1031!! Quindi, usando una moneta ben bilanciata, la probabilità di ottenere
1032!! un numero di teste X >= 15 (oppure X <= 5) dopo 20 lanci è pari a
1033!! 0,041 ossia al 4,1%. Giudicando bassa tale probabilità si rifiuterà
1034!! l'ipotesi di bilanciamento della moneta in esame, accettando quindi il
1035!! rischio del 4,1% di compiere un errore nel rifiutarla. Di solito, il
1036!! valore della probabilità adottato per rifiutare l'ipotesi nulla è <
1037!! 0,05. Tale valore è detto livello di significatività ed è definibile
1038!! come segue: il livello di significatività sotto l'ipotesi nulla è la
1039!! probabilità di cadere nella zona di rifiuto quando l'ipotesi nulla è
1040!! vera. Tale livello di significatività si indica convenzionalmente con
1041!! α. Il livello di significatività osservato α del test per il quale si
1042!! rifiuterebbe l'ipotesi nulla è detto valore-p (p-value). Riprendendo
1043!! l'esempio sopra riportato il valore-p è pari a 0,041. Adottando
1044!! nell'esempio α = 0,05, si rifiuterà l'ipotesi se
1045!! P{|X-10|>=x}<0,05. Tale condizione si raggiunge appunto se X<6 oppure
1046!! X>14. Tale insieme di valori si definisce convenzionalmente come
1047!! regione di rifiuto. Viceversa l'insieme { 6,7...14} si definisce regione
1048!! di accettazione. In questo modo si è costruita una regola di
1049!! comportamento per verificare l'ipotesi di bilanciamento della
1050!! moneta. Tale regola definisce il test statistico.
1051!!
1052!! In termini tecnici l'ipotesi da verificare si chiama ipotesi nulla e
1053!! si indica con H0, mentre l'ipotesi alternativa con H1. Nel caso della
1054!! moneta, se p è la probabilità di ottenere testa in un lancio la
1055!! verifica di ipotesi si traduce nel seguente sistema:
1056!!
1057!! H_0: p = \frac{1}{2}
1058!! H_1: p \ne \frac{1}{2}
1059!!
1060!! Come già osservato, il modo di condurre un test statistico comporta un
1061!! rischio di errore. Nella pratica statistica si individuano due tipi di
1062!! errori:
1063!!
1064!! 1. rifiutare H0 quando è vera, errore di primo tipo (α) (o errore di prima specie);
1065!! 2. accettare H0 quando è falsa, errore di secondo tipo (β) (o errore di seconda specie).
1066!!
1067!! Tornando all'esempio della moneta in cui la regione di accettazione è
1068!! data dall'insieme di valori {6..14}, la probabilità di rifiutare H0
1069!! quando è vera è stato calcolato pari a 0,041.Tale probabilità
1070!! rappresenta il rischio di incorrere in un errore di primo tipo e si
1071!! indica con α. Per valutare la probabilità di un errore di secondo tipo
1072!! è necessario specificare un valore di p in caso di verità di H1. Si
1073!! supponga che p=0,80, in tal caso la distribuzione di X è una
1074!! B(20;0,80)
1075!!
1076!! Con tale distribuzione di probabilità, l'errore di tipo 2 si calcola
1077!! sommando le probabilità relative ai valori di X della zona di
1078!! accettazione. Si trova quindi che la probabilità cercata è pari a
1079!! circa 0,20. Tale probabilità quantifica il rischio di incorrere
1080!! nell'errore di tipo 2. e si indica convenzionalmente con β. La
1081!! quantità 1-β si chiama potenza del test ed esprime quindi la capacità
1082!! di un test statistico riconoscere la falsità di H0 quando questa è
1083!! effettivamente falsa. La potenza del test trova applicazione nella
1084!! pratica statistica in fase di pianificazione di un esperimento.
1085!!
1086!!Scope of quality checks on observation values
1087!!Checks applied to determine the quality of an observation can range from the very simple to the
1088!!very complex. In roughly increasing order of complexity they can include:
1089!! * Syntactic checks (e.g. an air temperature must be a number to at most 1 decimal
1090!! place);
1091!! * Numeric ranges (e.g. the temperature must fall in the range -90 to +70);
1092!! * Climate range checks (i.e. is the datum consistent with climatology?)
1093!! * Intra-record consistency (e.g. the air temperature must not be less than the dew
1094!! point);
1095!! * Time-series consistency (e.g. the difference between two successive temperatures at
1096!! a site must be 'plausible'); and
1097!! * Spatial consistency (e.g. the station-dependent limits of plausible difference between
1098!! the temperatures at a station and its neighbours must not be violated).
1099!!\ingroup qc
1105
1106
1107implicit none
1108
1109
1110!> Definisce il livello di attendibilità per i dati validi
1112 integer (kind=int_b):: att !< confidence for "*B33192" "*B33193" "*B33194"
1113 integer (kind=int_b):: gross_error ! special valuer for "*B33192" when gross error check failed
1114 integer (kind=int_b):: invalidated ! special valuer for "*B33196" when manual invalidation happen
1116
1117!> Default: data with confidence less or equal 10 are rejected
1119
1120integer, parameter :: nqcattrvars=4
1121CHARACTER(len=10),parameter :: qcattrvarsbtables(nqcattrvars)=(/"*B33196","*B33192","*B33193","*B33194"/)
1122
1123type :: qcattrvars
1124 TYPE(vol7d_var) :: vars(nqcattrvars)
1125 CHARACTER(len=10) :: btables(nqcattrvars)
1126end type qcattrvars
1127
1128!> Variables user in Quality Control
1130 module procedure init_qcattrvars
1131end interface
1132
1133!> Remove data under a defined grade of confidence.
1135 module procedure peeledrb, peeleddb, peeledbb, peeledib, peeledcb &
1136 ,peeledri, peeleddi, peeledbi, peeledii, peeledci &
1137 ,peeledrr, peeleddr, peeledbr, peeledir, peeledcr &
1138 ,peeledrd, peeleddd, peeledbd, peeledid, peeledcd &
1139 ,peeledrc, peeleddc, peeledbc, peeledic, peeledcc
1140end interface
1141
1142
1143!> Check data validity based on single confidence
1145 module procedure vdi,vdb,vdr,vdd,vdc
1146end interface
1147
1148!> Check data validity based on gross error check
1150 module procedure vdgei,vdgeb,vdger,vdged,vdgec
1151end interface
1152
1153!> Test di dato invalidato
1155 module procedure invalidatedi,invalidatedb,invalidatedr,invalidatedd,invalidatedc
1156end interface
1157
1158private
1159
1161public qcattrvars, nqcattrvars, qcattrvarsbtables
1163
1164contains
1165
1166
1167! peeled routines
1168#undef VOL7D_POLY_SUBTYPE
1169#undef VOL7D_POLY_SUBTYPES
1170#undef VOL7D_POLY_ISC
1171#define VOL7D_POLY_SUBTYPE REAL
1172#define VOL7D_POLY_SUBTYPES r
1173
1174#undef VOL7D_POLY_TYPE
1175#undef VOL7D_POLY_TYPES
1176#undef VOL7D_POLY_ISC
1177#undef VOL7D_POLY_TYPES_SUBTYPES
1178#define VOL7D_POLY_TYPE REAL
1179#define VOL7D_POLY_TYPES r
1180#define VOL7D_POLY_TYPES_SUBTYPES rr
1181#include "modqc_peeled_include.F90"
1182#include "modqc_peel_util_include.F90"
1183#undef VOL7D_POLY_TYPE
1184#undef VOL7D_POLY_TYPES
1185#undef VOL7D_POLY_TYPES_SUBTYPES
1186#define VOL7D_POLY_TYPE DOUBLE PRECISION
1187#define VOL7D_POLY_TYPES d
1188#define VOL7D_POLY_TYPES_SUBTYPES dr
1189#include "modqc_peeled_include.F90"
1190#include "modqc_peel_util_include.F90"
1191#undef VOL7D_POLY_TYPE
1192#undef VOL7D_POLY_TYPES
1193#undef VOL7D_POLY_TYPES_SUBTYPES
1194#define VOL7D_POLY_TYPE INTEGER
1195#define VOL7D_POLY_TYPES i
1196#define VOL7D_POLY_TYPES_SUBTYPES ir
1197#include "modqc_peeled_include.F90"
1198#include "modqc_peel_util_include.F90"
1199#undef VOL7D_POLY_TYPE
1200#undef VOL7D_POLY_TYPES
1201#undef VOL7D_POLY_TYPES_SUBTYPES
1202#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1203#define VOL7D_POLY_TYPES b
1204#define VOL7D_POLY_TYPES_SUBTYPES br
1205#include "modqc_peeled_include.F90"
1206#include "modqc_peel_util_include.F90"
1207#undef VOL7D_POLY_TYPE
1208#undef VOL7D_POLY_TYPES
1209#undef VOL7D_POLY_TYPES_SUBTYPES
1210#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1211#define VOL7D_POLY_TYPES c
1212#define VOL7D_POLY_ISC = 1
1213#define VOL7D_POLY_TYPES_SUBTYPES cr
1214#include "modqc_peeled_include.F90"
1215#include "modqc_peel_util_include.F90"
1216
1217
1218#undef VOL7D_POLY_SUBTYPE
1219#undef VOL7D_POLY_SUBTYPES
1220#undef VOL7D_POLY_ISC
1221#define VOL7D_POLY_SUBTYPE DOUBLE PRECISION
1222#define VOL7D_POLY_SUBTYPES d
1223
1224#undef VOL7D_POLY_TYPE
1225#undef VOL7D_POLY_TYPES
1226#undef VOL7D_POLY_TYPES_SUBTYPES
1227#define VOL7D_POLY_TYPE REAL
1228#define VOL7D_POLY_TYPES r
1229#define VOL7D_POLY_TYPES_SUBTYPES rd
1230#include "modqc_peeled_include.F90"
1231#undef VOL7D_POLY_TYPE
1232#undef VOL7D_POLY_TYPES
1233#undef VOL7D_POLY_TYPES_SUBTYPES
1234#define VOL7D_POLY_TYPE DOUBLE PRECISION
1235#define VOL7D_POLY_TYPES d
1236#define VOL7D_POLY_TYPES_SUBTYPES dd
1237#include "modqc_peeled_include.F90"
1238#undef VOL7D_POLY_TYPE
1239#undef VOL7D_POLY_TYPES
1240#undef VOL7D_POLY_TYPES_SUBTYPES
1241#define VOL7D_POLY_TYPE INTEGER
1242#define VOL7D_POLY_TYPES i
1243#define VOL7D_POLY_TYPES_SUBTYPES id
1244#include "modqc_peeled_include.F90"
1245#undef VOL7D_POLY_TYPE
1246#undef VOL7D_POLY_TYPES
1247#undef VOL7D_POLY_TYPES_SUBTYPES
1248#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1249#define VOL7D_POLY_TYPES b
1250#define VOL7D_POLY_TYPES_SUBTYPES bd
1251#include "modqc_peeled_include.F90"
1252#undef VOL7D_POLY_TYPE
1253#undef VOL7D_POLY_TYPES
1254#undef VOL7D_POLY_TYPES_SUBTYPES
1255#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1256#define VOL7D_POLY_TYPES c
1257#define VOL7D_POLY_TYPES_SUBTYPES cd
1258#include "modqc_peeled_include.F90"
1259
1260
1261#undef VOL7D_POLY_SUBTYPE
1262#undef VOL7D_POLY_SUBTYPES
1263#undef VOL7D_POLY_ISC
1264#define VOL7D_POLY_SUBTYPE INTEGER
1265#define VOL7D_POLY_SUBTYPES i
1266
1267#undef VOL7D_POLY_TYPE
1268#undef VOL7D_POLY_TYPES
1269#undef VOL7D_POLY_TYPES_SUBTYPES
1270#define VOL7D_POLY_TYPE REAL
1271#define VOL7D_POLY_TYPES r
1272#define VOL7D_POLY_TYPES_SUBTYPES ri
1273#include "modqc_peeled_include.F90"
1274#undef VOL7D_POLY_TYPE
1275#undef VOL7D_POLY_TYPES
1276#undef VOL7D_POLY_TYPES_SUBTYPES
1277#define VOL7D_POLY_TYPE DOUBLE PRECISION
1278#define VOL7D_POLY_TYPES d
1279#define VOL7D_POLY_TYPES_SUBTYPES di
1280#include "modqc_peeled_include.F90"
1281#undef VOL7D_POLY_TYPE
1282#undef VOL7D_POLY_TYPES
1283#undef VOL7D_POLY_TYPES_SUBTYPES
1284#define VOL7D_POLY_TYPE INTEGER
1285#define VOL7D_POLY_TYPES i
1286#define VOL7D_POLY_TYPES_SUBTYPES ii
1287#include "modqc_peeled_include.F90"
1288#undef VOL7D_POLY_TYPE
1289#undef VOL7D_POLY_TYPES
1290#undef VOL7D_POLY_TYPES_SUBTYPES
1291#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1292#define VOL7D_POLY_TYPES b
1293#define VOL7D_POLY_TYPES_SUBTYPES bi
1294#include "modqc_peeled_include.F90"
1295#undef VOL7D_POLY_TYPE
1296#undef VOL7D_POLY_TYPES
1297#undef VOL7D_POLY_TYPES_SUBTYPES
1298#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1299#define VOL7D_POLY_TYPES c
1300#define VOL7D_POLY_ISC = 1
1301#define VOL7D_POLY_TYPES_SUBTYPES ci
1302#include "modqc_peeled_include.F90"
1303
1304
1305#undef VOL7D_POLY_SUBTYPE
1306#undef VOL7D_POLY_SUBTYPES
1307#undef VOL7D_POLY_ISC
1308#define VOL7D_POLY_SUBTYPE INTEGER(kind=int_b)
1309#define VOL7D_POLY_SUBTYPES b
1310
1311#undef VOL7D_POLY_TYPE
1312#undef VOL7D_POLY_TYPES
1313#undef VOL7D_POLY_TYPES_SUBTYPES
1314#define VOL7D_POLY_TYPE REAL
1315#define VOL7D_POLY_TYPES r
1316#define VOL7D_POLY_TYPES_SUBTYPES rb
1317#include "modqc_peeled_include.F90"
1318#undef VOL7D_POLY_TYPE
1319#undef VOL7D_POLY_TYPES
1320#undef VOL7D_POLY_TYPES_SUBTYPES
1321#define VOL7D_POLY_TYPE DOUBLE PRECISION
1322#define VOL7D_POLY_TYPES d
1323#define VOL7D_POLY_TYPES_SUBTYPES db
1324#include "modqc_peeled_include.F90"
1325#undef VOL7D_POLY_TYPE
1326#undef VOL7D_POLY_TYPES
1327#undef VOL7D_POLY_TYPES_SUBTYPES
1328#define VOL7D_POLY_TYPE INTEGER
1329#define VOL7D_POLY_TYPES i
1330#define VOL7D_POLY_TYPES_SUBTYPES ib
1331#include "modqc_peeled_include.F90"
1332#undef VOL7D_POLY_TYPE
1333#undef VOL7D_POLY_TYPES
1334#undef VOL7D_POLY_TYPES_SUBTYPES
1335#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1336#define VOL7D_POLY_TYPES b
1337#define VOL7D_POLY_TYPES_SUBTYPES bb
1338#include "modqc_peeled_include.F90"
1339#undef VOL7D_POLY_TYPE
1340#undef VOL7D_POLY_TYPES
1341#undef VOL7D_POLY_TYPES_SUBTYPES
1342#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1343#define VOL7D_POLY_TYPES c
1344#define VOL7D_POLY_ISC = 1
1345#define VOL7D_POLY_TYPES_SUBTYPES cb
1346#include "modqc_peeled_include.F90"
1347
1348
1349#undef VOL7D_POLY_SUBTYPE
1350#undef VOL7D_POLY_SUBTYPES
1351#undef VOL7D_POLY_ISC
1352#define VOL7D_POLY_SUBTYPE CHARACTER(len=vol7d_cdatalen)
1353#define VOL7D_POLY_SUBTYPES c
1354
1355#undef VOL7D_POLY_TYPE
1356#undef VOL7D_POLY_TYPES
1357#undef VOL7D_POLY_TYPES_SUBTYPES
1358#define VOL7D_POLY_TYPE REAL
1359#define VOL7D_POLY_TYPES r
1360#define VOL7D_POLY_TYPES_SUBTYPES rc
1361#include "modqc_peeled_include.F90"
1362#undef VOL7D_POLY_TYPE
1363#undef VOL7D_POLY_TYPES
1364#undef VOL7D_POLY_TYPES_SUBTYPES
1365#define VOL7D_POLY_TYPE DOUBLE PRECISION
1366#define VOL7D_POLY_TYPES d
1367#define VOL7D_POLY_TYPES_SUBTYPES dc
1368#include "modqc_peeled_include.F90"
1369#undef VOL7D_POLY_TYPE
1370#undef VOL7D_POLY_TYPES
1371#undef VOL7D_POLY_TYPES_SUBTYPES
1372#define VOL7D_POLY_TYPE INTEGER
1373#define VOL7D_POLY_TYPES i
1374#define VOL7D_POLY_TYPES_SUBTYPES ic
1375#include "modqc_peeled_include.F90"
1376#undef VOL7D_POLY_TYPE
1377#undef VOL7D_POLY_TYPES
1378#undef VOL7D_POLY_TYPES_SUBTYPES
1379#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1380#define VOL7D_POLY_TYPES b
1381#define VOL7D_POLY_TYPES_SUBTYPES bc
1382#include "modqc_peeled_include.F90"
1383#undef VOL7D_POLY_TYPE
1384#undef VOL7D_POLY_TYPES
1385#undef VOL7D_POLY_TYPES_SUBTYPES
1386#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1387#define VOL7D_POLY_TYPES c
1388#define VOL7D_POLY_ISC = 1
1389#define VOL7D_POLY_TYPES_SUBTYPES cc
1390#include "modqc_peeled_include.F90"
1391
1392
1393subroutine init_qcattrvars(this)
1394
1395type(qcattrvars),intent(inout) :: this
1396integer :: i
1397
1398this%btables(:) =qcattrvarsbtables
1399do i =1, nqcattrvars
1401end do
1402
1403end subroutine init_qcattrvars
1404
1405
1406type(qcattrvars) function qcattrvars_new()
1407
1409
1410end function qcattrvars_new
1411
1412
1413!> Remove data under the predefined grade of confidence.
1414!! If neither \a keep_attr nor \a delete_attr are passed, all the
1415!! attributes will be deleted after peeling; if \a keep_attr is
1416!! provided, only attributed listed in \a keep_attr will be kept in
1417!! output, (\a delete_attr will be ignored); if \a delete_attr is
1418!! provided, attributed listed in \a delete_attr will be deleted from
1419!! output.
1420SUBROUTINE vol7d_peeling(this, data_id, keep_attr, delete_attr, preserve, purgeana)
1421TYPE(vol7d),INTENT(INOUT) :: this !< object that has to be peeled
1422integer,INTENT(inout),pointer,OPTIONAL :: data_id(:,:,:,:,:) !< data ID to use with dballe DB (for fast write of attributes)
1423CHARACTER(len=*),INTENT(in),OPTIONAL :: keep_attr(:) !< Btable of attributes that should be kept after removing data
1424CHARACTER(len=*),INTENT(in),OPTIONAL :: delete_attr(:) !< Btable of attributes that should be deleted after removing data
1425logical,intent(in),optional :: preserve !< preserve all attributes if true (alternative to keep_attr and delete_attr)
1426logical,intent(in),optional :: purgeana !< if true remove ana with all data missing
1427
1428integer :: inddativar,inddatiattrinv,inddatiattrcli,inddatiattrtem,inddatiattrspa,inddativarattr
1429type(qcattrvars) :: attrvars
1430
1431INTEGER(kind=int_b),pointer :: invbb(:,:,:,:,:),clibb(:,:,:,:,:),tembb(:,:,:,:,:),spabb(:,:,:,:,:)
1432INTEGER,pointer :: invbi(:,:,:,:,:),clibi(:,:,:,:,:),tembi(:,:,:,:,:),spabi(:,:,:,:,:)
1433REAL,pointer :: invbr(:,:,:,:,:),clibr(:,:,:,:,:),tembr(:,:,:,:,:),spabr(:,:,:,:,:)
1434DOUBLE PRECISION,pointer :: invbd(:,:,:,:,:),clibd(:,:,:,:,:),tembd(:,:,:,:,:),spabd(:,:,:,:,:)
1435CHARACTER(len=vol7d_cdatalen),pointer :: invbc(:,:,:,:,:),clibc(:,:,:,:,:),tembc(:,:,:,:,:),spabc(:,:,:,:,:)
1436
1437call l4f_log(l4f_info,'starting peeling')
1438
1440
1441! generate code per i vari tipi di dati di v7d
1442! tramite un template e il preprocessore
1443
1444
1445#undef VOL7D_POLY_SUBTYPE
1446#undef VOL7D_POLY_SUBTYPES
1447#define VOL7D_POLY_SUBTYPE REAL
1448#define VOL7D_POLY_SUBTYPES r
1449
1450#undef VOL7D_POLY_TYPE
1451#undef VOL7D_POLY_TYPES
1452#define VOL7D_POLY_TYPE REAL
1453#define VOL7D_POLY_TYPES r
1454#include "modqc_peeling_include.F90"
1455#undef VOL7D_POLY_TYPE
1456#undef VOL7D_POLY_TYPES
1457#define VOL7D_POLY_TYPE DOUBLE PRECISION
1458#define VOL7D_POLY_TYPES d
1459#include "modqc_peeling_include.F90"
1460#undef VOL7D_POLY_TYPE
1461#undef VOL7D_POLY_TYPES
1462#define VOL7D_POLY_TYPE INTEGER
1463#define VOL7D_POLY_TYPES i
1464#include "modqc_peeling_include.F90"
1465#undef VOL7D_POLY_TYPE
1466#undef VOL7D_POLY_TYPES
1467#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1468#define VOL7D_POLY_TYPES b
1469#include "modqc_peeling_include.F90"
1470#undef VOL7D_POLY_TYPE
1471#undef VOL7D_POLY_TYPES
1472#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1473#define VOL7D_POLY_TYPES c
1474#include "modqc_peeling_include.F90"
1475
1476
1477#undef VOL7D_POLY_SUBTYPE
1478#undef VOL7D_POLY_SUBTYPES
1479#define VOL7D_POLY_SUBTYPE DOUBLE PRECISION
1480#define VOL7D_POLY_SUBTYPES d
1481
1482#undef VOL7D_POLY_TYPE
1483#undef VOL7D_POLY_TYPES
1484#define VOL7D_POLY_TYPE REAL
1485#define VOL7D_POLY_TYPES r
1486#include "modqc_peeling_include.F90"
1487#undef VOL7D_POLY_TYPE
1488#undef VOL7D_POLY_TYPES
1489#define VOL7D_POLY_TYPE DOUBLE PRECISION
1490#define VOL7D_POLY_TYPES d
1491#include "modqc_peeling_include.F90"
1492#undef VOL7D_POLY_TYPE
1493#undef VOL7D_POLY_TYPES
1494#define VOL7D_POLY_TYPE INTEGER
1495#define VOL7D_POLY_TYPES i
1496#include "modqc_peeling_include.F90"
1497#undef VOL7D_POLY_TYPE
1498#undef VOL7D_POLY_TYPES
1499#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1500#define VOL7D_POLY_TYPES b
1501#include "modqc_peeling_include.F90"
1502#undef VOL7D_POLY_TYPE
1503#undef VOL7D_POLY_TYPES
1504#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1505#define VOL7D_POLY_TYPES c
1506#include "modqc_peeling_include.F90"
1507
1508
1509#undef VOL7D_POLY_SUBTYPE
1510#undef VOL7D_POLY_SUBTYPES
1511#define VOL7D_POLY_SUBTYPE INTEGER
1512#define VOL7D_POLY_SUBTYPES i
1513
1514#undef VOL7D_POLY_TYPE
1515#undef VOL7D_POLY_TYPES
1516#define VOL7D_POLY_TYPE REAL
1517#define VOL7D_POLY_TYPES r
1518#include "modqc_peeling_include.F90"
1519#undef VOL7D_POLY_TYPE
1520#undef VOL7D_POLY_TYPES
1521#define VOL7D_POLY_TYPE DOUBLE PRECISION
1522#define VOL7D_POLY_TYPES d
1523#include "modqc_peeling_include.F90"
1524#undef VOL7D_POLY_TYPE
1525#undef VOL7D_POLY_TYPES
1526#define VOL7D_POLY_TYPE INTEGER
1527#define VOL7D_POLY_TYPES i
1528#include "modqc_peeling_include.F90"
1529#undef VOL7D_POLY_TYPE
1530#undef VOL7D_POLY_TYPES
1531#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1532#define VOL7D_POLY_TYPES b
1533#include "modqc_peeling_include.F90"
1534#undef VOL7D_POLY_TYPE
1535#undef VOL7D_POLY_TYPES
1536#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1537#define VOL7D_POLY_TYPES c
1538#include "modqc_peeling_include.F90"
1539
1540
1541#undef VOL7D_POLY_SUBTYPE
1542#undef VOL7D_POLY_SUBTYPES
1543#define VOL7D_POLY_SUBTYPE INTEGER(kind=int_b)
1544#define VOL7D_POLY_SUBTYPES b
1545
1546#undef VOL7D_POLY_TYPE
1547#undef VOL7D_POLY_TYPES
1548#define VOL7D_POLY_TYPE REAL
1549#define VOL7D_POLY_TYPES r
1550#include "modqc_peeling_include.F90"
1551#undef VOL7D_POLY_TYPE
1552#undef VOL7D_POLY_TYPES
1553#define VOL7D_POLY_TYPE DOUBLE PRECISION
1554#define VOL7D_POLY_TYPES d
1555#include "modqc_peeling_include.F90"
1556#undef VOL7D_POLY_TYPE
1557#undef VOL7D_POLY_TYPES
1558#define VOL7D_POLY_TYPE INTEGER
1559#define VOL7D_POLY_TYPES i
1560#include "modqc_peeling_include.F90"
1561#undef VOL7D_POLY_TYPE
1562#undef VOL7D_POLY_TYPES
1563#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1564#define VOL7D_POLY_TYPES b
1565#include "modqc_peeling_include.F90"
1566#undef VOL7D_POLY_TYPE
1567#undef VOL7D_POLY_TYPES
1568#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1569#define VOL7D_POLY_TYPES c
1570#include "modqc_peeling_include.F90"
1571
1572
1573
1574#undef VOL7D_POLY_SUBTYPE
1575#undef VOL7D_POLY_SUBTYPES
1576#define VOL7D_POLY_SUBTYPE CHARACTER(len=vol7d_cdatalen)
1577#define VOL7D_POLY_SUBTYPES c
1578
1579#undef VOL7D_POLY_TYPE
1580#undef VOL7D_POLY_TYPES
1581#define VOL7D_POLY_TYPE REAL
1582#define VOL7D_POLY_TYPES r
1583#include "modqc_peeling_include.F90"
1584#undef VOL7D_POLY_TYPE
1585#undef VOL7D_POLY_TYPES
1586#define VOL7D_POLY_TYPE DOUBLE PRECISION
1587#define VOL7D_POLY_TYPES d
1588#include "modqc_peeling_include.F90"
1589#undef VOL7D_POLY_TYPE
1590#undef VOL7D_POLY_TYPES
1591#define VOL7D_POLY_TYPE INTEGER
1592#define VOL7D_POLY_TYPES i
1593#include "modqc_peeling_include.F90"
1594#undef VOL7D_POLY_TYPE
1595#undef VOL7D_POLY_TYPES
1596#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1597#define VOL7D_POLY_TYPES b
1598#include "modqc_peeling_include.F90"
1599#undef VOL7D_POLY_TYPE
1600#undef VOL7D_POLY_TYPES
1601#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1602#define VOL7D_POLY_TYPES c
1603#include "modqc_peeling_include.F90"
1604
1605
1606
1607IF (.NOT.PRESENT(keep_attr) .AND. .NOT.PRESENT(delete_attr) .and. .not. optio_log(preserve)) THEN ! destroy all attributes
1608 IF (ASSOCIATED(this%voldatiattrr)) DEALLOCATE(this%voldatiattrr)
1609 IF (ASSOCIATED(this%voldatiattrd)) DEALLOCATE(this%voldatiattrd)
1610 IF (ASSOCIATED(this%voldatiattri)) DEALLOCATE(this%voldatiattri)
1611 IF (ASSOCIATED(this%voldatiattrb)) DEALLOCATE(this%voldatiattrb)
1612 IF (ASSOCIATED(this%voldatiattrc)) DEALLOCATE(this%voldatiattrc)
1613
1614 CALL delete(this%datiattr)
1615 CALL delete(this%dativarattr)
1616END IF
1617
1618IF (PRESENT(keep_attr)) THEN ! set to missing non requested attributes and reform
1619
1620 if (optio_log(preserve)) call l4f_log(l4f_warn,"preserve parameter ignored: keep_attr passed")
1621 CALL keep_var(this%datiattr%r)
1622 CALL keep_var(this%datiattr%d)
1623 CALL keep_var(this%datiattr%i)
1624 CALL keep_var(this%datiattr%b)
1625 CALL keep_var(this%datiattr%c)
1626 CALL qc_reform(this,data_id, miss=.true., purgeana=purgeana)
1627
1628ELSE IF (PRESENT(delete_attr)) THEN ! set to missing requested attributes and reform
1629
1630 if (optio_log(preserve)) call l4f_log(l4f_warn,"preserve parameter ignored: delete_attr passed")
1631 CALL delete_var(this%datiattr%r)
1632 CALL delete_var(this%datiattr%d)
1633 CALL delete_var(this%datiattr%i)
1634 CALL delete_var(this%datiattr%b)
1635 CALL delete_var(this%datiattr%c)
1636 CALL qc_reform(this,data_id, miss=.true., purgeana=purgeana)
1637
1638ELSE IF (PRESENT(purgeana)) THEN
1639
1640 CALL qc_reform(this,data_id, purgeana=purgeana)
1641
1642ENDIF
1643
1644
1645CONTAINS
1646
1647
1648!> Like vol7d_reform but manage data_id and have less options
1649subroutine qc_reform(this,data_id,miss, purgeana)
1650TYPE(vol7d),INTENT(INOUT) :: this !< object that has to be reformed
1651integer,INTENT(inout),pointer,OPTIONAL :: data_id(:,:,:,:,:) !< data ID to use with dballe DB (for fast write of attributes)
1652logical,intent(in),optional :: miss !< remove everithing related with missing position in description vector
1653logical,intent(in),optional :: purgeana !< if true remove ana with all data missing
1654
1655integer,pointer :: data_idtmp(:,:,:,:,:)
1656logical,allocatable :: llana(:)
1657integer,allocatable :: anaind(:)
1658integer :: i,j,nana
1659
1660if (optio_log(purgeana)) then
1661 allocate(llana(size(this%ana)))
1662 llana =.false.
1663 do i =1,size(this%ana)
1664 if (associated(this%voldatii)) llana(i)= llana(i) .or. any(c_e(this%voldatii(i,:,:,:,:,:)))
1665 if (associated(this%voldatir)) llana(i)= llana(i) .or. any(c_e(this%voldatir(i,:,:,:,:,:)))
1666 if (associated(this%voldatid)) llana(i)= llana(i) .or. any(c_e(this%voldatid(i,:,:,:,:,:)))
1667 if (associated(this%voldatib)) llana(i)= llana(i) .or. any(c_e(this%voldatib(i,:,:,:,:,:)))
1668 if (associated(this%voldatic)) llana(i)= llana(i) .or. any(c_e(this%voldatic(i,:,:,:,:,:)))
1669
1670#ifdef DEBUG
1671 if (.not. llana(i)) call l4f_log(l4f_debug,"remove station"//t2c(i))
1672#endif
1673
1674 end do
1675
1676 nana=count(llana)
1677
1678
1679 allocate(anaind(nana))
1680
1681 j=0
1682 do i=1,size(this%ana)
1683 if (llana(i)) then
1684 j=j+1
1685 anaind(j)=i
1686 end if
1687 end do
1688
1689
1690 if(present(data_id)) then
1691 allocate(data_idtmp(nana,size(data_id,2),size(data_id,3),size(data_id,4),size(data_id,5)))
1692 data_idtmp=data_id(anaind,:,:,:,:)
1693 if (associated(data_id))deallocate(data_id)
1694 data_id=>data_idtmp
1695 end if
1696
1697 call vol7d_reform(this,miss=miss,lana=llana)
1698
1699 deallocate(llana,anaind)
1700
1701else
1702
1703 call vol7d_reform(this,miss=miss)
1704
1705end if
1706
1707end subroutine qc_reform
1708
1709
1710SUBROUTINE keep_var(var)
1711TYPE(vol7d_var),intent(inout),POINTER :: var(:)
1712
1713INTEGER :: i
1714
1715IF (ASSOCIATED(var)) THEN
1716 if (size(var) == 0) then
1717 var%btable = vol7d_var_miss%btable
1718 else
1719 DO i = 1, SIZE(var)
1720 IF (all(var(i)%btable /= keep_attr(:))) THEN ! n.b. ALL((//)) = .TRUE.
1721 var(i)%btable = vol7d_var_miss%btable
1722 ENDIF
1723 ENDDO
1724 end if
1725ENDIF
1726
1727END SUBROUTINE keep_var
1728
1729SUBROUTINE delete_var(var)
1730TYPE(vol7d_var),intent(inout),POINTER :: var(:)
1731
1732INTEGER :: i
1733
1734IF (ASSOCIATED(var)) THEN
1735 if (size(var) == 0) then
1736 var%btable = vol7d_var_miss%btable
1737 else
1738 DO i = 1, SIZE(var)
1739 IF (any(var(i)%btable == delete_attr(:))) THEN ! n.b. ANY((//)) = .FALSE.
1740 var(i) = vol7d_var_miss
1741 ENDIF
1742 ENDDO
1743 end if
1744ENDIF
1745
1746END SUBROUTINE delete_var
1747
1748END SUBROUTINE vol7d_peeling
1749
1750
Definition of constants to be used for declaring variables of a desired type. Definition kinds.F90:245 Definitions of constants and functions for working with missing values. Definition missing_values.f90:50 Module for quickly interpreting the OPTIONAL parameters passed to a subprogram. Definition optional_values.f90:28 Classe per la gestione di un volume completo di dati osservati. Definition vol7d_class.F90:273 |