SUBROUTINE LANHSI_GEOGW(KST,KPROF,PRCORI,PREDIV,PGMV,PGMVS,PGFL,&
 & PSDIV0,PSDIV9,PTOD0,PTOD9,PGAGT0L,PGAGT0M,PGAGT9L,PGAGT9M,&
 & PSPDS0,PSPDS9,PLPD0,PLPD9)  

!**** *LANHSI_GEOGW*   Semi-Lagrangian scheme.
!                Computation of linear terms used in the semi-implicit scheme. 
!                Phi-gw NH model.

!     Purpose.
!     --------
!        Computation of linear terms used in the semi-implicit scheme
!        for U,V (momentum) equation, T (temperature) equation,
!        ps or ln(ps) (continuity) equation, NH variables equations.
!        Phi-gw NH model.

!        The code under LSPRT and LIMPF is identical to the one of LANHSI.

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

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

!        INPUT:
!          KST      - first element of work.
!          KPROF    - depth of work.
!          PRCORI   - Coriolis parameter.
!          PREDIV   - (c**2)/(M**2).
!          PGMV     - GMV variables at t-dt and t.
!          PGMVS    - GMVS variables at t-dt and t.
!          PGFL     - unified_treatment grid-point fields.

!        OUTPUT:
!          PSDIV0   - semi-implicit term at time t for continuity equation.
!          PSDIV9   - semi-implicit term at time t-dt for continuity equation.
!          PTOD0    - semi-implicit term at time t for temperature equation.
!          PTOD9    - semi-implicit term at time t-dt for temperature equation.
!          PGAGT0L  - semi-implicit term at time t for U-wind equation.
!          PGAGT0M  - semi-implicit term at time t for V-wind equation.
!          PGAGT9L  - semi-implicit term at time t-dt for U-wind equation.
!          PGAGT9M  - semi-implicit term at time t-dt for V-wind equation.
!          PSPDS0   - semi-implicit term at time t for SPD-var equation.
!          PSPDS9   - semi-implicit term at time t-dt for SPD-var equation.
!          PLPD0    - semi-implicit term at time t for SVD-var equation.
!          PLPD9    - semi-implicit term at time t-dt for SVD-var equation.

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

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

!     Externals.
!     ----------
!        Called by LACDYN.

!     Reference.
!     ----------
!        Arpege documentation about semi-Lagrangian scheme (IDSL).
!        Arpege documentation about semi-implicit scheme (IDSI).

!     Author.
!     -------
!        K. YESSAD (METEO FRANCE/CNRM/GMAP) after routine LANHSI

!     Modifications.
!     --------------
!  Original : APRIL 2008.
!  K. Yessad Aug 2008: rationalisation of dummy argument interfaces
!  End Modifications
!     ------------------------------------------------------------------

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

USE YOM_YGFL  ,ONLY : YGFL
USE YOMCST    ,ONLY : RD       ,RG       ,RCVD     ,RCPD
USE YOMCT0    ,ONLY : LSPRT    ,LTWOTL
USE YOMDIM   , ONLY : NPROMA   ,NFLEVG
USE YOMDYN    ,ONLY : LIMPF    ,SITR     ,SITRA
USE YOMGMV   , ONLY : NDIMGMV  ,NDIMGMVS ,YT0      ,YT9
USE YOMCVER   ,ONLY : LVFE_DBCS,LVFE_DBCT,LVFE_DERIB

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

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(IN)    :: PREDIV(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)   :: PSDIV0(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSDIV9(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTOD0(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTOD9(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGAGT0L(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGAGT0M(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGAGT9L(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGAGT9M(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPDS0(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPDS9(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLPD0(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLPD9(NPROMA,NFLEVG) 

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

REAL(KIND=JPRB) :: ZR9  (NPROMA,NFLEVG)
REAL(KIND=JPRB) :: ZSVDT(NPROMA,NFLEVG)
REAL(KIND=JPRB) :: ZTOD(NPROMA,NFLEVG) 
REAL(KIND=JPRB) :: ZW1L(NPROMA,0:NFLEVG+1) 
REAL(KIND=JPRB) :: ZW1M(NPROMA,0:NFLEVG+1) 
REAL(KIND=JPRB) :: ZW2(NPROMA,0:NFLEVG+1) 
REAL(KIND=JPRB) :: ZW3(NPROMA,0:NFLEVG+1) 
REAL(KIND=JPRB) :: ZW4(NPROMA,0:NFLEVG+1) 
REAL(KIND=JPRB) :: ZIN(NPROMA,0:NFLEVG+1) 

REAL(KIND=JPRB) :: ZCOEF,ZCOEG,ZCOEH,ZCOEI,ZCOEJ

INTEGER(KIND=JPIM) :: IPROFS, JLEV, JROF
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "gprcp.intfb.h"
#include "sitnu.intfb.h"
#include "sivderi.intfb.h"

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

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

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

IPROFS=KPROF-KST+1

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

! * Variables at time 0 (SL3TL and SL2TL).

! - Computation of Nu*D and Tau*D, and SI term for continuity equation.
DO JLEV=1,NFLEVG
  DO JROF=KST,KPROF
    ZSVDT(JROF,JLEV)=PGMV(JROF,JLEV,YT0%MSVD)/PREDIV(JROF)
  ENDDO
ENDDO
CALL SITNU(NPROMA,1,PGMV(KST,1,YT0%MDIV),ZTOD(KST,1),PSDIV0(KST),IPROFS)

! - Computation of (sivderi+1)*Phi, (sivderi+1).(sivderi)*Phi,
!   (sivderi+1)*grad(phi), sivderi*(gw), (sivderi+1)*T.
!   Apply the following upper conditions:
!    Phi_top=Phi_(l=1); gw_top=gw_(l=1); T_top=T_(l=1); (vert der)_top=0.
!   Apply the following lower conditions:
!    Phi_surf=Phis; gw_surf=gw_s; T_surf=T_(l=nflevg); (vert der)_surf=0.

! Constant upper BC; lower BC=0.
ZIN(KST:KPROF,1:NFLEVG)=PGMV(KST:KPROF,1:NFLEVG,YT0%MSPD)
ZIN(KST:KPROF,0)=ZIN(KST:KPROF,1)
ZIN(KST:KPROF,NFLEVG+1)=0.0_JPRB
CALL SIVDERI(IPROFS,2,LDVDERIB=LVFE_DERIB,LDBCS=LVFE_DBCS,LDBCT=LVFE_DBCT, &
 & PGPIN=ZIN(KST,0),PGPOUT=ZW2(KST,0))

! Constant upper BC; lower BC=0.
ZIN(KST:KPROF,1:NFLEVG)=PGMV(KST:KPROF,1:NFLEVG,YT0%MSPDL)
ZIN(KST:KPROF,0)=ZIN(KST:KPROF,1)
ZIN(KST:KPROF,NFLEVG+1)=0.0_JPRB
CALL SIVDERI(IPROFS,1,LDVDERIB=LVFE_DERIB,LDBCS=LVFE_DBCS,LDBCT=LVFE_DBCT, &
 & PGPIN=ZIN(KST,0),PGPOUT=ZW1L(KST,0))

! Constant upper BC; lower BC=0.
ZIN(KST:KPROF,1:NFLEVG)=PGMV(KST:KPROF,1:NFLEVG,YT0%MSPDM)
ZIN(KST:KPROF,0)=ZIN(KST:KPROF,1)
ZIN(KST:KPROF,NFLEVG+1)=0.0_JPRB
CALL SIVDERI(IPROFS,1,LDVDERIB=LVFE_DERIB,LDBCS=LVFE_DBCS,LDBCT=LVFE_DBCT, &
 & PGPIN=ZIN(KST,0),PGPOUT=ZW1M(KST,0))

! Constant upper BC; lower BC=0.
ZIN(KST:KPROF,1:NFLEVG)=ZSVDT(KST:KPROF,1:NFLEVG)
ZIN(KST:KPROF,0)=ZIN(KST:KPROF,1)
ZIN(KST:KPROF,NFLEVG+1)=0.0_JPRB
CALL SIVDERI(IPROFS,0,LDVDERIB=LVFE_DERIB,LDBCS=LVFE_DBCS,LDBCT=LVFE_DBCT, &
 & PGPIN=ZIN(KST,0),PGPOUT=ZW3(KST,0))

! Constant upper BC; constant lower BC.
ZIN(KST:KPROF,1:NFLEVG)=PGMV(KST:KPROF,1:NFLEVG,YT0%MT)
ZIN(KST:KPROF,0)=ZIN(KST:KPROF,1)
ZIN(KST:KPROF,NFLEVG+1)=ZIN(KST:KPROF,NFLEVG)
CALL SIVDERI(IPROFS,1,LDVDERIB=LVFE_DERIB,LDBCS=LVFE_DBCS,LDBCT=LVFE_DBCT, &
 & PGPIN=ZIN(KST,0),PGPOUT=ZW4(KST,0))

! - Momentum equation.
DO JLEV=1,NFLEVG
  DO JROF=KST,KPROF
    PGAGT0L(JROF,JLEV)=RD*PGMV(JROF,JLEV,YT0%MTL)+RD*SITR*PGMVS(JROF,YT0%MSPL) &
     & +ZW1L(JROF,JLEV)
    PGAGT0M(JROF,JLEV)=RD*PGMV(JROF,JLEV,YT0%MTM)+RD*SITR*PGMVS(JROF,YT0%MSPM) &
     & +ZW1M(JROF,JLEV)
  ENDDO
ENDDO
! - Temperature equation.
ZCOEF=RD*SITR/RCVD
ZCOEG=1.0_JPRB/(RD*SITRA)
DO JLEV=1,NFLEVG
  DO JROF=KST,KPROF
    PTOD0(JROF,JLEV)=ZCOEF*(PGMV(JROF,JLEV,YT0%MDIV)-ZCOEG*ZW3(JROF,JLEV))
  ENDDO
ENDDO
! - Phi equation.
ZCOEH=RD*SITR
ZCOEI=RCPD/(RD*SITR)
DO JLEV=1,NFLEVG
  DO JROF=KST,KPROF
    PSPDS0(JROF,JLEV)=-ZCOEH*PSDIV0(JROF)+ZCOEH*ZCOEI*ZTOD(JROF,JLEV) &
     & -ZSVDT(JROF,JLEV)
  ENDDO
ENDDO
! - gw equation.
ZCOEJ=RG*RG/(RD*SITRA)
DO JLEV=1,NFLEVG
  DO JROF=KST,KPROF
    PLPD0(JROF,JLEV)=ZCOEJ*(-RD*ZW4(JROF,JLEV)-ZW2(JROF,JLEV))
  ENDDO
ENDDO

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

! * Variables at time 9 (SL3TL only).

IF (.NOT.LTWOTL) THEN

  ! - Computation of Nu*D and Tau*D, and SI term for continuity equation.
  DO JLEV=1,NFLEVG
    DO JROF=KST,KPROF
      ZSVDT(JROF,JLEV)=PGMV(JROF,JLEV,YT9%MSVD)/PREDIV(JROF)
    ENDDO
  ENDDO
  CALL SITNU(NPROMA,1,PGMV(KST,1,YT9%MDIV),ZTOD(KST,1),PSDIV9(KST),IPROFS)

  ! - Computation of (sivderi+1)*Phi, (sivderi+1).(sivderi)*Phi,
  !   (sivderi+1)*grad(phi), sivderi*(gw), (sivderi+1)*T.

  ! Constant upper BC; lower BC=0.
  ZIN(KST:KPROF,1:NFLEVG)=PGMV(KST:KPROF,1:NFLEVG,YT9%MSPD)
  ZIN(KST:KPROF,0)=ZIN(KST:KPROF,1)
  ZIN(KST:KPROF,NFLEVG+1)=0.0_JPRB
  CALL SIVDERI(IPROFS,2,LDVDERIB=LVFE_DERIB,LDBCS=LVFE_DBCS,LDBCT=LVFE_DBCT, &
   & PGPIN=ZIN(KST,0),PGPOUT=ZW2(KST,0))

  ! Constant upper BC; lower BC=0.
  ZIN(KST:KPROF,1:NFLEVG)=PGMV(KST:KPROF,1:NFLEVG,YT9%MSPDL)
  ZIN(KST:KPROF,0)=ZIN(KST:KPROF,1)
  ZIN(KST:KPROF,NFLEVG+1)=0.0_JPRB
  CALL SIVDERI(IPROFS,1,LDVDERIB=LVFE_DERIB,LDBCS=LVFE_DBCS,LDBCT=LVFE_DBCT, &
   & PGPIN=ZIN(KST,0),PGPOUT=ZW1L(KST,0))

  ! Constant upper BC; lower BC=0.
  ZIN(KST:KPROF,1:NFLEVG)=PGMV(KST:KPROF,1:NFLEVG,YT9%MSPDM)
  ZIN(KST:KPROF,0)=ZIN(KST:KPROF,1)
  ZIN(KST:KPROF,NFLEVG+1)=0.0_JPRB
  CALL SIVDERI(IPROFS,1,LDVDERIB=LVFE_DERIB,LDBCS=LVFE_DBCS,LDBCT=LVFE_DBCT, &
   & PGPIN=ZIN(KST,0),PGPOUT=ZW1M(KST,0))

  ! Constant upper BC; lower BC=0.
  ZIN(KST:KPROF,1:NFLEVG)=ZSVDT(KST:KPROF,1:NFLEVG)
  ZIN(KST:KPROF,0)=ZIN(KST:KPROF,1)
  ZIN(KST:KPROF,NFLEVG+1)=0.0_JPRB
  CALL SIVDERI(IPROFS,0,LDVDERIB=LVFE_DERIB,LDBCS=LVFE_DBCS,LDBCT=LVFE_DBCT, &
   & PGPIN=ZIN(KST,0),PGPOUT=ZW3(KST,0))

  ! Constant upper BC; constant lower BC.
  ZIN(KST:KPROF,1:NFLEVG)=PGMV(KST:KPROF,1:NFLEVG,YT9%MT)
  ZIN(KST:KPROF,0)=ZIN(KST:KPROF,1)
  ZIN(KST:KPROF,NFLEVG+1)=ZIN(KST:KPROF,NFLEVG)
  CALL SIVDERI(IPROFS,1,LDVDERIB=LVFE_DERIB,LDBCS=LVFE_DBCS,LDBCT=LVFE_DBCT, &
   & PGPIN=ZIN(KST,0),PGPOUT=ZW4(KST,0))

  ! - Momentum equation.
  DO JLEV=1,NFLEVG
    DO JROF=KST,KPROF
      PGAGT9L(JROF,JLEV)=RD*PGMV(JROF,JLEV,YT9%MTL) &
       & +RD*SITR*PGMVS(JROF,YT9%MSPL)+ZW1L(JROF,JLEV)
      PGAGT9M(JROF,JLEV)=RD*PGMV(JROF,JLEV,YT9%MTM) &
       & +RD*SITR*PGMVS(JROF,YT9%MSPM)+ZW1M(JROF,JLEV)
    ENDDO
  ENDDO
  ! - Temperature equation.
  ZCOEF=RD*SITR/RCVD
  ZCOEG=1.0_JPRB/(RD*SITRA)
  DO JLEV=1,NFLEVG
    DO JROF=KST,KPROF
      PTOD9(JROF,JLEV)=ZCOEF*(PGMV(JROF,JLEV,YT9%MDIV)-ZCOEG*ZW3(JROF,JLEV))
    ENDDO
  ENDDO
  ! - Phi equation.
  ZCOEH=RD*SITR
  ZCOEI=RCPD/(RD*SITR)
  DO JLEV=1,NFLEVG
    DO JROF=KST,KPROF
      PSPDS9(JROF,JLEV)=-ZCOEH*PSDIV9(JROF)+ZCOEH*ZCOEI*ZTOD(JROF,JLEV) &
       & -ZSVDT(JROF,JLEV)
    ENDDO
  ENDDO
  ! - gw equation.
  ZCOEJ=RG*RG/(RD*SITRA)
  DO JLEV=1,NFLEVG
    DO JROF=KST,KPROF
      PLPD9(JROF,JLEV)=ZCOEJ*(-RD*ZW4(JROF,JLEV)-ZW2(JROF,JLEV))
    ENDDO
  ENDDO

ENDIF

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

! * For "spectral RT" option, adjust semi-implicit term in
!   T-equation to compensate for later multiplication by R/Rd

IF (LSPRT) THEN
  IF (LTWOTL) THEN
    ! remark for lpc_full:
    !  predictor: treatment of "t" data.
    !  corrector: treatment of provisional "t+dt" data.
    ! So in this case this is always the Y[X]%MP data which are used.
    CALL GPRCP(NPROMA,KST,KPROF,NFLEVG,PGFL=PGFL,PR=ZR9)
    DO JLEV=1,NFLEVG
      DO JROF=KST,KPROF
        PTOD0(JROF,JLEV)=RD*PTOD0(JROF,JLEV)/ZR9(JROF,JLEV)
      ENDDO
    ENDDO
  ELSE
    CALL GPRCP(NPROMA,KST,KPROF,NFLEVG,PGFL=PGFL,KGFLTYP=9,PR=ZR9)
    DO JLEV=1,NFLEVG
      DO JROF=KST,KPROF
        PTOD0(JROF,JLEV)=RD*PTOD0(JROF,JLEV)/ZR9(JROF,JLEV)
        PTOD9(JROF,JLEV)=RD*PTOD9(JROF,JLEV)/ZR9(JROF,JLEV)
      ENDDO
    ENDDO
  ENDIF
ENDIF

! * Add semi-implicit Coriolis terms to momentum eqn SI terms
!   if required (LIMPF=.T.).

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

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

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

