SUBROUTINE MWAVE_PUT( PMWAVE_TB_BUF,PMWAVE_OERR_BUF,PMWAVE_PERS1_BUF,&
  & PMWAVE_DIAG_BUF, PMWAVE_P19_BUF,PMWAVE_P37_BUF,PMWAVE_GNORM_BUF,KMWAVE_BUF)

!*****MWAVE_PUT* - 4D-VAR RAIN ASSIMILATION 

!     P. Bauer, P. Lopez, D. Salmond   ECMWF    Aug 2006

!     PURPOSE.
!     -------
!     PUT BRIGHTNESS TEMPERATURES FROM GRID-POINT SPACE TO ODB

!**   INTERFACE.
!**   ---------
!**   *CALL* * MWAVE_PUT()*  (FROM GP_MODEL)

!        Explicit arguments :
!        --------------------

!     AUTHOR: Deborah Salmond
!     DATE  : 01-08-2006

!     Modifications :
!     23 April 2008   A. Geer   Extension to multiple sensors
!     01 Oct   2008   A. Geer   Tidy up 
!     10 June  2009   A. Geer   Polarisation differences stored; per-channel
!                               status flag; passive mode enabled
!     01-Nov-2009   Anne Fouilloux  Obs to grid point mapping now in ODB
!     16-Dec-2009   F. Karbou	 Allow surface emissivity handling
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMDB
USE YOMCT0   , ONLY : LSCREEN, LIFSTRAJ
USE YOMVNMB  , ONLY : NVNUMB
USE YOMNMEV  , ONLY : NR1EVENT
USE YOMECTAB , ONLY : NTSLOTNOS,NTSLOTNOE
USE YOMGEM   , ONLY : NGPTOT
USE YOMMWAVE , ONLY : N_SATSENS, MWAVE_ID, MWAVE_OK,&
     & MWAVE_SERIOUS, MWAVE_REJECTOBS,&
     & LDMWAVE_LAND
USE PARMWAVE , ONLY : NMAX_CHAN, NMWAVE_DIAG, NMWAVE_P, IMWAVE_P_OBS, IMWAVE_P_SIM, &
     &  NMWAVE_GNRM

IMPLICIT NONE

REAL(KIND=JPRB)   ,INTENT(IN)   :: PMWAVE_TB_BUF(NGPTOT,NMAX_CHAN,N_SATSENS)
REAL(KIND=JPRB)   ,INTENT(IN)   :: PMWAVE_OERR_BUF(NGPTOT,NMAX_CHAN,N_SATSENS)
REAL(KIND=JPRB)   ,INTENT(IN)   :: PMWAVE_PERS1_BUF(NGPTOT,NMAX_CHAN,N_SATSENS)
REAL(KIND=JPRB)   ,INTENT(IN)   :: PMWAVE_DIAG_BUF(NGPTOT,NMWAVE_DIAG,N_SATSENS)
REAL(KIND=JPRB)   ,INTENT(IN)   :: PMWAVE_P19_BUF(NGPTOT,NMWAVE_P,N_SATSENS)
REAL(KIND=JPRB)   ,INTENT(IN)   :: PMWAVE_P37_BUF(NGPTOT,NMWAVE_P,N_SATSENS)
REAL(KIND=JPRB)   ,INTENT(IN)   :: PMWAVE_GNORM_BUF(NGPTOT,NMWAVE_GNRM,N_SATSENS)
INTEGER(KIND=JPIM),INTENT(IN)   :: KMWAVE_BUF(NGPTOT,NMAX_CHAN,N_SATSENS)

INTEGER(KIND=JPIM) :: JOBS
INTEGER(KIND=JPIM) :: IRET, IVNM, ICHAN, ILEN, JBODY, IBODY, ICH
INTEGER(KIND=JPIM) :: INFO(2)
INTEGER(KIND=JPIM) :: ICMBDY
INTEGER(KIND=JPIM) :: ISAT, JROF
LOGICAL :: LLMWAVE_OK
REAL(KIND=JPRB) :: ZINFO(0)
REAL(KIND=JPRB) :: ZHOOK_HANDLE

INTERFACE
#include "getdb.h"
#include "putdb.h"
END INTERFACE

#include "fcobs.h"
#include "openmp_obs.h"

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

IF ( N_SATSENS == 0 ) THEN
  IF (LHOOK) CALL DR_HOOK('MWAVE_PUT',1,ZHOOK_HANDLE)
  RETURN
ENDIF

INFO(1)=NTSLOTNOS
INFO(2)=NTSLOTNOE

CALL GETDB('MWAVE_PUT_SSMI',0, ILEN, INFO, 2, ZINFO, 0, &
  & -1, -1, -1, -1, -1, -1)  

DO JOBS = 1,ILEN

  ! Find satellite index in our local table
  DO ISAT=1,N_SATSENS
    IF(ROBHDR(JOBS,MDB_SATID_AT_SAT) == MWAVE_ID(ISAT) % BUFR_ID ) EXIT
  ENDDO

  ! Grid point index
  JROF = ROBHDR(JOBS,MDB_GP_NUMBER)

  ! Certain error conditions will reject whole observation
  LLMWAVE_OK=.TRUE.
  DO ICH=1,MWAVE_ID (ISAT) % NCHANNELS
    IF( MWAVE_REJECTOBS(KMWAVE_BUF (JROF,ICH,ISAT)) ) THEN

      LLMWAVE_OK=.FALSE.
      ROBHDR (JOBS,MDBRST)  = ZCHSTAT_REJECT (ROBHDR (JOBS,MDBRST))
      ROBHDR (JOBS,MDBREV1) = ZCHEV1 (ROBHDR (JOBS,MDBREV1),NR1EVENT(16))
      EXIT
    ENDIF
  ENDDO

  IF (LLMWAVE_OK) THEN

    ! Diagnostix output
    IF (LSCREEN) THEN ! 1st traj
     ROBHDR (JOBS,MDB_FG_RAIN_RATE)             = PMWAVE_DIAG_BUF(JROF,1,ISAT)
     ROBHDR (JOBS,MDB_FG_SNOW_RATE)             = PMWAVE_DIAG_BUF(JROF,2,ISAT)
     ROBHDR (JOBS,MDB_FG_TCWV)                  = PMWAVE_DIAG_BUF(JROF,3,ISAT)
     ROBHDR (JOBS,MDB_FG_CWP)                   = PMWAVE_DIAG_BUF(JROF,4,ISAT)
     ROBHDR (JOBS,MDB_FG_IWP)                   = PMWAVE_DIAG_BUF(JROF,5,ISAT)
     ROBHDR (JOBS,MDB_FG_RWP)                   = PMWAVE_DIAG_BUF(JROF,6,ISAT)
     ROBHDR (JOBS,MDB_FG_SWP)                   = PMWAVE_DIAG_BUF(JROF,7,ISAT)
     ROBHDR (JOBS,MDB_FG_RTTOV_CLD_FRAC)        = PMWAVE_DIAG_BUF(JROF,8,ISAT)
    ENDIF
    IF (LIFSTRAJ) THEN  ! all traj
     ! Diagnostix output, last traj
     ROBHDR (JOBS,MDB_AN_RAIN_RATE)             = PMWAVE_DIAG_BUF(JROF,1,ISAT)
     ROBHDR (JOBS,MDB_AN_SNOW_RATE)             = PMWAVE_DIAG_BUF(JROF,2,ISAT)
     ROBHDR (JOBS,MDB_AN_TCWV)                  = PMWAVE_DIAG_BUF(JROF,3,ISAT)
     ROBHDR (JOBS,MDB_AN_CWP)                   = PMWAVE_DIAG_BUF(JROF,4,ISAT)
     ROBHDR (JOBS,MDB_AN_IWP)                   = PMWAVE_DIAG_BUF(JROF,5,ISAT)
     ROBHDR (JOBS,MDB_AN_RWP)                   = PMWAVE_DIAG_BUF(JROF,6,ISAT)
     ROBHDR (JOBS,MDB_AN_SWP)                   = PMWAVE_DIAG_BUF(JROF,7,ISAT)
     ROBHDR (JOBS,MDB_AN_RTTOV_CLD_FRAC)        = PMWAVE_DIAG_BUF(JROF,8,ISAT) 
    ENDIF

    ! Gradient norm output
    IF (LSCREEN) THEN
    ! Gradient-norm output, 1st traj, don't overwrite after
      ROBHDR (JOBS,MDB_GNORM_10MWIND) =  &
       &   PMWAVE_GNORM_BUF(JROF,1,ISAT)

      ROBHDR (JOBS,MDB_GNORM_SKINTEMP) =  &
       &   PMWAVE_GNORM_BUF(JROF,2,ISAT)

      ROBHDR (JOBS,MDB_GNORM_TEMP) =  &
       &   PMWAVE_GNORM_BUF(JROF,3,ISAT)

      ROBHDR (JOBS,MDB_GNORM_Q) =  &
       &   PMWAVE_GNORM_BUF(JROF,4,ISAT)

      ROBHDR (JOBS,MDB_GNORM_RAINFLUX) =  &
       &   PMWAVE_GNORM_BUF(JROF,5,ISAT)

      ROBHDR (JOBS,MDB_GNORM_SNOWFLUX) =  &
       &   PMWAVE_GNORM_BUF(JROF,6,ISAT)

      ROBHDR (JOBS,MDB_GNORM_CLW) =  &
       &   PMWAVE_GNORM_BUF(JROF,7,ISAT)

      ROBHDR (JOBS,MDB_GNORM_CIW) =  &
       &   PMWAVE_GNORM_BUF(JROF,8,ISAT)

      ROBHDR (JOBS,MDB_GNORM_CC) =  &
       &   PMWAVE_GNORM_BUF(JROF,9,ISAT)

    ENDIF

    ! Observed and FG polarisation differences
    IF (LSCREEN)  THEN
      ROBHDR (JOBS,MDB_OB_P19) = PMWAVE_P19_BUF(JROF,IMWAVE_P_OBS,ISAT)  
      ROBHDR (JOBS,MDB_FG_P19) = PMWAVE_P19_BUF(JROF,IMWAVE_P_SIM,ISAT)  
      ROBHDR (JOBS,MDB_OB_P37) = PMWAVE_P37_BUF(JROF,IMWAVE_P_OBS,ISAT)  
      ROBHDR (JOBS,MDB_FG_P37) = PMWAVE_P37_BUF(JROF,IMWAVE_P_SIM,ISAT) 
    ENDIF

    ! Working polarisation differences (= analysed after final traj)
    IF (LIFSTRAJ) THEN
      ROBHDR (JOBS,MDB_AN_P19) = PMWAVE_P19_BUF(JROF,IMWAVE_P_SIM,ISAT)  
      ROBHDR (JOBS,MDB_AN_P37) = PMWAVE_P37_BUF(JROF,IMWAVE_P_SIM,ISAT)  
    ENDIF

  ENDIF

  ICMBDY=MLNKH2B(JOBS+1)-MLNKH2B(JOBS)
  DO JBODY=1,ICMBDY
    IBODY = MLNKH2B(JOBS)+(JBODY-1)
    IVNM  = ROBODY(IBODY,MDBVNM)
    IF (IVNM == NVNUMB(50)) THEN          
      ICHAN=ROBODY(IBODY,MDBPPP)

      DO ICH=1,NMAX_CHAN
        IF(ICHAN == ICH)THEN

          IF (LSCREEN)  THEN
            IF (LDMWAVE_LAND) THEN
               ROBODY (IBODY,MDB_MWEMIS_SAT2)= PMWAVE_PERS1_BUF(JROF,ICH,ISAT)  ! emissivity used in fw model 
            ELSE
               ROBODY (IBODY,MDB_MWEMIS_SAT2)= 2.0_JPRB
            ENDIF
          ENDIF

          ! Status flag
          ROBODY(IBODY,MDB_DATUM_TBFLAG) = KMWAVE_BUF(JROF,ICH,ISAT)  
	  
          ! For all OK obs and those with "non-serious" errors we can calculate
          ! a TB and hence a departure.
          IF ( .NOT. MWAVE_SERIOUS(KMWAVE_BUF(JROF,ICH,ISAT)) ) THEN
            ROBODY (IBODY,MDB_TBVALUE) = PMWAVE_TB_BUF  (JROF,ICH,ISAT)             ! TB FG
            ROBODY (IBODY,MDBOER) = PMWAVE_OERR_BUF(JROF,ICH,ISAT) ! TB Obserr
            ROBODY (IBODY,MDBFOE) = PMWAVE_OERR_BUF(JROF,ICH,ISAT) ! TB Obserr
          ENDIF

          IF (.NOT. LLMWAVE_OK .OR. (.NOT. MWAVE_OK(KMWAVE_BUF(JROF,ICH,ISAT))))  THEN  
            ! Reject body entry
            ROBODY(IBODY,MDBDSTA) = ZCHSTAT_REJECT( ROBODY(IBODY,MDBDSTA))
          ENDIF
  
          EXIT
        ENDIF
      ENDDO
    ENDIF
  ENDDO
ENDDO
  
CALL PUTDB('MWAVE_PUT_SSMI', 0, IRET, INFO, 0, ZINFO, 0)

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

END SUBROUTINE MWAVE_PUT
