SUBROUTINE CUDUDVTL ( &
 & KIDIA,    KFDIA,    KLON,   KLEV,&
 & KTOPM2,   KTYPE,    KCBOT,    KCTOP,    LDCUM,    PTSPHY,&
 & PAPH5,    PUEN5,    PVEN5,    PMFU5,    PMFD5,&
 & PUU5,     PUD5,     PVU5,     PVD5,&
 & PTENU5,   PTENV5,&
 & PDMFEN5,  PDMFDE5,&
 & PUEN,     PVEN,&
 & PTENU,    PTENV  )  

!**** *CUDUDVTL* - UPDATES U AND V TENDENCIES,
!                  DOES GLOBAL DIAGNOSTIC OF DISSIPATION
!                  (Tangent linear)

!          J.F. MAHFOUF           E.C.M.W.F.     06/12/96
!          P.LOPEZ+P.BECHTOLD     E.C.M.W.F.     11/02/05 IMPLICIT SOLVER

!          Adapted from 

!          M.TIEDTKE         E.C.M.W.F.     7/86 MODIF. 12/89

!**   INTERFACE.
!     ----------

!          *CUDUDVTL* IS CALLED FROM *CUMASTRNTL*

!     PARAMETER     DESCRIPTION                                   UNITS
!     ---------     -----------                                   -----
!     INPUT PARAMETERS (INTEGER):

!    *KIDIA*        START POINT
!    *KFDIA*        END POINT
!    *KLON*         NUMBER OF GRID POINTS PER PACKET
!    *KLEV*         NUMBER OF LEVELS
!    *KTYPE*        TYPE OF CONVECTION
!                       1 = PENETRATIVE CONVECTION
!                       2 = SHALLOW CONVECTION
!                       3 = MIDLEVEL CONVECTION
!    *KCBOT*        CLOUD BASE LEVEL
!    *KCTOP*        CLOUD TOP LEVEL

!    INPUT PARAMETERS (LOGICAL):

!    *LDCUM*        FLAG: .TRUE. FOR CONVECTIVE POINTS 

!    INPUT PARAMETERS (REAL):

!    *PTSPHY*       PHYSICS TIME-STEP                              S
!    *PAPH5*        PROVISIONAL PRESSURE ON HALF LEVELS        (Trajectory)  
!    *PUEN5*        PROVISIONAL ENVIRONMENT U-VELOCITY (T+1)   (Trajectory)  
!    *PVEN5*        PROVISIONAL ENVIRONMENT V-VELOCITY (T+1)   (Trajectory)  
!    *PMFU5*        MASSFLUX UPDRAFTS                          (Trajectory)  
!    *PMFD5*        MASSFLUX DOWNDRAFTS                        (Trajectory)  
!    *PUU5*         U-VELOCITY IN UPDRAFTS                     (Trajectory)  
!    *PUD5*         U-VELOCITY IN DOWNDRAFTS                   (Trajectory)  
!    *PVU5*         V-VELOCITY IN UPDRAFTS                     (Trajectory)  
!    *PVD5*         V-VELOCITY IN DOWNDRAFTS                   (Trajectory)
!    *PDMFEN5*      VARIATION IN UPDRAFT MASS FLUX             (Trajectory)
!    *PDMFDE5*      VARIATION IN DOWNRAFT MASS FLUX            (Trajectory)  

!    *PUEN*         PROVISIONAL ENVIRONMENT U-VELOCITY (T+1)       M/S
!    *PVEN*         PROVISIONAL ENVIRONMENT V-VELOCITY (T+1)       M/S

!    UPDATED PARAMETERS (REAL):

!    *PTENU5*       TENDENCY OF U-COMP. OF WIND                (Trajectory)  
!    *PTENV5*       TENDENCY OF V-COMP. OF WIND                (Trajectory)  

!    *PTENU*        TENDENCY OF U-COMP. OF WIND                    M/S2
!    *PTENV*        TENDENCY OF V-COMP. OF WIND                    M/S2

!          METHOD
!          -------
!     EXPLICIT UPSTREAM AND IMPLICIT SOLUTION OF VERTICAL ADVECTION
!     DEPENDING ON VALUE OF RMFSOLUV: 0=EXPLICIT >=1 IMPLICIT 0-1 SEMI-IMPLICIT

!     FOR EXPLICIT SOLUTION: ONLY ONE SINGLE ITERATION
!     FOR IMPLICIT SOLUTION: FIRST IMPLICIT SOLVER, THEN EXPLICIT SOLVER
!                            TO CORRECT TENDENCIES BELOW CLOUD BASE

!          EXTERNALS
!          ---------
!          CUBIDIAGTL

!          MODIFICATIONS
!          -------------
!             92-09-21 : Update to Cy44      J.-J. MORCRETTE
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!----------------------------------------------------------------------

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

USE YOMCST   , ONLY : RG
USE YOECUMF  , ONLY : RMFSOLUV

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)    :: KTOPM2 
INTEGER(KIND=JPIM),INTENT(IN)    :: KTYPE(KLON) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KCBOT(KLON)
INTEGER(KIND=JPIM),INTENT(IN)    :: KCTOP(KLON)
LOGICAL           ,INTENT(INOUT) :: LDCUM(KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTSPHY
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPH5(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PUEN5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVEN5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PMFU5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PMFD5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PUU5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PUD5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVU5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVD5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTENU5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTENV5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDMFEN5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDMFDE5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PUEN(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVEN(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTENU(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTENV(KLON,KLEV) 

REAL(KIND=JPRB) :: ZMFUU5(KLON,KLEV),  ZMFDU5(KLON,KLEV),&
                  &ZMFUV5(KLON,KLEV),  ZMFDV5(KLON,KLEV),&
                  &ZUEN5(KLON,KLEV),   ZVEN5(KLON,KLEV)

REAL(KIND=JPRB) :: ZMFUU(KLON,KLEV),   ZMFDU(KLON,KLEV),&
                  &ZMFUV(KLON,KLEV),   ZMFDV(KLON,KLEV),&
                  &ZUEN(KLON,KLEV),    ZVEN(KLON,KLEV)

INTEGER(KIND=JPIM) :: IK, IKB, JK, JL

REAL(KIND=JPRB) :: ZZP5, ZIMP, ZTSPHY

!       ALLOCATABLE ARAYS
REAL(KIND=JPRB),   DIMENSION(:,:), ALLOCATABLE :: ZDP5, ZDUDT5, ZDVDT5&
                                                &,ZA5,  ZB5,    ZR15,  ZR25
REAL(KIND=JPRB),   DIMENSION(:,:), ALLOCATABLE ::       ZDUDT,      ZDVDT&
                                                &,ZA,   ZB,    ZR1,   ZR2

LOGICAL,DIMENSION(:,:),   ALLOCATABLE ::  LLCUMBAS 
REAL(KIND=JPRB) :: ZHOOK_HANDLE


#include "cubidiagtl.intfb.h"
!----------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('CUDUDVTL',0,ZHOOK_HANDLE)
ZIMP=1.0_JPRB-RMFSOLUV
ZTSPHY=1.0_JPRB/PTSPHY

! Trajectory arrays

ALLOCATE(ZDUDT5(KLON,KLEV))
ALLOCATE(ZDVDT5(KLON,KLEV))
ALLOCATE(ZDP5(KLON,KLEV))

! Tangent-linear perturbation arrays

ALLOCATE(ZDUDT(KLON,KLEV))
ALLOCATE(ZDVDT(KLON,KLEV))


!         MASS-FLUX APPROACH SWITCHED ON FOR DEEP CONVECTION ONLY
!         -------------------------------------------------------

do jl=kidia,kfdia
  if (ktype(jl) /= 1) ldcum(jl)=.false.
enddo

! Initialize Cumulus mask + setups

DO JK=1,KLEV
   DO JL=KIDIA,KFDIA
     IF(LDCUM(JL)) THEN   
       ZUEN5(JL,JK)=PUEN5(JL,JK)
       ZVEN5(JL,JK)=PVEN5(JL,JK)
       ZUEN(JL,JK) =PUEN(JL,JK)
       ZVEN(JL,JK) =PVEN(JL,JK)
       ZDP5(JL,JK)=RG/(PAPH5(JL,JK+1)-PAPH5(JL,JK))
     ENDIF
   ENDDO 
ENDDO 

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

     
!*    1.0          CALCULATE FLUXES AND UPDATE U AND V TENDENCIES
!                  ----------------------------------------------

   DO JK=KTOPM2,KLEV
     IK=JK-1
     DO JL=KIDIA,KFDIA
       IF(LDCUM(JL)) THEN
         ZMFUU5(JL,JK)=PMFU5(JL,JK)*(PUU5(JL,JK)-ZIMP*ZUEN5(JL,IK))
         ZMFUV5(JL,JK)=PMFU5(JL,JK)*(PVU5(JL,JK)-ZIMP*ZVEN5(JL,IK))
         ZMFDU5(JL,JK)=PMFD5(JL,JK)*(PUD5(JL,JK)-ZIMP*ZUEN5(JL,IK))
         ZMFDV5(JL,JK)=PMFD5(JL,JK)*(PVD5(JL,JK)-ZIMP*ZVEN5(JL,IK))
         ZMFUU(JL,JK)=-ZIMP*PMFU5(JL,JK)*ZUEN(JL,IK)
         ZMFUV(JL,JK)=-ZIMP*PMFU5(JL,JK)*ZVEN(JL,IK)
         ZMFDU(JL,JK)=-ZIMP*PMFD5(JL,JK)*ZUEN(JL,IK)
         ZMFDV(JL,JK)=-ZIMP*PMFD5(JL,JK)*ZVEN(JL,IK)
       ENDIF
     ENDDO
   ENDDO
   
! linear fluxes below cloud 
  IF(RMFSOLUV==0.0_JPRB) THEN  
    DO JK=KTOPM2,KLEV
    !DIR$ IVDEP
    !OCL NOVREC
      DO JL=KIDIA,KFDIA
        IF(LDCUM(JL).AND.JK > KCBOT(JL)) THEN   
           IKB=KCBOT(JL)
           ZZP5=((PAPH5(JL,KLEV+1)-PAPH5(JL,JK))/(PAPH5(JL,KLEV+1)-PAPH5(JL,IKB)))
           IF(KTYPE(JL) == 3) ZZP5=ZZP5*ZZP5
           ZMFUU (JL,JK)=ZMFUU (JL,IKB)*ZZP5
           ZMFUU5(JL,JK)=ZMFUU5(JL,IKB)*ZZP5
           ZMFUV (JL,JK)=ZMFUV (JL,IKB)*ZZP5
           ZMFUV5(JL,JK)=ZMFUV5(JL,IKB)*ZZP5
           ZMFDU (JL,JK)=ZMFDU (JL,IKB)*ZZP5
           ZMFDU5(JL,JK)=ZMFDU5(JL,IKB)*ZZP5
           ZMFDV (JL,JK)=ZMFDV (JL,IKB)*ZZP5
           ZMFDV5(JL,JK)=ZMFDV5(JL,IKB)*ZZP5
         ENDIF
       ENDDO
     ENDDO
   ENDIF

!*      1.2          COMPUTE TENDENCIES
!                    ------------------
     
   DO JK=KTOPM2,KLEV

     IF(JK < KLEV) THEN
        IK=JK+1
        DO JL=KIDIA,KFDIA
          IF(LDCUM(JL)) THEN
            ZDUDT5(JL,JK)=ZDP5(JL,JK)*&
             &(ZMFUU5(JL,IK)-ZMFUU5(JL,JK)+ZMFDU5(JL,IK)-ZMFDU5(JL,JK))
            ZDVDT5(JL,JK)=ZDP5(JL,JK)*&
             &(ZMFUV5(JL,IK)-ZMFUV5(JL,JK)+ZMFDV5(JL,IK)-ZMFDV5(JL,JK))
          ENDIF
        ENDDO
       ! perturbed tendencies: 
        DO JL=KIDIA,KFDIA
          IF(LDCUM(JL)) THEN 
            IKB=KCBOT(JL)-1
            IF(JK<=IKB) THEN 
        ! as no perturbation of mass flux, substract udM/dp from total flux gradient
              ZDUDT(JL,JK) =ZDP5(JL,JK)*(ZMFUU(JL,IK)-ZMFUU(JL,JK)+&
                           &             ZMFDU(JL,IK)-ZMFDU(JL,JK)-&
                           &(PDMFEN5(JL,JK)+PDMFDE5(JL,JK))*PUEN(JL,JK))
              ZDVDT(JL,JK) =ZDP5(JL,JK)*(ZMFUV(JL,IK)-ZMFUV(JL,JK)+&
                           &             ZMFDV(JL,IK)-ZMFDV(JL,JK)-&
                           &(PDMFEN5(JL,JK)+PDMFDE5(JL,JK))*PVEN(JL,JK))
            ELSEIF(JK>IKB) THEN
              ZZP5=((PAPH5(JL,KLEV+1)-PAPH5(JL,JK))/&
             &      (PAPH5(JL,KLEV+1)-PAPH5(JL,IKB)))  
              ZDUDT(JL,JK)=ZDUDT(JL,IKB)*ZZP5
              ZDVDT(JL,JK)=ZDVDT(JL,IKB)*ZZP5  
            ENDIF
          ENDIF
        ENDDO

     ELSE       
        DO JL=KIDIA,KFDIA
          IF(LDCUM(JL)) THEN
            ZDUDT5(JL,JK)=-ZDP5(JL,JK)*(ZMFUU5(JL,JK)+ZMFDU5(JL,JK))
            ZDVDT5(JL,JK)=-ZDP5(JL,JK)*(ZMFUV5(JL,JK)+ZMFDV5(JL,JK))
            IKB=KCBOT(JL)-1
            ZZP5=((PAPH5(JL,KLEV+1)-PAPH5(JL,JK))/&
           &      (PAPH5(JL,KLEV+1)-PAPH5(JL,IKB)))  
            ZDUDT(JL,JK)=ZDUDT(JL,IKB)*ZZP5
            ZDVDT(JL,JK)=ZDVDT(JL,IKB)*ZZP5
          ENDIF
        ENDDO
     ENDIF

   ENDDO   

   IF ( RMFSOLUV==0.0_JPRB ) THEN


!*      1.3          UPDATE TENDENCIES
!                    -----------------

      DO JK=KTOPM2,KLEV
        DO JL=KIDIA,KFDIA
          IF(LDCUM(JL)) THEN
            PTENU5(JL,JK)=PTENU5(JL,JK)+ZDUDT5(JL,JK)
            PTENV5(JL,JK)=PTENV5(JL,JK)+ZDVDT5(JL,JK)
            PTENU(JL,JK) =PTENU(JL,JK) +ZDUDT(JL,JK)
            PTENV(JL,JK) =PTENV(JL,JK) +ZDVDT(JL,JK)
          ENDIF
        ENDDO
      ENDDO

   ELSE
!----------------------------------------------------------------------
      
!*      1.6          IMPLICIT SOLUTION
!                    -----------------

     ! Fill bi-diagonal Matrix vectors A=k-1, B=k;
     ! ZDUDT and ZDVDT correspond to the RHS ("constants") of the equation
     ! The solution is in ZR1 and ZR2
     
      ALLOCATE(ZA5(KLON,KLEV))
      ALLOCATE(ZB5(KLON,KLEV))
      ALLOCATE(ZA(KLON,KLEV))
      ALLOCATE(ZB(KLON,KLEV))
      ALLOCATE(ZR15(KLON,KLEV))
      ALLOCATE(ZR25(KLON,KLEV))
      ALLOCATE(ZR1(KLON,KLEV))
      ALLOCATE(ZR2(KLON,KLEV))     
      ALLOCATE(LLCUMBAS(KLON,KLEV))
      LLCUMBAS(:,:)=.FALSE.
      ZB5(:,:)=1.0_JPRB
      ZA5(:,:)=0.0_JPRB
      ZB(:,:)=0.0_JPRB
      ZA(:,:)=0.0_JPRB
     
     ! Fill vectors A, B and RHS 
     
      DO JK=KTOPM2,KLEV
         IK=JK+1
         DO JL=KIDIA,KFDIA
           LLCUMBAS(JL,JK)=LDCUM(JL).AND.JK>=KCTOP(JL)-1 
           IF(LLCUMBAS(JL,JK)) THEN
             ZZP5=RMFSOLUV*ZDP5(JL,JK)*PTSPHY
             ZA5(JL,JK)    =-ZZP5*(PMFU5(JL,JK)+PMFD5(JL,JK))
             ZA(JL,JK)     = 0.0_JPRB
             ZDUDT5(JL,JK) = ZDUDT5(JL,JK)*PTSPHY+ZUEN5(JL,JK)
             ZDVDT5(JL,JK) = ZDVDT5(JL,JK)*PTSPHY+ZVEN5(JL,JK)
           ! ZDUDT5(JL,JK) = (PTENU5(JL,JK)+ZDUDT5(JL,JK))*PTSPHY+ZUEN5(JL,JK)
           ! ZDVDT5(JL,JK) = (PTENV5(JL,JK)+ZDVDT5(JL,JK))*PTSPHY+ZVEN5(JL,JK)
             ZDUDT(JL,JK)  = ZDUDT(JL,JK)*PTSPHY+ZUEN(JL,JK)
             ZDVDT(JL,JK)  = ZDVDT(JL,JK)*PTSPHY+ZVEN(JL,JK)
           ! ZDUDT(JL,JK)  = (PTENU(JL,JK)+ZDUDT(JL,JK))*PTSPHY+ZUEN(JL,JK)
           ! ZDVDT(JL,JK)  = (PTENV(JL,JK)+ZDVDT(JL,JK))*PTSPHY+ZVEN(JL,JK)
             IF(JK<KLEV) THEN
               ZB5(JL,JK)  = 1.0_JPRB+ZZP5*(PMFU5(JL,IK)+PMFD5(JL,IK))
             ELSE
               ZB5(JL,JK)  = 1.0_JPRB
             ENDIF
             ZB(JL,JK)     = 0._JPRB
           ENDIF
         ENDDO
      ENDDO
     
      CALL CUBIDIAGTL&
         &( KIDIA, KFDIA, KLON, KLEV, &
         &  KCTOP, LLCUMBAS, &
         &  ZA5,   ZB5,    ZDUDT5,   ZR15, &
         &  ZA,    ZB ,    ZDUDT,    ZR1  )
     
      CALL CUBIDIAGTL&
         &( KIDIA, KFDIA, KLON, KLEV, &
         &  KCTOP, LLCUMBAS, &
         &  ZA5,   ZB5,    ZDVDT5,   ZR25, &
         &  ZA,    ZB ,    ZDVDT,    ZR2 )

     
     ! Compute tendencies
     
      DO JK=KTOPM2,KLEV
         DO JL=KIDIA,KFDIA
           IF(LLCUMBAS(JL,JK)) THEN
             PTENU5(JL,JK)=PTENU5(JL,JK)+(ZR15(JL,JK)-ZUEN5(JL,JK))*ZTSPHY
           ! PTENU5(JL,JK)=(ZR15(JL,JK)-ZUEN5(JL,JK))*ZTSPHY
             PTENU (JL,JK)=PTENU (JL,JK)+(ZR1 (JL,JK)-ZUEN (JL,JK))*ZTSPHY
           ! PTENU (JL,JK)=(ZR1 (JL,JK)-ZUEN (JL,JK))*ZTSPHY

             PTENV5(JL,JK)=PTENV5(JL,JK)+(ZR25(JL,JK)-ZVEN5(JL,JK))*ZTSPHY
           ! PTENV5(JL,JK)=(ZR25(JL,JK)-ZVEN5(JL,JK))*ZTSPHY
             PTENV (JL,JK)=PTENV (JL,JK)+(ZR2 (JL,JK)-ZVEN (JL,JK))*ZTSPHY
           ! PTENV (JL,JK)=(ZR2 (JL,JK)-ZVEN (JL,JK))*ZTSPHY
           ENDIF
         ENDDO
      ENDDO
     
      DEALLOCATE(LLCUMBAS)
      DEALLOCATE(ZR2)
      DEALLOCATE(ZR1)
      DEALLOCATE(ZR25)
      DEALLOCATE(ZR15)
      DEALLOCATE(ZB)
      DEALLOCATE(ZA)
      DEALLOCATE(ZB5)
      DEALLOCATE(ZA5)
     
   ENDIF
!----------------------------------------------------------------------


DEALLOCATE(ZDVDT)
DEALLOCATE(ZDUDT)

DEALLOCATE(ZDP5)
DEALLOCATE(ZDVDT5)
DEALLOCATE(ZDUDT5)

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




