SUBROUTINE VDFDIFM1S(KIDIA,KFDIA,KLON,KLEV,KTOP,&
 & PTMST,PUM1,PVM1,PAPHM1,PCFM,&
 & PVOM,PVOL,PUDIF,PVDIF)  
!     ------------------------------------------------------------------

!**   *VDFDIFM* - DOES THE IMLPLICIT CALCULATION FOR MOMENTUM DIFFUSION

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

!     PURPOSE
!     -------

!     SOLVE TRIDIAGONAL MATRICES FOR MOMENTUM DIFFUSION

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

!     *VDFDIFM* IS CALLED BY *VDFMAIN*

!     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)
!     *PUM1*         X-VELOCITY COMPONENT AT T-1
!     *PVM1*         Y-VELOCITY COMPONENT AT T-1
!     *PAPHM1*       PRESSURE AT T-1
!     *PCFM*         PROP.TO EXCH.COEFF. FOR MOMENTUM (C,K-STAR IN DOC.)
!     *PVOM*         U-TENDENCY
!     *PVOL*         V-TENDENCY

!     OUTPUT PARAMETERS (REAL):

!     *PUDIF*        U-DOUBLE-TILDE DEVIDED BY ALFA
!     *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)    :: PUM1(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVM1(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPHM1(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCFM(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVOM(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVOL(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PUDIF(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PVDIF(KLON,KLEV) 
!*    LOCAL STORAGE
!     ----- -------

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

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

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

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

!*         1.1     SETTING OF RIGHT HAND SIDES.

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

!1s !*         1.2     TOP LAYER ELIMINATION.
!1s 
!1s DO JL=KIDIA,KFDIA
!1s   ZTCOE(JL)=PCFM(JL,KTOP)
!1s   ZQDP=1.0_JPRB/(PAPHM1(JL,ITOPP1)-PAPHM1(JL,KTOP))
!1s   ZDISC=1.0_JPRB/(1.0_JPRB+PCFM(JL,KTOP)*ZQDP)
!1s   ZEBSM(JL,KTOP)=ZDISC*(PCFM(JL,KTOP)*ZQDP)
!1s   PUDIF(JL,KTOP)=ZDISC*PUDIF(JL,KTOP)
!1s   PVDIF(JL,KTOP)=ZDISC*PVDIF(JL,KTOP)
!1s ENDDO
!1s 
!1s !*         1.3     ELIMINATION FOR MIDDLE LAYERS.
!1s 
!1s DO JK=ITOPP1,ILEVM1
!1s   DO JL=KIDIA,KFDIA
!1s     ZQDP=1.0_JPRB/(PAPHM1(JL,JK+1)-PAPHM1(JL,JK))
!1s     ZFAC=ZTCOE(JL)*ZQDP
!1s     ZTCOE(JL)=PCFM(JL,JK)
!1s     ZDISC=1.0_JPRB/(1.0_JPRB+ZFAC*(1.0_JPRB-ZEBSM(JL,JK-1))+PCFM(JL,JK)*ZQDP)
!1s     ZEBSM(JL,JK)=ZDISC*(PCFM(JL,JK)*ZQDP)
!1s     PUDIF(JL,JK)=ZDISC*(PUDIF(JL,JK)+ZFAC*PUDIF(JL,JK-1))
!1s     PVDIF(JL,JK)=ZDISC*(PVDIF(JL,JK)+ZFAC*PVDIF(JL,JK-1))
!1s   ENDDO
!1s ENDDO
!1s 
!1s !*         1.4     BOTTOM LAYER ELIMINATION.
!1s 
!1s DO JL=KIDIA,KFDIA
!1s   ZQDP=1.0_JPRB/(PAPHM1(JL,KLEV+1)-PAPHM1(JL,KLEV))
!1s   ZFAC=ZTCOE(JL)*ZQDP
!1s   ZDISC=1.0_JPRB/(1.0_JPRB+ZFAC*(1.0_JPRB-ZEBSM(JL,ILEVM1))+PCFM(JL,KLEV)*ZQDP)
!1s   PUDIF(JL,KLEV)=ZDISC*(PUDIF(JL,KLEV)+ZFAC*PUDIF(JL,ILEVM1))
!1s   PVDIF(JL,KLEV)=ZDISC*(PVDIF(JL,KLEV)+ZFAC*PVDIF(JL,ILEVM1))
!1s ENDDO
!1s 
!1s !*         1.5     BACK-SUBSTITUTION.
!1s 
!1s DO JK=ILEVM1,KTOP,-1
!1s   DO JL=KIDIA,KFDIA
!1s     PUDIF(JL,JK)=PUDIF(JL,JK)+ZEBSM(JL,JK)*PUDIF(JL,JK+1)
!1s     PVDIF(JL,JK)=PVDIF(JL,JK)+ZEBSM(JL,JK)*PVDIF(JL,JK+1)
!1s   ENDDO
!1s ENDDO

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