SUBROUTINE SUFPWFPBUF

!**** *SUFPWFPBUF*  - INITIALIZE BUFFER WFPBUF, WHICH CONTAINS THE WORKING FIELDS
!                   FOR HORIZONTAL INTERPOLATIONS : SIZE OF THE BOX, INDEXES
!                   AND WEIGHTS

!     PURPOSE.
!     --------
!        READ OR COMPUTE INPUT/OUTPUT LAND-SEA MASK, COMPUTE WEIGHTS AND INDEX,
!        (computes MLAT,MLON,MLOS,MLONN,MLOSS,WSTD04,WSTD12).

!       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
!       Points number 1 to 12 are used if 12 points interpolations.
!       Points number 1 to 4 are used if bilinear interpolations.

!       DM-environment is the one of departure geometry.


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

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

!     EXTERNALS.
!     ----------
!      see below.

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

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

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 94-04-08
!        g. radnoti 95-01-30: call suehow in ALADIN case
!        M.Hamrud : 95-10-20 Interface block for EXTGPF
!        Modified by K. YESSAD (MARCH 1997):
!          - optimisations.
!          - parallelisation of FULL-POS.
!        K.YESSAD : (AUGUST 1997):
!          - cleaning for cy18: corrections of false comments.
!        C.Fischer: 97-10-23 Plug in SUEHOW2, SUEHOWLSM for Aladin
!        Modified 98-08-10 by K. YESSAD: removal of LRPOLE option.
!          - removal of LRPOLE in YOMCT0.
!          - removal of LLPOLE and code under LRPOLE, LLPOLE.
!          - removal of NDGLG, LRPOLE/LLPOLE in 'CALL SUHOW2/SUHOWLSM'.
!        G. Radnoti: 98-09-09 new calling sequence for rdclimo
!        R. El Khatib : 98-10-07 Simplified scanning & substantial rewrite
!        D. Giard : 99-07-26 argument KBINL suppressed 
!        R. El Khatib : 99-03-18 NFPSIZEL replaced by NFPNUMD
!        J.Boutahar : 2000-03-01 new treatment of the Lakes in Fullpos
!        R. El Khatib : 01-08-07 Pruning options
!    R. El Khatib : 02-21-20 Fullpos B-level distribution + remove IO scheme
!      R. El Khatib : 03-01-29 Remove SM aspects.
!    R. El Khatib : 03-04-17 Fullpos improvments
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Hamrud      10-Jan-2004 CY28R1 Cleaning
!        K.Yessad : 27-02-2007  Optimisations of distributed memory in FULL-POS.
!     ------------------------------------------------------------------

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

USE YOMLUN   , ONLY : NULOUT
USE YOMCT0   , ONLY : LELAM    ,LALLOPR
USE YOMDIM   , ONLY : NDGLG    ,NDGSAFPH ,NDGENFPH ,NDGUXG   ,NDLUXG
USE YOMLEG   , ONLY : RLATIG
USE YOMFPG   , ONLY : NFPRGPL_DEP,RFPLA_DEP,RFPLO_DEP,LFPOSBUF
USE YOMWFPDS , ONLY : LWSTD12  ,LWSTD04  ,LQUAD
USE YOMWFPB  , ONLY : MLAT     ,MLON     ,MLOS     ,MLONN    ,MLOSS    ,&
 & WSTD04   ,WSTD12
USE YOMMP    , ONLY : NFRSTLOFF
USE YEMGEO   , ONLY : EDELX    ,EDELY
USE YOMCST   , ONLY : RPI
USE YOMGEM   , ONLY : NLOENG   ,R4JP

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

IMPLICIT NONE

! ZDLAT : Meridian linear weight.
! ZDLO  : Zonal linear weight for the latitude of the point numbered 5.
! ZDLO1 : Zonal linear weight for the latitude of the point numbered 1.
! ZDLO2 : Zonal linear weight for the latitude of the point numbered 3.
! ZDLO3 : Zonal linear weight for the latitude of the point numbered 11.

REAL(KIND=JPRB) :: ZDLAT(NFPRGPL_DEP)
REAL(KIND=JPRB) :: ZDLO(NFPRGPL_DEP), ZDLO1(NFPRGPL_DEP)
REAL(KIND=JPRB) :: ZDLO2(NFPRGPL_DEP), ZDLO3(NFPRGPL_DEP)

INTEGER(KIND=JPIM) :: IBINL

REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "suhow1.intfb.h"
#include "suhow2.intfb.h"
#include "suehow1.intfb.h"
#include "suehow2.intfb.h"

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

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

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

! 1. Compute adresses & linear weights
!    ---------------------------------

IF (LFPOSBUF) THEN
  IF (LQUAD) THEN
    IBINL=0
  ELSE
    IBINL=1
  ENDIF
  ALLOCATE(MLAT(NFPRGPL_DEP),MLON(NFPRGPL_DEP),MLOS(NFPRGPL_DEP))
  ! allocated anyway because they are dummies:
  ALLOCATE(MLONN(NFPRGPL_DEP),MLOSS(NFPRGPL_DEP))
  IF (LALLOPR) THEN
    WRITE(NULOUT,9990) 'MLAT     ',SIZE(MLAT),SHAPE(MLAT)
    WRITE(NULOUT,9990) 'MLON     ',SIZE(MLON),SHAPE(MLON)
    WRITE(NULOUT,9990) 'MLOS     ',SIZE(MLOS),SHAPE(MLOS)
    WRITE(NULOUT,9990) 'MLONN    ',SIZE(MLONN),SHAPE(MLONN)
    WRITE(NULOUT,9990) 'MLOSS    ',SIZE(MLOSS),SHAPE(MLOSS)
  ENDIF
  IF (LELAM) THEN
    CALL SUEHOW1(NDGLG,NDGSAFPH,NDGENFPH,NFRSTLOFF,RPI,&
     & NLOENG(NDGSAFPH+NFRSTLOFF),IBINL,RFPLA_DEP,RFPLO_DEP,NFPRGPL_DEP,EDELX,EDELY,1,&
     & NDLUXG,1,NDGUXG,MLAT,MLON,MLONN,MLOS,MLOSS,ZDLAT,ZDLO,ZDLO1,ZDLO2,ZDLO3)
  ELSE
    CALL SUHOW1(NDGSAFPH,NDGENFPH,NFRSTLOFF,R4JP,RPI,&
     & NLOENG(NDGSAFPH+NFRSTLOFF),RLATIG(NDGSAFPH+NFRSTLOFF),IBINL,RFPLA_DEP,&
     & RFPLO_DEP,NFPRGPL_DEP,MLAT,MLON,MLONN,MLOS,MLOSS,ZDLAT,ZDLO,ZDLO1,ZDLO2,ZDLO3)
  ENDIF
ENDIF


! 3. Compute weights without mask
!    ----------------------------

! 3.1 For quadratic interpolations

IF (LWSTD12) THEN
  IBINL=12
  ALLOCATE(WSTD12(NFPRGPL_DEP,IBINL))
  IF (LALLOPR) THEN
    WRITE(NULOUT,9990) 'WSTD12   ',SIZE(WSTD12),SHAPE(WSTD12)
  ENDIF
  IF (LELAM) THEN
    CALL SUEHOW2(NDGLG,NDGSAFPH,NDGENFPH,NFRSTLOFF,IBINL,NFPRGPL_DEP,MLAT,&
     & ZDLAT,ZDLO,ZDLO1,ZDLO2,ZDLO3,EDELY,WSTD12)  
  ELSE
    CALL SUHOW2(NDGSAFPH,NDGENFPH,NFRSTLOFF,RLATIG(NDGSAFPH+NFRSTLOFF),&
     & IBINL,NFPRGPL_DEP,MLAT,ZDLAT,ZDLO,ZDLO1,ZDLO2,ZDLO3,WSTD12)  
  ENDIF
ENDIF

! 3.2 For bilinear interpolations

IF (LWSTD04) THEN
  IBINL=4
  ALLOCATE(WSTD04(NFPRGPL_DEP,IBINL))
  IF (LALLOPR) THEN
    WRITE(NULOUT,9990) 'WSTD04   ',SIZE(WSTD04),SHAPE(WSTD04)
  ENDIF
  IF (LELAM) THEN
    CALL SUEHOW2(NDGLG,NDGSAFPH,NDGENFPH,NFRSTLOFF,IBINL,NFPRGPL_DEP,MLAT,&
     & ZDLAT,ZDLO,ZDLO1,ZDLO2,ZDLO3,EDELY,WSTD04)  
  ELSE
    CALL SUHOW2(NDGSAFPH,NDGENFPH,NFRSTLOFF,RLATIG(NDGSAFPH+NFRSTLOFF),&
     & IBINL,NFPRGPL_DEP,MLAT,ZDLAT,ZDLO,ZDLO1,ZDLO2,ZDLO3,WSTD04)  
  ENDIF
ENDIF


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

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

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