SUBROUTINE LAPINEAAD(KST,KPROF,KSTGLO,&
 & PCOLON,PSILON,PGM,PGEMU,PGSQM2,PGECLO,PGESLO,&
 & PGNORDL,PGNORDM,PINDX,PINDY,&
 & PINC,KINC,KDIM1,KDIM2,&
! -----------------------------------------------------------------------
 & PB1,PB2,PB15,&
! -----------------------------------------------------------------------
 & PLON,PLAT,PR,PS,&
 & PLON5,PLAT5,PR5,PS5,&
! -----------------------------------------------------------------------
 & KL0,PDLO,PCLO,PCLOSLD,PDLAT,PCLA,PCLASLD,PDVER,PVINTW,PVINTWSLD,&
 & PDLO5,PDLAT5,PDVER5,&
! -----------------------------------------------------------------------
 & PCOSCO,PSINCO,PCOPHI,PSINLA,PLEV,&
 & PCOSCO5,PSINCO5,PCOPHI5,PSINLA5,PLEV5,&
! -----------------------------------------------------------------------
 & PUF5,PVF5,POUT5,KLOCK)  

!**** *LAPINEAAD* - semi-LAgrangian scheme:(Interpolation - Part A)
!                                               (adjoint version)
!                Interface subroutine for interpolations and lagrangian
!                trends. (Programme INterface d'Ensemble).

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

!           Computes the semi-Lagrangian trajectory.
!           Computes the weights ready for interpolations at origin point.

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

!        Explicit arguments :
!        --------------------
!          KST     - first element of arrays where computations are performed.
!          KPROF   - depth of work.
!          KSTGLO  - global offset into nproma buffer.
!          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.
!          KDIM1,KDIM2 - dimensions of KINC, PINC
!          KINC    - addresses of interpolation increments in global buffer
!          PINC    - interpolation increments to global buffer (vector only)
!          PB1     - SLBUF1-buffer for interpolations.
!          PB2     - SLBUF2-buf to communicate info from non lag. to lag. dyn.
!          PB15    - SLBUF1-buf traj for interpolations.

!          PLON    - computational sphere longitude of interpolation point.
!          PLAT    - computational sphere latitude of interpolation point.
!          PR      - first element of the wind displacement matrix for O.
!          PS      - second element of the wind displacement matrix for O.
!          PLON5   - cf. PLON (trajectory)
!          PLAT5   - cf. PLAT (trajectory)
!          PR5     - cf. PR (trajectory, in)
!          PS5     - cf. PS (trajectory, in)
!          KL0     - index of the four western points
!                    of the 16 points interpolation grid.
!          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   - distances for vertical linear interpolation
!                    on a same vertical.
!          PVINTW  - Vertical cubic interpolation weights.
!          PVINTWSLD - vertical cubic interpolation weights, SLHD case
!          PDLO5   - cf. PDLO (trajectory)
!          PDLAT5  - cf. PDLAT (trajectory)
!          PDVER5  - cf. PDVER (trajectory)
!          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.
!          PLEV    - vertical coordinate of the interpolation point.
!          PCOSCO5 - cf. PCOSCO (trajectory)
!          PSINCO5 - cf. PSINCO (trajectory)
!          PCOPHI5 - cf. PCOPHI (trajectory)
!          PSINLA5 - cf. PSINLA (trajectory)
!          PLEV5   - cf. PLEV (trajectory)
!          PUF5    - interpolated U-wind (trajectory)
!          PVF5    - interpolated V-wind (trajectory)
!          POUT5   - indicator of O point of the SL trajectory (for LAM only).
!                    If O lays inside the domain, the value is zero.
!          KLOCK   - ??? (used for OpenMP purposes).

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

!     Method.
!     -------

!     Externals.    
!     ----------     
!       See includes below.
!       Called by CALL_SL_AD.

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

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

! Modifications (list from LAPINEAD)
! -------------
!   Original : 99/10/15
!   Modified 00-02-07 by C. Temperton: removed redundant use of PDP0
!                                      when NVLAG=3 (contained zero!)
!   Modified 00-02-09 by C. Temperton: added PCL0 and PCL05 in call to
!                   LAINORAD (for improved vectorization in LARCINAD)
!                                      - also added NVSEP.
!   Modified 00-06-15 by C. Temperton: NVSEP -> NVSEPC,NVSEPL. 
!   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 2000-12  by A. Untch: vertical finite element scheme
!   Modified Oct 2000 by M. Szczech: no LADVAMV test for ozon 
!   Modified Jul 2001 by K. YESSAD: update dummy arguments of LAINOR.
!   Modified 01-08-30 by K. YESSAD: pruning and some other cleanings.
!   R. El Khatib : 01-08-07 Pruning options
!   01-Oct-2003 M. Hamrud  CY28 Cleaning
!   16-Jun-2004 J. Masek   NH cleaning (LPC_NOTR)
!   Modified 05-01-11 by C. Temperton: streamlining.
!   Modified 05-02-02 by C. Temperton: transfer computations from
!                            end of LAIDEPAD to start of LARMESAD.
!   D.Salmond     08-Feb-2005 New LAPINEAAD
!   K. Yessad     07-Sep-2005 Now calls directly LARCINAAD
!   Modified 21-06-2006 by F. Vana: LRPLANE=.T.
!   F. Vana       08-Jan-2007 KDEP for vectorized (LAM) adjoint
!   N. Wedi and K. Yessad (Jan 2008): different dev for NH model and PC scheme
!   F. Vana       14-Aug-2008 Weights driven interpolation + optimization.
!   K. Yessad Nov 2008: rationalisation of dummy argument interfaces
!   F. Vana :     11-Dec-2008 OpenMP for vector platforms
!   F. Vana     13-Jan-2009: TL/AD of SLHD
!------------------------------------------------------------------------------

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

USE YOMDIM   , ONLY : NDGSAG   ,NDGSAL   ,NDGENG   ,NDGENL   ,NDGUNG   ,&
 & NDGUXG   ,NDLUNG   ,NDLUXG   ,NFLEVG   ,NDGSAH   ,&
 & NDGENH   ,NRLEVX   ,NPROMA   ,NFLSA    ,NFLEN
USE YOMCT0   , ONLY : LRPLANE
USE YOMDYNA  , ONLY : LSLHD    ,LSLHDQUAD
USE YOMDYN   , ONLY : NITMP    ,VETAON   ,VETAOX   ,LSETTLST ,LELTRA   ,LADVF 
USE YOMCST   , ONLY : RPI
USE YOMGEM   , ONLY : NLOENG
USE YEMGEO   , ONLY : EDELX    ,EDELY
USE YOMRIP   , ONLY : RTDT
USE YOMSC2   , ONLY : NSLWIDE  ,NFLDSLB1 ,NFLDSLB2 ,NFLDSLB15
USE YOMMP    , ONLY : NSLOFF   ,NFRSTLOFF,NASLB1
USE YOMSEP   , ONLY : NVSEPC   ,NVSEPL
USE PTRSLB1  , ONLY : MSLB1UR9 ,MSLB1VR9
USE PTRSLB15 , ONLY : MSLB1UR95,MSLB1VR95
USE PTRSLB2  , ONLY : MSLB2KAPPA,MSLB2KAPPA5

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

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KST 
INTEGER(KIND=JPIM),INTENT(IN)    :: KPROF 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTGLO 
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) 
INTEGER(KIND=JPIM),INTENT(OUT)   :: KINC(KDIM1,KDIM2,NITMP)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PINC(KDIM1,KDIM2,NITMP)
INTEGER(KIND=JPIM),INTENT(IN)    :: KDIM1
INTEGER(KIND=JPIM),INTENT(IN)    :: KDIM2
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PB1(NASLB1,NFLDSLB1)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PB2(NPROMA,NFLDSLB2)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PB15(NASLB1,NFLDSLB15) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PLON(NPROMA,NFLEVG)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PLAT(NPROMA,NFLEVG)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PR(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PS(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLON5(NPROMA,NFLEVG,NITMP)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLAT5(NPROMA,NFLEVG,NITMP)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PR5(NPROMA,NFLEVG,NITMP) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PS5(NPROMA,NFLEVG,NITMP) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KL0(NPROMA,NFLEVG,0:3,NITMP) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PDLO(NPROMA,NFLEVG,0:3) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCLO(NPROMA,NFLEVG,3,2)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCLOSLD(NPROMA,NFLEVG,3,2)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PDLAT(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCLA(NPROMA,NFLEVG,3) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCLASLD(NPROMA,NFLEVG,3) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PDVER(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVINTW(NPROMA,NFLEVG,3) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVINTWSLD(NPROMA,NFLEVG,3) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PDLO5(NPROMA,NFLEVG,0:3,NITMP) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PDLAT5(NPROMA,NFLEVG,NITMP) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PDVER5(NPROMA,NFLEVG,NITMP) 
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)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLEV(NPROMA,NFLEVG)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCOSCO5(NPROMA,NFLEVG,NITMP) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSINCO5(NPROMA,NFLEVG,NITMP) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCOPHI5(NPROMA,NFLEVG,NITMP) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSINLA5(NPROMA,NFLEVG,NITMP) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLEV5(NPROMA,NFLEVG,NITMP) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PUF5(NPROMA,NFLEVG,NITMP-1)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVF5(NPROMA,NFLEVG,NITMP-1)
REAL(KIND=JPRB)   ,INTENT(IN)    :: POUT5(NPROMA,NFLEVG,NITMP)
INTEGER(KIND=JPIM),INTENT(INOUT) :: KLOCK(:) 

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

REAL(KIND=JPRB) :: ZLSDEPI(NDGSAH:NDGENH)

REAL(KIND=JPRB) :: ZGMDTX(NPROMA)
REAL(KIND=JPRB) :: ZGMDTY(NPROMA)

INTEGER(KIND=JPIM) :: ISTALAT(NDGSAH:NDGENH)
INTEGER(KIND=JPIM) :: IGLGLO, JGL, JROF, JLEV
INTEGER(KIND=JPIM) :: ITIP, IDIM, IROT, IL0(1,1,0:3)

LOGICAL :: LLSETTLST
LOGICAL :: LLOCK_UP

REAL(KIND=JPRB) :: ZDEPI

REAL(KIND=JPRB) :: ZUF0(1),ZVF0(1),ZWF0(1),ZWRL0(1),ZWRL05(1)
REAL(KIND=JPRB) :: ZDLO5(1,1,0:3),ZDLAT5(1,1),ZDVER5(1,1)

REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "larcinaad.intfb.h"
#include "larmesad.intfb.h"
#include "elarmesad.intfb.h"

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

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

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

!*       1.    PRELIMINARY INITIALISATIONS:

ZDEPI=2.0_JPRB*RPI
DO JGL=MAX(NDGSAG,NDGSAL+NFRSTLOFF-NSLWIDE)-NFRSTLOFF,&
   & MIN(NDGENG,NDGENL+NFRSTLOFF+NSLWIDE)-NFRSTLOFF  
  IGLGLO=JGL+NFRSTLOFF
  ZLSDEPI(JGL)=REAL(NLOENG(IGLGLO),JPRB)/ZDEPI
ENDDO

IF(LRPLANE) THEN
  ZGMDTX (KST:KPROF)=0.5_JPRB*PGM(KST:KPROF)*RTDT/EDELX
  ZGMDTY (KST:KPROF)=0.5_JPRB*PGM(KST:KPROF)*RTDT/EDELY
ENDIF

DO JGL=MAX(NDGSAH,LBOUND(NSLOFF,1)),MIN(NDGENH,UBOUND(NSLOFF,1))
  ISTALAT(JGL)=NSLOFF(JGL)
ENDDO

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

!*       3.    COMPUTATION OF WEIGHTS AND INDICES ARRAYS FOR INTERPOLATIONS.
!              -------------------------------------------------------------

IF (LRPLANE) THEN
! * Use PSINLA and PCOPHI to transfer origin point coordinates from LAPINEA5
!   before they are overwritten by "2 Omega vectorial a k". The perturbations
!   are stored there in LARCINB in order to be consistent with the NL code.
  IF(LADVF) THEN
    PLON5(KST:KPROF,1:NFLEVG,NITMP)=PSINLA5(KST:KPROF,1:NFLEVG,NITMP)
    PLAT5(KST:KPROF,1:NFLEVG,NITMP)=PCOPHI5(KST:KPROF,1:NFLEVG,NITMP)
    DO JLEV=1,NFLEVG
      DO JROF=KST,KPROF
        PLON(JROF,JLEV)=PSINLA(JROF,JLEV)
        PLAT(JROF,JLEV)=PCOPHI(JROF,JLEV)
        PSINLA(JROF,JLEV)=0.0_JPRB
        PCOPHI(JROF,JLEV)=0.0_JPRB
      ENDDO
    ENDDO
  ENDIF
ENDIF

IROT=1
IDIM=1
LLOCK_UP=.FALSE.
ITIP=3

! * Remark: IL0,ZDLO5,ZDLAT5,ZDVER5,ZWRL0,ZWRL05,ZUF0,ZVF0,ZWF0
!   are not used in this call of LARCINAAD.

CALL LARCINAAD(IDIM,KSTGLO,KST,KPROF,&
 & ISTALAT,LSLHD,LSLHDQUAD,ITIP,IROT,LRPLANE,LLOCK_UP,ZLSDEPI,&
 & PCOLON,PSILON,PGEMU,PGSQM2,PGECLO,PGESLO,&
 & PCOSCO,PSINCO,PSINLA,PCOPHI,PLEV,&
 & PCOSCO5(1,1,NITMP),PSINCO5(1,1,NITMP),&
 & PSINLA5(1,1,NITMP),PCOPHI5(1,1,NITMP),PLEV5(1,1,NITMP),&
 & PB2(1,MSLB2KAPPA),PB2(1,MSLB2KAPPA5),&
 & PB1(1,MSLB1UR9),PB1(1,MSLB1VR9),ZWRL0,&
 & PB15(1,MSLB1UR95),PB15(1,MSLB1VR95),ZWRL05,&
 & NVSEPC,NVSEPL,KLOCK,&
 & PINC(1,1,NITMP),KINC(1,1,NITMP),KDIM1,KDIM2,&
 & PLON,PLAT,PR,PS,&
 & ZUF0,ZVF0,ZWF0,&
 & PLON5(1,1,NITMP),PLAT5(1,1,NITMP),&
 & IL0,PDLO,PCLO,PCLOSLD,PDLAT,PCLA,PCLASLD,PDVER,PVINTW,PVINTWSLD,&
 & ZDLO5,ZDLAT5,ZDVER5)

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

!*       2.    COMPUTATION OF THE SL TRAJECTORY.
!              ---------------------------------

LLSETTLST=LSETTLST.AND.(.NOT.LELTRA)
IF (LRPLANE) THEN

  CALL ELARMESAD(KSTGLO,KST,KPROF,ISTALAT,LLSETTLST,&
   & PINDX,PINDY,ZGMDTX,ZGMDTY,PB1,PB15,PB2,&
   & PINC,KINC,KDIM1,KDIM2,&
   & ZLSDEPI,PCOLON,PSILON,PGEMU,PGSQM2,PGECLO,PGESLO,&
   & PLON,PLAT,PCOSCO,PSINCO,PSINLA,PCOPHI,PLEV,KL0,KLOCK,&
   & PLON5,PLAT5,PCOSCO5,PSINCO5,PSINLA5,PCOPHI5,PLEV5,&
   & PDLO5,PDLAT5,PDVER5,POUT5)

ELSE

  CALL LARMESAD(KSTGLO,KST,KPROF,ISTALAT,LLSETTLST,PB1,PB15,PB2,&
   & PINC,KINC,KDIM1,KDIM2,&
   & ZLSDEPI,PCOLON,PSILON,PGEMU,PGSQM2,PGECLO,PGESLO,PGNORDL,PGNORDM,&
   & PLON,PLAT,PCOSCO,PSINCO,PSINLA,PCOPHI,PLEV,KL0,KLOCK,&
   & PLON5,PLAT5,PCOSCO5,PSINCO5,PSINLA5,PCOPHI5,PLEV5,PR5,PS5,PUF5,PVF5,&
   & PDLO5,PDLAT5,PDVER5)  

ENDIF

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

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