SUBROUTINE COBSAD(KSTART,KPROF,KSTGLO,KPROFE,PGM,&
 & PGMV,PGMVS,PGFL,PB1)  

!**** *COBSAD* - PREPARATION FOR HORIZONTAL INTERPOLATION AT OBS. POINTS

!     Interface.
!     ----------
!        *CALL* *COBSAD(...)

!        Explicit arguments :
!        --------------------
!        PB1       : fields buffer for horiz interpolation at obs points

!     Author.
!     -------
!        Mats Hamrud and Drasko Vasiljevic  *ECMWF*

!     Modifications.
!     --------------
!        Original   : 92-03-31
!     F.Bouttier  92-12-01 : Securities for small models
!     V.Casse     93-05    : cleaning and use of GT1 and GPP for CANAR
!     M.Hamrud    95-03-01 : (F90 re-write)
!     V.Casse     96-12    : interpolation in the model geometry
!     L. Isaksen  96-02-20 : Adapted for Message Passing
!     E.Andersson 97-11-17 : Introduce CIW and O3
!     E.Holm      98-01-05 : Include logical switch LSPO3 for ozone
!     Modified 98-08-10 by K. YESSAD: removal of LRPOLE option.
!       - removal of LRPOLE in YOMCT0.
!       - removal of code under LRPOLE.
!       - use routine INIPEX.
!     C. Fischer   03-06-03 : add kprofe for LAM/Jo gridpoint scan
!     M.Hamrud    03-08-01 : GFL introduction
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!     K. Yessad (Dec 2008): remove dummy CDLOCK + cleanings
!     H. Hersbach (Dec 2009): Introduce surface perturbations (10m-neutral wind)
!    -------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMDIM   , ONLY : NFLEVG   ,NFTHER   ,NPROMA   
USE YOMCT0B  , ONLY : LECMWF
USE YOMSC2   , ONLY : NFLDOBB1
USE SURFACE_FIELDS_MIX, ONLY : &
 & SD_VD, YSD_VD
USE YOMMP    , ONLY : NSLCORE  ,NASLB1
USE YOMGMV   , ONLY : NDIMGMV  ,NDIMGMVS ,YT0
USE YOM_YGFL , ONLY : YGFL
USE GOMS_MIX     , ONLY : NGOMGFL,YGOMGFL

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

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KSTART 
INTEGER(KIND=JPIM),INTENT(IN)    :: KPROF 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTGLO 
INTEGER(KIND=JPIM),INTENT(IN)    :: KPROFE 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGM(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGMV(NPROMA,NFLEVG,NDIMGMV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGMVS(NPROMA,NDIMGMVS) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGFL(NPROMA,NFLEVG,YGFL%NDIM) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PB1(NASLB1,NFLDOBB1) 

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

INTEGER(KIND=JPIM) :: ISLCORE(KPROF)

INTEGER(KIND=JPIM) :: IBLK, IEND, IENDC, &
 & ILEVT, ILEVU, ILEVV, &
 & IOBB1GFL, JGFL, ILEVGFL, &
 & IOBB1SP, IOBB1T, IOBB1U, IOBB1V, IOBBUF1, &
 & IOBB1TS, IOBB1WS,IOBB1SN,IOBB1Z0,IOBB1WL, &
 & IOBB1U10N,IOBB1V10N, &
 & IPCT, IST, ISTC, JLEV, JROF,IROF

REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

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

!    -------------------------------------------------------------------
!*       1.    SET-UP.
!              ------

IPCT = 1
IST   = KSTART
IEND  = KPROF
ISTC  = KSTART
IENDC = KPROFE

!    -------------------------------------------------------------------
!*       2.    Interface to global arrays.
!              --------------------------

IOBBUF1 = 1
IOBB1U  = IOBBUF1
IOBB1V  = IOBB1U   +NFLEVG
IOBB1T  = IOBB1V   +NFLEVG
IOBB1GFL  = IOBB1T + NFLEVG
IOBB1SP = IOBB1GFL + NFLEVG*NGOMGFL
IOBB1TS = IOBB1SP  + 1
IOBB1WS = IOBB1TS  + 1
IOBB1SN = IOBB1WS  + 1
IOBB1Z0 = IOBB1SN  + 1
IOBB1WL = IOBB1Z0  + 1
IOBB1U10N=IOBB1WL  + 1
IOBB1V10N=IOBB1U10N+ 1

!        2.3.0 INITIALIZE SURFACE FIELDS

!ZGP(:,:)=_ZERO_

!    -------------------------------------------------------------------
!*       4.    FILL OBBUFFERS.
!              --------------

DO JROF = IST , IEND
  IROF = NSLCORE(KSTGLO+JROF-1)
  ISLCORE(JROF)=IROF
ENDDO

!*       4.1   COPY
!              WIND : MAP FACTOR (V.Casse)
!              T and Q : if exist
!              WC and CC : if exist

DO JLEV = 1 , NFLEVG
  ILEVU   = IOBB1U  + JLEV-1
  ILEVV   = IOBB1V  + JLEV-1
  ILEVT   = IOBB1T  + JLEV-1
  DO JROF = IST , IEND
    IROF = ISLCORE(JROF)
    PGMV(JROF,JLEV,YT0%MU) = PGMV(JROF,JLEV,YT0%MU)+PB1(IROF,ILEVU)*PGM(JROF)
    PGMV(JROF,JLEV,YT0%MV) = PGMV(JROF,JLEV,YT0%MV)+PB1(IROF,ILEVV)*PGM(JROF)

    IF(NFTHER /= 0) THEN
      PGMV(JROF,JLEV,YT0%MT) = PGMV(JROF,JLEV,YT0%MT)+PB1(IROF,ILEVT)
    ENDIF
  ENDDO
ENDDO

DO JGFL=1,NGOMGFL
  DO JLEV = 1 , NFLEVG
    ILEVGFL = IOBB1GFL+(JGFL-1)*NFLEVG+JLEV-1
    DO JROF = IST , IEND
      IROF = ISLCORE(JROF)
      PGFL(JROF,JLEV,YGOMGFL(JGFL)%MPMDL)  = PGFL(JROF,JLEV,YGOMGFL(JGFL)%MPMDL) + &
       & PB1(IROF,ILEVGFL)
    ENDDO
  ENDDO
ENDDO

!*       4.2   SURFACE PRESSURE

DO JROF = IST , IEND
  IROF = ISLCORE(JROF)
  PGMVS(JROF,YT0%MSP) = PGMVS(JROF,YT0%MSP) + PB1(IROF,IOBB1SP)
ENDDO

!    -------------------------------------------------------------------
!*       4.3   READ SURFACE FIELDS.
!              -------------------

IF (LECMWF) THEN
  IBLK=(KSTGLO-1)/NPROMA+1
  DO JROF = IST , IEND
    IROF = ISLCORE(JROF)
     SD_VD(JROF,YSD_VD%Y10NU%MP,IBLK) = SD_VD(JROF,YSD_VD%Y10NU%MP,IBLK) + &
      & PB1(IROF,IOBB1U10N)
     SD_VD(JROF,YSD_VD%Y10NV%MP,IBLK) = SD_VD(JROF,YSD_VD%Y10NV%MP,IBLK) + &
      & PB1(IROF,IOBB1V10N)
  ENDDO
ENDIF

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

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