SUBROUTINE SMOS_NEAREST(PLATOBS,PLONOBS,POB_DIST_TO_GP,KSEQNO,KLEN,KPOL,KNLENMAX,LDALL,LDSUM)

!**** *SMOS_NEAREST* -  !
!     J. Munoz Sabater   ECMWF    Oct 2009
!
!     PURPOSE.
!     -------
!     FIND NEAREST GRID-POINT TO EACH SMOS OBS
!
!**   INTERFACE.
!**   ---------
!**   *CALL* * SMOS_NEAREST()*  (FROM SMOS_GET)

!        Explicit arguments :


!     Modifications :
!
!     ------------------------------------------------------------------

USE PARKIND1  , ONLY : JPIM, JPRB
USE YOMMP     , ONLY : MYPROC, NFRSTLAT, NLSTLAT, NPTRFRSTLAT,&
                       & NSTA, NONL, NGPSET2PE
USE YOMGEM    , ONLY : NLOENG, NGPTOT
USE YOMCT0    , ONLY : NPROC, N_REGIONS_NS, N_REGIONS
USE YOMLEG    , ONLY : RLATIG
USE YOMCST    , ONLY : RPI, RA
USE MPL_MODULE, ONLY : MPL_SEND, MPL_RECV, MPL_BARRIER, MPL_BROADCAST
USE YOMSMOS   , ONLY : RLIMIT_SD, OB_JOBS, OB_FROM, OB_JROF_GP, OB_INDEX, &
                       & GP_COUNT, OB_COUNT, NPOL_MAX
USE YOMHOOK   , ONLY : LHOOK, DR_HOOK

!USE YOMLUN    , ONLY : NULOUT

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)   :: KLEN
INTEGER(KIND=JPIM),INTENT(IN)   :: KPOL
INTEGER(KIND=JPIM),INTENT(IN)   :: KNLENMAX
REAL(KIND=JPRB)   ,INTENT(IN)   :: PLATOBS(KLEN)
REAL(KIND=JPRB)   ,INTENT(IN)   :: PLONOBS(KLEN)
REAL(KIND=JPRB)   ,INTENT(INOUT):: POB_DIST_TO_GP(KLEN)
INTEGER(KIND=JPIM),INTENT(IN)   :: KSEQNO(KLEN)
LOGICAL           ,INTENT(IN)   :: LDALL
LOGICAL           ,INTENT(IN)   :: LDSUM

INTEGER(KIND=JPIM)              :: IGPTOT(NPROC)
REAL(KIND=JPRB)                 :: ZLAT,ZLON,ZD,ZDPISNL
REAL(KIND=JPRB)                 :: ZDLON, ZDLAT, ZA, ZC
REAL(KIND=JPRB)                 :: ZLAT_DIST(SIZE(RLATIG))
REAL(KIND=JPRB)   , ALLOCATABLE :: ZOB_DIST(:,:)
INTEGER(KIND=JPIM), ALLOCATABLE :: IOB_TO(:,:),IOB_JROF(:,:)
INTEGER(KIND=JPIM), ALLOCATABLE :: IOB_SEQ(:,:)
INTEGER(KIND=JPIM), ALLOCATABLE :: IOB_FROM(:,:)
INTEGER(KIND=JPIM), ALLOCATABLE :: IOB_JOBS(:,:)
INTEGER(KIND=JPIM), ALLOCATABLE :: IOB_SEQ_MIN(:,:)
REAL(KIND=JPRB)   , ALLOCATABLE :: ZOB_DIST_MIN(:,:)
REAL(KIND=JPRB)                 :: ZLIMIT_DEG, ZLIMIT_SCALE
REAL(KIND=JPRB)   , PARAMETER   :: ZMAX_DIST = 9999999.0_JPRB

INTEGER(KIND=JPIM)              :: JA, JB, IGLOFF
INTEGER(KIND=JPIM)              :: JLAT, JLON, JROF, JLATL, INLATS
INTEGER(KIND=JPIM)              :: IPROC, JPROC, ITAG, JOBS, JOBTOTG, JPOL
INTEGER(KIND=JPIM)              :: IOBTOTG,IOB_COUNT_DIM,IGPTOTG
INTEGER(KIND=JPIM)              :: J1,J2,II,JCLOSE
REAL(KIND=JPRB)                 :: ZHOOK_HANDLE
LOGICAL                         :: LL_FOUND


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

 IF (KPOL == 0) THEN 
    ALLOCATE(GP_COUNT(NPROC,0:NPOL_MAX-1))
    ALLOCATE(OB_COUNT(NPROC,0:NPOL_MAX-1))
!
    GP_COUNT(:,:) = 0
 ENDIF

 OB_COUNT(MYPROC,KPOL) = KLEN
 IGPTOT(MYPROC)        = NGPTOT
 ITAG                  = 1
!
! Send to MYPROC = 1
!
 CALL GSTATS(902,0)
!
 IF(MYPROC /= 1) THEN
   CALL MPL_SEND(OB_COUNT(MYPROC,KPOL),&
        & KDEST=1,KTAG=ITAG,CDSTRING='SMOS_NEAREST' )
   CALL MPL_SEND(IGPTOT(MYPROC),&
        & KDEST=1,KTAG=ITAG+1,CDSTRING='SMOS_NEAREST' )
 ELSE
   DO IPROC=2,NPROC
     CALL MPL_RECV(OB_COUNT(IPROC,KPOL),&
          & KSOURCE=IPROC,KTAG=ITAG,CDSTRING='SMOS_NEAREST' )
     CALL MPL_RECV(IGPTOT(IPROC),&
          & KSOURCE=IPROC,KTAG=ITAG+1,CDSTRING='SMOS_NEAREST' )
   ENDDO
 ENDIF
!
 CALL GSTATS(902,1)
!
 IF(MYPROC == 1)THEN
   IOB_COUNT_DIM=MAXVAL(OB_COUNT(:,KPOL))
 ELSE
   IOB_COUNT_DIM=OB_COUNT(MYPROC,KPOL)
 ENDIF
!
 ALLOCATE(ZOB_DIST(IOB_COUNT_DIM,NPROC))
 ALLOCATE(IOB_TO(IOB_COUNT_DIM,NPROC))
 ALLOCATE(IOB_JROF(IOB_COUNT_DIM,NPROC))
 ALLOCATE(IOB_SEQ(IOB_COUNT_DIM,NPROC))
!
 IOB_TO=0
 IOB_JROF=0
 ZOB_DIST=ZMAX_DIST
 ZLIMIT_DEG=RLIMIT_SD*180.0_JPRB/(RPI*RA)
!
 IF(LDALL)THEN
   ZLIMIT_SCALE = 10.0_JPRB
 ELSE
   ZLIMIT_SCALE = 1.0_JPRB
 ENDIF
!
! FOR EACH OBS LOOP ROUND ALL GP 
!
 CALL GSTATS(1490,0)
!$OMP PARALLEL DO SCHEDULE(DYNAMIC,1) & 
!$OMP& PRIVATE(JOBS,JA,IGLOFF,JB,INLATS,ZLAT_DIST,JCLOSE,JLATL,JLAT,ZLAT, &
!$OMP&         ZDPISNL,J1,J2,JLON,JROF,ZLON,ZDLON,ZDLAT,ZA,ZC,ZD,LL_FOUND)
 DO JOBS = 1,OB_COUNT(MYPROC,KPOL)
!
! Loop through each distributed memory region of the globe
  DO JA=1,N_REGIONS_NS
    IF(RLATIG(NLSTLAT(JA)) <= (PLATOBS(JOBS)+ZLIMIT_SCALE*ZLIMIT_DEG)  &
    &   .AND. (PLATOBS(JOBS)-ZLIMIT_SCALE*ZLIMIT_DEG) <=RLATIG(NFRSTLAT(JA))) THEN
      IGLOFF=NPTRFRSTLAT(JA)-1 
      !
      DO JB=1,N_REGIONS(JA)
        INLATS = NLSTLAT(JA)-NFRSTLAT(JA)+1
        ZLAT_DIST(1:INLATS) = PLATOBS(JOBS) - RLATIG(NFRSTLAT(JA):NLSTLAT(JA))  
        !
        ! Find closest and second closest latitude (where the gaussian
        ! grid is staggered in longitude, the closest point may not be the
        ! closest in latitude).
        DO JCLOSE=1,2
           JLATL = MINLOC(ABS(ZLAT_DIST(1:INLATS)),1)
           ZLAT_DIST(JLATL) = ZMAX_DIST  ! Eliminate closest latitude for next iteration
           !
           JLAT  = JLATL+NFRSTLAT(JA)-1
           ZLAT = RLATIG(JLAT)
           ZDPISNL = 2.0_JPRB*RPI/REAL(NLOENG(JLAT),JPRB)
           !
           J1=NSTA(IGLOFF+JLATL,JB)
           J2=NSTA(IGLOFF+JLATL,JB)+NONL(IGLOFF+JLATL,JB)-1
           !
           ! Find closest longitude
           JLON = 1 + MODULO(NINT( (2.0_JPRB*RPI + PLONOBS(JOBS)) / ZDPISNL ), NLOENG(JLAT))
           IF( JLON >= J1 .AND. JLON <= J2 ) THEN
             !
             JROF = SUM(NONL(IGLOFF+1:IGLOFF+JLATL-1,JB)) + JLON - J1 +1
             ZLON = ZDPISNL*REAL(JLON-1,JPRB)
             ! 
             ! Haversine formula for distance on a sphere. Accurate for
             ! small displacements. See also satrad/pre_screen/distance_between.F90
             ZDLON = PLONOBS(JOBS) - ZLON
             ZDLAT = PLATOBS(JOBS) - ZLAT
             ZA = (SIN(ZDLAT/2.0_JPRB))**2 &
                  & + COS(PLATOBS(JOBS)) * COS(ZLAT) * (SIN(ZDLON/2.0_JPRB))**2
             ZC = 2.0_JPRB * ASIN( MIN(1.0_JPRB,SQRT(ZA)) ) ! angular distance in radians
             ZD = RA * ZC                    ! in metres
             !
             IF (LDALL) THEN              
               LL_FOUND = (ZD < ZOB_DIST(JOBS,MYPROC))
             ELSE
               LL_FOUND = (ZD < ZOB_DIST(JOBS,MYPROC) .AND. ZD < RLIMIT_SD)
             ENDIF
             !
             IF(LL_FOUND) THEN
              ! NEED TO SAVE THIS TO ODB => DIST FROM AN OBS TO NEAREST GP
              POB_DIST_TO_GP(JOBS)=ZD
              ZOB_DIST(JOBS,MYPROC)=ZD
              IOB_TO(JOBS,MYPROC)=NGPSET2PE(JA,JB)
              IOB_JROF(JOBS,MYPROC)=JROF
              IOB_SEQ(JOBS,MYPROC)=KSEQNO(JOBS)
              !WRITE(NULOUT,*) 'MINIMUM DISTANCE HAS BEEN CALCULATED for MYPROC =',MYPROC
             ENDIF
           ENDIF
         ENDDO ! JCLOSE
       ENDDO !JB
     ENDIF
   ENDDO !JA
 ENDDO !JOBS
!$OMP END PARALLEL DO
 CALL GSTATS(1490,1)
!
! Send to MYPROC = 1
 CALL GSTATS(902,0)
!
 IF(MYPROC /= 1) THEN
    IF(OB_COUNT(MYPROC,KPOL) /=0)THEN
     CALL MPL_SEND(ZOB_DIST(1:OB_COUNT(MYPROC,KPOL),MYPROC),&
          & KDEST=1,KTAG=ITAG,CDSTRING='SMOS_NEAREST' )
     CALL MPL_SEND(IOB_TO(1:OB_COUNT(MYPROC,KPOL),MYPROC),&
          & KDEST=1,KTAG=ITAG+1,CDSTRING='SMOS_NEAREST' )
     CALL MPL_SEND(IOB_JROF(1:OB_COUNT(MYPROC,KPOL),MYPROC),&
          & KDEST=1,KTAG=ITAG+2,CDSTRING='SMOS_NEAREST' )
     CALL MPL_SEND(IOB_SEQ(1:OB_COUNT(MYPROC,KPOL),MYPROC),&
          & KDEST=1,KTAG=ITAG+3,CDSTRING='SMOS_NEAREST' )
   ENDIF
 ELSE
   DO IPROC=2,NPROC
     IF(OB_COUNT(IPROC,KPOL) /=0)THEN
       CALL MPL_RECV(ZOB_DIST(1:OB_COUNT(IPROC,KPOL),IPROC),&
            & KSOURCE=IPROC,KTAG=ITAG,CDSTRING='SMOS_NEAREST' )
       CALL MPL_RECV(IOB_TO(1:OB_COUNT(IPROC,KPOL),IPROC),&
            & KSOURCE=IPROC,KTAG=ITAG+1,CDSTRING='SMOS_NEAREST' )
       CALL MPL_RECV(IOB_JROF(1:OB_COUNT(IPROC,KPOL),IPROC),&
            & KSOURCE=IPROC,KTAG=ITAG+2,CDSTRING='SMOS_NEAREST' )
       CALL MPL_RECV(IOB_SEQ(1:OB_COUNT(IPROC,KPOL),IPROC),&
            & KSOURCE=IPROC,KTAG=ITAG+3,CDSTRING='SMOS_NEAREST' )
     ENDIF
   ENDDO
 ENDIF
!
 CALL GSTATS(902,1)
!
 CALL GSTATS(908,0)
 CALL MPL_BARRIER(CDSTRING='SMOS_NEAREST')
 CALL GSTATS(908,1)
!
 ALLOCATE(ZOB_DIST_MIN(IGPTOT(MYPROC),NPROC))
 ALLOCATE(IOB_FROM(IGPTOT(MYPROC),NPROC))
 ALLOCATE(IOB_JOBS(IGPTOT(MYPROC),NPROC))
!
 IOBTOTG=SUM(OB_COUNT(:,KPOL))
! WRITE(NULOUT,*) 'IOBTOTG in nearest =',IOBTOTG
!
 CALL GSTATS(902,0)
 CALL MPL_BROADCAST(IOBTOTG,KROOT=1,KTAG=ITAG,CDSTRING='SMOS_NEAREST')
 CALL GSTATS(902,1)
!
!IF (MYPROC == 1 .AND. SAT == 1) THEN
!  WRITE(NULOUT,*)'4D-VAR: OB_COUNT',IOBTOTG,OB_COUNT
!ENDIF
!
 IF(.NOT.LDALL)THEN
   ALLOCATE(IOB_SEQ_MIN(IGPTOT(MYPROC),NPROC))
 ELSE
   ALLOCATE(IOB_SEQ_MIN(IOBTOTG,NPROC))
 ENDIF
!
 IF (KPOL == 0) THEN
   ALLOCATE(OB_FROM(KNLENMAX,NPROC,0:NPOL_MAX-1))
   ALLOCATE(OB_JOBS(KNLENMAX,NPROC,0:NPOL_MAX-1))
   ALLOCATE(OB_JROF_GP(KNLENMAX,NPROC,0:NPOL_MAX-1))
   ALLOCATE(OB_INDEX(KNLENMAX,0:NPOL_MAX-1))
   !WRITE(NULOUT,*) 'GLOBAL ALLOCATION DONE FOR KPOL ',KPOL 
!
   CALL GSTATS(1490,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JPOL,JPROC,JOBTOTG)
   DO JPOL=0,NPOL_MAX-1 
     DO JPROC=1,NPROC  
       DO JOBTOTG=1,KNLENMAX
         OB_JOBS(JOBTOTG,JPROC,JPOL)=0
       ENDDO
     ENDDO
   ENDDO
!$OMP END PARALLEL DO
   CALL GSTATS(1490,1)
!
 ENDIF
!   
 IF(MYPROC == 1)THEN
!
  CALL GSTATS(2012,0)
  IF(.NOT.LDALL)THEN
    !
    !One OBS per GP
     ZOB_DIST_MIN=ZMAX_DIST
    !
    ! Loop over all processors and all observations on each processor 
     DO JPROC=1,NPROC
       DO JOBS=1,OB_COUNT(JPROC,KPOL)
         IF(ZOB_DIST(JOBS,JPROC) /= ZMAX_DIST)THEN
          !
          ! This observation was found to be within the search radius of a grid point       
           JROF=IOB_JROF(JOBS,JPROC)
           IPROC=IOB_TO(JOBS,JPROC)
           IF(ZOB_DIST(JOBS,JPROC) < ZOB_DIST_MIN(JROF,IPROC))THEN
            !
            ! This observation is the closest to the grid point yet found
             ZOB_DIST_MIN(JROF,IPROC)=ZOB_DIST(JOBS,JPROC)
             IOB_SEQ_MIN(JROF,IPROC)=IOB_SEQ(JOBS,JPROC)
             IOB_FROM(JROF,IPROC)=JPROC
             IOB_JOBS(JROF,IPROC)=JOBS

           ELSEIF(ZOB_DIST(JOBS,JPROC) == ZOB_DIST_MIN(JROF,IPROC) .AND. &
                 &    IOB_SEQ(JOBS,JPROC) < IOB_SEQ_MIN(JROF,IPROC)) THEN

             ! When distances are equal, take the observation with the lowest
             ! sequence number. This preserves bit reproducibility            
             IOB_SEQ_MIN(JROF,IPROC)=IOB_SEQ(JOBS,JPROC)
             IOB_FROM(JROF,IPROC)=JPROC
             IOB_JOBS(JROF,IPROC)=JOBS
             !
           ENDIF
         ENDIF
       ENDDO
     ENDDO
    !
    ! Loop over all processors and all grid points on each processor   
     DO IPROC=1,NPROC
       DO JROF=1,IGPTOT(IPROC)
         IF(ZOB_DIST_MIN(JROF,IPROC) /= ZMAX_DIST)THEN
          ! 
          ! This grid point has a valid observation
          !
          ! Total grid points with valid observations (from the
          ! sensor of interest) on this processor
          GP_COUNT(IPROC,KPOL)=GP_COUNT(IPROC,KPOL)+1
          !
          ! The processor this observation belongs to
          OB_FROM(GP_COUNT(IPROC,KPOL),IPROC,KPOL)=IOB_FROM(JROF,IPROC)
          !
          ! Its index in the observation array on that processor 
          OB_JOBS(GP_COUNT(IPROC,KPOL),IPROC,KPOL)=IOB_JOBS(JROF,IPROC)
          !
          ! The index of this grid point in this processor's grid point array
          OB_JROF_GP(GP_COUNT(IPROC,KPOL),IPROC,KPOL)=JROF
          !
         ENDIF
       ENDDO
     ENDDO
     !
  ELSE
    ! 
    !Multiple OBS per GP
     DO JPROC=1,NPROC
       DO JOBS=1,OB_COUNT(JPROC,KPOL)
         IF(ZOB_DIST(JOBS,JPROC) /= ZMAX_DIST)THEN
           IPROC=IOB_TO(JOBS,JPROC)
           GP_COUNT(IPROC,KPOL)=GP_COUNT(IPROC,KPOL)+1
           OB_FROM(GP_COUNT(IPROC,KPOL),IPROC,KPOL)=JPROC
           OB_JOBS(GP_COUNT(IPROC,KPOL),IPROC,KPOL)=JOBS
           OB_JROF_GP(GP_COUNT(IPROC,KPOL),IPROC,KPOL)=IOB_JROF(JOBS,JPROC)
           IOB_SEQ_MIN(GP_COUNT(IPROC,KPOL),IPROC)=IOB_SEQ(JOBS,JPROC)
        ENDIF
      ENDDO
    ENDDO
    !
  ENDIF
  !
  CALL GSTATS(2012,1)
  !
  CALL GSTATS(902,0)
  !
  DO IPROC=2,NPROC
     CALL MPL_SEND(GP_COUNT(IPROC,KPOL),&
          & KDEST=IPROC,KTAG=ITAG,CDSTRING='SMOS_NEAREST' )
  ENDDO
  !
  IGPTOTG=SUM(GP_COUNT(:,KPOL))
  !
  !  WRITE(NULOUT,*)'4D-VAR: GP_COUNT',IGPTOTG,GP_COUNT)
  !
  ! Send to processor that owns grid-point
  !
   DO IPROC=2,NPROC
     IF(GP_COUNT(IPROC,KPOL) /= 0)THEN
       CALL MPL_SEND(OB_FROM(1:GP_COUNT(IPROC,KPOL),IPROC,KPOL),&
            & KDEST=IPROC,KTAG=ITAG+1,CDSTRING='SMOS_NEAREST' )
       CALL MPL_SEND(OB_JOBS(1:GP_COUNT(IPROC,KPOL),IPROC,KPOL),&
            & KDEST=IPROC,KTAG=ITAG+2,CDSTRING='SMOS_NEAREST' )
       CALL MPL_SEND(OB_JROF_GP(1:GP_COUNT(IPROC,KPOL),IPROC,KPOL),&
            & KDEST=IPROC,KTAG=ITAG+3,CDSTRING='SMOS_NEAREST' )
       CALL MPL_SEND(IOB_SEQ_MIN(1:GP_COUNT(IPROC,KPOL),IPROC),&
            & KDEST=IPROC,KTAG=ITAG+4,CDSTRING='SMOS_NEAREST' )
     ENDIF
  ENDDO
  !
  CALL GSTATS(902,1)
  !
 ELSE
  !
  CALL GSTATS(902,0)
  CALL MPL_RECV(GP_COUNT(MYPROC,KPOL),&
       & KSOURCE=1,KTAG=ITAG,CDSTRING='SMOS_NEAREST' )
  !
  IF(GP_COUNT(MYPROC,KPOL) /= 0)THEN
     CALL MPL_RECV(OB_FROM(1:GP_COUNT(MYPROC,KPOL),MYPROC,KPOL),&
         & KSOURCE=1,KTAG=ITAG+1,CDSTRING='SMOS_NEAREST' )
     CALL MPL_RECV(OB_JOBS(1:GP_COUNT(MYPROC,KPOL),MYPROC,KPOL),&
         & KSOURCE=1,KTAG=ITAG+2,CDSTRING='SMOS_NEAREST' )
     CALL MPL_RECV(OB_JROF_GP(1:GP_COUNT(MYPROC,KPOL),MYPROC,KPOL),&
         & KSOURCE=1,KTAG=ITAG+3,CDSTRING='SMOS_NEAREST' )
     CALL MPL_RECV(IOB_SEQ_MIN(1:GP_COUNT(MYPROC,KPOL),MYPROC),&
        & KSOURCE=1,KTAG=ITAG+4,CDSTRING='SMOS_NEAREST' )
  ENDIF
  !
  CALL GSTATS(902,1)
 !
 ENDIF
 !
 CALL GSTATS(908,0)
 CALL MPL_BARRIER(CDSTRING='SMOS_NEAREST')
 CALL GSTATS(908,1)
 !
 IF(LDSUM)THEN
  ! When meaning or summing in gp2obs routines, the following ensures
  ! bit-reproducibility. Note that ISORTX also changes the order of
  ! IOB_SEQ_MIN as (in this case) an unwanted side-effect.
  CALL ISORTX(IOB_SEQ_MIN(:,MYPROC),1,GP_COUNT(MYPROC,KPOL),OB_INDEX(:,KPOL))
 ELSE
   DO II=1,GP_COUNT(MYPROC,KPOL)
     OB_INDEX(II,KPOL)=II
   ENDDO
 ENDIF
 !
 DEALLOCATE(ZOB_DIST)
 DEALLOCATE(IOB_TO)
 DEALLOCATE(IOB_JROF)
 DEALLOCATE(ZOB_DIST_MIN)
 DEALLOCATE(IOB_SEQ_MIN)
 DEALLOCATE(IOB_FROM)
 DEALLOCATE(IOB_JOBS)
 DEALLOCATE(IOB_SEQ)
 !
 IF (LHOOK) CALL DR_HOOK('SMOS_NEAREST',1,ZHOOK_HANDLE)
 !
 END SUBROUTINE SMOS_NEAREST
