SUBROUTINE INCVFILT(KDOBS,KLEN,KDBDY,KMXBDY,KCMBDY,KVNM)

!**** SUBROUTINE INCVFILT - Reject obs. with poor incremental convergence

!     Author: F. Bouttier ECMWF 26/3/2000

!     Purpose: To reduce the weight of observations that converge very poorly,
!              by inflating the assumed obs standard error.

!     Interface: Much like hdepart:
!           KDOBS = First dimension, observations
!           KLEN  = Actual number of observations
!           KDBDY = Second dimension, data
!           KMXBDY= Actual maximum number of data.
!           KCMBDY= Number of data in each report
!           KVNM  = ROBSAR variable numbers

!     Method: At a selected incremental outer loop update, diagnose the
!             ratio of increments at high vs low resolution whenever possible
!             from the observation array. If the badness exceeds a given ratio,
!             inflate the observation standard error steeply but smoothly in
!             order to reduce their weight in subsequent inner loops.

!     Modifications:
!      F.Bouttier      26/03/2000  : original
!      S.Saarinen      12/04/2000  : ODB-zation
!        M.Hamrud      01-Oct-2003 CY28 Cleaning

!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK

USE YOMVAR   , ONLY : NUPTRA
USE YOMLUN   , ONLY : NULOUT
USE YOMVRTL  , ONLY :     LINCVDBG ,RINCVLIM ,&
 & RINCVSLOP  
USE YOMNMEV  , ONLY : ND1EVENT
USE YOMANCS  , ONLY : RMDI
USE YOMDB

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KDOBS 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDBDY 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KMXBDY 
INTEGER(KIND=JPIM),INTENT(IN)    :: KCMBDY(KDOBS) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KVNM(KDOBS,KDBDY) 
REAL(KIND=JPRB) :: ZHRCUR,ZHRPRE,ZLRPRE,ZHRINC,ZLRINC,ZRATIO,ZOBSE,ZINFL
INTEGER(KIND=JPIM) :: JBODY,JOBS,IIVNM,IBODY,ICDTYPE,ITYPE,IFLAG
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "nflgdse.intfb.h"

#include "fcobs.h"

#include "openmp_obs.h"

!     ------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('INCVFILT',0,ZHOOK_HANDLE)
WRITE(NULOUT,*) 'Filtering observations with bad incremental convergence'

! 0. Process all data in CMA array
DO JBODY=1,KMXBDY
!OCL NOVREC
  DO JOBS=1,KLEN
    IF(JBODY > KCMBDY(JOBS)) CYCLE
    IBODY=MLNKH2B(JOBS)+(JBODY-1)

    IIVNM=KVNM(JOBS,JBODY)
    IF (IIVNM == 0) CYCLE

    ICDTYPE  = ROBHDR(JOBS,MDB_CODETYPE_AT_HDR)
    ITYPE    = ROBHDR(JOBS,MDBOTP)

    ZHRCUR=ROBODY(IBODY,MDBIFC1(NUPTRA+1))    ! current o-hr
    ZHRPRE=ROBODY(IBODY,MDBIFC1(NUPTRA))      ! previous o-hr and o-lr ini
    ZLRPRE=ROBODY(IBODY,MDBIOMN(NUPTRA))      ! last o-lr final
    ZOBSE=ROBODY(IBODY,MDBFOE)                ! obs error

    ! 2. Compute convergence ratio using paranoid security checks
    ZRATIO=0.
    IF ( (ZHRCUR/=RMDI).AND.(ZHRPRE/=RMDI).AND. &
       & (ZLRPRE/=RMDI).AND.(ZOBSE/=RMDI)        ) THEN  
      ZHRINC=ZHRPRE-ZHRCUR
      ZLRINC=ZHRPRE-ZLRPRE
      IF ( (ZOBSE>100.*TINY(ZOBSE)).AND.(ABS(ZLRINC)>ZOBSE/2.) ) &
       & ZRATIO=ABS(ZHRINC/ZLRINC-1.0_JPRB)   ! Measures the lack of convergence  
    ENDIF

    ! 3. Inflate obs error
    ZINFL=1.0_JPRB+RINCVSLOP*(ZRATIO-RINCVLIM)
    ZOBSE=ZOBSE*MAX(1.0_JPRB,ZINFL)

    ! 4. Put obs error, flags, events etc back into CMA
    ROBODY(IBODY,MDBFOE)=ZOBSE
    IF (ZRATIO>RINCVLIM) THEN
      IF (LINCVDBG) THEN
        WRITE(NULOUT,*) 'INCV:type=',ITYPE,'/',ICDTYPE, &
         & 'hrinc=',ZHRINC,'lrinc=',ZLRINC,'ratio=',ZRATIO,'infl=',ZINFL  
      ENDIF
      IFLAG=MAX(0,MIN(3,NINT( ZINFL )))

      CALL NFLGDSE(IBODY,'VARQC',IFLAG)
      IF(IFLAG >= 2) THEN
        ROBODY(IBODY,MDBDSTA) = ZCHSTAT_REJECT( ROBODY(IBODY,MDBDSTA))
      ENDIF
      ROBODY(IBODY,MDBDEV1) = ZCHEV1( ROBODY(IBODY,MDBDEV1),ND1EVENT(28))
    ENDIF
  
  ENDDO
ENDDO

!     ------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('INCVFILT',1,ZHOOK_HANDLE)
END SUBROUTINE INCVFILT

