SUBROUTINE GP_SSMI_GP2OBS(PFIELD_GP,PFIELD,KCHAN,KFLDS,KSTREAM1D)

!**** *GP_SSMI_GP2OBS* - RAIN ASSIMILATION
!     1D-Var in clouds/precipitation for SSM/I radiances

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

!     PURPOSE.
!     -------
!     SEND SSMI OBS FROM GRID-POINT SPACE TO OBS PROCESSORS

!**   INTERFACE.
!**   ---------
!**   *CALL* * GP_SSMI_GP2OBS()*  (FROM GP_SSMI)

!        Explicit arguments :


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

!     Modifications :
!     D.Salmond     : 1-Jul-2005 Bit reproducible OBS/GP matching
!     A.Geer        : 27-Feb-2007 Multiple sensors
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMMP    , ONLY : MYPROC
USE YOMCT0   , ONLY : NPROC
USE YOMGEM   , ONLY : NGPTOT
USE YOM_SSMI , ONLY : OB_JOBS, OB_FROM, OB_JROF_GP, &
                    & GP_COUNT,OB_COUNT
USE MPL_MODULE, ONLY : MPL_SEND, MPL_RECV, MPL_BARRIER

USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK

IMPLICIT NONE

REAL(KIND=JPRB),INTENT(IN) :: PFIELD_GP(NGPTOT,KCHAN,KFLDS)
REAL(KIND=JPRB),INTENT(INOUT) :: PFIELD(OB_COUNT(MYPROC),KCHAN,KFLDS)
INTEGER(KIND=JPIM),INTENT(IN) :: KCHAN
INTEGER(KIND=JPIM),INTENT(IN) :: KFLDS
INTEGER(KIND=JPIM),INTENT(IN) :: KSTREAM1D

INTEGER(KIND=JPIM) :: ITAG,IDIM_GP,IDIM_OB,IFLDS,ICHAN,II,IPROC
REAL(KIND=JPRB),ALLOCATABLE :: ZBUF_GP(:,:)
REAL(KIND=JPRB),ALLOCATABLE :: ZBUF_OBS(:,:)
REAL(KIND=JPRB),ALLOCATABLE :: ZBUF(:)
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

CALL GSTATS(698,0)
ITAG=1

IF(MYPROC == 1)THEN
  IDIM_GP=MAXVAL(GP_COUNT(KSTREAM1D,:))
  IDIM_OB=MAXVAL(OB_COUNT)
  ALLOCATE(ZBUF_GP(IDIM_GP,NPROC))
  ALLOCATE(ZBUF_OBS(IDIM_OB,NPROC))
ENDIF

ALLOCATE(ZBUF(GP_COUNT(KSTREAM1D,MYPROC)))

DO IFLDS=1,KFLDS
  DO ICHAN=1,KCHAN

    IF(MYPROC /= 1)THEN
    
      ! Send current obs space contents to processor 1
      IF(OB_COUNT(MYPROC) /= 0)THEN
        CALL MPL_SEND(PFIELD(1:OB_COUNT(MYPROC),ICHAN,IFLDS),&
          & KDEST=1,KTAG=ITAG,CDSTRING='GP_SSMI_GP2OBS' )
      ENDIF
   
    ELSE
    
      ZBUF_GP=0.0_JPRB
      
      ! Gather current obs space contents from other processors
      DO IPROC=2,NPROC
        IF(OB_COUNT(IPROC) /= 0)THEN
          CALL MPL_RECV(ZBUF_OBS(1:OB_COUNT(IPROC),IPROC),&
           & KSOURCE=IPROC,KTAG=ITAG,CDSTRING='GP_SSMI_GP2OBS' )
        ENDIF
      ENDDO
      
      ZBUF_OBS(1:OB_COUNT(1),1) = &
               &   PFIELD(1:OB_COUNT(1),ICHAN,IFLDS)

    ENDIF
    
    ZBUF=0.0_JPRB  
    DO II=1,GP_COUNT(KSTREAM1D,MYPROC)
      ZBUF(II)=PFIELD_GP(OB_JROF_GP(II,KSTREAM1D,MYPROC),ICHAN,IFLDS)
    ENDDO
    
    IF(MYPROC /=1)THEN
    
      ! Send grid point space contents to processor 1
      IF(GP_COUNT(KSTREAM1D,MYPROC) /= 0)THEN
        CALL MPL_SEND(ZBUF(1:GP_COUNT(KSTREAM1D,MYPROC)),&
         & KDEST=1,KTAG=ITAG,CDSTRING='GP_SSMI_GP2OBS' )
      ENDIF
    
    ELSE
     
      ZBUF_GP(1:GP_COUNT(KSTREAM1D,1),1)= &
              &      ZBUF(1:GP_COUNT(KSTREAM1D,1))
 
      ! Gather grid point info from other processors   
      DO IPROC=2,NPROC
        IF(GP_COUNT(KSTREAM1D,IPROC) /= 0)THEN
          CALL MPL_RECV(ZBUF_GP(1:GP_COUNT(KSTREAM1D,IPROC),IPROC),&
           & KSOURCE=IPROC,KTAG=ITAG,CDSTRING='GP_SSMI_GP2OBS' )
        ENDIF
      ENDDO
 
      ! Map back from grid point to obs space   
      DO IPROC=1,NPROC
          DO II=1,GP_COUNT(KSTREAM1D,IPROC)
            ZBUF_OBS(OB_JOBS(II,KSTREAM1D,IPROC),OB_FROM(II,KSTREAM1D,IPROC))= &
               &                 ZBUF_GP(II,IPROC)
          ENDDO
      ENDDO
    
    ENDIF
    
    
    IF(MYPROC == 1)THEN
 
      ! Send back to PE that owns OB  
      DO IPROC=2,NPROC
        IF(OB_COUNT(IPROC) /= 0)THEN
          CALL MPL_SEND(ZBUF_OBS(1:OB_COUNT(IPROC),IPROC),&
           & KDEST=IPROC,KTAG=ITAG,CDSTRING='GP_SSMI_GP2OBS' )
        ENDIF
      ENDDO
      
      PFIELD(1:OB_COUNT(MYPROC),ICHAN,IFLDS) = ZBUF_OBS(1:OB_COUNT(MYPROC),MYPROC)
   
    ELSE

      ! Get updated observation field    
      IF(OB_COUNT(MYPROC) /= 0)THEN
        CALL MPL_RECV(PFIELD(1:OB_COUNT(MYPROC),ICHAN,IFLDS),&
         & KSOURCE=1,KTAG=ITAG,CDSTRING='GP_SSMI_GP2OBS' )
      ENDIF
        
    ENDIF

  ENDDO
ENDDO

IF(MYPROC == 1)THEN
  DEALLOCATE(ZBUF_GP)
  DEALLOCATE(ZBUF_OBS)
ENDIF

DEALLOCATE(ZBUF)
  
CALL MPL_BARRIER(CDSTRING='GP_SSMI_GP2OBS')
CALL GSTATS(698,1)

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

END SUBROUTINE GP_SSMI_GP2OBS
