subroutine mwave_obsop_ad (kstart, kend, kproma, klev, kmaxchannels, &       ! in: dimensions
                        &  yd_mwave_phys_fw, yd_mwave_phys_ad, yd_mwave_rad) ! in/out: 2d/3d fields, FW/AD

!**** Adjoint of observation operator for 
!     4D-Var in clouds/precipitation for microwave radiances 

!     P. Bauer   ECMWF    December 2005

!     1. Call AD of RTTOV-interface of observation operator

!     MWAVE_OBSOP_AD is called from CALLPARAD (ifs/phys_ec)

!     Modifications:
!     September 2006, P. Bauer, Recoded to outsource phys operators to CALLPAR and 
!                               Use new F90   types
!     21-Nov-2007     A. Geer   RTTOV9 compatible
!     23 April 2008   A. Geer   Extension to multiple sensors
!     23 Sept  2008   A. Geer   Deal with zenith angles and elevation; recalculate obs error
!     09 Mar  2009    W. Bell   Add azimuth angles for windsat-like sensors
!     10 June  2009   A. Geer   Per-channel status flag and passive mode enabled.
!     16-Dec-2009     F. Karbou Surface emissivity estimation
!     07-Apr-2010     A. Geer   Cloud / precip fraction consistent with physics 

!**** MODULES      

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

!* IFS
use yommwave, only: mwave_phys_type, mwave_rad_type, mwave_id, mwave_ok, &
                  & n_satsens, mwave_ok_a1, &
                  & rlimit_obs_err, ldmwave_land      
use parmwave, only: rmissing_angle, rmwave_no_emis  
use yomcst  , only: rpi
use yomtvrad, only: msensor_windsat
use yomancs,  only: rmdi

implicit none
          
!* Common variables
integer (kind=jpim), intent    (in)    :: kstart, kend, kproma, klev, kmaxchannels

type (mwave_phys_type), intent (inout) :: yd_mwave_phys_fw (kproma), yd_mwave_phys_ad (kproma)
type (mwave_rad_type) , intent (inout) :: yd_mwave_rad     (kproma, n_satsens)

!* OTHER
integer (kind=jpim) :: iprof, inprof, i, jsat, inchan
integer (kind=jpim), dimension (kproma) :: jprof

real    (kind=jprb), dimension (kproma,klev+1) :: zphys_ph_fw
real    (kind=jprb), dimension (kproma,klev)   :: zphys_rfl_fw, zphys_sfl_fw
real    (kind=jprb), dimension (kproma,klev)   :: zphys_cwc_fw, zphys_cic_fw , zphys_cc_fw
real    (kind=jprb), dimension (kproma,klev)   :: zphys_p_fw  , zphys_t_fw   , zphys_q_fw
real    (kind=jprb), dimension (kproma)        :: zphys_u10_fw, zphys_v10_fw , zphys_t2m_fw , zphys_q2m_fw
real    (kind=jprb), dimension (kproma)        :: zphys_lsm, zphys_tsfc_fw, zphys_lat, zphys_elevation
real    (kind=jprb), dimension (kproma)        :: zrad_zen,zrad_azi
             
real    (kind=jprb), dimension (kproma,klev+1) :: zphys_ph_ad  
real    (kind=jprb), dimension (kproma,klev)   :: zphys_rfl_ad, zphys_sfl_ad  
real    (kind=jprb), dimension (kproma,klev)   :: zphys_cwc_ad, zphys_cic_ad , zphys_cc_ad
real    (kind=jprb), dimension (kproma,klev)   :: zphys_p_ad  , zphys_t_ad   , zphys_q_ad  
real    (kind=jprb), dimension (kproma)        :: zphys_u10_ad, zphys_v10_ad , zphys_t2m_ad , zphys_q2m_ad
real    (kind=jprb), dimension (kproma)        :: zphys_tsfc_ad

real    (kind=jprb), dimension (kproma,kmaxchannels) :: zrad_tb_fw, zrad_tb_ad, zrad_ee_fw

real    (kind=jprb), dimension (kproma)              :: zcfrac_fw, zcfrac_ad

logical :: lluse_channel(kproma,kmaxchannels)
integer (kind=jpim) :: ich

! adjustment variables
real (kind=jprb) :: zhook_handle
    
!* INTERFACES
!#include "mwave_obsop_rttov_ad.intfb.h"
#include "mwave_cpfrac.intfb.h"

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

!* Loop over all satellite/sensor combinations
do jsat = 1, n_satsens

  lluse_channel(:,:) = .false.

  inchan = mwave_id (jsat) % nchannels

  !* Extract active profiles
  inprof    = 0
  jprof (:) = 0

  do i = kstart, kend

    if (mwave_ok_a1(yd_mwave_rad (i,jsat) % screen(1:inchan))) then 

      inprof = inprof + 1
      jprof (inprof) = i

      zphys_p_fw    (inprof,1:klev)   = yd_mwave_phys_fw (i) % p   (1:klev)
      zphys_ph_fw   (inprof,1:klev+1) = yd_mwave_phys_fw (i) % ph  (1:klev+1)
      zphys_t_fw    (inprof,1:klev)   = yd_mwave_phys_fw (i) % t   (1:klev) 
      zphys_q_fw    (inprof,1:klev)   = yd_mwave_phys_fw (i) % q   (1:klev) 

      zphys_rfl_fw  (inprof,1:klev)   = yd_mwave_phys_fw (i) % rfl (1:klev) &
                                    & + yd_mwave_phys_fw (i) % crfl(1:klev)
      zphys_sfl_fw  (inprof,1:klev)   = yd_mwave_phys_fw (i) % sfl (1:klev) &
                                    & + yd_mwave_phys_fw (i) % csfl(1:klev)  
      zphys_cwc_fw  (inprof,1:klev)   = yd_mwave_phys_fw (i) % cwc (1:klev) 
      zphys_cic_fw  (inprof,1:klev)   = yd_mwave_phys_fw (i) % cic (1:klev) 
      zphys_cc_fw   (inprof,1:klev)   = yd_mwave_phys_fw (i) % cc  (1:klev)

      zphys_t2m_fw  (inprof) = yd_mwave_phys_fw (i) % t2m
      zphys_q2m_fw  (inprof) = yd_mwave_phys_fw (i) % q2m
      zphys_u10_fw  (inprof) = yd_mwave_phys_fw (i) % u10
      zphys_v10_fw  (inprof) = yd_mwave_phys_fw (i) % v10
      zphys_tsfc_fw (inprof) = yd_mwave_phys_fw (i) % tsk 

      zphys_lsm     (inprof) = yd_mwave_phys_fw (i) % lsm
      zphys_lat     (inprof) = asin( yd_mwave_phys_fw (i) % slat ) * 180.0_JPRB / rpi
      zphys_elevation (inprof) = yd_mwave_phys_fw (i) % orog ! metres

      if ( yd_mwave_rad (i,jsat) % zenith /= rmissing_angle ) then 
        ! Zenith angle available from observation data
        zrad_zen (inprof) = yd_mwave_rad (i,jsat) % zenith
      else
        ! Fixed zenith angle (SSM/I, SSMIS, AMSR-E)
        zrad_zen (inprof) = mwave_id (jsat) % zenith
      endif

      if ( yd_mwave_rad (i,jsat) % azimuth /= rmissing_angle .and. &
        &  mwave_id(jsat) % sensid == msensor_windsat ) then 
        ! Windsat requires azimuth angle for emissivity calculation
        zrad_azi (inprof) = yd_mwave_rad (i,jsat) % azimuth
      else
        ! Set azimuth angle to RMDI to trigger FASTEM-2 behaviour, i.e.
        ! no azimuth dependence.
        zrad_azi (inprof) = rmdi 
      endif

      if (ldmwave_land) then  
        ! get stored land surface emissivity  
      zrad_ee_fw (inprof,1:inchan) = yd_mwave_rad (i,jsat) % pers1 (1:inchan)
      else
        ! use RTTOV's emissivity model
        zrad_ee_fw (inprof,1:inchan) = rmwave_no_emis
      endif

      !* Set input perturbations
      zrad_tb_ad (inprof,1:inchan) = yd_mwave_rad (i,jsat) % ad (1:inchan)
      yd_mwave_rad (i,jsat) % ad (1:inchan) = 0.0_JPRB   
      
      !* Calculate cloud / precip fraction
      call mwave_cpfrac ( &
       & klev, &                  ! in  : dimensions   
       & jsat,            &  ! in : satellite ID (for mwave) 
       & yd_mwave_phys_fw (i),            &  ! in: 2d/3d fields, FW
       & zcfrac_fw(inprof))     ! out: cloud/precip fraction

      ! Adjoint & TL only : save time by not computing channels with v. high errors.
    do ich = 1, inchan
      if (yd_mwave_rad (i,jsat) % oerr(ich) < rlimit_obs_err &
       &  .and. mwave_ok( yd_mwave_rad (i,jsat) % screen (ich) )) then
        lluse_channel(inprof,ich) = .true.
      endif
    enddo

    endif
  enddo                          

  if (inprof > 0) then
                                
    !* RTTOV-SCATT
    zphys_p_ad    (:,:) = 0.0_JPRB 
    zphys_ph_ad   (:,:) = 0.0_JPRB
    zphys_t_ad    (:,:) = 0.0_JPRB
    zphys_q_ad    (:,:) = 0.0_JPRB
    
    zphys_t2m_ad  (:)   = 0.0_JPRB
    zphys_q2m_ad  (:)   = 0.0_JPRB
    zphys_u10_ad  (:)   = 0.0_JPRB
    zphys_v10_ad  (:)   = 0.0_JPRB
    zphys_tsfc_ad (:)   = 0.0_JPRB
    
    zphys_rfl_ad  (:,:) = 0.0_JPRB 
    zphys_sfl_ad  (:,:) = 0.0_JPRB 
    zphys_cwc_ad  (:,:) = 0.0_JPRB 
    zphys_cic_ad  (:,:) = 0.0_JPRB 
    zphys_cc_ad   (:,:) = 0.0_JPRB 
    zcfrac_ad     (:) = 0.0_JPRB 

    call mwave_obsop_rttov_ad (klev, inprof, & ! in: levels, profiles
      &  inchan                           , &  ! in: channels
      &  lluse_channel  (1:inprof,1:inchan), & ! in: which channels to do computations for
      &  jsat                             , &  ! in: satellite/sensor index
      &  zphys_p_fw    (1:inprof,:)       , &  ! in: pressure
      &  zphys_ph_fw   (1:inprof,:)       , &  ! in: pressure half levels
      &  zphys_t_fw    (1:inprof,:)       , &  ! in: temperature
      &  zphys_q_fw    (1:inprof,:)       , &  ! in: spec. humidity
      &  zphys_rfl_fw  (1:inprof,:)       , &  ! in: rain flux 
      &  zphys_sfl_fw  (1:inprof,:)       , &  ! in: snow flux
      &  zphys_cwc_fw  (1:inprof,:)       , &  ! in: cloud water content 
      &  zphys_cic_fw  (1:inprof,:)       , &  ! in: cloud ice content 
      &  zphys_cc_fw   (1:inprof,:)       , &  ! in: cloud coverage    
      &  zphys_t2m_fw  (1:inprof)         , &  ! in: 2m-temperature
      &  zphys_q2m_fw  (1:inprof)         , &  ! in: 2m-spec. humdity                            
      &  zphys_u10_fw  (1:inprof)         , &  ! in: 10m-u windspeed
      &  zphys_v10_fw  (1:inprof)         , &  ! in: 10m-v windspeed
      &  zphys_tsfc_fw (1:inprof)         , &  ! in: skin temperature
      &  zcfrac_fw     (1:inprof)         , &  ! in: cloud frac FW 
      &  zphys_lsm     (1:inprof)         , &  ! in: land fraction
      &  zphys_lat     (1:inprof)         , &  ! in: latitude (degrees)
      &  zphys_elevation (1:inprof)       , &  ! in: surface elevation (m)
      &  zrad_zen      (1:inprof)         , &  ! in: satellite zenith angle
      &  zrad_azi      (1:inprof)         , &  ! in: satellite azimuth angle
      &  zphys_p_ad    (1:inprof,:)       , &  ! inout: pressure, AD
      &  zphys_ph_ad   (1:inprof,:)       , &  ! inout: pressure half levels, AD
      &  zphys_t_ad    (1:inprof,:)       , &  ! inout: temperature, AD
      &  zphys_q_ad    (1:inprof,:)       , &  ! inout: spec. humidity, AD
      &  zphys_rfl_ad  (1:inprof,:)       , &  ! inout: rain flux, AD 
      &  zphys_sfl_ad  (1:inprof,:)       , &  ! inout: snow flux, AD
      &  zphys_cwc_ad  (1:inprof,:)       , &  ! inout: cloud water content, AD 
      &  zphys_cic_ad  (1:inprof,:)       , &  ! inout: cloud ice content, AD 
      &  zphys_cc_ad   (1:inprof,:)       , &  ! inout: cloud coverage, AD    
      &  zphys_t2m_ad  (1:inprof)         , &  ! inout: 2m-temperature, AD
      &  zphys_q2m_ad  (1:inprof)         , &  ! inout: 2m-spec. humdity, AD                            
      &  zphys_u10_ad  (1:inprof)         , &  ! inout: 10m-u windspeed, AD
      &  zphys_v10_ad  (1:inprof)         , &  ! inout: 10m-v windspeed, AD
      &  zphys_tsfc_ad (1:inprof)         , &  ! inout: skin temperature, AD      
      &  zcfrac_ad     (1:inprof)         , &  ! inout: cloud frac AD     
      &  zrad_ee_fw    (1:inprof,1:inchan), &  !   
      &  zrad_tb_fw    (1:inprof,1:inchan), &  ! out: TB's
      &  zrad_tb_ad    (1:inprof,1:inchan))    ! in:  TB's, AD

    !* Restore to kproma-array                     
    do iprof = 1, inprof
      i = jprof (iprof)

      !* Calculate condensate paths and cloud / precip fraction - adjoint
      call mwave_cpfrac ( &
       & klev, &                  ! in  : dimensions   
       & jsat, &                  ! in : satellite ID (for mwave) 
       & yd_mwave_phys_fw (i), &  ! in: 2d/3d fields, FW
       & zcfrac_fw(iprof), &      ! out: cloud/precip fraction
       & yd_mwave_phys_ad = yd_mwave_phys_ad (i), &  ! inout: 2d/3d fields, AD
       & pcfrac_ad        = zcfrac_ad(iprof))        ! in: AD cloud/precip fraction

      yd_mwave_rad (i,jsat) % fw (1:inchan) = zrad_tb_fw (iprof,1:inchan)
      yd_mwave_rad (i,jsat) % pers1 (1:inchan) = zrad_ee_fw (iprof,1:inchan)
              
      yd_mwave_phys_ad (i) % u10 = yd_mwave_phys_ad (i) % u10 + zphys_u10_ad  (iprof)           
      yd_mwave_phys_ad (i) % v10 = yd_mwave_phys_ad (i) % v10 + zphys_v10_ad  (iprof)                
      yd_mwave_phys_ad (i) % t2m = yd_mwave_phys_ad (i) % t2m + zphys_t2m_ad  (iprof)             
      yd_mwave_phys_ad (i) % q2m = yd_mwave_phys_ad (i) % q2m + zphys_q2m_ad  (iprof)                               
      yd_mwave_phys_ad (i) % tsk = yd_mwave_phys_ad (i) % tsk + zphys_tsfc_ad (iprof) 
       
      zphys_u10_ad  (iprof) = 0.0_JPRB           
      zphys_v10_ad  (iprof) = 0.0_JPRB                
      zphys_t2m_ad  (iprof) = 0.0_JPRB             
      zphys_q2m_ad  (iprof) = 0.0_JPRB                               
      zphys_tsfc_ad (iprof) = 0.0_JPRB 

      yd_mwave_phys_ad (i) % p  (1:klev)   = yd_mwave_phys_ad (i) % p  (1:klev)   + zphys_p_ad   (iprof,1:klev)
      yd_mwave_phys_ad (i) % ph (1:klev+1) = yd_mwave_phys_ad (i) % ph (1:klev+1) + zphys_ph_ad  (iprof,1:klev+1)
      yd_mwave_phys_ad (i) % t  (1:klev)   = yd_mwave_phys_ad (i) % t  (1:klev)   + zphys_t_ad   (iprof,1:klev)
      yd_mwave_phys_ad (i) % q  (1:klev)   = yd_mwave_phys_ad (i) % q  (1:klev)   + zphys_q_ad   (iprof,1:klev)
                                
      zphys_p_ad   (iprof,1:klev)   = 0.0_JPRB
      zphys_ph_ad  (iprof,1:klev+1) = 0.0_JPRB
      zphys_t_ad   (iprof,1:klev)   = 0.0_JPRB
      zphys_q_ad   (iprof,1:klev)   = 0.0_JPRB

      yd_mwave_phys_ad (i) % rfl (1:klev) = yd_mwave_phys_ad (i) % rfl (1:klev) + zphys_rfl_ad (iprof,1:klev)
      yd_mwave_phys_ad (i) % sfl (1:klev) = yd_mwave_phys_ad (i) % sfl (1:klev) + zphys_sfl_ad (iprof,1:klev)
      yd_mwave_phys_ad (i) % crfl(1:klev) = yd_mwave_phys_ad (i) % crfl(1:klev) + zphys_rfl_ad (iprof,1:klev)
      yd_mwave_phys_ad (i) % csfl(1:klev) = yd_mwave_phys_ad (i) % csfl(1:klev) + zphys_sfl_ad (iprof,1:klev)
      yd_mwave_phys_ad (i) % cwc (1:klev) = yd_mwave_phys_ad (i) % cwc (1:klev) + zphys_cwc_ad (iprof,1:klev)
      yd_mwave_phys_ad (i) % cic (1:klev) = yd_mwave_phys_ad (i) % cic (1:klev) + zphys_cic_ad (iprof,1:klev)
      yd_mwave_phys_ad (i) % cc  (1:klev) = yd_mwave_phys_ad (i) % cc  (1:klev) + zphys_cc_ad  (iprof,1:klev)

      zphys_rfl_ad (iprof,1:klev) = 0.0_JPRB
      zphys_sfl_ad (iprof,1:klev) = 0.0_JPRB
      zphys_cwc_ad (iprof,1:klev) = 0.0_JPRB
      zphys_cic_ad (iprof,1:klev) = 0.0_JPRB
      zphys_cc_ad  (iprof,1:klev) = 0.0_JPRB

    enddo
  endif

enddo

if (lhook) call dr_hook ('MWAVE_OBSOP_AD',1,zhook_handle) 

end subroutine mwave_obsop_ad
