SUBROUTINE GP_SSMI_OBS2GP(PFIELD,PFIELD_GP,KCHAN,KLEN,KSTREAM1D)

!**** *GP_SSMI_OBS2GP* - RAIN ASSIMILATION - GET SSMI OBS IN GRID-POINT SPACE for
!     1D-Var in clouds/precipitation for SSM/I radiances

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

!     PURPOSE.
!     -------
!     GET SSMI OBS FROM OBS TO GRID-POINT SPACE

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

!        Explicit arguments :


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

!     Modifications :
!     D.Salmond     : 1-Jul-2005 Bit reproducible OBS/GP matching
!     A.Geer        : 26-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(KLEN,KCHAN)
REAL(KIND=JPRB),INTENT(OUT) :: PFIELD_GP(NGPTOT,KCHAN)
INTEGER(KIND=JPIM),INTENT(IN) :: KCHAN, KLEN, KSTREAM1D

INTEGER(KIND=JPIM) :: ITAG,IDIM_GP,IDIM_OB,ICHAN,IPROC,II
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_OBS2GP',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 ICHAN=1,KCHAN

  IF(MYPROC == 1)THEN
    ZBUF_GP=0.0_JPRB
    ZBUF_OBS=0.0_JPRB
  ENDIF

  ZBUF=0.0_JPRB

! Send to PE 1

  IF(MYPROC /= 1)THEN
  
    IF(OB_COUNT(MYPROC) /= 0)THEN
      CALL MPL_SEND(PFIELD(1:OB_COUNT(MYPROC),ICHAN),&
       & KDEST=1,KTAG=ITAG,CDSTRING='GP_SSMI_OBS2GP' )
    ENDIF
  
  ELSE
  
    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_OBS2GP' )
      ENDIF
    ENDDO
  
    ZBUF_OBS(1:OB_COUNT(1),1) = &
               &   PFIELD(1:OB_COUNT(1),ICHAN)
  
  ENDIF
  
  
! Send to PE that owns GP
  
  IF(MYPROC ==1)THEN
  
    DO IPROC=1,NPROC
      DO II=1,GP_COUNT(KSTREAM1D,IPROC)
        ZBUF_GP(II,IPROC)= &
          &  ZBUF_OBS(OB_JOBS(II,KSTREAM1D,IPROC),OB_FROM(II,KSTREAM1D,IPROC))
      ENDDO
    ENDDO
  
    DO IPROC=2,NPROC
      IF(GP_COUNT(KSTREAM1D,IPROC) /= 0)THEN
        CALL MPL_SEND(ZBUF_GP(1:GP_COUNT(KSTREAM1D,IPROC),IPROC),&
         & KDEST=IPROC,KTAG=ITAG,CDSTRING='GP_SSMI_OBS2GP' )
      ENDIF
    ENDDO
  
    ZBUF(1:GP_COUNT(KSTREAM1D,1)) = &
         &    ZBUF_GP(1:GP_COUNT(KSTREAM1D,1),1)
  
  ELSE 
  
    IF(GP_COUNT(KSTREAM1D,MYPROC) /= 0)THEN
      CALL MPL_RECV(ZBUF(1:GP_COUNT(KSTREAM1D,MYPROC)),&
       & KSOURCE=1,KTAG=ITAG,CDSTRING='GP_SSMI_OBS2GP' )
    ENDIF
  
  ENDIF
  
  
  DO II=1,GP_COUNT(KSTREAM1D,MYPROC)
    PFIELD_GP(OB_JROF_GP(II,KSTREAM1D,MYPROC),ICHAN)=ZBUF(II)
  ENDDO

ENDDO

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

DEALLOCATE(ZBUF)

CALL MPL_BARRIER(CDSTRING='GP_SSMI_OBS2GP')
CALL GSTATS(698,1)

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

END SUBROUTINE GP_SSMI_OBS2GP
