libsim Versione 7.2.6

◆ quacontem()

subroutine, public quacontem ( type(qctemtype), intent(inout) qctem,
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à temporale.

Questo è il vero e proprio controllo di qualità temporale.

Parametri
[in,out]qctemOggetto per il controllo di qualità
[in]battrinvattributo invalidated in input
[in]battrcliattributo con la confidenza climatologica in input
[in]battroutattributo con la confidenza temporale in output
[in]anamaskFiltro sulle anagrafiche
[in]timemaskFiltro sul tempo
[in]levelmaskFiltro sui livelli
[in]timerangemaskfiltro sui timerange
[in]varmaskFiltro sulle variabili
[in]networkmaskFiltro sui network

Definizione alla linea 545 del file modqctem.F90.

547
548 datoqui = qctem%v7d%voldatir (indana ,indtime ,indlevel ,indtimerange ,inddativarr, indnetwork )
549 if (.not. c_e(datoqui)) cycle
550 ora = qctem%v7d%time (indtime)
551
552 ! invalidated
553 if (indbattrinv > 0) then
554 if( invalidated(qctem%v7d%voldatiattrb&
555 (indana,indtime,indlevel,indtimerange,inddativarr,indnetwork,indbattrinv))) then
556 call l4f_category_log(qctem%category,l4f_warn,&
557 "It's better to do a reform on ana to v7d after peeling, before spatial QC")
558 cycle
559 end if
560 end if
561
562 ! gross error check
563 if (indbattrcli > 0) then
564 if( .not. vdge(qctem%v7d%voldatiattrb&
565 (indana,indtime,indlevel,indtimerange,inddativarr,indnetwork,indbattrcli))) then
566 call l4f_category_log(qctem%category,l4f_warn,&
567 "It's better to do a reform on ana to v7d after peeling, before spatial QC")
568 cycle
569 end if
570 end if
571
572
573
574 if (qctem%operation == "run") then
575
576 indclevel = index(qctem%clima%level , qctem%v7d%level(indlevel))
577 indctimerange = index(qctem%clima%timerange , qctem%v7d%timerange(indtimerange))
578
579 ! attenzione attenzione TODO
580 ! se leggo da bufr il default è char e non reale
581 indcdativarr = index(qctem%clima%dativar%r, qctem%v7d%dativar%r(inddativarr))
582
583#ifdef DEBUG
584 call l4f_log(l4f_debug,"QCtem Index:"// to_char(indctime)//to_char(indclevel)//&
585 to_char(indctimerange)//to_char(indcdativarr)//to_char(indcnetworks))
586#endif
587 if ( indctime <= 0 .or. indclevel <= 0 .or. indctimerange <= 0 .or. indcdativarr <= 0 &
588 .or. indcnetworks <= 0 ) cycle
589 end if
590
591!!$ nintime=qctem%v7d%time(indtime)+timedelta_new(minute=30)
592!!$ CALL getval(nintime, month=mese, hour=ora)
593!!$ call init(time, year=1001, month=mese, day=1, hour=ora, minute=00)
594!!$
595
596 !find the nearest data in time before
597 indtimenear=indtime-1
598 datoprima = qctem%v7d%voldatir (indana ,indtimenear ,indlevel ,indtimerange ,inddativarr, indnetwork )
599 prima = qctem%v7d%time (indtimenear)
600
601 ! invalidated
602 if (indbattrinv > 0) then
603 if( invalidated(qctem%v7d%voldatiattrb&
604 (indana,indtimenear,indlevel,indtimerange,inddativarr,indnetwork,indbattrinv))) then
605 datoprima=rmiss
606 end if
607 end if
608
609 ! gross error check
610 if (indbattrcli > 0) then
611 if( .not. vdge(qctem%v7d%voldatiattrb&
612 (indana,indtimenear,indlevel,indtimerange,inddativarr,indnetwork,indbattrcli))) then
613 datoprima=rmiss
614 end if
615 end if
616
617
618 !find the nearest data in time after
619 indtimenear=indtime+1
620 datodopo = qctem%v7d%voldatir (indana ,indtimenear ,indlevel ,indtimerange ,inddativarr, indnetwork )
621 dopo = qctem%v7d%time (indtimenear)
622
623 ! invalidated
624 if (indbattrinv > 0) then
625 if( invalidated(qctem%v7d%voldatiattrb&
626 (indana,indtimenear,indlevel,indtimerange,inddativarr,indnetwork,indbattrinv))) then
627 datodopo=rmiss
628 end if
629 end if
630
631 ! gross error check
632 if (indbattrcli > 0) then
633 if( .not. vdge(qctem%v7d%voldatiattrb&
634 (indana,indtimenear,indlevel,indtimerange,inddativarr,indnetwork,indbattrcli))) then
635 datodopo=rmiss
636 end if
637 end if
638
639
640 IF(.NOT.c_e(datoprima) .and. .NOT.c_e(datodopo) ) cycle
641
642 gradprima=dmiss
643 graddopo=dmiss
644 grad=dmiss
645
646 !compute time gradient only inside timeconfidence
647 td=ora-prima
648 call getval(td,asec=asec)
649 if ((c_e(qctem%timeconfidence) .and. asec <= qctem%timeconfidence) .or. &
650 .not. c_e(qctem%timeconfidence)) then
651 if (c_e(datoprima)) gradprima=(datoqui-datoprima) / dble(asec)
652 end if
653
654 td=dopo-ora
655 call getval(td,asec=asec)
656 if ((c_e(qctem%timeconfidence) .and. asec <= qctem%timeconfidence) .or. &
657 .not. c_e(qctem%timeconfidence)) then
658 if (c_e(datodopo)) graddopo =(datodopo-datoqui ) / dble(asec)
659 end if
660
661
662#ifdef DEBUG
663 call l4f_log(l4f_debug,"QCtem gradprima:"// to_char(gradprima)//" graddopo:"//to_char(graddopo))
664#endif
665 ! we need some gradient
666 IF(.NOT.c_e(gradprima) .and. .NOT.c_e(graddopo) ) cycle
667
668
669 ! for gap we set negative gradient
670 ! for spike positive gradinet
671 IF(.NOT.c_e(gradprima) ) then
672
673 ! set gap for other one
674 grad= sign(abs(graddopo),-1.d0)
675
676 else IF(.NOT.c_e(graddopo) ) then
677
678 ! set gap for other one
679 grad= sign(abs(gradprima),-1.d0)
680
681 else
682
683 if (abs(max(abs(gradprima),abs(graddopo))-min(abs(gradprima),abs(graddopo))) < &
684 max(abs(gradprima),abs(graddopo))/2. .and. (sign(1.d0,gradprima)*sign(1.d0,graddopo)) < 0.) then
685 ! spike
686 grad= min(abs(gradprima),abs(graddopo))
687 else
688 ! gap
689 grad= sign(max(abs(gradprima),abs(graddopo)),-1.d0)
690 end if
691 end IF
692
693 if (qctem%operation == "gradient") then
694 write(grunit,*)grad
695 end if
696
697 !ATTENZIONE TODO : inddativarr È UNA GRANDE SEMPLIFICAZIONE NON VERA SE TIPI DI DATO DIVERSI !!!!
698 if (qctem%operation == "run") then
699
700 ! choice which network we have to use
701 if (grad >= 0) then
702#ifdef DEBUG
703 call l4f_log(l4f_debug,"QCtem choice gradient type: spike")
704#endif
705 indcnetwork=indcnetworks
706 else
707#ifdef DEBUG
708 call l4f_log(l4f_debug,"QCtem choice gradient type: gradmax")
709#endif
710 indcnetwork=indcnetworkg
711 end if
712
713 grad=abs(grad)
714 call l4f_log(l4f_debug,"gradiente da confrontare con QCtem clima:"//t2c(grad))
715
716 do indcana=1,size(qctem%clima%ana)
717
718 climaquii=(qctem%clima%voldatir(indcana &
719 ,indctime,indclevel,indctimerange,indcdativarr,indcnetwork)&
720 -tem_b(ind))/tem_a(ind) ! denormalize
721
722 climaquif=(qctem%clima%voldatir(min(indcana+1,size(qctem%clima%ana)) &
723 ,indctime,indclevel,indctimerange,indcdativarr,indcnetwork)&
724 -tem_b(ind))/tem_a(ind) ! denormalize
725
726#ifdef DEBUG
727 call l4f_log(l4f_debug,"QCtem clima start:"//t2c(climaquii))
728 call l4f_log(l4f_debug,"QCtem clima end:"//t2c(climaquif))
729#endif
730 if ( c_e(climaquii) .and. c_e(climaquif )) then
731
732 if ( (grad >= climaquii .and. grad < climaquif) .or. &
733 (indcana == 1 .and. grad < climaquii) .or. &
734 (indcana == size(qctem%clima%ana) .and. grad >= climaquif) ) then
735
736#ifdef DEBUG
737 call l4f_log(l4f_debug,"QCtem confidence:"// t2c(qctem%clima%voldatiattrb&
738 (indcana,indctime,indclevel,indctimerange,indcdativarr,indcnetwork,1)))
739#endif
740
741 qctem%v7d%voldatiattrb( indana, indtime, indlevel, indtimerange, inddativarr, indnetwork, indbattrout)=&
742 qctem%clima%voldatiattrb(indcana,indctime,indclevel,indctimerange,indcdativarr,indcnetwork,1 )
743
744 if ( associated ( qctem%data_id_in)) then
745#ifdef DEBUG
746 call l4f_log (l4f_debug,"id: "//t2c(&
747 qctem%data_id_in(indana,indtime,indlevel,indtimerange,indnetwork)))
748#endif
749 qctem%data_id_out(indana,indtime,indlevel,indtimerange,indnetwork)=&
750 qctem%data_id_in(indana,indtime,indlevel,indtimerange,indnetwork)
751 end if
752 end if
753 end if
754 end do
755 end if
756 end do
757 end do
758 end do
759 end do
760 end do
761
762 if (qctem%operation == "gradient") then
763 close (unit=grunit)
764 end if
765
766end do
767
768!!$print*,"risultato"
769!!$print *,qcspa%v7d%voldatiattrb(:,:,:,:,:,:,indbattrout)
770!!$print*,"fine risultato"
771
772return
773
774end subroutine quacontem
775
776
777end module modqctem
778
779
780!> \example v7d_qctem.F90
781!! Sample program for module qctem
Index method.
Controllo di qualità temporale.
Definition modqctem.F90:256

Generated with Doxygen.