SUBROUTINE REDGL_NO_SQ(KLEN,LDSHIP)

!**** SUBROUTINE REDGL_NO_SQ - FIND REDUNDANT SHIP/DRIBU REPORTS

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

!*    PURPOSE
!     -------

!        FIND REDUNDANT SHIP/DRIBU REPORTS WITH AID OF THE GLOBAL
!     TIME-LOCATION ARRAYS OF MOVING PLATFORMS (SHIP SYNOPS AND DRIBUS).
!     AIREPS ARE SEPARATELY HANDLED IN MOVPL.

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

!        CALL REDGL_NO_SQ(KLEN,LDSHIP)
!     WHERE KLEN    = DB LEN
!           LDSHIP  = REMOVE REDUNDANCIES AMONG SHIP SYNOPS

!        REDGL_NO_SQ IS CALLED BY SUBROUTINE REDUN (ONCE FOR BOTH OBS. TYPES)

!*    METHOD
!     ------

!        REDUNDANT REPORTS ARE SEARCED FOR. FOR MOST OBSERVATION TYPES
!     THEY ARE SEARCHED FROM THE OBSERVATIONS THAT ARE PRESENT IN THE
!     PROCESSOR, I.E. FROM THE LOCAL CMA. USUALLY FOR THESE "STATIC"
!     PLATFORMS ONLY THE REPORT CLOSEST TO THE ANALYSIS TIME IS RETAINED
!     AND THE REST ARE REDUNDANT. FOR SHIP SYNOPS AND DRIBUS GLOBAL ARRAYS
!     OF MOVING PLATFORMS ARE USED. IN THOSE CASES, THE SEARCH WILL BE
!     CONCENTRATED ON A ONE BY ONE DEGREE BOX AND WITHIN THAT BOX ONLY THE
!     REPORT CLOSEST TO THE ANALYSIS TIME IS RETAINED.

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

!        REFTIM  - GET REFERENCE TIME
!        REJMV   - REJECT A MOVING PLATFORM
!        NGENADA - GET NUMBER OF ACTIVE DATA (FROM ODB)

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

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

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

USE YOMCOCTP , ONLY : NSYNOP   ,NDRIBU
USE YOMLUN   , ONLY : NULOUT   ,NULERR
USE YOMANA   , ONLY : NANDAT   ,NANTIM
USE YOMANCS  , ONLY : RDEGREES
USE YOMSCC   , ONLY : LSCDPR
USE YOMSCREE , ONLY : NAMBPL   ,CAMBPL
USE YOMTHLIM , ONLY : RSHIDIS
USE YOMOBS
USE YOMDB
USE ecsort_mix   , ONLY : keysort

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KLEN 
LOGICAL           ,INTENT(IN)    :: LDSHIP 
REAL(KIND=JPRB),allocatable :: ZGLSEA(:,:)

INTEGER(KIND=JPIM) :: IRSTA(4)

CHARACTER (LEN=8) ::  CLRFID, CLSTID
CHARACTER (LEN=5) ::  CLOBTYP
LOGICAL :: LLSHIP,LLEXIT_INNER_LOOP

INTEGER(KIND=JPIM),DIMENSION(:), ALLOCATABLE :: JSTA(:), JEND(:)

REAL(KIND=JPRB)   , ALLOCATABLE :: ZKEY  (:,:)

INTEGER(KIND=JPIM), PARAMETER   :: icolumns0=7,ipo=1,idt0=2,itm0=3,ilt=4,iln=5,icom=6,irn0=7

INTEGER(KIND=JPIM) :: IACD1, IACD2, IAN, ICMONM, ICMRAN, ICU, IOBS, &
 & IDIM, IEND, INEND, INSQ, INSTA, IOBCTP, IOBDAT, &
 & IOBETM, IOBITP, IOBTYP, IPR1, IPR2, ICDTYP, &
 & IREFPO, IRF, IRFCTP, IRFDAT, IRFETM, IRFITP, &
 & IRFONM, IRFRAN, IRFOTP, ISTA, J, JPR, &
 & JOBS, JREF, JSEQ, ILEN, ICOUNT, IGLSEA, INGLSEA, INADA  

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

LOGICAL :: LLPRINT
LOGICAL :: LL_PRINT

REAL(KIND=JPRB) :: Z_ST, Z_ST_JOBS, ZDIST, ZOBLAT, ZOBLON, ZRFLAT, ZRFLON
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
#include "gcdis.intfb.h"
#include "ngenada.intfb.h"
#include "ngersta.intfb.h"
#include "reftim.intfb.h"
#include "rejmv.intfb.h"
#include "thin_red_presort.intfb.h"

#include "fcobs.h"

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

!        1.       INITIALIZE
!                 ----------

IF (LHOOK) CALL DR_HOOK('REDGL_NO_SQ',0,ZHOOK_HANDLE)
LL_PRINT=LTHINNER_PRINT
ILEN = KLEN

!*          1.1   LOGICAL VARIABLES

LLSHIP  = .FALSE.
LLPRINT = .FALSE.
LLEXIT_INNER_LOOP = .FALSE.
!*
!           1.2   INITIALIZE LOOP CONTROL
!*
!              1.2.1   SHIP SYNOP

INSTA  = 1
INEND  = ILEN
IF(LDSHIP) THEN
  LLSHIP = .TRUE.
ENDIF
!*
!*             1.2.4   GET THE REFERENCE TIME FOR ANALYSIS TIME

CALL REFTIM(NANDAT,NANTIM,IAN)
!*
!*             1.2.5   INFORM

IF(LLSHIP) THEN
  IF(LSCDPR) WRITE(NULOUT,'('' REDGL_NO_SQ; THINNING OF SHIP OBSERVATIONS '')')
ELSE
  IF(LSCDPR) WRITE(NULOUT,'('' REDGL_NO_SQ; THINNING OF DRIBU OBSERVATIONS '')')
ENDIF

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

ALLOCATE(ZKEY (ILEN,icolumns0))
CALL THIN_RED_PRESORT(ILEN,'REDGL',ZKEY,icolumns0,&
 & IPO,IDT0,ITM0,ILT,ILN,ICOM,IRN0 )  

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

!        1.       STUDY OBSERVATIONS
!                 ------------------

!*
!           1.1   LOOP OVER OBSERVATIONS

IGLSEA = 0
OBS_LOOP1: DO JOBS = 1, ILEN
  IOBS   = ZKEY(JOBS,1)
  IOBTYP    = ROBHDR(IOBS,MDBOTP)
  IF(LLSHIP) THEN
    IF(IOBTYP /= NSYNOP) CYCLE OBS_LOOP1
  ELSE
    IF(IOBTYP /= NDRIBU) CYCLE OBS_LOOP1
  ENDIF

!*          1.2   ACCEPT ACTIVE REPORTS ONLY

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

!*          1.3   ACCEPT ONLY REPORTS CONTAINING ACTIVE DATA

  CALL NGENADA(IOBS,INADA)
  IF(INADA == 0) CYCLE OBS_LOOP1

!*          1.4   UPDATE COUNTER

  IGLSEA = IGLSEA + 1

!*          1.5   CLOSE THE LOOP

ENDDO OBS_LOOP1

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

!        2.       ALLOCATE AND PRESET GLOBAL ARRAYS
!                 ---------------------------------

!*          2.0   INFORM

IF(LSCDPR) THEN
  IF(LLSHIP) THEN
    WRITE(NULOUT,'('' *** NO. OF SHIP REPORTS:'',I10)') IGLSEA
  ELSE
    WRITE(NULOUT,'('' *** NO. OF DRIBU REPORTS:'',I10)') IGLSEA
  ENDIF
ENDIF
INGLSEA = IGLSEA
IF(INGLSEA == 0)  GO TO 10

!*          2.1   PRESET

INSTA  = 1
INEND  = INGLSEA
IDIM   = INGLSEA

!*          2.2        

ALLOCATE(JSTA(IDIM))
IF(LSCDPR) THEN
  WRITE(NULOUT,9990) 'JSTA  ',SIZE(JSTA),SHAPE(JSTA)
ENDIF

!*          2.3        

ALLOCATE(JEND(IDIM))
IF(LSCDPR) THEN
  WRITE(NULOUT,9990) 'JEND  ',SIZE(JEND),SHAPE(JEND)
ENDIF

!*          2.4        POINTER/SORT ARRAY

ALLOCATE(ZGLSEA(3,INGLSEA))
IF(LSCDPR) THEN
  WRITE(NULOUT,9990) 'ZGLSEA   ',SIZE(ZGLSEA   ),SHAPE(ZGLSEA   )
ENDIF
ZGLSEA(:,:) = 0.0_JPRB

!*          2.5        FORMAT

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

!        3.       FILL GLOBAL ARRAYS

IGLSEA = 0

!*
!           3.1   LOOP OVER OBSERVATIONS

OBS_LOOP2: DO JOBS = 1, ILEN
  IOBS      = ZKEY  (JOBS,1)
  IOBTYP    = ROBHDR(IOBS,MDBOTP)
  ICDTYP    = ROBHDR(IOBS,MDB_CODETYPE_AT_HDR)
  IF(LLSHIP) THEN
    IF(IOBTYP /= NSYNOP) CYCLE OBS_LOOP2
  ELSE
    IF(IOBTYP /= NDRIBU) CYCLE OBS_LOOP2
  ENDIF
  ICMONM    = ROBHDR(IOBS,MDBONM)

!*          3.2   ACCEPT ACTIVE REPORTS ONLY

  CALL NGERSTA(INT(ROBHDR(IOBS,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(IOBS,INADA)
  IF(INADA == 0) CYCLE OBS_LOOP2

!*          3.4   UPDATE COUNTER

  IGLSEA = IGLSEA + 1

!           3.5   FILL ARRAY

  ZGLSEA( 1,IGLSEA) = IOBS
  ZGLSEA( 2,IGLSEA) = ROBHDR(IOBS,MDBSID)
  ZGLSEA( 3,IGLSEA) = ZKEY  (JOBS,IRN0)
!  ZGLSEA( 1,IGLSEA) = IOBS
!  ZGLSEA( 2,IGLSEA) = ICDTYP
!  ZGLSEA( 3,IGLSEA) = ROBHDR(IOBS,MDBSID)
!  ZGLSEA( 4,IGLSEA) = ZKEY  (JOBS,IRN0)
!! ZGLSEA( 3,IGLSEA) = ICMONM

!           3.6   CLOSE THE LOOP

ENDDO OBS_LOOP2

!           3.7   CROSS CHECK

IF(IGLSEA /= INGLSEA) THEN
  WRITE(NULERR,'('' *** ERROR IN REDGL_NO_SQ (1): '')')
  WRITE(NULERR,'(''     IGLSEA = '',I10)') IGLSEA
  WRITE(NULERR,'(''     INGLSEA= '',I10)') INGLSEA
  CALL ABOR1('REDGL_NO_SQ: ERROR 1')
ENDIF
!*
!     ------------------------------------------------------------------

!        4.       SORT
!                 ----
IF(LL_PRINT) THEN
  write(NULOUT,'('' REDGL_NO_SQ; ZKEY'')')
  DO JPR=1,ILEN
    WRITE(NULOUT,'('' '',I6,1X,6(F15.2,1X))') JPR,&
     & ZKEY(JPR,2),ZKEY(JPR,3),&
     & ZKEY(JPR,4),ZKEY(JPR,5),&
     & ZKEY(JPR,6),&
     & ZKEY(JPR,7)  
  ENDDO
  CALL FLUSH(NULOUT)
ENDIF

I_MKEY(1) = 2
I_MKEY(2) = 3
isize = INGLSEA

CALL KEYSORT(iret, ZGLSEA, isize,multikey=I_MKEY, transposed=.TRUE.)

IF(LL_PRINT) THEN
  WRITE(NULOUT,'('' REDGL_NO_SQ; ZGLSEA '')')
  DO JPR=1,INGLSEA
    IOBS = ZGLSEA(1,JPR)
    WRITE(NULOUT,'('' '',I5,1x,A8,1x,2(F15.2,1x))') JPR,&
     & TRANSFER(ZGLSEA(2,JPR),CLSTID),&
     & ROBHDR(IOBS,MDBLAT)*RDEGREES,ROBHDR(IOBS,MDBLON)*RDEGREES  
  ENDDO
  CALL FLUSH(NULOUT)
ENDIF

!*
!     ------------------------------------------------------------------
!        5.       INITIALISE SEARCH
!                 -----------------

INSQ = 0
ISTA = 1
IEND = 1
IOBS = ZGLSEA(1,1)
Z_ST = ROBHDR(IOBS,MDBSID)
!*
!           5.3   LOOP OVER THE GLOBAL "SHIP" or "DRIBU" ARRAY
!                 - THESE ARE SORTED WITH STATION ID IN A UNIQUE WAY

DO JOBS = 2, INEND
  IOBS = ZGLSEA(1,JOBS)

!*          5.4   SEARCH FOR A SEQUENCE OF MORE THAN 2 SAME STATION IDS
!                 AND COMPOSE THE INITIAL ENTRIES FOR DISTRIBUTION

  Z_ST_JOBS = ROBHDR(IOBS,MDBSID)
  IF(Z_ST_JOBS == Z_ST) THEN
    IEND = JOBS
  ELSE
    IF(IEND > ISTA) THEN
      INSQ = INSQ + 1
      JSTA(INSQ) = ISTA
      JEND(INSQ) = IEND
    ENDIF
    Z_ST   = ROBHDR(IOBS,MDBSID)
    ISTA = JOBS
    IEND = JOBS
  ENDIF
ENDDO
IF(IEND > ISTA) THEN
  INSQ = INSQ + 1
  JSTA(INSQ) = ISTA
  JEND(INSQ) = IEND
ENDIF
!*
!     ------------------------------------------------------------------

!        6.       STUDY THE GLOBAL TIME-LOCATION ARRAY
!                 ------------------------------------
!*
!           6.1   START THE LOOP OVER THE SEQUENCES

SEQUENCE_LOOP: DO JSEQ = 1, INSQ
!*
!           6.2   START THE OUTER LOOP

  OUTER_LOOP: DO JREF = JSTA(JSEQ), JEND(JSEQ)-1
    IREFPO = ZGLSEA(1,JREF)
    IRFRAN = ZGLSEA(3,JREF)

!*             6.2.1   ACTIVE REPORT

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

!*             6.2.2   PICK UP REFERENCE REPORT INFO

    ZRFLAT = ROBHDR(IREFPO,MDBLAT)
    ZRFLON = ROBHDR(IREFPO,MDBLON)
    IRFOTP = ROBHDR(IREFPO,MDBOTP)
    IRFCTP = ROBHDR(IREFPO,MDB_CODETYPE_AT_HDR)
    IRFITP = ROBHDR(IREFPO,MDB_INSTTYPE_AT_HDR)
    IRFDAT = ROBHDR(IREFPO,MDBDAT)
    IRFETM = ROBHDR(IREFPO,MDBETM)
    IRFONM = ROBHDR(IREFPO,MDBONM)
    CALL NGENADA(IREFPO,IACD1)
    CLRFID = TRANSFER(ROBHDR(IREFPO,MDBSID), CLRFID)
!*
!*             6.2.3   GET THE REFERENCE TIME FOR REFERENCE REPORT

    CALL REFTIM(IRFDAT,IRFETM,IRF)
!*
!           6.3   START THE INNER LOOP

    INNER_LOOP: DO JOBS = JREF+1, JEND(JSEQ)
      IOBS   = ZGLSEA(1,JOBS)
      ICMRAN = ZGLSEA(3,JOBS)

!           6.4   COLLECT AND TEST HEADER INFORMATION

!*             6.4.1   ACTIVE REPORT

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

!*             6.4.2   OBSERVATION TYPE (TRIVIAL)

      IOBTYP = ROBHDR(IOBS,MDBOTP)
      IF(IRFOTP /= IOBTYP) CYCLE INNER_LOOP
!*
!              6.4.3   DISTANCE BETWEEN REPORTS: WITHIN RSHIDIS (111km)

      ZOBLAT = ROBHDR(IOBS,MDBLAT)
      ZOBLON = ROBHDR(IOBS,MDBLON)
      CALL GCDIS(ZRFLAT,ZRFLON,ZOBLAT,ZOBLON,ZDIST)
      IF(ZDIST > RSHIDIS) CYCLE INNER_LOOP

!*             6.4.4   CODE AND INSTRUMENT TYPE

      IOBCTP = ROBHDR(IOBS,MDB_CODETYPE_AT_HDR)
      IOBITP = ROBHDR(IOBS,MDB_INSTTYPE_AT_HDR)
!     IF(IRFCTP /= IOBCTP) CYCLE INNER_LOOP
      IF(IRFITP /= IOBITP) CYCLE INNER_LOOP
!*
!              6.4.5   UNIQUE OBSERVATION SEQUENCE NUMBER
!                      - GLOBAL ARRAY HAS A DUPLICATE OF REF. REPORT

      ICMONM = ROBHDR(IOBS,MDBONM)
      IF(IRFONM == ICMONM) THEN
        WRITE(NULERR,'('' DUPLICATED SEQUENCE NUMBER '',&
         & 2(I8,1X))') IRFONM,ICMONM  
        CALL ABOR1('REDGL_NO_SQ: DUPLICATED SEQUENCE NUMBER')
      ENDIF

!*             6.4.6   STATION ID

      CLSTID = TRANSFER(ROBHDR(IOBS,MDBSID), CLSTID)
      IF(CLRFID /= CLSTID) CYCLE INNER_LOOP
!*
!              6.4.7   LIST OF AMBIGUOUS PLATFORMS
!                      - IGNORE REDUNDANCY CHECK FOR THOSE

      IF(LLSHIP) THEN
        DO J = 1, NAMBPL
          IF(CLSTID == CAMBPL(J)) CYCLE INNER_LOOP
        ENDDO
      ENDIF
!*
!              6.4.8   DATE/TIME/OWNER PE/POINTER TO LOCAL CMA

      IOBDAT = ROBHDR(IOBS,MDBDAT)
      IOBETM = ROBHDR(IOBS,MDBETM)
!*
!     ------------------------------------------------------------------

!        7.       FIND OUT THE OBSERVATION WITH HIGHER PRIORITY
!                 ---------------------------------------------
!*
!           7.1   GET THE REFERENCE TIME

      CALL REFTIM(IOBDAT,IOBETM,ICU)
!*
!           7.2   GET THE NUMBER OF ACTIVE DATA IN REPORT

      CALL NGENADA(IOBS,IACD2)
!*
!           7.3   COMPOSE THE PRIORITY FIGURES

      IPR1 = 1000*ABS(IRF-IAN) + 10*(99-IACD1)
      IPR2 = 1000*ABS(ICU-IAN) + 10*(99-IACD2)
!* to be done at later date
      IF(IRFRAN > ICMRAN) IPR1 = IPR1 + 1
      IF(IRFRAN < ICMRAN) IPR2 = IPR2 + 1
!     IF(IRFONM > ICMONM) IPR1 = IPR1 + 1
!     IF(IRFONM < ICMONM) IPR2 = IPR2 + 1
!*
!           7.4   SELECT THE ONE WITH LOWER PRIORITY FIGURE

      IF(IPR1 < IPR2) THEN
        CALL REJMV(IOBS,IOBTYP,ICMONM)
        LLPRINT = .TRUE.
      ELSE
        CALL REJMV(IREFPO,IRFOTP,IRFONM)
        LLPRINT = .TRUE.
        LLEXIT_INNER_LOOP = .TRUE.
      ENDIF

!*          7.5   PRINT WHILE TESTING

      IF(LLSHIP ) THEN
        CLOBTYP = ' SHIP'
      ELSE
        CLOBTYP = 'DRIBU'
      ENDIF
      WRITE(NULOUT,'('' REDGL_NO_SQ; REDUNDANT '',A5,'' ID '',A8,'' AT '',&
       & 2(F7.2,1X),'' AN-TIME '',I8,1X,I6,'' REF: DT/NDATA '',&
       & I4,''/'',I1,'' OBS: DT/NDATA '',I4,''/'',I1)')&
       & CLOBTYP,CLSTID,ZOBLAT*RDEGREES,ZOBLON*RDEGREES,&
       & NANDAT,NANTIM,(IRF-IAN),IACD1,(ICU-IAN),IACD2  

      IF(LLEXIT_INNER_LOOP) THEN
        LLEXIT_INNER_LOOP = .FALSE.
        EXIT INNER_LOOP
      ENDIF

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

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

    ENDDO INNER_LOOP

  ENDDO OUTER_LOOP

ENDDO SEQUENCE_LOOP
!*
!     ------------------------------------------------------------------

!        9.       DEALOC
!                 ------

DEALLOCATE(JSTA)
DEALLOCATE(JEND)
DEALLOCATE(ZGLSEA)
!*
!     ------------------------------------------------------------------

!        10.      RETURN
!                 ------
10 CONTINUE
DEALLOCATE(ZKEY )
IF (LHOOK) CALL DR_HOOK('REDGL_NO_SQ',1,ZHOOK_HANDLE)
END SUBROUTINE REDGL_NO_SQ
