SUBROUTINE NEW_THINN_RADAR(KLEN,KBOXNO,PBOXSZ,KOBSTYPE)

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

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

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

USE YOMLUN   , ONLY : NULOUT   ,NULERR
USE YOMANCS  , ONLY : RMDI     
USE YOMNMEV  , ONLY :  NR1EVENT, ND1EVENT
USE YOMDB
USE YOMOBS
USE ECSORT_MIX   , ONLY : KEYSORT
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(:,:)
REAL(KIND=JPRB)   , ALLOCATABLE :: ZKEYPRE(:,:)
INTEGER(KIND=JPIM) :: IDSTA(4)
INTEGER(KIND=JPIM), PARAMETER   :: icolumns=4,ibx=2,itm=3,irn=4,ijo=1
INTEGER(KIND=JPIM), PARAMETER   :: I_MKEY(icolumns-1)=(/ibx,itm,irn/)
INTEGER(KIND=JPIM), PARAMETER   :: icolumns0=7,ipo=1,idt0=2,itm0=3,ilt=4,iln=5,icom=6,irn0=7
INTEGER(KIND=JPIM) :: IOBS, IOBSTYPE, ILEN, IACTIVE, ICOUNT, INSTA,IREJ
INTEGER(KIND=JPIM) :: IELEV
INTEGER(KIND=JPIM) :: IRET,IOLDKEY,ITHINNED,IKEY
INTEGER(KIND=JPIM) :: IRSTA(KLEN,4),ICV(KLEN)
INTEGER(KIND=JPIM) :: JBODY,JOBS,JACTIVE ! ,JPR

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 "thin_red_presort.intfb.h"

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

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

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

ILEN= KLEN

!           0.2  PRESORT OBS PER DATE, TIME, LAT, LON AND ...

ALLOCATE(ZKEYPRE(ILEN,icolumns0))

CALL THIN_RED_PRESORT(ILEN,'RADAR',ZKEYPRE,icolumns0,&
 & IPO,IDT0,ITM0,ILT,ILN,ICOM,IRN0 )

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

!        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,'(''     NEW_THINN_RADAR: MATCHING REQUEST COUNT - '',I8,1X,I4,1X,F8.2)') &
 & ICOUNT,KOBSTYPE,PBOXSZ  
IF(ICOUNT == 0)  GO TO 8

!*          1.3   VARIOUS UN_VECTORIZABLE STUFF

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

OBS_LOOP1: DO JOBS = 1,ILEN
  IOBS    = ZKEYPRE(JOBS,1)
  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

!*          1.3.2 STORED SORTING KEYS

  IF(KBOXNO >= 1 .AND. KBOXNO <= JP_NUMTHBOX) THEN
    IF(ROBHDR(IOBS,MDB_THINNINGKEY_AT_HDR(KBOXNO)) == RMDI) THEN
      CYCLE OBS_LOOP1
    ENDIF
  ENDIF

  IF(ROBHDR(IOBS,MDB_THINNINGTIMEKEY_AT_HDR) == RMDI) THEN
    CYCLE OBS_LOOP1
  ENDIF

!*          1.3.3 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.4 DEFINE ACTIVE REPORT

  LL_ACTIVE(JOBS)=.TRUE.

ENDDO OBS_LOOP1

ICOUNT=COUNT(LL_ACTIVE(1:ILEN))
WRITE(NULOUT,'(''     NEW_THINN_RADAR: 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

IACTIVE = 0
DO JOBS = 1, ILEN
  IOBS      = ZKEYPRE(JOBS,1)
  IF(LL_ACTIVE(JOBS)) THEN
    IACTIVE = IACTIVE + 1
    ZKEY(IACTIVE,ijo) = JOBS
    ZKEY(IACTIVE,irn) = ZKEYPRE(JOBS,IRN0)
  ELSE
    ROBHDR(IOBS,MDBRST ) = ZCHSTAT_REJECT(ROBHDR(IOBS,MDBRST))
    ROBHDR(IOBS,MDBREV1) = ZCHEV1(ROBHDR(IOBS,MDBREV1),NR1EVENT(10))
  ENDIF
ENDDO

!           3.2   CROSS CHECK COUNTS

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

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

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

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

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

!        5.       SORT THE OBSERVATIONS
!                 ---------------------
!*
!*          5.1    SORT AND CHECK FOR SORTING ERRORS

CALL KEYSORT(IRET,ZKEY,ICOUNT,multikey=I_MKEY)

!WRITE(NULOUT,'(''     NEW_THINN_RADAR; SORTED ZKEY'')')
!WRITE(NULOUT,*) "    INDEX       #OBS        BOX_INDEX         #ELEV          TOT_INNOV"
!DO JPR=1,ICOUNT
!  IOBS = ZKEY(JPR,1)
!  WRITE(NULOUT,'('' '',I5,1x,4(F15.2,1X))') JPR,&
!   & ZKEY(JPR,1),ZKEY(JPR,2),ZKEY(JPR,3),ZKEY(JPR,4)
!ENDDO
!CALL FLUSH(NULOUT)


!*       6.       PERFORM THE THINNING
!                 --------------------

IOLDKEY=NINT(ZKEY(1,ibx))

!*          6.1   LOOP OVER ALL ACTIVE OBSERVATIONS
!                 ALLOW ONE PROFILE PER THINNING BOX ONLY

DO JACTIVE = 2,ICOUNT
  IOBS = ZKEY(JACTIVE,ijo)
  IKEY=NINT(ZKEY(JACTIVE,ibx))

  IF(IKEY == IOLDKEY) THEN
    LL_ACTIVE(IOBS)=.FALSE.
  ELSE
    IOLDKEY = IKEY
  ENDIF
ENDDO

!*          6.2   FLAG THINNED DOPPLER VELOCITIES

!*          REJECT THE DATA, if thinned

DO JACTIVE = 1,ICOUNT
  IOBS = ZKEY(JACTIVE,IJO)
  IF(.NOT.LL_ACTIVE(IOBS)) THEN
! remove both reflectivity and Vr data for the moment
     ROBHDR(IOBS,MDBRST ) = ZCHSTAT_REJECT(ROBHDR(IOBS,MDBRST))
     ROBHDR(IOBS,MDBREV1) = ZCHEV1(ROBHDR(IOBS,MDBREV1),NR1EVENT(10))
!     DO JBODY=MLNKH2B(IOBS),MLNKH2B(IOBS+1)-1
!        IF (ROBODY(JBODY,MDBVNM) == 195) THEN
!          ROBODY(JBODY,MDBDSTA) = ZCHSTAT_REJECT(ROBODY(JBODY,MDBDSTA))
!          ROBODY(JBODY,MDBDEV1)= ZCHEV1(ROBODY(JBODY,MDBDEV1),ND1EVENT(13))
!        ENDIF
!     ENDDO
  ELSE  ! remove reflectivity data for the moment
!     WRITE(NULOUT,*) "===> ACTIVE OBS:",IOBS
     DO JBODY=MLNKH2B(IOBS),MLNKH2B(IOBS+1)-1
        IF (ROBODY(JBODY,MDBVNM) == 192) THEN
          ROBODY(JBODY,MDBDSTA) = ZCHSTAT_REJECT(ROBODY(JBODY,MDBDSTA))
          ROBODY(JBODY,MDBDEV1)= ZCHEV1(ROBODY(JBODY,MDBDEV1),ND1EVENT(13))
        ENDIF
!        WRITE(NULOUT,*) "     DATA:",ROBODY(JBODY,MDBESQN)," STATUS:",ROBODY(JBODY,MDBDSTA),&
!          &"  VARNO:",ROBODY(JBODY,MDBVNM)
     ENDDO
  ENDIF
ENDDO

ITHINNED=ICOUNT-COUNT(LL_ACTIVE(1:ILEN))
WRITE(NULOUT,*)'     NEW_THINN_RADAR: REDUNDANT REPORT COUNT - ',ITHINNED

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

!        8.       RELEASE WORK SPACE
!                 ------------------
DEALLOCATE(ZKEY)

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

!        9.       RETURN
!                 ------
8 CONTINUE
DEALLOCATE(ZKEYPRE)
IF (LHOOK) CALL DR_HOOK('NEW_THINN_RADAR',1,ZHOOK_HANDLE)
END SUBROUTINE NEW_THINN_RADAR
