|
◆ quaconspa()
subroutine, public modqcspa::quaconspa |
( |
type(qcspatype), intent(inout) |
qcspa, |
|
|
type(timedelta), intent(in) |
timetollerance, |
|
|
logical, intent(in), optional |
noborder, |
|
|
character (len=10), intent(in), optional |
battrinv, |
|
|
character (len=10), intent(in), optional |
battrcli, |
|
|
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à spaziale.
Questo è il vero e proprio controllo di qualità spaziale.
- Parametri
-
[in,out] | qcspa | Oggetto per il controllo di qualità |
[in] | timetollerance | time tollerance to compare nearest stations |
[in] | noborder | Exclude border from QC |
[in] | battrinv | attributo invalidated in input |
[in] | battrcli | attributo con la confidenza climatologica in input |
[in] | battrout | attributo con la confidenza spaziale 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 675 del file modqcspa.F90.
676 datoqui = qcspa%v7d%voldatir (indana ,indtime ,indlevel ,indtimerange ,inddativarr, indnetwork ) 677 if (.not. c_e(datoqui)) cycle 680 if (indbattrinv > 0) then 681 if( invalidated(qcspa%v7d%voldatiattrb& 682 (indana,indtime,indlevel,indtimerange,inddativarr,indnetwork,indbattrinv))) then 683 call l4f_category_log(qcspa%category,l4f_warn,& 684 "It's better to do a reform on ana to v7d after peeling, before spatial QC") 690 if (indbattrcli > 0) then 691 if( .not. vdge(qcspa%v7d%voldatiattrb& 692 (indana,indtime,indlevel,indtimerange,inddativarr,indnetwork,indbattrcli))) then 693 call l4f_category_log(qcspa%category,l4f_warn,& 694 "It's better to do a reform on ana to v7d after peeling, before spatial QC") 711 if (qcspa%operation == "run") then 713 indclevel = index(qcspa%clima%level , qcspa%v7d%level(indlevel)) 714 indctimerange = index(qcspa%clima%timerange , qcspa%v7d%timerange(indtimerange)) 718 indcdativarr = index(qcspa%clima%dativar%r, qcspa%v7d%dativar%r(inddativarr)) 722 call l4f_log(l4f_debug, "Index:"// to_char(indctime)//to_char(indclevel)//& 723 to_char(indctimerange)//to_char(indcdativarr)//to_char(indcnetwork)) 725 if ( indctime <= 0 .or. indclevel <= 0 .or. indctimerange <= 0 .or. indcdativarr <= 0 & 726 .or. indcnetwork <= 0 ) cycle 729 if (optio_log(noborder) .and. any(indana == qcspa%tri%ipl(:3*qcspa%tri%nl:3))) cycle 737 IF(qcspa%tri%IPT(3*it-2).EQ.indana) THEN 739 ivert(2*itrov)=qcspa%tri%IPT(3*it) 740 ivert(2*itrov-1)=qcspa%tri%IPT(3*it-1) 745 IF(qcspa%tri%IPT(3*it-1).EQ.indana) THEN 747 ivert(2*itrov)=qcspa%tri%IPT(3*it) 748 ivert(2*itrov-1)=qcspa%tri%IPT(3*it-2) 753 IF(qcspa%tri%IPT(3*it).EQ.indana) THEN 755 ivert(2*itrov)=qcspa%tri%IPT(3*it-1) 756 ivert(2*itrov-1)=qcspa%tri%IPT(3*it-2) 769 call sort(ivert(:itrov)) 783 IF(ivert(iv).NE.ivert(kk)) THEN 788 IF (iv.GT.itrov)iv=itrov 798 gradmin=huge(gradmin) 801 datola = qcspa%v7d%voldatir (ivert(i) ,indtime ,indlevel ,indtimerange ,inddativarr, indnetwork ) 804 if (indbattrinv > 0) then 805 if( invalidated(qcspa%v7d%voldatiattrb& 806 (ivert(i),indtime,indlevel,indtimerange,inddativarr,indnetwork,indbattrinv))) then 812 if (indbattrcli > 0) then 813 if( .not. vdge(qcspa%v7d%voldatiattrb& 814 (ivert(i),indtime,indlevel,indtimerange,inddativarr,indnetwork,indbattrcli))) then 823 deltato=timedelta_miss 824 do indnet=1, size(qcspa%v7d%network) 825 datila = qcspa%v7d%voldatir (ivert(i) ,: ,indlevel ,indtimerange ,inddativarr, indnet ) 826 do iindtime=1, size(qcspa%v7d%time) 827 if (.not. c_e(datila(iindtime))) cycle 829 if (indbattrinv > 0 ) then 830 if (invalidated(qcspa%v7d%voldatiattrb& 831 (ivert(i),iindtime,indlevel,indtimerange,inddativarr,indnetwork,indbattrinv))) cycle 834 if (indbattrcli > 0 ) then 835 if (.not. vdge(qcspa%v7d%voldatiattrb& 836 (ivert(i),iindtime,indlevel,indtimerange,inddativarr,indnetwork,indbattrcli))) cycle 839 if (iindtime < indtime) then 840 deltat=qcspa%v7d%time(indtime)-qcspa%v7d%time(iindtime) 841 else if (iindtime >= indtime) then 842 deltat=qcspa%v7d%time(iindtime)-qcspa%v7d%time(indtime) 845 if ((deltat < deltato .or. .not. c_e(deltato)) .and. deltat <= timetollerance ) then 846 datola = datila(iindtime) 853 IF(.NOT.c_e(datola)) cycle 855 dist = distanza(qcspa%co(indana),qcspa%co(ivert(i))) 857 call l4f_category_log(qcspa%category,l4f_error, "distance from two station == 0.") 862 call l4f_log (l4f_debug, "distanza: "//t2c(dist)) 865 dist=max(dist,distmin) 868 if (dist > distscol) cycle 871 grad=(datoqui-datola)/(dist) 872 IF (grad >= 0.d0) ipos=ipos+1 873 IF (grad <= 0.d0) ineg=ineg+1 875 gradmin=min(gradmin,abs(grad)) 880 call l4f_log (l4f_debug, "ivb: "//t2c(ivb)) 885 IF (ipos == ivb .or. ineg == ivb) THEN 887 gradmin=sign(gradmin,dble(ipos-ineg)) 889 if (qcspa%operation == "gradient") then 890 write(grunit,*)gradmin 898 call l4f_log (l4f_debug, "gradmin: "//t2c(gradmin)) 904 if (qcspa%operation == "run") then 906 do indcana=1, size(qcspa%clima%ana) 907 climaquii=(qcspa%clima%voldatir(indcana & 908 ,indctime,indclevel,indctimerange,indcdativarr,indcnetwork)& 909 - spa_b(ind))/spa_a(ind) 913 climaquif=(qcspa%clima%voldatir(min(indcana+1, size(qcspa%clima%ana)) & 914 ,indctime,indclevel,indctimerange,indcdativarr,indcnetwork)& 915 - spa_b(ind))/spa_a(ind) 918 call l4f_log (l4f_debug, "climaquii: "//t2c(climaquii)) 919 call l4f_log (l4f_debug, "climaquif: "//t2c(climaquif)) 922 if ( c_e(climaquii) .and. c_e(climaquif )) then 924 if ( (gradmin >= climaquii .and. gradmin < climaquif) .or. & 925 (indcana == 1 .and. gradmin < climaquii) .or. & 926 (indcana == size(qcspa%clima%ana) .and. gradmin >= climaquif) ) then 928 flag=qcspa%clima%voldatiattrb(indcana,indctime,indclevel,indctimerange,indcdativarr,indcnetwork,1) 930 if ( associated ( qcspa%data_id_in)) then 932 call l4f_log (l4f_debug, "id: "//t2c(& 933 qcspa%data_id_in(indana,indtime,indlevel,indtimerange,indnetwork))) 935 qcspa%data_id_out(indana,indtime,indlevel,indtimerange,indnetwork)=& 936 qcspa%data_id_in(indana,indtime,indlevel,indtimerange,indnetwork) 942 call l4f_log (l4f_info, "datoqui: "//t2c(datoqui)) 943 call l4f_log (l4f_info, "flag qcspa: "//t2c(flag)) 950 if (qcspa%operation == "run") then 952 qcspa%v7d%voldatiattrb( indana, indtime, indlevel, indtimerange, inddativarr, indnetwork, indbattrout)=flag 957 if (qcspa%operation == "gradient") then 974 elemental double precision function distanza (co1,co2) 975 type(xy), intent(in) :: co1,co2 978 distanza = sqrt((co2%x-co1%x)**2 + (co2%y-co1%y)**2) 980 end function distanza 982 end subroutine quaconspa 991
Controllo di qualità spaziale.
|