libsim  Versione7.2.1

◆ quacontem()

subroutine, public modqctem::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 557 del file modqctem.F90.

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 
766 end do
767 
768 !!$print*,"risultato"
769 !!$print *,qcspa%v7d%voldatiattrb(:,:,:,:,:,:,indbattrout)
770 !!$print*,"fine risultato"
771 
772 return
773 
774 end subroutine quacontem
775 
776 
777 end module modqctem
778 
779 
782 
Controllo di qualità temporale.
Definition: modqctem.F90:266
Index method.

Generated with Doxygen.