SUBROUTINE SMOS_IOBS2GP(KFIELD,KFIELD_GP,KPOL)

!**** *SMOS_IOBS2GP* -  
!
!     J. Munoz Sabater      ECMWF  Oct. 2009
!
!     PURPOSE.
!     -------
!     GET SMOS MASK FROM OBS TO GRID-POINT SPACE
!
!     Note that this function is customised to work with smos status 
!     flags only.
!
!**   INTERFACE.
!**   ---------
!**   *CALL* * SMOS_IOBS2GP()*  (FROM SMOS_GET)
!
!        Explicit arguments :
!
!!     Modifications :
!     J. Muñoz Sabater  26-11-2009 : Accounts for different polarisations in data
!
!     ------------------------------------------------------------------

 USE PARKIND1  ,ONLY : JPIM     ,JPRB
 USE YOMMP    , ONLY : MYPROC
 USE YOMCT0   , ONLY : NPROC
 USE YOMGEM   , ONLY : NGPTOT
 USE YOMSMOS  , ONLY : OB_JOBS, OB_FROM, OB_JROF_GP, OB_INDEX, GP_COUNT, &
                     & OB_COUNT, SMOS_NO_OBS, SMOS_ACTIVE, SMOS_CONTAMINATED
 USE MPL_MODULE, ONLY : MPL_SEND, MPL_RECV, MPL_BARRIER
 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
 USE YOMLUN    , ONLY : NULOUT

 IMPLICIT NONE

 INTEGER(KIND=JPIM),INTENT(IN)  :: KFIELD(OB_COUNT(MYPROC,KPOL))
 INTEGER(KIND=JPIM),INTENT(OUT) :: KFIELD_GP(NGPTOT)
 INTEGER(KIND=JPIM),INTENT(IN)  :: KPOL 

 INTEGER(KIND=JPIM)             :: ITAG,IDIM_GP,IDIM_OB,IPROC,II,JROF
 INTEGER(KIND=JPIM),ALLOCATABLE :: IBUF_GP(:,:)
 INTEGER(KIND=JPIM),ALLOCATABLE :: IBUF_OBS(:,:)
 INTEGER(KIND=JPIM),ALLOCATABLE :: IBUF(:)
 REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

 ITAG=1

 IF(MYPROC == 1)THEN
   IDIM_GP=MAXVAL(GP_COUNT(:,KPOL))
   IDIM_OB=MAXVAL(OB_COUNT(:,KPOL))
   ALLOCATE(IBUF_GP(IDIM_GP,NPROC))
   ALLOCATE(IBUF_OBS(IDIM_OB,NPROC))
 ENDIF

 ALLOCATE(IBUF(GP_COUNT(MYPROC,KPOL)))

 IF(MYPROC == 1)THEN
   IBUF_GP =0.0_JPRB
   IBUF_OBS=0.0_JPRB
 ENDIF

 IBUF=0.0_JPRB

! Send to PE 1

 IF(MYPROC /= 1)THEN
!
   IF(OB_COUNT(MYPROC,KPOL) /= 0)THEN
     CALL GSTATS(906,0)
     CALL MPL_SEND(KFIELD(1:OB_COUNT(MYPROC,KPOL)),&
          & KDEST=1,KTAG=ITAG,CDSTRING='SMOS_IOBS2GP' )
     CALL GSTATS(906,1)
   ENDIF

 ELSE

   CALL GSTATS(906,0)
   DO IPROC=2,NPROC
     IF(OB_COUNT(IPROC,KPOL) /= 0)THEN
       CALL MPL_RECV(IBUF_OBS(1:OB_COUNT(IPROC,KPOL),IPROC),&
            & KSOURCE=IPROC,KTAG=ITAG,CDSTRING='SMOS_IOBS2GP' )
     ENDIF
   ENDDO
   CALL GSTATS(906,1)

   IBUF_OBS(1:OB_COUNT(1,KPOL),1) = KFIELD(1:OB_COUNT(1,KPOL))

 ENDIF

!  
! Send to PE that owns GP
 IF(MYPROC ==1)THEN

   DO IPROC=1,NPROC
     DO II=1,GP_COUNT(IPROC,KPOL)
       IBUF_GP(II,IPROC)= &
              &  IBUF_OBS(OB_JOBS(II,IPROC,KPOL),OB_FROM(II,IPROC,KPOL))
     ENDDO
   ENDDO

   CALL GSTATS(906,0)
   DO IPROC=2,NPROC
     IF(GP_COUNT(IPROC,KPOL) /= 0)THEN
       CALL MPL_SEND(IBUF_GP(1:GP_COUNT(IPROC,KPOL),IPROC),&
            & KDEST=IPROC,KTAG=ITAG,CDSTRING='SMOS_IOBS2GP' )
     ENDIF
   ENDDO
   CALL GSTATS(906,1)

   IBUF(1:GP_COUNT(1,KPOL)) = IBUF_GP(1:GP_COUNT(1,KPOL),1)

 ELSE 

   IF(GP_COUNT(MYPROC,KPOL) /= 0)THEN
     CALL GSTATS(906,0)
     CALL MPL_RECV(IBUF(1:GP_COUNT(MYPROC,KPOL)),&
          & KSOURCE=1,KTAG=ITAG,CDSTRING='SMOS_IOBS2GP' )
     CALL GSTATS(906,1)
   ENDIF

 ENDIF

! Initialise grid point output to indicate no matching observation  
 KFIELD_GP = IBSET(0, SMOS_NO_OBS)

 CALL GSTATS(2017,0)
 WRITE(NULOUT,*) 'SMOS_IOBS2GP: GP_COUNT(MYPROC,KPOL)=',GP_COUNT(MYPROC,KPOL)
 DO II=1,GP_COUNT(MYPROC,KPOL)
  
   JROF = OB_JROF_GP(OB_INDEX(II,KPOL),MYPROC,KPOL)
 
   IF ( BTEST( KFIELD_GP(JROF), SMOS_NO_OBS) ) THEN
       KFIELD_GP(JROF) = IBUF(OB_INDEX(II,KPOL))
   ELSE
     ! There is more than one obs for this grid point, so rejected
     ! observations will "contaminate" unrejected ones: 
     IF ( IBUF(OB_INDEX(II,KPOL)) /= SMOS_ACTIVE ) THEN
        KFIELD_GP(JROF) = IBUF(OB_INDEX(II,KPOL))
        KFIELD_GP(JROF) = IBSET( KFIELD_GP(JROF), SMOS_CONTAMINATED )
     ENDIF
   ENDIF
 ENDDO
 CALL GSTATS(2017,1)

 IF(MYPROC == 1)THEN
   DEALLOCATE(IBUF_GP)
   DEALLOCATE(IBUF_OBS)
 ENDIF

 DEALLOCATE(IBUF)

 CALL GSTATS(912,0)
 CALL MPL_BARRIER(CDSTRING='SMOS_IOBS2GP')
 CALL GSTATS(912,1)

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

END SUBROUTINE SMOS_IOBS2GP
