SUBROUTINE PRE_THINN_RADAR(KLEN,KBOXNO,PBOXSZ,KOBSTYPE)

!**** SUBROUTINE PRE_THINN_RADAR - HORIZONTAL THINNING OF WIND DATA FROM DOPPLER RADAR

!          Th. MONTMERLE  MF/CNRM         

!*    PURPOSE
!     -------

!        REDUCE THE NUMBER OF RADAR PROFILES TO A SUITABLE DENSITY.
!        CRITERIA (with decreasing order of priority): BOX INDEX, NB OF ELEVATIONS,
!            MINIMUM INTEGRATED INNOVATION

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

!*    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
!     ---------

!        THIBOX - THINNING BOX INDEX

!**   MODIFICATIONS
!     -------------
!     ------------------------------------------------------------------

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

USE YOMLUN   , ONLY : NULOUT   ,NULERR
USE YOMANCS  , ONLY : RMDI     
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 
INTEGER(KIND=JPIM),INTENT(IN)    :: KOBSTYPE 
!     LOCAL VARIABLES
REAL(KIND=JPRB)   , ALLOCATABLE :: ZKEY(:,:)
INTEGER(KIND=JPIM) :: IDSTA(4)
INTEGER(KIND=JPIM), PARAMETER   :: icolumns=4,ibx=2,itm=3,isq=4,ijo=1
INTEGER(KIND=JPIM) :: IOBS, IOBSTYPE, ILEN, IACTIVE, ICOUNT,INSTA,IREJ
INTEGER(KIND=JPIM) :: IELEV
INTEGER(KIND=JPIM) :: IRSTA(KLEN,4),IBOX(KLEN),ICV(KLEN)
INTEGER(KIND=JPIM) :: JBODY,JOBS,JACTIVE
REAL(KIND=JPRB)    :: ZOBSE,ZBGDEP,ZTOTBGDEP

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

#include "abor1.intfb.h"
#include "gersta_v.intfb.h"
#include "ngedsta.intfb.h"
#include "thibox.intfb.h"

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

IF (LHOOK) CALL DR_HOOK('PRE_THINN_RADAR',0,ZHOOK_HANDLE)

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

!           1.1   LOCAL VARIABLES

ILEN= KLEN

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

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

!           1.1   INDICATE WHICH JOBS ARE THE REQUESTED TYPE OF DATA

DO JOBS = 1,ILEN
  IOBSTYPE  = ROBHDR(JOBS,MDBOTP)
  LL_TYPE(JOBS)=(IOBSTYPE == KOBSTYPE .OR. KOBSTYPE== -1) 
ENDDO

ICOUNT=COUNT(LL_TYPE(1:ILEN))
WRITE(NULOUT,'(''     PRE_THINNER: MATCHING REQUEST COUNT - '',I8,1X,I4,1X,F8.2)') &
 & ICOUNT,KOBSTYPE,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(1:ILEN)=.FALSE.

!* GET REPORT STATUS
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
    WRITE(NULOUT,*) "#OBS:",JOBS,"  NON-ACTIVE REPORT"
    CYCLE OBS_LOOP1
  ENDIF

!* GET NUMBER OF ACTIVE RADIAL VELOCITIES IN THE REPORT
  IREJ=0
  IELEV=0
  DO JBODY=MLNKH2B(JOBS),MLNKH2B(JOBS+1)-1
    CALL NGEDSTA(INT(ROBODY(JBODY,MDBDSTA)),INSTA,IDSTA)
    IF (ROBODY(JBODY,MDBVNM) == 195) THEN
       IELEV = IELEV + 1 
       IF(IDSTA(2) == 1 .OR. IDSTA(3) == 1 .OR. IDSTA(4) == 1) IREJ = IREJ + 1
    ENDIF
  ENDDO
  IF(IREJ == IELEV) THEN
     WRITE(NULOUT,*) "IOBS, ELEV,  OBS REJECTED:", JOBS,IELEV,IREJ
    !WRITE(NULOUT,*) "#OBS:",JOBS,"  ONLY NON-ACTIVE DATA IN THE REPORT: REPORT REJECTED"
    CYCLE OBS_LOOP1
  ENDIF


!*          1.3.2 DEFINE ACTIVE REPORT

  LL_ACTIVE(JOBS)=.TRUE.

ENDDO OBS_LOOP1

ICOUNT=COUNT(LL_ACTIVE(1:ILEN))
WRITE(NULOUT,'(''     PRE_THINNER: ACTIVE DATA COUNT      - '',I8,1X,I4,1X,F8.2)') &
 & ICOUNT,KOBSTYPE,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,icolumns))
ZKEY(:,:) = 0.0_JPRB

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

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

!           3.1   LOOP OVER OBSERVATIONS

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

!           3.2   CROSS CHECK COUNTS

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

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

!        4.       PREPARE FOR SORT OF RADAR OBSERVATIONS
!                 ---------------------------------------

!WRITE(NULOUT,'(''     PRE_THINN_RADAR; ZKEY'')')
!WRITE(NULOUT,*) "    #ACTIVE       #OBS        BOX_INDEX         CRIT       TOT_INNOV    SIGMAO     #ELEV"

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

  IELEV = 0
  ZBGDEP = 0.0
  DO JBODY=MLNKH2B(IOBS),MLNKH2B(IOBS+1)-1
     IF (ROBODY(JBODY,MDBVNM) == 195) THEN
       IELEV = IELEV + 1
       ZBGDEP = ZBGDEP + ROBODY(JBODY,MDBOMF)
       ZOBSE = ROBODY(JBODY,MDBOER)  ! Same sigmao per column
     ENDIF
  ENDDO

  ZTOTBGDEP=MIN(ABS(ZBGDEP),100._JPRB)/IELEV

!*          SORTING KEYS

  ZKEY(JACTIVE,ibx) = IBOX(IOBS)
  ZKEY(JACTIVE,itm) = 5*ZOBSE/IELEV
  ZKEY(JACTIVE,isq) = NINT(ZTOTBGDEP)

!  WRITE(NULOUT,'('' '',I4,1X,5(F15.2,1X),I4)') JACTIVE,&
!   & ZKEY(JACTIVE,ijo),ZKEY(JACTIVE,ibx),&
!   & ZKEY(JACTIVE,itm),ZKEY(JACTIVE,isq),ZOBSE,IELEV
!  CALL FLUSH(NULOUT)

!*         STORE SORT KEY INTO ODB

  IF(KBOXNO >= 1 .AND. KBOXNO <= JP_NUMTHBOX)      THEN
    ROBHDR(IOBS,MDB_THINNINGKEY_AT_HDR(KBOXNO)) = ZKEY(JACTIVE,ibx)
  ENDIF
  IF(KBOXNO == 1)  THEN
    ROBHDR(IOBS,MDB_THINNINGTIMEKEY_AT_HDR) = ZKEY(JACTIVE,itm)
  ENDIF

ENDDO

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

!        5.       RELEASE WORK SPACE
!                 ------------------

DEALLOCATE(ZKEY)

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

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