|
◆ quaconcli()
subroutine, public modqccli::quaconcli |
( |
type(qcclitype), intent(inout) |
qccli, |
|
|
character (len=10), intent(in), optional |
battrinv, |
|
|
character (len=10), intent(in), optional |
battrout, |
|
|
logical, dimension(:), intent(in), optional |
anamask, |
|
|
logical, dimension(:), intent(in), optional |
timemask, |
|
|
logical, dimension(:), intent(in), optional |
levelmask, |
|
|
logical, dimension(:), intent(in), optional |
timerangemask, |
|
|
logical, dimension(:), intent(in), optional |
varmask, |
|
|
logical, dimension(:), intent(in), optional |
networkmask |
|
) |
| |
Controllo di Qualità climatico.
Questo è il vero e proprio controllo di qualità climatico. Avendo a disposizione un volume dati climatico contenente i percentili suddivisi per area, altezza sul livello del mare, per mese dell'anno viene selezionato il percentile e sulla base di questo vengono assegnate le opportune confidenze.
- Parametri
-
[in,out] | qccli | Oggetto per il controllo di qualità |
[in] | battrinv | attributo invalidated in input/output |
[in] | battrout | attributo con la confidenza climatologica in output |
[in] | anamask | Filtro sulle anagrafiche |
[in] | timemask | Filtro sul tempo |
[in] | levelmask | Filtro sui livelli |
[in] | timerangemask | filtro sui timerange |
[in] | varmask | Filtro sulle variabili |
[in] | networkmask | Filtro sui network |
Definizione alla linea 1082 del file modqccli.F90.
1082 call l4f_log (l4f_debug, "qccli: skip station for a preceding invalidated flag") 1088 nintime=qccli%v7d%time(indtime)+timedelta_new(minute=30) 1089 CALL getval(nintime, month=mese, hour=ora) 1091 time=cyclicdatetime_to_conventional(cyclicdatetime_new(month=mese, hour=ora)) 1096 level=qccli%v7d%level(indlevel) 1098 call init(network, "qcclima-perc") 1100 indcnetwork = index(qccli%extreme%network , network) 1101 indctime = index(qccli%extreme%time , time) 1102 indclevel = index(qccli%extreme%level , level) 1103 indctimerange = index(qccli%extreme%timerange , qccli%v7d%timerange(indtimerange)) 1107 indcdativarr = index(qccli%extreme%dativar%r, qccli%v7d%dativar%r(inddativarr)) 1126 if (indctime <= 0 .or. indclevel <= 0 .or. indctimerange <= 0 .or. indcdativarr <= 0 & 1127 .or. indcnetwork <= 0 ) cycle 1129 datoqui = qccli%v7d%voldatir (indana ,indtime ,indlevel ,indtimerange ,inddativarr, indnetwork ) 1131 if ( c_e(datoqui)) then 1145 if ( associated(qccli%extreme%voldatir)) then 1147 if (qccli%height2level) then 1159 write(ident, '("#",i2.2,2i3.3)')k,iarea,desc 1160 call init(ana,ident=ident,lat=latc,lon=lonc) 1161 indcana= index(qccli%extreme%ana,ana) 1162 if (indcana > 0 ) then 1163 perc25=qccli%extreme%voldatir(indcana,indctime,indclevel,indctimerange,indcdativarr,indcnetwork) 1167 write(ident, '("#",i2.2,2i3.3)')k,iarea,desc 1168 call init(ana,ident=ident,lat=latc,lon=lonc) 1169 indcana= index(qccli%extreme%ana,ana) 1172 if (indcana > 0 ) then 1173 perc50=qccli%extreme%voldatir(indcana,indctime,indclevel,indctimerange,indcdativarr,indcnetwork) 1177 write(ident, '("#",i2.2,2i3.3)')k,iarea,desc 1178 call init(ana,ident=ident,lat=latc,lon=lonc) 1179 indcana= index(qccli%extreme%ana,ana) 1180 if (indcana > 0 ) then 1181 perc75=qccli%extreme%voldatir(indcana,indctime,indclevel,indctimerange,indcdativarr,indcnetwork) 1185 if ( .not. c_e(perc25) .or. .not. c_e(perc50) .or. .not. c_e(perc75)) cycle 1191 extremequii=perc50 - (perc75 - perc25) *1.3 * 3.65 1192 extremequif=perc50 + (perc75 - perc25) *1.3 * 3.65 1195 call l4f_log (l4f_debug, "qccli: gross error check "//t2c(extremequii)// ">"//t2c(datoqui)// "<"//t2c(extremequif)) 1199 if ( datoqui <= extremequii .or. extremequif <= datoqui ) then 1204 call l4f_log (l4f_debug, "qccli: gross error check flag set to bad") 1206 qccli%v7d%voldatiattrb(indana,indtime,indlevel,indtimerange,inddativarr,indnetwork,indbattrout)=qcpar%gross_error 1208 if ( associated ( qccli%data_id_in)) then 1210 call l4f_log (l4f_debug, "id: "//t2c(& 1211 qccli%data_id_in(indana,indtime,indlevel,indtimerange,indnetwork))) 1213 qccli%data_id_out(indana,indtime,indlevel,indtimerange,indnetwork)=& 1214 qccli%data_id_in(indana,indtime,indlevel,indtimerange,indnetwork) 1218 else if (.not. vdge(qccli%v7d%voldatiattrb(indana,indtime,indlevel,indtimerange,& 1219 inddativarr,indnetwork,indbattrout))) then 1223 call l4f_log (l4f_warn, "qccli: skip station for a preceding gross error check flagged bad") 1230 datoqui = (datoqui - perc50) / (perc75 - perc25) + base_value(qccli%v7d%dativar%r(inddativarr)%btable) 1234 call init(network, "qcclima-ndi") 1236 level=qccli%v7d%level(indlevel) 1237 time=cyclicdatetime_to_conventional(cyclicdatetime_new(month=mese)) 1239 indcnetwork = index(qccli%clima%network , network) 1240 indctime = index(qccli%clima%time , time) 1241 indclevel = index(qccli%clima%level , level) 1242 indctimerange = index(qccli%clima%timerange , qccli%v7d%timerange(indtimerange)) 1246 indcdativarr = index(qccli%clima%dativar%r, qccli%v7d%dativar%r(inddativarr)) 1250 if (indctime <= 0 .or. indclevel <= 0 .or. indctimerange <= 0 .or. indcdativarr <= 0 & 1251 .or. indcnetwork <= 0 ) cycle 1255 do desc=1, size(qccli%clima%ana) 1260 write(ident, '("#",i2.2,2i3.3)')0,0,min(desc, size(qccli%clima%ana)-1) *10 1261 call init(ana,ident=ident,lat=0d0,lon=0d0) 1262 indcana= index(qccli%clima%ana,ana) 1263 if (indcana > 0 ) then 1264 climaquif=qccli%clima%voldatir(indcana,indctime,indclevel,indctimerange,indcdativarr,indcnetwork) 1268 write(ident, '("#",i2.2,2i3.3)')0,0,(desc-1)*10 1269 call init(ana,ident=ident,lat=0d0,lon=0d0) 1270 indcana= index(qccli%clima%ana,ana) 1273 if (indcana > 0 ) then 1274 climaquii=qccli%clima%voldatir(indcana,indctime,indclevel,indctimerange,indcdativarr,indcnetwork) 1280 if ( c_e(climaquii) .and. c_e(climaquif )) then 1292 if ( (climaquii <= datoqui.and. datoqui < climaquif) .or. & 1293 (desc == 1 .and. datoqui < climaquii) .or. & 1294 (desc == size(qccli%clima%ana) .and. datoqui >= climaquif) ) then 1296 if ( c_e(qccli%clima%voldatiattrb(indcana & 1297 ,indctime,indclevel,indctimerange,indcdativarr,indcnetwork,1))) then 1302 qccli%v7d%voldatiattrb(indana,indtime,indlevel,indtimerange,inddativarr,indnetwork,indbattrout)=& 1303 max(qccli%clima%voldatiattrb& 1304 (indcana,indctime,indclevel,indctimerange,indcdativarr,indcnetwork,1)& 1308 call l4f_log (l4f_debug, "data ndi: "//t2c(datoqui)// "->"//& 1309 t2c(qccli%clima%voldatiattrb(indcana,indctime,indclevel,indctimerange,indcdativarr,indcnetwork,1))& 1310 // " : "//t2c(qccli%v7d%time(indtime))) 1311 call l4f_log (l4f_debug, "limits: "//t2c(indcana)// ":"//qccli%clima%ana(indcana)%ident//& 1312 " : "//t2c(climaquii)// " - "//t2c(climaquif)// " : "//t2c(qccli%clima%time(indctime))) 1313 call l4f_log (l4f_debug, "qccli: clima check "//t2c(datoqui)// " confidence: "//& 1314 t2c(qccli%v7d%voldatiattrb(indana,indtime,indlevel,indtimerange,inddativarr,indnetwork,indbattrout))& 1315 // " : "//t2c(qccli%v7d%time(indtime))) 1319 if ( associated ( qccli%data_id_in)) then 1321 call l4f_log (l4f_debug, "id: "//t2c(& 1322 qccli%data_id_in(indana,indtime,indlevel,indtimerange,indnetwork))) 1324 qccli%data_id_out(indana,indtime,indlevel,indtimerange,indnetwork)=& 1325 qccli%data_id_in(indana,indtime,indlevel,indtimerange,indnetwork) 1350 end subroutine quaconcli 1356 subroutine cli_level(heigth,level) 1358 real, intent(in) :: heigth 1359 TYPE(vol7d_level), intent(out):: level 1365 if ( c_e(heigth)) then 1366 i=firsttrue(cli_level1 <= heigth .and. heigth <= cli_level2 ) 1369 if (i >= 1 .and. i <= 10 ) then 1370 call init(level, 102,cli_level1(i)*1000,102,cli_level2(i)*1000) 1372 if ( c_e(i)) CALL l4f_log(l4f_debug, "cli_level: strange level, heigth: "//to_char(heigth)) 1376 end subroutine cli_level 1380 subroutine cli_level_generate(level) 1382 TYPE(vol7d_level), intent(out):: level(:) 1386 if ( size(level) /= cli_nlevel ) then 1387 call l4f_log(l4f_error, "cli_level_generate: level dimension /= "//trim(to_char(cli_nlevel))) 1388 call raise_error( "cli_level_generate: level dimension /= "//trim(to_char(cli_nlevel))) 1392 call init(level(i), 102,cli_level1(i)*1000,102,cli_level2(i)*1000) 1395 end subroutine cli_level_generate 1409 integer function supermacroa(macroa) 1411 integer, intent(in) :: macroa 1416 if (macroa == 1 .or. macroa == 2 .or. macroa == 4 ) supermacroa=3 1417 if (macroa == 3 .or. macroa == 5 .or. macroa == 6 ) supermacroa=2 1418 if (macroa == 7 .or. macroa == 8 ) supermacroa=1 1426 end function supermacroa 1429 SUBROUTINE qc_compute_percentile(this, perc_vals,cyclicdt,presentperc, presentnumb) 1431 TYPE(qcclitype), INTENT(inout) :: this 1435 real, intent(in) :: perc_vals(:) 1436 TYPE(cyclicdatetime), INTENT(in) :: cyclicdt 1437 real, optional :: presentperc 1438 integer, optional :: presentnumb 1441 integer :: indana,indtime,indvar,indnetwork,indlevel ,indtimerange ,inddativarr,i,j,k,iana,narea 1443 REAL, DIMENSION(:), allocatable :: perc 1444 TYPE(vol7d_var) :: var 1445 character(len=vol7d_ana_lenident) :: ident 1446 character(len=1) :: type 1447 integer :: areav(size(this%v7d%ana)),iclv(size(this%v7d%ana)) 1449 logical, allocatable :: mask(:,:,:),maskplus(:,:,:), maskarea(:) 1450 integer, allocatable :: area(:) 1451 real :: lpresentperc 1452 integer :: lpresentnumb 1454 lpresentperc=optio_r(presentperc) 1455 lpresentnumb=optio_i(presentnumb) 1457 allocate (perc( size(perc_vals))) 1459 call delete(this%extreme) 1460 CALL init(this%extreme, time_definition=this%v7d%time_definition) 1462 call init(var, btable= "B01192") 1465 indvar = index(this%v7d%anavar, var, type=type) 1466 indnetwork=min(1, size(this%v7d%network)) 1468 if( indvar > 0 .and. indnetwork > 0 ) then 1471 areav=integerdat(this%v7d%volanad(:,indvar,indnetwork),this%v7d%anavar%d(indvar)) 1473 areav=integerdat(this%v7d%volanar(:,indvar,indnetwork),this%v7d%anavar%r(indvar)) 1475 areav=integerdat(this%v7d%volanai(:,indvar,indnetwork),this%v7d%anavar%i(indvar)) 1477 areav=integerdat(this%v7d%volanab(:,indvar,indnetwork),this%v7d%anavar%b(indvar)) 1479 areav=integerdat(this%v7d%volanac(:,indvar,indnetwork),this%v7d%anavar%c(indvar)) 1487 allocate(maskarea( size(this%v7d%ana))) 1488 maskarea(:)= areav(:) /= imiss 1489 narea=count_distinct(areav,maskarea) 1490 allocate(area(narea)) 1491 area=pack_distinct(areav,narea,maskarea) 1492 deallocate(maskarea) 1493 if (this%height2level) then 1494 call vol7d_alloc(this%extreme,nana=narea* size(perc_vals)*cli_nlevel) 1496 call vol7d_alloc(this%extreme,nana=narea* size(perc_vals)) 1499 if (this%height2level) then 1501 call init(var, btable= "B07030") 1504 indvar = index(this%v7d%anavar, var, type=type) 1536 do k=1, size(this%v7d%ana) Function to check whether a value is missing or not.
|