SUBROUTINE VDFINCRSAD (KIDIA,KFDIA,KLON,KLEV,KTOP,PTMST,&
 & PUM15    ,PVM15 ,PTM15  ,PQM15  , PAPHM15, &
 & PGEOM15  ,PCFM5 ,PTOFDC5,PCPTGZ5,&
 & PUDIF5   ,PVDIF5,PTDIF5 ,PQDIF5 , &
 & PVOM5    ,PVOL5 ,PTE5   ,PQE5   ,&
 & PTEWODIS5,PVDIS5,PSTRTU5,PSTRTV5, &
 & PUM1     ,PVM1  ,PTM1   ,PQM1   ,PAPHM1, &
 & PGEOM1   ,PCFM  ,PTOFDC ,PCPTGZ ,&
 & PUDIF    ,PVDIF ,PTDIF  ,PQDIF  , &
 & PVOM     ,PVOL  ,PTE    ,PQE    , &
 & PTEWODIS ,PVDIS ,PSTRTU ,PSTRTV)  
!     ------------------------------------------------------------------

!**   *VDFINCRSAD* - INCREMENTS U,V,T AND Q-TENDENCIES; COMPUTE MULTILEVEL
!                    FLUXES AND DISSIPATION.
!                    (Adjoint)

!     J.F. MAHFOUF          E.C.M.W.F.    16/02/96

!     Adapted from

!     DERIVED FROM VDIFF (CY34) BY
!     A.C.M. BELJAARS       E.C.M.W.F.    18-1-90

!     OBUKHOV-L UPDATE      ACMB          26/03/90.

!     PURPOSE
!     -------

!     INCREMENT U,V,T AND Q; COMPUTE MULTILEVEL FLUXES AND DISSIPATION

!     INTERFACE
!     ---------

!     *VDFINCRSAD* IS CALLED BY *VDFMAINSAD*

!*      INPUT PARAMETERS (INTEGER):

!     *KIDIA*        START POINT
!     *KFDIA*        END POINT
!     *KLEV*         NUMBER OF LEVELS
!     *KLON*         NUMBER OF GRID POINTS PER PACKET

!*      OUTPUT PARAMETER (INTEGER):

!     *KTOP*         FIRST LEVEL INDEX WITHOUT ZERO-DIFFUSION

!*      INPUT PARAMETERS (REAL):

!     *PTMST*        DOUBLE TIME STEP (SINGLE AT 1TH STEP)

!*      INPUT PARAMETERS (REAL):
!  Trajectory  Perturbation  Description                               Unit
!  PUM15       PUM1          X-VELOCITY COMPONENT AT T-1               m/s
!  PVM15       PVM1          Y-VELOCITY COMPONENT AT T-1               m/s
!  PTM15       PTM1          TEMPERATURE AT T-1                        K
!  PQM15       PQM1          SPECIFIC HUMUDITY AT T-1                  kg/kg
!  PAPHM15     PAPHM1        PRESSURE AT T-1                           Pa
!  PGEOM15     PGEOM1        GEOPOTENTIAL AT T-1                       m2/s2
!  PCFM5       PCFM          PROP. TO EXCH. COEFF. FOR MOMENTUM
!                                              (C-STAR IN DOC.)
!  PTOFDC5     PTOFDC        TURBULENT OROGRAPHIC DRAG COEFFICIENT
!  PCPTGZ5     PCPTGZ        DRY STATIC ENERGY                         J/kg
!  PUDIF5      PUDIF         U-DOUBLE TILDE DEVIDED BY ALFA
!  PVDIF5      PVDIF         V-DOUBLE TILDE DEVIDED BY ALFA

!*      UPDATED PARAMETERS (REAL):
!  Trajectory  Perturbation  Description                               Unit
!  PTDIF5      PTDIF         S-DOUBLE TILDE DEVIDED BY ALFA (ON ENTRY)
!                            S-SINGLE TILDE                 (ON EXIT)
!  PQDIF5      PQDIF         Q-DOUBLE TILDE DEVIDED BY ALFA (ON ENTRY)
!                            Q-SINGLE TILDE                 (ON EXIT)
!  PVOM5       PVOM          U-TENDENCY                                m/s2
!  PVOL5       PVOL          V-TENDENCY                                m/s2
!  PTE5        PTE           T-TENDENCY                                K/s
!  PQE5        PQE           Q-TENDENCY                               kg/(kg s)

!*      OUTPUT PARAMETERS (REAL):
!  Trajectory  Perturbation  Description                               Unit
!  PVDIS5      PVDIS         DISSIPATION
!  PSTRTU5     PSTRTU        TURBULENT FLUX OF U-MOMEMTUM       kg*(m/s)/(m2*s)
!  PSTRTV5     PSTRTV        TURBULENT FLUX OF V-MOMEMTUM       kg*(m/s)/(m2*s)
!  PTEWODIS5   PTEWODIS      T-TENDENCY MINUS DISSIPATION


!     METHOD
!     ------

!     SEE DOCUMENTATION

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

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

USE YOMCST   , ONLY : RG       ,RCPD
USE YOETHF   , ONLY : RVTMP2
USE YOEVDF   , ONLY : RVDIFTS

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)    :: KTOP 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTMST 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PUM15(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVM15(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTM15(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQM15(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPHM15(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGEOM15(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCFM5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTOFDC5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCPTGZ5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PUDIF5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVDIF5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTDIF5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQDIF5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVOM5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVOL5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTE5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PQE5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTEWODIS5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PVDIS5(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSTRTU5(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSTRTV5(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PUM1(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVM1(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTM1(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQM1(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PAPHM1(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGEOM1(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCFM(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTOFDC(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCPTGZ(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PUDIF(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVDIF(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTDIF(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQDIF(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVOM(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVOL(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTE(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQE(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTEWODIS(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVDIS(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSTRTU(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSTRTV(KLON,0:KLEV) 
!*    LOCAL STORAGE
!     ----- -------

REAL(KIND=JPRB) ::    ZVIDIS(KLON),ZTAUU(KLON),ZTAUV(KLON)
REAL(KIND=JPRB) ::    ZVIDIS5(KLON),ZTAUU5(KLON),ZTAUV5(KLON)

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

REAL(KIND=JPRB) ::   ZLODIS5(KLON,KLEV),ZVOM55(KLON,KLEV),ZVOL55(KLON,KLEV)

INTEGER(KIND=JPIM) :: JK, JL

REAL(KIND=JPRB) :: ZCONS13, ZCONS15, ZDQDT, ZDQDT5, ZDTDT, ZDTDT5,&
 & ZDTWODIS, ZDTWODIS5, ZDUDT, ZDUDT5, ZDVDT, &
 & ZDVDT5, ZLODIS, ZTPFAC2, ZTPFAC3, &
 & ZTPFAC4, ZDP, ZDP5  
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

!*       1.     INITIALIZE CONSTANTS
!               ---------- ----------

IF (LHOOK) CALL DR_HOOK('VDFINCRSAD',0,ZHOOK_HANDLE)
ZTPFAC2 = 1.0_JPRB/RVDIFTS
ZTPFAC3 = 1.0_JPRB-ZTPFAC2
ZTPFAC4 = 1.0_JPRB+ZTPFAC3

ZCONS13 = 1.0_JPRB/PTMST
ZCONS15 = 1.0_JPRB/(RG*PTMST)

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

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

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

!*       2.    COMPUTE TENDENCIES AND BUDGETS
!              ------- ---------- --- -------

DO JL = KIDIA, KFDIA
  ZVIDIS5(JL) = 0.0_JPRB
  ZTAUU5(JL)  = 0.0_JPRB
  ZTAUV5(JL)  = 0.0_JPRB
ENDDO

!***  
DO JK = KTOP, KLEV
!***      
  DO JL = KIDIA, KFDIA
    ZDUDT5 = ZCONS13*(PUDIF5(JL,JK)-ZTPFAC2*PUM15(JL,JK))
    ZDVDT5 = ZCONS13*(PVDIF5(JL,JK)-ZTPFAC2*PVM15(JL,JK))
    ZLODIS5(JL,JK) = 0.5_JPRB*((ZTPFAC2*PUM15(JL,JK)-PUDIF5(JL,JK)+&
     & PTMST*PVOM5(JL,JK))*(ZTPFAC4*PUM15(JL,JK)+&
     & PUDIF5(JL,JK))+(ZTPFAC2*PVM15(JL,JK)-&
     & PVDIF5(JL,JK)+PTMST*PVOL5(JL,JK))*&
     & (ZTPFAC4*PVM15(JL,JK)+PVDIF5(JL,JK)))  
    ZVOM55(JL,JK)=PVOM5(JL,JK)
    ZVOL55(JL,JK)=PVOL5(JL,JK)
    PVOM5(JL,JK) = ZDUDT5
    PVOL5(JL,JK) = ZDVDT5
    ZDP5=PAPHM15(JL,JK)-PAPHM15(JL,JK-1)
    ZVIDIS5(JL) =ZVIDIS5(JL)+ZLODIS5(JL,JK)*ZDP5

    PQDIF5(JL,JK) = PQDIF5(JL,JK)+ZTPFAC3*PQM15(JL,JK)
    ZDQDT5 = ZCONS13*(PQDIF5(JL,JK)-PQM15(JL,JK))
    PQE5(JL,JK) = ZDQDT5

    PTDIF5(JL,JK) = PTDIF5(JL,JK)+ZTPFAC3*PCPTGZ5(JL,JK)
    ZDTDT5 = ZCONS13*((PTDIF5(JL,JK)+ZLODIS5(JL,JK)-PGEOM15(JL,JK))/&
     & (RCPD*(1.0_JPRB+RVTMP2*PQDIF5(JL,JK)))-PTM15(JL,JK))  
    PTE5(JL,JK) = ZDTDT5
    ZDTWODIS5 = ZCONS13*((PTDIF5(JL,JK)-PGEOM15(JL,JK))/&
     & (RCPD*(1.0_JPRB+RVTMP2*PQDIF5(JL,JK)))-PTM15(JL,JK))  
    PTEWODIS5(JL,JK) = ZDTWODIS5

!   INTEGRATE TOFD TENDENCIES TO GET SURFACE STRESS

    ZTAUU5(JL)=PUDIF5(JL,JK)*PTOFDC5(JL,JK)*ZDP5*ZCONS15+ZTAUU5(JL)
    ZTAUV5(JL)=PVDIF5(JL,JK)*PTOFDC5(JL,JK)*ZDP5*ZCONS15+ZTAUV5(JL)

  ENDDO

ENDDO

!*         2.2     COMPUTE SURFACE STRESSES AND COPY DISSIPATION

DO JL = KIDIA, KFDIA
  PSTRTU5(JL,KLEV) = ZCONS15*PCFM5(JL,KLEV)*PUDIF5(JL,KLEV)+ZTAUU5(JL)
  PSTRTV5(JL,KLEV) = ZCONS15*PCFM5(JL,KLEV)*PVDIF5(JL,KLEV)+ZTAUV5(JL)
  PVDIS5(JL) = ZCONS15*ZVIDIS5(JL)
ENDDO

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

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

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

!*         2.3     INITIALISATIONS

DO JL=KIDIA,KFDIA
  ZVIDIS(JL) = 0.0_JPRB
  ZTAUU (JL) = 0.0_JPRB
  ZTAUV (JL) = 0.0_JPRB
ENDDO

!*         2.2     COMPUTE SURFACE STRESSES AND COPY DISSIPATION

DO JL = KIDIA, KFDIA
  ZVIDIS(JL)      = ZVIDIS(JL) + PVDIS(JL)*ZCONS15
  PVDIS(JL)       = 0.0_JPRB
  PVDIF(JL,KLEV)  = PVDIF(JL,KLEV) + PSTRTV(JL,KLEV)*ZCONS15*PCFM5(JL,KLEV)
  PCFM(JL,KLEV)   = PCFM(JL,KLEV)  + PSTRTV(JL,KLEV)*ZCONS15*PVDIF5(JL,KLEV)
  ZTAUV(JL)       = ZTAUV(JL)      + PSTRTV(JL,KLEV)
  PSTRTV(JL,KLEV) = 0.0_JPRB
  PUDIF(JL,KLEV)  = PUDIF(JL,KLEV) + PSTRTU(JL,KLEV)*ZCONS15*PCFM5(JL,KLEV)
  PCFM(JL,KLEV)   = PCFM(JL,KLEV)  + PSTRTU(JL,KLEV)*ZCONS15*PUDIF5(JL,KLEV)
  ZTAUU(JL)       = ZTAUU(JL)      + PSTRTU(JL,KLEV)
  PSTRTU(JL,KLEV) = 0.0_JPRB
ENDDO

!***  
DO JK = KLEV, KTOP, -1
!***      
  DO JL = KIDIA, KFDIA

    ZDTWODIS = 0.0_JPRB
    ZDTDT    = 0.0_JPRB
    ZLODIS   = 0.0_JPRB
    ZDUDT    = 0.0_JPRB
    ZDVDT    = 0.0_JPRB
    ZDQDT    = 0.0_JPRB
    ZDP      = 0.0_JPRB
    ZDP5=PAPHM15(JL,JK)-PAPHM15(JL,JK-1)

    ZDP=ZDP+PVDIF5(JL,JK)*PTOFDC5(JL,JK)*ZCONS15*ZTAUV(JL)
    PTOFDC(JL,JK)=PTOFDC(JL,JK)+PVDIF5(JL,JK)*ZDP5*ZCONS15*ZTAUV(JL)
    PVDIF(JL,JK)=PVDIF(JL,JK)+PTOFDC5(JL,JK)*ZDP5*ZCONS15*ZTAUV(JL)

    ZDP=ZDP+PUDIF5(JL,JK)*PTOFDC5(JL,JK)*ZCONS15*ZTAUU(JL)
    PTOFDC(JL,JK)=PTOFDC(JL,JK)+PUDIF5(JL,JK)*ZDP5*ZCONS15*ZTAUU(JL)
    PUDIF(JL,JK)=PUDIF(JL,JK)+PTOFDC5(JL,JK)*ZDP5*ZCONS15*ZTAUU(JL)

    ZDTWODIS = ZDTWODIS + PTEWODIS(JL,JK)
    PTEWODIS(JL,JK) = 0.0_JPRB
    PTDIF(JL,JK)  = PTDIF(JL,JK) + ZDTWODIS*ZCONS13/&
     & (RCPD*(1.0_JPRB+RVTMP2*PQDIF5(JL,JK)))  
    PGEOM1(JL,JK) = PGEOM1(JL,JK) - ZDTWODIS*ZCONS13/&
     & (RCPD*(1.0_JPRB+RVTMP2*PQDIF5(JL,JK)))  
    PQDIF(JL,JK)  = PQDIF(JL,JK) - ZDTWODIS*ZCONS13*RCPD*RVTMP2*&
     & (PTDIF5(JL,JK)-PGEOM15(JL,JK))/&
     & (RCPD*(1.0_JPRB+RVTMP2*PQDIF5(JL,JK)))**2  
    PTM1(JL,JK)  = PTM1(JL,JK) - ZDTWODIS*ZCONS13
    ZDTDT = ZDTDT + PTE(JL,JK)
    PTE (JL,JK) = 0.0_JPRB
    PTDIF(JL,JK)  = PTDIF(JL,JK) + ZDTDT*ZCONS13/&
     & (RCPD*(1.0_JPRB+RVTMP2*PQDIF5(JL,JK)))  
    ZLODIS        = ZLODIS + ZDTDT*ZCONS13/&
     & (RCPD*(1.0_JPRB+RVTMP2*PQDIF5(JL,JK)))  
    PGEOM1(JL,JK) = PGEOM1(JL,JK) - ZDTDT*ZCONS13/&
     & (RCPD*(1.0_JPRB+RVTMP2*PQDIF5(JL,JK)))  
    PQDIF(JL,JK)  = PQDIF(JL,JK) - ZDTDT*ZCONS13*RCPD*RVTMP2*&
     & (PTDIF5(JL,JK)+ZLODIS5(JL,JK)-PGEOM15(JL,JK))/&
     & (RCPD*(1.0_JPRB+RVTMP2*PQDIF5(JL,JK)))**2  
    PTM1(JL,JK)  = PTM1(JL,JK) - ZDTDT*ZCONS13
    PCPTGZ(JL,JK) = PCPTGZ(JL,JK) + PTDIF(JL,JK)*ZTPFAC3

    ZDQDT = ZDQDT + PQE(JL,JK)
    PQE(JL,JK) = 0.0_JPRB
    PQDIF(JL,JK) = PQDIF(JL,JK) + ZCONS13*ZDQDT
    PQM1(JL,JK) = PQM1(JL,JK) - ZCONS13*ZDQDT
    PQM1(JL,JK) = PQM1(JL,JK) + PQDIF(JL,JK)*ZTPFAC3

    ZLODIS=ZLODIS+ZDP5*ZVIDIS(JL)
    ZDP=ZDP+ZLODIS5(JL,JK)*ZVIDIS(JL)
    PAPHM1(JL,JK)=PAPHM1(JL,JK)+ZDP
    PAPHM1(JL,JK-1)=PAPHM1(JL,JK-1)-ZDP

    ZDUDT = ZDUDT + PVOM(JL,JK)
    PVOM(JL,JK) = 0.0_JPRB
    ZDVDT = ZDVDT + PVOL(JL,JK)
    PVOL(JL,JK) = 0.0_JPRB
    PUM1(JL,JK) = PUM1(JL,JK) + 0.5_JPRB*ZLODIS*&
     & (2.0_JPRB*ZTPFAC2*ZTPFAC4*PUM15(JL,JK) + &
     & PUDIF5(JL,JK)*(ZTPFAC2-ZTPFAC4) + &
     & ZTPFAC4*PTMST*ZVOM55(JL,JK))  
    PUDIF(JL,JK) = PUDIF(JL,JK) + 0.5_JPRB*ZLODIS*&
     & (PUM15(JL,JK)*(ZTPFAC2-ZTPFAC4)-&
     & 2.0_JPRB*PUDIF5(JL,JK)+PTMST*ZVOM55(JL,JK))  
    PVOM(JL,JK) = PVOM(JL,JK) + 0.5_JPRB*ZLODIS*PTMST*&
     & (ZTPFAC4*PUM15(JL,JK) + PUDIF5(JL,JK))  
    PVM1(JL,JK) = PVM1(JL,JK) + 0.5_JPRB*ZLODIS*&
     & (2.0_JPRB*ZTPFAC2*ZTPFAC4*PVM15(JL,JK) + &
     & PVDIF5(JL,JK)*(ZTPFAC2-ZTPFAC4) + &
     & ZTPFAC4*PTMST*ZVOL55(JL,JK))  
    PVDIF(JL,JK) = PVDIF(JL,JK) + 0.5_JPRB*ZLODIS*&
     & (PVM15(JL,JK)*(ZTPFAC2-ZTPFAC4)-&
     & 2.0_JPRB*PVDIF5(JL,JK)+PTMST*ZVOL55(JL,JK))  
    PVOL(JL,JK) = PVOL(JL,JK) + 0.5_JPRB*ZLODIS*PTMST*&
     & (ZTPFAC4*PVM15(JL,JK) + PVDIF5(JL,JK))  
    PVDIF(JL,JK) = PVDIF(JL,JK) + ZDVDT*ZCONS13
    PVM1(JL,JK) = PVM1(JL,JK) - ZDVDT*ZCONS13*ZTPFAC2
    PUDIF(JL,JK) = PUDIF(JL,JK) + ZDUDT*ZCONS13
    PUM1(JL,JK) = PUM1(JL,JK) - ZDUDT*ZCONS13*ZTPFAC2
  ENDDO

ENDDO

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

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

