libsim Versione 7.2.6
|
◆ invalidatedb()
Data invalidated check.
Definizione alla linea 1085 del file modqc.F90. 1086! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1087! authors:
1088! Davide Cesari <dcesari@arpa.emr.it>
1089! Paolo Patruno <ppatruno@arpa.emr.it>
1090
1091! This program is free software; you can redistribute it and/or
1092! modify it under the terms of the GNU General Public License as
1093! published by the Free Software Foundation; either version 2 of
1094! the License, or (at your option) any later version.
1095
1096! This program is distributed in the hope that it will be useful,
1097! but WITHOUT ANY WARRANTY; without even the implied warranty of
1098! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1099! GNU General Public License for more details.
1100
1101! You should have received a copy of the GNU General Public License
1102! along with this program. If not, see <http://www.gnu.org/licenses/>.
1103#include "config.h"
1104!> \defgroup qc Libsim package, qc library.
1105!! Procedures for data quality control.
1106!! At the moment only climatological quality control is implemented
1107
1108!> Utilities and defines for quality control.
1109!!
1110!! Concise, high-value definitions of Data Quality by expert users,
1111!! analysts, implementers and journalists. This is a great starting point
1112!! to learn about Data Quality.
1113!!
1114!! Data Quality: The Accuracy Dimension
1115!!
1116!! "Data quality is defined as follows: data has quality if it satisfies
1117!! the requirements of its intended use. It lacks quality to the extent
1118!! that it does not satisfy the requirement. In other words, data quality
1119!! depends as much on the intended use as it does on the data itself. To
1120!! satisfy the intended use, the data must be accurate, timely, relevant,
1121!! complete, understood, and trusted." Jack E. Olson
1122!!
1123!! No Data Left Behind: Federal Student Aid - A Case History
1124!!
1125!! "Data quality institutionalizes a set of repeatable processes to
1126!! continuously monitor data and improve data accuracy, completeness,
1127!! timeliness and relevance." Holly Hyland and Lisa Elliott, Federal
1128!! Student Aid
1129!!
1130!! Data Quality: It's a Family Affair
1131!!
1132!! Data Quality definition: "The state of completeness, consistency,
1133!! timeliness and accuracy that makes data appropriate for a specific
1134!! use." Wim Helmer, Dun & Bradstreet
1135!!
1136!! Data Quality and Quality Management - Examples of Quality Evaluation
1137!! Procedures and Quality Management in European National Mapping
1138!! Agencies
1139!!
1140!! "Quality is defined as the totality of characteristics of a product
1141!! that bear on its ability to satisfy stated and implied needs (ISO
1142!! 8402, 1994). In the new ISO/DIS 9000:2000 standard (2000) the
1143!! definition of quality is: 'Ability of a set of inherent
1144!! characteristics of a product, system or process to fulfill
1145!! requirements of customers and other interested parties.' This
1146!! indicates that data quality and quality management are very closely
1147!! related. Data quality is part of the organisation's total quality
1148!! management." Antti Jakobsson
1149!!
1150!! text below from Wikipedia
1151!! http://it.wikipedia.org/wiki/Test_di_verifica_d%27ipotesi
1152!! http://creativecommons.org/licenses/by-sa/3.0/deed.it
1153!! L'ambito statistico
1154!!
1155!! Nel secondo caso la situazione è modificata in quanto interviene un
1156!! elemento nuovo, ovvero il caso. Si supponga di avere una moneta
1157!! recante due facce contrassegnate con testa e croce. Volendo verificare
1158!! l'ipotesi di bilanciamento della moneta si eseguono 20 lanci e si
1159!! contano quelli che danno esito testa. La conseguenza del bilanciamento
1160!! consiste nell'osservare un valore di teste attorno a 10. Tuttavia
1161!! anche in ipotesi di bilanciamento non si può escludere di osservare 20
1162!! teste. D'altronde, l'ipotesi di bilanciamento è logicamente
1163!! compatibile con un numero di teste variante da 0 a 20. In tale
1164!! contesto una qualsiasi decisione in merito all'ipotesi da verificare
1165!! comporta un rischio di errore. Ad esempio rigettare l'ipotesi di
1166!! bilanciamento della moneta avendo osservato 20 teste su 20 lanci
1167!! comporta il rischio di prendere una decisione errata. Nel procedere
1168!! alla verifica dell'ipotesi di bilanciamento della moneta, si ricorre a
1169!! una variabile casuale X. Tale variabile casuale X è una variabile
1170!! aleatoria discreta con distribuzione binomiale B(20; 0,5), dove 20
1171!! indica il numero di lanci e 0,5 la probabilità che si verifichi
1172!! l'evento "testa".
1173!!
1174!! Il risultato sperimentale si deve quindi confrontare con tale
1175!! distribuzione: quanto è distante tale risultato dal valore medio della
1176!! distribuzione B(20; 0,5)? Per rispondere alla domanda si deve
1177!! individuare un valore caratteristico della distribuzione B(20;
1178!! 0,5). Nel nostro caso tale valore caratteristico è il valore medio
1179!! 20/2 = 10. Per valutare la distanza tra il valore sperimentale e
1180!! quello atteso si valuta la probabilità di ottenere un valore
1181!! sperimentale lontano dal valore medio di B(20; 0,5), ossia nel caso
1182!! che dal nostro esperimento risulti X=15 (15 teste dopo 20 lanci), si
1183!! calcola P{|X-10|>=15-10} quindi P{X<=5 oppure X>=15}=0,041.
1184!!
1185!! Quindi, usando una moneta ben bilanciata, la probabilità di ottenere
1186!! un numero di teste X >= 15 (oppure X <= 5) dopo 20 lanci è pari a
1187!! 0,041 ossia al 4,1%. Giudicando bassa tale probabilità si rifiuterà
1188!! l'ipotesi di bilanciamento della moneta in esame, accettando quindi il
1189!! rischio del 4,1% di compiere un errore nel rifiutarla. Di solito, il
1190!! valore della probabilità adottato per rifiutare l'ipotesi nulla è <
1191!! 0,05. Tale valore è detto livello di significatività ed è definibile
1192!! come segue: il livello di significatività sotto l'ipotesi nulla è la
1193!! probabilità di cadere nella zona di rifiuto quando l'ipotesi nulla è
1194!! vera. Tale livello di significatività si indica convenzionalmente con
1195!! α. Il livello di significatività osservato α del test per il quale si
1196!! rifiuterebbe l'ipotesi nulla è detto valore-p (p-value). Riprendendo
1197!! l'esempio sopra riportato il valore-p è pari a 0,041. Adottando
1198!! nell'esempio α = 0,05, si rifiuterà l'ipotesi se
1199!! P{|X-10|>=x}<0,05. Tale condizione si raggiunge appunto se X<6 oppure
1200!! X>14. Tale insieme di valori si definisce convenzionalmente come
1201!! regione di rifiuto. Viceversa l'insieme { 6,7...14} si definisce regione
1202!! di accettazione. In questo modo si è costruita una regola di
1203!! comportamento per verificare l'ipotesi di bilanciamento della
1204!! moneta. Tale regola definisce il test statistico.
1205!!
1206!! In termini tecnici l'ipotesi da verificare si chiama ipotesi nulla e
1207!! si indica con H0, mentre l'ipotesi alternativa con H1. Nel caso della
1208!! moneta, se p è la probabilità di ottenere testa in un lancio la
1209!! verifica di ipotesi si traduce nel seguente sistema:
1210!!
1211!! H_0: p = \frac{1}{2}
1212!! H_1: p \ne \frac{1}{2}
1213!!
1214!! Come già osservato, il modo di condurre un test statistico comporta un
1215!! rischio di errore. Nella pratica statistica si individuano due tipi di
1216!! errori:
1217!!
1218!! 1. rifiutare H0 quando è vera, errore di primo tipo (α) (o errore di prima specie);
1219!! 2. accettare H0 quando è falsa, errore di secondo tipo (β) (o errore di seconda specie).
1220!!
1221!! Tornando all'esempio della moneta in cui la regione di accettazione è
1222!! data dall'insieme di valori {6..14}, la probabilità di rifiutare H0
1223!! quando è vera è stato calcolato pari a 0,041.Tale probabilità
1224!! rappresenta il rischio di incorrere in un errore di primo tipo e si
1225!! indica con α. Per valutare la probabilità di un errore di secondo tipo
1226!! è necessario specificare un valore di p in caso di verità di H1. Si
1227!! supponga che p=0,80, in tal caso la distribuzione di X è una
1228!! B(20;0,80)
1229!!
1230!! Con tale distribuzione di probabilità, l'errore di tipo 2 si calcola
1231!! sommando le probabilità relative ai valori di X della zona di
1232!! accettazione. Si trova quindi che la probabilità cercata è pari a
1233!! circa 0,20. Tale probabilità quantifica il rischio di incorrere
1234!! nell'errore di tipo 2. e si indica convenzionalmente con β. La
1235!! quantità 1-β si chiama potenza del test ed esprime quindi la capacità
1236!! di un test statistico riconoscere la falsità di H0 quando questa è
1237!! effettivamente falsa. La potenza del test trova applicazione nella
1238!! pratica statistica in fase di pianificazione di un esperimento.
1239!!
1240!!Scope of quality checks on observation values
1241!!Checks applied to determine the quality of an observation can range from the very simple to the
1242!!very complex. In roughly increasing order of complexity they can include:
1243!! * Syntactic checks (e.g. an air temperature must be a number to at most 1 decimal
1244!! place);
1245!! * Numeric ranges (e.g. the temperature must fall in the range -90 to +70);
1246!! * Climate range checks (i.e. is the datum consistent with climatology?)
1247!! * Intra-record consistency (e.g. the air temperature must not be less than the dew
1248!! point);
1249!! * Time-series consistency (e.g. the difference between two successive temperatures at
1250!! a site must be 'plausible'); and
1251!! * Spatial consistency (e.g. the station-dependent limits of plausible difference between
1252!! the temperatures at a station and its neighbours must not be violated).
1253!!\ingroup qc
1259
1260
1261implicit none
1262
1263
1264!> Definisce il livello di attendibilità per i dati validi
1266 integer (kind=int_b):: att !< confidence for "*B33192" "*B33193" "*B33194"
1267 integer (kind=int_b):: gross_error ! special valuer for "*B33192" when gross error check failed
1268 integer (kind=int_b):: invalidated ! special valuer for "*B33196" when manual invalidation happen
1270
1271!> Default: data with confidence less or equal 10 are rejected
1273
1274integer, parameter :: nqcattrvars=4
1275CHARACTER(len=10),parameter :: qcattrvarsbtables(nqcattrvars)=(/"*B33196","*B33192","*B33193","*B33194"/)
1276
1277type :: qcattrvars
1278 TYPE(vol7d_var) :: vars(nqcattrvars)
1279 CHARACTER(len=10) :: btables(nqcattrvars)
1280end type qcattrvars
1281
1282!> Variables user in Quality Control
1284 module procedure init_qcattrvars
1285end interface
1286
1287!> Remove data under a defined grade of confidence.
1289 module procedure peeledrb, peeleddb, peeledbb, peeledib, peeledcb &
1290 ,peeledri, peeleddi, peeledbi, peeledii, peeledci &
1291 ,peeledrr, peeleddr, peeledbr, peeledir, peeledcr &
1292 ,peeledrd, peeleddd, peeledbd, peeledid, peeledcd &
1293 ,peeledrc, peeleddc, peeledbc, peeledic, peeledcc
1294end interface
1295
1296
1297!> Check data validity based on single confidence
1299 module procedure vdi,vdb,vdr,vdd,vdc
1300end interface
1301
1302!> Check data validity based on gross error check
1304 module procedure vdgei,vdgeb,vdger,vdged,vdgec
1305end interface
1306
1307!> Test di dato invalidato
1309 module procedure invalidatedi,invalidatedb,invalidatedr,invalidatedd,invalidatedc
1310end interface
1311
1312private
1313
1315public qcattrvars, nqcattrvars, qcattrvarsbtables
1317
1318contains
1319
1320
1321! peeled routines
1322#undef VOL7D_POLY_SUBTYPE
1323#undef VOL7D_POLY_SUBTYPES
1324#undef VOL7D_POLY_ISC
1325#define VOL7D_POLY_SUBTYPE REAL
1326#define VOL7D_POLY_SUBTYPES r
1327
1328#undef VOL7D_POLY_TYPE
1329#undef VOL7D_POLY_TYPES
1330#undef VOL7D_POLY_ISC
1331#undef VOL7D_POLY_TYPES_SUBTYPES
1332#define VOL7D_POLY_TYPE REAL
1333#define VOL7D_POLY_TYPES r
1334#define VOL7D_POLY_TYPES_SUBTYPES rr
1335#include "modqc_peeled_include.F90"
1336#include "modqc_peel_util_include.F90"
1337#undef VOL7D_POLY_TYPE
1338#undef VOL7D_POLY_TYPES
1339#undef VOL7D_POLY_TYPES_SUBTYPES
1340#define VOL7D_POLY_TYPE DOUBLE PRECISION
1341#define VOL7D_POLY_TYPES d
1342#define VOL7D_POLY_TYPES_SUBTYPES dr
1343#include "modqc_peeled_include.F90"
1344#include "modqc_peel_util_include.F90"
1345#undef VOL7D_POLY_TYPE
1346#undef VOL7D_POLY_TYPES
1347#undef VOL7D_POLY_TYPES_SUBTYPES
1348#define VOL7D_POLY_TYPE INTEGER
1349#define VOL7D_POLY_TYPES i
1350#define VOL7D_POLY_TYPES_SUBTYPES ir
1351#include "modqc_peeled_include.F90"
1352#include "modqc_peel_util_include.F90"
1353#undef VOL7D_POLY_TYPE
1354#undef VOL7D_POLY_TYPES
1355#undef VOL7D_POLY_TYPES_SUBTYPES
1356#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1357#define VOL7D_POLY_TYPES b
1358#define VOL7D_POLY_TYPES_SUBTYPES br
1359#include "modqc_peeled_include.F90"
1360#include "modqc_peel_util_include.F90"
1361#undef VOL7D_POLY_TYPE
1362#undef VOL7D_POLY_TYPES
1363#undef VOL7D_POLY_TYPES_SUBTYPES
1364#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1365#define VOL7D_POLY_TYPES c
1366#define VOL7D_POLY_ISC = 1
1367#define VOL7D_POLY_TYPES_SUBTYPES cr
1368#include "modqc_peeled_include.F90"
1369#include "modqc_peel_util_include.F90"
1370
1371
1372#undef VOL7D_POLY_SUBTYPE
1373#undef VOL7D_POLY_SUBTYPES
1374#undef VOL7D_POLY_ISC
1375#define VOL7D_POLY_SUBTYPE DOUBLE PRECISION
1376#define VOL7D_POLY_SUBTYPES d
1377
1378#undef VOL7D_POLY_TYPE
1379#undef VOL7D_POLY_TYPES
1380#undef VOL7D_POLY_TYPES_SUBTYPES
1381#define VOL7D_POLY_TYPE REAL
1382#define VOL7D_POLY_TYPES r
1383#define VOL7D_POLY_TYPES_SUBTYPES rd
1384#include "modqc_peeled_include.F90"
1385#undef VOL7D_POLY_TYPE
1386#undef VOL7D_POLY_TYPES
1387#undef VOL7D_POLY_TYPES_SUBTYPES
1388#define VOL7D_POLY_TYPE DOUBLE PRECISION
1389#define VOL7D_POLY_TYPES d
1390#define VOL7D_POLY_TYPES_SUBTYPES dd
1391#include "modqc_peeled_include.F90"
1392#undef VOL7D_POLY_TYPE
1393#undef VOL7D_POLY_TYPES
1394#undef VOL7D_POLY_TYPES_SUBTYPES
1395#define VOL7D_POLY_TYPE INTEGER
1396#define VOL7D_POLY_TYPES i
1397#define VOL7D_POLY_TYPES_SUBTYPES id
1398#include "modqc_peeled_include.F90"
1399#undef VOL7D_POLY_TYPE
1400#undef VOL7D_POLY_TYPES
1401#undef VOL7D_POLY_TYPES_SUBTYPES
1402#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1403#define VOL7D_POLY_TYPES b
1404#define VOL7D_POLY_TYPES_SUBTYPES bd
1405#include "modqc_peeled_include.F90"
1406#undef VOL7D_POLY_TYPE
1407#undef VOL7D_POLY_TYPES
1408#undef VOL7D_POLY_TYPES_SUBTYPES
1409#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1410#define VOL7D_POLY_TYPES c
1411#define VOL7D_POLY_TYPES_SUBTYPES cd
1412#include "modqc_peeled_include.F90"
1413
1414
1415#undef VOL7D_POLY_SUBTYPE
1416#undef VOL7D_POLY_SUBTYPES
1417#undef VOL7D_POLY_ISC
1418#define VOL7D_POLY_SUBTYPE INTEGER
1419#define VOL7D_POLY_SUBTYPES i
1420
1421#undef VOL7D_POLY_TYPE
1422#undef VOL7D_POLY_TYPES
1423#undef VOL7D_POLY_TYPES_SUBTYPES
1424#define VOL7D_POLY_TYPE REAL
1425#define VOL7D_POLY_TYPES r
1426#define VOL7D_POLY_TYPES_SUBTYPES ri
1427#include "modqc_peeled_include.F90"
1428#undef VOL7D_POLY_TYPE
1429#undef VOL7D_POLY_TYPES
1430#undef VOL7D_POLY_TYPES_SUBTYPES
1431#define VOL7D_POLY_TYPE DOUBLE PRECISION
1432#define VOL7D_POLY_TYPES d
1433#define VOL7D_POLY_TYPES_SUBTYPES di
1434#include "modqc_peeled_include.F90"
1435#undef VOL7D_POLY_TYPE
1436#undef VOL7D_POLY_TYPES
1437#undef VOL7D_POLY_TYPES_SUBTYPES
1438#define VOL7D_POLY_TYPE INTEGER
1439#define VOL7D_POLY_TYPES i
1440#define VOL7D_POLY_TYPES_SUBTYPES ii
1441#include "modqc_peeled_include.F90"
1442#undef VOL7D_POLY_TYPE
1443#undef VOL7D_POLY_TYPES
1444#undef VOL7D_POLY_TYPES_SUBTYPES
1445#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1446#define VOL7D_POLY_TYPES b
1447#define VOL7D_POLY_TYPES_SUBTYPES bi
1448#include "modqc_peeled_include.F90"
1449#undef VOL7D_POLY_TYPE
1450#undef VOL7D_POLY_TYPES
1451#undef VOL7D_POLY_TYPES_SUBTYPES
1452#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1453#define VOL7D_POLY_TYPES c
1454#define VOL7D_POLY_ISC = 1
1455#define VOL7D_POLY_TYPES_SUBTYPES ci
1456#include "modqc_peeled_include.F90"
1457
1458
1459#undef VOL7D_POLY_SUBTYPE
1460#undef VOL7D_POLY_SUBTYPES
1461#undef VOL7D_POLY_ISC
1462#define VOL7D_POLY_SUBTYPE INTEGER(kind=int_b)
1463#define VOL7D_POLY_SUBTYPES b
1464
1465#undef VOL7D_POLY_TYPE
1466#undef VOL7D_POLY_TYPES
1467#undef VOL7D_POLY_TYPES_SUBTYPES
1468#define VOL7D_POLY_TYPE REAL
1469#define VOL7D_POLY_TYPES r
1470#define VOL7D_POLY_TYPES_SUBTYPES rb
1471#include "modqc_peeled_include.F90"
1472#undef VOL7D_POLY_TYPE
1473#undef VOL7D_POLY_TYPES
1474#undef VOL7D_POLY_TYPES_SUBTYPES
1475#define VOL7D_POLY_TYPE DOUBLE PRECISION
1476#define VOL7D_POLY_TYPES d
1477#define VOL7D_POLY_TYPES_SUBTYPES db
1478#include "modqc_peeled_include.F90"
1479#undef VOL7D_POLY_TYPE
1480#undef VOL7D_POLY_TYPES
1481#undef VOL7D_POLY_TYPES_SUBTYPES
1482#define VOL7D_POLY_TYPE INTEGER
1483#define VOL7D_POLY_TYPES i
1484#define VOL7D_POLY_TYPES_SUBTYPES ib
1485#include "modqc_peeled_include.F90"
1486#undef VOL7D_POLY_TYPE
1487#undef VOL7D_POLY_TYPES
1488#undef VOL7D_POLY_TYPES_SUBTYPES
1489#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1490#define VOL7D_POLY_TYPES b
1491#define VOL7D_POLY_TYPES_SUBTYPES bb
1492#include "modqc_peeled_include.F90"
1493#undef VOL7D_POLY_TYPE
1494#undef VOL7D_POLY_TYPES
1495#undef VOL7D_POLY_TYPES_SUBTYPES
1496#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1497#define VOL7D_POLY_TYPES c
1498#define VOL7D_POLY_ISC = 1
1499#define VOL7D_POLY_TYPES_SUBTYPES cb
1500#include "modqc_peeled_include.F90"
1501
1502
1503#undef VOL7D_POLY_SUBTYPE
1504#undef VOL7D_POLY_SUBTYPES
1505#undef VOL7D_POLY_ISC
1506#define VOL7D_POLY_SUBTYPE CHARACTER(len=vol7d_cdatalen)
1507#define VOL7D_POLY_SUBTYPES c
1508
1509#undef VOL7D_POLY_TYPE
1510#undef VOL7D_POLY_TYPES
1511#undef VOL7D_POLY_TYPES_SUBTYPES
1512#define VOL7D_POLY_TYPE REAL
1513#define VOL7D_POLY_TYPES r
1514#define VOL7D_POLY_TYPES_SUBTYPES rc
1515#include "modqc_peeled_include.F90"
1516#undef VOL7D_POLY_TYPE
1517#undef VOL7D_POLY_TYPES
1518#undef VOL7D_POLY_TYPES_SUBTYPES
1519#define VOL7D_POLY_TYPE DOUBLE PRECISION
1520#define VOL7D_POLY_TYPES d
1521#define VOL7D_POLY_TYPES_SUBTYPES dc
1522#include "modqc_peeled_include.F90"
1523#undef VOL7D_POLY_TYPE
1524#undef VOL7D_POLY_TYPES
1525#undef VOL7D_POLY_TYPES_SUBTYPES
1526#define VOL7D_POLY_TYPE INTEGER
1527#define VOL7D_POLY_TYPES i
1528#define VOL7D_POLY_TYPES_SUBTYPES ic
1529#include "modqc_peeled_include.F90"
1530#undef VOL7D_POLY_TYPE
1531#undef VOL7D_POLY_TYPES
1532#undef VOL7D_POLY_TYPES_SUBTYPES
1533#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1534#define VOL7D_POLY_TYPES b
1535#define VOL7D_POLY_TYPES_SUBTYPES bc
1536#include "modqc_peeled_include.F90"
1537#undef VOL7D_POLY_TYPE
1538#undef VOL7D_POLY_TYPES
1539#undef VOL7D_POLY_TYPES_SUBTYPES
1540#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1541#define VOL7D_POLY_TYPES c
1542#define VOL7D_POLY_ISC = 1
1543#define VOL7D_POLY_TYPES_SUBTYPES cc
1544#include "modqc_peeled_include.F90"
1545
1546
1547subroutine init_qcattrvars(this)
1548
1549type(qcattrvars),intent(inout) :: this
1550integer :: i
1551
1552this%btables(:) =qcattrvarsbtables
1553do i =1, nqcattrvars
1555end do
1556
1557end subroutine init_qcattrvars
1558
1559
1560type(qcattrvars) function qcattrvars_new()
1561
1563
1564end function qcattrvars_new
1565
1566
1567!> Remove data under the predefined grade of confidence.
1568!! If neither \a keep_attr nor \a delete_attr are passed, all the
1569!! attributes will be deleted after peeling; if \a keep_attr is
1570!! provided, only attributed listed in \a keep_attr will be kept in
1571!! output, (\a delete_attr will be ignored); if \a delete_attr is
1572!! provided, attributed listed in \a delete_attr will be deleted from
1573!! output.
1574SUBROUTINE vol7d_peeling(this, data_id, keep_attr, delete_attr, preserve, purgeana)
1575TYPE(vol7d),INTENT(INOUT) :: this !< object that has to be peeled
1576integer,INTENT(inout),pointer,OPTIONAL :: data_id(:,:,:,:,:) !< data ID to use with dballe DB (for fast write of attributes)
1577CHARACTER(len=*),INTENT(in),OPTIONAL :: keep_attr(:) !< Btable of attributes that should be kept after removing data
1578CHARACTER(len=*),INTENT(in),OPTIONAL :: delete_attr(:) !< Btable of attributes that should be deleted after removing data
1579logical,intent(in),optional :: preserve !< preserve all attributes if true (alternative to keep_attr and delete_attr)
1580logical,intent(in),optional :: purgeana !< if true remove ana with all data missing
1581
1582integer :: inddativar,inddatiattrinv,inddatiattrcli,inddatiattrtem,inddatiattrspa,inddativarattr
1583type(qcattrvars) :: attrvars
1584
1585INTEGER(kind=int_b),pointer :: invbb(:,:,:,:,:),clibb(:,:,:,:,:),tembb(:,:,:,:,:),spabb(:,:,:,:,:)
1586INTEGER,pointer :: invbi(:,:,:,:,:),clibi(:,:,:,:,:),tembi(:,:,:,:,:),spabi(:,:,:,:,:)
1587REAL,pointer :: invbr(:,:,:,:,:),clibr(:,:,:,:,:),tembr(:,:,:,:,:),spabr(:,:,:,:,:)
1588DOUBLE PRECISION,pointer :: invbd(:,:,:,:,:),clibd(:,:,:,:,:),tembd(:,:,:,:,:),spabd(:,:,:,:,:)
1589CHARACTER(len=vol7d_cdatalen),pointer :: invbc(:,:,:,:,:),clibc(:,:,:,:,:),tembc(:,:,:,:,:),spabc(:,:,:,:,:)
1590
1591call l4f_log(l4f_info,'starting peeling')
1592
1594
1595! generate code per i vari tipi di dati di v7d
1596! tramite un template e il preprocessore
1597
1598
1599#undef VOL7D_POLY_SUBTYPE
1600#undef VOL7D_POLY_SUBTYPES
1601#define VOL7D_POLY_SUBTYPE REAL
1602#define VOL7D_POLY_SUBTYPES r
1603
1604#undef VOL7D_POLY_TYPE
1605#undef VOL7D_POLY_TYPES
1606#define VOL7D_POLY_TYPE REAL
1607#define VOL7D_POLY_TYPES r
1608#include "modqc_peeling_include.F90"
1609#undef VOL7D_POLY_TYPE
1610#undef VOL7D_POLY_TYPES
1611#define VOL7D_POLY_TYPE DOUBLE PRECISION
1612#define VOL7D_POLY_TYPES d
1613#include "modqc_peeling_include.F90"
1614#undef VOL7D_POLY_TYPE
1615#undef VOL7D_POLY_TYPES
1616#define VOL7D_POLY_TYPE INTEGER
1617#define VOL7D_POLY_TYPES i
1618#include "modqc_peeling_include.F90"
1619#undef VOL7D_POLY_TYPE
1620#undef VOL7D_POLY_TYPES
1621#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1622#define VOL7D_POLY_TYPES b
1623#include "modqc_peeling_include.F90"
1624#undef VOL7D_POLY_TYPE
1625#undef VOL7D_POLY_TYPES
1626#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1627#define VOL7D_POLY_TYPES c
1628#include "modqc_peeling_include.F90"
1629
1630
1631#undef VOL7D_POLY_SUBTYPE
1632#undef VOL7D_POLY_SUBTYPES
1633#define VOL7D_POLY_SUBTYPE DOUBLE PRECISION
1634#define VOL7D_POLY_SUBTYPES d
1635
1636#undef VOL7D_POLY_TYPE
1637#undef VOL7D_POLY_TYPES
1638#define VOL7D_POLY_TYPE REAL
1639#define VOL7D_POLY_TYPES r
1640#include "modqc_peeling_include.F90"
1641#undef VOL7D_POLY_TYPE
1642#undef VOL7D_POLY_TYPES
1643#define VOL7D_POLY_TYPE DOUBLE PRECISION
1644#define VOL7D_POLY_TYPES d
1645#include "modqc_peeling_include.F90"
1646#undef VOL7D_POLY_TYPE
1647#undef VOL7D_POLY_TYPES
1648#define VOL7D_POLY_TYPE INTEGER
1649#define VOL7D_POLY_TYPES i
1650#include "modqc_peeling_include.F90"
1651#undef VOL7D_POLY_TYPE
1652#undef VOL7D_POLY_TYPES
1653#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1654#define VOL7D_POLY_TYPES b
1655#include "modqc_peeling_include.F90"
1656#undef VOL7D_POLY_TYPE
1657#undef VOL7D_POLY_TYPES
1658#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1659#define VOL7D_POLY_TYPES c
1660#include "modqc_peeling_include.F90"
1661
1662
1663#undef VOL7D_POLY_SUBTYPE
1664#undef VOL7D_POLY_SUBTYPES
1665#define VOL7D_POLY_SUBTYPE INTEGER
1666#define VOL7D_POLY_SUBTYPES i
1667
1668#undef VOL7D_POLY_TYPE
1669#undef VOL7D_POLY_TYPES
1670#define VOL7D_POLY_TYPE REAL
1671#define VOL7D_POLY_TYPES r
1672#include "modqc_peeling_include.F90"
1673#undef VOL7D_POLY_TYPE
1674#undef VOL7D_POLY_TYPES
1675#define VOL7D_POLY_TYPE DOUBLE PRECISION
1676#define VOL7D_POLY_TYPES d
1677#include "modqc_peeling_include.F90"
1678#undef VOL7D_POLY_TYPE
1679#undef VOL7D_POLY_TYPES
1680#define VOL7D_POLY_TYPE INTEGER
1681#define VOL7D_POLY_TYPES i
1682#include "modqc_peeling_include.F90"
1683#undef VOL7D_POLY_TYPE
1684#undef VOL7D_POLY_TYPES
1685#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1686#define VOL7D_POLY_TYPES b
1687#include "modqc_peeling_include.F90"
1688#undef VOL7D_POLY_TYPE
1689#undef VOL7D_POLY_TYPES
1690#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1691#define VOL7D_POLY_TYPES c
1692#include "modqc_peeling_include.F90"
1693
1694
1695#undef VOL7D_POLY_SUBTYPE
1696#undef VOL7D_POLY_SUBTYPES
1697#define VOL7D_POLY_SUBTYPE INTEGER(kind=int_b)
1698#define VOL7D_POLY_SUBTYPES b
1699
1700#undef VOL7D_POLY_TYPE
1701#undef VOL7D_POLY_TYPES
1702#define VOL7D_POLY_TYPE REAL
1703#define VOL7D_POLY_TYPES r
1704#include "modqc_peeling_include.F90"
1705#undef VOL7D_POLY_TYPE
1706#undef VOL7D_POLY_TYPES
1707#define VOL7D_POLY_TYPE DOUBLE PRECISION
1708#define VOL7D_POLY_TYPES d
1709#include "modqc_peeling_include.F90"
1710#undef VOL7D_POLY_TYPE
1711#undef VOL7D_POLY_TYPES
1712#define VOL7D_POLY_TYPE INTEGER
1713#define VOL7D_POLY_TYPES i
1714#include "modqc_peeling_include.F90"
1715#undef VOL7D_POLY_TYPE
1716#undef VOL7D_POLY_TYPES
1717#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1718#define VOL7D_POLY_TYPES b
1719#include "modqc_peeling_include.F90"
1720#undef VOL7D_POLY_TYPE
1721#undef VOL7D_POLY_TYPES
1722#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1723#define VOL7D_POLY_TYPES c
1724#include "modqc_peeling_include.F90"
1725
1726
1727
1728#undef VOL7D_POLY_SUBTYPE
1729#undef VOL7D_POLY_SUBTYPES
1730#define VOL7D_POLY_SUBTYPE CHARACTER(len=vol7d_cdatalen)
1731#define VOL7D_POLY_SUBTYPES c
1732
1733#undef VOL7D_POLY_TYPE
1734#undef VOL7D_POLY_TYPES
1735#define VOL7D_POLY_TYPE REAL
1736#define VOL7D_POLY_TYPES r
1737#include "modqc_peeling_include.F90"
1738#undef VOL7D_POLY_TYPE
1739#undef VOL7D_POLY_TYPES
1740#define VOL7D_POLY_TYPE DOUBLE PRECISION
1741#define VOL7D_POLY_TYPES d
1742#include "modqc_peeling_include.F90"
1743#undef VOL7D_POLY_TYPE
1744#undef VOL7D_POLY_TYPES
1745#define VOL7D_POLY_TYPE INTEGER
1746#define VOL7D_POLY_TYPES i
1747#include "modqc_peeling_include.F90"
1748#undef VOL7D_POLY_TYPE
1749#undef VOL7D_POLY_TYPES
1750#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1751#define VOL7D_POLY_TYPES b
1752#include "modqc_peeling_include.F90"
1753#undef VOL7D_POLY_TYPE
1754#undef VOL7D_POLY_TYPES
1755#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1756#define VOL7D_POLY_TYPES c
1757#include "modqc_peeling_include.F90"
1758
1759
1760
1761IF (.NOT.PRESENT(keep_attr) .AND. .NOT.PRESENT(delete_attr) .and. .not. optio_log(preserve)) THEN ! destroy all attributes
1762 IF (ASSOCIATED(this%voldatiattrr)) DEALLOCATE(this%voldatiattrr)
1763 IF (ASSOCIATED(this%voldatiattrd)) DEALLOCATE(this%voldatiattrd)
1764 IF (ASSOCIATED(this%voldatiattri)) DEALLOCATE(this%voldatiattri)
1765 IF (ASSOCIATED(this%voldatiattrb)) DEALLOCATE(this%voldatiattrb)
1766 IF (ASSOCIATED(this%voldatiattrc)) DEALLOCATE(this%voldatiattrc)
1767
1768 CALL delete(this%datiattr)
1769 CALL delete(this%dativarattr)
1770END IF
1771
1772IF (PRESENT(keep_attr)) THEN ! set to missing non requested attributes and reform
1773
1774 if (optio_log(preserve)) call l4f_log(l4f_warn,"preserve parameter ignored: keep_attr passed")
1775 CALL keep_var(this%datiattr%r)
1776 CALL keep_var(this%datiattr%d)
1777 CALL keep_var(this%datiattr%i)
1778 CALL keep_var(this%datiattr%b)
1779 CALL keep_var(this%datiattr%c)
1780 CALL qc_reform(this,data_id, miss=.true., purgeana=purgeana)
1781
1782ELSE IF (PRESENT(delete_attr)) THEN ! set to missing requested attributes and reform
1783
1784 if (optio_log(preserve)) call l4f_log(l4f_warn,"preserve parameter ignored: delete_attr passed")
1785 CALL delete_var(this%datiattr%r)
1786 CALL delete_var(this%datiattr%d)
1787 CALL delete_var(this%datiattr%i)
1788 CALL delete_var(this%datiattr%b)
1789 CALL delete_var(this%datiattr%c)
1790 CALL qc_reform(this,data_id, miss=.true., purgeana=purgeana)
1791
1792ELSE IF (PRESENT(purgeana)) THEN
1793
1794 CALL qc_reform(this,data_id, purgeana=purgeana)
1795
1796ENDIF
1797
1798
1799CONTAINS
1800
1801
1802!> Like vol7d_reform but manage data_id and have less options
1803subroutine qc_reform(this,data_id,miss, purgeana)
1804TYPE(vol7d),INTENT(INOUT) :: this !< object that has to be reformed
1805integer,INTENT(inout),pointer,OPTIONAL :: data_id(:,:,:,:,:) !< data ID to use with dballe DB (for fast write of attributes)
1806logical,intent(in),optional :: miss !< remove everithing related with missing position in description vector
1807logical,intent(in),optional :: purgeana !< if true remove ana with all data missing
1808
1809integer,pointer :: data_idtmp(:,:,:,:,:)
1810logical,allocatable :: llana(:)
1811integer,allocatable :: anaind(:)
1812integer :: i,j,nana
1813
1814if (optio_log(purgeana)) then
1815 allocate(llana(size(this%ana)))
1816 llana =.false.
1817 do i =1,size(this%ana)
1818 if (associated(this%voldatii)) llana(i)= llana(i) .or. any(c_e(this%voldatii(i,:,:,:,:,:)))
1819 if (associated(this%voldatir)) llana(i)= llana(i) .or. any(c_e(this%voldatir(i,:,:,:,:,:)))
1820 if (associated(this%voldatid)) llana(i)= llana(i) .or. any(c_e(this%voldatid(i,:,:,:,:,:)))
1821 if (associated(this%voldatib)) llana(i)= llana(i) .or. any(c_e(this%voldatib(i,:,:,:,:,:)))
1822 if (associated(this%voldatic)) llana(i)= llana(i) .or. any(c_e(this%voldatic(i,:,:,:,:,:)))
1823
1824#ifdef DEBUG
1825 if (.not. llana(i)) call l4f_log(l4f_debug,"remove station"//t2c(i))
1826#endif
1827
1828 end do
1829
1830 nana=count(llana)
1831
1832
1833 allocate(anaind(nana))
1834
1835 j=0
1836 do i=1,size(this%ana)
1837 if (llana(i)) then
1838 j=j+1
1839 anaind(j)=i
1840 end if
1841 end do
1842
1843
1844 if(present(data_id)) then
1845 allocate(data_idtmp(nana,size(data_id,2),size(data_id,3),size(data_id,4),size(data_id,5)))
1846 data_idtmp=data_id(anaind,:,:,:,:)
1847 if (associated(data_id))deallocate(data_id)
1848 data_id=>data_idtmp
1849 end if
1850
1851 call vol7d_reform(this,miss=miss,lana=llana)
1852
1853 deallocate(llana,anaind)
1854
1855else
1856
1857 call vol7d_reform(this,miss=miss)
1858
1859end if
1860
1861end subroutine qc_reform
1862
1863
1864SUBROUTINE keep_var(var)
1865TYPE(vol7d_var),intent(inout),POINTER :: var(:)
1866
1867INTEGER :: i
1868
1869IF (ASSOCIATED(var)) THEN
1870 if (size(var) == 0) then
1871 var%btable = vol7d_var_miss%btable
1872 else
1873 DO i = 1, SIZE(var)
1874 IF (all(var(i)%btable /= keep_attr(:))) THEN ! n.b. ALL((//)) = .TRUE.
1875 var(i)%btable = vol7d_var_miss%btable
1876 ENDIF
1877 ENDDO
1878 end if
1879ENDIF
1880
1881END SUBROUTINE keep_var
1882
1883SUBROUTINE delete_var(var)
1884TYPE(vol7d_var),intent(inout),POINTER :: var(:)
1885
1886INTEGER :: i
1887
1888IF (ASSOCIATED(var)) THEN
1889 if (size(var) == 0) then
1890 var%btable = vol7d_var_miss%btable
1891 else
1892 DO i = 1, SIZE(var)
1893 IF (any(var(i)%btable == delete_attr(:))) THEN ! n.b. ANY((//)) = .FALSE.
1894 var(i) = vol7d_var_miss
1895 ENDIF
1896 ENDDO
1897 end if
1898ENDIF
1899
1900END SUBROUTINE delete_var
1901
1902END SUBROUTINE vol7d_peeling
1903
1904
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 |