SUBROUTINE DUPLI(KLEN)

!**** SUBROUTINE DUPLI - REMOVE DUPLICATED AIREPS GLOBALLY

!          HEIKKI JARVINEN   ECMWF          30/DEC/1996
!          DRASKO VASILJEVIC ECMWF          21/10/1999

!*    PURPOSE
!     -------

!        SEARCH GLOBALLY FOR DUPLICATED (AIREP) DATA. USUALLY, THERE
!     ARE AIREP REPORTS THAT HAVE THE SAME DATE/TIME, ROUGHLY THE SAME
!     LOCATION AND, AT LEAST PARTIALLY, THE SAME DATA. THE STATION ID
!     IS USUALLY SLIGHTLY DIFFERENT. THE PURPOSE IS TO SELECT THE BEST
!     DATA AND TO THE REMOVE REDUNDANCIES.
!     THE SEARCH IS DONE GLOBALLY, AS ONLY THE THE RESULT IS REPRODU-
!     CIBLE. WE CANNOT RELY ON THE UNDERLYING ASSUMPTION THAT ALL THESE
!     (AIREP) REPORTS ARE WITHIN THE SAME PROCESSOR!

!     REMOVE DUPLICATED AIREPS.
!       - DUPLICATES: SAME REPORT MAY APPEAR UNDER SLIGHTLY DIFFERENT
!         STATION IDENTIFIER.  THE BEST DATA IS RETAINED AND REDUNDAN-
!         CIES REMOVED. THE CHECK IS PERFORMED HERE SO THAT IT DOES
!         NOT AFFECT THE CREATION OF GLOBAL AIREP ARRAY WHICH SHOULD
!         ONLY CONTAIN ACTIVE UNIQUE AIREP REPORTS
!       - THE REMOVAL MUST NOT RELY ON HAVING REPORTS FROM THE SAME
!         PLATFORM ON THE SAME PROCESSOR.
!       - THE AIREPS ARE COPIED INTO A GLOBAL ARRAY OF REPORTS. ALSO
!         AN ARRAY WITH THE MINIMUM NECESSARY INFORMATION IS CREATED.
!         THESE ARRAYS ARE COMMUNICATED AMONG THE PROCESSORS.
!       - THE LATTER ARRAY IS ALSO SORTED ACCORDING TO TIME AND THE
!         UNIQUE SEQUENCE NUMBER OF THE REPORT. OTHERWISE IT ISN'T
!         POSSIBLE TO REPRODUCE THE RESULT OF THINNING WITH A
!         DIFFERENT COMPUTER CONFIGURATION.

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

!     ***CALL DUPLI(KLEN)
!     WHERE KLEN  = DB LEN

!        DUPLI IS CALLED BY SUBROUTINE DECIS

!*    METHOD
!     ------

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

!        NGEDSTA  - GET THE DATUM STATUS

!**   MODIFICATIONS
!     -------------
!     Sami Saarinen 980224 - Calls to the new (multi-)keysort added

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

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

USE YOMLUN   , ONLY : NULOUT   ,NULERR
USE YOMANA   , ONLY : NANDAT   ,NANTIM
USE YOMANCS  , ONLY : RDEGREES
USE YOMSCC   , ONLY : LSCDPR
USE YOMVNMB  , ONLY : NVNUMB
USE YOMNMEV  , ONLY : ND1EVENT
USE ECSORT_MIX   , ONLY : KEYSORT
USE YOMDB

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KLEN 
INTEGER(KIND=JPIM) :: IRSTA(4), IDSTA(4), IILEVS(20)
REAL(KIND=JPRB),allocatable :: ZGLPOI(:,:)
CHARACTER(LEN=8) ::  CLRFID, CLOBID


INTEGER(KIND=JPIM) :: ICMONM, ICOUNT, IOBS, &
 & IGNUM, IIUCOM, IIVCOM, &
 & ILEV, ILEVREF, ILEVCUR, iret, isize, &
 & INLEVS, &
 & IOBDAT, IOBETM, IOBNLV, &
 & IOBVNM, INOACD, ICDTYP, IOBTIM, &
 & IREFPO, IRFDAT, IRFETM, &
 & IRFNLV, IRFONM, IRFVNM, IRFTIM, IANTIM, IKEY, &
 & JINN, &
 & JLEV, JOBLEV, JOUT, JRFLEV, INUM, ILEN, JOBS, &
 & ICURCDTYP, IREFCDTYP  

LOGICAL :: LLREJE, LLUCOM, LLVCOM

REAL(KIND=JPRB) :: ZLDIF, ZOBFGE, ZOBLAT, ZOBLON, ZOBOMF, &
 & ZOBPPP, ZPDIF, ZRFFGE, ZRFLAT, ZRFLON, &
 & ZRFOMF, ZRFPPP, ZTIM, ZLAT,ZLON  
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
#include "ngedsta.intfb.h"
#include "ngenada.intfb.h"
#include "ngersta.intfb.h"
#include "reftim.intfb.h"

#include "fcobs.h"

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

!*       0.       INITIALIZE
!                 ----------
!*
!           0.1   INFORM

IF (LHOOK) CALL DR_HOOK('DUPLI',0,ZHOOK_HANDLE)
WRITE(NULOUT,'('' DUPLI; REMOVE DUPLICATED AIREPS  '')')

!           0.1   REF TIME

CALL REFTIM(NANDAT,NANTIM,IANTIM)

!*
!*
!           0.3   NUMBER OF REPORTS IN GLOBAL TIME-LOCATION ARRAYS

INUM = 0
IGNUM= 0
ILEN = KLEN

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

!*       1.       CALCULATE HOW MANY AIREPs GLOBALLY
!                 ----------------------------------
!*

!*          1.1   LOOP OVER ALL REPs

OBS_LOOP1: DO JOBS = 1, ILEN

!*          1.3   ACCEPT ACTIVE REPORTS ONLY

  CALL NGERSTA(INT(ROBHDR(JOBS,MDBRST)),ICOUNT,IRSTA)
  IF(IRSTA(2) == 1.OR. IRSTA(3) == 1.OR. IRSTA(4) == 1) CYCLE OBS_LOOP1

!*          1.4   ACCEPT ONLY REPORTS CONTAINING ACTIVE DATA

  CALL NGENADA(JOBS,INOACD)
  IF(INOACD == 0) CYCLE OBS_LOOP1

!*          1.5     UPDATE COUNTER

  INUM = INUM + 1

ENDDO OBS_LOOP1

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

!        2.       ALLOCATE THE GLOBAL ARRAYS
!                 --------------------------

!*             2.4.1   GLOBAL TIME-LOCATION AIREP ARRAY

IF(LSCDPR) THEN
  WRITE(NULOUT,'(''     DUPLI ALLOCATION FOR: '',I10,'' REPORTS'')') INUM
ENDIF

IGNUM = INUM
IF(IGNUM == 0) THEN
  WRITE(NULOUT,'(''     NO USEFUL AIREP REPORTS FOR DUPLI CHECK '')')
  CALL FLUSH(NULOUT)
  GO TO 7
ENDIF

isize = IGNUM + mod(ignum+1,2)
ALLOCATE(ZGLPOI(isize,2))
IF(LSCDPR) THEN
  WRITE(NULOUT,9990) 'ZGLPOI   ',SIZE(ZGLPOI), SHAPE(ZGLPOI)
ENDIF

!*             2.4.2   FORMAT

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

!*          2.5   INITIALIZE DIMENSIONS AND GLOBAL ARRAYS

ZGLPOI(:,:) = 0.0_JPRB

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

!        3.       FILL THE GLOBAL ARRAYS
!                 ----------------------

!*
!           3.1   LOOP OVER REPs

INUM = 0
OBS_LOOP2: DO JOBS = 1, ILEN

!*          3.2   FIND OUT OBSERVATION POINTER

  ICMONM = ROBHDR(JOBS,MDBONM)
  ICDTYP = ROBHDR(JOBS,MDB_CODETYPE_AT_HDR)
  IOBDAT = ROBHDR(JOBS,MDBDAT)
  IOBTIM = ROBHDR(JOBS,MDBETM)

!*          3.3   ACCEPT ACTIVE REPORTS ONLY

  CALL NGERSTA(INT(ROBHDR(JOBS,MDBRST)),ICOUNT,IRSTA)
  IF(IRSTA(2) == 1.OR. IRSTA(3) == 1.OR. IRSTA(4) == 1) CYCLE OBS_LOOP2

!*          3.4   ACCEPT ONLY REPORTS CONTAINING ACTIVE DATA

  CALL NGENADA(JOBS,INOACD)
  IF(INOACD == 0) CYCLE OBS_LOOP2

!*          3.5   UPDATE COUNTER

  INUM = INUM + 1

!*          3.6   COMPOSE SORTING KEY

  CALL REFTIM(IOBDAT,IOBTIM,IRFTIM)
  ZTIM = REAL(IRFTIM - IANTIM + 100000,JPRB)
  ZGLPOI( INUM,2) = ZTIM*100000000._JPRB + REAL(ICMONM,JPRB)

!          3.7    REPORT POINTER

  ZGLPOI( INUM,1) = JOBS

ENDDO OBS_LOOP2

!          3.9    CROSS CHECK

IF(INUM  /= IGNUM) THEN
  WRITE(NULERR,'('' *** ERROR IN DUPLI; COUNTS DO NOT AGREE'')')
  WRITE(NULERR,'(''     INUM  ='',I10)') INUM
  WRITE(NULERR,'(''     IGNUM ='',I10)') IGNUM
  CALL ABOR1('DUPLI: ERROR 1')
ENDIF

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

!        4.       SORT THE AIREPS (globally) IN TIME
!                 ----------------------------------

IF(LSCDPR) THEN
  WRITE(NULOUT,'('' *** SORTING STARTING IN DUPLI '')')
ENDIF

!*          4.1    SORT USING THE KEY

IKEY = 2
isize = IGNUM
CALL KEYSORT(iret,ZGLPOI,isize,key=IKEY, transposed=.FALSE.)

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

!        5.       SEARCH FOR DUPLICATES
!                 ---------------------
!*
!           5.1   START OUTER LOOP

OUTER_LOOP2: DO JOUT = 1, IGNUM-1
!*
!           5.2   COLLECT HEADER INFORMATION FOR REFERENCE

  IREFPO    = ZGLPOI( JOUT,1)
  IRFDAT    = ROBHDR(IREFPO,MDBDAT)
  IRFETM    = ROBHDR(IREFPO,MDBETM)
  IRFNLV    = MLNKH2B(IREFPO+1)-MLNKH2B(IREFPO)
  IREFCDTYP = ROBHDR(IREFPO,MDB_CODETYPE_AT_HDR)

  ZRFPPP = ROBODY(MLNKH2B(IREFPO),MDBPPP)
  
  ZRFLAT = ROBHDR(IREFPO,MDBLAT)
  ZRFLON = ROBHDR(IREFPO,MDBLON)
!*
!           5.3   START INNER LOOP

  INNER_LOOP2: DO JINN = JOUT+1, IGNUM
!*
!           5.4   CHECK DATE AND TIME

    IOBS = ZGLPOI( JINN,1)
    IOBDAT = ROBHDR(IOBS,MDBDAT)
    IOBETM = ROBHDR(IOBS,MDBETM)
    IF(IRFDAT /= IOBDAT) EXIT INNER_LOOP2
    IF(IRFETM /= IOBETM) EXIT INNER_LOOP2
    ICURCDTYP = ROBHDR(IOBS,MDB_CODETYPE_AT_HDR)
!*
!           5.5   COLLECT AND TEST OTHER HEADER INFORMATION
!*
!              5.5.1   LATITUDE, LONGITUDE (TO BE WITHIN 0.02 DEG)

    ZLDIF  = 0.02_JPRB
    ZOBLAT = ROBHDR(IOBS,MDBLAT)
    ZOBLON = ROBHDR(IOBS,MDBLON)
    IF(ABS((ZRFLAT-ZOBLAT)*RDEGREES) > ZLDIF) CYCLE INNER_LOOP2
    IF(ABS((ZRFLON-ZOBLON)*RDEGREES) > ZLDIF) CYCLE INNER_LOOP2
!*
!              5.5.2   PRESSURE LEVEL (TO BE WITHIN 2 HPA)

    ZPDIF  = 200._JPRB
    ZOBPPP = ROBODY(MLNKH2B(IOBS),MDBPPP)
    IF(ABS(ZRFPPP-ZOBPPP) > ZPDIF) CYCLE INNER_LOOP2
!*
!           5.6   LOOP OVER THE REPORTS AND COMPARE THE DATUMS

    IOBNLV = MLNKH2B(IOBS+1)-MLNKH2B(IOBS)
    LLREJE = .FALSE.
    LLUCOM = .FALSE.
    LLVCOM = .FALSE.
    INLEVS = 0
    IILEVS(:) = 0
!*
!              5.6.1   OUTER LOOP OVER THE REFERENCE REPORT

    REF_REPORT: DO JRFLEV = MLNKH2B(IREFPO),MLNKH2B(IREFPO+1)-1
      ILEVREF= JRFLEV
      IRFVNM = ROBODY(ILEVREF,MDBVNM)
      ZRFPPP = ROBODY(ILEVREF,MDBPPP)
      ZRFOMF = ROBODY(ILEVREF,MDBOMF)
      ZRFFGE = ROBODY(ILEVREF,MDBFGE)
!*
!                 5.6.1.1   CHECK FOR DATUM STATUS

      CALL NGEDSTA(INT(ROBODY(ILEVREF,MDBDSTA)),ICOUNT,IDSTA)
      IF(IDSTA(2) == 1.OR. IDSTA(3) == 1.OR.IDSTA(4) == 1) CYCLE REF_REPORT
!*
!              5.6.2   INNER LOOP OVER THE CURRENT REPORT

      CUR_REPORT: DO JOBLEV = MLNKH2B(IOBS),MLNKH2B(IOBS+1)-1
        ILEVCUR= JOBLEV
        IOBVNM = ROBODY(ILEVCUR,MDBVNM)
        ZOBPPP = ROBODY(ILEVCUR,MDBPPP)
        ZOBOMF = ROBODY(ILEVCUR,MDBOMF)
        ZOBFGE = ROBODY(ILEVCUR,MDBFGE)
!*
!                 5.6.2.1   COMPARE VARIABLE TYPE

        IF(IRFVNM /= IOBVNM) CYCLE CUR_REPORT
!*
!                 5.6.2.2   PRESSURE LEVEL (TO BE WITHIN 2 HPA)

        IF(ABS(ZRFPPP-ZOBPPP) > ZPDIF) CYCLE CUR_REPORT

!*
!                 5.6.2.3   CHECK FOR DATUM STATUS

        CALL NGEDSTA(INT(ROBODY(ILEVCUR,MDBDSTA)),ICOUNT,IDSTA)
        IF(IDSTA(2) == 1.OR. IDSTA(3) == 1.OR.IDSTA(4) == 1) CYCLE CUR_REPORT
!*
!                 5.6.2.4   STORE POINTERS TO DATA. CHECK FOR WIND COMP.

        INLEVS = INLEVS + 1
        IF (ICURCDTYP <= IREFCDTYP) THEN
          IILEVS(INLEVS) = ILEVCUR
        ELSE
          IILEVS(INLEVS) = ILEVREF
        ENDIF
        IF(IOBVNM == NVNUMB( 1) .OR. IOBVNM == NVNUMB(56)) THEN
          LLUCOM = .TRUE.
          IIUCOM = IILEVS(INLEVS)
        ENDIF
        IF(IOBVNM == NVNUMB( 2) .OR. IOBVNM == NVNUMB(57)) THEN
          LLVCOM = .TRUE.
          IIVCOM = IILEVS(INLEVS)
        ENDIF
        LLREJE = .TRUE.
!*
!           5.7   CLOSE THE LOOP OVER THE CURRENT REPORT

      ENDDO CUR_REPORT
!*
!           5.8   CLOSE THE LOOP OVER THE REFERENCE REPORT

    ENDDO REF_REPORT
!*
!           5.9   IS THERE ANYTHING TO REJECT

    IF(LLREJE) THEN
      IF(LSCDPR) THEN
        IRFONM = ROBHDR(IREFPO,MDBONM)
        ICMONM = ROBHDR(IOBS,MDBONM)
        CLRFID = TRANSFER(ROBHDR(IREFPO,MDBSID),CLRFID)
        CLOBID = TRANSFER(ROBHDR(IOBS,MDBSID),CLOBID)
        ZLAT   = ROBHDR(IOBS,MDBLAT)
        ZLON   = ROBHDR(IOBS,MDBLON)
        WRITE(NULOUT,'('' DUPLICATE AIREPS '',2(A8,1X),&
         & ''AT '',2(F7.2,1X),''SQN.NMBRS: '',2(I8,1X))')&
         & CLRFID,CLOBID,ZLAT*RDEGREES,ZLON*RDEGREES,&
         & IRFONM,ICMONM  
        CALL FLUSH(NULOUT)
      ENDIF
    ELSE
      CYCLE INNER_LOOP2
    ENDIF
!*
!           5.10  PERFORM REJECTION. IF WIND: REJECT BOTH OR NONE.

    DO JLEV = 1, INLEVS
      ILEV = IILEVS(JLEV)
      IF(ILEV == IIUCOM .AND. .NOT.(LLVCOM.AND.LLUCOM)) CYCLE
      IF(ILEV == IIVCOM .AND. .NOT.(LLVCOM.AND.LLUCOM)) CYCLE
!*
!              5.10.1  REJECT IN THE GLOBAL ARRAY

      IF(LSCDPR) THEN
        WRITE(NULOUT,'('' - VARIABLE '',I3,'' WITH DEPARTURE '',&
         & E12.5,'' AT PRESSURE '',F9.2)')&
         & ROBODY(ILEV,MDBVNM),ROBODY(ILEV,MDBOMF),&
         & ROBODY(ILEV,MDBPPP)  
        CALL FLUSH(NULOUT)
      ENDIF
      ROBODY(ILEV,MDBDSTA) = ZCHSTAT_REJECT( ROBODY(ILEV,MDBDSTA))
      ROBODY(ILEV,MDBDEV1) = ZCHEV1( ROBODY(ILEV,MDBDEV1),ND1EVENT(18))
    ENDDO
!*
!           5.11  CLOSE THE LOOP OVER THE THE OBSERVATIONS
  ENDDO INNER_LOOP2
!*
!           5.12  CLOSE THE LOOP OVER THE THE SETS
ENDDO OUTER_LOOP2
!*
!     ------------------------------------------------------------------

!        6.       ?
!                 -

6 CONTINUE
DEALLOCATE( ZGLPOI )
IF(LSCDPR) THEN
  WRITE(NULOUT,9991) 'ZGLPOI    '
ENDIF
9991 FORMAT(1X,'ARRAY ',A10,' DEALLOCATED ')
!*
!     ------------------------------------------------------------------

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