SUBROUTINE rtl_screen(klen,ksensor,kmw)

!**** *rtl_screen* - Microwindow, cloud and height screening for limb radiances

!     N. Bormann             ECMWF          2004/11/22

!     PURPOSE
!     -------
!     Reject data not selected in microwindows (if provided).
!     Reject cloud affected sweeps, and sweeps with too high tangent heights.

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

!    CALL rtl_screen(klen,ksensor,kmw) 
!     WHERE KLEN      = Number of observations.
!           KSENSOR   = Sensor ID
!           KMW       = RT or MW index number

!     rtl_screen is called from HRETR

!**   METHOD
!     ------
!     Channel selection uses the channel selection information in
!     Y_LIMB_CHAN_SEL which is read under rtl_setup.
!     Cloud screening is based on the Remedios and Spang cloud index,
!     and an absolute threshold on the clearest MIPAS channel.


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

!**   MODIFICATIONS
!     -------------
!     Niels Bormann      2004/11/22 : Original
!     -------------------------------------------------------------------------


USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMANCS   ,ONLY : RMDI
USE YOMLIMB   ,ONLY : MSENSOR_MIPAS,                              &  
 &  PP_MIPAS_ZCLOUD_THRESH, PP_MIPAS_CI_THRESH, PP_MIPAS_WR_THRESH, &
 &  PP_MIPAS_ZTAN_MAX, PP_MIPAS_ZTAN_MIN, LQTAN_PRES, &
 &  Y_LIMB_CHAN_SEL, Y_LIMB_CHAN_SEL_T
USE YOMLUN    ,ONLY : NULOUT
USE YOMNMEV  , ONLY : ND1EVENT 
USE YOMVNMB  , ONLY : NVNUMB
USE PARCMA    ,ONLY : JPMX_LIMB_TAN

USE YOMDB

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KLEN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSENSOR
INTEGER(KIND=JPIM),INTENT(IN)    :: KMW

! local variables           
           
TYPE(y_limb_chan_sel_t), Pointer :: YLMW

INTEGER(KIND=JPIM) :: JBODY, JOBS, JTAN, JHGT            ! loops
INTEGER(KIND=JPIM) :: INTAN, ITAN
INTEGER(KIND=JPIM) :: ICHAN
INTEGER(KIND=JPIM) :: IRAD

INTEGER(KIND=JPIM) :: IDX(JPMX_LIMB_TAN)

LOGICAL         :: LLCLOUDY(JPMX_LIMB_TAN)
LOGICAL         :: LLZOUT(JPMX_LIMB_TAN)

REAL(KIND=JPRB) :: ZCLOUD_INDEX
REAL(KIND=JPRB) :: ZWINDOW_RAD
REAL(KIND=JPRB) :: ZZTAN
REAL(KIND=JPRB) :: ZPTAN

REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "fcobs.h"

#include "openmp_obs.h"

!=============================================

! loop through each observation

IF (LHOOK) CALL DR_HOOK('RTL_SCREEN',0,ZHOOK_HANDLE)

!*       1) Channel selection


YLMW => Y_LIMB_CHAN_SEL(KMW)

IF(YLMW%active)THEN

  DO JOBS = 1, KLEN

!        1.1) Set up index pointers for height mask

    INTAN = SATHDR(JOBS, MDB_NTAN_AT_LIMB)

    IDX(:) = -1
    DO JTAN = 1, INTAN
      ZZTAN = SATHDR(JOBS, MDB_ZTAN_AT_LIMB(JTAN))
      DO JHGT = YLMW%nheight, 1, -1
        IDX(JTAN) = JHGT
        IF ( ZZTAN > YLMW%msk_heights(JHGT) ) EXIT
      ENDDO
      IF ( ZZTAN <= YLMW%msk_heights(1) ) IDX(JTAN) = -1
    ENDDO

!       1.2) Loop through body entries and select

    DO JBODY = MLNKH2B(JOBS),MLNKH2B(JOBS+1) - 1
           
      IF(ROBODY(JBODY,MDBVNM) /= NVNUMB(79) ) CYCLE

      ICHAN = NINT(ROBODY(JBODY,MDBPPP))
      ITAN  = NINT(ROBODY(JBODY,MDBPRL))

      ZZTAN = SATHDR(JOBS, MDB_ZTAN_AT_LIMB(ITAN))

      ! Height outside MW boundaries
      IF ( ZZTAN > YLMW%height_up(ICHAN) .OR. IDX(ITAN) < 1 ) THEN
        ROBODY(JBODY,MDBDSTA) = ZCHSTAT_REJECT( ROBODY(JBODY,MDBDSTA))
        ROBODY(JBODY,MDBDEV1) = ZCHEV1( ROBODY(JBODY,MDBDEV1),ND1EVENT(21))
        CYCLE
      ENDIF

!      ! Apply height mask
      IF ( .NOT. YLMW%msk(ICHAN,IDX(ITAN)) ) THEN
        ROBODY(JBODY,MDBDSTA) = ZCHSTAT_REJECT( ROBODY(JBODY,MDBDSTA))
        ROBODY(JBODY,MDBDEV1) = ZCHEV1( ROBODY(JBODY,MDBDEV1),ND1EVENT(21))
      ENDIF
  
    ENDDO
  ENDDO

ENDIF

!*       2) Cloud and height screening for MIPAS


IF(KSENSOR == MSENSOR_MIPAS)THEN

  DO JOBS = 1, KLEN

!*       2.1) See which sweeps are cloudy or out of range


    LLCLOUDY(:) = .FALSE.
    LLZOUT(:)   = .FALSE.
    INTAN = SATHDR(JOBS, MDB_NTAN_AT_LIMB)
    DO JTAN = 1, INTAN
      ZCLOUD_INDEX = SATHDR(JOBS, MDB_CLOUD_INDEX_AT_LIMB(JTAN))
      ZWINDOW_RAD  = SATHDR(JOBS, MDB_WINDOW_RAD_AT_LIMB(JTAN))
      ZZTAN        = SATHDR(JOBS, MDB_ZTAN_AT_LIMB(JTAN))
      ZPTAN        = SATHDR(JOBS, MDB_PTAN_AT_LIMB(JTAN))

      IF(       ZZTAN  <=  PP_MIPAS_ZCLOUD_THRESH            &
       & .AND. (     ZCLOUD_INDEX <= PP_MIPAS_CI_THRESH      &
       &        .OR.  ZWINDOW_RAD >= PP_MIPAS_WR_THRESH )) THEN
        LLCLOUDY(JTAN) = .TRUE.
        WRITE(NULOUT,'(A,3(f10.3,2x))')                               &
         &       'RTL_SCREEN: Rejecting cloudy sweep: ZTAN,CI,WR:',   &
         &       ZZTAN, ZCLOUD_INDEX, ZWINDOW_RAD
      ENDIF

      IF( ZZTAN >= PP_MIPAS_ZTAN_MAX .OR. ZZTAN <= PP_MIPAS_ZTAN_MIN  &
       &  .OR. ( LQTAN_PRES                          &
       &         .AND. ( ZPTAN == RMDI .OR. ZPTAN <= 0.0_JPRB ) ) ) THEN
        LLZOUT(JTAN) = .TRUE.
        WRITE(NULOUT,'(A,2(e13.6,2x))')                               &
         &       'RTL_SCREEN: Rejecting sweep with bad height: ZTAN,PTAN:', &
         &       ZZTAN, ZPTAN
        
      ENDIF

    ENDDO

!*       2.2) Loops through individual radiances and reject those from
!*            a flagged sweep

    IRAD = 0
    DO JBODY = MLNKH2B(JOBS),MLNKH2B(JOBS+1) - 1
           
      IF(ROBODY(JBODY,MDBVNM) /= NVNUMB(79) ) CYCLE

      ITAN = NINT(ROBODY(JBODY,MDBPRL))

      IF( LLCLOUDY(ITAN) .OR. LLZOUT(ITAN) )THEN
        ROBODY(JBODY,MDBDSTA) = ZCHSTAT_REJECT( ROBODY(JBODY,MDBDSTA))
        IRAD = IRAD + 1
        IF( LLCLOUDY(ITAN) ) &
          & ROBODY(JBODY,MDBDEV1) = ZCHEV1( ROBODY(JBODY,MDBDEV1),ND1EVENT(13))
        IF( LLZOUT(ITAN) ) &
          & ROBODY(JBODY,MDBDEV1) = ZCHEV1( ROBODY(JBODY,MDBDEV1),ND1EVENT(8))
      ENDIF

    ENDDO

    WRITE(NULOUT,'(A,I8)')                                        &
      &       'RTL_SCREEN: Number of radiances rejected:', IRAD

  ENDDO

ENDIF

IF (LHOOK) CALL DR_HOOK('RTL_SCREEN',1,ZHOOK_HANDLE)

END SUBROUTINE rtl_screen
