SUBROUTINE FPINT4(KFIELDS,KGPST,KGPEND,KFPROMA,KFLDBUF,KDER, &
 & KDMP,LDNRST,KBOX,KL0,PW,LDMASK,PBUF,PROW)  

!**** *FPINT4*  - FULL-POS horizontal interpolator.

!     PURPOSE.
!     --------

!        Performs interpolations for each point of a row and for a set 
!        of fields.
!        Numbering of the points (I is the interpolation point):

!                              1       2        
!                                 (I)
!                              3       4        

!**   INTERFACE.
!     ----------
!       *CALL* *FPINT4*

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

!        INPUT:
!         KFIELDS  : number of fields in row.
!         KGPST    : first output point in row.
!         KGPEND   : last output point in row.
!         KFPROMA  : length of the output row.
!         KFLDBUF  : number of fields in input buffer
!         KDER     : number of "boxes" for each field (used for
!                    "horizontal derivative" in stretched mode). 
!         KDMP     : subdomain number for each field in input buffer
!                    (if relevent)
!         LDNRST   : .TRUE. to replace interpolations by the search of 
!                    the nearest point
!         KBOX     : index of the subdomain each point belongs.
!                    Used for for pp. of stretched filtred derivatives.
!         KL0      : indexes of the western points, from north to south :
!                    2 points (n³ 7, 9) used over 4.
!         PW       : weights for interpolations.
!         LDMASK   : logical mask : .TRUE. => no computation
!         PBUF     : buffer which contain the fields to interpolate.
!        OUTPUT:
!         PROW     : interpolated fields.

!        IMPLICIT ARGUMENTS
!        --------------------
!          None

!     METHOD.
!     -------
!        Horizontal interpolations : with 4 or the nearest point(s).
!        Note that the adress of the input field may depend of the 
!        output point (in the case  field is considered as an 
!        "horizontal derivative".
!        Anyway, the computation is done only if the logical mask is .TRUE.

!     EXTERNALS.
!     ----------
!      None

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

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

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 98-09-07 from FPINT12
!    J. Boutahar : 2000-03-01 Debug 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
!     -----------------------------------------------------------------------

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

USE YOMWFPDS  , ONLY : NFPWIDE
USE YOMMP     , ONLY : NAFPB1

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 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDER(KFIELDS) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDMP(KFLDBUF) 
LOGICAL           ,INTENT(IN)    :: LDNRST(KFIELDS) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KBOX(KFPROMA) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KL0(KFPROMA,NFPWIDE+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PW(KGPEND,4) 
LOGICAL           ,INTENT(IN)    :: LDMASK(KFIELDS) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PBUF(NAFPB1*KFLDBUF) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PROW(KFPROMA,KFIELDS) 
!     IADD : field index in input buffer.
!     INRST: location in input buffer of the points with highest weight 

INTEGER(KIND=JPIM) :: IADD(KFPROMA), INRST(KFPROMA)
INTEGER(KIND=JPIM) :: IADDFLD, IMAX0(KFPROMA,1)

INTEGER(KIND=JPIM) :: JDER, JF, JI, IPW, IFLDBUF
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"

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

!*    1. CHECK DIMENSIONS
!        ----------------

IF (LHOOK) CALL DR_HOOK('FPINT4',0,ZHOOK_HANDLE)
IF (NFPWIDE == 3) THEN
  IPW=4
ELSE
  CALL ABOR1('FPINT12 : ERROR NFPWIDE')
ENDIF

!*    2. FIND NEAREST POINT AND A LAND-SEA COMPATIBLE POINT TO START
!        -----------------------------------------------------------

IF (ANY(LDNRST)) THEN
! Search the nearest land-sea compatible point
  DO JI=KGPST,KGPEND
    IMAX0(JI,1:1)=MAXLOC(PW(JI,1:IPW))
  ENDDO
  DO JI=KGPST,KGPEND
    SELECT CASE (IMAX0(JI,1))
    CASE (1)
      INRST(JI)=KL0(JI,2)+1
    CASE (2)
      INRST(JI)=KL0(JI,2)+2
    CASE (3)
      INRST(JI)=KL0(JI,3)+1
    CASE (4)
      INRST(JI)=KL0(JI,3)+2
    END SELECT
  ENDDO
ENDIF

!*    3. LOOP ON ALL FIELDS
!        ------------------

IADDFLD=0
DO JF = 1, KFIELDS

!*      3.1 SKIP THE FIELD IF THE LOGICAL MASK IS .FALSE.

  IF (.NOT.LDMASK(JF)) THEN

!*      3.2 COMPUTE INPUT FIELD ADRESS

    IADD(KGPST:KGPEND)=NAFPB1*IADDFLD
    IF (KDER(JF) > 1) THEN
!     Modify gp adresses to point onto the right subdomain
      DO JDER=1,KDER(JF)
        IFLDBUF=IADDFLD+JDER
        DO JI=KGPST,KGPEND
          IF (KBOX(JI) == KDMP(IFLDBUF)) THEN
            IADD(JI)=NAFPB1*(IADDFLD+JDER-1)
          ENDIF
        ENDDO
      ENDDO
    ENDIF

!*      3.3 COMPUTE OUTPUT POINT

    IF (.NOT.LDNRST(JF)) THEN
      DO JI=KGPST,KGPEND
        PROW(JI,JF)=&
         & ( PW(JI, 1)*PBUF(IADD(JI)+KL0(JI,2)+1)&
         & + PW(JI, 2)*PBUF(IADD(JI)+KL0(JI,2)+2)&
         & + PW(JI, 3)*PBUF(IADD(JI)+KL0(JI,3)+1)&
         & + PW(JI, 4)*PBUF(IADD(JI)+KL0(JI,3)+2) )  
      ENDDO
    ELSE
      DO JI=KGPST,KGPEND
        PROW(JI,JF) = PBUF(IADD(JI)+INRST(JI))
      ENDDO
    ENDIF

  ENDIF

  IADDFLD=IADDFLD+KDER(JF)
  IF (IADDFLD > KFLDBUF) THEN
    CALL ABOR1('FPINT4 : INTERNAL ERROR IADDFLD')
  ENDIF

ENDDO
!     ------------------------------------------------------------------

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