SUBROUTINE FPSAMPL(KFIELDS,KGPST,KGPEND,KFPROMA,KFLDBUF,PBUF,PROW,KL0,LDONE,&
 & LDSAMPL,KBLOCK)

!**** *FPSAMPL*  - FULL-POS horizontal sampling

!     PURPOSE.
!     --------
!        To sample input buffer (when the output grid is a subset of the 
!        input grid or the same grid)
!        Numbering of the neighbouring points (I is the target point):

!                      13      5       6      14

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

!                      15     11      12      16

!**   INTERFACE.
!     ----------
!       *CALL* *FPSAMPL*

!        EXPLICIT ARGUMENTS
!        --------------------

!        INPUT:
!         KFIELDS  : number of fields in row
!         KGPST    : first output point in row.
!         KGPEND   : last output point in row.
!         PBUF     : buffer which contain the fields to interpolate.
!         KL0      : indexes of the western points, from north to south :
!                    4 points (n³13,7,9,15) if NFPWIDE=3 ;
!         KFPROMA  : length of the output row.
!         KFLDBUF  : number of fields in input buffer
!         LDONE    : Logical mask : signal fields (.TRUE.) already computed
!         KBLOCK   : current NFPROMA_DEP-sized block
!        OUTPUT:
!         PROW     : interpolated fields.
!         LDSAMPL  : .TRUE. if sampling has been done

!        IMPLICIT ARGUMENTS
!        --------------------
!          See #include below. 

!     METHOD.
!     -------
!        SEE DOCUMENTATION

!     EXTERNALS.
!     ----------
!      See below.

!     REFERENCE.
!     ----------
!        ECMWF Research Department documentation of the IFS
!        See documentation about FULL-POS.

!     AUTHOR.
!     -------
!        RYAD EL KHATIB *METEO-FRANCE*

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 98-09-09
!        Modified :2000-03-01 by  Jaouad Boutahar (bilinear interpolation)
!    R. El Khatib : 03-04-17 Fullpos improvemnts
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!   R. El Khatib  20-May-2005 NFPWIDE moved to YOMWFPDS
!        K. Yessad: 28-02-2007 DM-features optimisations in FULL-POS
!     --------------------------------------------------------------------

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

USE YOMWFPDS  ,ONLY : NFPWIDE  ,LWSTD04  ,LWSTD12
USE YOMMP     ,ONLY : NAFPB1
USE YOMWFPB   ,ONLY : WSTD04   ,WSTD12
USE YOMFPSC2  ,ONLY : NFPBLOFF_DEP

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

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KFIELDS 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFPROMA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFLDBUF 
INTEGER(KIND=JPIM),INTENT(IN)    :: KGPST 
INTEGER(KIND=JPIM),INTENT(IN)    :: KGPEND 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PBUF(NAFPB1*KFLDBUF) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PROW(KFPROMA,KFIELDS) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KL0(KFPROMA,NFPWIDE+1) 
LOGICAL           ,INTENT(IN)    :: LDONE(KFIELDS) 
LOGICAL           ,INTENT(OUT)   :: LDSAMPL(KFIELDS) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KBLOCK

!     --------------------------------------------------------------------
!     IDER   : number of "boxes" for each field (for derivatives)
!     LLMONO : .TRUE. for monotonic interpolations
!     LLMNMX : .TRUE. to replace interpolations by the search of the 
!              nearest point

LOGICAL :: LLMONO(KFIELDS), LLMNMX(KFIELDS)

INTEGER(KIND=JPIM) :: IBOX(KFPROMA), IDER(KFIELDS), IDMP(KFLDBUF)

INTEGER(KIND=JPIM) :: IADD, JF, JFLD, JI, ISTB, IENB
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "abor1.intfb.h"
#include "fpint12.intfb.h"
#include "fpint4.intfb.h"

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

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

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

!*    1. BUFFER TRANSFER OR ACTUAL SAMPLING
!        ----------------------------------

IF (NFPWIDE == 0) THEN

  ! Buffer copy of all fields
  DO JF = 1, KFIELDS
    IF (.NOT.LDONE(JF)) THEN
      IADD=NAFPB1*(JF-1)
      DO JI=KGPST,KGPEND
        PROW(JI,JF)=PBUF(KL0(JI,1)+IADD)
      ENDDO
    ENDIF
  ENDDO

ELSE

  ISTB=NFPBLOFF_DEP(KBLOCK)+1
  IENB=NFPBLOFF_DEP(KBLOCK)+KGPEND-KGPST+1
  ! No interpolations => :  
  IDER(:)=1
  IBOX(:)=1
  IDMP(:)=0
  LLMONO(:)=.FALSE.
  ! Search for the nearest point in all cases : 
  LLMNMX(:)=.TRUE.
  IF (LWSTD04) THEN
    CALL FPINT4(KFIELDS,KGPST,KGPEND,KFPROMA,KFLDBUF,IDER,IDMP,LLMNMX,&
     & IBOX,KL0,WSTD04(ISTB:IENB,1:4),LDONE,PBUF,PROW)
  ELSEIF (LWSTD12) THEN
    CALL FPINT12(KFIELDS,KGPST,KGPEND,KFPROMA,KFLDBUF,IDER,IDMP,LLMNMX,&
     & LLMONO,IBOX,KL0,WSTD12(ISTB:IENB,1:12),LDONE,PBUF,PROW)
  ELSE
    CALL ABOR1('FPSAMPL: NO INTERPOLATOR FOUND !')
  ENDIF

ENDIF

!*    2. CONTROL
!        -------

!     Signal sampling has been done
DO JFLD=1,KFIELDS
  LDSAMPL(JFLD)=.NOT.LDONE(JFLD)
ENDDO

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

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