SUBROUTINE VDFDIFMSAD (KIDIA, KFDIA, KLON, KLEV, KTOP,&
 & PTMST ,PUM15 ,PVM15  ,PAPHM15 , PCFM5, PTOFDC5,&
 & PVOM5 ,PVOL5 ,PUDIF5 ,PVDIF5  ,&
 & PUM1  ,PVM1  ,PAPHM1 ,PCFM    , PTOFDC,&
 & PVOM  ,PVOL  ,PUDIF  ,PVDIF)  
!     ------------------------------------------------------------------

!**   *VDFDIFMSAD* - DOES THE IMPLICIT CALCULATION FOR MOMENTUM DIFFUSION
!                    (Adjoint)

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

!     adapted from

!     DERIVED FROM VDIFF (CY34) BY
!     A.C.M. BELJAARS       E.C.M.W.F.    10-11-89

!     MODIFIED
!     --------
!     M. Janiskova  - 29/07/2004 - AD of Turb. Orogr. Drag + cleaning

!     PURPOSE
!     -------

!     SOLVE TRIDIAGONAL MATRICES FOR MOMENTUM DIFFUSION

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

!     *VDFDIFMSAD* IS CALLED BY *VDFMAINSAD*

!*      INPUT PARAMETERS (INTEGER):

!     *KIDIA*        START POINT
!     *KFDIA*        END POINT
!     *KLEV*         NUMBER OF LEVELS
!     *KLON*         NUMBER OF GRID POINTS PER PACKET
!     *KTOP*         INDEX FOR BOUNDARY LAYER TOP

!*      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
!  PAPHM15     PAPHM1        PRESSURE AT T-1                           Pa
!  PCFM5       PCFM          PROP.TO EXCH.COEFF. FOR MOMENTUM 
!                                          (C,K-STAR IN DOC.)
!  PTOFDC5     PTOFDC        TURB. OROGR. DRAG (IMPLICIT) COEFFICIENTS 
!  PVOM5       PVOM          U-TENDENCY                                m/s2
!  PVOL5       PVOL          V-TENDENCY                                m/s2 

!*      OUTPUT PARAMETERS (REAL):
!  Trajectory  Perturbation  Description                               Unit
!  PUDIF5      PUDIF         U-DOUBLE-TILDE DEVIDED BY ALFA
!  PVDIF5      PVDIF         V-DOUBLE-TILDE DEVIDED BY ALFA


!     METHOD
!     ------

!     *LU*-DECOMPOSITION AND BACK SUBSTITUTION IN ONE DOWNWARD SCAN
!     AND ONE UPWARD SCAN.

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

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

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)    :: PAPHM15(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCFM5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTOFDC5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVOM5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVOL5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PUDIF5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PVDIF5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PUM1(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVM1(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PAPHM1(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCFM(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTOFDC(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVOM(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVOL(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PUDIF(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVDIF(KLON,KLEV) 
!*    LOCAL STORAGE
!     ----- -------

REAL(KIND=JPRB) ::  ZTCOE (KLON), ZEBSM (KLON,KLEV)
REAL(KIND=JPRB) ::  ZTCOE5(KLON,KLEV), ZEBSM5(KLON,KLEV)

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

REAL(KIND=JPRB) :: ZQDP5   (KLON,KLEV),&
 & ZDISC5    (KLON,KLEV), ZUDIF55A (KLON,KLEV),&
 & ZDISCI5   (KLON,KLEV),&
 & ZVDIF55A  (KLON,KLEV), ZUDIF55B (KLON,KLEV),&
 & ZVDIF55B  (KLON,KLEV), ZUDIF55C (KLON,KLEV),         &
 & ZVDIF55C  (KLON,KLEV), ZFAC5    (KLON,KLEV)  

INTEGER(KIND=JPIM) :: ILEVM1, ITOPP1, JK, JL

REAL(KIND=JPRB) :: ZDISC, ZFAC, ZQDP, ZTPFAC2
REAL(KIND=JPRB) :: ZDISCI
REAL(KIND=JPRB) :: ZHOOK_HANDLE

IF (LHOOK) CALL DR_HOOK('VDFDIFMSAD',0,ZHOOK_HANDLE)
ZTPFAC2 = 1.0_JPRB/RVDIFTS
ILEVM1 = -1+KLEV
ITOPP1 = 1+KTOP

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

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

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

!*         1.1     SETTING OF RIGHT HAND SIDES.

DO JK = KTOP, KLEV
  DO JL = KIDIA, KFDIA
    PUDIF5(JL,JK) = ZTPFAC2*PUM15(JL,JK)+PTMST*PVOM5(JL,JK)
    PVDIF5(JL,JK) = ZTPFAC2*PVM15(JL,JK)+PTMST*PVOL5(JL,JK)
  ENDDO
ENDDO

!*         1.2     TOP LAYER ELIMINATION.

DO JL = KIDIA, KFDIA
  ZTCOE5(JL,KTOP) = PCFM5(JL,KTOP)
  ZQDP5(JL,KTOP) = 1.0_JPRB/(PAPHM15(JL,ITOPP1)-PAPHM15(JL,KTOP))
  ZDISCI5(JL,KTOP) = 1.0_JPRB+PCFM5(JL,KTOP)*ZQDP5(JL,KTOP) &
   &               + PTOFDC5(JL,KTOP)
  ZDISC5(JL,KTOP) = 1.0_JPRB/ZDISCI5(JL,KTOP)
  ZEBSM5(JL,KTOP) = ZDISC5(JL,KTOP)*(PCFM5(JL,KTOP)*ZQDP5(JL,KTOP))
  ZUDIF55A (JL,KTOP) = PUDIF5(JL,KTOP)
  PUDIF5(JL,KTOP) = ZDISC5(JL,KTOP)*PUDIF5(JL,KTOP)
  ZVDIF55A (JL,KTOP) = PVDIF5(JL,KTOP)
  PVDIF5(JL,KTOP) = ZDISC5(JL,KTOP)*PVDIF5(JL,KTOP)
ENDDO

!*         1.3     ELIMINATION FOR MIDDLE LAYERS.

DO JK = ITOPP1, ILEVM1
  DO JL = KIDIA, KFDIA
    ZQDP5(JL,JK) = 1.0_JPRB/(PAPHM15(JL,JK+1)-PAPHM15(JL,JK))
    ZFAC5(JL,JK) = ZTCOE5(JL,JK-1)*ZQDP5(JL,JK)
    ZTCOE5(JL,JK) = PCFM5(JL,JK)
    ZDISCI5(JL,JK) = 1.0_JPRB+ZFAC5(JL,JK)*(1.0_JPRB-ZEBSM5(JL,JK-1)) &
     &      + PCFM5(JL,JK)*ZQDP5(JL,JK)+PTOFDC5(JL,JK)
    ZDISC5(JL,JK) = 1.0_JPRB/ZDISCI5(JL,JK)
    ZEBSM5(JL,JK) = ZDISC5(JL,JK)*(PCFM5(JL,JK)*ZQDP5(JL,JK))
    ZUDIF55A (JL,JK) = PUDIF5(JL,JK)
    ZUDIF55B (JL,JK-1) = PUDIF5(JL,JK-1)
    PUDIF5(JL,JK) =ZDISC5(JL,JK)*(PUDIF5(JL,JK) &
     &            +ZFAC5(JL,JK)*PUDIF5(JL,JK-1))
    ZVDIF55A (JL,JK) = PVDIF5(JL,JK)
    ZVDIF55B (JL,JK-1) = PVDIF5(JL,JK-1)
    PVDIF5(JL,JK) = ZDISC5(JL,JK)*(PVDIF5(JL,JK) &
     &            + ZFAC5(JL,JK)*PVDIF5(JL,JK-1))
  ENDDO
ENDDO

!*         1.4     BOTTOM LAYER ELIMINATION.

DO JL = KIDIA, KFDIA
  ZQDP5(JL,KLEV) = 1.0_JPRB/(PAPHM15(JL,KLEV+1)-PAPHM15(JL,KLEV))
  ZFAC5(JL,KLEV) = ZTCOE5(JL,ILEVM1)*ZQDP5(JL,KLEV)
  ZDISCI5(JL,KLEV) = 1.0_JPRB+ZFAC5(JL,KLEV)*(1.0_JPRB-ZEBSM5(JL,ILEVM1)) &
   &               + PCFM5(JL,KLEV)*ZQDP5(JL,KLEV)+PTOFDC5(JL,KLEV)
  ZDISC5(JL,KLEV) = 1.0_JPRB/ZDISCI5(JL,KLEV)
  ZUDIF55A (JL,KLEV) = PUDIF5(JL,KLEV)
  ZUDIF55B (JL,ILEVM1) = PUDIF5(JL,ILEVM1)
  PUDIF5(JL,KLEV) = ZDISC5(JL,KLEV)*(PUDIF5(JL,KLEV) &
   &              + ZFAC5(JL,KLEV)*PUDIF5(JL,ILEVM1))
  ZVDIF55A (JL,KLEV) = PVDIF5(JL,KLEV)
  ZVDIF55B (JL,ILEVM1) = PVDIF5(JL,ILEVM1)
  PVDIF5(JL,KLEV) = ZDISC5(JL,KLEV)*(PVDIF5(JL,KLEV) &
   &              + ZFAC5(JL,KLEV)*PVDIF5(JL,ILEVM1))
ENDDO

!*         1.5     BACK-SUBSTITUTION.

DO JK = ILEVM1, KTOP, -1
  DO JL = KIDIA, KFDIA
    ZUDIF55C (JL,JK+1) = PUDIF5(JL,JK+1)
    PUDIF5(JL,JK) = PUDIF5(JL,JK)+ZEBSM5(JL,JK)*PUDIF5(JL,JK+1)
    ZVDIF55C (JL,JK+1) = PVDIF5(JL,JK+1)
    PVDIF5(JL,JK) = PVDIF5(JL,JK)+ZEBSM5(JL,JK)*PVDIF5(JL,JK+1)
  ENDDO
ENDDO

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

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

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

!*                            INITIALISATIONS
!                             ---------------

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

DO JK=1,KLEV
  DO JL=KIDIA,KFDIA
    ZEBSM (JL,JK) = 0.0_JPRB
  ENDDO
ENDDO

!*         1.5     BACK-SUBSTITUTION.

DO JK = KTOP, ILEVM1
  DO JL = KIDIA, KFDIA
    ZEBSM(JL,JK) = ZEBSM(JL,JK) + PVDIF(JL,JK)*ZVDIF55C(JL,JK+1)
    PVDIF(JL,JK+1) = PVDIF(JL,JK+1) + PVDIF(JL,JK)*ZEBSM5(JL,JK)
    ZEBSM(JL,JK) = ZEBSM(JL,JK) + PUDIF(JL,JK)*ZUDIF55C(JL,JK+1)
    PUDIF(JL,JK+1) = PUDIF(JL,JK+1) + PUDIF(JL,JK)*ZEBSM5(JL,JK)
  ENDDO
ENDDO

!*         1.4     BOTTOM LAYER ELIMINATION.

DO JL = KIDIA, KFDIA

  ZDISC = 0.0_JPRB
  ZDISCI= 0.0_JPRB
  ZFAC  = 0.0_JPRB
  ZQDP  = 0.0_JPRB

  ZDISC = ZDISC + PVDIF(JL,KLEV)*&
   & (ZVDIF55A(JL,KLEV)+ZFAC5(JL,KLEV)*ZVDIF55B(JL,ILEVM1))  
  ZFAC = ZFAC + PVDIF(JL,KLEV)*ZDISC5(JL,KLEV)*ZVDIF55B(JL,ILEVM1)
  PVDIF(JL,ILEVM1) = PVDIF(JL,ILEVM1) + PVDIF(JL,KLEV)*&
   & ZDISC5(JL,KLEV)*ZFAC5(JL,KLEV)  
  PVDIF(JL,KLEV) = ZDISC5(JL,KLEV)*PVDIF(JL,KLEV)
  ZDISC = ZDISC + PUDIF(JL,KLEV)*&
   & (ZUDIF55A(JL,KLEV)+ZFAC5(JL,KLEV)*ZUDIF55B(JL,ILEVM1))  
  ZFAC = ZFAC + PUDIF(JL,KLEV)*ZDISC5(JL,KLEV)*ZUDIF55B(JL,ILEVM1)
  PUDIF(JL,ILEVM1) = PUDIF(JL,ILEVM1) + PUDIF(JL,KLEV)*&
   & ZDISC5(JL,KLEV)*ZFAC5(JL,KLEV)  
  PUDIF(JL,KLEV) = ZDISC5(JL,KLEV)*PUDIF(JL,KLEV)
  ZDISCI = ZDISCI-ZDISC/ZDISCI5(JL,KLEV)**2
  ZFAC = ZFAC+(1.0_JPRB-ZEBSM5(JL,ILEVM1))*ZDISCI
  ZEBSM(JL,ILEVM1) = ZEBSM(JL,ILEVM1)-ZFAC5(JL,KLEV)*ZDISCI
  ZQDP = ZQDP+PCFM5(JL,KLEV)*ZDISCI
  PCFM(JL,KLEV) = PCFM(JL,KLEV)+ZQDP5(JL,KLEV)*ZDISCI
  PTOFDC(JL,KLEV) = PTOFDC(JL,KLEV)+ZDISCI
  ZTCOE(JL) = ZTCOE(JL) + ZFAC*ZQDP5(JL,KLEV)
  ZQDP = ZQDP + ZFAC*ZTCOE5(JL,ILEVM1)
  PAPHM1(JL,KLEV+1) = PAPHM1(JL,KLEV+1) - ZQDP/&
   & (PAPHM15(JL,KLEV+1)-PAPHM15(JL,KLEV))**2  
  PAPHM1(JL,KLEV) = PAPHM1(JL,KLEV) + ZQDP/&
   & (PAPHM15(JL,KLEV+1)-PAPHM15(JL,KLEV))**2  
ENDDO

!*         1.3     ELIMINATION FOR MIDDLE LAYERS.

DO JK = ILEVM1, ITOPP1, -1
  DO JL = KIDIA, KFDIA

    ZDISC = 0.0_JPRB
    ZDISCI= 0.0_JPRB
    ZFAC  = 0.0_JPRB
    ZQDP  = 0.0_JPRB

    ZDISC = ZDISC + PVDIF(JL,JK)*&
     & (ZVDIF55A(JL,JK)+ZFAC5(JL,JK)*ZVDIF55B(JL,JK-1))  
    PVDIF(JL,JK-1) = PVDIF(JL,JK-1) + PVDIF(JL,JK)*&
     & ZDISC5(JL,JK)*ZFAC5(JL,JK)  
    ZFAC = ZFAC + PVDIF(JL,JK)*ZDISC5(JL,JK)*ZVDIF55B(JL,JK-1)
    PVDIF(JL,JK) = ZDISC5(JL,JK)*PVDIF(JL,JK)
    ZDISC = ZDISC + PUDIF(JL,JK)*&
     & (ZUDIF55A(JL,JK)+ZFAC5(JL,JK)*ZUDIF55B(JL,JK-1))  
    PUDIF(JL,JK-1) = PUDIF(JL,JK-1) + PUDIF(JL,JK)*&
     & ZDISC5(JL,JK)*ZFAC5(JL,JK)  
    ZFAC = ZFAC + PUDIF(JL,JK)*ZDISC5(JL,JK)*ZUDIF55B(JL,JK-1)
    PUDIF(JL,JK) = ZDISC5(JL,JK)*PUDIF(JL,JK)
    ZDISC = ZDISC + ZEBSM(JL,JK)*PCFM5(JL,JK)*ZQDP5(JL,JK)
    PCFM(JL,JK) = PCFM(JL,JK) + ZEBSM(JL,JK)*ZDISC5(JL,JK)*ZQDP5(JL,JK)
    ZQDP = ZQDP + ZEBSM(JL,JK)*PCFM5(JL,JK)*ZDISC5(JL,JK)
    ZEBSM(JL,JK) = 0.0_JPRB
    ZDISCI = ZDISCI-ZDISC/ZDISCI5(JL,JK)**2
    ZFAC = ZFAC+(1.0_JPRB-ZEBSM5(JL,JK-1))*ZDISCI
    ZEBSM (JL,JK-1) = ZEBSM (JL,JK-1)-ZFAC5(JL,JK)*ZDISCI
    ZQDP = ZQDP+PCFM5(JL,JK)*ZDISCI
    PCFM(JL,JK) = PCFM(JL,JK)+ZQDP5(JL,JK)*ZDISCI
    PTOFDC(JL,JK) = PTOFDC(JL,JK)+ZDISCI
    PCFM(JL,JK) =  PCFM(JL,JK) + ZTCOE(JL)
    ZTCOE(JL) = 0.0_JPRB
    ZTCOE(JL) = ZTCOE(JL) + ZFAC*ZQDP5(JL,JK)
    ZQDP = ZQDP + ZFAC*ZTCOE5 (JL,JK-1)
    PAPHM1(JL,JK+1) = PAPHM1(JL,JK+1) - ZQDP/&
     & (PAPHM15(JL,JK+1)-PAPHM15(JL,JK))**2  
    PAPHM1(JL,JK  ) = PAPHM1(JL,JK  ) + ZQDP/&
     & (PAPHM15(JL,JK+1)-PAPHM15(JL,JK))**2  
  ENDDO
ENDDO

!*         1.2     TOP LAYER ELIMINATION.

DO JL = KIDIA, KFDIA

  ZDISC = 0.0_JPRB
  ZDISCI= 0.0_JPRB
  ZQDP  = 0.0_JPRB

  ZDISC = ZDISC + PVDIF(JL,KTOP)*ZVDIF55A(JL,KTOP)
  PVDIF(JL,KTOP) = ZDISC5(JL,KTOP)*PVDIF(JL,KTOP)
  ZDISC = ZDISC + PUDIF(JL,KTOP)*ZUDIF55A(JL,KTOP)
  PUDIF(JL,KTOP) = ZDISC5(JL,KTOP)*PUDIF(JL,KTOP)
  ZDISC = ZDISC +  ZEBSM(JL,KTOP)*PCFM5(JL,KTOP)*ZQDP5(JL,KTOP)
  PCFM(JL,KTOP) = PCFM(JL,KTOP) + ZEBSM(JL,KTOP)*ZQDP5(JL,KTOP)*&
   & ZDISC5(JL,KTOP)   
  ZQDP = ZQDP + ZEBSM(JL,KTOP)*PCFM5(JL,KTOP)*ZDISC5(JL,KTOP)
  ZEBSM(JL,KTOP) = 0.0_JPRB
  ZDISCI = ZDISCI-ZDISC/ZDISCI5(JL,KTOP)**2
  ZQDP = ZQDP+PCFM5(JL,KTOP)*ZDISCI
  PCFM(JL,KTOP) = PCFM(JL,KTOP)+ZQDP5(JL,KTOP)*ZDISCI
  PTOFDC(JL,KTOP) = PTOFDC(JL,KTOP)+ZDISCI
  PAPHM1(JL,ITOPP1) = PAPHM1(JL,ITOPP1) - ZQDP/&
   & (PAPHM15(JL,ITOPP1)-PAPHM15(JL,KTOP))**2  
  PAPHM1(JL,KTOP  ) = PAPHM1(JL,KTOP  ) + ZQDP/&
   & (PAPHM15(JL,ITOPP1)-PAPHM15(JL,KTOP))**2  
  PCFM(JL,KTOP) = PCFM(JL,KTOP) + ZTCOE(JL)
  ZTCOE(JL) = 0.0_JPRB
ENDDO

!*         1.1     SETTING OF RIGHT HAND SIDES.

DO JK = KTOP, KLEV
  DO JL = KIDIA, KFDIA
    PVM1(JL,JK) = PVM1(JL,JK) + PVDIF(JL,JK)*ZTPFAC2
    PVOL(JL,JK) = PVOL(JL,JK) + PVDIF(JL,JK)*PTMST
    PVDIF(JL,JK) = 0.0_JPRB
    PUM1(JL,JK) = PUM1(JL,JK) + PUDIF(JL,JK)*ZTPFAC2
    PVOM(JL,JK) = PVOM(JL,JK) + PUDIF(JL,JK)*PTMST
    PUDIF(JL,JK) = 0.0_JPRB
  ENDDO
ENDDO

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

