SUBROUTINE THIN_RED_PRESORT(KLEN,CD_MODE,PKEY,KCOL,&
 & KP,KDT,KTM,KLT,KLN,KAUX,KRN)  

!**** SUBROUTINE THIN_RED_PRESORT - PRESORT OBS FOR THINNING/REDUNDANCY

!          DRASKO VASILJEVIC ECMWF          16/12/2002

!*    PURPOSE
!     -------

!        PRESORT OBS FOR THINNING/REDUNDANCY

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

!     ***CALL*THIN_RED_PRESORT(KLEN,CD_MODE,PKEY,KCOL,
!                              KP,KDT,KTM,KLT,KLN,KAUX,KRN)
!     WHERE KLEN       = Length of observation array
!           CD_MODE    = Modus operandii
!           PKEY       = OBS ARRAY
!           KCOL       = 2nd dimension of PKEY
!           KP         = PKEY POSITION TO STORE OBS POINTER
!           KDT        = PKEY POSITION TO STORE OBS DATE
!           KTM        = PKEY POSITION TO STORE OBS TIME
!           KLT        = PKEY POSITION TO STORE OBS LAT
!           KLN        = PKEY POSITION TO STORE OBS LON
!           KAUX       = PKEY POSITION TO STORE OBS AUX PARAMETER
!           KRN        = PKEY POSITION TO STORE OBS RANDOM NO.

!        THIN_RED_PRESORT IS CALLED BY

!*    METHOD
!     ------

!        OBS ARE SORTED BY DATE, TIME, LAT, LON (AND ELSE).

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

!**   MODIFICATIONS
!     -------------
! Lueder von Bremen   20031013 Sorting key for SATOB/SATAM depends on pressure,
!                              u, v-wind component -->obs with lowest pressure,
!                              u-wind and v-wind is sorted first). But date, 
!                              time, lat, lon still have higher priority!!

!     2003/04/23 M.Fisher : Use RANDOM_NUMBERS_MIX
!     ------------------------------------------------------------------

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

USE YOMANCS  , ONLY : RMDI     ,RDEGREES
USE YOMDB
USE YOMOBS
USE YOMVNMB  , ONLY : NVNUMB
USE ECSORT_MIX   , ONLY : KEYSORT
USE RANDOM_NUMBERS_MIX

IMPLICIT NONE

!     DUMMY VARIABLES
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KAUX 
CHARACTER(LEN=*)  ,INTENT(IN)    :: CD_MODE
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PKEY(KLEN,KCOL)
INTEGER(KIND=JPIM),INTENT(IN)    :: KCOL
INTEGER(KIND=JPIM),INTENT(IN)    :: KP 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDT 
INTEGER(KIND=JPIM),INTENT(IN)    :: KTM 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLT 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KRN 
!     LOCAL VARIABLES
REAL(KIND=JPRB)   , ALLOCATABLE :: ZRAND0(:,:)
REAL(KIND=JPRB)   , ALLOCATABLE :: ZRAND (:)
INTEGER(KIND=JPIM), ALLOCATABLE :: IRAND (:)

INTEGER(KIND=JPIM) :: I_MKEY(KCOL-2)

LOGICAL :: LL_SATOB, LL_MOVPL, LL_RAD1C, LL_REDRP1

INTEGER(KIND=JPIM) ::  IMULTIP, IKEY, &
 & ILEN,  &
 & IRET, ILEV, JNLV  ,ICMVNM
INTEGER(KIND=JPIM) :: JOBS
REAL(KIND=JPRB)    :: ZU,ZV

REAL(KIND=JPRB)    :: ZMULTIP, ZOBPPP
REAL(KIND=JPRB) :: ZHOOK_HANDLE

TYPE(randomNumberStream) :: YL_RANDOM_STREAM

#include "p_4_sort.intfb.h"
#include "setran.intfb.h"

#include "fcobs.h"

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

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

IF (LHOOK) CALL DR_HOOK('THIN_RED_PRESORT',0,ZHOOK_HANDLE)
ILEN    = KLEN
I_MKEY(1) = KDT
I_MKEY(2) = KTM
I_MKEY(3) = KLT
I_MKEY(4) = KLN
I_MKEY(5) = KAUX

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

!        1.       GET RANDOM NUMBERS

ALLOCATE(ZRAND0 (ILEN,2))
ALLOCATE(ZRAND  (ILEN  ))
ALLOCATE(IRAND  (ILEN  ))
ZMULTIP = 1000000._JPRB
IMULTIP = NINT(1.0_JPRB+ILEN/ZMULTIP)
ZMULTIP = IMULTIP*ZMULTIP
CALL SETRAN(0,YL_RANDOM_STREAM)
CALL UNIFORM_DISTRIBUTION (ZRAND,YL_RANDOM_STREAM)
IRAND(:) = INT((1.0_JPRB - ZRAND(:))*ZMULTIP)
DO JOBS = 1 , ILEN
  ZRAND0(JOBS,1) = JOBS
  ZRAND0(JOBS,2) = IRAND(JOBS)
ENDDO

IKEY=2
CALL KEYSORT(IRET,ZRAND0,ILEN,key=IKEY)

DO JOBS = 1 , ILEN
  IRAND(JOBS) = ZRAND0(JOBS,2)
ENDDO

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

!        2.       SORT OBS PER DATE, TIME, LAT AND LON

LL_SATOB = (CD_MODE == 'SATOB'.OR.CD_MODE == 'SATAM')
LL_MOVPL = (CD_MODE == 'MOVPL')
LL_RAD1C = (CD_MODE == 'RAD1C')
LL_REDRP1= (CD_MODE == 'REDRP1')

!cjfePKEY(:,:) = _ZERO_
OBS_LOOP: DO JOBS = 1, ILEN
  PKEY(JOBS,KP ) = JOBS
  PKEY(JOBS,KDT) = ROBHDR(JOBS,MDBDAT)
  PKEY(JOBS,KTM) = ROBHDR(JOBS,MDBETM)
  PKEY(JOBS,KLT) = ROBHDR(JOBS,MDBLAT)*RDEGREES
  PKEY(JOBS,KLN) = ROBHDR(JOBS,MDBLON)*RDEGREES

!     2.1      IF SATOB/SATAM USE P,U,V OBSERVATION ITSELF (SMALLEST PRESSURE IS PREFERRED, AS IT WILL BE FIRST IN THE LIST)

  IF(LL_SATOB) THEN
      ZU=RMDI
      ZV=RMDI
      DO JNLV = MLNKH2B(JOBS),MLNKH2B(JOBS+1)-1
         ILEV = JNLV
         ICMVNM = ROBODY(ILEV,MDBVNM)
         IF(ICMVNM == NVNUMB( 1) )THEN
            ZU    = ROBODY(ILEV,MDBVAR)
         ELSEIF(ICMVNM == NVNUMB( 2) )THEN
            ZV    = ROBODY(ILEV,MDBVAR)
         ENDIF
      ENDDO
      ZOBPPP=ROBODY(MLNKH2B(JOBS),MDBPPP)
!now creating PKEY(JOBS,KAUX) carefully
      IF (ZU /= RMDI .AND. ZV /= RMDI .AND. &
      &   ZOBPPP /= RMDI) THEN
         PKEY(JOBS,KAUX) = ZOBPPP*1000000+1000*ZU + ZV
      ELSE
      ! OBSERVATION WILL NOT BE ACTIVE ANYWAY
         PKEY(JOBS,KAUX) = RMDI
      ENDIF


!        2.2      IF MOVPL (AIREPS) USE PRESSURE

  ELSEIF(LL_MOVPL) THEN
    ZOBPPP = RMDI
    CALL P_4_SORT(JOBS,ZOBPPP)
    PKEY(JOBS,KAUX) = ZOBPPP

!        2.3      RAD1C; USE SCANLINE

  ELSEIF(LL_RAD1C) THEN
    PKEY(JOBS,KAUX) = ABS(ROBHDR(JOBS,MDB_SCANLINE_AT_RADIANCE))

!        2.4      REDRP1; USE ALTITUDE

  ELSEIF(LL_REDRP1) THEN
    PKEY(JOBS,KAUX) = ABS(ROBHDR(JOBS,MDBALT))

!        2.5      OTHERWISE SET TO MISSING

  ELSE
    PKEY(JOBS,KAUX) = RMDI
  ENDIF
ENDDO OBS_LOOP

CALL KEYSORT(IRET,PKEY,ILEN,multikey=I_MKEY)
  
DO JOBS = 1, ILEN
  PKEY(JOBS,KRN) = IRAND(JOBS)
ENDDO

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

!        3.       RELEASE WORK SPACE
!                 ------------------
DEALLOCATE(ZRAND)
DEALLOCATE(ZRAND0)
DEALLOCATE(IRAND)

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

!        4.       RETURN
!                 ------
IF (LHOOK) CALL DR_HOOK('THIN_RED_PRESORT',1,ZHOOK_HANDLE)
END SUBROUTINE THIN_RED_PRESORT
