|
◆ 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 673 del file modqcspa.F90.
676 datoqui = qcspa%v7d%voldatir (indana ,indtime ,indlevel ,indtimerange
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 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 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
714 indctimerange = index(qcspa%clima%timerange
718 indcdativarr = index(qcspa%clima%dativar%r, qcspa%v7d%dativar%r
722 call l4f_log(l4f_debug, "Index:"// to_char(indctime)//to_char
723 to_char(indctimerange)//to_char(indcdativarr)//to_char(indcnetwork
725 if ( indctime <= 0 .or. indclevel <= 0 .or. indctimerange
726 .or. indcnetwork <= 0 ) cycle
729 if (optio_log(noborder) .and. any(indana == qcspa%tri%ipl(:3
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
804 if (indbattrinv > 0) then
805 if( invalidated(qcspa%v7d%voldatiattrb&
806 (ivert(i),indtime,indlevel,indtimerange,inddativarr,indnetwork then
812 if (indbattrcli > 0) then
813 if( .not. vdge(qcspa%v7d%voldatiattrb&
814 (ivert(i),indtime,indlevel,indtimerange,inddativarr,indnetwork then
823 deltato=timedelta_miss
824 do indnet=1, size(qcspa%v7d%network)
825 datila = qcspa%v7d%voldatir (ivert(i) ,: ,indlevel ,indtimerange
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
834 if (indbattrcli > 0 ) then
835 if (.not. vdge(qcspa%v7d%voldatiattrb&
836 (ivert(i),iindtime,indlevel,indtimerange,inddativarr
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 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
925 (indcana == 1 .and. gradmin <
926 (indcana == size(qcspa%clima%ana) .and. gradmin >= climaquif then
928 flag=qcspa%clima%voldatiattrb(indcana,indctime,indclevel
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
935 qcspa%data_id_out(indana,indtime,indlevel,indtimerange
936 qcspa%data_id_in(indana,indtime,indlevel,indtimerange
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
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
Controllo di qualità spaziale.
|