SUBROUTINE REDRP1(KLEN)

!**** SUBROUTINE REDRP1 - FIND REDUNDANT REPORTS

!          HEIKKI JARVINEN   ECMWF          15/MAR/1995
!          DRASKO VASILJEVIC ECMWF          21/10/1999

!*    PURPOSE
!     -------

!       FIND REDUNDANT REPORTS GLOBALLY. THE REFERENCE REPORT IS FROM
!     THE LOCAL CMA, BUT THE SEARCH IS PERFORMED GLOBALLY THROUGH A TIME-
!     LOCATION ARRAY.
!     SHIP SYNOPS AND DRIBUS ARE HANDLED IN REDGL, AND AIREPS IN MOVPL.

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

!        CALL REDRP1(KLEN)
!     WHERE KLEN = LEN OF DB

!        REDRP1 IS CALLED BY SUBROUTINE REDUN

!*    METHOD
!     ------

!        REDUNDANT REPORTS ARE SEARCED FOR GLOBALLY. USUALLY FOR THE
!     "STATIC" PLATFORMS ONLY THE REPORT CLOSEST TO THE ANALYSIS TIME
!     IS RETAINED AND THE REST ARE REDUNDANT.

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

!        NGERSTA - GET REPORT STATUS
!        REFTIM  - GET REFERENCE TIME
!        NGENADA - GET NUMBER OF ACTIVE DATA

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

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

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

USE YOMLUN   , ONLY : NULOUT   ,NULERR
USE YOMCOCTP , ONLY : NSYNOP   ,NPAOB    ,NSRSCD ,NATSCD  ,&
       &  NSYRCD, NRADOH, NSHSCD
USE YOMANA   , ONLY : NANDAT   ,NANTIM
USE YOMANCS  , ONLY : RDEGREES
USE YOMSCREE , ONLY : NGLSYN
USE YOMSCC   , ONLY : LSCDPR
USE YOMNMEV  , ONLY :  ND1EVENT
USE YOMDB
USE YOMVNMB  , ONLY : NVNUMB
USE ECSORT_MIX   , ONLY : KEYSORT

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KLEN 
REAL(KIND=JPRB),ALLOCATABLE :: ZGLSYN(:,:)

INTEGER(KIND=JPIM) :: IRSTA(4), IDSTA(4)
CHARACTER (LEN=8) ::  CLSTID, CLRFID, CLOBID
CHARACTER (LEN=5) ::  CLOBTYP

INTEGER(KIND=JPIM) :: ICMONM, &
 & ICOUNT, ICU, IOBS, IOBITP, IOBTYP, ICDTYP, &
 & IREFPO, IRF, IRFCTP, IRFDAT, IRFETM, &
 & IRFITP, IRFONM, IRFOTP, &
 & IDATUMCUR, IDATUMREF, IIUCOM, IIVCOM, &
 & IOBSQN, IOBVNM, IRFSQN, IRFVNM, &
 & JOBS, ILEN, IGLSYN, INADA, JOBS1, JOBS2, &
 & JOBDATUM, JRFDATUM  

INTEGER(KIND=JPIM) :: iret, isize, I_MKEY(4)

LOGICAL :: LLREJE, LLUCOM, LLVCOM

REAL(KIND=JPRB) :: ZOBLAT, ZOBLON, ZREFID, ZRFLAT, ZRFLON, 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"
!*
!     ------------------------------------------------------------------
!        1.       INITIALSE
!                 ---------

IF (LHOOK) CALL DR_HOOK('REDRP1',0,ZHOOK_HANDLE)
ILEN = KLEN

!*
!     ------------------------------------------------------------------
!        2.       ALLOCATE
!                 --------

!*          2.1   ALLOCATE   

! mod()-hassle to avoid memory bank/cache conflicts
ISIZE = ILEN + MOD(ILEN+1,2)
ALLOCATE(ZGLSYN(ISIZE,5))
IF(LSCDPR) THEN
  WRITE(NULOUT,9991) 'NGLSYN   ',NGLSYN
  WRITE(NULOUT,9990) 'ZGLSYN   ',SIZE(ZGLSYN   ),SHAPE(ZGLSYN   )
ENDIF
ZGLSYN(:,:) = 0.0_JPRB

!*          2.5        FORMAT

9990 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8)
9991 FORMAT(1X,A10,' =    ',I8)
!*
!     ------------------------------------------------------------------

!        3.       FILL THE GLOBAL ARRAYS
!                 ----------------------
IGLSYN = 0

!*
!           3.1   LOOP OVER OBSERVATIONS

OBS_LOOP2: DO JOBS = 1, ILEN
  IOBTYP  = ROBHDR(JOBS,MDBOTP)
  IF(IOBTYP /= NSYNOP .AND. IOBTYP /= NPAOB) THEN
    WRITE(NULERR,'('' *** ERROR IN REDRP1; NOT EXPECTED OBS TYPE '')')
    WRITE(NULERR,'(''     IOBTYP= '',3I10)') IOBTYP,NSYNOP,NPAOB
    CALL ABOR1('REDRP1; NOT EXPECTED OBS TYPE')
  ENDIF
  IF(IOBTYP == NSYNOP) THEN
    ICDTYP = ROBHDR(JOBS,MDB_CODETYPE_AT_HDR)
 IF(ICDTYP /= NSRSCD .AND. ICDTYP /= NATSCD .AND. ICDTYP /= NSYRCD &
        &   .AND. ICDTYP /= NRADOH .AND. ICDTYP /= NSHSCD) CYCLE OBS_LOOP2
  ENDIF
  ICMONM    = ROBHDR(JOBS,MDBONM)

!*          3.2   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.3   ACCEPT ONLY REPORTS CONTAINING ACTIVE DATA

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

!*          3.4   UPDATE COUNTER

  IGLSYN = IGLSYN + 1

!           3.5   FILL ARRAY

  IRFDAT = ROBHDR(JOBS,MDBDAT)
  IRFETM = ROBHDR(JOBS,MDBETM)
  CALL REFTIM(IRFDAT,IRFETM,IRF)

  ZGLSYN(IGLSYN,1) = JOBS
  ZGLSYN(IGLSYN,2) = IRF
  ZGLSYN(IGLSYN,3) = ROBHDR(JOBS,MDBLAT)
  ZGLSYN(IGLSYN,4) = ROBHDR(JOBS,MDBLON)
  ZGLSYN(IGLSYN,5) = ICMONM

!           3.6   CLOSE THE LOOP

ENDDO OBS_LOOP2

NGLSYN = IGLSYN
IF(NGLSYN == 0) GO TO 9
!*
!     ------------------------------------------------------------------

!        4.       SORT
!                 ----
I_MKEY(1) = 2
I_MKEY(2) = 3
I_MKEY(3) = 4
I_MKEY(4) = 5

!WRITE(NULOUT,'('' REDRP1; ZGLSYN BEFORE SORT'')')
!DO JPR=1,ILEN
!WRITE(NULOUT,'('' '',I5,1x,5(F15.2,1X))') JPR,&
!&ZGLSYN(jpr,1),ZGLSYN(jpr,2),ZGLSYN(jpr,3),&
!&ZGLSYN(jpr,4),ZGLSYN(jpr,5)
!ENDDO
!CALL FLUSH(NULOUT)

CALL KEYSORT(IRET, ZGLSYN, NGLSYN, MULTIKEY=I_MKEY, TRANSPOSED=.FALSE.)

!WRITE(NULOUT,'('' REDRP1; ZGLSYN AFTER SORT'')')
!DO JPR=1,ILEN
!WRITE(NULOUT,'('' '',I5,1x,5(F15.2,1X))') JPR,&
!&ZGLSYN(jpr,1),ZGLSYN(jpr,2),ZGLSYN(jpr,3),&
!&ZGLSYN(jpr,4),ZGLSYN(jpr,5)
!ENDDO
!CALL FLUSH(NULOUT)

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

!        5.       SEARCH
!                 ------
 
!*          5.0   LOOP OVER ALL DATA

LOOP_GL1: DO JOBS1 = 1, NGLSYN

!*          5.1   FIND OUT OBSERVATION POINTER TO REFERENCE REPORT

  IREFPO = NINT(ZGLSYN(JOBS1,1))

!*
!           5.3   COLLECT HEADER INFORMATION OF REFERENCE REPORT

  IRFONM = ROBHDR(IREFPO,MDBONM)
  IRFOTP = ROBHDR(IREFPO,MDBOTP)
  IRFCTP = ROBHDR(IREFPO,MDB_CODETYPE_AT_HDR)
  IRFITP = ROBHDR(IREFPO,MDB_INSTTYPE_AT_HDR)
  ZREFID = ROBHDR(IREFPO,MDBSID)
!*
!           5.4   GET THE REFERENCE TIME

  IRF=NINT(ZGLSYN(JOBS1,2))
!*
!     ------------------------------------------------------------------

!        6.       STUDY THE GLOBAL TIME-LOCATION ARRAY FOR SYNOPTIC REPS.

  ZRFLAT = ZGLSYN(JOBS1,3)
  ZRFLON = ZGLSYN(JOBS1,4)

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

!*          6.0   LOOP OVER THE GLOBAL ARRAY

  GLOBAL_LOOP: DO JOBS2 = JOBS1+1, NGLSYN

!*          6.1   GET THE TIME, LATITUDE, LONGITUDE 

    ICU = NINT(ZGLSYN(JOBS2,2))
    ZOBLAT = ZGLSYN(JOBS2,3)
    ZOBLON = ZGLSYN(JOBS2,4)

    IF (IRF /= ICU .OR. ZRFLAT /= ZOBLAT .OR. ZRFLON /= ZOBLON) &
     & EXIT GLOBAL_LOOP  

!*         6.1.1 THE REPORTS HAVE IDENTICAL DATE, TIME, LATITUDE AND
!*               LONGITUDE.
!*               SCAN THROUGH THE DATA IN THE REPORTS AND
!*               REJECT DUBLICATE DATUM

    IOBS = NINT(ZGLSYN(JOBS2,1))

!*          6.4   INSTRUMENT TYPE

    IOBITP = ROBHDR(IOBS,MDB_INSTTYPE_AT_HDR)
    IF(IRFITP /= IOBITP) CYCLE GLOBAL_LOOP

!*          6.6   DATE, TIME, OWNER, POINTER AND NO. ACTIVE DATA

!           6.7.1  OUTER LOOP OVER THE REFERENCE REPORT

    LLREJE = .FALSE.
    LLUCOM = .FALSE.
    LLVCOM = .FALSE.

!           6.7.2  HANDLE ONE DATUM AT A TIME

    REF_REPORT: DO JRFDATUM = MLNKH2B(IREFPO),MLNKH2B(IREFPO+1)-1
      IDATUMREF= JRFDATUM
      IRFVNM = ROBODY(IDATUMREF,MDBVNM)
      IRFSQN = ROBODY(IDATUMREF,MDBESQN)
!*
!           6.7.3  ONLY INTERESTED IN ACTIVE DATA

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

      CUR_REPORT: DO JOBDATUM = MLNKH2B(IOBS),MLNKH2B(IOBS+1)-1
        IDATUMCUR= JOBDATUM
        IOBVNM = ROBODY(IDATUMCUR,MDBVNM)
        IOBSQN = ROBODY(IDATUMCUR,MDBESQN)

!           6.7.4.1  COMPARE VARIABLE TYPE

        IF(IRFVNM /= IOBVNM) CYCLE CUR_REPORT
!*
!*
!           6.7.4.2  ONLY INTERESTED IN ACTIVE DATA

        CALL NGEDSTA(INT(ROBODY(IDATUMCUR,MDBDSTA)),ICOUNT,IDSTA)
        IF(IDSTA(2) == 1.OR. IDSTA(3) == 1.OR.IDSTA(4) == 1) CYCLE CUR_REPORT
!*
!           6.7.4.3  STORE POINTERS TO WIND DATA. REJECT OTHER DATA TYPES

        IF(IOBVNM == NVNUMB( 1) .OR. IOBVNM == NVNUMB(56)) THEN
          LLUCOM = .TRUE.
          IIUCOM = IDATUMCUR
        ELSEIF(IOBVNM == NVNUMB( 2) .OR. IOBVNM == NVNUMB(57)) THEN
          LLVCOM = .TRUE.
          IIVCOM = IDATUMCUR
        ELSE
          ROBODY(IDATUMCUR,MDBDSTA) = &
           & ZCHSTAT_REJECT( ROBODY(IDATUMCUR,MDBDSTA))  
          ROBODY(IDATUMCUR,MDBDEV1) = &
           & ZCHEV1( ROBODY(IDATUMCUR,MDBDEV1),ND1EVENT(18))  
        ENDIF
        LLREJE = .TRUE.
!*
!          6.11   CLOSE THE LOOP OVER THE CURRENT REPORT

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

    ENDDO REF_REPORT
!*
!          6.13   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 SYNOPS '',2(A8,1X),&
       & ''AT '',2(F7.2,1X),''SQN.NMBRS: '',2(I8,1X))')&
       & CLRFID,CLOBID,ZLAT*RDEGREES,ZLON*RDEGREES,&
       & IRFONM,ICMONM  
   !! ENDIF
    ELSE
      CYCLE GLOBAL_LOOP
    ENDIF
!*
!           6.14  ONLY PERFORM REJECTION OF WINDS IF BOTH U AND V ARE AVAILABLE.

    IF(LLVCOM.AND.LLUCOM) THEN

      ROBODY(IIUCOM,MDBDSTA) = ZCHSTAT_REJECT( ROBODY(IIUCOM,MDBDSTA))
      ROBODY(IIUCOM,MDBDEV1) = ZCHEV1( ROBODY(IIUCOM,MDBDEV1),ND1EVENT(18))
      ROBODY(IIVCOM,MDBDSTA) = ZCHSTAT_REJECT( ROBODY(IIVCOM,MDBDSTA))
      ROBODY(IIVCOM,MDBDEV1) = ZCHEV1( ROBODY(IIVCOM,MDBDEV1),ND1EVENT(18))

    ENDIF

!*
!           7.3   PRINT 

    CLSTID = TRANSFER(ROBHDR(IOBS,MDBSID), CLSTID)
    CLOBTYP = 'SYNOP'
    WRITE(NULOUT,'('' REDUNDANT '',A5,'' ID '',A8,'' AT '',&
     & 2(F7.2,1X),'' AN-TIME '',I8,1X,I6)')&
     & CLOBTYP,CLSTID,ZOBLAT*RDEGREES,ZOBLON*RDEGREES,&
     & NANDAT,NANTIM  

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

!        8.       CLOSE LOOPS
!                 -----------

  ENDDO GLOBAL_LOOP
ENDDO LOOP_GL1
!*
!     ------------------------------------------------------------------

!        9.       DEALOC
!                 ------

9 CONTINUE
DEALLOCATE(ZGLSYN)
!*
!     ------------------------------------------------------------------
!*

IF (LHOOK) CALL DR_HOOK('REDRP1',1,ZHOOK_HANDLE)
END SUBROUTINE REDRP1
