SUBROUTINE COBSTL(KSTART,KPROF,KSTGLO,KPROFE,&
 & PGNORDL,PGNORDM,PGM,POROG,PRCORI,&
 & PGMV,PGMVS,PGFL,PPARITY,PB1)  

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

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

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

!     Author.
!     -------
!        F. Bouttier *ECMWF*

!     Modifications.
!     --------------
!      Original     95-12-05 : according to cobs (Hamrud,Vasiljevic,Casse)
!      L. Isaksen   96-02-20 : NFLEV --> NFLEVG
!      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.
!      P.Moll       99-08-03 : implementation of achmt in cy21t1
!      P.Viterbo    99-09-01 : Surface tiles
!      R. El Khatib : 01-08-07 Pruning options
!     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
!        Y.Tremolet    18-Mar-2004 Option for model bias
!     K. Yessad (Dec 2008): remove dummy CDLOCK + cleanings
!     H. Hersbach(Dec 2009): Introduce perturbations in surface fields (neutral wind),
!                            Introduce argument PPARITY
!    -------------------------------------------------------------------

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 YOMPHY   , ONLY : LSOLV    
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)    :: PGNORDL(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGNORDM(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGM(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: POROG(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRCORI(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGMV(NPROMA,NFLEVG,NDIMGMV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGMVS(NPROMA,NDIMGMVS) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGFL(NPROMA,NFLEVG,YGFL%NDIM) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PPARITY(NFLDOBB1) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PB1(NASLB1,NFLDOBB1) 

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

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

INTEGER(KIND=JPIM) :: IBLK, IEND, IENDC, &
 & ILEVT, ILEVU, ILEVV, &
 & IOBB1AL, IOBB1ARG,  &
 & IOBB1CO, IOBB1DL, IOBB1DM, IOBB1EM, IOBB1HV, &
 & IOBB1LS, IOBB1OR, IOBB1PRS, IOBB1PRW, &
 & IOBB1SAB, IOBB1SN, IOBB1SP, IOBB1T, &
 & IOBB1TS, IOBB1U, IOBB1V, IOBB1VG, &
 & IOBB1CI, IOBB1CVH, IOBB1CVL, IOBB1TVH, IOBB1TVL, &
 & IOBB1U10N,IOBB1V10N,&
 & IOBB1WL, IOBB1UCU, IOBB1VCU, IOBB1CHN,&
 & IOBB1WS, IOBB1Z0, IOBB1Z0H, IOBBUF1, IST, ISTC, JLEV, JROF,IROF, &
 & ISTF,JFLD, JGFL,IOBB1GFL,ILEVGFL
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

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

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


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

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

!*       2.1   PREPARE MAPPING FACTOR

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
IOBB1OR = IOBB1V10N+ 1
IOBB1CO = IOBB1OR  + 1
IOBB1DL = IOBB1CO  + 1
IOBB1DM = IOBB1DL  + 1
IOBB1AL = IOBB1DM  + 1
IOBB1EM = IOBB1AL  + 1
IOBB1LS = IOBB1EM  + 1
IF (LECMWF) THEN
  IOBB1CI  = IOBB1LS  + 1
  IOBB1UCU = IOBB1CI  + 1
  IOBB1VCU = IOBB1UCU + 1
  IOBB1CHN = IOBB1VCU + 1
  IOBB1CVH = IOBB1CHN + 1
  IOBB1CVL = IOBB1CVH + 1
  IOBB1TVH = IOBB1CVL + 1
  IOBB1TVL = IOBB1TVH + 1
  IOBB1VG = IOBB1TVL
ELSE
  IOBB1VG = IOBB1LS  + 1
ENDIF
IOBB1PRW= IOBB1VG  + 1
IOBB1PRS= IOBB1PRW + 1
IF ( LSOLV ) THEN
  IOBB1ARG= IOBB1PRS + 1
  IOBB1SAB= IOBB1ARG + 1
  IOBB1HV = IOBB1SAB + 1
  IOBB1Z0H= IOBB1HV  + 1
ENDIF

!    -------------------------------------------------------------------
!*       3.    FILL OBBUFFERS.
!              ---------------

DO JROF = IST , IEND
  IROF = NSLCORE(KSTGLO+JROF-1)
  ISLCORE(JROF)=IROF
ENDDO
!*       3.0   PRESET PB1
!                 Preset PB1 in case not all fields are filled to
!                 avoid floating point errors in subsequent code
ISTF=1+(3+NGOMGFL)*NFLEVG+1
DO JFLD = ISTF , NFLDOBB1
  DO JROF = IST , IEND
    IROF = ISLCORE(JROF)
    PB1(IROF,JFLD) = 0.0_JPRB
  ENDDO
ENDDO

!*       3.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
 !OCL NOVREC
  DO JROF = IST , IEND
    IROF = ISLCORE(JROF)
    PB1(IROF,ILEVU) = PGMV (JROF,JLEV,YT0%MU) * PGM(JROF)
    PB1(IROF,ILEVV) = PGMV (JROF,JLEV,YT0%MV) * PGM(JROF)

    IF(NFTHER /= 0) THEN
      PB1(IROF,ILEVT) = PGMV(JROF,JLEV,YT0%MT)
    ELSE
      PB1(IROF,ILEVT) = 0.0_JPRB
    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)
      PB1(IROF,ILEVGFL) = PGFL(JROF,JLEV,YGOMGFL(JGFL)%MPMDL)
    ENDDO
  ENDDO
ENDDO

!*       3.2   SURFACE PRESSURE

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

!*       3.3   PHYSICAL AND CONSTANT FIELDS

!       Orography & Coriolis factor are constants
!     WARNING here we put their TRAJECTORY values because there is no
!     clean separation between traj/pert arrays in SLINT for those fields
!OCL NOVREC
DO JROF = IST , IEND
  IROF = ISLCORE(JROF)
  PB1(IROF,IOBB1OR) = POROG(JROF)
  PB1(IROF,IOBB1CO) = PRCORI(JROF)
  PB1(IROF,IOBB1DL) = PGNORDL(JROF)
  PB1(IROF,IOBB1DM) = PGNORDM(JROF)
ENDDO

!*       3.4   READ SURFACE FIELD PERTURBATIONS

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

!*     4. FILL PARITY ATTRIBUTE (1 FOR SCALAR, -1 FOR VECTOR FIELD)

IF (KSTGLO==1) THEN
   PPARITY(1:NFLDOBB1)=1
   PPARITY(IOBB1U:IOBB1U+NFLEVG-1)=-1
   PPARITY(IOBB1V:IOBB1V+NFLEVG-1)=-1
   PPARITY(IOBB1U10N)=-1
   PPARITY(IOBB1V10N)=-1
   IF(LECMWF) THEN
      PPARITY(IOBB1UCU)=-1
      PPARITY(IOBB1VCU)=-1
   ENDIF
ENDIF


!    -------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('COBSTL',1,ZHOOK_HANDLE)
END SUBROUTINE COBSTL
