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

!**** Observation operator for 
!     4D-Var in clouds/precipitation for microwave radiances 

!     P. Bauer   ECMWF    May 2005

!     1. Call RTTOV-interface of observation operator

!     MWAVE_EMIS is called from CALLPAR (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
!     16-Apr-2008    Alan Geer  Extension to multiple sensors
!     23-Sep-2008    Alan Geer  Initialisations now done in ec_phys; code is now
!                               diffable with ad and tl versions.
!     09 Mar  2009    W. Bell   Add azimuth angles for windsat-like sensors
!     10-Jun-2009    Alan Geer  Per-channel status flag; normalised polarisation 
!                               difference calculated at 19 and 37 GHz.
!     16-Dec-2009     F. Karbou Surface emissivity estimation
!**** 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, n_satsens, &
 & mwave_serious, mwave_negative_q, mwave_land, &
 & mwave_excess_snow, mwave_cold_sector, ldmwave_land
use parmwave, only: rmissing_angle, & 
 & imwave_tcwv, imwave_tclw, imwave_tciw, &
 & imwave_swp, wn_snow_rt_problem 
use yomcst  , only: rpi
use yomct0  , only: lscreen
use yomtvrad, only : msensor_ssmis

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)
type (mwave_rad_type) , intent (inout) :: yd_mwave_rad     (kproma, n_satsens)

!* OTHER
integer (kind=jpim) :: iprof, inprof, i, jsat, inchan, ich, iproma
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,kmaxchannels) :: zrad_tb_fw
real    (kind=jprb), dimension (kproma,kmaxchannels) :: zrad_tb_clr
real    (kind=jprb), dimension (kproma,kmaxchannels,10) :: zrad_emis
real    (kind=jprb), dimension (kproma,kmaxchannels) :: zrad_ee_fw

real    (kind=jprb), dimension (kproma)              :: zcfrac
real    (kind=jprb) :: ztotal_cloud, zcloud_water_fraction
real    (kind=jprb) :: zemis1, zemis2, zemis3, zemis4

logical :: llprocess

! adjustment variables
real (kind=jprb) :: zhook_handle

!* INTERFACES

#include "mwave_diags.intfb.h"

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

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

  inchan = mwave_id (jsat) % nchannels 
  if (mwave_id(jsat) % sensid == msensor_ssmis) then

    ! Nasty hack for SSMIS: The last 4 channels on SSMIS, at 60.792GHz, are not 
    ! included in the RTTOV-9 Mie tables, so we must avoid using them. In future
    ! we need to regenerate the Mie tables with 24 channels. The TL and AD versions
    ! are protected against this because we flag these channels in mwave_screen.F90
    inchan = 20

  endif


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

  do i = kstart, kend

    !* Re-check land-sea contamination (resolution dependent) and for negative q after screening
    IF (.not. ldmwave_land) THEN
      if (yd_mwave_phys_fw (i) % lsm /= 0.0_JPRB) &
       & yd_mwave_rad (i,jsat) % screen(:) = ibset (yd_mwave_rad (i,jsat) % screen(:), mwave_land)
    ENDIF
    if (any (yd_mwave_phys_fw (i) % q (1:klev) < 0.0_JPRB)) &
     & yd_mwave_rad (i,jsat) % screen(:) = ibset (yd_mwave_rad (i,jsat) % screen(:), mwave_negative_q)

    !* Process any profile with at least one channel with no serious errors
    llprocess = .false.
    do ich = 1, inchan
      if ( .not. mwave_serious(yd_mwave_rad (i,jsat) % screen(ich)) ) then 
        llprocess = .true.
        exit
      endif
    enddo
    if (llprocess) 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) 
      zphys_sfl_fw  (inprof,1:klev)   = yd_mwave_phys_fw (i) % sfl (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 ) then 
        ! Azimuth angle available from observation data
        zrad_azi (inprof) = yd_mwave_rad (i,jsat) % azimuth
      else
        ! Set azimuth angle to missing
        zrad_azi (inprof) = rmissing_angle 
      endif

      !* Calculate condensate paths for diagnostics 
      call mwave_diags ( &
       & klev,    &  ! in : dimensions   
       & jsat,            &  ! in : satellite ID (for mwave) 
       & yd_mwave_phys_fw (i),            &  ! in: 2d/3d fields, FW
       & yd_mwave_rad (i,jsat) % diag)       ! inout: diagnostics array

      ! Avoid some known model and observation operator problems:

      ! (1) Cold sectors in winter - model just can't produce enough liquid cloud
      ! Identified by (i)   TCWV < 15 kg m^-2 (ii) CWF < 0.5 
      !               (iii) Total hydrometeors > 0.01 kg m^-2
      ! Do only in screening, to avoid "contaminating" huge numbers of obs
      if (lscreen) then

        ztotal_cloud = sum (yd_mwave_rad (i,jsat) % diag (imwave_tclw:imwave_tciw))
        if ( ztotal_cloud > 1.0E-12_JPRB ) then
          zcloud_water_fraction = yd_mwave_rad (i,jsat) % diag (imwave_tclw) / ztotal_cloud
        else
          zcloud_water_fraction = 1.0_JPRB
        endif
        if ( yd_mwave_rad (i,jsat) % diag (imwave_tcwv) < 15 &
         & .and. sum (yd_mwave_rad (i,jsat) % diag (imwave_tclw:imwave_swp)) > 0.01 &
         & .and. (zcloud_water_fraction < 0.5 ) ) then

          yd_mwave_rad (i,jsat) % screen(:) = &
           & ibset (yd_mwave_rad (i,jsat) % screen(:), mwave_cold_sector)

        endif

        ! (2) RTTOV-SCATT has an excessive response to snow
        if ( yd_mwave_rad (i,jsat) % diag (imwave_swp) > 0.5 ) then

          ! So eliminate all higher frequency channels in case of significant snow
          where( mwave_id(jsat) % rcwn(1:inchan) > wn_snow_rt_problem ) 
            yd_mwave_rad (i,jsat) % screen(1:inchan) = ibset (yd_mwave_rad (i,jsat) % screen(1:inchan), mwave_excess_snow)
          endwhere

        endif

      endif
    endif
  enddo

  if (inprof > 0) then


    do iprof = 1, inprof
      i = jprof (iprof)
      zrad_emis(iprof,1:inchan,1)= yd_mwave_rad (i,jsat) % obs   (1:inchan) 

      if (zphys_lsm (iprof) > 0.01_JPRB) THEN
        zrad_emis(iprof,1:inchan,7)= 0.9_JPRB
      else
        zrad_emis(iprof,1:inchan,7)= 2.0_JPRB
      endif
    enddo


    !* RTTOV-SCATT
    call mwave_emis_rttov (klev, inprof, &  ! in: levels, profiles
     &  inchan                           , &  ! in: channels
     &  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
     &  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_emis    (1:inprof,1:inchan,:)       , &  ! in/out: emissivity 
     &  zrad_tb_fw    (1:inprof,1:inchan)       , &  ! out: TB's
     &  zrad_tb_clr   (1:inprof,1:inchan)       , &  ! out: TB's assuming clear sky (forward only)
     &  zcfrac        (1:inprof))             ! out: cloud frac (forward only diagnostic)



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

      yd_mwave_rad (iproma,jsat) % eesat (1:inchan) = zrad_emis     (iprof,1:inchan,2)
      yd_mwave_rad (iproma,jsat) % eemod (1:inchan) = zrad_emis     (iprof,1:inchan,3)
      yd_mwave_rad (iproma,jsat) % trans (1:inchan) = zrad_emis     (iprof,1:inchan,4)
      yd_mwave_rad (iproma,jsat) % pers2 (1:inchan) = zrad_emis     (iprof,1:inchan,5)
      yd_mwave_rad (iproma,jsat) % eesurf (1:inchan) = zrad_emis     (iprof,1:inchan,7)

      ! assign emissivity to channels

      if (zphys_lsm (iprof) /= 0.0_JPRB) THEN

        zrad_ee_fw (iprof,1:inchan) = 0.9_JPRB

        If (mwave_id(jsat) % sensid == 6 ) then
          ! only valid for ssmi
          zemis1=yd_mwave_rad (iproma,jsat) % eesat   (4) 
          zemis2=yd_mwave_rad (iproma,jsat) % eesat   (5)

          if ((zemis1 > 0.0_JPRB).and.(zemis1 <= 1.0_JPRB)) then 
            zrad_ee_fw (iprof,1) =  zemis1
            zrad_ee_fw (iprof,3) =  zemis1 
            zrad_ee_fw (iprof,4) =  zemis1
            zrad_ee_fw (iprof,6) =  zemis1
          else
            zrad_ee_fw (iprof,1) =  0.955_JPRB
            zrad_ee_fw (iprof,3) =  0.955_JPRB 
            zrad_ee_fw (iprof,4) =  0.955_JPRB
            zrad_ee_fw (iprof,6) =  0.955_JPRB
          endif
          if ((zemis2 > 0.0_JPRB).and.(zemis2 <= 1.0_JPRB)) then 
            zrad_ee_fw (iprof,2) =  zemis2
            zrad_ee_fw (iprof,5) =  zemis2
            zrad_ee_fw (iprof,7) =  zemis2
          else
            zrad_ee_fw (iprof,2) =  0.855_JPRB
            zrad_ee_fw (iprof,5) =  0.855_JPRB
            zrad_ee_fw (iprof,7) =  0.855_JPRB
          endif
        endif

        If (mwave_id(jsat) % sensid == 10 ) then
          ! only valid for ssmis 

          ! emissivity at 50V is given to temperature channels
          zemis1=yd_mwave_rad (iproma,jsat) % eesat   (1) 
          zemis2=yd_mwave_rad (iproma,jsat) % eesat   (16)
          zemis3=yd_mwave_rad (iproma,jsat) % eesat   (15) 
          zemis4=yd_mwave_rad (iproma,jsat) % eesat   (18) 

          if ((zemis1 > 0.0_JPRB).and.(zemis1 <= 1.0_JPRB)) then 
            zrad_ee_fw (iprof,1:7) =  zemis1 
            zrad_ee_fw (iprof,19:inchan) =  zemis1
          else
            zrad_ee_fw (iprof,1:7) =  0.955_JPRB 
            zrad_ee_fw (iprof,19:inchan) =  0.955_JPRB
          endif
          ! emissivities at 37GHz are given to 19,22 
          ! emissivities at 37H are given to humidity channels 
          if ((zemis2 > 0.0_JPRB).and.(zemis2 <= 1.0_JPRB)) then 
            zrad_ee_fw (iprof,13) =  zemis2
            zrad_ee_fw (iprof,16) =  zemis2
            zrad_ee_fw (iprof,14) =  zemis2 
            zrad_ee_fw (iprof,17) =  zemis2 
          else
            zrad_ee_fw (iprof,13) =  0.955_JPRB
            zrad_ee_fw (iprof,16) =  0.955_JPRB
            zrad_ee_fw (iprof,14) =  0.955_JPRB 
            zrad_ee_fw (iprof,17) =  0.955_JPRB 
          endif
          if ((zemis4 > 0.0_JPRB).and.(zemis4 <= 1.0_JPRB)) then 

            zrad_ee_fw (iprof,8:11) =  zemis4
          else
            if ((zemis3 > 0.0_JPRB).and.(zemis3 <= 1.0_JPRB)) then
              zrad_ee_fw (iprof,8:11) =  zemis3- 0.01_JPRB 
            else
              zrad_ee_fw (iprof,8:11) =  0.855_JPRB
            endif
          endif
          if ((zemis3 > 0.0_JPRB).and.(zemis3 <= 1.0_JPRB)) then 
            zrad_ee_fw (iprof,12) =  zemis3
            zrad_ee_fw (iprof,15) = zemis3
            zrad_ee_fw (iprof,18) =  zemis3
          else
            zrad_ee_fw (iprof,12) =  0.855_JPRB
            zrad_ee_fw (iprof,15) = 0.855_JPRB
            zrad_ee_fw (iprof,18) =  0.855_JPRB
          endif

        endif
        If (mwave_id(jsat) % sensid == 9 ) then
          ! only valid for tmi
          zemis1= yd_mwave_rad (iproma,jsat) % eesat   (6)
          zemis2= yd_mwave_rad (iproma,jsat) % eesat   (7)
          ! emissivities at 37GHz are given to all channels
          if ((zemis1 > 0.0_JPRB).and.(zemis1 <= 1.0_JPRB)) then 
            zrad_ee_fw (iprof,1) =  zemis1
            zrad_ee_fw (iprof,3) =  zemis1
            zrad_ee_fw (iprof,5) =  zemis1
            zrad_ee_fw (iprof,8) =  zemis1
            zrad_ee_fw (iprof,6) =  zemis1
          else
            zrad_ee_fw (iprof,1) =  0.955_JPRB
            zrad_ee_fw (iprof,3) =  0.955_JPRB
            zrad_ee_fw (iprof,5) =  0.955_JPRB
            zrad_ee_fw (iprof,8) =  0.955_JPRB
            zrad_ee_fw (iprof,6) =  0.955_JPRB
          endif


          if ((zemis2 > 0.0_JPRB).and.(zemis2 <= 1.0_JPRB)) then 
            zrad_ee_fw (iprof,2) =  zemis2
            zrad_ee_fw (iprof,4) =  zemis2
            zrad_ee_fw (iprof,7) =  zemis2
            zrad_ee_fw (iprof,9) =  zemis2
          else
            zrad_ee_fw (iprof,2) =  0.855_JPRB
            zrad_ee_fw (iprof,4) =  0.855_JPRB
            zrad_ee_fw (iprof,7) =  0.855_JPRB
            zrad_ee_fw (iprof,9) =  0.855_JPRB
          endif

        endif
        If (mwave_id(jsat) % sensid == 17 ) then
          ! only valid for tmi
          zemis1= yd_mwave_rad (iproma,jsat) % eesat   (9)
          zemis2= yd_mwave_rad (iproma,jsat) % eesat   (10)
          ! emissivities at 37GHz are given to all channels
          if ((zemis2 > 0.0_JPRB).and.(zemis2 <= 1.0_JPRB)) then 
            zrad_ee_fw (iprof,1) = zemis1
            zrad_ee_fw (iprof,3) = zemis1
            zrad_ee_fw (iprof,5) = zemis1
            zrad_ee_fw (iprof,7) = zemis1
            zrad_ee_fw (iprof,9) = zemis1
          else
            zrad_ee_fw (iprof,1) = 0.955_JPRB
            zrad_ee_fw (iprof,3) = 0.955_JPRB
            zrad_ee_fw (iprof,5) = 0.955_JPRB
            zrad_ee_fw (iprof,7) = 0.955_JPRB
            zrad_ee_fw (iprof,9) = 0.955_JPRB
          endif

          if ((zemis2 > 0.0_JPRB).and.(zemis2 <= 1.0_JPRB)) then 
            zrad_ee_fw (iprof,2) =  zemis2
            zrad_ee_fw (iprof,4) =  zemis2
            zrad_ee_fw (iprof,6) =  zemis2
            zrad_ee_fw (iprof,8) =  zemis2  
            zrad_ee_fw (iprof,10) = zemis2
          else
            zrad_ee_fw (iprof,2) =  0.855_JPRB
            zrad_ee_fw (iprof,4) =  0.855_JPRB
            zrad_ee_fw (iprof,6) =  0.855_JPRB
            zrad_ee_fw (iprof,8) =  0.855_JPRB
            zrad_ee_fw (iprof,10) = 0.855_JPRB
          endif

        endif

      else
        zrad_ee_fw(iprof,1:inchan)= 2.0_JPRB
      endif


      yd_mwave_rad (iproma,jsat) % pers1 (1:inchan) = zrad_ee_fw     (iprof,1:inchan)
    enddo


  endif


enddo

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

end subroutine mwave_emis
