subroutine onedvar_simul &
 & (ksat, k1d_x, k1d_y, k1d_z, k_max, knumb, kstglo, &
 &  pxn                , &
 &  p1d_x_fg           , &
 &  p1d_x_xt           , &
 &  p1d_b_evec         , &
 &  p1d_b_eval         , &
 &  p1d_x_sigb         , &
 &  p1d_y              , &     
 &  p1d_r_inv          , &
 &  k_iter             , &
 &  pxj_o              , &
 &  pxj_b              , &
 &  pdj                , &
 &  kfail)
    
!**** Interface between M1QN3 minimizer and observation operator for 
!     1D-Var in clouds/precipitation for SSM/I radiances 

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

!     1. Change of control variable chi -> x
!     2. Change of control variable x = rh' -> q
!     3. Observation operator calculates TB
!     4. Cost-function Jo, Jb, gradient
!     5. Change of gradient dJ/dq -> dJ/drh'
!     6. Change of gradient dJ/drh'= dJ/dx -> dJ/dchi
!     7. Norm of gradient in x

!     ONEDVAR_SIMUL is called from ONEDVAR_RAINTB, M1QN3A_1DV, MLIS0_1DV

!     Modifications:

!     A. Geer     4-Apr-2006   Retrieve surface wind; New bitwise failure
!                              codes (kfail)
!     C. O'Dell   17-Oct-2006  Added ksat calling parameter
    
!**** MODULES      

!* KIND     
use parkind1, only: jpim, jprb
use yomhook , only: lhook,   dr_hook     
use yomdim  , only: nflevg
use paronedvar, only: rt_min, rt_max, rq_min, rq_max
use yomonedvar, only: ifail_minim_inc, ifail_minim_wind, ifail_minim_t, &
 & ifail_minim_q

implicit none
    
!**** VARIABLES
!* IN/OUTPUT
integer (kind=jpim), intent (   in)                          :: ksat, k1d_x, k1d_y, k1d_z, k_max, k_iter
integer (kind=jpim), intent (   in)                          :: knumb, kstglo
real    (kind=jprb), intent (   in), dimension (k1d_x,k1d_x) :: p1d_b_evec
real    (kind=jprb), intent (   in), dimension (k1d_x)       :: pxn, p1d_x_fg, p1d_b_eval, p1d_x_sigb
real    (kind=jprb), intent (inout), dimension (k1d_z)       :: p1d_x_xt
real    (kind=jprb), intent (   in), dimension (k1d_y)       :: p1d_y   
real    (kind=jprb), intent (   in), dimension (k1d_y,k1d_y) :: p1d_r_inv  
real    (kind=jprb), intent (inout), dimension (0:k_max)     :: pxj_o, pxj_b
real    (kind=jprb), intent (  out), dimension (k1d_x)       :: pdj
integer (kind=jpim), intent (inout)                          :: kfail

!* OTHER
real    (kind=jprb), dimension (knumb,k1d_x) ::z1d_x, z1d_dj_ox
real    (kind=jprb), dimension (knumb,k1d_z) ::z1d_x_xt
real    (kind=jprb), dimension (knumb,k1d_y) ::z1d_y, z1d_dj_o

real    (kind=jprb), dimension (k1d_x)   :: zx, zdx, zdj_ox, zdj_oxn, zdj_b, zdj_x
real    (kind=jprb), dimension (k1d_y)   :: zy, zdj_o
real    (kind=jprb), dimension (0:k_max) :: zdj_n
integer (kind=jpim)                      :: ix, jx, inumb
real    (kind=jprb) :: zhook_handle

character(len=1) :: cld_conf
                     
!* INTERFACES
#include "onedvar_obsop.intfb.h"
#include "onedvar_obsop_gr.intfb.h"
#include "abor1.intfb.h"

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

if (k_iter > k_max) call abor1 ('ONEDVAR_SIMUL: Too many iterations')

!* Initialize
z1d_x     (:,:) = 0.0_JPRB
z1d_y     (:,:) = 0.0_JPRB
z1d_x_xt  (:,:) = 0.0_JPRB
z1d_dj_o  (:,:) = 0.0_JPRB
z1d_dj_ox (:,:) = 0.0_JPRB

zx      (:) = 0.0_JPRB
zdx     (:) = 0.0_JPRB
zy      (:) = 0.0_JPRB
zdj_o   (:) = 0.0_JPRB
zdj_o   (:) = 0.0_JPRB
zdj_ox  (:) = 0.0_JPRB
zdj_oxn (:) = 0.0_JPRB
zdj_b   (:) = 0.0_JPRB
pdj     (:) = 0.0_JPRB
zdj_x   (:) = 0.0_JPRB
    
zdj_n (k_iter) = 0.0_JPRB
pxj_o (k_iter) = 0.0_JPRB
pxj_b (k_iter) = 0.0_JPRB
    
cld_conf = 'G'
inumb    = knumb

!* xn -> x 
do ix = 1, k1d_x
   do jx = 1, k1d_x
      zdx (ix) = zdx (ix) + p1d_b_evec (ix,jx) * pxn (jx) * sqrt (p1d_b_eval(jx))
   enddo
enddo

zx (:) = p1d_x_fg (:) + zdx (:) 

! Check increments etc.
do ix = 1, k1d_x

   if (abs (zdx (ix)) > p1d_x_sigb (ix) * 10.0_JPRB) then
      ! Too large increments (larger than 10*sigma_b): failure
      kfail = ibset(kfail, ifail_minim_inc)
   endif

   if (ix > nflevg*2 .and. ix <= (nflevg*2+2) .and. (abs (zdx (ix)) > p1d_x_sigb (ix) * 3.0_JPRB)) then
      ! Excessive 10m wind increments (3*sigma_b threshold): failure
      kfail = ibset(kfail, ifail_minim_wind)
   endif 
     
   if (ix <= nflevg .and. (zx (ix) < rt_min .or. zx (ix) > rt_max)) then
      ! Unrealistic temperatures: failure
      kfail = ibset(kfail, ifail_minim_t)
   endif

   ! Examine q part of vector   
   if (ix >  nflevg .and. ix <= nflevg*2 ) then
   
      if  (zx (ix) > rq_max) then
         ! Unrealistically high humidities: failure
         kfail = ibset(kfail, ifail_minim_q)
      endif    
              
      if  (zx (ix) < rq_min) then
         ! Excessively small or negative humidities: reset to small positive number
         zx (ix) = rq_min
      endif
      
   endif
enddo

if (kfail /= 0) then
   if (lhook) call dr_hook ('ONEDVAR_SIMUL',1,zhook_handle)
   return
endif  

!* new y(x), trajectory
z1d_x_xt (inumb,:) = p1d_x_xt (:)
z1d_x    (inumb,:) = zx (:)

call onedvar_obsop (ksat, knumb, k1d_x, k1d_y, k1d_z, z1d_x, z1d_x_xt, z1d_y)

zy (:) = z1d_y (inumb,:)

!* J_o
zdj_o (:) = matmul (p1d_r_inv (:,:), zy (:) - p1d_y (:)) 

    
pxj_o (k_iter) = 0.5_JPRB * dot_product (zdj_o (:), zy (:) - p1d_y (:)) 
    
!* J_b
zdj_b (:) = pxn (:)
pxj_b (k_iter) = 0.5_JPRB * dot_product (pxn (:), pxn (:)) 

!* dJ_o in x-space
z1d_x_xt (inumb,:) = p1d_x_xt (:)
z1d_x    (inumb,:) = zx       (:)
z1d_dj_o (inumb,:) = zdj_o    (:)

call onedvar_obsop_gr (ksat, knumb, k1d_x, k1d_y, k1d_z, &
                      &  z1d_x, z1d_x_xt, z1d_y, z1d_dj_o, z1d_dj_ox)

zy     (:) = z1d_y     (inumb,:)
zdj_ox (:) = z1d_dj_ox (inumb,:)                    
    
!* zdj_o, dJ in xn-space    
zdj_oxn (:) = sqrt (p1d_b_eval (:)) * matmul (transpose (p1d_b_evec (:,:)), zdj_ox (:))
     
pdj (:) = zdj_b (:) + zdj_oxn (:)

        
!* norm of dJ in x-space
do ix = 1, k1d_x
   do jx = 1, k1d_x
      zdj_x (ix) = zdj_x (ix) + p1d_b_evec (ix,jx) * pdj (jx) / sqrt (p1d_b_eval (jx))
   enddo
enddo

zdj_n (k_iter) = dot_product (zdj_x (:), zdj_x (:)) 
   
if (lhook) call dr_hook('ONEDVAR_SIMUL',1,zhook_handle)

end subroutine onedvar_simul
