SUBROUTINE REDSL(KSET)

!**** SUBROUTINE REDSL - REMOVE REDUNDANT SURFACE LEVELS FROM TEMP/PILOT

!          HEIKKI JARVINEN   ECMWF          15/JUN/1996
!          DRASKO VASILJEVIC ECMWF          15/JUN/1996

!*    PURPOSE
!     -------

!        SEARCH FOR REDUNDANT (OR DUPLICATED) SURFACE LEVELS THAT MAY APPEAR
!     APPEAR IN MULTILEVEL REPORTS (TEMP/PILOT). JUST DO IT FOR THE LOCAL CMA
!     WITHIN THE SAME PROCESSOR.

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

!         CALL REDSL(KSET)
!     WHERE KSET  = ECSET

!        REDSL IS CALLED BY SUBROUTINE MISCE

!*    METHOD
!     ------

!        LOOP OVER ALL THE SETS, AND IF IT CONTAINS TEMP/PILOT REPORTS THEN
!     LOOP OVER THE REPORT AND SEARCH FO RDEDUNDANT SURFACE LEVELS. REJECT ALL
!     BUT THE FIRST ENCOUNTERED.

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

!        NGEDSTA - GET DATUM STATUS

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

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

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

USE YOMLUN   , ONLY : NULOUT
USE YOMOBSET_THSAFE
USE YOMCOCTP , ONLY : NTEMP    ,NPILOT
USE YOMANCS  , ONLY : RDEGREES
USE YOMVNMB  , ONLY : NVNUMB
USE YOMSCC   , ONLY : LSCDPR
USE YOMNMEV  , ONLY : ND1EVENT
USE YOMDB
USE OML_MOD, ONLY : OML_MY_THREAD

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KSET 
CHARACTER (LEN=8) ::  CLSTID
CHARACTER (LEN=5) ::  CLOBTYP
INTEGER(KIND=JPIM) :: IDSTA(4)

INTEGER(KIND=JPIM) :: ICOUNT, ILEV,&
 & IOBTYP, IVNM, JLEV, JOBS, ITID

LOGICAL :: LLREJECT, LLRH2M, LLT2M, LLTD2M, LLU10M, LLV10M

REAL(KIND=JPRB) :: ZLAT, ZLON
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "ngedsta.intfb.h"

#include "fcobs.h"

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

!        1.       INITIALIZE
!                 ----------
!*
!           1.0   INFORM

IF (LHOOK) CALL DR_HOOK('REDSL',0,ZHOOK_HANDLE)
ITID = OML_MY_THREAD()
IF(LSCDPR) WRITE(NULOUT,'(''     REMOVE REDUNDANT SURFACE LEVELS '')')
!*
!     ------------------------------------------------------------------

!        2.       LOOP OVER TEMP/PILOT SETS
!                 -------------------------

!           2.1   LOOP OVER ALL THE OBSERVATIONS

OBS_LOOP: DO JOBS = 1, OBSET(ITID)%MLNSET(KSET)

!*          2.2   OBSERVATION POINTER, TYPE

  IOBTYP = ROBHDR(JOBS,MDBOTP)
  IF(IOBTYP /= NTEMP .AND. IOBTYP /= NPILOT) CYCLE OBS_LOOP

!*          2.3   INITIALIZE THE LOGICAL VARIABLES

  LLRH2M = .FALSE.
  LLT2M  = .FALSE.
  LLTD2M = .FALSE.
  LLU10M = .FALSE.
  LLV10M = .FALSE.
!*
!           2.4   LOOP OVER THE REPORT

  DAT_LOOP: DO JLEV = MLNKH2B(JOBS),MLNKH2B(JOBS+1)-1
    ILEV = JLEV
    IVNM = ROBODY(ILEV,MDBVNM)
!*
!           2.5   CHECK FOR DATUM STATUS (PAS/REJ/BLA)

    CALL NGEDSTA(INT(ROBODY(ILEV,MDBDSTA)),ICOUNT,IDSTA)
    IF(IDSTA(2) == 1.OR. IDSTA(3) == 1.OR. IDSTA(4) == 1) THEN
      CYCLE DAT_LOOP
    ENDIF
!*
!           2.6   CHECK FOR VARIABLE NAMES

    LLREJECT = .FALSE.
    IF(IVNM == NVNUMB( 7)) THEN
      IF(LLRH2M) LLREJECT = .TRUE.
      LLRH2M = .TRUE.
    ELSEIF(IVNM == NVNUMB(10)) THEN
      IF(LLT2M) LLREJECT = .TRUE.
      LLT2M = .TRUE.
    ELSEIF(IVNM == NVNUMB(11)) THEN
      IF(LLTD2M) LLREJECT = .TRUE.
      LLTD2M = .TRUE.
    ELSEIF(IVNM == NVNUMB(56)) THEN
      IF(LLU10M) LLREJECT = .TRUE.
      LLU10M = .TRUE.
    ELSEIF(IVNM == NVNUMB(57)) THEN
      IF(LLV10M) LLREJECT = .TRUE.
      LLV10M = .TRUE.
    ENDIF
!*
!           2.7   REJECT IF NECESSARY

    IF(LLREJECT) THEN
      ROBODY(ILEV,MDBDSTA) = ZCHSTAT_REJECT( ROBODY(ILEV,MDBDSTA))
      ROBODY(ILEV,MDBDEV1) = ZCHEV1( ROBODY(ILEV,MDBDEV1),ND1EVENT(19))
    ENDIF
!*
!           2.8   PRINT WHILE TESTING

    IF(LSCDPR .AND. LLREJECT) THEN
      CLSTID = TRANSFER(ROBHDR(JOBS,MDBSID), CLSTID)
      ZLAT = ROBHDR(JOBS,MDBLAT)
      ZLON = ROBHDR(JOBS,MDBLON)
      IF(IOBTYP == NTEMP ) CLOBTYP = '    TEMP'
      IF(IOBTYP == NPILOT) CLOBTYP = '   PILOT'
      WRITE(NULOUT,'('' REDUNDANT SFC-LEVEL IN '',A5,''&
       & STATION '',&
       & A8,'' AT '',2(F8.2,1X),'' FOR VARIABLE '',I4)')&
       & CLOBTYP,CLSTID,ZLAT*RDEGREES,ZLON*RDEGREES,IVNM  
      LLREJECT = .FALSE.
    ENDIF

!*
!           2.9   CLOSE THE LOOP OVER ...

!                    ... THE CURRENT REPORT

  ENDDO DAT_LOOP

!                    ... THE OBSERVATIONS

ENDDO OBS_LOOP
!*
!     ------------------------------------------------------------------

!        3.       RETURN
!                 ------

3 CONTINUE
IF (LHOOK) CALL DR_HOOK('REDSL',1,ZHOOK_HANDLE)
END SUBROUTINE REDSL
