SUBROUTINE GPVCMUS(KPROMA,KD,KF,KFLEV,&
 & PRCORIC,PGNORDL,PGNORDM,PVCASRSF,PUF,PVF,&
 & PVCMUSF)

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

USE YOMCST   , ONLY : RA       ,RG

!**** *GPVCMUS* - Computes 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.

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

!        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 of the unit vector
!                       directed towards the true North pole.
!           PGNORDM   - meridian component of the unit vector
!                       directed towards the true North pole.
!           PVCASRSF  - "a/rs" on layers.
!           PUF       - zonal component of horizontal wind, on layers.
!           PVF       - meridian component of horizontal wind, on layers.

!        OUTPUT :
!           PVCMUSF   - "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 + cleanings
!     ------------------------------------------------------------------

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)    :: PVCASRSF(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PUF(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVF(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PVCMUSF(KPROMA,KFLEV) 

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

INTEGER(KIND=JPIM) :: JLEV

REAL(KIND=JPRB) :: ZUSG, Z2SAG

REAL(KIND=JPRB) :: ZKENE(KPROMA)
REAL(KIND=JPRB) :: ZHOOK_HANDLE

!     ------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('GPVCMUS',0,ZHOOK_HANDLE)
!     ------------------------------------------------------------------

! * Computation of "mu_s" on layers:

ZUSG=1.0_JPRB/RG
Z2SAG=2.0_JPRB/(RA*RG)
DO JLEV=1,KFLEV
  ZKENE(KD:KF)=0.5_JPRB*( PUF(KD:KF,JLEV)*PUF(KD:KF,JLEV) &
   & + PVF(KD:KF,JLEV)*PVF(KD:KF,JLEV) )  
  PVCMUSF(KD:KF,JLEV)= &
   & - ZUSG * PRCORIC(KD:KF) * &
   & ( PGNORDM(KD:KF)*PUF(KD:KF,JLEV) - PGNORDL(KD:KF)*PVF(KD:KF,JLEV) ) &
   & - Z2SAG * ZKENE(KD:KF) * PVCASRSF(KD:KF,JLEV)  
ENDDO

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

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