!OPTIONS XOPT(HSFUN)
SUBROUTINE GWDRAGAD( KIDIA,KFDIA,KLON,KLEV,&
 & PTSPHY, KSTEP, KSTART,&
 & PAPHM15,PAPM15,PGEOM15,PTM15,PUM15,&
 & PVM15, PHSTD  , PGAMMA, PTHETA, PSIG,&
 & PAPHM1 ,PAPM1 ,PGEOM1 ,PTM1 ,PUM1,&
 & PVM1,&
 ! OUTPUTS
 & PUSTRGW5,PVSTRGW5,PVDISGW5,PVOL5,PVOM5,PTE5,&
 & PUSTRGW ,PVSTRGW ,PVDISGW ,PVOL ,PVOM ,PTE,&
 !  FLUX OUTPUTS
 & PSTRDU5,PSTRDV5,&
 & PSTRDU ,PSTRDV                             )  

!**** *GWDRAGAD* - DOES THE GRAVITY WAVE PARAMETRIZATION.
!                  (Adjoint)

!     J.-F. MAHFOUF           E.C.M.W.F.               07/05/96

!     PURPOSE.
!     --------

!          THIS ROUTINE COMPUTES THE PHYSICAL TENDENCIES OF THE
!     PROGNOSTIC VARIABLES U,V  AND T DUE TO  VERTICAL TRANSPORTS BY
!     SUBGRIDSCALE OROGRAPHICALLY EXCITED GRAVITY WAVES

!**   INTERFACE.
!     ----------
!          CALLED FROM *CALLPARAD*.

!          THE ROUTINE TAKES ITS INPUT FROM THE LONG-TERM STORAGE:
!          U,V,T AND P AT T-1.

!        EXPLICIT ARGUMENTS :
!        --------------------

!     ==== INPUTS ===

!        *KIDIA*       START POINT
!        *KFDIA*       END POINT
!        *KLON*        NUMBER OF GRID POINTS PER PACKET
!        *KLEV*        NUMBER OF VERTICAL LEVELS
!        *KGL1*        ROW NUMBER FOR PRINTINGS (UNUSED)
!        *KSTEP*       CURRENT TIME STEP INDEX
!        *KSTART*      FIRST STEP OF THE MODEL
!        *PTSPHY*      TIME STEP OF THE PHYSICS
!        *PAPHM15*     PRESSURE AT HALF LEVELS AT T-1   (Trajectory)
!        *PAPM15*      PRESSURE AT FULL LEVELS AT T-1   (Trajectory)
!        *PGEOM15*     GEOPOTENTIAL AT T-1              (Trajectory)
!        *PTM15*       TEMPERATURE AT T-1               (Trajectory)
!        *PUM15*       X-VELOCITY COMPONENT AT T-1      (Trajectory)
!        *PVM15*       Y-VELOCITY COMPONENT AT T-1      (Trajectory)
!        *PHSTD*       STANDARD DEVIATION OF THE SUBGRID SCALE OROGRAPHY
!        *PTHETA*      GEOGRAPHICAL ORIENTATION 
!                      OF THE SUBGRID SCALE  OROGRAPHY
!        *PGAMMA*      ANISOTROPY OF THE SUBGRID SCALE OROGRAPHY
!        *PSIG*        SLOPE OF THE SUBGRID SCALE OROGRAPHY
!        *PAPHM1*      PRESSURE AT HALF LEVELS AT T-1
!        *PAPM1*       PRESSURE AT FULL LEVELS AT T-1
!        *PGEOM1*      GEOPOTENTIAL AT T-1
!        *PTM1*        TEMPERATURE AT T-1
!        *PUM1*        X-VELOCITY COMPONENT AT T-1
!        *PVM1*        Y-VELOCITY COMPONENT AT T-1

!     ==== OUTPUTS ===

!        *PUSTRGW5*    SURFACE FLUX OF U-MOMENTUM       (Trajectory)
!        *PVSTRGW5*    SURFACE FLUX OF V-MOMENTUM       (Trajectory)
!        *PVDISGW5*    DISSIPATION OF KINTIC ENERGY     (Trajectory) 
!        *PVOM5*       TENDENCY OF U-COMP. OF WIND      (Trajectory)
!        *PVOL5*       TENDENCY OF V-COMP. OF WIND      (Trajectory) 
!        *PTE5*        TEMPERATURE TENDENCY             (Trajectory)
!        *PUSTRGW*     SURFACE FLUX OF U-MOMENTUM
!        *PVSTRGW*     SURFACE FLUX OF V-MOMENTUM
!        *PVDISGW*     DISSIPATION OF KINETIC ENERGY 
!        *PVOM*        TENDENCY OF U-COMP. OF WIND 
!        *PVOL*        TENDENCY OF V-COMP. OF WIND
!        *PTE*         TEMPERATURE TENDENCY    
!        *PSTRDU5*     FLUX OF U-MOMENTUM               (Trajectory)
!        *PSTRDV5*     FLUX OF V-MOMENTUM               (Trajectory)
!        *PSTRDU*      FLUX OF U-MOMENTUM
!        *PSTRDV*      FLUX OF V-MOMENTUM

!        IMPLICIT ARGUMENTS :   NONE
!        --------------------

!     METHOD.
!     -------
!          THE SCHEME CONSISTS OF THREE PARTS,THE CALCULATION OF LOWLEVEL
!         DRAG DUE TO WAKE EFFECTS OF THE SUBGRID OROGRAPHY,THE GRAVITY 
!         WAVE STRESS AND THE STRESS PROFILE IN THE VERTICAL.
!         THE STRESS IS COMPUTED USING A LOW-LEVEL WIND,STATIC STABILITY
!         AND  SUBGRID OROGRAPHIC PARAMETERS.THESE ARE THE STANDARD 
!         DEVIATION OF THE HEIGHT,THE ANGLE RELATIVE TO EAST, THE
!         ANISOTROPY,AND THE SLOPE.
!         A WAVE RICHARDSON NUMBER IS COMPUTED AT EACH LEVEL AND BY
!         REQUIRING THAT ITS VALUE IS NEVER LESS THAN A CRITICAL ONE
!         A VALUE OF STRESS IS DETERMINED AT EACH MODEL LEVEL.
!         THE CRITICAL FROUDE NUMBER OF THE FLOW DETERMINES THE DEPTH OF
!         THE LOWLEVEL DRAG.  

!     EXTERNALS.
!     ----------

!     REFERENCE.
!     ----------
!         SEE MODEL DOCUMENTATION

!        SEE ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE "I.F.S."

!     AUTHOR.
!     -------
!     M.MILLER + B.RITTER   E.C.M.W.F.     15/06/86.

!     MODIFICATIONS.
!     --------------
!     REVISED BY MARTIN MILLER   E.C.M.W.F.   22/03/89.
!        M.Hamrud      01-Oct-2003 CY28 Cleaning

!     NEW VERSION MARTIN MILLER  E.C.M.W.F.   1993

!     CODED FOR IFS BY F.LOTT    E.C.M.W.F.   22/11/93
!-----------------------------------------------------------------------

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

USE YOMCST   , ONLY : RG       ,RCPD
USE YOEGWD   , ONLY : GKDRAG   ,GKWAKE   ,NGWDLIM,   GTENLIM,&
                    & NGWDTOP  ,GRFPLM
USE YOEPHLI  , ONLY : LPHYLIN  ,RLPDRAG

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 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTSPHY 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTEP 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTART 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPHM15(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPM15(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGEOM15(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTM15(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PUM15(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVM15(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PHSTD(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGAMMA(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTHETA(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSIG(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PAPHM1(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PAPM1(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGEOM1(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTM1(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PUM1(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVM1(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PUSTRGW5(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PVSTRGW5(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PVDISGW5(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVOL5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVOM5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTE5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PUSTRGW(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVSTRGW(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVDISGW(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVOL(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVOM(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTE(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSTRDU5(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSTRDV5(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSTRDU(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSTRDV(KLON,KLEV+1) 

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

!*       0.1   ARGUMENTS
!              ---------

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

!              ------------
INTEGER(KIND=JPIM) ::  &
 & ICRIT(KLON),&
 & IKCRITH(KLON),&
 & IKENVH(KLON),&
 & IKNU(KLON),&
 & IKNU2(KLON)  

LOGICAL :: LLGWD(KLON)

REAL(KIND=JPRB) ::   ZTAU5(KLON,KLEV+1),&
 & ZSTAB5(KLON,KLEV+1),&
 & ZVPH5(KLON,KLEV+1),&
 & ZRHO5(KLON,KLEV+1),&
 & ZRI5(KLON,KLEV+1),&
 & ZPSI5(KLON,KLEV+1),&
 & ZZDEP5(KLON,KLEV)  
REAL(KIND=JPRB) ::   ZDUDT5(KLON),&
 & ZDVDT5(KLON),&
 & ZDTDT5(KLON),&
 & ZDEDT5(KLON),&
 & ZVIDIS5(KLON),&
 & ZULOW5(KLON),&
 & ZVLOW5(KLON),&
 & ZNU5(KLON),&
 & ZD15(KLON),&
 & ZD25(KLON),&
 & ZDMOD5(KLON)  

REAL(KIND=JPRB) :: ZUEA5(KLON,KLEV),ZVEA5(KLON,KLEV)

REAL(KIND=JPRB) ::   ZTAU(KLON,KLEV+1),&
 & ZSTAB(KLON,KLEV+1),&
 & ZVPH(KLON,KLEV+1),&
 & ZRHO(KLON,KLEV+1),&
 & ZRI(KLON,KLEV+1),&
 & ZPSI(KLON,KLEV+1),&
 & ZZDEP(KLON,KLEV)  
REAL(KIND=JPRB) ::   ZDUDT(KLON),&
 & ZDVDT(KLON),&
 & ZDTDT(KLON),&
 & ZDEDT(KLON),&
 & ZVIDIS(KLON),&
 & ZULOW(KLON),&
 & ZVLOW(KLON),&
 & ZD1(KLON),&
 & ZD2(KLON),&
 & ZDMOD(KLON)  

REAL(KIND=JPRB) :: ZTEA(KLON,KLEV),ZUEA(KLON,KLEV),ZVEA(KLON,KLEV)

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

!*          -----  EXTRA STORAGE FOR TRAJECTORY ------

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

REAL(KIND=JPRB) :: ZDIS55   (KLON,KLEV), ZUST55 (KLON,KLEV),&
 & ZVST55   (KLON,KLEV),&
 & ZDVDT55  (KLON,KLEV), ZDUDT55(KLON,KLEV),&
 & ZBET55   (KLON,KLEV), ZZD155 (KLON,KLEV), &
 & ZABSV55  (KLON,KLEV), ZS255  (KLON,KLEV),&
 & ZRATIO55 (KLON,KLEV), ZS155  (KLON,KLEV),&
 & ZTEMP55  (KLON,KLEV)      

INTEGER(KIND=JPIM) :: ILEVP1, ILONS, JK, JL, IKTOP

REAL(KIND=JPRB) :: ZABSV, ZABSV5, ZB, ZBET, ZBET5, ZBLOCK, ZBLOCK5, ZC,&
 & ZCONB, ZCONS1, ZCS, ZCS5, ZCST, ZDELP, ZDELP5, ZDELP0, ZDELP05, &
 & ZDIAGT, ZDIS, ZDIS5, ZEFF, ZEFF5, ZGDPH, ZGDPH5, &
 & ZKDRAG, ZRATIO, ZRATIO5, ZRTMST, ZS1, ZS15, &
 & ZS2, ZS25, ZSS, ZSS5, ZSTD, ZTEMP, ZTEMP5, &
 & ZTMST, ZUST, ZUST5, ZVST, ZVST5, ZZD1, ZZD15, Z1D9, ZIDIV5
          
LOGICAL :: LLTEST1(KLON,KLEV),LLTEST2(KLON,KLEV),LLTEST3(KLON,KLEV)&
 & ,LLTEST4(KLON,KLEV)            
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "gwprofil.intfb.h"
#include "gwprofilad.intfb.h"
#include "gwsetup.intfb.h"
#include "gwsetupad.intfb.h"

!*************************************************************

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

!*         1.    INITIALIZATION
!                --------------

IF (LHOOK) CALL DR_HOOK('GWDRAGAD',0,ZHOOK_HANDLE)
ILONS=KFDIA-KIDIA+1
!     ------------------------------------------------------------------

!*         1.1   COMPUTATIONAL CONSTANTS
!                -----------------------

ZTMST=PTSPHY
ZRTMST=1.0_JPRB/ZTMST
Z1D9=1.0_JPRB/9.0_JPRB
IF(KSTEP == KSTART) THEN
  ZDIAGT=ZTMST
ELSE
  ZDIAGT=0.5_JPRB*ZTMST
ENDIF
ZCONS1=1.0_JPRB/(RG*ZTMST)

ZBLOCK=0.0_JPRB

!       SELECT POINTS FOR SCHEME TO OPERATE(SGS OROG >50METRES)  ****

DO JL=KIDIA,KFDIA
  IF (PHSTD(JL) > 50._JPRB) THEN
    LLGWD(JL)=.TRUE.
  ELSE
    LLGWD(JL)=.FALSE.
  ENDIF
ENDDO

!       Constant for surface stress

IF (LPHYLIN) THEN
  ZKDRAG=RLPDRAG
ELSE
  ZKDRAG=GKDRAG
ENDIF

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

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

!                 ----- TRAJECTORY COMPUTATIONS ------

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

!*         1.4   SAVING PROGNOSTIC VARIABLES
!                ---------------------------

DO JK=1,KLEV
  DO JL=KIDIA,KFDIA
    ZUEA5(JL,JK)=PVOM5(JL,JK)
    ZVEA5(JL,JK)=PVOL5(JL,JK)
  ENDDO
ENDDO

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

!*         2.     PRECOMPUTE BASIC STATE VARIABLES.
!*                ---------- ----- ----- ----------

CALL GWSETUP &
 & ( KIDIA , KFDIA , KLON  , KLEV , LLGWD,&
 & IKCRITH, ICRIT,&
 & IKENVH,IKNU,IKNU2,&
 & PAPHM15, PAPM15 , PUM15   , PVM15 , PTM15 , PGEOM15, PHSTD,&
 & ZRHO5  , ZRI5   , ZSTAB5  , ZTAU5 , ZVPH5 , ZPSI5 , ZZDEP5,&
 & ZULOW5 , ZVLOW5,&
 & PTHETA , PGAMMA,ZNU5  ,ZD15 , ZD25, ZDMOD5 )  

!***********************************************************

!*         3.      COMPUTE THE SURFACE GRAVITY WAVE STRESS

DO JL=KIDIA,KFDIA
  IF(LLGWD(JL)) THEN
    ZBLOCK5=PGEOM15(JL,IKENVH(JL))/RG
    ZSTD=PHSTD(JL)
    ZEFF5=MAX(0.0_JPRB,3.0_JPRB*ZSTD-ZBLOCK5)
    ZTAU5(JL,KLEV+1)=ZKDRAG*ZRHO5(JL,KLEV+1)*PSIG(JL)*ZEFF5**2 &
     & *Z1D9/ZSTD*ZVPH5(JL,KLEV+1)*ZDMOD5(JL)*SQRT(ZSTAB5(JL,KLEV+1))  
  ELSE
    ZTAU5(JL,KLEV+1)=0.0_JPRB
  ENDIF

ENDDO

!*         4.      COMPUTE STRESS PROFILE.
!*                 ------- ------ --------

CALL GWPROFIL &
 & ( KIDIA , KFDIA , KLON , KLEV,&
 & LLGWD,&
 & IKCRITH, ICRIT , IKENVH, IKNU,&
 & IKNU2 , PAPHM15, ZRHO5  , ZSTAB5 , ZVPH5,&
 & ZRI5 , ZTAU5 , ZDMOD5 , PSIG ,PHSTD)  

!*         5.      COMPUTE TENDENCIES.
!*                 -------------------

DO JL=KIDIA,KFDIA
  ZVIDIS5(JL)=0.0_JPRB
  ZDUDT5 (JL)=0.0_JPRB
  ZDVDT5 (JL)=0.0_JPRB
  ZDTDT5 (JL)=0.0_JPRB
ENDDO

ILEVP1=KLEV+1

IKTOP=NGWDTOP

!     COMPUTES AND ADDS THE LOWLEVEL DRAG TENDENCIES TO THE GWD ONES 
!     LOWLEVEL CALCULATION IN PARTLY IMPLICIT FORM

DO JK=1,KLEV

!OCL  VCT(CEX)
  DO JL=KIDIA,KFDIA
    IF(LLGWD(JL)) THEN
      ZDELP5 =PAPHM15(JL,JK+1)-PAPHM15(JL,JK)
      IF( PAPM15(JL,JK) < GRFPLM) THEN
        ZDELP05=PAPHM15(JL,IKTOP+1)-PAPHM15(JL,1)
        ZIDIV5=1._JPRB/(ZVPH5(JL,ILEVP1)*ZDELP05**2)
        ZTEMP5 =-RG*(ZTAU5(JL,IKTOP+1)-ZTAU5(JL,1))*ZDELP5*ZIDIV5
      ELSE
        ZIDIV5=1._JPRB/(ZVPH5(JL,ILEVP1)*ZDELP5)
        ZTEMP5 =-RG*(ZTAU5(JL,JK+1)-ZTAU5(JL,JK))*ZIDIV5
      ENDIF

      ZTEMP55(JL,JK)=ZTEMP5
      ZS15=ZTEMP5/ZDMOD5(JL)
      ZS155(JL,JK)=ZS15
      ZDUDT5(JL)=(ZULOW5(JL)*ZD15(JL)-ZVLOW5(JL)*ZD25(JL))*ZS15
      ZDVDT5(JL)=(ZVLOW5(JL)*ZD15(JL)+ZULOW5(JL)*ZD25(JL))*ZS15
      
      LLTEST1(JL,JK)=ZDUDT5(JL)> GTENLIM
      LLTEST2(JL,JK)=ZDUDT5(JL)<-GTENLIM
      LLTEST3(JL,JK)=ZDVDT5(JL)> GTENLIM
      LLTEST4(JL,JK)=ZDVDT5(JL)<-GTENLIM
      
!LIMIT THE WIND TENDENCIES IN THE STRATOSPHERE
      IF(JK < NGWDLIM) THEN
        IF (ZDUDT5(JL)>GTENLIM) THEN
          ZDUDT5(JL)= GTENLIM
        ELSEIF (ZDUDT5(JL)<-GTENLIM) THEN
          ZDUDT5(JL)=-GTENLIM
        ENDIF    
        IF (ZDVDT5(JL)>GTENLIM) THEN
          ZDVDT5(JL)= GTENLIM
        ELSEIF (ZDVDT5(JL)<-GTENLIM) THEN
          ZDVDT5(JL)=-GTENLIM
        ENDIF    
      ENDIF
      
      IF(JK >= IKENVH(JL)) THEN
        ZB    =1.0_JPRB-0.18_JPRB*PGAMMA(JL)-0.04_JPRB*PGAMMA(JL)**2
        ZC    =0.48_JPRB*PGAMMA(JL)+0.3_JPRB*PGAMMA(JL)**2
        ZCS5  =COS(ZPSI5(JL,JK))**2
        ZSS5  =1.0_JPRB-ZCS5
        ZCONB =ZTMST*GKWAKE*PSIG(JL)/(2.0_JPRB*PHSTD(JL))
        ZABSV5=0.5_JPRB* SQRT(PUM15(JL,JK)**2+PVM15(JL,JK)**2)
        ZABSV55(JL,JK)=ZABSV5
        ZZD15 =ZB*ZCS5+ZC*ZSS5
        ZZD155(JL,JK)=ZZD15
        ZRATIO5=(ZCS5+PGAMMA(JL)*ZSS5) /(PGAMMA(JL)*ZCS5+ZSS5)
        ZRATIO55(JL,JK)=ZRATIO5
        ZS25=2.0_JPRB-1.0_JPRB/ZRATIO5
        IF (ZS25 < 0.0_JPRB) THEN
          ZS25=0.0_JPRB
        ENDIF
        ZS255(JL,JK)=ZS25
        ZBET5  =ZCONB*ZS25*ZZDEP5(JL,JK)*ZZD15*ZABSV5
        ZBET55(JL,JK)=ZBET5
        ZDUDT5(JL)=-PUM15(JL,JK)/ZTMST-PVOM5(JL,JK)
        ZDUDT55(JL,JK)=ZDUDT5(JL)
        ZDVDT5(JL)=-PVM15(JL,JK)/ZTMST-PVOL5(JL,JK)
        ZDVDT55(JL,JK)=ZDVDT5(JL)
        ZDUDT5(JL)=ZDUDT5(JL)*(ZBET5/(1.0_JPRB+ZBET5))
        ZDVDT5(JL)=ZDVDT5(JL)*(ZBET5/(1.0_JPRB+ZBET5))
      ENDIF

      PVOM5(JL,JK)=PVOM5(JL,JK)+ZDUDT5(JL)
      PVOL5(JL,JK)=PVOL5(JL,JK)+ZDVDT5(JL)
      ZUST5=PUM15(JL,JK)+ZTMST*ZDUDT5(JL)
      ZUST55(JL,JK)=ZUST5
      ZVST5=PVM15(JL,JK)+ZTMST*ZDVDT5(JL)
      ZVST55(JL,JK)=ZVST5
      ZDIS5=0.5_JPRB*(PUM15(JL,JK)**2+PVM15(JL,JK)**2-ZUST5**2-ZVST5**2)
      ZDIS55(JL,JK)=ZDIS5
      ZDEDT5(JL) =ZDIS5/ZTMST
      ZVIDIS5(JL)=ZVIDIS5(JL)+ZDIS5*ZDELP5
      ZDTDT5(JL) =ZDEDT5(JL)/RCPD
      PTE5(JL,JK)=PTE5(JL,JK)+ZDTDT5(JL)
    ENDIF
  ENDDO

ENDDO
!**
!**     5.3     UPDATE STRESS COMPONENTS AND DISSIPATION
!**
DO JL=KIDIA,KFDIA
  PUSTRGW5(JL)=0.0_JPRB
  PVSTRGW5(JL)=0.0_JPRB
  PVDISGW5(JL)=0.0_JPRB
ENDDO

DO JL=KIDIA,KFDIA
  IF(LLGWD(JL)) THEN
    PVDISGW5(JL)=ZCONS1*ZVIDIS5(JL)
  ENDIF
ENDDO

!*******************************************************************

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

!*         5.5    FLUX COMPUTATIONS
!                 --------- -------

DO JL=KIDIA,KFDIA
  PSTRDU5(JL,1)=0.0_JPRB
  PSTRDV5(JL,1)=0.0_JPRB
ENDDO

DO JK=1,KLEV
  DO JL=KIDIA,KFDIA
    ZGDPH5=-RG  /(PAPHM15(JL,JK+1)-PAPHM15(JL,JK))
    PSTRDU5(JL,JK+1)=(PVOM5(JL,JK)-ZUEA5(JL,JK))/ZGDPH5 +PSTRDU5(JL,JK)
    PSTRDV5(JL,JK+1)=(PVOL5(JL,JK)-ZVEA5(JL,JK))/ZGDPH5 + PSTRDV5(JL,JK)
  ENDDO
ENDDO

DO JL=KIDIA,KFDIA
  PUSTRGW5(JL)=PSTRDU5(JL,KLEV+1)
  PVSTRGW5(JL)=PSTRDV5(JL,KLEV+1)
ENDDO

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

!                 ----- ADJOINT COMPUTATIONS ------

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

!*                        INITIALIZATIONS
!                         ---------------

DO JK=1,KLEV
  DO JL=KIDIA,KFDIA
    ZVEA  (JL,JK) = 0.0_JPRB
    ZUEA  (JL,JK) = 0.0_JPRB
    ZTEA  (JL,JK) = 0.0_JPRB
    ZZDEP (JL,JK) = 0.0_JPRB
  ENDDO
ENDDO

DO JK=1,KLEV+1
  DO JL=KIDIA,KFDIA
    ZPSI  (JL,JK) = 0.0_JPRB
    ZRHO  (JL,JK) = 0.0_JPRB
    ZSTAB (JL,JK) = 0.0_JPRB
    ZVPH  (JL,JK) = 0.0_JPRB
    ZTAU  (JL,JK) = 0.0_JPRB
    ZRI   (JL,JK) = 0.0_JPRB
  ENDDO
ENDDO

DO JL=KIDIA,KFDIA
  ZVIDIS (JL) = 0.0_JPRB
  ZDTDT  (JL) = 0.0_JPRB
  ZDEDT  (JL) = 0.0_JPRB
  ZDUDT  (JL) = 0.0_JPRB
  ZDVDT  (JL) = 0.0_JPRB
  ZDMOD  (JL) = 0.0_JPRB
  ZD1    (JL) = 0.0_JPRB
  ZD2    (JL) = 0.0_JPRB
  ZULOW  (JL) = 0.0_JPRB
  ZVLOW  (JL) = 0.0_JPRB
ENDDO

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

DO JL=KIDIA,KFDIA
  PSTRDV (JL,KLEV+1) = PSTRDV (JL,KLEV+1) + PVSTRGW (JL)
  PVSTRGW (JL) = 0.0_JPRB
  PSTRDU (JL,KLEV+1) = PSTRDU (JL,KLEV+1) + PUSTRGW (JL)
  PUSTRGW (JL) = 0.0_JPRB
ENDDO
!     ------------------------------------------------------------------

!*         5.5    FLUX COMPUTATIONS
!                 --------- -------

DO JK=KLEV,1,-1
  DO JL=KIDIA,KFDIA

    ZGDPH  = 0.0_JPRB

    ZGDPH5=-RG  /(PAPHM15(JL,JK+1)-PAPHM15(JL,JK))
    PVOL (JL,JK) = PVOL (JL,JK) + PSTRDV(JL,JK+1)/ZGDPH5
    ZVEA (JL,JK) = ZVEA (JL,JK) - PSTRDV(JL,JK+1)/ZGDPH5
    ZGDPH = ZGDPH - PSTRDV(JL,JK+1)*(PVOL5(JL,JK)-ZVEA5(JL,JK))/ZGDPH5**2
    PSTRDV (JL,JK) = PSTRDV (JL,JK) + PSTRDV(JL,JK+1)
    PSTRDV(JL,JK+1) = 0.0_JPRB
    PVOM (JL,JK) = PVOM (JL,JK) + PSTRDU(JL,JK+1)/ZGDPH5
    ZUEA (JL,JK) = ZUEA (JL,JK) - PSTRDU(JL,JK+1)/ZGDPH5
    ZGDPH = ZGDPH - PSTRDU(JL,JK+1)*(PVOM5(JL,JK)-ZUEA5(JL,JK))/ZGDPH5**2
    PSTRDU (JL,JK) = PSTRDU (JL,JK) + PSTRDU(JL,JK+1)
    PSTRDU(JL,JK+1) = 0.0_JPRB
    PAPHM1 (JL,JK+1) = PAPHM1 (JL,JK+1) + RG*ZGDPH/&
     & (PAPHM15(JL,JK+1)-PAPHM15(JL,JK))**2  
    PAPHM1 (JL,JK  ) = PAPHM1 (JL,JK  ) - RG*ZGDPH/&
     & (PAPHM15(JL,JK+1)-PAPHM15(JL,JK))**2  
  ENDDO
ENDDO

DO JL=KIDIA,KFDIA
  PSTRDU (JL,1)=0.0_JPRB
  PSTRDV (JL,1)=0.0_JPRB
ENDDO
!**
!**     5.3     UPDATE STRESS COMPONENTS AND DISSIPATION
!**
DO JL=KIDIA,KFDIA
  IF(LLGWD(JL)) THEN
    ZVIDIS (JL) = ZVIDIS (JL) + ZCONS1*PVDISGW (JL)
    PVDISGW (JL) = 0.0_JPRB
  ENDIF
ENDDO

DO JL=KIDIA,KFDIA
  PUSTRGW (JL)=0.0_JPRB
  PVSTRGW (JL)=0.0_JPRB
  PVDISGW (JL)=0.0_JPRB
ENDDO

!*         5.      COMPUTE TENDENCIES.
!*                 -------------------

ILEVP1=KLEV+1

IKTOP=NGWDTOP


!     COMPUTES AND ADDS THE LOWLEVEL DRAG TENDENCIES TO THE GWD ONES 
!     LOWLEVEL CALCULATION IN PARTLY IMPLICIT FORM

DO JK=KLEV,1,-1

!OCL  VCT(CEX)
  DO JL=KIDIA,KFDIA
    IF(LLGWD(JL)) THEN

      ZDIS   = 0.0_JPRB
      ZDELP  = 0.0_JPRB
      ZDELP0 = 0.0_JPRB
      ZUST   = 0.0_JPRB
      ZVST   = 0.0_JPRB
      ZBET   = 0.0_JPRB
      ZS2    = 0.0_JPRB
      ZZD1   = 0.0_JPRB
      ZABSV  = 0.0_JPRB
      ZRATIO = 0.0_JPRB
      ZCS    = 0.0_JPRB
      ZSS    = 0.0_JPRB
      ZS1    = 0.0_JPRB
      ZTEMP  = 0.0_JPRB

      ZDELP5=PAPHM15(JL,JK+1)-PAPHM15(JL,JK)

      ZDTDT (JL) = ZDTDT (JL) + PTE (JL,JK)
      ZDEDT (JL) = ZDEDT (JL) + ZDTDT (JL)/RCPD
      ZDTDT (JL) = 0.0_JPRB
      ZDIS = ZDIS + ZVIDIS (JL)*ZDELP5
      ZDELP = ZDELP + ZVIDIS (JL)*ZDIS55(JL,JK)
      ZDIS = ZDIS + ZDEDT (JL)/ZTMST
      ZDEDT (JL) = 0.0_JPRB
      PUM1(JL,JK) = PUM1(JL,JK) + ZDIS*PUM15(JL,JK)
      PVM1(JL,JK) = PVM1(JL,JK) + ZDIS*PVM15(JL,JK)
      ZUST = ZUST  - ZDIS*ZUST55(JL,JK)
      ZVST = ZVST  - ZDIS*ZVST55(JL,JK)
      PVM1 (JL,JK) = PVM1 (JL,JK) + ZVST
      ZDVDT (JL) = ZDVDT (JL) + ZVST*ZTMST
      PUM1 (JL,JK) = PUM1 (JL,JK) + ZUST
      ZDUDT (JL) = ZDUDT (JL) + ZUST*ZTMST
      ZDVDT (JL) = ZDVDT (JL) + PVOL (JL,JK)
      ZDUDT (JL) = ZDUDT (JL) + PVOM (JL,JK)

      IF(JK >= IKENVH(JL)) THEN
        ZB    =1.0_JPRB-0.18_JPRB*PGAMMA(JL)-0.04_JPRB*PGAMMA(JL)**2
        ZC    =0.48_JPRB*PGAMMA(JL)+0.3_JPRB*PGAMMA(JL)**2
        ZCONB =ZTMST*GKWAKE*PSIG(JL)/(2.0_JPRB*PHSTD(JL))
        ZCS5  =COS(ZPSI5(JL,JK))**2
        ZSS5  =1.0_JPRB-ZCS5

        ZBET = ZBET + ZDVDT (JL)*ZDVDT55(JL,JK)/(1.0_JPRB+ZBET55(JL,JK))**2
        ZDVDT(JL) = ZDVDT(JL)*(ZBET55(JL,JK)/(1.0_JPRB+ZBET55(JL,JK)))
        ZBET = ZBET + ZDUDT (JL)*ZDUDT55(JL,JK)/(1.0_JPRB+ZBET55(JL,JK))**2
        ZDUDT(JL)=ZDUDT(JL)*(ZBET55(JL,JK)/(1.0_JPRB+ZBET55(JL,JK)))
        PVM1 (JL,JK) = PVM1 (JL,JK) - ZDVDT (JL)/ZTMST
        PVOL(JL,JK)=PVOL(JL,JK)-ZDVDT(JL)
        ZDVDT (JL) = 0.0_JPRB
        PUM1 (JL,JK) = PUM1 (JL,JK) - ZDUDT (JL)/ZTMST
        PVOM(JL,JK)=PVOM(JL,JK)-ZDUDT(JL)
        ZDUDT (JL) = 0.0_JPRB
        ZS2 = ZS2 + ZCONB*ZBET*ZZDEP5(JL,JK)*ZZD155(JL,JK)*ZABSV55(JL,JK)
        ZZDEP (JL,JK) = ZZDEP (JL,JK) +&
         & ZCONB*ZBET*ZZD155(JL,JK)*&
         & ZABSV55(JL,JK)*ZS255(JL,JK)  
        ZZD1 = ZZD1 + ZCONB*ZBET*ZS255(JL,JK)*ZZDEP5(JL,JK)*ZABSV55(JL,JK)
        ZABSV = ZABSV + ZCONB*ZBET*ZS255(JL,JK)*ZZDEP5(JL,JK)*ZZD155(JL,JK)
        IF (ZS255(JL,JK) <= 0.0_JPRB) THEN
          ZS2=0.0_JPRB
        ENDIF
        ZRATIO = ZRATIO + ZS2/ZRATIO55(JL,JK)**2
        ZCS = ZCS + ZRATIO*ZSS5*(1.0_JPRB-PGAMMA(JL)**2)/&
         & (PGAMMA(JL)*ZCS5+ZSS5)**2  
        ZSS = ZSS - ZRATIO*ZCS5*(1.0_JPRB-PGAMMA(JL)**2)/&
         & (PGAMMA(JL)*ZCS5+ZSS5)**2  
        ZCS = ZCS + ZZD1*ZB
        ZSS = ZSS + ZZD1*ZC
        PUM1(JL,JK) = PUM1(JL,JK) + 0.5_JPRB*ZABSV*PUM15(JL,JK)/&
         & SQRT(PUM15(JL,JK)**2+PVM15(JL,JK)**2)  
        PVM1(JL,JK) = PVM1(JL,JK) + 0.5_JPRB*ZABSV*PVM15(JL,JK)/&
         & SQRT(PUM15(JL,JK)**2+PVM15(JL,JK)**2)  
        ZCS = ZCS - ZSS
        ZPSI(JL,JK) = ZPSI(JL,JK) -2.0_JPRB*ZCS*&
         & SIN(ZPSI5(JL,JK))*COS(ZPSI5(JL,JK))     
      ENDIF
      
!LIMIT THE WIND TENDENCIES IN THE STRATOSPHERE
      IF(JK < NGWDLIM) THEN
        IF (LLTEST1(JL,JK)) THEN
          ZDUDT(JL)=0.0_JPRB
        ELSEIF (LLTEST2(JL,JK)) THEN
          ZDUDT(JL)=0.0_JPRB
        ENDIF    
        IF (LLTEST3(JL,JK)) THEN
          ZDVDT(JL)=0.0_JPRB
        ELSEIF (LLTEST4(JL,JK)) THEN
          ZDVDT(JL)=0.0_JPRB
        ENDIF    
      ENDIF
      
      ZS1 = ZS1 + ZDVDT (JL)*(ZVLOW5(JL)*ZD15(JL)+ZULOW5(JL)*ZD25(JL))
      ZD1 (JL) = ZD1 (JL) + ZDVDT (JL)*ZVLOW5(JL)*ZS155(JL,JK)
      ZVLOW (JL) = ZVLOW (JL) + ZDVDT (JL)*ZD15(JL)*ZS155(JL,JK)
      ZD2 (JL) = ZD2 (JL) + ZDVDT (JL)*ZULOW5(JL)*ZS155(JL,JK)
      ZULOW (JL) = ZULOW (JL) + ZDVDT (JL)*ZD25(JL)*ZS155(JL,JK)
      ZDVDT (JL) = 0.0_JPRB
      ZS1 = ZS1 + ZDUDT (JL)*(ZULOW5(JL)*ZD15(JL)-ZVLOW5(JL)*ZD25(JL))
      ZD1 (JL) = ZD1 (JL) + ZDUDT (JL)*ZULOW5(JL)*ZS155(JL,JK)
      ZULOW (JL) = ZULOW (JL) + ZDUDT (JL)*ZD15(JL)*ZS155(JL,JK)
      ZD2 (JL) = ZD2 (JL) - ZDUDT (JL)*ZVLOW5(JL)*ZS155(JL,JK)
      ZVLOW (JL) = ZVLOW (JL) - ZDUDT (JL)*ZD25(JL)*ZS155(JL,JK)
      ZDUDT (JL) = 0.0_JPRB
      ZTEMP = ZTEMP + ZS1/ZDMOD5(JL)
      ZDMOD(JL) = ZDMOD(JL) - ZS1*ZTEMP55(JL,JK)/ZDMOD5(JL)**2
! adjust in pressure < 10hPa      
      IF( PAPM15(JL,JK) < GRFPLM) THEN
        ZDELP05=PAPHM15(JL,IKTOP+1)-PAPHM15(JL,1)
        ZIDIV5=1._JPRB/(ZVPH5(JL,ILEVP1)*ZDELP05**2)
        ZTAU(JL,IKTOP+1)=ZTAU(JL,IKTOP+1)-RG*ZDELP5*ZTEMP*ZIDIV5
        ZTAU(JL,1)=ZTAU(JL,1)+RG*ZDELP5*ZTEMP*ZIDIV5
        ZDELP=ZDELP-RG*(ZTAU5(JL,IKTOP+1)-ZTAU5(JL,1))*ZTEMP*ZIDIV5
        ZDELP0=ZDELP0+RG*(ZTAU5(JL,IKTOP+1)-ZTAU5(JL,1))*&
         & ZDELP5*2._JPRB*ZTEMP*ZIDIV5
        ZVPH(JL,ILEVP1)=ZVPH(JL,ILEVP1)+RG*(ZTAU5(JL,IKTOP+1)-ZTAU5(JL,1))*&
         & ZDELP5*ZDELP05**2*ZTEMP*ZIDIV5**2
        PAPHM1 (JL,JK+1) = PAPHM1 (JL,JK+1) + ZDELP
        PAPHM1 (JL,JK  ) = PAPHM1 (JL,JK  ) - ZDELP
        PAPHM1 (JL,IKTOP+1)= PAPHM1 (JL,IKTOP+1) + ZDELP0
        PAPHM1 (JL,1  )  = PAPHM1 (JL,1  ) - ZDELP0
      ELSE
        ZIDIV5=1._JPRB/(ZVPH5(JL,ILEVP1)*ZDELP5)
        ZTAU(JL,JK+1) = ZTAU(JL,JK+1) - RG*ZTEMP*ZIDIV5
        ZTAU(JL,JK  ) = ZTAU(JL,JK  ) + RG*ZTEMP*ZIDIV5
        ZDELP = ZDELP + RG*(ZTAU5(JL,JK+1)-ZTAU5(JL,JK))*ZVPH5(JL,ILEVP1)*ZTEMP*ZIDIV5**2
        ZVPH(JL,ILEVP1) = ZVPH(JL,ILEVP1) + RG*ZTEMP*&
         & (ZTAU5(JL,JK+1)-ZTAU5(JL,JK))/&
         & (ZVPH5(JL,ILEVP1)**2*ZDELP5)  
        PAPHM1 (JL,JK+1) = PAPHM1 (JL,JK+1) + ZDELP
        PAPHM1 (JL,JK  ) = PAPHM1 (JL,JK  ) - ZDELP
      ENDIF
    ENDIF
  ENDDO

ENDDO

DO JL=KIDIA,KFDIA
  ZVIDIS (JL)=0.0_JPRB
  ZDUDT  (JL)=0.0_JPRB
  ZDVDT  (JL)=0.0_JPRB
  ZDTDT  (JL)=0.0_JPRB
ENDDO

!*         4.      COMPUTE STRESS PROFILE.
!*                 ------- ------ --------

!*    The initialisation to zero of the stress profile 
!*    for the trajectory [ZTAU5] is not necessary 

CALL GWPROFILAD &
 & ( KIDIA , KFDIA , KLON , KLEV,&
 & LLGWD,&
 & IKCRITH, ICRIT , IKENVH, IKNU,&
 & IKNU2 , PAPHM15, ZRHO5  , ZSTAB5 , ZVPH5,&
 & ZRI5  , ZTAU5  , ZDMOD5 , PSIG   ,PHSTD,&
 & PAPHM1, ZRHO   , ZSTAB  , ZVPH,&
 & ZRI   , ZTAU   , ZDMOD )  

!***********************************************************

!*         3.      COMPUTE THE SURFACE GRAVITY WAVE STRESS

DO JL=KIDIA,KFDIA
  IF(LLGWD(JL)) THEN
    ZBLOCK5=PGEOM15(JL,IKENVH(JL))/RG
    ZBLOCK=0.0_JPRB
    ZSTD=PHSTD(JL)
    ZEFF5=MAX(0.0_JPRB,3.0_JPRB*ZSTD-ZBLOCK5)
    ZEFF=0.0_JPRB
    ZCST=Z1D9*ZKDRAG*PSIG(JL)/ZSTD
    ZRHO(JL,KLEV+1) = ZRHO(JL,KLEV+1) + ZCST*ZTAU (JL,KLEV+1)*&
     & ZEFF5**2*ZVPH5(JL,KLEV+1)*ZDMOD5(JL)*&
     & SQRT(ZSTAB5(JL,KLEV+1))  
    ZEFF            = ZEFF            + ZCST*ZTAU (JL,KLEV+1)*&
     & ZRHO5(JL,KLEV+1)*2.0_JPRB*ZEFF5*ZVPH5(JL,KLEV+1)*ZDMOD5(JL)*&
     & SQRT(ZSTAB5(JL,KLEV+1))  
    ZVPH(JL,KLEV+1) = ZVPH(JL,KLEV+1) + ZCST*ZTAU (JL,KLEV+1)*&
     & ZRHO5(JL,KLEV+1)*ZEFF5**2*ZDMOD5(JL)*&
     & SQRT(ZSTAB5(JL,KLEV+1))  
    ZDMOD(JL) = ZDMOD(JL) + ZCST*ZTAU (JL,KLEV+1)*&
     & ZRHO5(JL,KLEV+1)*ZEFF5**2*ZVPH5(JL,KLEV+1)*                  &
     & SQRT(ZSTAB5(JL,KLEV+1))  
    ZSTAB(JL,KLEV+1) = ZSTAB(JL,KLEV+1) +ZCST*ZTAU (JL,KLEV+1)*&
     & ZRHO5(JL,KLEV+1)*ZEFF5**2*ZVPH5(JL,KLEV+1)*&
     & ZDMOD5(JL)/(2.0_JPRB*SQRT(ZSTAB5(JL,KLEV+1)))  

    ZTAU (JL,KLEV+1) = 0.0_JPRB

    IF (ZEFF5 == 0) THEN
      ZEFF=0.0_JPRB
    ELSE
      ZBLOCK=ZBLOCK-ZEFF
      ZEFF=0.0_JPRB
    ENDIF

    PGEOM1(JL,IKENVH(JL))=PGEOM1(JL,IKENVH(JL))+ZBLOCK/RG
    ZBLOCK=0.0_JPRB
  ELSE
    ZTAU (JL,KLEV+1)=0.0_JPRB
  ENDIF

ENDDO

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

!*         2.     PRECOMPUTE BASIC STATE VARIABLES.
!*                ---------- ----- ----- ----------

CALL GWSETUPAD &
 & ( KIDIA , KFDIA   , KLON    , KLEV  , LLGWD,&
 & IKCRITH , ICRIT,&
 & IKENVH, IKNU    , IKNU2,&
 & PAPHM15, PAPM15 , PUM15   , PVM15 , PTM15 , PGEOM15, PHSTD,&
 & ZRHO5  , ZRI5   , ZSTAB5  , ZTAU5 , ZVPH5 , ZPSI5  , ZZDEP5,&
 & ZULOW5 , ZVLOW5,&
 & PTHETA , PGAMMA , ZNU5    , ZD15  , ZD25  , ZDMOD5,&
 & PAPHM1 , PAPM1  , PUM1    , PVM1  , PTM1  , PGEOM1,&
 & ZRHO   , ZRI    , ZSTAB   , ZTAU  , ZVPH  , ZPSI   , ZZDEP,&
 & ZULOW  , ZVLOW,&
 & ZD1    , ZD2    , ZDMOD  )  

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

!*         1.4   SAVING PROGNOSTIC VARIABLES
!                ---------------------------

DO JK=1,KLEV
  DO JL=KIDIA,KFDIA
    PVOL (JL,JK) = PVOL (JL,JK) + ZVEA (JL,JK)
    ZTEA (JL,JK) = 0.0_JPRB
    PVOM (JL,JK) = PVOM (JL,JK) + ZUEA (JL,JK)
    ZUEA (JL,JK) = 0.0_JPRB
    PTE  (JL,JK) = PTE  (JL,JK) + ZTEA (JL,JK)
    ZTEA (JL,JK) = 0.0_JPRB
  ENDDO
ENDDO

!     Possible problem: dT/dt does not appear anymore in the GWD code,
!       but is accounted for in new CPTEND, CPUTQY

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