!OPTIONS XOPT(NOEVAL)
SUBROUTINE ACDRMEAD ( KIDIA,KFDIA,KLON,KTDIA,KLEV,&
 !-----------------------------------------------------------------------
 ! - INPUT  2D .
 & PCP5,PDELP5,PT5,PU5,PV5,&
 & PCP,PDELP,PT,PU,PV,&
 ! - OUTPUT 2D .
 & PFRMH5,PSTRMU5,PSTRMV5,&
 & PFRMH,PSTRMU,PSTRMV,&
 ! - CONSTANTES .
 & PMESOT,PMESOU,PSTAT,&
 ! - LOCK ARGUMENTS .
 & CDLOCK)  

!**** *ACDRMEAD* ADJOINT DU FLUX MESOSPHERIQUE DE QUANTITE DE 
!                MOUVEMENT ET ENTHALPIE

!     Sujet.
!     ------
!     - ROUTINE DE CALCUL ACTIF .
!       CALCUL DU FLUX DE QUANTITE DE MOUVEMENT LIE A LA PRESENCE
!       D'UN FREINAGE DANS LA MESOSPHERE, ET DU FLUX D'ENTHALPIE
!       CORRESPONDANT A UN RAPPEL VERS LA TEMPERATURE DE
!       L'ATMOSPHERE STANDARD.
!     - COMPUTES THE MOMENTUM FLUX DUE TO A MESOSPHERIC DRAG AND THE HEAT FLUX
!       CORRESPONDING TO A RELAXATION OF TEMPERATURE TOWARDS THE
!       STANDARD ATMOSPHERE.

!**   Interface.
!     ----------
!        *CALL* *ACDRMEAD*

!-----------------------------------------------------------------------
! WARNING: THE ENGLISH VERSION OF VARIABLES' NAMES IS TO BE READ IN THE
!          "APLPAR" CODE.
!-----------------------------------------------------------------------

! -   ARGUMENTS D ENTREE.
!     -------------------

! - NOM DES PARAMETRES DE DIMENSIONNEMENT DE LA PHYSIQUE.

!       KIDIA: INDICE DE DEPART DES BOUCLES VECTORISEES SUR L'HORIZONT..
!       KFDIA: INDICE DE FIN DES BOUCLES VECTORISEES SUR L'HORIZONTALE.
!       KLON : DIMENSION HORIZONTALE
!       KTDIA: DEBUT BOUCLE VERTICALE
!       KLEV : FIN BOUCLE VERTICALE ET DIMENSION VERTICALE

! - NOM DES VARIABLES DE LA PHYSIQUE (PAR ORDRE ALPHABETIQUE DANS CHAQUE
!   CATEGORIE).

! - 2D (1:KLEV) .

!       PCP   : CHALEUR MASSIQUE A PRESSION CONSTANTE
!                   DE L'AIR
!       PDELP : EPAISSEUR EN PRESSION DE LA COUCHE
!       PT    : TEMPERATURE
!       PU    : VENT ZONAL
!       PV    : VENT MERIDIEN

!  The same but for trajectory
!  ---------------------------
!       PCP5  : CHALEUR MASSIQUE A PRESSION CONSTANTE
!                   DE L'AIR
!       PDELP5: EPAISSEUR EN PRESSION DE LA COUCHE
!       PT5   : TEMPERATURE
!       PU5   : VENT ZONAL
!       PV5   : VENT MERIDIEN

! - CONSTANTES .

!      PMESOT: PROFIL VERTICAL DU DRAG MESO. EN T
!      PMESOU: PROFIL VERTICAL DU DRAG MESO. EN U
!      PSTAT : TEMPERATURE DE L'ATMOSPHERE STANDARD

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

! -   ARGUMENTS DE SORTIE.
!     --------------------

! - NOM DES VARIABLES DE LA PHYSIQUE (PAR ORDRE ALPHABETIQUE DANS CHAQUE
!   CATEGORIE).

! - 2D (0:KLEV) .

!      PFRMH  : FLUX D'ENTHALPIE DANS LA MESOSPHERE
!      PSTRMU : FLUX DE QUANTITE DE MVT EN U
!      PSTRMV : FLUX DE QUANTITE DE MVT EN V

!  The same but for trajectory
!  ---------------------------
!      PFRMH5 : FLUX D'ENTHALPIE DANS LA MESOSPHERE
!      PSTRMU5: FLUX DE QUANTITE DE MVT EN U
!      PSTRMV5: FLUX DE QUANTITE DE MVT EN V

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

!     Externes.
!     ---------

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

!     Auteur.
!    --------
!         F. Bouyssel
!         Original : 01-03.

!     Modifications :
!    ----------------
!        M.Hamrud      01-Oct-2003 CY28 Cleaning

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

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

USE YOMCST   , ONLY : RG
USE YOMPHY2  , ONLY : TSPHY

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KLON 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KTDIA 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCP5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDELP5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PT5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PU5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PV5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCP(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PDELP(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PT(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PU(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PV(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRMH5(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSTRMU5(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSTRMV5(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PFRMH(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSTRMU(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSTRMV(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PMESOT(KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PMESOU(KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSTAT(KLEV) 
CHARACTER(LEN=7)  ,INTENT(IN)    :: CDLOCK 
REAL(KIND=JPRB) :: ZTENU5(KLON,KLEV),ZTENV5(KLON,KLEV),ZTENT5(KLON,KLEV)
REAL(KIND=JPRB) :: ZTENU(KLON,KLEV),ZTENV(KLON,KLEV),ZTENT(KLON,KLEV)&
 & ,ZUREL(KLEV),ZVREL(KLEV),ZTREL(KLEV)  

INTEGER(KIND=JPIM) :: JLEV, JLON

REAL(KIND=JPRB) :: ZALPHA, ZEPS, ZRGI, ZUNMAL, ZMESOU, ZMESOT
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"

!     CHECK RELIABILITY OF INPUT ARGUMENTS.

IF (LHOOK) CALL DR_HOOK('ACDRMEAD',0,ZHOOK_HANDLE)
IF(CDLOCK /= 'DRMEAD ') CALL ABOR1('BAD NUMBER OF ARGUMENTS!')

!*
!     ------------------------------------------------------------------
!     I - CALCULS PRELIMINAIRES ET DIVERSES INITIALISATIONS

!         PRELIMINARY COMPUTATIONS AND VARIOUS INITIALIZATIONS

!     1.1 CALCULS DE PARAMETRES DERIVES ET D'UNE CONSTANTE DE SECURITE
!         AUXILLARY PARAMETERS AND SECURITY CONSTANT

ZRGI=1.0_JPRB/RG

!      POUR UN SCHEMA IMPLICITE ZALPHA = 1, EXPLICITE ZALPHA = 0
!      FOR AN IMPLICIT SCHEME ZALPHA = 1 , EXPLICIT SCHEME ZALPHA = 0

ZALPHA=1.0_JPRB
ZUNMAL=1.0_JPRB-ZALPHA

ZEPS=1.E-11_JPRB

!     1.2 INITIALISATION DES PROFIL VERTICAUX DE RAPPEL
!         DE VENT ET DE TEMPERATURE
!         INITIALIZATION OF VERTICAL RELAXATION PROFILES
!         FOR WIND AND TEMPERATURE

! - TEMPORAIRE(S) 2D (1:KLEV).

!       ZTENU    : TENDANCE DE U
!                   TREND FOR U
!       ZTENV    : TENDANCE DE V
!                   TREND FOR V
!       ZTENT    : TENDANCE DE T
!                   TREND FOR T

! - TEMPORAIRE(S) 1D (1:KLEV).

!       ZUREL    : PROFIL VERTICAL DE RAPPEL DE U
!                   RELAXATION PROFILE FOR U
!       ZVREL    : PROFIL VERTICAL DE RAPPEL DE V
!                   RELAXATION PROFILE FOR V
!       ZTREL    : PROFIL VERTICAL DE RAPPEL DE T
!                   RELAXATION PROFILE FOR T

DO JLEV=1,KLEV
  ZUREL(JLEV)=0.0_JPRB
  ZVREL(JLEV)=0.0_JPRB
  ZTREL(JLEV)=PSTAT(JLEV)
ENDDO

!     1.3 MISE A ZERO DES FLUX
!         FLUXES SET TO ZERO

DO JLEV=KTDIA-1,KLEV
  DO JLON=KIDIA,KFDIA
    PSTRMU5(JLON,JLEV)=0.0_JPRB
    PSTRMV5(JLON,JLEV)=0.0_JPRB
    PFRMH5 (JLON,JLEV)=0.0_JPRB
  ENDDO
ENDDO

!*
!     ------------------------------------------------------------------
!     II - CALCUL DE LA TENDANCE MESOSPHERIQUE DE U, V, ET T

!          MESOSPHERIC TREND FOR U, V, AND T

DO JLEV=KTDIA,KLEV
  ZMESOU=-PMESOU(JLEV)/(1.0_JPRB+PMESOU(JLEV)*ZALPHA*TSPHY)
  ZMESOT=-PMESOT(JLEV)/(1.0_JPRB+PMESOT(JLEV)*ZALPHA*TSPHY)
  DO JLON=KIDIA,KFDIA
    ZTENU5(JLON,JLEV)= ZMESOU * (PU5(JLON,JLEV)-ZUREL(JLEV) )
    ZTENV5(JLON,JLEV)= ZMESOU * (PV5(JLON,JLEV)-ZVREL(JLEV) )
    ZTENT5(JLON,JLEV)= ZMESOT * (PT5(JLON,JLEV)-ZTREL(JLEV) )
  ENDDO
ENDDO

!*
!     ------------------------------------------------------------------
!     III - CALCUL DU FLUX, PAR INTEGRATION DE LA TENDANCE DE BAS EN HAUT
!           LES FLUX SONT SUPPOSES NULS AU DERNIER NIVEAU (KLEV) DU MODELE

!           THE FLUXES ARE CALCULATED BY VERTICAL INTEGRATION (FROM THE BOTTOM)
!           OF THE TREND. THEY ARE ASSUMED TO BE ZERO AT THE LAST LEVEL (KLEV)

DO JLEV=KLEV,KTDIA,-1
  DO JLON=KIDIA,KFDIA
    PSTRMU5(JLON,JLEV-1)=PSTRMU5(JLON,JLEV)&
     & + ZRGI*ZTENU5(JLON,JLEV)*PDELP5(JLON,JLEV)  
    PSTRMV5(JLON,JLEV-1)=PSTRMV5(JLON,JLEV)&
     & + ZRGI*ZTENV5(JLON,JLEV)*PDELP5(JLON,JLEV)  
    PFRMH5 (JLON,JLEV-1)=PFRMH5 (JLON,JLEV)&
     & + ZRGI*ZTENT5(JLON,JLEV)*PDELP5(JLON,JLEV)*PCP5(JLON,JLEV)  
  ENDDO
ENDDO

!*
!     ------------------------------------------------------------------
!     IV - INITIALISATION DES VARIABLES LOCALES

ZTENU(:,:)= 0.0_JPRB
ZTENV(:,:)= 0.0_JPRB
ZTENT(:,:)= 0.0_JPRB

!*
!     ------------------------------------------------------------------
!     V - PARTIE ADJOINTE

DO JLEV=KTDIA,KLEV
  DO JLON=KIDIA,KFDIA
    PSTRMU(JLON,JLEV)=PSTRMU(JLON,JLEV)+PSTRMU(JLON,JLEV-1)
    ZTENU (JLON,JLEV)=ZTENU (JLON,JLEV)+ZRGI*PDELP5(JLON,JLEV)*PSTRMU(JLON,JLEV-1)
    PDELP (JLON,JLEV)=PDELP (JLON,JLEV)+ZRGI*ZTENU5(JLON,JLEV)*PSTRMU(JLON,JLEV-1)
    PSTRMU(JLON,JLEV-1)=0.0_JPRB
    
    PSTRMV(JLON,JLEV)=PSTRMV(JLON,JLEV)+PSTRMV(JLON,JLEV-1)
    ZTENV (JLON,JLEV)=ZTENV (JLON,JLEV)+ZRGI*PDELP5(JLON,JLEV)*PSTRMV(JLON,JLEV-1)
    PDELP (JLON,JLEV)=PDELP (JLON,JLEV)+ZRGI*ZTENV5(JLON,JLEV)*PSTRMV(JLON,JLEV-1)
    PSTRMV(JLON,JLEV-1)=0.0_JPRB
    
    PFRMH (JLON,JLEV)=PFRMH (JLON,JLEV)+PFRMH (JLON,JLEV-1)
    ZTENT (JLON,JLEV)=ZTENT (JLON,JLEV)+ZRGI*PDELP5(JLON,JLEV)*PCP5  (JLON,JLEV)*PFRMH(JLON,JLEV-1)
    PDELP (JLON,JLEV)=PDELP (JLON,JLEV)+ZRGI*ZTENT5(JLON,JLEV)*PCP5  (JLON,JLEV)*PFRMH(JLON,JLEV-1)
    PCP   (JLON,JLEV)=PCP   (JLON,JLEV)+ZRGI*ZTENT5(JLON,JLEV)*PDELP5(JLON,JLEV)*PFRMH(JLON,JLEV-1)
    PFRMH(JLON,JLEV-1)=0.0_JPRB
  ENDDO
ENDDO

DO JLEV=KTDIA,KLEV
  ZMESOU=-PMESOU(JLEV)/(1.0_JPRB+PMESOU(JLEV)*ZALPHA*TSPHY)
  ZMESOT=-PMESOT(JLEV)/(1.0_JPRB+PMESOT(JLEV)*ZALPHA*TSPHY)
  DO JLON=KIDIA,KFDIA
    PU(JLON,JLEV)=PU(JLON,JLEV)+ZMESOU*ZTENU(JLON,JLEV)
    PV(JLON,JLEV)=PV(JLON,JLEV)+ZMESOU*ZTENV(JLON,JLEV)
    PT(JLON,JLEV)=PT(JLON,JLEV)+ZMESOT*ZTENT(JLON,JLEV)
    ZTENU(JLON,JLEV)=0.0_JPRB
    ZTENV(JLON,JLEV)=0.0_JPRB
    ZTENT(JLON,JLEV)=0.0_JPRB
  ENDDO
ENDDO

DO JLEV=KTDIA-1,KLEV
  DO JLON=KIDIA,KFDIA
    PSTRMU (JLON,JLEV)=0.0_JPRB
    PSTRMV (JLON,JLEV)=0.0_JPRB
    PFRMH  (JLON,JLEV)=0.0_JPRB
  ENDDO
ENDDO

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