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