SUBROUTINE LAPINEBTL(KST,KPROF,&
 & PCOLON,PSILON,PGM,PGEMU,PGSQM2,PGECLO,PGESLO,&
 & PGNORDL,PGNORDM,PINDX,PINDY,&
 & PB1,PB15,PGMVT1,PGMVT1S,PGFLT1,PB2,&
 ! -----------------------------------------------------------------------
 & PLON,PLAT,PQX,PQY,&
 & PLON5,PLAT5,PQX5,PQY5,&
 ! -----------------------------------------------------------------------
 & KL0,KLH0,PDLO,PCLO,PCLOSLD,&
 & PDLAT,PCLA,PCLASLD,PDVER,PVINTW,PVINTWSLD,&
 & PDLO5,PCLO5,PCLOSLD5,&
 & PDLAT5,PCLA5,PCLASLD5,PDVER5,PVINTW5,PVINTWSLD5,&
 ! -----------------------------------------------------------------------
 & PCOSCO,PSINCO,PCOPHI,PSINLA,&
 & PCOSCO5,PSINCO5,PCOPHI5,PSINLA5)

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

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

USE YOMDIM   , ONLY : NDGUNG   ,NDGUXG   ,NDLUNG   ,NDLUXG   ,NPROMA   ,&
 & NFLEVG   ,NFLSA    ,NFLEN
USE YOMCT0   , ONLY : LRPLANE
USE YOMDYN   , ONLY : NVLAG    ,LADVF    ,L2TLFF  
USE YOMCST   , ONLY : RPI      ,ROMEGA   ,RA
USE YOMGEM   , ONLY : VDELB    ,NSTTYP   ,RMUCEN   ,RLOCEN   ,RSTRET   ,&
 & RC2P1    ,RC2M1    ,VFE_RDETAH  
USE YOMCVER  , ONLY : LVERTFE
USE YOMRIP   , ONLY : RTDT
USE YOEPHY   , ONLY : LEPHYS   ,LAGPHY
USE YOMPHY   , ONLY : LMPHYS
USE YOM_YGFL , ONLY : YGFL     ,YGFLC
USE YEMGEO   , ONLY : EDELX    ,EDELY
USE YOMSC2   , ONLY : NFLDSLB1 ,NFLDSLB15,NFLDSLB2
USE YOMGMV   , ONLY : YT1
USE YOMMP    , ONLY : NASLB1 
USE PTRSLB2  , ONLY : MSLB2U15 ,MSLB2V15

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

!**** *LAPINEBTL* - semi-LAgrangian scheme(Interpolation):
!                                          (tangent-linear version)
!                Interface subroutine for interpolations and lagrangian
!                trends. (Programme INterface d'Ensemble).

!     Purpose.
!     --------
!       Grid point calculations in dynamics.

!       Does the interpolations at the origin point O of the SL-trajectory.
!       Then adds the interpolated quantities of the RHS of equations to
!       yield a provisional value for X(t+dt) for each prognostic variable X.

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

!        Explicit arguments :
!        --------------------
!        INPUT:
!          KST     - first element of arrays where
!                    computations are performed.
!          KPROF   - depth of work.
!          PCOLON  - cos(computational sphere longitude).
!          PSILON  - sin(computational sphere longitude).
!          PGM     - mapping factor.
!          PGEMU   - sin(geographical latitude).
!          PGSQM2  - cos(geographical latitude).
!          PGECLO  - cos(geographical longitude).
!          PGESLO  - sin(geographical longitude).
!          PGNORDL - zonal component of the vector pointed towards the
!                    true North pole.
!          PGNORDM - meridian component of the vector pointed towards the
!                    true North pole.
!          PINDX   - x coordinate on the plane.
!          PINDY   - y coordinate on the plane.
!          PB1     - "SLBUF1" buffer for interpolations.
!          PB15    - "SLBUF1" buffer for interpolations (trajectory).

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

!        INPUT/OUTPUT:
!          PGMVT1  - t+dt GMV (upper air) variables.
!          PGMVT1S - t+dt GMVS (surface) variables.
!          PGFLT1  - t+dt GFL
!          PB2     - "SLBUF2" buffer.

!        OUTPUT:
!          PLON    - computational sphere longitude of interpolation point.
!          PLAT    - computational sphere latitude of interpolation point.
!          PQX     - first element of the wind displacement matrix (pt O).
!          PQY     - second element of the wind displacement matrix (pt O).
! ----------------------- trajectory variables --------------------------
!          PLON5,PLAT5,PQX5,PQY5: cf. PLON,PLAT,PQX,PQY for trajectory.
! -----------------------------------------------------------------------
         
!        ADDITIONAL INPUT (to be re-ordered later like in the direct code):
!          KL0     - index of the four western points
!                    of the 16 points interpolation grid.
!          KLH0    - second value of index of the four western points
!                    of the 16 points interpolation grid if needed.
!          PDLO    - distances for horizontal linear interpolations
!                    in longitude (latitude rows 0, 1, 2, 3)
!          PCLO    - weights for horizontal cubic interpolations in
!                    longitude (latitude rows 1, 2)
!          PCLOSLD - weights for horizontal cubic interpolations in
!                    longitude, SLHD case (latitude rows 1, 2)
!          PDLAT   - distance for horizontal linear interpolations
!                    in latitude
!          PCLA    - weights for horizontal cubic interpolations
!                    in latitude
!          PCLASLD - weights for horizontal cubic interpolations
!                    in latitude, SLHD case
!          PDVER   - distance for vertical linear interpolation
!          PVINTW  - vertical cubic interpolation weights
!          PVINTWSLD-vertical cubic interpolation weights, SLHD case
! ----------------------- trajectory variables --------------------------
!          PDLO5   - distances for horizontal linear interpolations
!                    in longitude (latitude rows 0, 1, 2, 3)
!          PCLO5   - weights for horizontal cubic interpolations in
!                    longitude (latitude rows 1, 2)
!          PCLOSLD5- weights for horizontal cubic interpolations in
!                    longitude, SLHD case (latitude rows 1, 2)
!          PDLAT5  - distance for horizontal linear interpolations
!                    in latitude
!          PCLA5   - weights for horizontal cubic interpolations
!                    in latitude
!          PCLASLD5- weights for horizontal cubic interpolations
!                    in latitude, SLHD case
!          PDVER5  - distance for vertical linear interpolation
!          PVINTW5 - vertical cubic interpolation weights
!          PVINTWSLD5-vertical cubic interpolation weights, SLHD case
! -----------------------------------------------------------------------

!        ADDITIONAL INPUT/OUTPUT (other ones),
!        to be re-ordered later like in the direct code:
!          PCOSCO  - cos(Longitude-Longitude(grid-point))*cos(Latitude)
!                    of the interpolation point (geographical longitude
!                    and latitude).
!                    ! if LDPLANE: x - coordinate (fractional system).
!          PSINCO  - sin(Longitude-Longitude(grid-point))*cos(Latitude)
!                    of the interpolation point (geographical longitude
!                    and latitude).
!                    ! if LDPLANE: y - coordinate (fractional system).
!          PCOPHI  - cosine of the geographical angle between the
!                    interpolation point and the grid-point.
!          PSINLA  - sine of the interpolation point geographical latitude.
! ----------------------- trajectory variables --------------------------
!          PCOSCO5 - cos(Longitude-Longitude(grid-point))*cos(Latitude)
!                    of the interpolation point (geographical longitude
!                    and latitude).
!                    ! if LDPLANE: x - coordinate (fractional system).
!          PSINCO5 - sin(Longitude-Longitude(grid-point))*cos(Latitude)
!                    of the interpolation point (geographical longitude
!                    and latitude).
!                    ! if LDPLANE: y - coordinate (fractional system).
!          PSINLA5 - sine of the interpolation point geographical latitude.
!          PCOPHI5 - cosine of the geographical angle between the
!                    interpolation point and the grid-point.
! -----------------------------------------------------------------------

!        Implicit arguments :
!        --------------------

!     Method.
!     -------

!     Externals.
!     ----------
!      Called by CALL_SL_TL.

!     Reference.
!     ----------
!        ARPEGE documentation about semi-Lagrangian scheme.

!     Author.
!     -------
!        C. Temperton (ECMWF)

!     Modifications.
!     --------------
!   Original : 99/07/13
!   Modified 00-02-07 by C. Temperton: removed redundant use of PDP0
!                                           when NVLAG=3 (contained zero!)
!   Modified August 2000 by Deborah Salmond to split into _traj and _int
!   Modified 00-11-06 by C. Temperton: bugfix for ozone advection.
!   Modified 00-11-23 by C. Temperton: renamed _TRAJ and _INT routines.
!   Modified 01-08-30 by K. YESSAD: pruning and some other cleanings.
!   R. El Khatib : 01-08-07 Pruning options
!   Modified 2000-12  by A. Untch: vertical finite element scheme
!   M.Hamrud      01-Oct-2003 CY28 Cleaning
!   D.Salmond     22-Dec-2003 Karim's Larcin cleaning
!   Modified 05-01-19 by C. Temperton: cleaning.
!   F.Vana        01-Jun-2006 LRPLANE=.T.
!   N. Wedi and K. Yessad (Jan 2008): different dev for NH model and PC scheme
!   F. Vana       30-Jun-2008 Weights driven interpolation
!   K. Yessad Nov 2008: rationalisation of dummy argument interfaces
!     ------------------------------------------------------------------

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KST 
INTEGER(KIND=JPIM),INTENT(IN)    :: KPROF 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLON(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSILON(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGM(NPROMA)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGEMU(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGSQM2(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGECLO(NPROMA)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGESLO(NPROMA)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGNORDL(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGNORDM(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PINDX(NPROMA)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PINDY(NPROMA)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PB1(NASLB1,NFLDSLB1)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PB15(NASLB1,NFLDSLB15)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGMVT1(NPROMA,NFLEVG,YT1%NDIM) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGMVT1S(NPROMA,YT1%NDIMS) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGFLT1(NPROMA,NFLEVG,YGFL%NDIM1) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PB2(NPROMA,NFLDSLB2)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLON(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLAT(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQX(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQY(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLON5(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLAT5(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQX5(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQY5(NPROMA,NFLEVG) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KL0(NPROMA,NFLEVG,0:3) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLH0(NPROMA,NFLEVG,0:3) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDLO(NPROMA,NFLEVG,0:3) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLO(NPROMA,NFLEVG,3,2) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLOSLD(NPROMA,NFLEVG,3,2)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDLAT(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLA(NPROMA,NFLEVG,3) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLASLD(NPROMA,NFLEVG,3) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDVER(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVINTW(NPROMA,NFLEVG,3) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVINTWSLD(NPROMA,NFLEVG,3) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDLO5(NPROMA,NFLEVG,0:3) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLO5(NPROMA,NFLEVG,3,2) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLOSLD5(NPROMA,NFLEVG,3,2)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDLAT5(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLA5(NPROMA,NFLEVG,3) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLASLD5(NPROMA,NFLEVG,3) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDVER5(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVINTW5(NPROMA,NFLEVG,3) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVINTWSLD5(NPROMA,NFLEVG,3) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCOSCO(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSINCO(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCOPHI(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSINLA(NPROMA,NFLEVG) 
! The following arrays correspond to the final iteration
! of the algorithm to find the departure point:
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCOSCO5(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSINCO5(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCOPHI5(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSINLA5(NPROMA,NFLEVG) 

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

! - interpolated quantities arrays.
REAL(KIND=JPRB) :: ZUZ9(NPROMA,NFLEVG)
REAL(KIND=JPRB) :: ZVZ9(NPROMA,NFLEVG)
REAL(KIND=JPRB) :: ZUZ95(NPROMA,NFLEVG)
REAL(KIND=JPRB) :: ZVZ95(NPROMA,NFLEVG)
REAL(KIND=JPRB) :: ZSPT1(NPROMA,NFLEVG)
REAL(KIND=JPRB) :: ZSPTO(NPROMA,NFLEVG+1)
REAL(KIND=JPRB) :: ZDP9(NPROMA,NFLEVG)
REAL(KIND=JPRB) :: ZU9(NPROMA,NFLEVG)
REAL(KIND=JPRB) :: ZV9(NPROMA,NFLEVG)
REAL(KIND=JPRB) :: ZT9(NPROMA,NFLEVG)
REAL(KIND=JPRB) :: ZGFL9(NPROMA,NFLEVG,YGFL%NUMFLDS)
REAL(KIND=JPRB) :: ZC9(NPROMA,NFLEVG)
REAL(KIND=JPRB) :: ZU95(NPROMA,NFLEVG)
REAL(KIND=JPRB) :: ZV95(NPROMA,NFLEVG)
REAL(KIND=JPRB) :: ZGMDTX(NPROMA)
REAL(KIND=JPRB) :: ZGMDTY(NPROMA)
REAL(KIND=JPRB) :: ZINEZV(NPROMA)

INTEGER(KIND=JPIM) :: JLEV, JROF,JGFL

LOGICAL :: LL2TLFFO
LOGICAL :: LLCOMPUTE_OMVAK_O, LLVERCOR, LLADVFW

REAL(KIND=JPRB) :: ZCOPHI, ZDEPI, &
 & ZDSTRET, ZPHI, &
 & ZPP, ZPP1, ZPP9, ZQQ, ZQQ1, ZQQ9, ZSINX, &
 & ZUT1, ZVT1, &
 & ZCOPHI5, ZPHI5, ZPP5, ZPP95, ZQQ5, ZQQ95, &
 & ZSINX5, ZUT15, ZVT15, ZDLUN, ZDLUX, ZDGUN, ZDGUX, &
 & ZTXO, ZTYO, ZTXO5, ZTYO5
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "laconetl.intfb.h"
#include "larcinbtl.intfb.h"
#include "elarchetl.intfb.h"
#include "larchetl.intfb.h"
#include "verint.intfb.h"

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

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

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

!*       1.    PRELIMINARY ALLOCATIONS AND INITIALISATIONS:
!              -------------------------------------------

ZDEPI  =2.0_JPRB*RPI

ZDSTRET=2.0_JPRB*RSTRET

LL2TLFFO=L2TLFF.AND.(LMPHYS.OR.LEPHYS).AND.(.NOT.LAGPHY)

IF(LRPLANE) THEN
  ZDLUN=REAL(NDLUNG,JPRB)
  ZDLUX=REAL(NDLUXG,JPRB)
  ZDGUN=REAL(NDGUNG,JPRB)
  ZDGUX=REAL(NDGUXG,JPRB)
  DO JROF = KST, KPROF
    ZGMDTX (JROF)=0.5_JPRB*PGM(JROF)*RTDT/EDELX
    ZGMDTY (JROF)=0.5_JPRB*PGM(JROF)*RTDT/EDELY
    ZINEZV(JROF)=MAX(0.0_JPRB,SIGN(1.0_JPRB,(PINDX(JROF)-ZDLUN)*&
     & (ZDLUX-PINDX(JROF))))*&
     & MAX(0.0_JPRB,SIGN(1.0_JPRB,(PINDY(JROF)-ZDGUN)*(ZDGUX-PINDY(JROF))))
  ENDDO
! * Retrieve the origin point coordinates from LAPINEA
!   for "2 Omega vectorial a k" recalculation.
  PLON5(KST:KPROF,:)=PSINLA5(KST:KPROF,:)
  PLAT5(KST:KPROF,:)=PCOPHI5(KST:KPROF,:)
  PLON(KST:KPROF,:) =PSINLA(KST:KPROF,:)
  PLAT(KST:KPROF,:) =PCOPHI(KST:KPROF,:)
ENDIF


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

!*       2.    INTERPOLATIONS AT THE ORIGIN POINT
!              ----------------------------------

CALL LARCINBTL(KST,KPROF,LL2TLFFO,KL0,KLH0,&
 & PDLO,PCLO,PCLOSLD,PDLAT,PCLA,PCLASLD,PDVER,PVINTW,PVINTWSLD,PB1,PB15,&
 & ZDP9,ZU9,ZV9,ZT9,ZGFL9,ZC9,ZUZ9,ZVZ9,&
 & ZU95,ZV95,ZUZ95,ZVZ95,&
 & PDLO5,PCLO5,PCLOSLD5,PDLAT5,PCLA5,PCLASLD5,PDVER5,PVINTW5,PVINTWSLD5)

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

!*       3.    ADD QUANTITIES INTERPOLATED AT THE ORIGIN POINT
!              TO ARRAYS P(X)T1 FOR CONTINUITY EQUATION.
!              -----------------------------------------------

IF (NVLAG == 2.OR.NVLAG == 3) THEN

  IF(LVERTFE) THEN
    DO JLEV=1,NFLEVG
      ZSPT1(KST:KPROF,JLEV)=VDELB(JLEV)*VFE_RDETAH(JLEV)&
       & *(ZDP9(KST:KPROF,JLEV)+ZC9(KST:KPROF,JLEV))  
    ENDDO
    CALL VERINT(NPROMA,KST,KPROF,NFLEVG,ZSPT1,ZSPTO,0)
    DO JROF=KST,KPROF
      PGMVT1S(JROF,YT1%MSP)=PGMVT1S(JROF,YT1%MSP)+ZSPTO(JROF,NFLEVG+1)
    ENDDO
  ELSE
    DO JLEV=1,NFLEVG
      DO JROF=KST,KPROF
        PGMVT1S(JROF,YT1%MSP)=PGMVT1S(JROF,YT1%MSP) &
         & +VDELB(JLEV)*(ZDP9(JROF,JLEV)+ZC9(JROF,JLEV))
      ENDDO
    ENDDO
  ENDIF

ENDIF

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

!*       4.    ADD QUANTITIES INTERPOLATED AT THE ORIGIN
!              POINTS TO ARRAYS P(X)T1 FOR EQUATIONS OTHER THAN
!              CONTINUITY EQUATION.
!              ----------------------------------------------------

!        4.1   ADD CONTRIBUTIONS.

DO JLEV=1,NFLEVG
  DO JROF=KST,KPROF
    ZPP5=PQX5(JROF,JLEV)*PGNORDM(JROF)-PQY5(JROF,JLEV)*PGNORDL(JROF)
    ZQQ5=PQY5(JROF,JLEV)*PGNORDM(JROF)+PQX5(JROF,JLEV)*PGNORDL(JROF)
    ZPP=PQX(JROF,JLEV)*PGNORDM(JROF)-PQY(JROF,JLEV)*PGNORDL(JROF)
    ZQQ=PQY(JROF,JLEV)*PGNORDM(JROF)+PQX(JROF,JLEV)*PGNORDL(JROF)
    IF (LADVF.AND.L2TLFF) THEN
      PB2(JROF,MSLB2U15-1+JLEV)=PB2(JROF,MSLB2U15-1+JLEV)&
       & +ZPP5*ZU95(JROF,JLEV)+ZQQ5*ZV95(JROF,JLEV)  
      PB2(JROF,MSLB2V15-1+JLEV)=PB2(JROF,MSLB2V15-1+JLEV)&
       & -ZQQ5*ZU95(JROF,JLEV)+ZPP5*ZV95(JROF,JLEV)  
    ENDIF
    PGMVT1(JROF,JLEV,YT1%MU)=PGMVT1(JROF,JLEV,YT1%MU)&
     & +ZPP*ZU95(JROF,JLEV)+ZQQ*ZV95(JROF,JLEV)&
     & +ZPP5*ZU9(JROF,JLEV)+ZQQ5*ZV9(JROF,JLEV)  
    PGMVT1(JROF,JLEV,YT1%MV)=PGMVT1(JROF,JLEV,YT1%MV)&
     & -ZQQ*ZU95(JROF,JLEV)+ZPP*ZV95(JROF,JLEV)&
     & -ZQQ5*ZU9(JROF,JLEV)+ZPP5*ZV9(JROF,JLEV)  
  ENDDO
ENDDO

DO JLEV=1,NFLEVG
  DO JROF=KST,KPROF
    PGMVT1(JROF,JLEV,YT1%MT)=PGMVT1(JROF,JLEV,YT1%MT)+ZT9(JROF,JLEV)
  ENDDO
ENDDO

DO JGFL=1,YGFL%NUMFLDS
  IF(YGFLC(JGFL)%LADV) THEN
    DO JLEV=1,NFLEVG
      DO JROF=KST,KPROF
        PGFLT1(JROF,JLEV,YGFLC(JGFL)%MP1) =PGFLT1(JROF,JLEV,YGFLC(JGFL)%MP1)+&
         & ZGFL9(JROF,JLEV,JGFL)  
      ENDDO
    ENDDO
  ENDIF
ENDDO

!        4.2   SPECIAL TREATMENT OF CORIOLIS TERM.

! * Relaxation of thin layer hypothesis is currently not coded in TL code.
LLVERCOR=.FALSE.
LLADVFW=.FALSE.

LLCOMPUTE_OMVAK_O= &
 & (((.NOT.LLVERCOR).AND.LADVF).OR.(LLVERCOR.AND.(LADVF.OR.LLADVFW)))  

IF (LLCOMPUTE_OMVAK_O) THEN
! * Analytical computation of "2 Omega wedge a k" at "O":
  IF (LRPLANE) THEN
!   * calculation of LACONE done already in ELARCHE -> results are in
!     zlon, zlat tables.
    ZU95(KST:KPROF,1:NFLEVG)=PLON5(KST:KPROF,1:NFLEVG)
    ZV95(KST:KPROF,1:NFLEVG)=PLAT5(KST:KPROF,1:NFLEVG)
    ZU9(KST:KPROF,1:NFLEVG)=PLON(KST:KPROF,1:NFLEVG)
    ZV9(KST:KPROF,1:NFLEVG)=PLAT(KST:KPROF,1:NFLEVG)
  ELSE
    CALL LACONETL(NPROMA,KST,KPROF,NFLEVG,NSTTYP,&
     & ROMEGA,ZDSTRET,RC2M1,RC2P1,RMUCEN,RA,RPI,&
     & PLON5,PLAT5,ZU95,ZV95,PLON,PLAT,ZU9,ZV9)  
  ENDIF
ENDIF

! * Replace "2 Omega wedge a k" by "2 Omega wedge rs k" or
!   "2 Omega wedge (rs-a) k" according to LADVF:
!   case LVERCOR.AND.LADVFW only ==> TL not yet coded.

IF (LLCOMPUTE_OMVAK_O) THEN
! * Add the content of "pu9,pv9" to "pgmvt1(U,V)" (+ trajectory):
  DO JLEV=1,NFLEVG
    DO JROF=KST,KPROF
      ZPP5=PQX5(JROF,JLEV)*PGNORDM(JROF)-PQY5(JROF,JLEV)*PGNORDL(JROF)
      ZQQ5=PQY5(JROF,JLEV)*PGNORDM(JROF)+PQX5(JROF,JLEV)*PGNORDL(JROF)
      ZPP=PQX(JROF,JLEV)*PGNORDM(JROF)-PQY(JROF,JLEV)*PGNORDL(JROF)
      ZQQ=PQY(JROF,JLEV)*PGNORDM(JROF)+PQX(JROF,JLEV)*PGNORDL(JROF)
      IF (L2TLFF) THEN
        PB2(JROF,MSLB2U15-1+JLEV)=PB2(JROF,MSLB2U15-1+JLEV)&
         & +ZPP5*ZU95(JROF,JLEV)+ZQQ5*ZV95(JROF,JLEV)  
        PB2(JROF,MSLB2V15-1+JLEV)=PB2(JROF,MSLB2V15-1+JLEV)&
         & -ZQQ5*ZU95(JROF,JLEV)+ZPP5*ZV95(JROF,JLEV)  
      ENDIF
      PGMVT1(JROF,JLEV,YT1%MU)=PGMVT1(JROF,JLEV,YT1%MU)&
       & +ZPP*ZU95(JROF,JLEV)+ZQQ*ZV95(JROF,JLEV)&
       & +ZPP5*ZU9(JROF,JLEV)+ZQQ5*ZV9(JROF,JLEV)  
      PGMVT1(JROF,JLEV,YT1%MV)=PGMVT1(JROF,JLEV,YT1%MV)&
       & -ZQQ*ZU95(JROF,JLEV)+ZPP*ZV95(JROF,JLEV)&
       & -ZQQ5*ZU9(JROF,JLEV)+ZPP5*ZV9(JROF,JLEV)  
    ENDDO
  ENDDO
ENDIF

!        4.3   ADD CORIOLIS TERM AT "F" WHEN NOT DONE IN ROUTINE "LATTEX"

! * Involves the cases of lvercor=.true. when "rs/a" is needed at t+dt.
!   In this case work cannot be done in routine "LATTEX" because
!   at this stage of calculations "rs/a"(t+dt) is not yet available.
!   ==> TL not yet coded.

!        4.4   SPECIAL TREATMENT OF CORIOLIS TERM:
!              CASE "L2TLFF=T".

! * Refined calculation of the origin point.
!   Refined treatment of Coriolis term in 2TL scheme (or in 3TL SLI scheme).
!   Works for the following configurations:
!    - LVERCOR=.F.
!    - 3TL SLI scheme, LADVF=.T. or 2TL SL scheme, LADVF=.T.
!    - NWLAG=3.
!    - RW2TLFF=1. (RW2TLFF in ]0,1[ not coded in TL code).

IF (L2TLFF) THEN

  IF (LRPLANE) THEN
!   * compute new origin point:
    DO JLEV=1,NFLEVG
      DO JROF=KST,KPROF
!       * old rotation and vector deplacement:
        ZPP5=PQX5(JROF,JLEV)*PGNORDM(JROF)-PQY5(JROF,JLEV)*PGNORDL(JROF)
        ZQQ5=PQY5(JROF,JLEV)*PGNORDM(JROF)+PQX5(JROF,JLEV)*PGNORDL(JROF)
        ZPP=PQX(JROF,JLEV)*PGNORDM(JROF)-PQY(JROF,JLEV)*PGNORDL(JROF)
        ZQQ=PQY(JROF,JLEV)*PGNORDM(JROF)+PQX(JROF,JLEV)*PGNORDL(JROF)
!       * new estimate of trajectory (a/rs)*wind:
!         at this stage (pgmvt1(U,V)) contains wind;
!         (puf,pvf) and (zuz9,zvz9) contain (a/rs)*wind.
        ZUT15=0.5_JPRB*(PB2(JROF,MSLB2U15-1+JLEV) + ZUZ95(JROF,JLEV))
        ZVT15=0.5_JPRB*(PB2(JROF,MSLB2V15-1+JLEV) + ZVZ95(JROF,JLEV))
        ZUT1=0.5_JPRB*(PGMVT1(JROF,JLEV,YT1%MU) + ZUZ9(JROF,JLEV))
        ZVT1=0.5_JPRB*(PGMVT1(JROF,JLEV,YT1%MV) + ZVZ9(JROF,JLEV))
!       * subtract old estimate of advected Coriolis term:
!         ("2 Omega wedge a k", "2 Omega wedge (rs-a) k"
!         or "2 Omega wedge rs k" evaluated at O
!         according to the value of (LVERCOR,LADVF,LADVFW)). 
        PB2(JROF,MSLB2U15-1+JLEV)=PB2(JROF,MSLB2U15-1+JLEV)&
         & -ZPP5*ZU95(JROF,JLEV)-ZQQ5*ZV95(JROF,JLEV)  
        PB2(JROF,MSLB2V15-1+JLEV)=PB2(JROF,MSLB2V15-1+JLEV)&
         & +ZQQ5*ZU95(JROF,JLEV)-ZPP5*ZV95(JROF,JLEV)  
        PGMVT1(JROF,JLEV,YT1%MU)=PGMVT1(JROF,JLEV,YT1%MU)&
         & -ZPP*ZU95(JROF,JLEV)-ZQQ*ZV95(JROF,JLEV)&
         & -ZPP5*ZU9(JROF,JLEV)-ZQQ5*ZV9(JROF,JLEV)  
        PGMVT1(JROF,JLEV,YT1%MV)=PGMVT1(JROF,JLEV,YT1%MV)&
         & +ZQQ*ZU95(JROF,JLEV)-ZPP*ZV95(JROF,JLEV)&
         & +ZQQ5*ZU9(JROF,JLEV)-ZPP5*ZV9(JROF,JLEV)  
!       * compute the new origin point ON:
        ZTXO5=PINDX(JROF)-2.0_JPRB*ZUT15*ZGMDTX(JROF)
        ZTYO5=PINDY(JROF)-2.0_JPRB*ZVT15*ZGMDTY(JROF)
        ZTXO=-2.0_JPRB*ZUT1*ZGMDTX(JROF)
        ZTYO=-2.0_JPRB*ZVT1*ZGMDTY(JROF)
        PLON5(JROF,JLEV)=ZTXO5*ZINEZV(JROF)+PINDX(JROF)*(1.0_JPRB-ZINEZV(JROF))
        PLAT5(JROF,JLEV)=ZTYO5*ZINEZV(JROF)+PINDY(JROF)*(1.0_JPRB-ZINEZV(JROF))
        PLON(JROF,JLEV)=ZTXO*ZINEZV(JROF)
        PLAT(JROF,JLEV)=ZTYO*ZINEZV(JROF)
        IF((ZTXO5 > ZDLUN).OR.(ZTXO5 < ZDLUX)) ZTXO=0.0_JPRB
        IF((ZTYO5 > ZDGUN).OR.(ZTYO5 < ZDGUX)) ZTYO=0.0_JPRB
        ZTXO5=MIN(MAX(ZTXO5,ZDLUN),ZDLUX)
        ZTYO5=MIN(MAX(ZTYO5,ZDGUN),ZDGUX)
        PCOSCO5(JROF,JLEV)=ZTXO5*ZINEZV(JROF)+PINDX(JROF)*(1.0_JPRB-ZINEZV(JROF))
        PSINCO5(JROF,JLEV)=ZTYO5*ZINEZV(JROF)+PINDY(JROF)*(1.0_JPRB-ZINEZV(JROF))
        PCOSCO(JROF,JLEV)=ZTXO*ZINEZV(JROF)
        PSINCO(JROF,JLEV)=ZTYO*ZINEZV(JROF)
      ENDDO
    ENDDO
!   * compute rotation matrix and Coriolis term "2 Omega wedge a k"
!     at the new origin point ON.
    CALL ELARCHETL(NPROMA,KST,KPROF,NFLEVG,&
     & PGEMU,PGSQM2,PGECLO,PGESLO,&
     & PCOSCO,PSINCO,PQX,PQY,PLON,PLAT,&
     & PCOSCO5,PSINCO5,PQX5,PQY5,PLON5,PLAT5)  
    ZU95(KST:KPROF,1:NFLEVG)=PLON5(KST:KPROF,1:NFLEVG)
    ZV95(KST:KPROF,1:NFLEVG)=PLAT5(KST:KPROF,1:NFLEVG)
    ZU9(KST:KPROF,1:NFLEVG)=PLON(KST:KPROF,1:NFLEVG)
    ZV9(KST:KPROF,1:NFLEVG)=PLAT(KST:KPROF,1:NFLEVG)
!   * add new estimate of advected Coriolis term:
    DO JLEV=1,NFLEVG
      DO JROF=KST,KPROF
        ZPP5=PQX5(JROF,JLEV)*PGNORDM(JROF)-PQY5(JROF,JLEV)*PGNORDL(JROF)
        ZQQ5=PQY5(JROF,JLEV)*PGNORDM(JROF)+PQX5(JROF,JLEV)*PGNORDL(JROF)
        ZPP=PQX(JROF,JLEV)*PGNORDM(JROF)-PQY(JROF,JLEV)*PGNORDL(JROF)
        ZQQ=PQY(JROF,JLEV)*PGNORDM(JROF)+PQX(JROF,JLEV)*PGNORDL(JROF)
        PB2(JROF,MSLB2U15-1+JLEV)=PB2(JROF,MSLB2U15-1+JLEV)&
         & +ZPP5*ZU95(JROF,JLEV)+ZQQ5*ZV95(JROF,JLEV)  
        PB2(JROF,MSLB2V15-1+JLEV)=PB2(JROF,MSLB2V15-1+JLEV)&
         & -ZQQ5*ZU95(JROF,JLEV)+ZPP5*ZV95(JROF,JLEV)  
        PGMVT1(JROF,JLEV,YT1%MU)=PGMVT1(JROF,JLEV,YT1%MU)&
         & +ZPP*ZU95(JROF,JLEV)+ZQQ*ZV95(JROF,JLEV)&
         & +ZPP5*ZU9(JROF,JLEV)+ZQQ5*ZV9(JROF,JLEV)  
        PGMVT1(JROF,JLEV,YT1%MV)=PGMVT1(JROF,JLEV,YT1%MV)&
         & -ZQQ*ZU95(JROF,JLEV)+ZPP*ZV95(JROF,JLEV)&
         & -ZQQ5*ZU9(JROF,JLEV)+ZPP5*ZV9(JROF,JLEV)  
      ENDDO
    ENDDO

  ELSE

!   * compute new origin point:
    DO JLEV=1,NFLEVG
      DO JROF=KST,KPROF
!       * old rotation and vector deplacement:
        ZPP5=PQX5(JROF,JLEV)*PGNORDM(JROF)-PQY5(JROF,JLEV)*PGNORDL(JROF)
        ZQQ5=PQY5(JROF,JLEV)*PGNORDM(JROF)+PQX5(JROF,JLEV)*PGNORDL(JROF)
        ZPP95=PQX5(JROF,JLEV)
        ZQQ95=PQY5(JROF,JLEV)
        ZPP=PQX(JROF,JLEV)*PGNORDM(JROF)-PQY(JROF,JLEV)*PGNORDL(JROF)
        ZQQ=PQY(JROF,JLEV)*PGNORDM(JROF)+PQX(JROF,JLEV)*PGNORDL(JROF)
        ZPP9=PQX(JROF,JLEV)
        ZQQ9=PQY(JROF,JLEV)
        ZPP1=PGNORDM(JROF)
        ZQQ1=-PGNORDL(JROF)
!       * new estimate of trajectory wind:
        ZUT15=0.5_JPRB*(&
         & ZPP1*PB2(JROF,MSLB2U15-1+JLEV)+ZQQ1*PB2(JROF,MSLB2V15-1+JLEV)&
         & +ZPP95*ZUZ95(JROF,JLEV)+ZQQ95*ZVZ95(JROF,JLEV))  
        ZVT15=0.5_JPRB*(&
         & -ZQQ1*PB2(JROF,MSLB2U15-1+JLEV)+ZPP1*PB2(JROF,MSLB2V15-1+JLEV)&
         & -ZQQ95*ZUZ95(JROF,JLEV)+ZPP95*ZVZ95(JROF,JLEV))  
        ZUT1=0.5_JPRB*(&
         & ZPP1*PGMVT1(JROF,JLEV,YT1%MU)+ZQQ1*PGMVT1(JROF,JLEV,YT1%MV)&
         & +ZPP9*ZUZ95(JROF,JLEV)+ZQQ9*ZVZ95(JROF,JLEV)&
         & +ZPP95*ZUZ9(JROF,JLEV)+ZQQ95*ZVZ9(JROF,JLEV))  
        ZVT1=0.5_JPRB*(&
         & -ZQQ1*PGMVT1(JROF,JLEV,YT1%MU)+ZPP1*PGMVT1(JROF,JLEV,YT1%MV)&
         & -ZQQ9*ZUZ95(JROF,JLEV)+ZPP9*ZVZ95(JROF,JLEV)&
         & -ZQQ95*ZUZ9(JROF,JLEV)+ZPP95*ZVZ9(JROF,JLEV))  
!       * subtract old estimate of advected Coriolis term:
        PGMVT1(JROF,JLEV,YT1%MU)=PGMVT1(JROF,JLEV,YT1%MU)&
         & -ZPP*ZU95(JROF,JLEV)-ZQQ*ZV95(JROF,JLEV)&
         & -ZPP5*ZU9(JROF,JLEV)-ZQQ5*ZV9(JROF,JLEV)  
        PGMVT1(JROF,JLEV,YT1%MV)=PGMVT1(JROF,JLEV,YT1%MV)&
         & +ZQQ*ZU95(JROF,JLEV)-ZPP*ZV95(JROF,JLEV)&
         & +ZQQ5*ZU9(JROF,JLEV)-ZPP5*ZV9(JROF,JLEV)  
!       * compute new origin point:
        ZPHI5=0.5_JPRB*RTDT*SQRT(ZUT15*ZUT15+ZVT15*ZVT15)/RA
        ZCOPHI5=1.0_JPRB-0.5_JPRB*ZPHI5*ZPHI5
        ZSINX5=ZCOPHI5*RTDT*(1.0_JPRB-ZPHI5*ZPHI5/6.0_JPRB)/RA
        PSINLA5(JROF,JLEV)=PGEMU(JROF)*(2.0_JPRB*ZCOPHI5*ZCOPHI5-1.0_JPRB)&
         & -ZVT15*PGSQM2(JROF)*ZSINX5  
        PCOSCO5(JROF,JLEV)=PGSQM2(JROF)*(2.0_JPRB*ZCOPHI5*ZCOPHI5-1.0_JPRB)&
         & +ZVT15*PGEMU(JROF)*ZSINX5  
        PSINCO5(JROF,JLEV)=-ZUT15*ZSINX5
        PCOPHI5(JROF,JLEV)=2.0_JPRB*ZCOPHI5*ZCOPHI5-1.0_JPRB
        ZPHI=0.5_JPRB*RTDT*(ZUT1*ZUT15+ZVT1*ZVT15)&
         & /(RA*SQRT(ZUT15*ZUT15+ZVT15*ZVT15))  
        ZCOPHI=-ZPHI*ZPHI5
        ZSINX=RTDT*(ZCOPHI*(1.0_JPRB-ZPHI5*ZPHI5/6.0_JPRB)&
         & -ZCOPHI5*ZPHI*ZPHI5/3.0_JPRB)/RA  
        PSINLA(JROF,JLEV)=PGEMU(JROF)*4.0_JPRB*ZCOPHI*ZCOPHI5&
         & -PGSQM2(JROF)*(ZVT1*ZSINX5+ZVT15*ZSINX)  
        PCOSCO(JROF,JLEV)=PGSQM2(JROF)*4.0_JPRB*ZCOPHI*ZCOPHI5&
         & +PGEMU(JROF)*(ZVT1*ZSINX5+ZVT15*ZSINX)  
        PSINCO(JROF,JLEV)=-ZUT1*ZSINX5-ZUT15*ZSINX
        PCOPHI(JROF,JLEV)=4.0_JPRB*ZCOPHI*ZCOPHI5
      ENDDO
    ENDDO
!   * compute rotation matrix and Coriolis term at the new origin point.
    CALL LARCHETL(NPROMA,KST,KPROF,NFLEVG,NSTTYP,ZDSTRET,&
     & RC2M1,RC2P1,RPI,ZDEPI,RLOCEN,RMUCEN,&
     & PCOLON,PSILON,PGEMU,PGSQM2,PGECLO,PGESLO,&
     & PCOSCO,PSINCO,PSINLA,PCOPHI,&
     & PCOSCO5,PSINCO5,PSINLA5,PCOPHI5,1,&
     & PLON,PLAT,PQX,PQY,PLON5,PLAT5,PQX5,PQY5)  
    CALL LACONETL(NPROMA,KST,KPROF,NFLEVG,NSTTYP,&
     & ROMEGA,ZDSTRET,RC2M1,RC2P1,RMUCEN,RA,RPI,&
     & PLON5,PLAT5,ZU95,ZV95,PLON,PLAT,ZU9,ZV9)  
!   * add new estimate of advected Coriolis term:
    DO JLEV=1,NFLEVG
      DO JROF=KST,KPROF
        ZPP5=PQX5(JROF,JLEV)*PGNORDM(JROF)-PQY5(JROF,JLEV)*PGNORDL(JROF)
        ZQQ5=PQY5(JROF,JLEV)*PGNORDM(JROF)+PQX5(JROF,JLEV)*PGNORDL(JROF)
        ZPP=PQX(JROF,JLEV)*PGNORDM(JROF)-PQY(JROF,JLEV)*PGNORDL(JROF)
        ZQQ=PQY(JROF,JLEV)*PGNORDM(JROF)+PQX(JROF,JLEV)*PGNORDL(JROF)
        PGMVT1(JROF,JLEV,YT1%MU)=PGMVT1(JROF,JLEV,YT1%MU)&
         & +ZPP*ZU95(JROF,JLEV)+ZQQ*ZV95(JROF,JLEV)&
         & +ZPP5*ZU9(JROF,JLEV)+ZQQ5*ZV9(JROF,JLEV)  
        PGMVT1(JROF,JLEV,YT1%MV)=PGMVT1(JROF,JLEV,YT1%MV)&
         & -ZQQ*ZU95(JROF,JLEV)+ZPP*ZV95(JROF,JLEV)&
         & -ZQQ5*ZU9(JROF,JLEV)+ZPP5*ZV9(JROF,JLEV)  
      ENDDO
    ENDDO

  ENDIF

ENDIF

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

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