SUBROUTINE SUFPCIP(PLSMIN,PLSMOUT,KL0)  

! Purpose :
! -------
!   *SUFPCIP* Setup localization of created isolated points (lake or island)
!             in the horizontal interpolation step.

! Interface :
! ---------

!      PLSMIN    : source land/sea mask, including halo
!      PLSMOUT   : target land/sea mask.
!      KL0       : Column indices of the 4 western points 13, 7, 9, 15.

! Externals :
! ---------
!   MPL_ALLREDUCE

! Method :
! ------

! Distributed computation.
! Always consider the neighbouring 12 rather than 4 points.
! Rely upon land-sea mask possible values : 1 = land ; 0 = sea
! Action depends on the vegetation index (from climatology)
! Numbering of the points (I is the interpolation point):
!                     13       5       6      14

!                      7       1       2       8
!                                 (I)
!                      9       3       4      10

!                     15      11      12      16

! Reference :
! ---------

! Author :
! ------
!   03-Aug-2005 R. El Khatib  *METEO-FRANCE*

! Modifications :
! -------------
!   K. Yessad: 28-Feb-2007: optimisation of distributed memory in FULL-POS.
! End Modifications
!-----------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK

USE YOMCT0   , ONLY : NPROC    ,LALLOPR
USE YOMLUN   , ONLY : NULOUT
USE YOMMP    , ONLY : NAFPB1
USE YOMFPG   , ONLY : NFPRGPL  ,NFPRGPL_DEP        ,LFPOSBUF ,LFPDISTRIB
USE YOMWFPDS , ONLY : NFPWIDE
USE YOMWFPB  , ONLY : MWIC     ,MWIC_DEP
USE YOMFPSC2 , ONLY : NFPBLOCS ,NFPROMA  ,NFPSTART ,NFPEND   ,NFPBLOFF
USE YOMRFPDS , ONLY : NRFPOS   ,MOFPTR
USE YOMRFPB  , ONLY : RFPBUF   ,NSTARFPB
USE YOMAFN   , ONLY : GFP_IVEG
USE YOMCLI   , ONLY : NTPLAC   ,NTPMER
USE MPL_MODULE, ONLY : MPL_ALLREDUCE

!-----------------------------------------------------------------------------

IMPLICIT NONE

REAL(KIND=JPRB)   ,INTENT(IN)  :: PLSMIN(NAFPB1)
REAL(KIND=JPRB)   ,INTENT(IN)  :: PLSMOUT(NFPRGPL_DEP)
INTEGER(KIND=JPIM),INTENT(IN)  :: KL0(NFPRGPL_DEP,0:NFPWIDE)

!-----------------------------------------------------------------------------

INTEGER(KIND=JPIM) :: IT, J, JBLOC, IST, IEND, JFP, IPTR, ILAKES, ISLANDS
INTEGER(KIND=JPIM) :: IC, IFLDS
INTEGER(KIND=JPIM) :: IN(12), IMAX(1), IMIN(1)
INTEGER(KIND=JPIM) :: IVEG_DEP(NFPRGPL_DEP)
INTEGER(KIND=JPIM) :: ISNGLL(4) ! local counter of singular points
INTEGER(KIND=JPIM) :: ISNGLG(4) ! global counter of singular points

REAL(KIND=JPRB) :: ZWORK(NFPRGPL,1)
REAL(KIND=JPRB) :: ZWORK_DEP(NFPRGPL_DEP,1)
REAL(KIND=JPRB) :: ZRFP(NFPROMA,NRFPOS)

REAL(KIND=JPRB) :: ZHOOK_HANDLE

!-----------------------------------------------------------------------------

#include "fptratod.intfb.h"
#include "fptrdtoa.intfb.h"
#include "sc2rdgfp.intfb.h"

!-----------------------------------------------------------------------------

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

!-----------------------------------------------------------------------------

ALLOCATE(MWIC(NFPRGPL))
ALLOCATE(MWIC_DEP(NFPRGPL_DEP))
IF (LALLOPR) THEN
  WRITE(NULOUT,9990) 'MWIC     ',SIZE(MWIC),SHAPE(MWIC)
  WRITE(NULOUT,9990) 'MWIC_DEP ',SIZE(MWIC_DEP),SHAPE(MWIC_DEP)
ENDIF

IPTR=MOFPTR(GFP_IVEG%ICOD)
DO JBLOC=1,NFPBLOCS
  IST =NFPSTART(JBLOC)
  IEND=NFPEND(JBLOC)
  CALL SC2RDGFP(NFPROMA,NRFPOS,RFPBUF,NSTARFPB(JBLOC),IST,IEND,ZRFP)
  DO JFP=IST,IEND
    ZWORK(NFPBLOFF(JBLOC)+JFP,1)=ZRFP(JFP,IPTR)
  ENDDO
ENDDO

! Transposition between arrival geometry and departure geometry DM-partitions:
IF (LFPDISTRIB.AND.LFPOSBUF) THEN
  IC=1
  IFLDS=1
  CALL FPTRATOD(IC,IFLDS,ZWORK,ZWORK_DEP)
  DO J=1,NFPRGPL_DEP
    IVEG_DEP(J)=NINT(ZWORK_DEP(J,1))
  ENDDO
ELSE
  DO J=1,NFPRGPL_DEP
    IVEG_DEP(J)=NINT(ZWORK(J,1))
  ENDDO
ENDIF

ISNGLL(:)=0

DO J = 1, NFPRGPL_DEP
    IT     = NINT(PLSMOUT(J))
    IN( 1) = NINT(PLSMIN(KL0(J,1)+1))
    IN( 2) = NINT(PLSMIN(KL0(J,1)+2))
    IN( 3) = NINT(PLSMIN(KL0(J,2)+1))
    IN( 4) = NINT(PLSMIN(KL0(J,2)+2))
    IN( 5) = NINT(PLSMIN(KL0(J,0)+1))
    IN( 6) = NINT(PLSMIN(KL0(J,0)+2))
    IN( 7) = NINT(PLSMIN(KL0(J,1)))
    IN( 8) = NINT(PLSMIN(KL0(J,1)+3))
    IN( 9) = NINT(PLSMIN(KL0(J,2)))
    IN(10) = NINT(PLSMIN(KL0(J,2)+3))
    IN(11) = NINT(PLSMIN(KL0(J,3)+1))
    IN(12) = NINT(PLSMIN(KL0(J,3)+2))
    IMAX(1)=MAXVAL(IN)
    IMIN(1)=MINVAL(IN)
    IF (IT == 0 .AND. IMIN(1) == 1 .AND. IVEG_DEP(J) == NTPLAC) THEN
      ! An identified lake has been created
      MWIC_DEP(J)=1
      ISNGLL(1)=ISNGLL(1)+1
    ELSEIF (IT == 0 .AND. IMIN(1) == 1 .AND. IVEG_DEP(J) == NTPMER) THEN
      ! An unidentified lake has been created
      MWIC_DEP(J)=1
      ISNGLL(2)=ISNGLL(2)+1
    ELSEIF (IT == 1 .AND. IMAX(1) == 0) THEN
      ! An island has been created
      MWIC_DEP(J)=2
      ISNGLL(3)=ISNGLL(3)+1
    ELSEIF (IVEG_DEP(J) == NTPLAC) THEN
      ! An identified lake has NOT been created => force climatology
      MWIC_DEP(J)=1
      ISNGLL(4)=ISNGLL(4)+1
    ELSE
      ! At least 1 of the neighbouring points is same kind as target point
      MWIC_DEP(J)=0
    ENDIF
ENDDO

! Transposition between departure geometry and arrival geometry DM-partitions:
IF (LFPDISTRIB.AND.LFPOSBUF) THEN
  DO J=1,NFPRGPL_DEP
    ZWORK_DEP(J,1)=REAL(MWIC_DEP(J),JPRB)
  ENDDO
  IC=1
  IFLDS=1
  CALL FPTRDTOA(IC,IFLDS,ZWORK_DEP,ZWORK)
  DO J=1,NFPRGPL
    MWIC(J)=NINT(ZWORK(J,1))
  ENDDO
ELSE
  ! Simply copy MWIC_DEP in MWIC:
  MWIC(:)=MWIC_DEP(:)
ENDIF

ISNGLG(:) = ISNGLL(:)
IF (NPROC > 1) CALL MPL_ALLREDUCE(ISNGLG,'SUM',CDSTRING='SUFPCIP:')

ILAKES=ISNGLG(1)+ISNGLG(2)+ISNGLG(4)
ISLANDS=ISNGLG(3)
WRITE(UNIT=NULOUT,FMT='('' SINGULAR POINTS FOR HORIZONTAL INTERPOLATIONS : '',&
 & I4, '' ISOLATED LAKE(S) + '',I4,'' ISOLATED ISLAND(S)'')') ILAKES,ISLANDS
WRITE(UNIT=NULOUT,FMT='('' IDENTIFIED LAKES   : '',I4)') ISNGLG(1)
WRITE(UNIT=NULOUT,FMT='('' UNIDENTIFIED LAKES : '',I4)') ISNGLG(2)
WRITE(UNIT=NULOUT,FMT='('' MISSED LAKES       : '',I4)') ISNGLG(4)

9990 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8)
!     ---------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('SUFPCIP',1,ZHOOK_HANDLE)
END SUBROUTINE SUFPCIP
