SUBROUTINE PRE_THINNER(KLEN,KBOXNO,PBOXSZ,CD_MODE,&
 & KOBSTYPE_RQ,KCDTYPE_RQ,KSENSOR_RQ,KVNM_RQ)  

!**** SUBROUTINE PRE_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*PRE_THINNER(KLEN,KBOXNO,PBOXSZ,CD_MODE,&
!           &         KOBSTYPE_RQ,KCDTYPE_RQ,KSENSOR_RQ,KVNM_RQ)
!     WHERE KLEN       = Length of observation array
!           KBOXNO     = BOX NO.
!           PBOXSZ     = BoxSize for thinning (in degrees)
!           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)

!        PRE_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 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
!        THIBOX - THINNING BOX INDEX

!**   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
!     05/08/2004  ANTJE DETHOF  ECMWF introduce thinning criteria for REO3 data 
!     08/02/2005  CHRISTOPHE PAYAN  MF    use of QI1 for SATAM thinning if LMFSCREEN
!     23/03/04  Matthew Szyndel   Add MTSAT and FY-2 thinning criteria
!     01/2/05     A Collard ECMWF Thin for AIRS based on number of used channels 
!     30/03/2007  N. Bormann ECMWF Allow combined thinning of different sensors
!                  Favour AMSUB/MHS lowest window departure and MHS over AMSUB
!     13/2/07     A Collard ECMWF Thin for IASI based on number of used channels 
!     10/05/2007  C Payan MF  bug fixed : in case of several calls of this
!           routine in the same loop (when KBOXNO=1), MDB_THINNINGKEY_AT_HDR
!           reinitialized at RMDI (and the initial value removed). Now,
!           initialisation only for "active" data.
!     06/03/07  Paul Poli MF introduce thinning for GPSRO: 1 obs per model layer
!     12/12/07  Paul Poli MF select GPSRO obs closest to bottom of model layer
!     14/10/2008  ANTJE DETHOF  ECMWF Add varno as criterion for reo3 thinning
!     11/12/08  C. Payan Add IDPTU=173/176 case (EARS MODIS SATAM)
!     19/09/2009  Qifeng LU     ECMWF Add FY3 IRAS MWTS and MWHS
!     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 YOMANA   , ONLY : NANDAT   ,NANTIM
USE YOMANCS  , ONLY : RMDI     
USE YOMCT0   , ONLY : LALLOPR
USE YOMVNMB  , ONLY : NVNUMB
USE YOMTVRAD , ONLY : MSENSOR_HIRS,MSENSOR_MSU,MSENSOR_AMSUA,&
 & MSENSOR_IRAS,  MSENSOR_MWTS, MSENSOR_MWHS, &
 & MSENSOR_AMSUB, MSENSOR_MHS, &
 & MSENSOR_VTPR1,MSENSOR_VTPR2,MSENSOR_AIRS,MSENSOR_MSG_HR, &
 & MSENSOR_METEOSAT,MSENSOR_GOESIMG, &
 & MSENSOR_MTSATIMG,MSENSOR_VISSR, &
 & MSENSOR_MSG,MSENSOR_IASI,MXSENSOR,CHSENSOR  
USE YOMCOCTP , ONLY : NGTHRB, NSTRO3, NTCWC
USE YOMDB
USE YOMOBS
IMPLICIT NONE

!     DUMMY VARIABLES
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KBOXNO 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PBOXSZ 
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
REAL(KIND=JPRB)   , ALLOCATABLE :: ZKEY(:,:)
INTEGER(KIND=JPIM), PARAMETER   :: icolumns=4,ibx=2,itm=3,isq=4,ijo=1
INTEGER(KIND=JPIM) :: ITIME_DIFF, ISENSOR, IVARNO, ISAZA, ICHAN, &
 & IANRTM, IOBS, ILSQ, ITOS, IOBSTYPE, ILEN, IACTIVE, ICOUNT, IDPTU, ICDTYPE, ICLD, IOBRTM, IND_PRESS  
INTEGER(KIND=JPIM) :: IRSTA(KLEN,4),IBOX(KLEN),ITIME_UNITS(KLEN),INADA,ICV(KLEN)
INTEGER(KIND=JPIM) :: IWIN_CHAN(0:MXSENSOR)
INTEGER(KIND=JPIM) :: JBODY,JOBS,JACTIVE
INTEGER(KIND=JPIM) :: IDBDAT, IDBETM
REAL(KIND=JPRB)    :: ZTIME_UNIT,ZSTDEV,ZCLEAR,ZCLEAR_WIN,ZOBPPP,ZPRESS_DIFF,ZOBQI
REAL(KIND=JPRB)    :: ZWINTB,ZBGDEP,ZOBS,ZNOCLR,ZOBPRL
CHARACTER(LEN=8) :: CL_CDSENSOR
CHARACTER(LEN=3) :: CLREO3

LOGICAL, DIMENSION(KLEN) :: LL_ACTIVE,LL_TYPE
LOGICAL :: LLBGDEP,LLNUMUSED
LOGICAL :: LL_ICLD, LL_SATOB, LL_GPSRO
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
#include "findl.intfb.h"
#include "gersta_v.intfb.h"
#include "ngenada.intfb.h"
#include "reftim.intfb.h"
#include "thibox.intfb.h"

#include "fcobs.h"

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


!        0.       INITIALIZE
!                 ----------
!*
!           1.1   LOCAL VARIABLES
IF (LHOOK) CALL DR_HOOK('PRE_THINNER',0,ZHOOK_HANDLE)
IF(KBOXNO /= 1 .AND.&
   & KBOXNO /= 2 .AND.&
   & KBOXNO /= 3       ) THEN  
  WRITE(NULERR,'(''BAD THINNING BOX NO. IN PRE_THINNER '',I10)') KBOXNO
  CALL ABOR1('PRE_THINNER: BAD THINNING MODE')
ENDIF

!           1.1   LOCAL VARIABLES

LL_ICLD=.true.
ILEN= KLEN
ZTIME_UNIT=20._JPRB                 ! In minutes
LL_SATOB = (CD_MODE == 'SATOB' .OR. CD_MODE == 'SATAM')
LL_GPSRO = (CD_MODE == 'GPSRO')

IF(CD_MODE == 'STMCD') THEN
! Do nothing
ELSEIF(CD_MODE == 'RAD1C') THEN
  IWIN_CHAN(:)=0
  IWIN_CHAN(MSENSOR_HIRS)  = 8
  IWIN_CHAN(MSENSOR_IRAS)  = 9
  IWIN_CHAN(MSENSOR_MWTS)  = 1
  IWIN_CHAN(MSENSOR_MWHS)  = 1 ! equivalent to AMSU-B/MHS channel 2
  IWIN_CHAN(MSENSOR_AIRS)  = 787
  IWIN_CHAN(MSENSOR_IASI)  = 2239
  IWIN_CHAN(MSENSOR_MSU)   = 1
  IWIN_CHAN(MSENSOR_AMSUA) = 4
  IWIN_CHAN(MSENSOR_AMSUB) = 2
  IWIN_CHAN(MSENSOR_MHS)   = 2
  IWIN_CHAN(MSENSOR_VTPR1) = 8
  IWIN_CHAN(MSENSOR_VTPR2) = 8
  IWIN_CHAN(MSENSOR_MSG_HR)= 6
  LLBGDEP=KSENSOR_RQ == MSENSOR_MSU .OR. KSENSOR_RQ == MSENSOR_AMSUA &
   &      .OR. KSENSOR_RQ == MSENSOR_MWTS .OR. KSENSOR_RQ == MSENSOR_MWHS &
   &      .OR. KSENSOR_RQ == MSENSOR_AMSUB .OR. KSENSOR_RQ == MSENSOR_MHS
  LLNUMUSED = ( KSENSOR_RQ == MSENSOR_AIRS .OR. KSENSOR_RQ == MSENSOR_IASI ) 
ELSEIF(CD_MODE == 'GEOS') THEN
  IWIN_CHAN(:)=0
  IWIN_CHAN(MSENSOR_METEOSAT) = 2
  IWIN_CHAN(MSENSOR_GOESIMG)  = 3 ! (in IFS/RTTOV. Is channel 4=10.9um on instrument)
  IWIN_CHAN(MSENSOR_MTSATIMG)= 1
  IWIN_CHAN(MSENSOR_VISSR)= 1
  IWIN_CHAN(MSENSOR_MSG) = 6
  ZTIME_UNIT=15._JPRB                 ! In minutes
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 PRE_THINNER '',A5)') CD_MODE
  CALL ABOR1('PRE_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.2   ANALYSIS TIME (IN MINUTES FROM REFERENCE DATE)

CALL REFTIM(NANDAT,NANTIM,IANRTM)

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

!        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
!If one body entry has varno=knvm_rq select this obs
    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,'(''     PRE_THINNER: MATCHING REQUEST COUNT - '',I8,2I4,2(1X,A8),F8.2)') &
 & ICOUNT,KOBSTYPE_RQ,KCDTYPE_RQ,CL_CDSENSOR,CD_MODE,PBOXSZ  
IF(ICOUNT == 0)  GO TO 8

!           1.2   THINNING BOX INDEX
CALL THIBOX(ROBHDR(1:ILEN,MDBLAT),ROBHDR(1:ILEN,MDBLON),PBOXSZ,IBOX,LL_TYPE)

!*          1.3   VARIOUS UN_VECTORIZABLE STUFF

LL_ACTIVE(:)=.FALSE.
CALL GERSTA_V(ROBHDR(1:ILEN,MDBRST),ICV,IRSTA)

OBS_LOOP1: DO JOBS = 1,ILEN

  IF(.NOT.LL_TYPE(JOBS)) THEN
    CYCLE OBS_LOOP1
  ENDIF

!*          1.3.1 STATUS

  IF(IRSTA(JOBS,2) == 1 .OR. IRSTA(JOBS,3) == 1 .OR. IRSTA(JOBS,4) == 1) THEN
    CYCLE OBS_LOOP1
  ENDIF

  CALL NGENADA(JOBS,INADA)
  IF(INADA == 0) THEN
    CYCLE OBS_LOOP1
  ENDIF

!*          1.3.2 DEFINE ACTIVE REPORT

  LL_ACTIVE(JOBS)=.TRUE.

!           1.3.4 MINUTES OFF TIME

  IDBDAT = ROBHDR(JOBS,MDBDAT)
  IDBETM = ROBHDR(JOBS,MDBETM)
  CALL REFTIM(IDBDAT,IDBETM,IOBRTM)
  ITIME_DIFF=IANRTM-IOBRTM
  ITIME_UNITS(JOBS)=ABS(INT(ITIME_DIFF/ZTIME_UNIT))

!           1.3.5 FIND THE CLOSEST STANDARD PRESSURE LEVEL

  IF (LL_SATOB) THEN
    ZOBPPP = ROBODY(MLNKH2B(JOBS),MDBPPP)
    CALL FINDL(ZOBPPP,IND_PRESS,ZPRESS_DIFF)
    IBOX(JOBS)=IBOX(JOBS)*100+IND_PRESS
  ENDIF

!           1.3.6 FIND THE CLOSEST MODEL LEVEL

  IF (LL_GPSRO) THEN
    ZOBPPP = ROBODY(MLNKH2B(JOBS),MDB_SURFEMISS_AT_BODY)
    IBOX(JOBS)=IBOX(JOBS)*100+INT(ZOBPPP,JPIM)
  ENDIF

ENDDO OBS_LOOP1

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

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

!        2.       ALLOCATE AND PRESET SORTING ARRAYS
!                 ----------------------------------

!           2.1   ALLOCATE KEY, SORTING INDEX AND POINTER/SORT ARRAY

ALLOCATE(ZKEY(ICOUNT+MOD(ICOUNT+1,2),icolumns))
IF(LALLOPR) WRITE(NULOUT,9990) 'ZKEY     ',SIZE(ZKEY     ),SHAPE(ZKEY     )
ZKEY(:,:) = 0.0_JPRB

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

!        3.       FILL SORT ARRAY
!                 ---------------

!           3.1   LOOP OVER OBSERVATIONS

IACTIVE = 0
DO JOBS = 1, ILEN
  IF(LL_ACTIVE(JOBS)) THEN
    IACTIVE = IACTIVE + 1
    IF(KBOXNO == 1 ) ROBHDR(JOBS,MDB_THINNINGKEY_AT_HDR(1:JP_NUMTHBOX)) = RMDI
    ZKEY(IACTIVE,ijo) = JOBS
    ZKEY(IACTIVE,isq) = ROBHDR(JOBS,MDBONM)
  ENDIF
ENDDO

!           3.2   CROSS CHECK COUNTS

IF(IACTIVE /= ICOUNT) THEN
  WRITE(NULERR,'('' *** ERROR IN PRE_THINNER (1): '')')
  WRITE(NULERR,'(''     IACTIVE,ICOUNT = '',2I10)') IACTIVE,ICOUNT
  CALL ABOR1('PRE_THINNER: IACTIVE /= ICOUNT')
ENDIF

!*
!     ------------------------------------------------------------------

!        5.       PREPARE FOR SORT of OBSERVATIONS
!                 --------------------------------
!*
!*          5.1   SORTING KEY - tcwc

IF(CD_MODE == 'TCWC') THEN
  DO JACTIVE = 1,ICOUNT
    IOBS = ZKEY(JACTIVE,ijo)

!*AF remove type of surface because it is not set for tcwc (meris data)
!*          5.1.1 SORTING KEY
    ITOS = 0

    ZKEY(JACTIVE,ibx) = IBOX(IOBS)*10 + (1-ITOS)
    ZKEY(JACTIVE,itm) = ITIME_UNITS(IOBS)
  ENDDO

!*          5.2   SORTING KEY - rad1c

ELSEIF(CD_MODE == 'RAD1C') THEN

! new hirs cloud calc

  DO JACTIVE = 1,ICOUNT
    IOBS = ZKEY(JACTIVE,ijo)
    ISENSOR = ROBHDR(IOBS,MDBSSIA)

!           5.2.1 ZENITH ANGLE, in degrees in steps of 10

    ISAZA = NINT(ABS(ROBHDR(IOBS,MDB_ZENITH_AT_SAT)))/10

!           5.2.2 FIND MAXIMUM MEASURED TB in HIRS and VTPR,
!                 OR MIMINUM DEPARTURE IN MSU AND AMSU-A window channels

    ZWINTB=999._JPRB
    ZNOCLR=0._JPRB  ! Initialise to sum number of clears for curent ob.
 
    DO JBODY=MLNKH2B(IOBS),MLNKH2B(IOBS+1)-1
      IF(ROBODY(JBODY,MDBVNM) /= NVNUMB(50)) CYCLE

      ICHAN=NINT(ROBODY(JBODY,MDBPPP))


      !  Test if channel is not rejected already and, if so, add one to 
      ! count for current ob
      IF (.NOT.( & 
&           BTEST( NINT(ROBODY(JBODY,MDBDSTA)) ,1) .OR. &
&           BTEST( NINT(ROBODY(JBODY,MDBDSTA)) ,2) .OR. &
&           BTEST( NINT(ROBODY(JBODY,MDBDSTA)) ,3)      &
&           )) ZNOCLR = ZNOCLR + 1._JPRB 
      IF(ICHAN == IWIN_CHAN(ISENSOR)) THEN
         IF(LLBGDEP) THEN
            ZBGDEP= ROBODY(JBODY,MDBOMF)
            IF(ZBGDEP /= RMDI) ZWINTB=MIN(ABS(ZBGDEP),100._JPRB)
         ELSE
            ZOBS=ROBODY(JBODY,MDBVAR)
            IF(ZOBS /= RMDI) ZWINTB=1000._JPRB-ZOBS
         ENDIF
      ENDIF

    ENDDO

!*          5.2.6 SORTING KEYS

    ZKEY(JACTIVE,ibx) = IBOX(IOBS)
    IF(LLNUMUSED .AND. ZNOCLR /= RMDI)THEN 
      ZKEY(JACTIVE,itm) = NINT(1000._JPRB-ZNOCLR)
    ELSE
      IF(ISENSOR == MSENSOR_HIRS .OR. ISENSOR == MSENSOR_IRAS)THEN
        IF(ZNOCLR > 0.0_JPRB)THEN
          ZKEY(JACTIVE,itm) = NINT(ZWINTB)-100._JPRB ! Favour data with some spots not passive
        ELSE
          ZKEY(JACTIVE,itm) = NINT(ZWINTB)
        ENDIF
      ELSEIF(ISENSOR == MSENSOR_MHS)THEN
        ZKEY(JACTIVE,itm) = NINT(ZWINTB)-100._JPRB  ! Favour MHS over AMSUB
      ELSE
        ZKEY(JACTIVE,itm) = NINT(ZWINTB)
      ENDIF
    ENDIF
  ENDDO

!*          5.3   SORTING KEY - geos

ELSEIF(CD_MODE == 'GEOS') THEN
  DO JACTIVE = 1,ICOUNT
    IOBS = ZKEY(JACTIVE,ijo)
    ISENSOR = ROBHDR(IOBS,MDBSSIA)

!           5.3.1 PERCENT OF CLEAR PIXELS WITHIN CSR QUADRANT IN ChANNEL
!                 AND IN WINDOW CHANNEL (stored in reference p level)
!                 AND STANDARD DEV OF CLEAR SKY PIXEL (lowest weight)
!                 OR WINDOW CHANNEL TB

    ZSTDEV = 0.0_JPRB
    ZCLEAR = 100._JPRB
    ZCLEAR_WIN=100._JPRB
    ZWINTB=999._JPRB
    DO JBODY=MLNKH2B(IOBS),MLNKH2B(IOBS+1)-1
      IF(ROBODY(JBODY,MDBVNM) /= NVNUMB(50)) CYCLE
      ICHAN=NINT(ROBODY(JBODY,MDBPPP))
      IF(ICHAN == IWIN_CHAN(ISENSOR) ) THEN
        IF(ROBODY(JBODY,MDBPRL) /= RMDI) ZCLEAR_WIN=ROBODY(JBODY,MDBPRL)
        IF(ROBODY(JBODY,MDBVAR) /= RMDI) ZWINTB = ROBODY(JBODY,MDBVAR)
      ENDIF
        ! MET: ZCLEAR=ZCLEAR_WIN if window ch(=ch 2) TB present, else ZCLEAR=clear of WV
        ! GOES: ZCLEAR=%clear of ch4 (=ch2 WV value)
      IF(ROBODY(JBODY,MDBRER) /= RMDI) ZSTDEV = ROBODY(JBODY,MDBRER)
      IF(ROBODY(JBODY,MDBPRL) /= RMDI) ZCLEAR = ROBODY(JBODY,MDBPRL)
    ENDDO

!*          5.3.2 SORTING KEY

    IF (ISENSOR == MSENSOR_METEOSAT) THEN       ! METEOSAT 
      ZKEY(JACTIVE,ibx) = IBOX(IOBS)
      ZKEY(JACTIVE,itm) = 100._JPRB - ZCLEAR                     &! % not clear in win or wv channel
       & + (100._JPRB - ZCLEAR_WIN) / 100._JPRB &! % not clear in win channel
       & + ZSTDEV/1000._JPRB                      ! stdv of obs  

    ELSEIF(ISENSOR == MSENSOR_GOESIMG) THEN     ! GOES
      ZKEY(JACTIVE,ibx) = IBOX(IOBS)
      ZKEY(JACTIVE,itm) = 1000._JPRB - ZWINTB      ! max window channel TB
    ELSEIF(ISENSOR == MSENSOR_MSG) THEN         ! SEVIRI
      ZKEY(JACTIVE,ibx) = IBOX(IOBS)
      ZKEY(JACTIVE,itm) = 1000._JPRB - ZWINTB      ! max window channel TB
    ELSEIF(ISENSOR == MSENSOR_MTSATIMG) THEN    ! MTSAT
      ZKEY(JACTIVE,ibx) = IBOX(IOBS)
      ZKEY(JACTIVE,itm) = 1000._JPRB - ZWINTB      ! max window channel TB
    ELSEIF(ISENSOR == MSENSOR_VISSR) THEN       ! FY-2
      ZKEY(JACTIVE,ibx) = IBOX(IOBS)
      ZKEY(JACTIVE,itm) = 1000._JPRB - ZWINTB      ! max window channel TB
    ENDIF
  ENDDO

!*          5.4   SORTING KEY - satob

ELSEIF(CD_MODE == 'SATOB') THEN
  DO JACTIVE = 1,ICOUNT
    IOBS = ZKEY(JACTIVE,ijo)

!*          5.4.1 SORTING KEY
    ZKEY(JACTIVE,ibx) = IBOX(IOBS)
    ZKEY(JACTIVE,itm) = ITIME_UNITS(IOBS)
  ENDDO

!*          5.5   SORTING KEY - satam

ELSEIF(CD_MODE == 'SATAM') THEN
  DO JACTIVE = 1,ICOUNT
    IOBS = ZKEY(JACTIVE,ijo)

!           5.5.1 QUALITY ESTIMATE (DISTANCE FROM OPTIMUM)

    ! Set which QI should be used for thinning preference. 
    ! QI1 - Forecast dependent; QI2 - Forecast independent
    ! If QI is missing, treat as if it was zero.
    IDPTU  = ROBHDR(IOBS,MDBSBDPT)
    ZOBQI=0.0_JPRB
    IF(ABS(ROBHDR(IOBS,MDBSBQI1)) /= RMDI &
     & .AND. (IDPTU == 254 .OR. LMFSCREEN) ) THEN        ! EUMETSAT
      ZOBQI= 100._JPRB - ROBHDR(IOBS,MDBSBQI1)
    ELSEIF(  ABS(ROBHDR(IOBS,MDBSBQI3)) /= RMDI &
     & .AND. .NOT. LMFSCREEN  &
     & .AND. (     IDPTU == 34  .OR. IDPTU == 160  &     ! JMA, NESDIS
     &        .OR. IDPTU == 173 .OR. IDPTU == 176)) THEN ! Pre-2010 CIMSS, CIMSS
      ZOBQI= 100._JPRB - ROBHDR(IOBS,MDBSBQI3)
    ELSE
      ZOBQI= 100.0_JPRB
    ENDIF

    ZOBQI =MIN(MAX(ZOBQI,0.0_JPRB),100._JPRB)


!           5.5.2 CLOUD WVCL/IR/VIS/WVMIX=0/1/2/3 - WVMW=5

!   IWVMW=NINT(ROBHDR(IOBS,MDBSBCMM))/5
!MR IBOX(IOBS)=IBOX(IOBS)*10+IWVMW   ! Is this really right? /Erik

!*          5.5.3 SORTING KEY

    ZKEY(JACTIVE,ibx) = IBOX(IOBS)
    ZKEY(JACTIVE,itm) = ZOBQI + ITIME_UNITS(IOBS)/100._JPRB
  ENDDO

!*          5.6   SORTING KEY - scatt

ELSEIF(CD_MODE == 'SCATT') THEN
  DO JACTIVE = 1,ICOUNT
    IOBS = ZKEY(JACTIVE,ijo)

!           5.6.1 Nothing, yet

    ITOS = 0

!*          5.6.2 SORTING KEY

    ZKEY(JACTIVE,ibx) = IBOX(IOBS)*10 + (1-ITOS)
    ZKEY(JACTIVE,itm) = ITIME_UNITS(IOBS)
  ENDDO

!*          5.7    SORTING KEY - satem/stmcd

ELSEIF(CD_MODE == 'STMCD') THEN
  DO JACTIVE = 1,ICOUNT
    IOBS = ZKEY(JACTIVE,ijo)

!           5.7.1 LAND/SEA QUALIFIER

    ILSQ = 1 

!           5.7.2 CLEAR/CLOUDY (DATA PROCESSING TECHNIQUE)
!                 (32=CLEAR, 16=PARTLY CLOUDY, 8=CLOUDY)

    ICLD = ROBHDR(IOBS,MDB_RETRTYPE_AT_HDR)

!*          5.7.3 SORTING KEYS

    ZKEY(JACTIVE,ibx) = IBOX(IOBS)*10 + ILSQ
    ZKEY(JACTIVE,itm) = 32-ICLD + ITIME_UNITS(IOBS)/100._JPRB
  ENDDO

!*          5.8    SORTING KEY - reo3

ELSEIF(CD_MODE == 'REO3') THEN
  DO JACTIVE = 1,ICOUNT
    IOBS = ZKEY(JACTIVE,ijo)

!*          5.8.1 SORTING KEY
    ZKEY(JACTIVE,ibx) = IBOX(IOBS)
    ZKEY(JACTIVE,itm) = ITIME_UNITS(IOBS)
  ENDDO

!*          5.9   SORTING KEY - gpsro

ELSEIF(CD_MODE == 'GPSRO') THEN
  DO JACTIVE = 1,ICOUNT
    IOBS = ZKEY(JACTIVE,ijo)

!*          5.9.1 HEIGHT ABOVE GEOID

    ZOBPRL= ROBODY(MLNKH2B(IOBS),MDBPRL)

!*          5.9.2 SORTING KEY

    ZKEY(JACTIVE,ibx) = IBOX(IOBS)
    ZKEY(JACTIVE,itm) = ZOBPRL
  ENDDO

ENDIF

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

!*       6.       STORE SORT KEY INTO ODB
!                 -----------------------

!*          6.1      LOOP OVER ALL ACTIVE OBSERVATIONS

DO JACTIVE = 1,ICOUNT
  IOBS = ZKEY(JACTIVE,ijo)

!*          6.2  STORE BOX KEY

  IF(KBOXNO >= 1 .AND. KBOXNO <= JP_NUMTHBOX)      THEN
    ROBHDR(IOBS,MDB_THINNINGKEY_AT_HDR(KBOXNO)) = ZKEY(JACTIVE,ibx)
  ENDIF
  
!*          6.3  STORE TIME KEY

  IF(KBOXNO == 1)  THEN
    ROBHDR(IOBS,MDB_THINNINGTIMEKEY_AT_HDR) = ZKEY(JACTIVE,itm)
  ENDIF
ENDDO

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

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

DEALLOCATE(ZKEY)
IF(LALLOPR) WRITE(NULOUT,9991) 'ZKEY     '

9990 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8)
9991 FORMAT(1X,'ARRAY ',A10,' DEALLOCATED ')

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

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