subroutine onedvar_screen ( knumb, &
      & k1d_x      , &   ! in:  size of control vector
      & k1d_y      , &   ! in:  number of channels (size of obs vector)
      & k1d_z      , &   ! in:  size of extra-parameters vector
      & ksat       , &   ! in:  satellite ID
      & kfov       , &   ! in:  IFOV number 
      & pt         , &   ! in:  temperature profile
      & pq         , &   ! in:  spec. humidity profile
      & pten_t     , &   ! in:  temperature tendency profile
      & pten_q     , &   ! in:  spec. humidity tendency profile         
      & prain      , &   ! in:  liquid precipitation profile 
      & psnow      , &   ! in:  solid precipitation profile  
      & pclfr      , &   ! in:  3-d cloud fraction    
      & pcllw      , &   ! in:  3-d cloud liquid water content   
      & pcliw      , &   ! in:  3-d cloud ice water content         
      & pt_2m      , &   ! in:  temperature @ 2m 
      & pq_2m      , &   ! in:  spec. humidity @ 2m
      & ptd_2m     , &   ! in:  dew-point temperature @ 2m 
      & pu_star    , &   ! in:  wind stress, u
      & pv_star    , &   ! in:  wind stress, v                        
      & pu_10m     , &   ! in:  wind speed, u @ 10m
      & pv_10m     , &   ! in:  wind speed, v @ 10m 
      & psh_sfc    , &   ! in:  sensible heat flux @ sfc
      & plh_sfc    , &   ! in:  latent heat flux @ sfc
      & psea_ice   , &   ! in:  sea-ice matrix
      & pland_sea  , &   ! in:  land-sea matrix
      & p_sfc      , &   ! in:  pressure @ sfc
      & pt_sfc     , &   ! in:  skin temperature @ sfc
      & pzen_obs   , &   ! in:  zenith angle [degrees]
      & plat_obs   , &   ! in:  obs latitude [radians]
      & plon_obs   , &   ! in:  obs longitude [radians]
      & ptb_obs    , &   ! in:  radiance array  
      & p_fg       , &   ! out: pressure profile FG
      & ph_fg      , &   ! out: half-pressure profile FG
      & prr_fg     , &   ! out: rain rate profile FG
      & prs_fg     , &   ! out: snow rate profile FG
      & prl_fg     , &   ! out: liq cloud profile FG
      & pri_fg     , &   ! out: ice cloud profile FG
      & prc_fg     , &   ! out: cloud fraction profile FG
      & prst_fg    , &   ! out: stratiform rain flux at FG
      & prco_fg    , &   ! out: convective rain flux at FG
      & ptcwv_fg   , &   ! out: tcwv fg 
      & ptb_bi     , &   ! out: TB bias array
      & ptb_fg     , &   ! out: TB first-guess array
      & ptb_fg_3d  , &   ! out: FG calculated from 3D clouds, not 1D
      & ptb_fg_3d_clear, & ! out: FG calculated from 3D ; clear sky part 
      & kid_dv       )   ! out: ondevar failure code
     
!**** 1D-Var in clouds/precipitation for SSM/I radiances

!     P. Bauer, P. Lopez, E. Moreau, D. Salmond   ECMWF    May 2004

!     Screening of observations prior to 1DVar retrieval; also used for
!     calculation of analysis TBs on final analysis trajectory

!     ONEDVAR_SCREEN can be called by ONEDVAR_RAINTB

!     Modifications:

!     A. Geer     4-Apr-2006   New bitwise failure codes (ifail)
!     A. Geer     5-Feb-2007   Store 3D as well as 1D TBs; analysis too
!     C. O'Dell   17-Oct-2006  Changed to work for a single profile
!     A. Geer     24-Aug-2007  Channel and sat dependent departure check
 
!**** MODULES

!* KIND     
use parkind1     , only: jpim, jprb
use yomhook      , only: lhook, dr_hook
use yomancs      , only: rmdi 

!* IFS
use yomdim       , only: nflevg  
use yomgem       , only: vah, vbh
use yomcst       , only: rg, rpi
      
use paronedvar, only: npred_bias, rt_min, rt_max, rq_min, rq_max
use yomonedvar, only: rlimit_err, rlimit_sf, onedvar_id, &
 & ifail_fg_t_q, ifail_frozen_precip, ifail_fg_tb_depar
      
implicit none                         

!**** VARIABLES
!* IN/OUTPUT
integer (kind=jpim), intent (in) :: knumb, k1d_x, k1d_y, k1d_z

real (kind=jprb), intent (inout), dimension (nflevg) :: &
  & pt, &
  & pq      

real (kind=jprb), intent (in) , dimension (nflevg) :: &
  & pten_t, &
  & pten_q, &
  & prain, &
  & psnow, &
  & pclfr, &
  & pcllw, &
  & pcliw    
         
real (kind=jprb), intent (in) :: &
  & pt_2m, &
  & pq_2m, &
  & ptd_2m, &
  & pu_star, &
  & pv_star, &
  & pu_10m, &
  & pv_10m, &
  & psh_sfc, &
  & plh_sfc, &
  & psea_ice, &
  & pland_sea, &
  & p_sfc, &
  & pt_sfc, &
  & pzen_obs, &
  & plat_obs, &
  & plon_obs

real (kind=jprb), intent (in), dimension (k1d_y) :: ptb_obs

real (kind=jprb), intent (out), dimension (nflevg) :: &
  & p_fg, &
  & prr_fg, &  
  & prs_fg, &  
  & prl_fg, &  
  & pri_fg, &  
  & prc_fg    
  
real (kind=jprb), intent (out), dimension (nflevg+1) ::   ph_fg  
      
real (kind=jprb), intent (out) :: &
  & ptcwv_fg, &
  & prst_fg, &
  & prco_fg  
  
real (kind=jprb), intent (out), dimension (k1d_y) :: &
  & ptb_bi, &
  & ptb_fg, &
  & ptb_fg_3d, &
  & ptb_fg_3d_clear
  
integer (kind=jpim), intent (in) :: ksat, kfov
integer (kind=jpim), intent (inout) :: kid_dv

!* LOCAL
real (kind=jprb), dimension (knumb,k1d_x) :: z1d_x 
real (kind=jprb), dimension (knumb,k1d_y) :: z1d_y, z1d_y_clear
real (kind=jprb), dimension (knumb,k1d_z) :: z1d_x_xt 
real (kind=jprb), dimension (knumb)       :: zcfrac

real (kind=jprb), dimension (npred_bias) :: zbias_pred

real    (kind=jprb) :: zrwp, zswp
integer (kind=jpim) :: i_lev, jy
real (kind=jprb) :: zhook_handle

!* External functions
logical, external :: onedvar_passive_ok

!* INTERFACES
#include "onedvar_get_bias.intfb.h"
#include "onedvar_obsop.intfb.h"

if (lhook) call dr_hook ('ONEDVAR_SCREEN',0,zhook_handle)

!* Initialize output
p_fg    (:) = RMDI
ph_fg   (:) = RMDI
prr_fg  (:) = RMDI
prs_fg  (:) = RMDI 
prl_fg  (:) = RMDI
pri_fg  (:) = RMDI
prc_fg  (:) = RMDI
prst_fg  = RMDI
prco_fg  = RMDI
ptcwv_fg = RMDI
ptb_bi (:) = RMDI
ptb_fg (:) = RMDI
ptb_fg_3d (:) = RMDI

! Test for temperature and moisture out-of-bounds (most profiles should pass)
do i_lev = 1, nflevg      
  if (pt (i_lev) < rt_min) kid_dv = ibset(kid_dv, ifail_fg_t_q)
  if (pt (i_lev) > rt_max) kid_dv = ibset(kid_dv, ifail_fg_t_q)
  if (pq (i_lev) < rq_min) kid_dv = ibset(kid_dv, ifail_fg_t_q)
  if (pq (i_lev) > rq_max) kid_dv = ibset(kid_dv, ifail_fg_t_q)
enddo
  
if (onedvar_passive_ok(kid_dv)) then

  ! Successful obervations only        
  z1d_x    (knumb,         1:  nflevg) = pt        (1:nflevg)
  z1d_x    (knumb,  nflevg+1:2*nflevg) = pq        (1:nflevg)
  z1d_x    (knumb,         2*nflevg+1) = pu_10m    
  z1d_x    (knumb,         2*nflevg+2) = pv_10m
  z1d_x_xt (knumb,         1:  nflevg) = pten_t    (1:nflevg)
  z1d_x_xt (knumb,  nflevg+1:2*nflevg) = pten_q    (1:nflevg)
  z1d_x_xt (knumb,7*nflevg+1         ) = pt_2m    
  z1d_x_xt (knumb,7*nflevg+2         ) = pq_2m     
  z1d_x_xt (knumb,7*nflevg+3         ) = ptd_2m    
  z1d_x_xt (knumb,7*nflevg+4         ) = pu_star   
  z1d_x_xt (knumb,7*nflevg+5         ) = pv_star   
  z1d_x_xt (knumb,7*nflevg+6         ) = psh_sfc   
  z1d_x_xt (knumb,7*nflevg+7         ) = plh_sfc   
  z1d_x_xt (knumb,7*nflevg+8         ) = pland_sea 
  z1d_x_xt (knumb,7*nflevg+9         ) = p_sfc     
  z1d_x_xt (knumb,7*nflevg+10        ) = pt_sfc 
  if (pzen_obs >= 0.0_JPRB) then
    z1d_x_xt (knumb,7*nflevg+13) = pzen_obs
  else
    z1d_x_xt (knumb,7*nflevg+13) = onedvar_id(ksat) % zenangle
  endif
  z1d_x_xt (knumb,7*nflevg+14        ) = plat_obs * 180.0_JPRB / rpi

  ! Construct Pressures & TCWV
  ptcwv_fg = 0.0_JPRB
  ph_fg (1:nflevg+1) = vbh (0:nflevg) * p_sfc + vah (0:nflevg)      
  do i_lev = 1, nflevg
    p_fg (i_lev) = 0.5 * (ph_fg (i_lev+1) + ph_fg (i_lev))
    ptcwv_fg = ptcwv_fg + pq (i_lev) &
        & * (ph_fg (i_lev+1) - ph_fg (i_lev)) / rg
  enddo       

  !* FG-TB (Using 1D physics)
  call onedvar_obsop (ksat, knumb, k1d_x, k1d_y, k1d_z, z1d_x, z1d_x_xt, z1d_y)

  !* Background precip fluxes / cloud water/ice/coverage
  prr_fg (1:nflevg) = z1d_x_xt (knumb,2*nflevg+1:3*nflevg)
  prs_fg (1:nflevg) = z1d_x_xt (knumb,3*nflevg+1:4*nflevg) 
  prl_fg (1:nflevg) = z1d_x_xt (knumb,4*nflevg+1:5*nflevg)
  pri_fg (1:nflevg) = z1d_x_xt (knumb,5*nflevg+1:6*nflevg)
  prc_fg (1:nflevg) = z1d_x_xt (knumb,6*nflevg+1:7*nflevg)

  prst_fg = z1d_x_xt (knumb,7*nflevg+11)
  prco_fg = z1d_x_xt (knumb,7*nflevg+12)

  !* TB-Bias
  zbias_pred (1) = ptcwv_fg                                     ! FG TCWV
  zbias_pred (2) = sqrt (pu_10m * pu_10m + pv_10m * pv_10m )    ! FG SWS
  zbias_pred (3) = (pt_sfc - 273.2) * 6.0 * (prst_fg + prco_fg) ! FG rain column

  call onedvar_get_bias (ksat, kfov, k1d_y, zbias_pred, ptb_bi (1:k1d_y))    

  !* Screening excessive snow
  zrwp = 0.0_jprb
  zswp = 0.0_jprb

  do i_lev = 1, nflevg
    zrwp = zrwp + prr_fg (i_lev) * (ph_fg (i_lev+1) - ph_fg (i_lev))
    zswp = zswp + prs_fg (i_lev) * (ph_fg (i_lev+1) - ph_fg (i_lev))
  enddo

  if (zswp >= rlimit_sf * zrwp) then
    kid_dv = ibset (kid_dv, ifail_frozen_precip)
  endif
  !Load FG TB
  do jy = 1, k1d_y
    ptb_fg (jy) = z1d_y (knumb,jy)
  enddo

  !* Screening excessive dTB FG
  if (kid_dv == 0) then  ! Obsop must have run succesfully
    do jy = 1, k1d_y

      ! Only for actively assimilated channels
      if (onedvar_id(ksat)%robs_err(jy) < rlimit_err) then

        if (abs (ptb_obs(jy) - ptb_bi(jy) - ptb_fg(jy)) > &
     &    onedvar_id(ksat) % rlimit_dep(jy) ) then

          kid_dv = ibset (kid_dv, ifail_fg_tb_depar)  
  
        endif 

      endif  

    enddo
  endif

  ! Replace the 1D-generated cloud parameters with those from ec_phys:
  ! NB the surface rain and snow fluxes are not used in obsop - we
  ! leave them set to 1D values.
  z1d_x_xt (knumb,2*nflevg+1:3*nflevg) = prain(1:nflevg)
  z1d_x_xt (knumb,3*nflevg+1:4*nflevg) = psnow(1:nflevg)
  z1d_x_xt (knumb,4*nflevg+1:5*nflevg) = pcllw(1:nflevg)
  z1d_x_xt (knumb,5*nflevg+1:6*nflevg) = pcliw(1:nflevg)
  z1d_x_xt (knumb,6*nflevg+1:7*nflevg) = pclfr(1:nflevg)

  ! Calculate FG-TB from 3D cloud/rain amounts: 
  call onedvar_obsop (ksat, knumb, k1d_x, k1d_y, k1d_z, z1d_x, z1d_x_xt, z1d_y, &
    &  ld1d_physics = .false., p1d_y_clear = z1d_y_clear, pcfrac = zcfrac) 
  ptb_fg_3d (:) = z1d_y (knumb,:)

  ptb_fg_3d_clear (:) = z1d_y_clear (knumb,:)  

endif

if (lhook) call dr_hook ('ONEDVAR_SCREEN',1,zhook_handle)
end subroutine onedvar_screen
