libsim Versione 7.2.6
|
◆ vol7d_peeling()
Remove data under the predefined grade of confidence. If neither keep_attr nor delete_attr are passed, all the attributes will be deleted after peeling; if keep_attr is provided, only attributed listed in keep_attr will be kept in output, (delete_attr will be ignored); if delete_attr is provided, attributed listed in delete_attr will be deleted from output.
Definizione alla linea 2865 del file modqc.F90. 2866! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2867! authors:
2868! Davide Cesari <dcesari@arpa.emr.it>
2869! Paolo Patruno <ppatruno@arpa.emr.it>
2870
2871! This program is free software; you can redistribute it and/or
2872! modify it under the terms of the GNU General Public License as
2873! published by the Free Software Foundation; either version 2 of
2874! the License, or (at your option) any later version.
2875
2876! This program is distributed in the hope that it will be useful,
2877! but WITHOUT ANY WARRANTY; without even the implied warranty of
2878! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2879! GNU General Public License for more details.
2880
2881! You should have received a copy of the GNU General Public License
2882! along with this program. If not, see <http://www.gnu.org/licenses/>.
2883#include "config.h"
2884!> \defgroup qc Libsim package, qc library.
2885!! Procedures for data quality control.
2886!! At the moment only climatological quality control is implemented
2887
2888!> Utilities and defines for quality control.
2889!!
2890!! Concise, high-value definitions of Data Quality by expert users,
2891!! analysts, implementers and journalists. This is a great starting point
2892!! to learn about Data Quality.
2893!!
2894!! Data Quality: The Accuracy Dimension
2895!!
2896!! "Data quality is defined as follows: data has quality if it satisfies
2897!! the requirements of its intended use. It lacks quality to the extent
2898!! that it does not satisfy the requirement. In other words, data quality
2899!! depends as much on the intended use as it does on the data itself. To
2900!! satisfy the intended use, the data must be accurate, timely, relevant,
2901!! complete, understood, and trusted." Jack E. Olson
2902!!
2903!! No Data Left Behind: Federal Student Aid - A Case History
2904!!
2905!! "Data quality institutionalizes a set of repeatable processes to
2906!! continuously monitor data and improve data accuracy, completeness,
2907!! timeliness and relevance." Holly Hyland and Lisa Elliott, Federal
2908!! Student Aid
2909!!
2910!! Data Quality: It's a Family Affair
2911!!
2912!! Data Quality definition: "The state of completeness, consistency,
2913!! timeliness and accuracy that makes data appropriate for a specific
2914!! use." Wim Helmer, Dun & Bradstreet
2915!!
2916!! Data Quality and Quality Management - Examples of Quality Evaluation
2917!! Procedures and Quality Management in European National Mapping
2918!! Agencies
2919!!
2920!! "Quality is defined as the totality of characteristics of a product
2921!! that bear on its ability to satisfy stated and implied needs (ISO
2922!! 8402, 1994). In the new ISO/DIS 9000:2000 standard (2000) the
2923!! definition of quality is: 'Ability of a set of inherent
2924!! characteristics of a product, system or process to fulfill
2925!! requirements of customers and other interested parties.' This
2926!! indicates that data quality and quality management are very closely
2927!! related. Data quality is part of the organisation's total quality
2928!! management." Antti Jakobsson
2929!!
2930!! text below from Wikipedia
2931!! http://it.wikipedia.org/wiki/Test_di_verifica_d%27ipotesi
2932!! http://creativecommons.org/licenses/by-sa/3.0/deed.it
2933!! L'ambito statistico
2934!!
2935!! Nel secondo caso la situazione è modificata in quanto interviene un
2936!! elemento nuovo, ovvero il caso. Si supponga di avere una moneta
2937!! recante due facce contrassegnate con testa e croce. Volendo verificare
2938!! l'ipotesi di bilanciamento della moneta si eseguono 20 lanci e si
2939!! contano quelli che danno esito testa. La conseguenza del bilanciamento
2940!! consiste nell'osservare un valore di teste attorno a 10. Tuttavia
2941!! anche in ipotesi di bilanciamento non si può escludere di osservare 20
2942!! teste. D'altronde, l'ipotesi di bilanciamento è logicamente
2943!! compatibile con un numero di teste variante da 0 a 20. In tale
2944!! contesto una qualsiasi decisione in merito all'ipotesi da verificare
2945!! comporta un rischio di errore. Ad esempio rigettare l'ipotesi di
2946!! bilanciamento della moneta avendo osservato 20 teste su 20 lanci
2947!! comporta il rischio di prendere una decisione errata. Nel procedere
2948!! alla verifica dell'ipotesi di bilanciamento della moneta, si ricorre a
2949!! una variabile casuale X. Tale variabile casuale X è una variabile
2950!! aleatoria discreta con distribuzione binomiale B(20; 0,5), dove 20
2951!! indica il numero di lanci e 0,5 la probabilità che si verifichi
2952!! l'evento "testa".
2953!!
2954!! Il risultato sperimentale si deve quindi confrontare con tale
2955!! distribuzione: quanto è distante tale risultato dal valore medio della
2956!! distribuzione B(20; 0,5)? Per rispondere alla domanda si deve
2957!! individuare un valore caratteristico della distribuzione B(20;
2958!! 0,5). Nel nostro caso tale valore caratteristico è il valore medio
2959!! 20/2 = 10. Per valutare la distanza tra il valore sperimentale e
2960!! quello atteso si valuta la probabilità di ottenere un valore
2961!! sperimentale lontano dal valore medio di B(20; 0,5), ossia nel caso
2962!! che dal nostro esperimento risulti X=15 (15 teste dopo 20 lanci), si
2963!! calcola P{|X-10|>=15-10} quindi P{X<=5 oppure X>=15}=0,041.
2964!!
2965!! Quindi, usando una moneta ben bilanciata, la probabilità di ottenere
2966!! un numero di teste X >= 15 (oppure X <= 5) dopo 20 lanci è pari a
2967!! 0,041 ossia al 4,1%. Giudicando bassa tale probabilità si rifiuterà
2968!! l'ipotesi di bilanciamento della moneta in esame, accettando quindi il
2969!! rischio del 4,1% di compiere un errore nel rifiutarla. Di solito, il
2970!! valore della probabilità adottato per rifiutare l'ipotesi nulla è <
2971!! 0,05. Tale valore è detto livello di significatività ed è definibile
2972!! come segue: il livello di significatività sotto l'ipotesi nulla è la
2973!! probabilità di cadere nella zona di rifiuto quando l'ipotesi nulla è
2974!! vera. Tale livello di significatività si indica convenzionalmente con
2975!! α. Il livello di significatività osservato α del test per il quale si
2976!! rifiuterebbe l'ipotesi nulla è detto valore-p (p-value). Riprendendo
2977!! l'esempio sopra riportato il valore-p è pari a 0,041. Adottando
2978!! nell'esempio α = 0,05, si rifiuterà l'ipotesi se
2979!! P{|X-10|>=x}<0,05. Tale condizione si raggiunge appunto se X<6 oppure
2980!! X>14. Tale insieme di valori si definisce convenzionalmente come
2981!! regione di rifiuto. Viceversa l'insieme { 6,7...14} si definisce regione
2982!! di accettazione. In questo modo si è costruita una regola di
2983!! comportamento per verificare l'ipotesi di bilanciamento della
2984!! moneta. Tale regola definisce il test statistico.
2985!!
2986!! In termini tecnici l'ipotesi da verificare si chiama ipotesi nulla e
2987!! si indica con H0, mentre l'ipotesi alternativa con H1. Nel caso della
2988!! moneta, se p è la probabilità di ottenere testa in un lancio la
2989!! verifica di ipotesi si traduce nel seguente sistema:
2990!!
2991!! H_0: p = \frac{1}{2}
2992!! H_1: p \ne \frac{1}{2}
2993!!
2994!! Come già osservato, il modo di condurre un test statistico comporta un
2995!! rischio di errore. Nella pratica statistica si individuano due tipi di
2996!! errori:
2997!!
2998!! 1. rifiutare H0 quando è vera, errore di primo tipo (α) (o errore di prima specie);
2999!! 2. accettare H0 quando è falsa, errore di secondo tipo (β) (o errore di seconda specie).
3000!!
3001!! Tornando all'esempio della moneta in cui la regione di accettazione è
3002!! data dall'insieme di valori {6..14}, la probabilità di rifiutare H0
3003!! quando è vera è stato calcolato pari a 0,041.Tale probabilità
3004!! rappresenta il rischio di incorrere in un errore di primo tipo e si
3005!! indica con α. Per valutare la probabilità di un errore di secondo tipo
3006!! è necessario specificare un valore di p in caso di verità di H1. Si
3007!! supponga che p=0,80, in tal caso la distribuzione di X è una
3008!! B(20;0,80)
3009!!
3010!! Con tale distribuzione di probabilità, l'errore di tipo 2 si calcola
3011!! sommando le probabilità relative ai valori di X della zona di
3012!! accettazione. Si trova quindi che la probabilità cercata è pari a
3013!! circa 0,20. Tale probabilità quantifica il rischio di incorrere
3014!! nell'errore di tipo 2. e si indica convenzionalmente con β. La
3015!! quantità 1-β si chiama potenza del test ed esprime quindi la capacità
3016!! di un test statistico riconoscere la falsità di H0 quando questa è
3017!! effettivamente falsa. La potenza del test trova applicazione nella
3018!! pratica statistica in fase di pianificazione di un esperimento.
3019!!
3020!!Scope of quality checks on observation values
3021!!Checks applied to determine the quality of an observation can range from the very simple to the
3022!!very complex. In roughly increasing order of complexity they can include:
3023!! * Syntactic checks (e.g. an air temperature must be a number to at most 1 decimal
3024!! place);
3025!! * Numeric ranges (e.g. the temperature must fall in the range -90 to +70);
3026!! * Climate range checks (i.e. is the datum consistent with climatology?)
3027!! * Intra-record consistency (e.g. the air temperature must not be less than the dew
3028!! point);
3029!! * Time-series consistency (e.g. the difference between two successive temperatures at
3030!! a site must be 'plausible'); and
3031!! * Spatial consistency (e.g. the station-dependent limits of plausible difference between
3032!! the temperatures at a station and its neighbours must not be violated).
3033!!\ingroup qc
3039
3040
3041implicit none
3042
3043
3044!> Definisce il livello di attendibilità per i dati validi
3046 integer (kind=int_b):: att !< confidence for "*B33192" "*B33193" "*B33194"
3047 integer (kind=int_b):: gross_error ! special valuer for "*B33192" when gross error check failed
3048 integer (kind=int_b):: invalidated ! special valuer for "*B33196" when manual invalidation happen
3050
3051!> Default: data with confidence less or equal 10 are rejected
3053
3054integer, parameter :: nqcattrvars=4
3055CHARACTER(len=10),parameter :: qcattrvarsbtables(nqcattrvars)=(/"*B33196","*B33192","*B33193","*B33194"/)
3056
3057type :: qcattrvars
3058 TYPE(vol7d_var) :: vars(nqcattrvars)
3059 CHARACTER(len=10) :: btables(nqcattrvars)
3060end type qcattrvars
3061
3062!> Variables user in Quality Control
3064 module procedure init_qcattrvars
3065end interface
3066
3067!> Remove data under a defined grade of confidence.
3069 module procedure peeledrb, peeleddb, peeledbb, peeledib, peeledcb &
3070 ,peeledri, peeleddi, peeledbi, peeledii, peeledci &
3071 ,peeledrr, peeleddr, peeledbr, peeledir, peeledcr &
3072 ,peeledrd, peeleddd, peeledbd, peeledid, peeledcd &
3073 ,peeledrc, peeleddc, peeledbc, peeledic, peeledcc
3074end interface
3075
3076
3077!> Check data validity based on single confidence
3079 module procedure vdi,vdb,vdr,vdd,vdc
3080end interface
3081
3082!> Check data validity based on gross error check
3084 module procedure vdgei,vdgeb,vdger,vdged,vdgec
3085end interface
3086
3087!> Test di dato invalidato
3089 module procedure invalidatedi,invalidatedb,invalidatedr,invalidatedd,invalidatedc
3090end interface
3091
3092private
3093
3095public qcattrvars, nqcattrvars, qcattrvarsbtables
3097
3098contains
3099
3100
3101! peeled routines
3102#undef VOL7D_POLY_SUBTYPE
3103#undef VOL7D_POLY_SUBTYPES
3104#undef VOL7D_POLY_ISC
3105#define VOL7D_POLY_SUBTYPE REAL
3106#define VOL7D_POLY_SUBTYPES r
3107
3108#undef VOL7D_POLY_TYPE
3109#undef VOL7D_POLY_TYPES
3110#undef VOL7D_POLY_ISC
3111#undef VOL7D_POLY_TYPES_SUBTYPES
3112#define VOL7D_POLY_TYPE REAL
3113#define VOL7D_POLY_TYPES r
3114#define VOL7D_POLY_TYPES_SUBTYPES rr
3115#include "modqc_peeled_include.F90"
3116#include "modqc_peel_util_include.F90"
3117#undef VOL7D_POLY_TYPE
3118#undef VOL7D_POLY_TYPES
3119#undef VOL7D_POLY_TYPES_SUBTYPES
3120#define VOL7D_POLY_TYPE DOUBLE PRECISION
3121#define VOL7D_POLY_TYPES d
3122#define VOL7D_POLY_TYPES_SUBTYPES dr
3123#include "modqc_peeled_include.F90"
3124#include "modqc_peel_util_include.F90"
3125#undef VOL7D_POLY_TYPE
3126#undef VOL7D_POLY_TYPES
3127#undef VOL7D_POLY_TYPES_SUBTYPES
3128#define VOL7D_POLY_TYPE INTEGER
3129#define VOL7D_POLY_TYPES i
3130#define VOL7D_POLY_TYPES_SUBTYPES ir
3131#include "modqc_peeled_include.F90"
3132#include "modqc_peel_util_include.F90"
3133#undef VOL7D_POLY_TYPE
3134#undef VOL7D_POLY_TYPES
3135#undef VOL7D_POLY_TYPES_SUBTYPES
3136#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
3137#define VOL7D_POLY_TYPES b
3138#define VOL7D_POLY_TYPES_SUBTYPES br
3139#include "modqc_peeled_include.F90"
3140#include "modqc_peel_util_include.F90"
3141#undef VOL7D_POLY_TYPE
3142#undef VOL7D_POLY_TYPES
3143#undef VOL7D_POLY_TYPES_SUBTYPES
3144#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
3145#define VOL7D_POLY_TYPES c
3146#define VOL7D_POLY_ISC = 1
3147#define VOL7D_POLY_TYPES_SUBTYPES cr
3148#include "modqc_peeled_include.F90"
3149#include "modqc_peel_util_include.F90"
3150
3151
3152#undef VOL7D_POLY_SUBTYPE
3153#undef VOL7D_POLY_SUBTYPES
3154#undef VOL7D_POLY_ISC
3155#define VOL7D_POLY_SUBTYPE DOUBLE PRECISION
3156#define VOL7D_POLY_SUBTYPES d
3157
3158#undef VOL7D_POLY_TYPE
3159#undef VOL7D_POLY_TYPES
3160#undef VOL7D_POLY_TYPES_SUBTYPES
3161#define VOL7D_POLY_TYPE REAL
3162#define VOL7D_POLY_TYPES r
3163#define VOL7D_POLY_TYPES_SUBTYPES rd
3164#include "modqc_peeled_include.F90"
3165#undef VOL7D_POLY_TYPE
3166#undef VOL7D_POLY_TYPES
3167#undef VOL7D_POLY_TYPES_SUBTYPES
3168#define VOL7D_POLY_TYPE DOUBLE PRECISION
3169#define VOL7D_POLY_TYPES d
3170#define VOL7D_POLY_TYPES_SUBTYPES dd
3171#include "modqc_peeled_include.F90"
3172#undef VOL7D_POLY_TYPE
3173#undef VOL7D_POLY_TYPES
3174#undef VOL7D_POLY_TYPES_SUBTYPES
3175#define VOL7D_POLY_TYPE INTEGER
3176#define VOL7D_POLY_TYPES i
3177#define VOL7D_POLY_TYPES_SUBTYPES id
3178#include "modqc_peeled_include.F90"
3179#undef VOL7D_POLY_TYPE
3180#undef VOL7D_POLY_TYPES
3181#undef VOL7D_POLY_TYPES_SUBTYPES
3182#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
3183#define VOL7D_POLY_TYPES b
3184#define VOL7D_POLY_TYPES_SUBTYPES bd
3185#include "modqc_peeled_include.F90"
3186#undef VOL7D_POLY_TYPE
3187#undef VOL7D_POLY_TYPES
3188#undef VOL7D_POLY_TYPES_SUBTYPES
3189#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
3190#define VOL7D_POLY_TYPES c
3191#define VOL7D_POLY_TYPES_SUBTYPES cd
3192#include "modqc_peeled_include.F90"
3193
3194
3195#undef VOL7D_POLY_SUBTYPE
3196#undef VOL7D_POLY_SUBTYPES
3197#undef VOL7D_POLY_ISC
3198#define VOL7D_POLY_SUBTYPE INTEGER
3199#define VOL7D_POLY_SUBTYPES i
3200
3201#undef VOL7D_POLY_TYPE
3202#undef VOL7D_POLY_TYPES
3203#undef VOL7D_POLY_TYPES_SUBTYPES
3204#define VOL7D_POLY_TYPE REAL
3205#define VOL7D_POLY_TYPES r
3206#define VOL7D_POLY_TYPES_SUBTYPES ri
3207#include "modqc_peeled_include.F90"
3208#undef VOL7D_POLY_TYPE
3209#undef VOL7D_POLY_TYPES
3210#undef VOL7D_POLY_TYPES_SUBTYPES
3211#define VOL7D_POLY_TYPE DOUBLE PRECISION
3212#define VOL7D_POLY_TYPES d
3213#define VOL7D_POLY_TYPES_SUBTYPES di
3214#include "modqc_peeled_include.F90"
3215#undef VOL7D_POLY_TYPE
3216#undef VOL7D_POLY_TYPES
3217#undef VOL7D_POLY_TYPES_SUBTYPES
3218#define VOL7D_POLY_TYPE INTEGER
3219#define VOL7D_POLY_TYPES i
3220#define VOL7D_POLY_TYPES_SUBTYPES ii
3221#include "modqc_peeled_include.F90"
3222#undef VOL7D_POLY_TYPE
3223#undef VOL7D_POLY_TYPES
3224#undef VOL7D_POLY_TYPES_SUBTYPES
3225#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
3226#define VOL7D_POLY_TYPES b
3227#define VOL7D_POLY_TYPES_SUBTYPES bi
3228#include "modqc_peeled_include.F90"
3229#undef VOL7D_POLY_TYPE
3230#undef VOL7D_POLY_TYPES
3231#undef VOL7D_POLY_TYPES_SUBTYPES
3232#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
3233#define VOL7D_POLY_TYPES c
3234#define VOL7D_POLY_ISC = 1
3235#define VOL7D_POLY_TYPES_SUBTYPES ci
3236#include "modqc_peeled_include.F90"
3237
3238
3239#undef VOL7D_POLY_SUBTYPE
3240#undef VOL7D_POLY_SUBTYPES
3241#undef VOL7D_POLY_ISC
3242#define VOL7D_POLY_SUBTYPE INTEGER(kind=int_b)
3243#define VOL7D_POLY_SUBTYPES b
3244
3245#undef VOL7D_POLY_TYPE
3246#undef VOL7D_POLY_TYPES
3247#undef VOL7D_POLY_TYPES_SUBTYPES
3248#define VOL7D_POLY_TYPE REAL
3249#define VOL7D_POLY_TYPES r
3250#define VOL7D_POLY_TYPES_SUBTYPES rb
3251#include "modqc_peeled_include.F90"
3252#undef VOL7D_POLY_TYPE
3253#undef VOL7D_POLY_TYPES
3254#undef VOL7D_POLY_TYPES_SUBTYPES
3255#define VOL7D_POLY_TYPE DOUBLE PRECISION
3256#define VOL7D_POLY_TYPES d
3257#define VOL7D_POLY_TYPES_SUBTYPES db
3258#include "modqc_peeled_include.F90"
3259#undef VOL7D_POLY_TYPE
3260#undef VOL7D_POLY_TYPES
3261#undef VOL7D_POLY_TYPES_SUBTYPES
3262#define VOL7D_POLY_TYPE INTEGER
3263#define VOL7D_POLY_TYPES i
3264#define VOL7D_POLY_TYPES_SUBTYPES ib
3265#include "modqc_peeled_include.F90"
3266#undef VOL7D_POLY_TYPE
3267#undef VOL7D_POLY_TYPES
3268#undef VOL7D_POLY_TYPES_SUBTYPES
3269#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
3270#define VOL7D_POLY_TYPES b
3271#define VOL7D_POLY_TYPES_SUBTYPES bb
3272#include "modqc_peeled_include.F90"
3273#undef VOL7D_POLY_TYPE
3274#undef VOL7D_POLY_TYPES
3275#undef VOL7D_POLY_TYPES_SUBTYPES
3276#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
3277#define VOL7D_POLY_TYPES c
3278#define VOL7D_POLY_ISC = 1
3279#define VOL7D_POLY_TYPES_SUBTYPES cb
3280#include "modqc_peeled_include.F90"
3281
3282
3283#undef VOL7D_POLY_SUBTYPE
3284#undef VOL7D_POLY_SUBTYPES
3285#undef VOL7D_POLY_ISC
3286#define VOL7D_POLY_SUBTYPE CHARACTER(len=vol7d_cdatalen)
3287#define VOL7D_POLY_SUBTYPES c
3288
3289#undef VOL7D_POLY_TYPE
3290#undef VOL7D_POLY_TYPES
3291#undef VOL7D_POLY_TYPES_SUBTYPES
3292#define VOL7D_POLY_TYPE REAL
3293#define VOL7D_POLY_TYPES r
3294#define VOL7D_POLY_TYPES_SUBTYPES rc
3295#include "modqc_peeled_include.F90"
3296#undef VOL7D_POLY_TYPE
3297#undef VOL7D_POLY_TYPES
3298#undef VOL7D_POLY_TYPES_SUBTYPES
3299#define VOL7D_POLY_TYPE DOUBLE PRECISION
3300#define VOL7D_POLY_TYPES d
3301#define VOL7D_POLY_TYPES_SUBTYPES dc
3302#include "modqc_peeled_include.F90"
3303#undef VOL7D_POLY_TYPE
3304#undef VOL7D_POLY_TYPES
3305#undef VOL7D_POLY_TYPES_SUBTYPES
3306#define VOL7D_POLY_TYPE INTEGER
3307#define VOL7D_POLY_TYPES i
3308#define VOL7D_POLY_TYPES_SUBTYPES ic
3309#include "modqc_peeled_include.F90"
3310#undef VOL7D_POLY_TYPE
3311#undef VOL7D_POLY_TYPES
3312#undef VOL7D_POLY_TYPES_SUBTYPES
3313#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
3314#define VOL7D_POLY_TYPES b
3315#define VOL7D_POLY_TYPES_SUBTYPES bc
3316#include "modqc_peeled_include.F90"
3317#undef VOL7D_POLY_TYPE
3318#undef VOL7D_POLY_TYPES
3319#undef VOL7D_POLY_TYPES_SUBTYPES
3320#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
3321#define VOL7D_POLY_TYPES c
3322#define VOL7D_POLY_ISC = 1
3323#define VOL7D_POLY_TYPES_SUBTYPES cc
3324#include "modqc_peeled_include.F90"
3325
3326
3327subroutine init_qcattrvars(this)
3328
3329type(qcattrvars),intent(inout) :: this
3330integer :: i
3331
3332this%btables(:) =qcattrvarsbtables
3333do i =1, nqcattrvars
3335end do
3336
3337end subroutine init_qcattrvars
3338
3339
3340type(qcattrvars) function qcattrvars_new()
3341
3343
3344end function qcattrvars_new
3345
3346
3347!> Remove data under the predefined grade of confidence.
3348!! If neither \a keep_attr nor \a delete_attr are passed, all the
3349!! attributes will be deleted after peeling; if \a keep_attr is
3350!! provided, only attributed listed in \a keep_attr will be kept in
3351!! output, (\a delete_attr will be ignored); if \a delete_attr is
3352!! provided, attributed listed in \a delete_attr will be deleted from
3353!! output.
3354SUBROUTINE vol7d_peeling(this, data_id, keep_attr, delete_attr, preserve, purgeana)
3355TYPE(vol7d),INTENT(INOUT) :: this !< object that has to be peeled
3356integer,INTENT(inout),pointer,OPTIONAL :: data_id(:,:,:,:,:) !< data ID to use with dballe DB (for fast write of attributes)
3357CHARACTER(len=*),INTENT(in),OPTIONAL :: keep_attr(:) !< Btable of attributes that should be kept after removing data
3358CHARACTER(len=*),INTENT(in),OPTIONAL :: delete_attr(:) !< Btable of attributes that should be deleted after removing data
3359logical,intent(in),optional :: preserve !< preserve all attributes if true (alternative to keep_attr and delete_attr)
3360logical,intent(in),optional :: purgeana !< if true remove ana with all data missing
3361
3362integer :: inddativar,inddatiattrinv,inddatiattrcli,inddatiattrtem,inddatiattrspa,inddativarattr
3363type(qcattrvars) :: attrvars
3364
3365INTEGER(kind=int_b),pointer :: invbb(:,:,:,:,:),clibb(:,:,:,:,:),tembb(:,:,:,:,:),spabb(:,:,:,:,:)
3366INTEGER,pointer :: invbi(:,:,:,:,:),clibi(:,:,:,:,:),tembi(:,:,:,:,:),spabi(:,:,:,:,:)
3367REAL,pointer :: invbr(:,:,:,:,:),clibr(:,:,:,:,:),tembr(:,:,:,:,:),spabr(:,:,:,:,:)
3368DOUBLE PRECISION,pointer :: invbd(:,:,:,:,:),clibd(:,:,:,:,:),tembd(:,:,:,:,:),spabd(:,:,:,:,:)
3369CHARACTER(len=vol7d_cdatalen),pointer :: invbc(:,:,:,:,:),clibc(:,:,:,:,:),tembc(:,:,:,:,:),spabc(:,:,:,:,:)
3370
3371call l4f_log(l4f_info,'starting peeling')
3372
3374
3375! generate code per i vari tipi di dati di v7d
3376! tramite un template e il preprocessore
3377
3378
3379#undef VOL7D_POLY_SUBTYPE
3380#undef VOL7D_POLY_SUBTYPES
3381#define VOL7D_POLY_SUBTYPE REAL
3382#define VOL7D_POLY_SUBTYPES r
3383
3384#undef VOL7D_POLY_TYPE
3385#undef VOL7D_POLY_TYPES
3386#define VOL7D_POLY_TYPE REAL
3387#define VOL7D_POLY_TYPES r
3388#include "modqc_peeling_include.F90"
3389#undef VOL7D_POLY_TYPE
3390#undef VOL7D_POLY_TYPES
3391#define VOL7D_POLY_TYPE DOUBLE PRECISION
3392#define VOL7D_POLY_TYPES d
3393#include "modqc_peeling_include.F90"
3394#undef VOL7D_POLY_TYPE
3395#undef VOL7D_POLY_TYPES
3396#define VOL7D_POLY_TYPE INTEGER
3397#define VOL7D_POLY_TYPES i
3398#include "modqc_peeling_include.F90"
3399#undef VOL7D_POLY_TYPE
3400#undef VOL7D_POLY_TYPES
3401#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
3402#define VOL7D_POLY_TYPES b
3403#include "modqc_peeling_include.F90"
3404#undef VOL7D_POLY_TYPE
3405#undef VOL7D_POLY_TYPES
3406#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
3407#define VOL7D_POLY_TYPES c
3408#include "modqc_peeling_include.F90"
3409
3410
3411#undef VOL7D_POLY_SUBTYPE
3412#undef VOL7D_POLY_SUBTYPES
3413#define VOL7D_POLY_SUBTYPE DOUBLE PRECISION
3414#define VOL7D_POLY_SUBTYPES d
3415
3416#undef VOL7D_POLY_TYPE
3417#undef VOL7D_POLY_TYPES
3418#define VOL7D_POLY_TYPE REAL
3419#define VOL7D_POLY_TYPES r
3420#include "modqc_peeling_include.F90"
3421#undef VOL7D_POLY_TYPE
3422#undef VOL7D_POLY_TYPES
3423#define VOL7D_POLY_TYPE DOUBLE PRECISION
3424#define VOL7D_POLY_TYPES d
3425#include "modqc_peeling_include.F90"
3426#undef VOL7D_POLY_TYPE
3427#undef VOL7D_POLY_TYPES
3428#define VOL7D_POLY_TYPE INTEGER
3429#define VOL7D_POLY_TYPES i
3430#include "modqc_peeling_include.F90"
3431#undef VOL7D_POLY_TYPE
3432#undef VOL7D_POLY_TYPES
3433#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
3434#define VOL7D_POLY_TYPES b
3435#include "modqc_peeling_include.F90"
3436#undef VOL7D_POLY_TYPE
3437#undef VOL7D_POLY_TYPES
3438#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
3439#define VOL7D_POLY_TYPES c
3440#include "modqc_peeling_include.F90"
3441
3442
3443#undef VOL7D_POLY_SUBTYPE
3444#undef VOL7D_POLY_SUBTYPES
3445#define VOL7D_POLY_SUBTYPE INTEGER
3446#define VOL7D_POLY_SUBTYPES i
3447
3448#undef VOL7D_POLY_TYPE
3449#undef VOL7D_POLY_TYPES
3450#define VOL7D_POLY_TYPE REAL
3451#define VOL7D_POLY_TYPES r
3452#include "modqc_peeling_include.F90"
3453#undef VOL7D_POLY_TYPE
3454#undef VOL7D_POLY_TYPES
3455#define VOL7D_POLY_TYPE DOUBLE PRECISION
3456#define VOL7D_POLY_TYPES d
3457#include "modqc_peeling_include.F90"
3458#undef VOL7D_POLY_TYPE
3459#undef VOL7D_POLY_TYPES
3460#define VOL7D_POLY_TYPE INTEGER
3461#define VOL7D_POLY_TYPES i
3462#include "modqc_peeling_include.F90"
3463#undef VOL7D_POLY_TYPE
3464#undef VOL7D_POLY_TYPES
3465#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
3466#define VOL7D_POLY_TYPES b
3467#include "modqc_peeling_include.F90"
3468#undef VOL7D_POLY_TYPE
3469#undef VOL7D_POLY_TYPES
3470#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
3471#define VOL7D_POLY_TYPES c
3472#include "modqc_peeling_include.F90"
3473
3474
3475#undef VOL7D_POLY_SUBTYPE
3476#undef VOL7D_POLY_SUBTYPES
3477#define VOL7D_POLY_SUBTYPE INTEGER(kind=int_b)
3478#define VOL7D_POLY_SUBTYPES b
3479
3480#undef VOL7D_POLY_TYPE
3481#undef VOL7D_POLY_TYPES
3482#define VOL7D_POLY_TYPE REAL
3483#define VOL7D_POLY_TYPES r
3484#include "modqc_peeling_include.F90"
3485#undef VOL7D_POLY_TYPE
3486#undef VOL7D_POLY_TYPES
3487#define VOL7D_POLY_TYPE DOUBLE PRECISION
3488#define VOL7D_POLY_TYPES d
3489#include "modqc_peeling_include.F90"
3490#undef VOL7D_POLY_TYPE
3491#undef VOL7D_POLY_TYPES
3492#define VOL7D_POLY_TYPE INTEGER
3493#define VOL7D_POLY_TYPES i
3494#include "modqc_peeling_include.F90"
3495#undef VOL7D_POLY_TYPE
3496#undef VOL7D_POLY_TYPES
3497#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
3498#define VOL7D_POLY_TYPES b
3499#include "modqc_peeling_include.F90"
3500#undef VOL7D_POLY_TYPE
3501#undef VOL7D_POLY_TYPES
3502#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
3503#define VOL7D_POLY_TYPES c
3504#include "modqc_peeling_include.F90"
3505
3506
3507
3508#undef VOL7D_POLY_SUBTYPE
3509#undef VOL7D_POLY_SUBTYPES
3510#define VOL7D_POLY_SUBTYPE CHARACTER(len=vol7d_cdatalen)
3511#define VOL7D_POLY_SUBTYPES c
3512
3513#undef VOL7D_POLY_TYPE
3514#undef VOL7D_POLY_TYPES
3515#define VOL7D_POLY_TYPE REAL
3516#define VOL7D_POLY_TYPES r
3517#include "modqc_peeling_include.F90"
3518#undef VOL7D_POLY_TYPE
3519#undef VOL7D_POLY_TYPES
3520#define VOL7D_POLY_TYPE DOUBLE PRECISION
3521#define VOL7D_POLY_TYPES d
3522#include "modqc_peeling_include.F90"
3523#undef VOL7D_POLY_TYPE
3524#undef VOL7D_POLY_TYPES
3525#define VOL7D_POLY_TYPE INTEGER
3526#define VOL7D_POLY_TYPES i
3527#include "modqc_peeling_include.F90"
3528#undef VOL7D_POLY_TYPE
3529#undef VOL7D_POLY_TYPES
3530#define VOL7D_POLY_TYPE INTEGER(kind=int_b)
3531#define VOL7D_POLY_TYPES b
3532#include "modqc_peeling_include.F90"
3533#undef VOL7D_POLY_TYPE
3534#undef VOL7D_POLY_TYPES
3535#define VOL7D_POLY_TYPE CHARACTER(len=vol7d_cdatalen)
3536#define VOL7D_POLY_TYPES c
3537#include "modqc_peeling_include.F90"
3538
3539
3540
3541IF (.NOT.PRESENT(keep_attr) .AND. .NOT.PRESENT(delete_attr) .and. .not. optio_log(preserve)) THEN ! destroy all attributes
3542 IF (ASSOCIATED(this%voldatiattrr)) DEALLOCATE(this%voldatiattrr)
3543 IF (ASSOCIATED(this%voldatiattrd)) DEALLOCATE(this%voldatiattrd)
3544 IF (ASSOCIATED(this%voldatiattri)) DEALLOCATE(this%voldatiattri)
3545 IF (ASSOCIATED(this%voldatiattrb)) DEALLOCATE(this%voldatiattrb)
3546 IF (ASSOCIATED(this%voldatiattrc)) DEALLOCATE(this%voldatiattrc)
3547
3548 CALL delete(this%datiattr)
3549 CALL delete(this%dativarattr)
3550END IF
3551
3552IF (PRESENT(keep_attr)) THEN ! set to missing non requested attributes and reform
3553
3554 if (optio_log(preserve)) call l4f_log(l4f_warn,"preserve parameter ignored: keep_attr passed")
3555 CALL keep_var(this%datiattr%r)
3556 CALL keep_var(this%datiattr%d)
3557 CALL keep_var(this%datiattr%i)
3558 CALL keep_var(this%datiattr%b)
3559 CALL keep_var(this%datiattr%c)
3560 CALL qc_reform(this,data_id, miss=.true., purgeana=purgeana)
3561
3562ELSE IF (PRESENT(delete_attr)) THEN ! set to missing requested attributes and reform
3563
3564 if (optio_log(preserve)) call l4f_log(l4f_warn,"preserve parameter ignored: delete_attr passed")
3565 CALL delete_var(this%datiattr%r)
3566 CALL delete_var(this%datiattr%d)
3567 CALL delete_var(this%datiattr%i)
3568 CALL delete_var(this%datiattr%b)
3569 CALL delete_var(this%datiattr%c)
3570 CALL qc_reform(this,data_id, miss=.true., purgeana=purgeana)
3571
3572ELSE IF (PRESENT(purgeana)) THEN
3573
3574 CALL qc_reform(this,data_id, purgeana=purgeana)
3575
3576ENDIF
3577
3578
3579CONTAINS
3580
3581
3582!> Like vol7d_reform but manage data_id and have less options
3583subroutine qc_reform(this,data_id,miss, purgeana)
3584TYPE(vol7d),INTENT(INOUT) :: this !< object that has to be reformed
3585integer,INTENT(inout),pointer,OPTIONAL :: data_id(:,:,:,:,:) !< data ID to use with dballe DB (for fast write of attributes)
3586logical,intent(in),optional :: miss !< remove everithing related with missing position in description vector
3587logical,intent(in),optional :: purgeana !< if true remove ana with all data missing
3588
3589integer,pointer :: data_idtmp(:,:,:,:,:)
3590logical,allocatable :: llana(:)
3591integer,allocatable :: anaind(:)
3592integer :: i,j,nana
3593
3594if (optio_log(purgeana)) then
3595 allocate(llana(size(this%ana)))
3596 llana =.false.
3597 do i =1,size(this%ana)
3598 if (associated(this%voldatii)) llana(i)= llana(i) .or. any(c_e(this%voldatii(i,:,:,:,:,:)))
3599 if (associated(this%voldatir)) llana(i)= llana(i) .or. any(c_e(this%voldatir(i,:,:,:,:,:)))
3600 if (associated(this%voldatid)) llana(i)= llana(i) .or. any(c_e(this%voldatid(i,:,:,:,:,:)))
3601 if (associated(this%voldatib)) llana(i)= llana(i) .or. any(c_e(this%voldatib(i,:,:,:,:,:)))
3602 if (associated(this%voldatic)) llana(i)= llana(i) .or. any(c_e(this%voldatic(i,:,:,:,:,:)))
3603
3604#ifdef DEBUG
3605 if (.not. llana(i)) call l4f_log(l4f_debug,"remove station"//t2c(i))
3606#endif
3607
3608 end do
3609
3610 nana=count(llana)
3611
3612
3613 allocate(anaind(nana))
3614
3615 j=0
3616 do i=1,size(this%ana)
3617 if (llana(i)) then
3618 j=j+1
3619 anaind(j)=i
3620 end if
3621 end do
3622
3623
3624 if(present(data_id)) then
3625 allocate(data_idtmp(nana,size(data_id,2),size(data_id,3),size(data_id,4),size(data_id,5)))
3626 data_idtmp=data_id(anaind,:,:,:,:)
3627 if (associated(data_id))deallocate(data_id)
3628 data_id=>data_idtmp
3629 end if
3630
3631 call vol7d_reform(this,miss=miss,lana=llana)
3632
3633 deallocate(llana,anaind)
3634
3635else
3636
3637 call vol7d_reform(this,miss=miss)
3638
3639end if
3640
3641end subroutine qc_reform
3642
3643
3644SUBROUTINE keep_var(var)
3645TYPE(vol7d_var),intent(inout),POINTER :: var(:)
3646
3647INTEGER :: i
3648
3649IF (ASSOCIATED(var)) THEN
3650 if (size(var) == 0) then
3651 var%btable = vol7d_var_miss%btable
3652 else
3653 DO i = 1, SIZE(var)
3654 IF (all(var(i)%btable /= keep_attr(:))) THEN ! n.b. ALL((//)) = .TRUE.
3655 var(i)%btable = vol7d_var_miss%btable
3656 ENDIF
3657 ENDDO
3658 end if
3659ENDIF
3660
3661END SUBROUTINE keep_var
3662
3663SUBROUTINE delete_var(var)
3664TYPE(vol7d_var),intent(inout),POINTER :: var(:)
3665
3666INTEGER :: i
3667
3668IF (ASSOCIATED(var)) THEN
3669 if (size(var) == 0) then
3670 var%btable = vol7d_var_miss%btable
3671 else
3672 DO i = 1, SIZE(var)
3673 IF (any(var(i)%btable == delete_attr(:))) THEN ! n.b. ANY((//)) = .FALSE.
3674 var(i) = vol7d_var_miss
3675 ENDIF
3676 ENDDO
3677 end if
3678ENDIF
3679
3680END SUBROUTINE delete_var
3681
3682END SUBROUTINE vol7d_peeling
3683
3684
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 |