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

!**** *FPINT12*  - 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):

!                      13      5       6      14 

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

!                      15     11      12      16 

!**   INTERFACE.
!     ----------
!       *CALL* *FPINT12*

!        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
!         LDMONO   : .TRUE. if monotonic interpolations
!         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 :
!                    4 points (n³13, 7, 9, 15)
!         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 12 points.
!        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 : 94-04-08
!        Modified by K. YESSAD (MARCH 1997):
!         - rewriting in a way more consistent with routine LAIDDI,
!           using array KL0, prior to parallelisation.
!         - parallelisation of FULL-POS.
!         - some cleaning. 
!        R. El Khatib 98-02-13 PMIN and PMAX as arrays
!        R. El Khatib 98-09-01 
!           split into FPINT12 and FPCOR12
!           merge with FPHOR12, FPMIMAX and FPAERO
!           loop on fields for FPINT12 ; 
!           prepare for 4 points interpolations/nearest point
!           case no interpolations
!        R. El Khatib 00-04-10 Security checks.
!        R. El Khatib 01-10-03 Fix monotonic interpolations for land-sea
!                              dependant fields
!    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) 
LOGICAL           ,INTENT(IN)    :: LDMONO(KFIELDS) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KBOX(KFPROMA) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KL0(KFPROMA,NFPWIDE+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PW(KGPEND,12) 
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,2)
INTEGER(KIND=JPIM) :: IADDFLD, IMAX0(KFPROMA,2)

INTEGER(KIND=JPIM) :: JDER, JF, JI, JW, IPW, IFLDBUF, J

REAL(KIND=JPRB) :: ZE, ZMX(KFPROMA), ZMN(KFPROMA)
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"

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

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

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

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

ZE=EPSILON(1.0_JPRB)*10._JPRB

IF (ANY(LDNRST).OR.ANY(LDMONO)) THEN
! Search the nearest land-sea compatible point
  DO JI=KGPST,KGPEND
    IMAX0(JI,1:1)=MAXLOC(PW(JI,1:IPW))
  ENDDO
! Search a land-sea compatible point among the 4 nearest ones first,
! then among all
  IMAX0(:,2)=0
  DO JW=1,IPW
    DO JI=KGPST,KGPEND
      IF (PW(JI,JW) >= ZE .AND. IMAX0(JI,2) == 0) IMAX0(JI,2)=JW
    ENDDO
  ENDDO
  DO JW=1,2
    DO JI=KGPST,KGPEND
      SELECT CASE (IMAX0(JI,JW))
      CASE (1)
        INRST(JI,JW)=KL0(JI,2)+1
      CASE (2)
        INRST(JI,JW)=KL0(JI,2)+2
      CASE (3)
        INRST(JI,JW)=KL0(JI,3)+1 
      CASE (4)
        INRST(JI,JW)=KL0(JI,3)+2
      CASE (5)
        INRST(JI,JW)=KL0(JI,1)+1
      CASE (6)
        INRST(JI,JW)=KL0(JI,1)+2
      CASE (7)
        INRST(JI,JW)=KL0(JI,2) 
      CASE (8)
        INRST(JI,JW)=KL0(JI,2)+3
      CASE (9)
        INRST(JI,JW)=KL0(JI,3)
      CASE (10)
        INRST(JI,JW)=KL0(JI,3)+3
      CASE (11)
        INRST(JI,JW)=KL0(JI,4)+1
      CASE (12)
        INRST(JI,JW)=KL0(JI,4)+2 
      END SELECT
    ENDDO
  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)&
         & + PW(JI, 5)*PBUF(IADD(JI)+KL0(JI,1)+1)&
         & + PW(JI, 6)*PBUF(IADD(JI)+KL0(JI,1)+2)&
         & + PW(JI, 7)*PBUF(IADD(JI)+KL0(JI,2)  )&
         & + PW(JI, 8)*PBUF(IADD(JI)+KL0(JI,2)+3)&
         & + PW(JI, 9)*PBUF(IADD(JI)+KL0(JI,3)  )&
         & + PW(JI,10)*PBUF(IADD(JI)+KL0(JI,3)+3)&
         & + PW(JI,11)*PBUF(IADD(JI)+KL0(JI,4)+1)&
         & + PW(JI,12)*PBUF(IADD(JI)+KL0(JI,4)+2) )  
      ENDDO
      IF (LDMONO(JF)) THEN
        DO J=KGPST,KGPEND
          ZMX(J)=PBUF(IADD(J)+INRST(J,2))
          ZMN(J)=PBUF(IADD(J)+INRST(J,2))
          IF (PW(J, 1) >= ZE) ZMX(J)=MAX(ZMX(J),PBUF(IADD(J)+KL0(J,2)+1))
          IF (PW(J, 2) >= ZE) ZMX(J)=MAX(ZMX(J),PBUF(IADD(J)+KL0(J,2)+2))
          IF (PW(J, 3) >= ZE) ZMX(J)=MAX(ZMX(J),PBUF(IADD(J)+KL0(J,3)+1))
          IF (PW(J, 4) >= ZE) ZMX(J)=MAX(ZMX(J),PBUF(IADD(J)+KL0(J,3)+2))
          IF (PW(J, 1) >= ZE) ZMN(J)=MIN(ZMN(J),PBUF(IADD(J)+KL0(J,2)+1))
          IF (PW(J, 2) >= ZE) ZMN(J)=MIN(ZMN(J),PBUF(IADD(J)+KL0(J,2)+2))
          IF (PW(J, 3) >= ZE) ZMN(J)=MIN(ZMN(J),PBUF(IADD(J)+KL0(J,3)+1))
          IF (PW(J, 4) >= ZE) ZMN(J)=MIN(ZMN(J),PBUF(IADD(J)+KL0(J,3)+2))
          IF (IMAX0(J,2) > 4) THEN
            IF (PW(J, 5) >= ZE) ZMX(J)=MAX(ZMX(J),PBUF(IADD(J)+KL0(J,1)+1))
            IF (PW(J, 6) >= ZE) ZMX(J)=MAX(ZMX(J),PBUF(IADD(J)+KL0(J,1)+2))
            IF (PW(J, 7) >= ZE) ZMX(J)=MAX(ZMX(J),PBUF(IADD(J)+KL0(J,2)  ))
            IF (PW(J, 8) >= ZE) ZMX(J)=MAX(ZMX(J),PBUF(IADD(J)+KL0(J,2)+3))
            IF (PW(J, 9) >= ZE) ZMX(J)=MAX(ZMX(J),PBUF(IADD(J)+KL0(J,3)  ))
            IF (PW(J,10) >= ZE) ZMX(J)=MAX(ZMX(J),PBUF(IADD(J)+KL0(J,3)+3))
            IF (PW(J,11) >= ZE) ZMX(J)=MAX(ZMX(J),PBUF(IADD(J)+KL0(J,4)+1))
            IF (PW(J,12) >= ZE) ZMX(J)=MAX(ZMX(J),PBUF(IADD(J)+KL0(J,4)+2))
            IF (PW(J, 5) >= ZE) ZMN(J)=MIN(ZMN(J),PBUF(IADD(J)+KL0(J,1)+1))
            IF (PW(J, 6) >= ZE) ZMN(J)=MIN(ZMN(J),PBUF(IADD(J)+KL0(J,1)+2))
            IF (PW(J, 7) >= ZE) ZMN(J)=MIN(ZMN(J),PBUF(IADD(J)+KL0(J,2)  ))
            IF (PW(J, 8) >= ZE) ZMN(J)=MIN(ZMN(J),PBUF(IADD(J)+KL0(J,2)+3))
            IF (PW(J, 9) >= ZE) ZMN(J)=MIN(ZMN(J),PBUF(IADD(J)+KL0(J,3)  ))
            IF (PW(J,10) >= ZE) ZMN(J)=MIN(ZMN(J),PBUF(IADD(J)+KL0(J,3)+3))
            IF (PW(J,11) >= ZE) ZMN(J)=MIN(ZMN(J),PBUF(IADD(J)+KL0(J,4)+1))
            IF (PW(J,12) >= ZE) ZMN(J)=MIN(ZMN(J),PBUF(IADD(J)+KL0(J,4)+2))
          ENDIF
          PROW(J,JF) = MIN(ZMX(J),MAX(ZMN(J),PROW(J,JF)))
        ENDDO
      ENDIF
    ELSE
      DO JI=KGPST,KGPEND
        PROW(JI,JF) = PBUF(IADD(JI)+INRST(JI,1))
      ENDDO
    ENDIF

  ENDIF

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

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

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