SUBROUTINE POST_THINNER(KLEN,CD_MODE,&
 & KOBSTYPE_RQ,KCDTYPE_RQ,KSENSOR_RQ,KVNM_RQ)  

!**** SUBROUTINE POST_THINNER - HORIZONTAL THINNING OF SATELLITE DATA

!          HEIKKI JARVINEN   ECMWF          15/08/1995
!          DRASKO VASILJEVIC ECMWF          21/10/1999
!          ERIK ANDERSSON    ECMWF          01/02/2000

!*    PURPOSE
!     -------

!        REDUCE THE NUMBER OF SATELLITE REPORTS TO A SUITABLE DENSITY.

!**   INTERFACE
!     ---------

!     ***CALL*POST_THINNER(KLEN,CD_MODE,&
!           &         KOBSTYPE_RQ,KCDTYPE_RQ,KSENSOR_RQ,KVNM_RQ)
!     WHERE KLEN       = Length of observation array
!           CD_MODE    = Modus operandii
!           KOBSTYPE_RQ= Observation type to process (-1 means ANY)
!           KCDTYPE_RQ = Code type to process        (-1 means ANY)
!           KSENSOR_RQ = Process like which sensor   (-1 means ANY)
!           KVNM_RQ    = Variable number to process  (-1 means whole report)

!        POST_THINNER IS CALLED BY SUBROUTINE THINN

!*    METHOD
!     ------

!        THINNING IS PERFORMED WITH AID OF A GLOBAL
!     ARRAY IN EACH PROCESSOR OF AN MPP-COMPUTER.
!     EACH PROCESSOR PERFORMS THE THINNING OF THE GLOBAL SET OF DATA.
!     THE ARRAY OF DATA IS SORTED ACCORDING TO A KEY, THE CONTENT OF WHICH
!     DEPENDS ON WHICH DATA TYPE IS BEING THINNED.

!        ONLY ONE REPORT PER BOX IS ALLOWED THE ONE THAT HAS THE HIGHEST
!     SELECTION PRIORITY WITHIN THE BOX IS COSEN.
!     AT THE FIRST CALL OF POST_THINNER, A STRINGENT CRITERION FOR THE BOX
!     SIZE IS APPLIED (~50KM) TO ENSURE A MINIMUM DISTANCE BETWEEN RE-
!     PORTS.  AT THE SECOND CALL THE THINNING GOES DOWN TO ~250KM RE-
!     SOLUTION (PBOXSZ) DEPENDING ON DATA TYPE.

!*    EXTERNALS
!     ---------

!        REFTIM - REFERENCE DATE

!**   MODIFICATIONS
!     -------------
!     27/08/2001  CHRISTINA KOPKEN  ECMWF Introduce percent of clear
!                    pixels of CSR into thinning for geos-radiances/METEOSAT.
!     30/10/2001  CHRISTINA KOPKEN  ECMWF introduce goes img, similar to meteosat
!     17/04/2002  CHRISTINA KOPKEN  ECMWF introduce thinning criteria for goesimg
!        M.Hamrud      01-Dec-2003 CY28R1 Cleaning 
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        A.Dethof      05-Aug-2004 CY28 introduce thinning for REO3 data
!     14/07/2006  Niels Bormann   ECMWF   Move HIRS cloud detection to HRETR 
!     06/03/2007  Paul Poli         MF    introduce thinning for GPSRO
!     30/03/2007  N. Bormann ECMWF Allow combined thinning of different sensors
!        A.Dethof      14-Oct-2008 Add varno as criterion for reo3 thinning
!     01/12/2009  N. Bormann       Rationalisation of AMV thinning
!     A. Fouilloux   31/03/10: use new codetype for MERIS data (replaced NSSMI by NTCWC)
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMLUN   , ONLY : NULOUT   ,NULERR
USE YOMNMEV  , ONLY : ND1EVENT 
USE YOMTVRAD , ONLY : MXSENSOR,CHSENSOR  
USE YOMCOCTP , ONLY : NGTHRB, NSTRO3, NTCWC
USE YOMDB
USE YOMOBS
IMPLICIT NONE

!     DUMMY VARIABLES
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEN 
CHARACTER(LEN=*)  ,INTENT(IN)    :: CD_MODE 
INTEGER(KIND=JPIM),INTENT(IN)    :: KOBSTYPE_RQ 
INTEGER(KIND=JPIM),INTENT(IN)    :: KCDTYPE_RQ 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSENSOR_RQ 
INTEGER(KIND=JPIM),INTENT(IN)    :: KVNM_RQ 
!     LOCAL VARIABLES
INTEGER(KIND=JPIM) ::  ISENSOR, IVARNO, IOBSTYPE, ILEN, ICOUNT, ICDTYPE
INTEGER(KIND=JPIM) :: IRSTA(KLEN,4),INADA,ICV(KLEN)
INTEGER(KIND=JPIM) :: JBODY,JOBS,J
!REAL(KIND=JPRB) ,DIMENSION(20)   :: ZVBGDEP             
!INTEGER(KIND=JPIM)  ,DIMENSION(20)   :: ICHLA               
CHARACTER(LEN=8) :: CL_CDSENSOR
CHARACTER(LEN=3) :: CLREO3

LOGICAL, DIMENSION(KLEN) :: LL_ACTIVE,LL_TYPE
LOGICAL :: LL_SATOB
LOGICAL :: LL_PRINT
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
#include "gersta_v.intfb.h"
#include "ngenada.intfb.h"

#include "fcobs.h"

#include "openmp_obs.h"
!*
!     ------------------------------------------------------------------

!        0.       INITIALIZE
!                 ----------
!*
!           1.1   LOCAL VARIABLES

IF (LHOOK) CALL DR_HOOK('POST_THINNER',0,ZHOOK_HANDLE)
LL_PRINT=LTHINNER_PRINT
ILEN= KLEN
LL_SATOB = (CD_MODE == 'SATOB' .OR. CD_MODE == 'SATAM')

IF(CD_MODE == 'STMCD') THEN
! Do nothing
ELSEIF(CD_MODE == 'RAD1C') THEN
! Do nothing
ELSEIF(CD_MODE == 'GEOS') THEN
! Do nothing
ELSEIF(CD_MODE == 'TCWC') THEN
! Do nothing
ELSEIF(CD_MODE == 'SATOB') THEN
! Do nothing
ELSEIF(CD_MODE == 'SATAM') THEN
! Do nothing
ELSEIF(CD_MODE == 'SCATT') THEN
! Do nothing
ELSEIF(CD_MODE == 'REO3') THEN
! Do nothing
ELSEIF(CD_MODE == 'GPSRO') THEN
! Do nothing
ELSE
  WRITE(NULERR,'(''BAD THINNING MODE IN POST_THINNER '',A5)') CD_MODE
  CALL ABOR1('POST_THINNER: BAD THINNING MODE')
ENDIF

IF(CD_MODE /= 'REO3' .AND. KSENSOR_RQ >= 0 .AND. KSENSOR_RQ <= MXSENSOR) THEN
  CL_CDSENSOR=CHSENSOR(KSENSOR_RQ)
ELSEIF(CD_MODE == 'REO3') THEN
  WRITE(CLREO3,'(I3.3)') KSENSOR_RQ
  CL_CDSENSOR='     '//CLREO3
ELSE
  CL_CDSENSOR='        '
ENDIF

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

!        1.       LOOP OBSERVATIONS
!                 -----------------

!           1.1   INDICATE WHICH JOBS ARE THE REQUESTED TYPE OF DATA

DO JOBS = 1,ILEN
  IOBSTYPE  = ROBHDR(JOBS,MDBOTP)
  ICDTYPE = ROBHDR(JOBS,MDB_CODETYPE_AT_HDR)
  IVARNO  = 0
  IF(ICDTYPE == NGTHRB ) THEN
    ISENSOR = ROBHDR(JOBS,MDBSSIA)
  ELSEIF( ICDTYPE == NSTRO3) THEN
    ISENSOR = ROBHDR(JOBS,MDBSSIA)
    IVARNO  = 0
    DO JBODY=MLNKH2B(JOBS),MLNKH2B(JOBS+1)-1
      IF(ROBODY(JBODY,MDBVNM) == KVNM_RQ) IVARNO=ROBODY(JBODY,MDBVNM)
    ENDDO
  ELSEIF( ICDTYPE == NTCWC) THEN
    ISENSOR = ROBHDR(JOBS,MDBSSIA)
  ELSE
    ISENSOR = 0
  ENDIF

  IF( ICDTYPE == NSTRO3) THEN
    LL_TYPE(JOBS)=(IOBSTYPE == KOBSTYPE_RQ.OR. KOBSTYPE_RQ== -1) .AND. &
     & (ICDTYPE  == KCDTYPE_RQ .OR. KCDTYPE_RQ == -1) .AND. &
     & (IVARNO   == KVNM_RQ    .OR. KVNM_RQ == -1)
  ELSEIF( ICDTYPE == NTCWC) THEN
    LL_TYPE(JOBS)=(IOBSTYPE == KOBSTYPE_RQ.OR. KOBSTYPE_RQ== -1) .AND. &
     & (ICDTYPE  == KCDTYPE_RQ .OR. KCDTYPE_RQ == -1) .AND. &
     & (ISENSOR  == KSENSOR_RQ .OR. KSENSOR_RQ == -1)
  ELSE
    LL_TYPE(JOBS)=(IOBSTYPE == KOBSTYPE_RQ.OR. KOBSTYPE_RQ== -1) .AND. &
     & (ICDTYPE  == KCDTYPE_RQ .OR. KCDTYPE_RQ == -1)
  ENDIF

ENDDO

ICOUNT=COUNT(LL_TYPE(1:ILEN))
WRITE(NULOUT,'(''     POST_THINNER: MATCHING REQUEST COUNT - '',I8,2I4,2(1X,A8))') &
 & ICOUNT,KOBSTYPE_RQ,KCDTYPE_RQ,CL_CDSENSOR,CD_MODE  
CALL FLUSH(NULOUT)
IF(ICOUNT == 0)  GO TO 8
LL_ACTIVE(:)=.FALSE.
CALL GERSTA_V(ROBHDR(1:ILEN,MDBRST),ICV,IRSTA)
OBS_LOOP1: DO JOBS = 1,ILEN
  IF(.NOT.LL_TYPE(JOBS)) CYCLE OBS_LOOP1

!*          1.3.1 STATUS

  IF(IRSTA(JOBS,2) == 1 .OR. IRSTA(JOBS,3) == 1 .OR. IRSTA(JOBS,4) == 1) CYCLE OBS_LOOP1
    
  CALL NGENADA(JOBS,INADA)
  IF(INADA == 0) CYCLE OBS_LOOP1

!*          1.3.2 DEFINE "ACTIVE" REPORT FOR NOW

  LL_ACTIVE(JOBS)=.TRUE.

ENDDO OBS_LOOP1

ICOUNT=COUNT(LL_ACTIVE(1:ILEN))
WRITE(NULOUT,'(''     POST_THINNER: ACTIVE DATA COUNT      - '',I8,2I4,2(1X,A8))') &
 & ICOUNT,KOBSTYPE_RQ,KCDTYPE_RQ,CL_CDSENSOR,CD_MODE  
CALL FLUSH(NULOUT)
IF(ICOUNT == 0)  GO TO 8

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

!        3.       LOOP OVER OBSERVATIONS
!                 ----------------------

IF(KVNM_RQ /= -1 ) THEN

!       6.4.2.1 Thinning of INDIVIDUAL DATUM, if KVNM_RQ set

  DO J = 1,ICOUNT
    IF(.NOT.LL_ACTIVE(J)) THEN
      DO JBODY = MLNKH2B(J),MLNKH2B(J+1)-1
        IF(ROBODY(JBODY,MDBVNM) == KVNM_RQ) THEN
          ROBODY(JBODY,MDBDSTA) = ZCHSTAT_REJECT( ROBODY(JBODY,MDBDSTA))
          ROBODY(JBODY,MDBDEV1) = ZCHEV1( ROBODY(JBODY,MDBDEV1),ND1EVENT(13))
        ENDIF
      ENDDO
    ENDIF
  ENDDO
ENDIF

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

!        7.       RELEASE WORK SPACE
!                 ------------------

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

!        8.       RETURN
!                 ------
8 CONTINUE
IF (LHOOK) CALL DR_HOOK('POST_THINNER',1,ZHOOK_HANDLE)
END SUBROUTINE POST_THINNER
