libsim Versione 7.2.6
|
◆ invalidatedc()
Data invalidated check.
Definizione alla linea 1264 del file modqc.F90. 1265! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1266! authors:
1267! Davide Cesari <dcesari@arpa.emr.it>
1268! Paolo Patruno <ppatruno@arpa.emr.it>
1269
1270! This program is free software; you can redistribute it and/or
1271! modify it under the terms of the GNU General Public License as
1272! published by the Free Software Foundation; either version 2 of
1273! the License, or (at your option) any later version.
1274
1275! This program is distributed in the hope that it will be useful,
1276! but WITHOUT ANY WARRANTY; without even the implied warranty of
1277! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1278! GNU General Public License for more details.
1279
1280! You should have received a copy of the GNU General Public License
1281! along with this program. If not, see <http://www.gnu.org/licenses/>.
1282#include "config.h"
1283!> \defgroup qc Libsim package, qc library.
1284!! Procedures for data quality control.
1285!! At the moment only climatological quality control is implemented
1286
1287!> Utilities and defines for quality control.
1288!!
1289!! Concise, high-value definitions of Data Quality by expert users,
1290!! analysts, implementers and journalists. This is a great starting point
1291!! to learn about Data Quality.
1292!!
1293!! Data Quality: The Accuracy Dimension
1294!!
1295!! "Data quality is defined as follows: data has quality if it satisfies
1296!! the requirements of its intended use. It lacks quality to the extent
1297!! that it does not satisfy the requirement. In other words, data quality
1298!! depends as much on the intended use as it does on the data itself. To
1299!! satisfy the intended use, the data must be accurate, timely, relevant,
1300!! complete, understood, and trusted." Jack E. Olson
1301!!
1302!! No Data Left Behind: Federal Student Aid - A Case History
1303!!
1304!! "Data quality institutionalizes a set of repeatable processes to
1305!! continuously monitor data and improve data accuracy, completeness,
1306!! timeliness and relevance." Holly Hyland and Lisa Elliott, Federal
1307!! Student Aid
1308!!
1309!! Data Quality: It's a Family Affair
1310!!
1311!! Data Quality definition: "The state of completeness, consistency,
1312!! timeliness and accuracy that makes data appropriate for a specific
1313!! use." Wim Helmer, Dun & Bradstreet
1314!!
1315!! Data Quality and Quality Management - Examples of Quality Evaluation
1316!! Procedures and Quality Management in European National Mapping
1317!! Agencies
1318!!
1319!! "Quality is defined as the totality of characteristics of a product
1320!! that bear on its ability to satisfy stated and implied needs (ISO
1321!! 8402, 1994). In the new ISO/DIS 9000:2000 standard (2000) the
1322!! definition of quality is: 'Ability of a set of inherent
1323!! characteristics of a product, system or process to fulfill
1324!! requirements of customers and other interested parties.' This
1325!! indicates that data quality and quality management are very closely
1326!! related. Data quality is part of the organisation's total quality
1327!! management." Antti Jakobsson
1328!!
1329!! text below from Wikipedia
1330!! http://it.wikipedia.org/wiki/Test_di_verifica_d%27ipotesi
1331!! http://creativecommons.org/licenses/by-sa/3.0/deed.it
1332!! L'ambito statistico
1333!!
1334!! Nel secondo caso la situazione è modificata in quanto interviene un
1335!! elemento nuovo, ovvero il caso. Si supponga di avere una moneta
1336!! recante due facce contrassegnate con testa e croce. Volendo verificare
1337!! l'ipotesi di bilanciamento della moneta si eseguono 20 lanci e si
1338!! contano quelli che danno esito testa. La conseguenza del bilanciamento
1339!! consiste nell'osservare un valore di teste attorno a 10. Tuttavia
1340!! anche in ipotesi di bilanciamento non si può escludere di osservare 20
1341!! teste. D'altronde, l'ipotesi di bilanciamento è logicamente
1342!! compatibile con un numero di teste variante da 0 a 20. In tale
1343!! contesto una qualsiasi decisione in merito all'ipotesi da verificare
1344!! comporta un rischio di errore. Ad esempio rigettare l'ipotesi di
1345!! bilanciamento della moneta avendo osservato 20 teste su 20 lanci
1346!! comporta il rischio di prendere una decisione errata. Nel procedere
1347!! alla verifica dell'ipotesi di bilanciamento della moneta, si ricorre a
1348!! una variabile casuale X. Tale variabile casuale X è una variabile
1349!! aleatoria discreta con distribuzione binomiale B(20; 0,5), dove 20
1350!! indica il numero di lanci e 0,5 la probabilità che si verifichi
1351!! l'evento "testa".
1352!!
1353!! Il risultato sperimentale si deve quindi confrontare con tale
1354!! distribuzione: quanto è distante tale risultato dal valore medio della
1355!! distribuzione B(20; 0,5)? Per rispondere alla domanda si deve
1356!! individuare un valore caratteristico della distribuzione B(20;
1357!! 0,5). Nel nostro caso tale valore caratteristico è il valore medio
1358!! 20/2 = 10. Per valutare la distanza tra il valore sperimentale e
1359!! quello atteso si valuta la probabilità di ottenere un valore
1360!! sperimentale lontano dal valore medio di B(20; 0,5), ossia nel caso
1361!! che dal nostro esperimento risulti X=15 (15 teste dopo 20 lanci), si
1362!! calcola P{|X-10|>=15-10} quindi P{X<=5 oppure X>=15}=0,041.
1363!!
1364!! Quindi, usando una moneta ben bilanciata, la probabilità di ottenere
1365!! un numero di teste X >= 15 (oppure X <= 5) dopo 20 lanci è pari a
1366!! 0,041 ossia al 4,1%. Giudicando bassa tale probabilità si rifiuterà
1367!! l'ipotesi di bilanciamento della moneta in esame, accettando quindi il
1368!! rischio del 4,1% di compiere un errore nel rifiutarla. Di solito, il
1369!! valore della probabilità adottato per rifiutare l'ipotesi nulla è <
1370!! 0,05. Tale valore è detto livello di significatività ed è definibile
1371!! come segue: il livello di significatività sotto l'ipotesi nulla è la
1372!! probabilità di cadere nella zona di rifiuto quando l'ipotesi nulla è
1373!! vera. Tale livello di significatività si indica convenzionalmente con
1374!! α. Il livello di significatività osservato α del test per il quale si
1375!! rifiuterebbe l'ipotesi nulla è detto valore-p (p-value). Riprendendo
1376!! l'esempio sopra riportato il valore-p è pari a 0,041. Adottando
1377!! nell'esempio α = 0,05, si rifiuterà l'ipotesi se
1378!! P{|X-10|>=x}<0,05. Tale condizione si raggiunge appunto se X<6 oppure
1379!! X>14. Tale insieme di valori si definisce convenzionalmente come
1380!! regione di rifiuto. Viceversa l'insieme { 6,7...14} si definisce regione
1381!! di accettazione. In questo modo si è costruita una regola di
1382!! comportamento per verificare l'ipotesi di bilanciamento della
1383!! moneta. Tale regola definisce il test statistico.
1384!!
1385!! In termini tecnici l'ipotesi da verificare si chiama ipotesi nulla e
1386!! si indica con H0, mentre l'ipotesi alternativa con H1. Nel caso della
1387!! moneta, se p è la probabilità di ottenere testa in un lancio la
1388!! verifica di ipotesi si traduce nel seguente sistema:
1389!!
1390!! H_0: p = \frac{1}{2}
1391!! H_1: p \ne \frac{1}{2}
1392!!
1393!! Come già osservato, il modo di condurre un test statistico comporta un
1394!! rischio di errore. Nella pratica statistica si individuano due tipi di
1395!! errori:
1396!!
1397!! 1. rifiutare H0 quando è vera, errore di primo tipo (α) (o errore di prima specie);
1398!! 2. accettare H0 quando è falsa, errore di secondo tipo (β) (o errore di seconda specie).
1399!!
1400!! Tornando all'esempio della moneta in cui la regione di accettazione è
1401!! data dall'insieme di valori {6..14}, la probabilità di rifiutare H0
1402!! quando è vera è stato calcolato pari a 0,041.Tale probabilità
1403!! rappresenta il rischio di incorrere in un errore di primo tipo e si
1404!! indica con α. Per valutare la probabilità di un errore di secondo tipo
1405!! è necessario specificare un valore di p in caso di verità di H1. Si
1406!! supponga che p=0,80, in tal caso la distribuzione di X è una
1407!! B(20;0,80)
1408!!
1409!! Con tale distribuzione di probabilità, l'errore di tipo 2 si calcola
1410!! sommando le probabilità relative ai valori di X della zona di
1411!! accettazione. Si trova quindi che la probabilità cercata è pari a
1412!! circa 0,20. Tale probabilità quantifica il rischio di incorrere
1413!! nell'errore di tipo 2. e si indica convenzionalmente con β. La
1414!! quantità 1-β si chiama potenza del test ed esprime quindi la capacità
1415!! di un test statistico riconoscere la falsità di H0 quando questa è
1416!! effettivamente falsa. La potenza del test trova applicazione nella
1417!! pratica statistica in fase di pianificazione di un esperimento.
1418!!
1419!!Scope of quality checks on observation values
1420!!Checks applied to determine the quality of an observation can range from the very simple to the
1421!!very complex. In roughly increasing order of complexity they can include:
1422!! * Syntactic checks (e.g. an air temperature must be a number to at most 1 decimal
1423!! place);
1424!! * Numeric ranges (e.g. the temperature must fall in the range -90 to +70);
1425!! * Climate range checks (i.e. is the datum consistent with climatology?)
1426!! * Intra-record consistency (e.g. the air temperature must not be less than the dew
1427!! point);
1428!! * Time-series consistency (e.g. the difference between two successive temperatures at
1429!! a site must be 'plausible'); and
1430!! * Spatial consistency (e.g. the station-dependent limits of plausible difference between
1431!! the temperatures at a station and its neighbours must not be violated).
1432!!\ingroup qc
1438
1439
1440implicit none
1441
1442
1443!> Definisce il livello di attendibilità per i dati validi
1445 integer (kind=int_b):: att !< confidence for "*B33192" "*B33193" "*B33194"
1446 integer (kind=int_b):: gross_error ! special valuer for "*B33192" when gross error check failed
1447 integer (kind=int_b):: invalidated ! special valuer for "*B33196" when manual invalidation happen
1449
1450!> Default: data with confidence less or equal 10 are rejected
1452
1453integer, parameter :: nqcattrvars=4
1454CHARACTER(len=10),parameter :: qcattrvarsbtables(nqcattrvars)=(/"*B33196","*B33192","*B33193","*B33194"/)
1455
1456type :: qcattrvars
1457 TYPE(vol7d_var) :: vars(nqcattrvars)
1458 CHARACTER(len=10) :: btables(nqcattrvars)
1459end type qcattrvars
1460
1461!> Variables user in Quality Control
1463 module procedure init_qcattrvars
1464end interface
1465
1466!> Remove data under a defined grade of confidence.
1468 module procedure peeledrb, peeleddb, peeledbb, peeledib, peeledcb &
1469 ,peeledri, peeleddi, peeledbi, peeledii, peeledci &
1470 ,peeledrr, peeleddr, peeledbr, peeledir, peeledcr &
1471 ,peeledrd, peeleddd, peeledbd, peeledid, peeledcd &
1472 ,peeledrc, peeleddc, peeledbc, peeledic, peeledcc
1473end interface
1474
1475
1476!> Check data validity based on single confidence
1478 module procedure vdi,vdb,vdr,vdd,vdc
1479end interface
1480
1481!> Check data validity based on gross error check
1483 module procedure vdgei,vdgeb,vdger,vdged,vdgec
1484end interface
1485
1486!> Test di dato invalidato
1488 module procedure invalidatedi,invalidatedb,invalidatedr,invalidatedd,invalidatedc
1489end interface
1490
1491private
1492
1494public qcattrvars, nqcattrvars, qcattrvarsbtables
1496
1497contains
1498
1499
1500! peeled routines
1501#undef VOL7D_POLY_SUBTYPE
1502#undef VOL7D_POLY_SUBTYPES
1503#undef VOL7D_POLY_ISC
1504#define VOL7D_POLY_SUBTYPE REAL
1505#define VOL7D_POLY_SUBTYPES r
1506
1507#undef VOL7D_POLY_TYPE
1508#undef VOL7D_POLY_TYPES
1509#undef VOL7D_POLY_ISC
1510#undef VOL7D_POLY_TYPES_SUBTYPES
1511#define VOL7D_POLY_TYPE REAL
1512#define VOL7D_POLY_TYPES r
1513#define VOL7D_POLY_TYPES_SUBTYPES rr
1514#include "modqc_peeled_include.F90"
1515#include "modqc_peel_util_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 dr
1522#include "modqc_peeled_include.F90"
1523#include "modqc_peel_util_include.F90"
1524#undef VOL7D_POLY_TYPE
1525#undef VOL7D_POLY_TYPES
1526#undef VOL7D_POLY_TYPES_SUBTYPES
1527#define VOL7D_POLY_TYPE INTEGER
1528#define VOL7D_POLY_TYPES i
1529#define VOL7D_POLY_TYPES_SUBTYPES ir
1530#include "modqc_peeled_include.F90"
1531#include "modqc_peel_util_include.F90"
1532#undef VOL7D_POLY_TYPE
1533#undef VOL7D_POLY_TYPES
1534#undef VOL7D_POLY_TYPES_SUBTYPES
1535#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1536#define VOL7D_POLY_TYPES b
1537#define VOL7D_POLY_TYPES_SUBTYPES br
1538#include "modqc_peeled_include.F90"
1539#include "modqc_peel_util_include.F90"
1540#undef VOL7D_POLY_TYPE
1541#undef VOL7D_POLY_TYPES
1542#undef VOL7D_POLY_TYPES_SUBTYPES
1543#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1544#define VOL7D_POLY_TYPES c
1545#define VOL7D_POLY_ISC = 1
1546#define VOL7D_POLY_TYPES_SUBTYPES cr
1547#include "modqc_peeled_include.F90"
1548#include "modqc_peel_util_include.F90"
1549
1550
1551#undef VOL7D_POLY_SUBTYPE
1552#undef VOL7D_POLY_SUBTYPES
1553#undef VOL7D_POLY_ISC
1554#define VOL7D_POLY_SUBTYPE DOUBLE PRECISION
1555#define VOL7D_POLY_SUBTYPES d
1556
1557#undef VOL7D_POLY_TYPE
1558#undef VOL7D_POLY_TYPES
1559#undef VOL7D_POLY_TYPES_SUBTYPES
1560#define VOL7D_POLY_TYPE REAL
1561#define VOL7D_POLY_TYPES r
1562#define VOL7D_POLY_TYPES_SUBTYPES rd
1563#include "modqc_peeled_include.F90"
1564#undef VOL7D_POLY_TYPE
1565#undef VOL7D_POLY_TYPES
1566#undef VOL7D_POLY_TYPES_SUBTYPES
1567#define VOL7D_POLY_TYPE DOUBLE PRECISION
1568#define VOL7D_POLY_TYPES d
1569#define VOL7D_POLY_TYPES_SUBTYPES dd
1570#include "modqc_peeled_include.F90"
1571#undef VOL7D_POLY_TYPE
1572#undef VOL7D_POLY_TYPES
1573#undef VOL7D_POLY_TYPES_SUBTYPES
1574#define VOL7D_POLY_TYPE INTEGER
1575#define VOL7D_POLY_TYPES i
1576#define VOL7D_POLY_TYPES_SUBTYPES id
1577#include "modqc_peeled_include.F90"
1578#undef VOL7D_POLY_TYPE
1579#undef VOL7D_POLY_TYPES
1580#undef VOL7D_POLY_TYPES_SUBTYPES
1581#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1582#define VOL7D_POLY_TYPES b
1583#define VOL7D_POLY_TYPES_SUBTYPES bd
1584#include "modqc_peeled_include.F90"
1585#undef VOL7D_POLY_TYPE
1586#undef VOL7D_POLY_TYPES
1587#undef VOL7D_POLY_TYPES_SUBTYPES
1588#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1589#define VOL7D_POLY_TYPES c
1590#define VOL7D_POLY_TYPES_SUBTYPES cd
1591#include "modqc_peeled_include.F90"
1592
1593
1594#undef VOL7D_POLY_SUBTYPE
1595#undef VOL7D_POLY_SUBTYPES
1596#undef VOL7D_POLY_ISC
1597#define VOL7D_POLY_SUBTYPE INTEGER
1598#define VOL7D_POLY_SUBTYPES i
1599
1600#undef VOL7D_POLY_TYPE
1601#undef VOL7D_POLY_TYPES
1602#undef VOL7D_POLY_TYPES_SUBTYPES
1603#define VOL7D_POLY_TYPE REAL
1604#define VOL7D_POLY_TYPES r
1605#define VOL7D_POLY_TYPES_SUBTYPES ri
1606#include "modqc_peeled_include.F90"
1607#undef VOL7D_POLY_TYPE
1608#undef VOL7D_POLY_TYPES
1609#undef VOL7D_POLY_TYPES_SUBTYPES
1610#define VOL7D_POLY_TYPE DOUBLE PRECISION
1611#define VOL7D_POLY_TYPES d
1612#define VOL7D_POLY_TYPES_SUBTYPES di
1613#include "modqc_peeled_include.F90"
1614#undef VOL7D_POLY_TYPE
1615#undef VOL7D_POLY_TYPES
1616#undef VOL7D_POLY_TYPES_SUBTYPES
1617#define VOL7D_POLY_TYPE INTEGER
1618#define VOL7D_POLY_TYPES i
1619#define VOL7D_POLY_TYPES_SUBTYPES ii
1620#include "modqc_peeled_include.F90"
1621#undef VOL7D_POLY_TYPE
1622#undef VOL7D_POLY_TYPES
1623#undef VOL7D_POLY_TYPES_SUBTYPES
1624#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1625#define VOL7D_POLY_TYPES b
1626#define VOL7D_POLY_TYPES_SUBTYPES bi
1627#include "modqc_peeled_include.F90"
1628#undef VOL7D_POLY_TYPE
1629#undef VOL7D_POLY_TYPES
1630#undef VOL7D_POLY_TYPES_SUBTYPES
1631#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1632#define VOL7D_POLY_TYPES c
1633#define VOL7D_POLY_ISC = 1
1634#define VOL7D_POLY_TYPES_SUBTYPES ci
1635#include "modqc_peeled_include.F90"
1636
1637
1638#undef VOL7D_POLY_SUBTYPE
1639#undef VOL7D_POLY_SUBTYPES
1640#undef VOL7D_POLY_ISC
1641#define VOL7D_POLY_SUBTYPE INTEGER(kind=int_b)
1642#define VOL7D_POLY_SUBTYPES b
1643
1644#undef VOL7D_POLY_TYPE
1645#undef VOL7D_POLY_TYPES
1646#undef VOL7D_POLY_TYPES_SUBTYPES
1647#define VOL7D_POLY_TYPE REAL
1648#define VOL7D_POLY_TYPES r
1649#define VOL7D_POLY_TYPES_SUBTYPES rb
1650#include "modqc_peeled_include.F90"
1651#undef VOL7D_POLY_TYPE
1652#undef VOL7D_POLY_TYPES
1653#undef VOL7D_POLY_TYPES_SUBTYPES
1654#define VOL7D_POLY_TYPE DOUBLE PRECISION
1655#define VOL7D_POLY_TYPES d
1656#define VOL7D_POLY_TYPES_SUBTYPES db
1657#include "modqc_peeled_include.F90"
1658#undef VOL7D_POLY_TYPE
1659#undef VOL7D_POLY_TYPES
1660#undef VOL7D_POLY_TYPES_SUBTYPES
1661#define VOL7D_POLY_TYPE INTEGER
1662#define VOL7D_POLY_TYPES i
1663#define VOL7D_POLY_TYPES_SUBTYPES ib
1664#include "modqc_peeled_include.F90"
1665#undef VOL7D_POLY_TYPE
1666#undef VOL7D_POLY_TYPES
1667#undef VOL7D_POLY_TYPES_SUBTYPES
1668#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1669#define VOL7D_POLY_TYPES b
1670#define VOL7D_POLY_TYPES_SUBTYPES bb
1671#include "modqc_peeled_include.F90"
1672#undef VOL7D_POLY_TYPE
1673#undef VOL7D_POLY_TYPES
1674#undef VOL7D_POLY_TYPES_SUBTYPES
1675#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1676#define VOL7D_POLY_TYPES c
1677#define VOL7D_POLY_ISC = 1
1678#define VOL7D_POLY_TYPES_SUBTYPES cb
1679#include "modqc_peeled_include.F90"
1680
1681
1682#undef VOL7D_POLY_SUBTYPE
1683#undef VOL7D_POLY_SUBTYPES
1684#undef VOL7D_POLY_ISC
1685#define VOL7D_POLY_SUBTYPE CHARACTER(len=vol7d_cdatalen)
1686#define VOL7D_POLY_SUBTYPES c
1687
1688#undef VOL7D_POLY_TYPE
1689#undef VOL7D_POLY_TYPES
1690#undef VOL7D_POLY_TYPES_SUBTYPES
1691#define VOL7D_POLY_TYPE REAL
1692#define VOL7D_POLY_TYPES r
1693#define VOL7D_POLY_TYPES_SUBTYPES rc
1694#include "modqc_peeled_include.F90"
1695#undef VOL7D_POLY_TYPE
1696#undef VOL7D_POLY_TYPES
1697#undef VOL7D_POLY_TYPES_SUBTYPES
1698#define VOL7D_POLY_TYPE DOUBLE PRECISION
1699#define VOL7D_POLY_TYPES d
1700#define VOL7D_POLY_TYPES_SUBTYPES dc
1701#include "modqc_peeled_include.F90"
1702#undef VOL7D_POLY_TYPE
1703#undef VOL7D_POLY_TYPES
1704#undef VOL7D_POLY_TYPES_SUBTYPES
1705#define VOL7D_POLY_TYPE INTEGER
1706#define VOL7D_POLY_TYPES i
1707#define VOL7D_POLY_TYPES_SUBTYPES ic
1708#include "modqc_peeled_include.F90"
1709#undef VOL7D_POLY_TYPE
1710#undef VOL7D_POLY_TYPES
1711#undef VOL7D_POLY_TYPES_SUBTYPES
1712#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1713#define VOL7D_POLY_TYPES b
1714#define VOL7D_POLY_TYPES_SUBTYPES bc
1715#include "modqc_peeled_include.F90"
1716#undef VOL7D_POLY_TYPE
1717#undef VOL7D_POLY_TYPES
1718#undef VOL7D_POLY_TYPES_SUBTYPES
1719#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1720#define VOL7D_POLY_TYPES c
1721#define VOL7D_POLY_ISC = 1
1722#define VOL7D_POLY_TYPES_SUBTYPES cc
1723#include "modqc_peeled_include.F90"
1724
1725
1726subroutine init_qcattrvars(this)
1727
1728type(qcattrvars),intent(inout) :: this
1729integer :: i
1730
1731this%btables(:) =qcattrvarsbtables
1732do i =1, nqcattrvars
1734end do
1735
1736end subroutine init_qcattrvars
1737
1738
1739type(qcattrvars) function qcattrvars_new()
1740
1742
1743end function qcattrvars_new
1744
1745
1746!> Remove data under the predefined grade of confidence.
1747!! If neither \a keep_attr nor \a delete_attr are passed, all the
1748!! attributes will be deleted after peeling; if \a keep_attr is
1749!! provided, only attributed listed in \a keep_attr will be kept in
1750!! output, (\a delete_attr will be ignored); if \a delete_attr is
1751!! provided, attributed listed in \a delete_attr will be deleted from
1752!! output.
1753SUBROUTINE vol7d_peeling(this, data_id, keep_attr, delete_attr, preserve, purgeana)
1754TYPE(vol7d),INTENT(INOUT) :: this !< object that has to be peeled
1755integer,INTENT(inout),pointer,OPTIONAL :: data_id(:,:,:,:,:) !< data ID to use with dballe DB (for fast write of attributes)
1756CHARACTER(len=*),INTENT(in),OPTIONAL :: keep_attr(:) !< Btable of attributes that should be kept after removing data
1757CHARACTER(len=*),INTENT(in),OPTIONAL :: delete_attr(:) !< Btable of attributes that should be deleted after removing data
1758logical,intent(in),optional :: preserve !< preserve all attributes if true (alternative to keep_attr and delete_attr)
1759logical,intent(in),optional :: purgeana !< if true remove ana with all data missing
1760
1761integer :: inddativar,inddatiattrinv,inddatiattrcli,inddatiattrtem,inddatiattrspa,inddativarattr
1762type(qcattrvars) :: attrvars
1763
1764INTEGER(kind=int_b),pointer :: invbb(:,:,:,:,:),clibb(:,:,:,:,:),tembb(:,:,:,:,:),spabb(:,:,:,:,:)
1765INTEGER,pointer :: invbi(:,:,:,:,:),clibi(:,:,:,:,:),tembi(:,:,:,:,:),spabi(:,:,:,:,:)
1766REAL,pointer :: invbr(:,:,:,:,:),clibr(:,:,:,:,:),tembr(:,:,:,:,:),spabr(:,:,:,:,:)
1767DOUBLE PRECISION,pointer :: invbd(:,:,:,:,:),clibd(:,:,:,:,:),tembd(:,:,:,:,:),spabd(:,:,:,:,:)
1768CHARACTER(len=vol7d_cdatalen),pointer :: invbc(:,:,:,:,:),clibc(:,:,:,:,:),tembc(:,:,:,:,:),spabc(:,:,:,:,:)
1769
1770call l4f_log(l4f_info,'starting peeling')
1771
1773
1774! generate code per i vari tipi di dati di v7d
1775! tramite un template e il preprocessore
1776
1777
1778#undef VOL7D_POLY_SUBTYPE
1779#undef VOL7D_POLY_SUBTYPES
1780#define VOL7D_POLY_SUBTYPE REAL
1781#define VOL7D_POLY_SUBTYPES r
1782
1783#undef VOL7D_POLY_TYPE
1784#undef VOL7D_POLY_TYPES
1785#define VOL7D_POLY_TYPE REAL
1786#define VOL7D_POLY_TYPES r
1787#include "modqc_peeling_include.F90"
1788#undef VOL7D_POLY_TYPE
1789#undef VOL7D_POLY_TYPES
1790#define VOL7D_POLY_TYPE DOUBLE PRECISION
1791#define VOL7D_POLY_TYPES d
1792#include "modqc_peeling_include.F90"
1793#undef VOL7D_POLY_TYPE
1794#undef VOL7D_POLY_TYPES
1795#define VOL7D_POLY_TYPE INTEGER
1796#define VOL7D_POLY_TYPES i
1797#include "modqc_peeling_include.F90"
1798#undef VOL7D_POLY_TYPE
1799#undef VOL7D_POLY_TYPES
1800#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1801#define VOL7D_POLY_TYPES b
1802#include "modqc_peeling_include.F90"
1803#undef VOL7D_POLY_TYPE
1804#undef VOL7D_POLY_TYPES
1805#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1806#define VOL7D_POLY_TYPES c
1807#include "modqc_peeling_include.F90"
1808
1809
1810#undef VOL7D_POLY_SUBTYPE
1811#undef VOL7D_POLY_SUBTYPES
1812#define VOL7D_POLY_SUBTYPE DOUBLE PRECISION
1813#define VOL7D_POLY_SUBTYPES d
1814
1815#undef VOL7D_POLY_TYPE
1816#undef VOL7D_POLY_TYPES
1817#define VOL7D_POLY_TYPE REAL
1818#define VOL7D_POLY_TYPES r
1819#include "modqc_peeling_include.F90"
1820#undef VOL7D_POLY_TYPE
1821#undef VOL7D_POLY_TYPES
1822#define VOL7D_POLY_TYPE DOUBLE PRECISION
1823#define VOL7D_POLY_TYPES d
1824#include "modqc_peeling_include.F90"
1825#undef VOL7D_POLY_TYPE
1826#undef VOL7D_POLY_TYPES
1827#define VOL7D_POLY_TYPE INTEGER
1828#define VOL7D_POLY_TYPES i
1829#include "modqc_peeling_include.F90"
1830#undef VOL7D_POLY_TYPE
1831#undef VOL7D_POLY_TYPES
1832#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1833#define VOL7D_POLY_TYPES b
1834#include "modqc_peeling_include.F90"
1835#undef VOL7D_POLY_TYPE
1836#undef VOL7D_POLY_TYPES
1837#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1838#define VOL7D_POLY_TYPES c
1839#include "modqc_peeling_include.F90"
1840
1841
1842#undef VOL7D_POLY_SUBTYPE
1843#undef VOL7D_POLY_SUBTYPES
1844#define VOL7D_POLY_SUBTYPE INTEGER
1845#define VOL7D_POLY_SUBTYPES i
1846
1847#undef VOL7D_POLY_TYPE
1848#undef VOL7D_POLY_TYPES
1849#define VOL7D_POLY_TYPE REAL
1850#define VOL7D_POLY_TYPES r
1851#include "modqc_peeling_include.F90"
1852#undef VOL7D_POLY_TYPE
1853#undef VOL7D_POLY_TYPES
1854#define VOL7D_POLY_TYPE DOUBLE PRECISION
1855#define VOL7D_POLY_TYPES d
1856#include "modqc_peeling_include.F90"
1857#undef VOL7D_POLY_TYPE
1858#undef VOL7D_POLY_TYPES
1859#define VOL7D_POLY_TYPE INTEGER
1860#define VOL7D_POLY_TYPES i
1861#include "modqc_peeling_include.F90"
1862#undef VOL7D_POLY_TYPE
1863#undef VOL7D_POLY_TYPES
1864#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1865#define VOL7D_POLY_TYPES b
1866#include "modqc_peeling_include.F90"
1867#undef VOL7D_POLY_TYPE
1868#undef VOL7D_POLY_TYPES
1869#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1870#define VOL7D_POLY_TYPES c
1871#include "modqc_peeling_include.F90"
1872
1873
1874#undef VOL7D_POLY_SUBTYPE
1875#undef VOL7D_POLY_SUBTYPES
1876#define VOL7D_POLY_SUBTYPE INTEGER(kind=int_b)
1877#define VOL7D_POLY_SUBTYPES b
1878
1879#undef VOL7D_POLY_TYPE
1880#undef VOL7D_POLY_TYPES
1881#define VOL7D_POLY_TYPE REAL
1882#define VOL7D_POLY_TYPES r
1883#include "modqc_peeling_include.F90"
1884#undef VOL7D_POLY_TYPE
1885#undef VOL7D_POLY_TYPES
1886#define VOL7D_POLY_TYPE DOUBLE PRECISION
1887#define VOL7D_POLY_TYPES d
1888#include "modqc_peeling_include.F90"
1889#undef VOL7D_POLY_TYPE
1890#undef VOL7D_POLY_TYPES
1891#define VOL7D_POLY_TYPE INTEGER
1892#define VOL7D_POLY_TYPES i
1893#include "modqc_peeling_include.F90"
1894#undef VOL7D_POLY_TYPE
1895#undef VOL7D_POLY_TYPES
1896#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1897#define VOL7D_POLY_TYPES b
1898#include "modqc_peeling_include.F90"
1899#undef VOL7D_POLY_TYPE
1900#undef VOL7D_POLY_TYPES
1901#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1902#define VOL7D_POLY_TYPES c
1903#include "modqc_peeling_include.F90"
1904
1905
1906
1907#undef VOL7D_POLY_SUBTYPE
1908#undef VOL7D_POLY_SUBTYPES
1909#define VOL7D_POLY_SUBTYPE CHARACTER(len=vol7d_cdatalen)
1910#define VOL7D_POLY_SUBTYPES c
1911
1912#undef VOL7D_POLY_TYPE
1913#undef VOL7D_POLY_TYPES
1914#define VOL7D_POLY_TYPE REAL
1915#define VOL7D_POLY_TYPES r
1916#include "modqc_peeling_include.F90"
1917#undef VOL7D_POLY_TYPE
1918#undef VOL7D_POLY_TYPES
1919#define VOL7D_POLY_TYPE DOUBLE PRECISION
1920#define VOL7D_POLY_TYPES d
1921#include "modqc_peeling_include.F90"
1922#undef VOL7D_POLY_TYPE
1923#undef VOL7D_POLY_TYPES
1924#define VOL7D_POLY_TYPE INTEGER
1925#define VOL7D_POLY_TYPES i
1926#include "modqc_peeling_include.F90"
1927#undef VOL7D_POLY_TYPE
1928#undef VOL7D_POLY_TYPES
1929#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
1930#define VOL7D_POLY_TYPES b
1931#include "modqc_peeling_include.F90"
1932#undef VOL7D_POLY_TYPE
1933#undef VOL7D_POLY_TYPES
1934#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
1935#define VOL7D_POLY_TYPES c
1936#include "modqc_peeling_include.F90"
1937
1938
1939
1940IF (.NOT.PRESENT(keep_attr) .AND. .NOT.PRESENT(delete_attr) .and. .not. optio_log(preserve)) THEN ! destroy all attributes
1941 IF (ASSOCIATED(this%voldatiattrr)) DEALLOCATE(this%voldatiattrr)
1942 IF (ASSOCIATED(this%voldatiattrd)) DEALLOCATE(this%voldatiattrd)
1943 IF (ASSOCIATED(this%voldatiattri)) DEALLOCATE(this%voldatiattri)
1944 IF (ASSOCIATED(this%voldatiattrb)) DEALLOCATE(this%voldatiattrb)
1945 IF (ASSOCIATED(this%voldatiattrc)) DEALLOCATE(this%voldatiattrc)
1946
1947 CALL delete(this%datiattr)
1948 CALL delete(this%dativarattr)
1949END IF
1950
1951IF (PRESENT(keep_attr)) THEN ! set to missing non requested attributes and reform
1952
1953 if (optio_log(preserve)) call l4f_log(l4f_warn,"preserve parameter ignored: keep_attr passed")
1954 CALL keep_var(this%datiattr%r)
1955 CALL keep_var(this%datiattr%d)
1956 CALL keep_var(this%datiattr%i)
1957 CALL keep_var(this%datiattr%b)
1958 CALL keep_var(this%datiattr%c)
1959 CALL qc_reform(this,data_id, miss=.true., purgeana=purgeana)
1960
1961ELSE IF (PRESENT(delete_attr)) THEN ! set to missing requested attributes and reform
1962
1963 if (optio_log(preserve)) call l4f_log(l4f_warn,"preserve parameter ignored: delete_attr passed")
1964 CALL delete_var(this%datiattr%r)
1965 CALL delete_var(this%datiattr%d)
1966 CALL delete_var(this%datiattr%i)
1967 CALL delete_var(this%datiattr%b)
1968 CALL delete_var(this%datiattr%c)
1969 CALL qc_reform(this,data_id, miss=.true., purgeana=purgeana)
1970
1971ELSE IF (PRESENT(purgeana)) THEN
1972
1973 CALL qc_reform(this,data_id, purgeana=purgeana)
1974
1975ENDIF
1976
1977
1978CONTAINS
1979
1980
1981!> Like vol7d_reform but manage data_id and have less options
1982subroutine qc_reform(this,data_id,miss, purgeana)
1983TYPE(vol7d),INTENT(INOUT) :: this !< object that has to be reformed
1984integer,INTENT(inout),pointer,OPTIONAL :: data_id(:,:,:,:,:) !< data ID to use with dballe DB (for fast write of attributes)
1985logical,intent(in),optional :: miss !< remove everithing related with missing position in description vector
1986logical,intent(in),optional :: purgeana !< if true remove ana with all data missing
1987
1988integer,pointer :: data_idtmp(:,:,:,:,:)
1989logical,allocatable :: llana(:)
1990integer,allocatable :: anaind(:)
1991integer :: i,j,nana
1992
1993if (optio_log(purgeana)) then
1994 allocate(llana(size(this%ana)))
1995 llana =.false.
1996 do i =1,size(this%ana)
1997 if (associated(this%voldatii)) llana(i)= llana(i) .or. any(c_e(this%voldatii(i,:,:,:,:,:)))
1998 if (associated(this%voldatir)) llana(i)= llana(i) .or. any(c_e(this%voldatir(i,:,:,:,:,:)))
1999 if (associated(this%voldatid)) llana(i)= llana(i) .or. any(c_e(this%voldatid(i,:,:,:,:,:)))
2000 if (associated(this%voldatib)) llana(i)= llana(i) .or. any(c_e(this%voldatib(i,:,:,:,:,:)))
2001 if (associated(this%voldatic)) llana(i)= llana(i) .or. any(c_e(this%voldatic(i,:,:,:,:,:)))
2002
2003#ifdef DEBUG
2004 if (.not. llana(i)) call l4f_log(l4f_debug,"remove station"//t2c(i))
2005#endif
2006
2007 end do
2008
2009 nana=count(llana)
2010
2011
2012 allocate(anaind(nana))
2013
2014 j=0
2015 do i=1,size(this%ana)
2016 if (llana(i)) then
2017 j=j+1
2018 anaind(j)=i
2019 end if
2020 end do
2021
2022
2023 if(present(data_id)) then
2024 allocate(data_idtmp(nana,size(data_id,2),size(data_id,3),size(data_id,4),size(data_id,5)))
2025 data_idtmp=data_id(anaind,:,:,:,:)
2026 if (associated(data_id))deallocate(data_id)
2027 data_id=>data_idtmp
2028 end if
2029
2030 call vol7d_reform(this,miss=miss,lana=llana)
2031
2032 deallocate(llana,anaind)
2033
2034else
2035
2036 call vol7d_reform(this,miss=miss)
2037
2038end if
2039
2040end subroutine qc_reform
2041
2042
2043SUBROUTINE keep_var(var)
2044TYPE(vol7d_var),intent(inout),POINTER :: var(:)
2045
2046INTEGER :: i
2047
2048IF (ASSOCIATED(var)) THEN
2049 if (size(var) == 0) then
2050 var%btable = vol7d_var_miss%btable
2051 else
2052 DO i = 1, SIZE(var)
2053 IF (all(var(i)%btable /= keep_attr(:))) THEN ! n.b. ALL((//)) = .TRUE.
2054 var(i)%btable = vol7d_var_miss%btable
2055 ENDIF
2056 ENDDO
2057 end if
2058ENDIF
2059
2060END SUBROUTINE keep_var
2061
2062SUBROUTINE delete_var(var)
2063TYPE(vol7d_var),intent(inout),POINTER :: var(:)
2064
2065INTEGER :: i
2066
2067IF (ASSOCIATED(var)) THEN
2068 if (size(var) == 0) then
2069 var%btable = vol7d_var_miss%btable
2070 else
2071 DO i = 1, SIZE(var)
2072 IF (any(var(i)%btable == delete_attr(:))) THEN ! n.b. ANY((//)) = .FALSE.
2073 var(i) = vol7d_var_miss
2074 ENDIF
2075 ENDDO
2076 end if
2077ENDIF
2078
2079END SUBROUTINE delete_var
2080
2081END SUBROUTINE vol7d_peeling
2082
2083
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 |