SUBROUTINE REDOR(KGLREP,PGLREP,KOBS,KOBTYP)

!**** SUBROUTINE REDOR - FIND REDUNDANT REPORTS OF GIVEN TYPE FROM OTHER SETS

!          HEIKKI JARVINEN   ECMWF          15/MAR/1995
!          DRASKO VASILJEVIC ECMWF          25/OCT/1999

!*    PURPOSE
!     -------

!        FIND REDUNDANT REPORTS OF GIVEN TYPE FROM OTHER SETS

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

!        CALL REDOR(KOBS,KOBTYP)
!     WHERE KOBS   = POSITION OF REFERENCE REPORT
!           KOBTYP = THE GIVEN TYPE OF OBSERVATION

!        REDOR IS CALLED BY SUBROUTINE REDUN

!*    METHOD
!     ------

!        LOOP OVER ALL THE SETS, AND FIND COLLOCATED REPORTS OF WITH
!     THE SAME STATION ID AND OF THE GIVEN OBSERVATION TYPE.
!     REFERENCE REPORT IS USUALLY A TEMP AND THOSE SEARCED FOR ARE
!     TEMP/PILOT REPORTS.

!     REFERENCE REPORT A TEMP:

!     * TEMP REPORT FROM SAME TIME WINDOW:
!       - TAKE INTO ACCOUNT IN THE LEVEL SELECTION

!     * PILOT REPORT FROM SAME TIME WINDOW:
!       - TAKE INTO ACCOUNT IN THE LEVEL SELECTION

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

!        GERSTA - GET REPORT STATUS
!        CHRSTA - CHANGE REPORT STATUS
!        CHREVE - CHANGE REPORT EVENT
!        STORD  - STORE DATUM POINTERS INTO LEVEL TABLES
!        REFTIM - GET REFERENCE TIME

!**   MODIFICATIONS
!     -------------
!     C.Fischer&P.Riber 01-July-2003 : correct obs index for lat/lon

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

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

USE YOMLUN   , ONLY : NULOUT
USE YOMCOCTP , ONLY : NTEMP    ,NPILOT
USE YOMANA   , ONLY : NANDAT   ,NANTIM
USE YOMANCS  , ONLY : RDEGREES
USE YOMSCC   , ONLY : LSCDPR
USE YOMDB

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KGLREP 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGLREP(3,KGLREP) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KOBS 
INTEGER(KIND=JPIM),INTENT(IN)    :: KOBTYP 
CHARACTER (LEN=8) ::  CLRFID, CLSTID
CHARACTER (LEN=5) ::  CLRFTYP,CLOBTYP

INTEGER(KIND=JPIM) :: IAN, ICMONM, ICU, IOBS, IEND, &
 & IOBDAT, IOBETM, IOBTYP, IOBS1, IOBS2, ICOUNT, &
 & IREFPO, IRF, IRFDAT, IRFETM, IRFONM, &
 & IRFTYP, ISTA, JEND, JOBS, JSTA   
INTEGER(KIND=JPIM) :: IRSTA(4)

LOGICAL :: LLPRINT, LLOCAL

REAL(KIND=JPRB) :: ZOBLAT, ZOBLON, ZREFID, ZRFLAT, ZRFLON, zcurid

REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
#include "ngersta.intfb.h"
#include "reftim.intfb.h"
#include "stord.intfb.h"

#include "fcobs.h"

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

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

!*          1.0   INITIALIZE LOCAL PRINTING SWITCH

IF (LHOOK) CALL DR_HOOK('REDOR',0,ZHOOK_HANDLE)
LLPRINT = .FALSE.

!*          1.1   FIND OUT OBSERVATION POINTER TO REFERENCE REPORT

IREFPO  = PGLREP(1,KOBS)
!*
!           1.2   COLLECT HEADER INFORMATION OF REFERENCE REPORT

CLRFID = TRANSFER(ROBHDR(IREFPO,MDBSID), CLRFID)
ZREFID = ROBHDR(IREFPO,MDBSID)
IRFTYP = ROBHDR(IREFPO,MDBOTP)
IRFONM = ROBHDR(IREFPO,MDBONM)
ZRFLAT = ROBHDR(IREFPO,MDBLAT)
ZRFLON = ROBHDR(IREFPO,MDBLON)
!*
!     ------------------------------------------------------------------

!        2.       SEARCH FOR THE DESIRED SEQUENCE OF STATION IDS
!                 ----------------------------------------------

!*          2.0   INITIALIZE

ISTA = 1
IEND = 0

!*          2.1   LOOP OVER THE GLOBAL ARRAY

SEQUENCE_BEGIN_LOOP: DO JSTA = 1, KGLREP
  IOBS1 = PGLREP(1,JSTA)

!*          2.2   START OF THE SEQUENCE

  ZCURID = ROBHDR(IOBS1,MDBSID)
  IF(ZCURID == ZREFID) THEN
    ISTA = JSTA
    IEND = JSTA
    EXIT
  ENDIF
ENDDO SEQUENCE_BEGIN_LOOP

!*          2.3   END OF THE SEQUENCE

IF(IEND > 0 .AND. ISTA < KGLREP) THEN
  IOBS2 = PGLREP(1,ISTA+1)
  IF(ROBHDR(IOBS2,MDBSID) == ZREFID) THEN
    SEQUENCE_END_LOOP: DO JEND = ISTA+1, KGLREP
      IOBS2 = PGLREP(1,JEND)
      IF(ROBHDR(IOBS2,MDBSID) == ZREFID) THEN
        IEND = JEND
      ELSE
        EXIT 
      ENDIF
    ENDDO SEQUENCE_END_LOOP
  ENDIF
ENDIF
!*
!     ------------------------------------------------------------------

!        3.       STUDY THE GLOBAL "SYNOPTIC" TIME-LOCATION ARRAY
!                 -----------------------------------------------
!*
!           3.1   START THE LOOP

GLOBAL_LOOP: DO JOBS = ISTA, IEND
  IOBS = PGLREP(1,JOBS)

!*          3.2   OBSERVATION TYPE

  IOBTYP = ROBHDR(IOBS,MDBOTP)
  IF(IOBTYP /= KOBTYP) CYCLE GLOBAL_LOOP

!*          3.3   CHECK WHETHER REPORT STILL ACTIVE
  CALL NGERSTA(INT(ROBHDR(IOBS,MDBRST)),ICOUNT,IRSTA)
  IF(IRSTA(2) == 1.OR. IRSTA(3) == 1.OR. IRSTA(4) == 1) THEN
    CYCLE GLOBAL_LOOP
  ENDIF

!           3.4   LATITUDE, LONGITUDE

  ZOBLAT = ROBHDR(IOBS  ,MDBLAT)
  ZOBLON = ROBHDR(IOBS  ,MDBLON)
  IF(ZRFLAT /= ZOBLAT) CYCLE GLOBAL_LOOP
  IF(ZRFLON /= ZOBLON) CYCLE GLOBAL_LOOP
!*
!           3.5   UNIQUE OBSERVATION SEQUENCE NUMBER

  ICMONM = ROBHDR(IOBS,MDBONM)
  IF(IRFONM == ICMONM) CYCLE GLOBAL_LOOP
!*
!           3.6   STATION ID

  CLSTID = TRANSFER(ROBHDR(IOBS,MDBSID), CLSTID)
  IF(CLRFID /= CLSTID) CYCLE GLOBAL_LOOP
!*
!     ------------------------------------------------------------------

!        4.       COMPARE OBSERVATIONS
!                 --------------------

!*          4.0   INITIALIZE

!*
!           4.1   CHECK THE UNIQUE OBSERVATION SEQUENCE NUMBER

!*          4.2   TEMP  VS. TEMP  CASE : TAKE TEMP  INTO LEVEL SELECTION
!                 TEMP  VS. PILOT CASE : TAKE PILOT INTO LEVEL SELECTION
!                 PILOT VS. TEMP  CASE : TAKE PILOT INTO LEVEL SELECTION
!                 PILOT VS. PILOT CASE : TAKE PILOT INTO LEVEL SELECTION

  IF((IRFTYP == NTEMP  .AND. IOBTYP == NTEMP )  .OR.&
     & (IRFTYP == NTEMP  .AND. IOBTYP == NPILOT)  .OR.&
     & (IRFTYP == NPILOT .AND. IOBTYP == NTEMP )  .OR.&
     & (IRFTYP == NPILOT .AND. IOBTYP == NPILOT)) THEN  

    LLOCAL = .TRUE.
    CALL STORD(IOBS,LLOCAL)
    LLPRINT = .TRUE.

!*          4.3   UNKNOWN CASE

  ELSE
    WRITE(UNIT=NULOUT,FMT='('' LOGICAL ERROR (2) IN REDOR '')')
    CALL ABOR1(' REDOR: LOGICAL ERROR (2) ')
  ENDIF

!*          4.4   PRINT WHILE TESTING

  IF(LSCDPR .AND. LLPRINT) THEN
    CLRFTYP = 'UNKNW'
    CLOBTYP = 'UNKNW'
    IF(IRFTYP == NTEMP ) CLRFTYP = ' TEMP'
    IF(IRFTYP == NPILOT) CLRFTYP = 'PILOT'
    IF(IOBTYP == NTEMP ) CLOBTYP = ' TEMP'
    IF(IOBTYP == NPILOT) CLOBTYP = 'PILOT'
    IRFDAT = ROBHDR(IREFPO,MDBDAT)
    IRFETM = ROBHDR(IREFPO,MDBETM)
    IOBDAT = ROBHDR(IOBS,MDBDAT)
    IOBETM = ROBHDR(IOBS,MDBETM)
    CALL REFTIM(IRFDAT,IRFETM,IRF)
    CALL REFTIM(IOBDAT,IOBETM,ICU)
    CALL REFTIM(NANDAT,NANTIM,IAN)
    WRITE(NULOUT,'('' REDUNDANT(1) '',A5,''/'',A5,&
     & '' PAIR. ID '',A8,'' AT '',2(F7.2,1X),&
     & '' AN-TIME '',I8,1X,I6,'' REF: DT '',I4,&
     & '' OBS: DT '',I4)')&
     & CLRFTYP,CLOBTYP,CLSTID,ZOBLAT*RDEGREES,&
     & ZOBLON*RDEGREES,NANDAT,NANTIM,(IRF-IAN),(ICU-IAN)  
    LLPRINT = .FALSE.
  ENDIF

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

!        5.       CLOSE THE LOOP OVER ...
!                 -----------------------

!*          5.1   ... THE OBSERVATIONS

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

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