SUBROUTINE MOVPL_NO_SQ(KLEN)

!**** SUBROUTINE MOVPL_NO_SQ - GLOBAL REDUNDANCY CHECK FOR MOVING PLATFORMS

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

!*    PURPOSE
!     -------

!        GLOBAL REDUNDANCY CHECK FOR MOVING PLATFORMS, AT THE MOMENT FOR
!     AIREPS.  SHIPS AND DRIBUS ARE GLOBALLY TREATED IN REDRP.

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

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

!        MOVPL_NO_SQ IS CALLED BY SUBROUTINE REDUN

!*    METHOD
!     ------

!        REDUNDANT REPORTS ARE SEARCED FOR EACH PLATFORM SEPARATELY.
!     GLOBAL TIME-LOCATION ARRAY FOR AIREPS (CREATED IN SUBROUTINE GLOBA)
!     IS LOOPED OVER TWICE. AT THE FIRST TIME, NUMBER OF DIFFERENT PATHS
!     IS CALCULATED, WHERE "A PATH" IS A UNIQUE FLIGHT PATH OF AN AIRCRAFT
!     AT A GIVEN ALTITUDE, I.E. THE SAME
!     - OBSERVATION TYPE
!     - CODE TYPE
!     - INSTRUMENT TYPE
!     - STATION ID
!     - LAYER OF THE FLIGHT PATH (INDEX OF QUASI MODEL LEVEL)
!     AT THE SECOND TIME, A POINTER TABLE TO THE REPORTS OF EACH PATH IN
!     GLOBAL ARRAY IS FORMED.
!        NEXT, THE REDUNDANCIES ARE SEARCHED FOR WITH AID OF THE POINTER
!     TABLES SEPARATELY FOR EACH PATH. THE ALGORITHM IS ACTUALLY VERY
!     SIMILAR TO THAT OF TOVS THINNING: THINNING BOXES ARE USED WHEREBY
!     REDUNDANCIES ARE SEARCHED OVER A LIMITED AREA AND THE EFFECT OF ONE
!     DECISION DOES NOT EXTEND OVER LARGE DISTANCES. 
!     MOVPL IS CALLED ONLY ONE TIME.

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

!        FINDL  = FIND CLOSEST STANDARD (MANDATORY) PRESSURE LEVEL
!        CHECKAIRPOS = CHECK TRACK FOR UNREALISTIC POSITIONS
!        THIAIR = MAKE SELECTION AMONG MOVING PLATFORMS (THINNING)

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

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

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

USE YOMLUN   , ONLY : NULOUT   ,NULERR
USE YOMANCS  , ONLY : RDEGREES ,RMDI
USE YOMCT0B  , ONLY : LECMWF
USE YOMCOCTP , ONLY : NAIREP
USE YOMSCC   , ONLY : RFIND_AIREP, LSCDPR
USE YOMDB
USE YOMOBS
USE ECSORT_MIX   , ONLY : KEYSORT

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KLEN 
CHARACTER(LEN=8):: CLOBID

INTEGER(KIND=JPIM) :: IMAX, INOAIR, INRP, IOBCTP, &
 & IOBIND, IOBITP, IOBTYP, J, JJPATH, JPR, ICDTYP, &
 & JOBS, ILEN, IIDAIR, INADA, IOBS, ICOUNT, &
 & IGLAIR, ICMONM, IRET, ISIZE, JTYPE, ISTART, &
 & IGLAIRCHECK,IOBIDE  
INTEGER(KIND=JPIM), ALLOCATABLE :: IDAIR(:), IDNAI(:), IDPAI(:,:)

INTEGER(KIND=JPIM) :: IRSTA(4), I_MKEY(2)
INTEGER(KIND=JPIM),ALLOCATABLE :: IDENT(:)

REAL(KIND=JPRB) :: ZDIFF, ZOBPPP, ZRAN
LOGICAL :: LLGOOD(KLEN)
LOGICAL :: LL_PRINT
REAL(KIND=JPRB)   , ALLOCATABLE :: ZGLAIR(:,:)
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

CHARACTER (LEN = 8), ALLOCATABLE :: CLIDAIR(:)
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
#include "checkairpos.intfb.h"
#include "findml.intfb.h"
#include "ngenada.intfb.h"
#include "ngersta.intfb.h"
#include "p_4_sort.intfb.h"
#include "thiair.intfb.h"
#include "thin_red_presort.intfb.h"

#include "fcobs.h"

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

!        0.       START
!                 -----

IF (LHOOK) CALL DR_HOOK('MOVPL_NO_SQ',0,ZHOOK_HANDLE)
WRITE(NULOUT,'('' MOVPL_NO_SQ; THINNING OF AIRCRAFT OBSERVATIONS '')')
LL_PRINT=LTHINNER_PRINT
ILEN   = KLEN

!           0.3   PRESORT OBS PER DATE, TIME, LAT, LON AND ...
!                 TO AVOID USING OBS SEQUNCE NO.

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

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

!        1.       STUDY THE POINTER TABLE DIMENSIONS
!                 ----------------------------------

!                 TYPE=1 FOR REJECTION OF CRAZY POSITIONS
!                        ALL OBSERVATIONS FROM SAME AIRCRAFT HANDLED SIMULTANEOUSLY
!                        THIS SCAN MAY REJECT REPORTS SO SECOND SCAN MAY BE SHORTER
!                 TYPE=2 FOR REJECTION OF TOO CLOSE REPORTS FROM SAME AIRCRAFT WITH
!                        SAME CODE TYPE, INSTRUMENT TYPE AND VERTICAL LEVEL

IF (LECMWF) THEN
  ISTART=1
ELSE
  ISTART=2
ENDIF

REDUNDANCY_TYPE_LOOP: DO JTYPE=ISTART,2

!*
!           1.1   LOOP OVER THE OBSERVATIONS

  IGLAIR = 0
  LLGOOD(:) = .FALSE.
  OBS_LOOP1: DO JOBS = 1, ILEN
    IOBS   = ZKEY(JOBS,1)
    IOBTYP = ROBHDR(IOBS,MDBOTP)
    IF(IOBTYP /= NAIREP) CYCLE OBS_LOOP1

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

    IGLAIR = IGLAIR + 1
    LLGOOD(IOBS) = .TRUE.
 
!*          1.5   CLOSE THE LOOP

  ENDDO OBS_LOOP1
!*
!     ------------------------------------------------------------------

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

!*          2.0   INFORM

  IGLAIRCHECK=IGLAIR
  IF(IGLAIR == 0)  GO TO 10

!*          2.1        AIREP IDENTIFICATION TABLES

  ALLOCATE(IDAIR(IGLAIR))
  IF(LSCDPR) THEN
    WRITE(NULOUT,9990) 'IDAIR   ',SIZE(IDAIR   ),SHAPE(IDAIR   )
  ENDIF
  IDAIR(:) = 0

!*          2.2        NUMBER OF AIREP REPORTS FOR EACH IDENTIFIER

  ALLOCATE(IDNAI(IGLAIR))
  IF(LSCDPR) THEN
    WRITE(NULOUT,9990) 'IDNAI   ',SIZE(IDNAI   ),SHAPE(IDNAI   )
  ENDIF
  IDNAI(:) = 0
 
!*          2.3        CHARACTER ID. TABLES FOR AIREP REPORTS

  ALLOCATE(CLIDAIR(IGLAIR))
  IF(LSCDPR) THEN
    WRITE(NULOUT,9990) 'CLIDAIR   ',SIZE(CLIDAIR   ),SHAPE(CLIDAIR   )
  ENDIF
  CLIDAIR(:) = '        '

!*          2.4        POINTER/SORT ARRAY

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

  ALLOCATE(IDENT(IGLAIR))
  IF(LSCDPR) THEN
    WRITE(NULOUT,9990) 'IDENT    ',SIZE(IDENT    ),SHAPE(IDENT    )
  ENDIF
  IDENT(:) = 0

!*          2.5        FORMAT

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

!        3.       FILL THE GLOBAL ARRAYS

  IGLAIR = 0

!*
!           3.1   LOOP OVER OBSERVATIONS

  OBS_LOOP2: DO JOBS = 1, ILEN

    IOBS      = ZKEY(JOBS,1)

    IF(LLGOOD(IOBS)) THEN

      ICMONM  = ROBHDR(IOBS,MDBONM)
      ICDTYP  = ROBHDR(IOBS,MDB_CODETYPE_AT_HDR)

!*          3.2   UPDATE COUNTER

      IGLAIR = IGLAIR + 1

!           3.3   FILL ARRAY

      ZGLAIR( 1,IGLAIR) = IOBS
      ZGLAIR( 2,IGLAIR) = ICDTYP
      ZGLAIR( 3,IGLAIR) = ZKEY(JOBS,IRN0)
!     ZGLAIR( 2,IGLAIR) = ICMONM

    ENDIF

!           3.4   CLOSE THE LOOP

  ENDDO OBS_LOOP2

!           3.5   CROSS CHECK

  IF(IGLAIR /= IGLAIRCHECK) THEN
    WRITE(NULERR,'('' *** ERROR IN MOVPL_NO_SQ (1): '')')
    WRITE(NULERR,'(''     IGLAIR= '',I10)') IGLAIR
    WRITE(NULERR,'(''     IGLAIRCHECK= '',I10)') IGLAIRCHECK
    CALL ABOR1('MOVPL_NO_SQ: ERROR 1')
  ENDIF
!*
!     ------------------------------------------------------------------

!        4.       SORT
!                 ----
  IF(LL_PRINT) THEN
    WRITE(NULOUT,'('' MOVPL_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 = IGLAIR
  CALL KEYSORT(IRET, ZGLAIR, ISIZE,multikey=I_MKEY, TRANSPOSED=.TRUE.)

  IF(LL_PRINT) THEN
    WRITE(NULOUT,'('' MOVPL_NO_SQ; ZGLAIR'')')
    DO JPR=1,IGLAIR
      IOBS = ZGLAIR(1,JPR)
      WRITE(NULOUT,'('' '',I5,1X,3(F15.2,1X))') JPR,&
       & ROBHDR(IOBS,MDBLAT)*RDEGREES,ROBHDR(IOBS,MDBLON)*RDEGREES,&
       & ZGLAIR(3,JPR)  
    ENDDO
    CALL FLUSH(NULOUT)
  ENDIF

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

!        5.       STUDY THE POINTER TABLE DIMENSIONS
!                 ----------------------------------

!           5.1   INITIALIZE THE PATH COUNTER

  IIDAIR = 0

!*          5.2   FIRST LOOP OVER THE GLOBAL AIREP TIME-LOCATION ARRAY

  IGLAIR = 0
  LOOP_GL1: DO JOBS = 1, IGLAIRCHECK
    IOBS = ZGLAIR(1,JOBS)
    ZRAN = ZGLAIR(3,JOBS)

!*          5.3   TEST OBSERVATION TYPE, ACTIVE REPORT AND ACTIVE DATA

    IOBTYP = ROBHDR(IOBS,MDBOTP)
    IGLAIR = IGLAIR + 1
    
!*          5.4   EXTRACT CODE TYPE/INST.TYPE/STAT.ID OR JUST STAT.ID

    WRITE(CLOBID,'(A8)') ROBHDR(IOBS,MDBSID)
    IF (JTYPE == 2) THEN
      IOBCTP = ROBHDR(IOBS,MDB_CODETYPE_AT_HDR)
      IOBITP = ROBHDR(IOBS,MDB_INSTTYPE_AT_HDR)

!*          5.5   FIND INDEX OF CLOSEST QUASI MODEL LEVEL

      ZOBPPP = RMDI
      CALL P_4_SORT(IOBS,ZOBPPP)
      CALL FINDML(ZOBPPP,IOBIND,ZDIFF)
    ENDIF
    
!*          5.6   COMPOSE AN IDENTIFIER

    IF (LECMWF) THEN
      IF (JTYPE == 1) THEN
        IOBIDE = 0
      ELSE
        IOBIDE = 1000000*IOBCTP + 1000*IOBITP + IOBIND
!       WRITE(NULOUT,'('' IOBIDE '',I6,1X,4(I12,1X),F12.2)') JOBS,&
!            &IOBCTP,IOBITP,IOBIND,IOBIDE,ZRAN
!       CALL FLUSH(NULOUT)
      ENDIF
    ELSE
      IOBIDE = IOBIND
    ENDIF

!*          5.7   CHECK IF THIS PATH IS ALREADY LISTED

    DO J = 1, IIDAIR
      IF(IOBIDE == IDAIR(J) .AND. CLOBID == CLIDAIR(J)) THEN
        IDNAI(J) = IDNAI(J) + 1
        IDENT(JOBS) = J
        CYCLE LOOP_GL1
      ENDIF
    ENDDO

!*          5.8   ADD THE PATH OF THIS AIRCRAFT INTO A LIST

    IIDAIR = IIDAIR + 1
    IDENT(JOBS) = IIDAIR
    IDNAI(IIDAIR) = 1
    IDAIR(IIDAIR) = IOBIDE
    CLIDAIR(IIDAIR) = CLOBID

!*          5.9   CLOSE THE FIRST LOOP OVER GLOBAL ARRAY

  ENDDO LOOP_GL1

!*          5.10  NO. OF AIREP REPORTS PASSED

  IGLAIRCHECK = IGLAIR
  IF(IGLAIR == 0)  GO TO 9
!*
!     ------------------------------------------------------------------

!        6.       ALLOCATE TABLES
!                 ---------------

!*          6.0   CHECK THAT ALL REPORTS REALLY ARE IN THE PATHS

  INRP = 0
  DO J = 1, IIDAIR
    INRP = INRP + IDNAI(J)
  ENDDO
  IF(INRP /= IGLAIRCHECK ) THEN
    WRITE(NULERR,'('' *** ERROR IN MOVPL_NO_SQ (3): '')')
    WRITE(NULERR,'(''   - GLOBAL NUMBER OF AIREPS '',I5)') IGLAIRCHECK
    WRITE(NULERR,'(''   - FOUND IN THE PATHS      '',I5)') INRP
    WRITE(NULERR,'(''   - NUMBER OF PATHS         '',I5)') IIDAIR
    CALL ABOR1('MOVPL_NO_SQ: ERROR 3')
  ENDIF

!*          6.1   FIND OUT MAXIMUM NUMBER OF REPORTS IN ONE PATH

  IMAX = 0
  DO J = 1, IIDAIR
    IF(IDNAI(J) > IMAX) IMAX = IDNAI(J)
    IDNAI(J) = 0
  ENDDO

!*          6.2   ALLOCATE AND INITIALIZE A POINTER TABLE

  IF(LSCDPR) THEN
    WRITE(NULOUT,'(''     MOVPL_NO_SQ ALLOCATION :: '')')
  ENDIF
  IF ( ALLOCATED(IDPAI) ) DEALLOCATE (IDPAI)
  ALLOCATE(IDPAI(IIDAIR,IMAX))

  IF(LSCDPR) THEN
    WRITE(NULOUT,9990) 'IDPAI   ',SIZE(IDPAI   ),SHAPE(IDPAI   )
  ENDIF

  IDPAI(:,:) = 0
!*
!     ------------------------------------------------------------------

!        7.       COMPOSE POINTER TABLES FOR ALL FLIGHT PATHS
!                 -------------------------------------------

!*          7.1   SECOND LOOP OVER THE GLOBAL AIREP ARRAY

  LOOP_GL2: DO JOBS = 1, IGLAIRCHECK
    IOBS = ZGLAIR(1,JOBS)

!*          7.6   ADD THE PATH OF THIS AIRCRAFT INTO A LIST

    IDNAI(IDENT(JOBS)) = IDNAI(IDENT(JOBS))+1
    IDPAI(IDENT(JOBS),IDNAI(IDENT(JOBS))) = IOBS

!*          7.7   CLOSE THE SECOND LOOP OVER GLOBAL ARRAY

  ENDDO LOOP_GL2

!*          7.9   REPEAT THE CHECK

  INRP = 0
  DO J = 1, IIDAIR
    INRP = INRP + IDNAI(J)
  ENDDO
  IF(INRP /= IGLAIR  ) THEN
    WRITE(NULERR,'('' *** ERROR IN MOVPL_NO_SQ (4): '')')
    WRITE(NULERR,'(''   - GLOBAL NUMBER OF AIREPS '',I5)') IGLAIR
    WRITE(NULERR,'(''   - FOUND IN THE PATHS      '',I5)') INRP
    WRITE(NULERR,'(''   - NUMBER OF PATHS         '',I5)') IIDAIR
    CALL ABOR1('MOVPL_NO_SQ: ERROR 4')
  ENDIF
!*
!     ------------------------------------------------------------------

!        8.       START REDUNDANCY CHECK
!                 ----------------------

!*          8.1   SET THE SIZE OF THINNING BOX
!                 - 0.45  <=>  50km
!                 - 0.675 <=>  75km
!                 - 1.125 <=> 125km

!*          8.2   LOOP OVER ALL THE PATHS

  PATH_LOOP: DO JJPATH = 1, IIDAIR

!*          8.3   TEST THE DIMENSION OF THE PATH

    INOAIR = IDNAI(JJPATH)
    IF(INOAIR <= 1) CYCLE PATH_LOOP

!*          8.4   CALL THINNING ROUTINE (SIMILAR TO TOVS THINNING)

    IF (JTYPE == 1) THEN
      CALL CHECKAIRPOS(JJPATH,INOAIR,IIDAIR,IMAX,IDPAI)
    ELSE
      CALL THIAIR(JJPATH,INOAIR,IIDAIR,IMAX,IDPAI,RFIND_AIREP)
    ENDIF

!*          8.5   CLOSE THE LOOP

  ENDDO PATH_LOOP
!*
!     ------------------------------------------------------------------

!        9.       DEALOC
!                 ------

  9 CONTINUE
  DEALLOCATE(IDAIR)
  DEALLOCATE(IDNAI)
  DEALLOCATE(CLIDAIR)
  DEALLOCATE(ZGLAIR)
  DEALLOCATE(IDENT)

ENDDO REDUNDANCY_TYPE_LOOP
!*
!     ------------------------------------------------------------------

!        10.      RETURN
!                 ------

10 CONTINUE
IF ( ALLOCATED(IDPAI) ) DEALLOCATE (IDPAI)
DEALLOCATE(ZKEY )

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