SUBROUTINE GP_SSMI_INV

!*****GP_SSMI_INV* - RAIN ASSIMILATION - PUT SSMI OBS FROM GRID-POINT TO ODB for
!     1D-Var in clouds/precipitation for SSM/I radiances

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

!     PURPOSE.
!     -------
!     PUT OUTPUT FROM ONEDVAR FROM GRID-POINT SPACE TO ODB

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

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

!     AUTHOR: Deborah Salmond
!     DATE  : 02-04-2004

!     Modifications :
!     M.Hamrud      : 15-Mar-2005 New GOM structures
!     D.Salmond     : 01-Jul-2005 Bit reproducible OBS/GP matching
!     A.Geer        : 30-Mar-2006 Surf. wind analysis; fail codes changed
!     A.Geer        : 23-Oct-2006 Info and fail codes from mimimisation
!     A.Geer        : 19-Feb-2007 Store more diagnostic info too
!     P. Bauer      : 16-Oct-2006 Allow other passive microwave imagers
!     A. Geer       : 06-Mar-2007 Multiple sensors; in failure cases 
!                                 onedvar_raintb now outputs sensible 
!                                 values, or flags with RMDI, so no 
!                                 precautions are needed here.
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMVAR    ,ONLY : NUPTRA, MUPTRA
USE YOMDB
USE YOMMP    , ONLY : MYPROC
USE YOMCT0   , ONLY : NPROC
USE YOMVNMB  , ONLY : NVNUMB
USE YOMNMEV  , ONLY : NR1EVENT
USE YOMANCS  , ONLY : RMDI 
USE YOMLUN   , ONLY : NULOUT
USE YOMECTAB , ONLY : NTSLTOB,NTSLOTNOS
USE YOMGEM   , ONLY : NGPTOT
USE YOM_SSMI , ONLY : RAIN_1D_GP, RAIN_1DDIAG_GP, RAIN_2DCHAN_GP,MID_GP, MIT_GP, &
  & MIS_GP, MEPSG_GP, MIM_GP, OB_COUNT, GP_COUNT, OB_JOBS, &
  & OB_FROM, OB_JROF_GP, MIFOV_GP, MISATID_GP, MIZEN_GP, MIAZI_GP
USE PARONEDVAR, ONLY : NMAX_CHANNELS
USE YOMONEDVAR, ONLY : STREAM1D_NUM
USE YOMCOCTP  , ONLY : NSATEM
USE YOM_PTR_SSMI  ,ONLY : MFLDS_1D,&
 &      M_P0,M_T0,M_U10_FG,M_V10_FG,M_PS_FG,M_PC_FG,&
 &      M_PS_AN,M_PC_AN,M_U10_AN,M_V10_AN,&
 &      M_WV_FG,M_WV_AN,M_ER_FG,M_ER_AN,M_CO_AN,&
 &      MFLDS_1DDIAG,&
 &      M_RWP_3D,M_SWP_3D,M_CWP_3D,M_IWP_3D,M_RA_3D,M_SN_3D,&
 &      M_RWP_FG,M_SWP_FG,M_CWP_FG,M_IWP_FG,&
 &      M_RWP_AN,M_SWP_AN,M_CWP_AN,M_IWP_AN,&
 &      MFLDS_2DCHAN, &
 &      M_TB_OB,M_TB_ER,M_TB_FG,M_TB_AN,M_TB_BI,M_TB_3D
USE MPL_MODULE, ONLY: MPL_SEND, MPL_RECV

IMPLICIT NONE

INTEGER(KIND=JPIM) :: JOBS

REAL(KIND=JPRB),ALLOCATABLE :: ZRAIN_2DCHAN_OBS(:,:,:)
REAL(KIND=JPRB),ALLOCATABLE :: ZRAIN_1D_OBS(:,:),  ZRAIN_1DDIAG_OBS(:,:)
INTEGER(KIND=JPIM),ALLOCATABLE :: IIT_OBS(:), IIS_OBS(:), IIM_OBS(:)
REAL(KIND=JPRB),ALLOCATABLE :: ZEPSG_OBS(:)
INTEGER(KIND=JPIM),ALLOCATABLE :: IID_OBS(:)
INTEGER(KIND=JPIM) :: IOBSTYPE
INTEGER(KIND=JPIM) :: IRET, IVNM, ICHAN, ITS, ILEN, JBODY, IBODY, ICH
INTEGER(KIND=JPIM) :: IMXBDY, IPROMBMP, INFO(0)
INTEGER(KIND=JPIM),ALLOCATABLE :: ICMBDY(:)
INTEGER(KIND=JPIM) :: IODB_COUNT(NPROC)
INTEGER(KIND=JPIM) :: IODBTOTG,ITAG,IPROC,ISTREAM1D
REAL(KIND=JPRB) :: ZINFO(0)
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "gp_ssmi_igp2obs.intfb.h"
#include "gp_ssmi_gp2obs.intfb.h"
#include "fcobs.h"
#include "openmp_obs.h"

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

CALL GSTATS(1955,0)

ITS=NTSLOTNOS

IPROMBMP = NTSLTOB(ITS) ! IOBTOT

ALLOCATE(ZRAIN_2DCHAN_OBS(OB_COUNT(MYPROC),NMAX_CHANNELS,MFLDS_2DCHAN))
ALLOCATE(ZRAIN_1D_OBS(OB_COUNT(MYPROC),MFLDS_1D))
ALLOCATE(ZRAIN_1DDIAG_OBS(OB_COUNT(MYPROC),MFLDS_1DDIAG))
ALLOCATE(IIT_OBS(OB_COUNT(MYPROC)))
ALLOCATE(IIS_OBS(OB_COUNT(MYPROC)))
ALLOCATE(ZEPSG_OBS(OB_COUNT(MYPROC)))
ALLOCATE(IIM_OBS(OB_COUNT(MYPROC)))
ALLOCATE(IID_OBS(OB_COUNT(MYPROC)))

IID_OBS=-1
IIT_OBS=0
IIS_OBS=0
IIM_OBS=0
ZEPSG_OBS=0.0_JPRB
ZRAIN_1D_OBS=0.0_JPRB
ZRAIN_1DDIAG_OBS=0.0_JPRB
ZRAIN_2DCHAN_OBS=0.0_JPRB

! Transfer 1D-Var retrievals from grid-point to observation space
CALL GSTATS(1955,2)
DO ISTREAM1D=1,STREAM1D_NUM

  CALL GP_SSMI_IGP2OBS( MIT_GP(:,ISTREAM1D), IIT_OBS, ISTREAM1D)
  CALL GP_SSMI_IGP2OBS( MIS_GP(:,ISTREAM1D), IIS_OBS, ISTREAM1D)
  CALL GP_SSMI_GP2OBS( MEPSG_GP(:,ISTREAM1D), ZEPSG_OBS, 1, 1, ISTREAM1D)
  CALL GP_SSMI_IGP2OBS( MIM_GP(:,ISTREAM1D), IIM_OBS, ISTREAM1D)
  CALL GP_SSMI_IGP2OBS( MID_GP(:,ISTREAM1D), IID_OBS, ISTREAM1D)
  CALL GP_SSMI_GP2OBS( RAIN_2DCHAN_GP(:,ISTREAM1D,:,:), ZRAIN_2DCHAN_OBS, &
    &  NMAX_CHANNELS, MFLDS_2DCHAN, ISTREAM1D)
  CALL GP_SSMI_GP2OBS( RAIN_1D_GP(:,ISTREAM1D,:), ZRAIN_1D_OBS, 1, &
    &  MFLDS_1D, ISTREAM1D)
  CALL GP_SSMI_GP2OBS( RAIN_1DDIAG_GP(:,ISTREAM1D,:), ZRAIN_1DDIAG_OBS, 1, &
    &  MFLDS_1DDIAG, ISTREAM1D)

ENDDO
CALL GSTATS(1955,3)

! Where an observation has no matching grid-point, set output
! failure code to 1.
WHERE (IID_OBS == -1) IID_OBS = 1

IOBSTYPE=NSATEM

! Open ODB(ECMA) for input
CALL GSTATS(1955,2)
CALL GSTATS(1795,0)
CALL GETDB('GP_PUT_SSMI',0, ILEN, INFO, 0, ZINFO, 0, -1, ITS, -1, IOBSTYPE, -1, -1)  
CALL GSTATS(1795,1)
CALL GSTATS(1955,3)

ALLOCATE(ICMBDY(ILEN))

DO JOBS = 1,ILEN
  ICMBDY(JOBS)=MLNKH2B(JOBS+1)-MLNKH2B(JOBS)
ENDDO

IMXBDY=MAXVAL(ICMBDY(1:ILEN))

! Count up successul observations, then the send totals to lead process 
! which will write all counts to log file.
IODB_COUNT=0
DO JOBS=1,OB_COUNT(MYPROC)
  IF(IID_OBS (JOBS) == 0)THEN
     IODB_COUNT(MYPROC)=IODB_COUNT(MYPROC)+1
  ENDIF
ENDDO
! Send to MYPROC = 1
ITAG=1
IF(MYPROC /= 1) THEN
  CALL MPL_SEND(IODB_COUNT(MYPROC),&
   & KDEST=1,KTAG=ITAG,CDSTRING='GP_SSMI_INV' )
ELSE
  DO IPROC=2,NPROC
    CALL MPL_RECV(IODB_COUNT(IPROC),&
     & KSOURCE=IPROC,KTAG=ITAG,CDSTRING='GP_SSMI_INV' )
  ENDDO
ENDIF
IF (MYPROC == 1) THEN
  IODBTOTG=SUM(IODB_COUNT)
  WRITE(NULOUT,*)'1D-VAR: ODB_COUNT',IODBTOTG,IODB_COUNT
ENDIF

IF (NUPTRA == 0) THEN
  
  ! Transfer 1D-Var obs to ODB input arrays
  DO JBODY=1,IMXBDY
    DO JOBS=1,ILEN
    
      IF (JBODY > ICMBDY(JOBS)) CYCLE

      ! 1D-VAR q/c
      ROBHDR (JOBS,MDB1DFIN) = IID_OBS (JOBS)   ! Failure flag
      IF (IID_OBS (JOBS) /= 0) THEN
        ! Note that passively monitored observations are set to rejected here,
        ! along with other erroneous 1D-Var retrievals
        ROBHDR (JOBS,MDBRST)  = ZCHSTAT_REJECT (ROBHDR (JOBS,MDBRST))
        ROBHDR (JOBS,MDBREV1) = ZCHEV1 (ROBHDR (JOBS,MDBREV1),NR1EVENT(16))
      ENDIF
       
      ! Write 1D-Var output to ODB(ECMA) in all cases where observation 
      ! matched a grid point. Even if not successful we still want to be 
      ! able to analyse the output from 1D-Var
      IF (IID_OBS (JOBS) /= 1) THEN       
       
        IBODY = MLNKH2B(JOBS)+(JBODY-1)
        IVNM  = ROBODY(IBODY,MDBVNM)

        ! SFC & TCWV        
        IF(IVNM == NVNUMB( 6)) THEN   

          ROBHDR (JOBS,MDB1DNIT) = IIT_OBS (JOBS)  ! No. of iterations
          ROBHDR (JOBS,MDB1DNIS) = IIS_OBS (JOBS)  ! No. of simulations
          ROBHDR (JOBS,MDB1DEPS) = ZEPSG_OBS (JOBS)  ! Cost function gradient ratio
          ROBHDR (JOBS,MDB1DFIM) = IIM_OBS (JOBS)  ! M1QN3 minimisation status

          ! sfc pressure
          ROBHDR (JOBS,MDB1BPS)  = ZRAIN_1D_OBS(JOBS,M_P0)
          ! skin temperature
          ROBHDR (JOBS,MDB1BSTS) = ZRAIN_1D_OBS(JOBS,M_T0) 
          ! u @ 10m FG
          ROBHDR (JOBS,MDB1BSUS(1)) = ZRAIN_1D_OBS(JOBS,M_U10_FG)
          ! v @ 10m FG
          ROBHDR (JOBS,MDB1BSVS(1)) = ZRAIN_1D_OBS(JOBS,M_V10_FG) 
          ! u @ 10m AN
          ROBHDR (JOBS,MDB1BSUS(2)) = ZRAIN_1D_OBS(JOBS,M_U10_AN)
          ! v @ 10m AN
          ROBHDR (JOBS,MDB1BSVS(2)) = ZRAIN_1D_OBS(JOBS,M_V10_AN) 

          ! strat. sfc precip
          ROBHDR (JOBS,MDB_PREC_ST_AT_SSMI (1))  &
                    &  = ZRAIN_1D_OBS(JOBS,M_PS_FG)        
          ! conv.  sfc precip
          ROBHDR (JOBS,MDB_PREC_CV_AT_SSMI (1))  &
                    &  = ZRAIN_1D_OBS(JOBS,M_PC_FG)
          ! strat. sfc precip
          ROBHDR (JOBS,MDB_PREC_ST_AT_SSMI (2))  &
                    &  = ZRAIN_1D_OBS(JOBS,M_PS_AN)
          ! conv.  sfc precip
          ROBHDR (JOBS,MDB_PREC_CV_AT_SSMI (2))  &
                    &  = ZRAIN_1D_OBS(JOBS,M_PC_AN)

          ! Cost function ratio
          ROBHDR (JOBS,MDB1D_COST) = ZRAIN_1D_OBS(JOBS,M_CO_AN)         

          ! 3D rain and snow at surface
          ROBHDR (JOBS,MDB1D_SFC_RAIN_3D_FG) = ZRAIN_1DDIAG_OBS(JOBS,M_RA_3D)         
          ROBHDR (JOBS,MDB1D_SFC_SNOW_3D_FG) = ZRAIN_1DDIAG_OBS(JOBS,M_SN_3D)         

          ! Total column diagnostics
          ROBHDR (JOBS,MDB1D_RWP (1)) = ZRAIN_1DDIAG_OBS(JOBS,M_RWP_FG)         
          ROBHDR (JOBS,MDB1D_SWP (1)) = ZRAIN_1DDIAG_OBS(JOBS,M_SWP_FG)         
          ROBHDR (JOBS,MDB1D_CWP (1)) = ZRAIN_1DDIAG_OBS(JOBS,M_CWP_FG)         
          ROBHDR (JOBS,MDB1D_IWP (1)) = ZRAIN_1DDIAG_OBS(JOBS,M_IWP_FG)             
          ROBHDR (JOBS,MDB1D_RWP (2)) = ZRAIN_1DDIAG_OBS(JOBS,M_RWP_AN)         
          ROBHDR (JOBS,MDB1D_SWP (2)) = ZRAIN_1DDIAG_OBS(JOBS,M_SWP_AN)         
          ROBHDR (JOBS,MDB1D_CWP (2)) = ZRAIN_1DDIAG_OBS(JOBS,M_CWP_AN)         
          ROBHDR (JOBS,MDB1D_IWP (2)) = ZRAIN_1DDIAG_OBS(JOBS,M_IWP_AN)   
          ROBHDR (JOBS,MDB1D_RWP (3)) = ZRAIN_1DDIAG_OBS(JOBS,M_RWP_3D)         
          ROBHDR (JOBS,MDB1D_SWP (3)) = ZRAIN_1DDIAG_OBS(JOBS,M_SWP_3D)         
          ROBHDR (JOBS,MDB1D_CWP (3)) = ZRAIN_1DDIAG_OBS(JOBS,M_CWP_3D)         
          ROBHDR (JOBS,MDB1D_IWP (3)) = ZRAIN_1DDIAG_OBS(JOBS,M_IWP_3D)   

          ! TCWV, FG
          ROBODY (IBODY,MDB1BPWS) = ZRAIN_1D_OBS(JOBS,M_WV_FG)     

          ! TCWV, Observation
          ROBODY (IBODY,MDBVAR)   = ZRAIN_1D_OBS(JOBS,M_WV_AN) 

          ! TCWV, AN-Error
          ROBODY (IBODY,MDBFOE)   = ZRAIN_1D_OBS(JOBS,M_ER_AN)
          ROBODY (IBODY,MDBOER)   = ZRAIN_1D_OBS(JOBS,M_ER_AN)
          ! TCWV, FG-Error
          ROBODY (IBODY,MDB1DREP) = ZRAIN_1D_OBS(JOBS,M_ER_FG)         

        ! Brightness temperatures
        ELSEIF(IVNM == NVNUMB(50)) THEN
          ICHAN=ROBODY(IBODY,MDBPPP)
          DO ICH=1,NMAX_CHANNELS
            IF(ICHAN == ICH)THEN

              ! TB, Observation
              ROBODY (IBODY,MDB_RAD_OBS_AT_SSMI_BODY)  &
                     & = ZRAIN_2DCHAN_OBS(JOBS,ICH,M_TB_OB)

              ! TB, FG-Departure
              IF ( ZRAIN_2DCHAN_OBS(JOBS,ICH,M_TB_FG) /= RMDI .AND. &
              & ZRAIN_2DCHAN_OBS(JOBS,ICH,M_TB_BI) /= RMDI) THEN    
                                      
                ROBODY (IBODY,MDB_RAD_FG_DEPAR_AT_SSMI_BODY)  &
                       & = ZRAIN_2DCHAN_OBS(JOBS,ICH,M_TB_OB) &
                       & - ZRAIN_2DCHAN_OBS(JOBS,ICH,M_TB_FG) & 
                       & - ZRAIN_2DCHAN_OBS(JOBS,ICH,M_TB_BI)  
                                            
              ELSE              
                ROBODY (IBODY,MDB_RAD_FG_DEPAR_AT_SSMI_BODY) = RMDI
              ENDIF

              ! TB, AN-Departure
              IF ( ZRAIN_2DCHAN_OBS(JOBS,ICH,M_TB_AN) /= RMDI .AND. &
              & ZRAIN_2DCHAN_OBS(JOBS,ICH,M_TB_BI) /= RMDI) THEN  
                            
                ROBODY (IBODY,MDB_RAD_AN_DEPAR_AT_SSMI_BODY)   &
                     & = ZRAIN_2DCHAN_OBS(JOBS,ICH,M_TB_OB) &
                     & - ZRAIN_2DCHAN_OBS(JOBS,ICH,M_TB_AN) &    
                     & - ZRAIN_2DCHAN_OBS(JOBS,ICH,M_TB_BI)

              ELSE              
                ROBODY (IBODY,MDB_RAD_AN_DEPAR_AT_SSMI_BODY) = RMDI
              ENDIF
              
              ! TB, Observation error
              ROBODY (IBODY,MDB_RAD_OBS_ERR_AT_SSMI_BODY)    &
                     & = ZRAIN_2DCHAN_OBS(JOBS,ICH,M_TB_ER)
              ! TB, Bias
              ROBODY (IBODY,MDB_RAD_BIAS_AT_SSMI_BODY)       &
                     & = ZRAIN_2DCHAN_OBS(JOBS,ICH,M_TB_BI)
              ! TB, From 3D modelled cloud fields
              ROBODY (IBODY,MDB_RAD_FG_3D_AT_SSMI_BODY)       &
                     & = ZRAIN_2DCHAN_OBS(JOBS,ICH,M_TB_3D)
              EXIT
            ENDIF
          ENDDO
        ENDIF
      ENDIF
    ENDDO
  ENDDO
  
ELSEIF(NUPTRA == MUPTRA) THEN

  !* Store calculations from the 4D-Var analysis trajectory in the ODB
  DO JBODY=1,IMXBDY
    DO JOBS=1,ILEN

      IF (IID_OBS (JOBS) /= 1) THEN       

        ! SFC & TCWV
        IF (JBODY <= ICMBDY(JOBS)) THEN          

          IBODY = MLNKH2B(JOBS)+(JBODY-1)
          IVNM  = ROBODY(IBODY,MDBVNM)

          IF(IVNM == NVNUMB( 6)) THEN   

            ! 3D rain and snow at surface
            ROBHDR (JOBS,MDB1D_SFC_RAIN_3D_AN) = ZRAIN_1DDIAG_OBS(JOBS,M_RA_3D)         
            ROBHDR (JOBS,MDB1D_SFC_SNOW_3D_AN) = ZRAIN_1DDIAG_OBS(JOBS,M_SN_3D)         

            ! Total column diagnostics
            ROBHDR (JOBS,MDB1D_RWP (4)) = ZRAIN_1DDIAG_OBS(JOBS,M_RWP_3D)         
            ROBHDR (JOBS,MDB1D_SWP (4)) = ZRAIN_1DDIAG_OBS(JOBS,M_SWP_3D)         
            ROBHDR (JOBS,MDB1D_CWP (4)) = ZRAIN_1DDIAG_OBS(JOBS,M_CWP_3D)         
            ROBHDR (JOBS,MDB1D_IWP (4)) = ZRAIN_1DDIAG_OBS(JOBS,M_IWP_3D)   

          ! Brightness temperatures
          ELSEIF(IVNM == NVNUMB(50)) THEN
            ICHAN=ROBODY(IBODY,MDBPPP)
            DO ICH=1,NMAX_CHANNELS
              IF(ICHAN == ICH)THEN

                ! TB, From 3D analysed t,q and cloud fields
                ROBODY (IBODY,MDB_RAD_4DAN_AT_SSMI_BODY)       &
                       & = ZRAIN_2DCHAN_OBS(JOBS,ICH,M_TB_3D)

                EXIT
              ENDIF
            ENDDO
          ENDIF
        ENDIF
      ENDIF      
    ENDDO
  ENDDO
  
ENDIF

! Write to ODB  
CALL GSTATS(1955,2)
CALL GSTATS(1795,0)
CALL PUTDB('GP_PUT_SSMI', 0, IRET, INFO, 0, ZINFO, 0)
CALL GSTATS(1795,1)
CALL GSTATS(1955,3)

DEALLOCATE(ZRAIN_2DCHAN_OBS)
DEALLOCATE(ZRAIN_1D_OBS)
DEALLOCATE(ZRAIN_1DDIAG_OBS)
DEALLOCATE(IIT_OBS)
DEALLOCATE(IIS_OBS)
DEALLOCATE(ZEPSG_OBS)
DEALLOCATE(IIM_OBS)
DEALLOCATE(IID_OBS)

IF (ALLOCATED(RAIN_1D_GP)) DEALLOCATE(RAIN_1D_GP)
IF (ALLOCATED(RAIN_1DDIAG_GP)) DEALLOCATE(RAIN_1DDIAG_GP)
IF (ALLOCATED(RAIN_2DCHAN_GP)) DEALLOCATE(RAIN_2DCHAN_GP)
IF (ALLOCATED(MID_GP))         DEALLOCATE(MID_GP)
IF (ALLOCATED(MIT_GP))         DEALLOCATE(MIT_GP)
IF (ALLOCATED(MIS_GP))         DEALLOCATE(MIS_GP)
IF (ALLOCATED(MEPSG_GP))       DEALLOCATE(MEPSG_GP)
IF (ALLOCATED(MIM_GP))         DEALLOCATE(MIM_GP)
IF (ALLOCATED(MIFOV_GP))       DEALLOCATE(MIFOV_GP)
IF (ALLOCATED(MISATID_GP))     DEALLOCATE(MISATID_GP)
IF (ALLOCATED(MIZEN_GP))       DEALLOCATE(MIZEN_GP)
IF (ALLOCATED(MIAZI_GP))       DEALLOCATE(MIAZI_GP)

DEALLOCATE(OB_COUNT)
DEALLOCATE(GP_COUNT)
DEALLOCATE(OB_FROM)
DEALLOCATE(OB_JOBS)
DEALLOCATE(OB_JROF_GP)

CALL GSTATS(1955,1)

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

END SUBROUTINE GP_SSMI_INV
