SUBROUTINE LASSIEAD(KST,KPROF,PRCORI,PGMV,PGMVS,PGFL,&
 & PSDIV0,PTOD0,PGAGT0L,PGAGT0M,PGMV5,PGFL5,PSDIV5,PTOD5)  

!**** *LASSIEAD* Semi-Lagrangian scheme.  (adjoint version)
!                Computation of linear terms used in the semi-implicit scheme. 

!     Purpose.
!     --------
!        Computation of linear terms used in the semi-implicit scheme:
!        Nabla(Gamma*T+Mu*Pi), (Tau*D) and (Nu*D).

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

!        Explicit arguments :
!        --------------------

!        INPUT:
!          KST      - first element of work.
!          KPROF    - depth of work.
!          PRCORI   - Coriolis parameter.

!        INPUT/OUTPUT (INPUT IN TL):
!          PGMV     - GMV variables at t-dt and t.
!          PGMVS    - GMVS variables at t-dt and t.
!          PGFL     - unified_treatment grid-point (GFL) fields.
!          PSDIV0   - semi-implicit term at time t for continuity equation
!                     (Nu*D).
!          PTOD0    - semi-implicit term at time t for temperature equation
!                     (Tau*D).
!          PGAGT0L  - semi-implicit term at time t for U-wind equation
!                     (zonal component of Nabla(Gamma*T+Mu*Pi)).
!          PGAGT0M  - semi-implicit term at time t for V-wind equation
!                     (meridian component of Nabla(Gamma*T+Mu*Pi)).

!        TRAJECTORY INPUT:
!          PGMV5    - trajectory for PGMV.
!          PGFL5    - trajectory for PGFL.

!        TRAJECTORY OUTPUT:
!          PSDIV5   - semi-implicit term at time t for continuity equation
!                     (Nu*D).  (trajectory)
!          PTOD5    - semi-implicit term at time t for temperature equation
!                     (Tau*D). (trajectory)

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

!     Method.
!     -------
!        See documentation

!     Externals.
!     ----------
!           Called by LACDYNAD.

!     Reference.
!     ----------
!             Arpege documentation about semi-lagrangian scheme.

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

!     Modifications.
!     --------------
!     Original : 99/10/04
!     Modified 01-01-23 by C. Temperton: case LSPRT=.T. corrected.
!     Modified by A. Untch 2000-12 : Vertical finite element scheme
!     Modified 02-01-22 by C. Temperton: case LSPRT=.T. 
!     M.Hamrud      01-Oct-2003 CY28 Cleaning
!     M.Jidane 09-04-2006 : Compute R with q variables under key
!     K. Yessad Aug 2008: rationalisation of dummy argument interfaces
!     ------------------------------------------------------------------

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

USE YOMCST   , ONLY : RD       ,RV
USE YOMCT0   , ONLY : LTWOTL   ,LSPRT
USE YOMDIM   , ONLY : NPROMA   ,NFLEVG
USE YOMDYN   , ONLY : LIMPF    ,LDRY_ECMWF
USE YOMGMV   , ONLY : NDIMGMV  ,NDIMGMVS ,YT0      ,YT5
USE YOM_YGFL , ONLY : YGFL     ,YQ

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

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KST 
INTEGER(KIND=JPIM),INTENT(IN)    :: KPROF 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRCORI(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(INOUT) :: PSDIV0(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTOD0(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGAGT0L(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGAGT0M(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGMV5(NPROMA,NFLEVG,YT5%NDIM)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGFL5(NPROMA,NFLEVG,YGFL%NDIM5)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSDIV5(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTOD5(NPROMA,NFLEVG) 

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

REAL(KIND=JPRB) :: ZR0  (NPROMA,NFLEVG)
REAL(KIND=JPRB) :: ZR5  (NPROMA,NFLEVG)
INTEGER(KIND=JPIM) :: IPROFS, JLEV, JROF

REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "abor1.intfb.h"
#include "sigamad.intfb.h"
#include "sitnu.intfb.h"
#include "sitnuad.intfb.h"

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

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

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

IF (.NOT.LTWOTL) THEN
  CALL ABOR1(' LASSIEAD: CALLED WITH LTWOTL=.F.')
ENDIF

IPROFS=KPROF-KST+1

!     * Add semi-implicit Coriolis terms to Nabla(Gamma*T+Mu*Pi)
!       if required (LIMPF=.T.).

IF (LIMPF) THEN
  DO JLEV=1,NFLEVG
    DO JROF=KST,KPROF
      PGMV(JROF,JLEV,YT0%MU)=PGMV(JROF,JLEV,YT0%MU) &
       & +PRCORI(JROF)*PGAGT0M(JROF,JLEV)
      PGMV(JROF,JLEV,YT0%MV)=PGMV(JROF,JLEV,YT0%MV) &
       & -PRCORI(JROF)*PGAGT0L(JROF,JLEV)
    ENDDO
  ENDDO
ENDIF

!     * Modify (Tau*D) if (LSPRT=.T.) in temperature equation to compensate
!       for later multiplication by R/Rd:

IF (LSPRT) THEN
  CALL SITNU(NPROMA,1,PGMV5(KST,1,YT5%MDIV),PTOD5(KST,1),PSDIV5(KST),IPROFS)
  DO JLEV=1,NFLEVG
    DO JROF=KST,KPROF
      ZR5(JROF,JLEV)=RD+(RV-RD)*PGFL5(JROF,JLEV,YQ%MP5)
    ENDDO
    IF (.NOT. LDRY_ECMWF) THEN
      DO JROF=KST,KPROF
        ZR0(JROF,JLEV)=-RD*PTOD5(JROF,JLEV)*PTOD0(JROF,JLEV)&
         & /(ZR5(JROF,JLEV)**2)  
        PGFL(JROF,JLEV,YQ%MP)=PGFL(JROF,JLEV,YQ%MP)+(RV-RD)*ZR0(JROF,JLEV)
      ENDDO
    ENDIF
    DO JROF=KST,KPROF
      PTOD0(JROF,JLEV)=RD*PTOD0(JROF,JLEV)/ZR5(JROF,JLEV)
    ENDDO
  ENDDO
ENDIF

! * Perturbation
!   - Computation of Nabla(Gamma*T+Mu*Pi) (SI term for momentum equation).
CALL SIGAMAD(NPROMA,1,PGAGT0L(KST,1),PGMV(KST,1,YT0%MTL),PGMVS(KST,YT0%MSPL),&
 & IPROFS)
CALL SIGAMAD(NPROMA,1,PGAGT0M(KST,1),PGMV(KST,1,YT0%MTM),PGMVS(KST,YT0%MSPM),&
 & IPROFS)
!  - Computation of Nu*D (SI term for continuity equation)
!     and Tau*D (SI term for temperature equation).
CALL SITNUAD(NPROMA,1,PGMV(KST,1,YT0%MDIV),PTOD0(KST,1),PSDIV0(KST),IPROFS)

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

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

