SUBROUTINE GPGRVCMUS(KPROMA,KD,KF,KFLEV,&
 & PRCORIC,PGNORDL,PGNORDM,PGNORDLCL,PGNORDMCL,PGNORDMCM,PRATATH,PRATATX,&
 & PUF,PVF,PUFL,PVFL,PDIVF,PVORF,&
 & PVCASRSF,PVCRSSAFL,PVCRSSAFM,&
 & PVCMUSFL,PVCMUSFM)

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

USE YEMGEO   , ONLY : ERPK
USE YOMCST   , ONLY : RA       ,RG       ,ROMEGA
USE YOMCT0   , ONLY : LRPLANE

!**** *GPGRVCMUS* - Computes "rssavnabla mu_s", the semi-reduced horizontal
!                   gradient of the coefficient "mu_s" linked to the
!                   contribution of the vertical velocity on Coriolis term,
!                   on model layers.

!**   Purpose.
!     --------

!      When taking account of the contribution of the vertical velocity
!      on Coriolis term and removing the thin layer hypothetis, additional
!      terms involving a quantity "mu_s" appear in the definition of the
!      total geopotential Phi, the pressure gradient term in the RHS of
!      horizontal wind equation, and also in the RHS of the "w" equation
!      in the non hydrostatic model.

!      Expression of "mu_s" writes:

!                 2 rs Omega cos(theta) (Gnordm U - Gnordl V) + U**2 + V**2
!       mu_s = - -----------------------------------------------------------
!                                        rs g

!      which can be rewritten:

!                2 Omega cos(theta)                          2  U**2 + V**2 a
!       mu_s = - ------------------ (Gnordm U - Gnordl V) - --- ----------- --
!                        g                                  a g      2      rs

!      where:
!       - "g" is the gravitation constant.
!       - "Omega" is the Earth rotation angular velocity.
!       - "theta" is the geographical latitude
!       - (Gnordl,Gnordm) is the compass, ie the apparent coordinates of a unit
!         vector directed towards the true North pole.
!       - "a" is the mean Earth radius.
!       - "rs" is the pseudo-radius.
!       - (U,V) are the components of the horizontal wind in the local repere.

!      "rssavnabla mu_s" writes T1 + T2 + T3 + T4 + T5 where:

!       T1 = (2 Omega/g) * cos(theta) *
!            ( Gnordl [ rssavnabla V ] - Gnordm [ rssavnabla U ] )

!       T2 = - (2 /(a*g)) * (a/rs) * ( U [ rssavnabla U ] + V [ rssavnabla V ] )

!               2  a**2  U**2 + V**2
!       T3 = + --- ----- ----------- [ rssavnabla (rs/a) ]
!              a g rs**2      2

!       T4 = zero for plane geometry
!       T4 = (2 Omega/g) * ( V [ rssavnabla (Gnordl cos(theta)) ] -
!            U [ rssavnabla (Gnordm cos(theta)) ] )
!            for spherical geometry

!       T5 = ((2*Omega*K_L)/(a*g)) * vect(-V,U)
!            - (4/(g*(a**2))) * (a/rs) * ((U**2 + V**2)/2) *
!            ( (sin(theta) - K_L)/(cos(theta)) ) * vect(-S,C)
!            for plane geometry
!       T5 = zero for spherical geometry

!      where:
!       - "K_L" is the projection constant (between 0 and 1).
!       - vector "(-S,C)" is the compass and is equivalent to vector
!         "(Gnordl,Gnordm)" in spherical geometry.

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

!        Explicit arguments :
!        --------------------
!        INPUT :
!           KPROMA    - horizontal dimensioning.
!           KD        - start of work.
!           KF        - depth of work.
!           KFLEV     - vertical dimensioning (number of layers).
!           PRCORIC   - 2 Omega cos(theta).
!           PGNORDL   - zonal component ("Gnordl") of the unit vector
!                       directed towards the true North pole.
!           PGNORDM   - meridian component ("Gnordm") of the unit vector
!                       directed towards the true North pole.
!           PGNORDLCL - zonal component of "rssavnabla (Gnordl cos(theta))".
!           PGNORDMCL - zonal component of "rssavnabla (Gnordm cos(theta))".
!           PGNORDMCM - meridian component of "rssavnabla (Gnordm cos(theta))".
!           PRATATH   - spherical geometry: 2 tan(theta_bne)/a
!                        (theta_bne = tilted but not stretched sphere latitude)
!                       plane geometry: 2 C (sin(theta) - K_L)/(a cos(theta)) 
!           PRATATX   - spherical geometry: zero
!                       plane geometry: 2 S (sin(theta) - K_L)/(a cos(theta))
!           PUF       - zonal component "U" of horizontal wind, on layers.
!           PVF       - meridian component "V" of horizontal wind, on layers.
!           PUFL      - zonal component of "rssavnabla U", on layers.
!           PVFL      - zonal component of "rssavnabla V", on layers.
!           PDIVF     - semi-reduced horizontal divergence (M**2 D'=a/rs D),
!                       on layers.
!           PVORF     - semi-reduced vorticity (M**2 zeta'=a/rs zeta),
!                       on layers.
!           PVCASRSF  - "a/rs" on layers.
!           PVCRSSAFL - zonal component of "rssavnabla (rs/a)", on layers.
!           PVCRSSAFM - meridian component of "rssavnabla (rs/a)", on layers.

!        OUTPUT :
!           PVCMUSFL  - zonal component of "rssavnabla mu_s", on layers.
!           PVCMUSFM  - meridian component of "rssavnabla mu_s", on layers.

!        Implicit arguments :
!        --------------------
!        none.

!     Method.
!     -------

!     Externals.
!     ----------
!        none.

!     Reference.
!     ----------

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

!     Modifications.
!     --------------
!        Original: AUGUST 2000.
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        K. Yessad (Dec 2008): remove dummy CDLOCK
!     ------------------------------------------------------------------

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KPROMA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFLEV 
INTEGER(KIND=JPIM),INTENT(IN)    :: KD 
INTEGER(KIND=JPIM),INTENT(IN)    :: KF 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRCORIC(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGNORDL(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGNORDM(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGNORDLCL(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGNORDMCL(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGNORDMCM(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRATATH(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRATATX(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PUF(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVF(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PUFL(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVFL(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDIVF(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVORF(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVCASRSF(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVCRSSAFL(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVCRSSAFM(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PVCMUSFL(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PVCMUSFM(KPROMA,KFLEV) 

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

INTEGER(KIND=JPIM) :: JLEV

REAL(KIND=JPRB) :: ZPLA, ZSPH, ZUSG, Z2OMEGAKSAG, Z2OMEGASG, Z2SAG, Z4SAAG

REAL(KIND=JPRB) :: ZKENE(KPROMA)
REAL(KIND=JPRB) :: ZT1L(KPROMA),ZT1M(KPROMA)
REAL(KIND=JPRB) :: ZT2L(KPROMA),ZT2M(KPROMA)
REAL(KIND=JPRB) :: ZT3L(KPROMA),ZT3M(KPROMA)
REAL(KIND=JPRB) :: ZT4L(KPROMA),ZT4M(KPROMA)
REAL(KIND=JPRB) :: ZT5L(KPROMA),ZT5M(KPROMA)
REAL(KIND=JPRB) :: ZUFL(KPROMA),ZUFM(KPROMA),ZVFL(KPROMA),ZVFM(KPROMA)
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

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

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

! * Computation of "rssavnabla mu_s":

ZUSG=1.0_JPRB/RG
Z2OMEGASG=(2.0_JPRB*ROMEGA)/RG
Z2OMEGAKSAG=(2.0_JPRB*ROMEGA*ERPK)/(RA*RG)
Z2SAG=2.0_JPRB/(RA*RG)
Z4SAAG=4._JPRB/(RA*RA*RG)
IF (LRPLANE) THEN
  ZSPH=0.0_JPRB
  ZPLA=1.0_JPRB
ELSE
  ZSPH=1.0_JPRB
  ZPLA=0.0_JPRB
ENDIF

DO JLEV=1,KFLEV

! - "rssavnabla U":

  ZUFL(KD:KF)=PUFL(KD:KF,JLEV)
  ZUFM(KD:KF)=-PVORF(KD:KF,JLEV) &
   & +PVFL(KD:KF,JLEV) &
   & +0.5_JPRB*ZSPH*PUF(KD:KF,JLEV)*PRATATH(KD:KF)  

! - "rssavnabla V":

  ZVFL(KD:KF)=PVFL(KD:KF,JLEV)
  ZVFM(KD:KF)=PDIVF(KD:KF,JLEV) &
   & -PUFL(KD:KF,JLEV) &
   & +0.5_JPRB*ZSPH*PVF(KD:KF,JLEV)*PRATATH(KD:KF)  

! - kinetic energy:

  ZKENE(KD:KF)=0.5_JPRB*( PUF(KD:KF,JLEV)*PUF(KD:KF,JLEV)&
   & + PVF(KD:KF,JLEV)*PVF(KD:KF,JLEV) )  

! - "T1":
  ZT1L(KD:KF)=ZUSG*PRCORIC(KD:KF)&
   & *(PGNORDL(KD:KF)*ZVFL(KD:KF)-PGNORDM(KD:KF)*ZUFL(KD:KF))  
  ZT1M(KD:KF)=ZUSG*PRCORIC(KD:KF)&
   & *(PGNORDL(KD:KF)*ZVFM(KD:KF)-PGNORDM(KD:KF)*ZUFM(KD:KF))  

! - "T2":
  ZT2L(KD:KF)=-Z2SAG*PVCASRSF(KD:KF,JLEV)&
   & *(PUF(KD:KF,JLEV)*ZUFL(KD:KF)+PVF(KD:KF,JLEV)*ZVFL(KD:KF))  
  ZT2M(KD:KF)=-Z2SAG*PVCASRSF(KD:KF,JLEV)&
   & *(PUF(KD:KF,JLEV)*ZUFM(KD:KF)+PVF(KD:KF,JLEV)*ZVFM(KD:KF))  

! - "T3":
  ZT3L(KD:KF)=Z2SAG*PVCASRSF(KD:KF,JLEV)*PVCASRSF(KD:KF,JLEV) &
   & *ZKENE(KD:KF)*PVCRSSAFL(KD:KF,JLEV)  
  ZT3M(KD:KF)=Z2SAG*PVCASRSF(KD:KF,JLEV)*PVCASRSF(KD:KF,JLEV)&
   & *ZKENE(KD:KF)*PVCRSSAFM(KD:KF,JLEV)  

! - "T4":
  IF (LRPLANE) THEN
    ZT4L(KD:KF)=0.0_JPRB
    ZT4M(KD:KF)=0.0_JPRB
  ELSE
    ZT4L(KD:KF)=Z2OMEGASG&
     & *(PVF(KD:KF,JLEV)*PGNORDLCL(KD:KF)-PUF(KD:KF,JLEV)*PGNORDMCL(KD:KF))  
    ZT4M(KD:KF)=-Z2OMEGASG*PUF(KD:KF,JLEV)*PGNORDMCM(KD:KF)
  ENDIF

! - "T5":
  ZT5L(KD:KF)=ZPLA*&
   & (-Z2OMEGAKSAG*PVF(KD:KF,JLEV)&
   & +Z4SAAG*PVCASRSF(KD:KF,JLEV)*ZKENE(KD:KF)*PRATATX(KD:KF))  
  ZT5M(KD:KF)=ZPLA*&
   & (Z2OMEGAKSAG*PUF(KD:KF,JLEV)&
   & -Z4SAAG*PVCASRSF(KD:KF,JLEV)*ZKENE(KD:KF)*PRATATH(KD:KF))  

! - compute "rssavnabla mu_s = T1+T2+T3+T4+T5":

  PVCMUSFL(KD:KF,JLEV)= &
   & ZT1L(KD:KF)+ZT2L(KD:KF)+ZT3L(KD:KF)+ZT4L(KD:KF)+ZT5L(KD:KF)  
  PVCMUSFM(KD:KF,JLEV)= &
   & ZT1M(KD:KF)+ZT2M(KD:KF)+ZT3M(KD:KF)+ZT4M(KD:KF)+ZT5M(KD:KF)  

ENDDO

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

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