SUBROUTINE VDFDIFCSTL(KIDIA,KFDIA,KLON,KLEV,KTOP,KTRAC,PTMST,&
                   & PCM15,PTENC5,PAPHM15,PCFH5,PCFLX5,&  
                   & PCM1 ,PTENC ,PAPHM1 ,PCFH ,PCFLX )  
!     ------------------------------------------------------------------

!**   *VDFDIFCSTL* - Does the implicit computation for diffusion of tracers
!                   (TL version)

!     P. Lopez       ECMWF    18-01-2006

!     PURPOSE
!     -------

!     Solve the tridiagonal equations for the diffusion of tracers. 

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

!     *VDFDIFCSTL* is called by *VDFMAINSTL*

!     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
!     *KTRAC*        Number of tracers

!     INPUT PARAMETERS (REAL):

!     *PTMST*        Time step                                         (s)

!     *PCM15*        Tracer concentration at T-1                       (kg/kg)
!     *PAPHM15*      Pressure AT T-1                                   (Pa)
!     *PCFH5*        Prop. to exch. coeff. (K-star in doc.)
!     *PCFLX5*       Surface flux boundary condition for tracers       (kg/m2s)

!     *PCM1*         Perturbation of tracer concentration at T-1       (kg/kg)
!     *PAPHM1*       Perturbation of pressure AT T-1                   (Pa)
!     *PCFH*         Perturbation of Prop. to exch. coeff. (K-star in doc.)
!     *PCFLX *       Perturbation of surface flux boundary condition for tracers  (kg/m2s)

!     UPDATED PARAMETERS (REAL):

!     *PTENC5*        Tendency of tracer concentration                  (1/s)
!     *PTENC *        Perturbation of tendency of tracer concentration  (1/s)

!     METHOD
!     ------

!     *LU*-decomposition (downward scan), followed by 
!     back substitution (upward scan).

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

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

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

USE YOMCST   , ONLY : RG
!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 
INTEGER(KIND=JPIM),INTENT(IN)    :: KTRAC 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTMST 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCM15(KLON,KLEV,KTRAC) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTENC5(KLON,KLEV,KTRAC) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPHM15(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCFH5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCFLX5(KLON,KTRAC) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCM1(KLON,KLEV,KTRAC) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTENC(KLON,KLEV,KTRAC) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPHM1(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCFH(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCFLX(KLON,KTRAC) 

!*    LOCAL STORAGE
!     ----- -------

REAL(KIND=JPRB) ::  ZTCOE5(KLON),ZEBSH5(KLON,KLEV)
REAL(KIND=JPRB) ::  ZACL5(KLON),ZBCL5(KLON,KTRAC),ZDISC5(KLON)
REAL(KIND=JPRB) ::  ZFAC5(KLON),ZCDIF5(KLON,KLEV,KTRAC)

REAL(KIND=JPRB) ::  ZTCOE(KLON),ZEBSH(KLON,KLEV)
REAL(KIND=JPRB) ::  ZACL(KLON),ZBCL(KLON,KTRAC),ZDISC(KLON)
REAL(KIND=JPRB) ::  ZFAC(KLON),ZCDIF(KLON,KLEV,KTRAC)

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

REAL(KIND=JPRB) :: ZALF,ZQDP5,ZTPFAC2,ZCOEF2,ZCONS13,ZQDP
REAL(KIND=JPRB) :: ZHOOK_HANDLE

IF (LHOOK) CALL DR_HOOK('VDFDIFCSTL',0,ZHOOK_HANDLE)
!ZALF=RVDIFTS
ZALF=1.0_JPRB
ZTPFAC2=1.0_JPRB/ZALF
ZCONS13=1.0_JPRB/PTMST
ILEVM1=KLEV-1
ITOPP1=KTOP+1

!*         1.1      Setting of right hand sides.

DO JTR=1,KTRAC
  DO JK=KTOP,KLEV
    DO JL=KIDIA,KFDIA
      ZCDIF5(JL,JK,JTR)= ZTPFAC2*PCM15(JL,JK,JTR)+PTMST*PTENC5(JL,JK,JTR)
      ZCDIF (JL,JK,JTR)= ZTPFAC2*PCM1 (JL,JK,JTR)+PTMST*PTENC (JL,JK,JTR)
    ENDDO
  ENDDO
ENDDO


!*         2.1     Top layer elimination.

DO JL=KIDIA,KFDIA
  ZTCOE5(JL)=PCFH5(JL,KTOP)
  ZTCOE (JL)=PCFH (JL,KTOP)
  
  ZQDP5=1.0_JPRB/(PAPHM15(JL,ITOPP1)-PAPHM15(JL,KTOP))
  ZQDP =-(PAPHM1(JL,ITOPP1)-PAPHM1(JL,KTOP))*ZQDP5**2.0_JPRB
  
  ZDISC5(JL)=1.0_JPRB/(1.0_JPRB+PCFH5(JL,KTOP)*ZQDP5)
  ZDISC (JL)=-(PCFH(JL,KTOP)*ZQDP5+PCFH5(JL,KTOP)*ZQDP)*ZDISC5(JL)**2.0_JPRB

  ZEBSH5(JL,KTOP)=ZDISC5(JL)*(PCFH5(JL,KTOP)*ZQDP5)
  ZEBSH (JL,KTOP)=ZDISC (JL)*(PCFH5(JL,KTOP)*ZQDP5) &
             &   +ZDISC5(JL)*(PCFH (JL,KTOP)*ZQDP5) &
             &   +ZDISC5(JL)*(PCFH5(JL,KTOP)*ZQDP )
ENDDO
DO JTR=1,KTRAC
  DO JL=KIDIA,KFDIA
    ZCDIF (JL,KTOP,JTR)=ZDISC (JL)*ZCDIF5(JL,KTOP,JTR) &
                     & +ZDISC5(JL)*ZCDIF (JL,KTOP,JTR)
    ZCDIF5(JL,KTOP,JTR)=ZDISC5(JL)*ZCDIF5(JL,KTOP,JTR)
  ENDDO
ENDDO

!*         2.2     Elimination for middle layers.

DO JK=ITOPP1,ILEVM1
  DO JL=KIDIA,KFDIA
    ZQDP5=1.0_JPRB/(PAPHM15(JL,JK+1)-PAPHM15(JL,JK))
    ZQDP =-(PAPHM1(JL,JK+1)-PAPHM1(JL,JK))*ZQDP5**2.0_JPRB

    ZFAC5(JL)=ZTCOE5(JL)*ZQDP5
    ZFAC (JL)=ZTCOE (JL)*ZQDP5+ZTCOE5(JL)*ZQDP

    ZTCOE5(JL)=PCFH5(JL,JK)
    ZTCOE (JL)=PCFH (JL,JK)

    ZDISC5(JL)=1.0_JPRB/(1.0_JPRB+ZFAC5(JL)*(1.0_JPRB-ZEBSH5(JL,JK-1))+PCFH5(JL,JK)*ZQDP5)
    ZDISC (JL)=-(ZFAC (JL)*(1.0_JPRB-ZEBSH5(JL,JK-1)) &
            & -  ZFAC5(JL)*ZEBSH (JL,JK-1) &
            & +  PCFH (JL,JK)*ZQDP5 &
            & +  PCFH5(JL,JK)*ZQDP ) &
            & *  ZDISC5(JL)**2.0_JPRB

    ZEBSH5(JL,JK)=ZDISC5(JL)*(PCFH5(JL,JK)*ZQDP5)
    ZEBSH (JL,JK)=ZDISC (JL)*(PCFH5(JL,JK)*ZQDP5) &
             &   +ZDISC5(JL)*(PCFH (JL,JK)*ZQDP5) &
             &   +ZDISC5(JL)*(PCFH5(JL,JK)*ZQDP )
  ENDDO
  DO JTR=1,KTRAC
    DO JL=KIDIA,KFDIA
      ZCDIF (JL,JK,JTR)=ZDISC (JL)*(ZCDIF5(JL,JK,JTR)+ZFAC5(JL)*ZCDIF5(JL,JK-1,JTR)) &
                     & +ZDISC5(JL)*(ZCDIF (JL,JK,JTR) &
                     & +ZFAC (JL)*ZCDIF5(JL,JK-1,JTR) &
                     & +ZFAC5(JL)*ZCDIF (JL,JK-1,JTR))
      ZCDIF5(JL,JK,JTR)=ZDISC5(JL)*(ZCDIF5(JL,JK,JTR)+ZFAC5(JL)*ZCDIF5(JL,JK-1,JTR))
    ENDDO
  ENDDO
ENDDO

!*         2.3     Bottom layer, linear relation between lowest  
!                  model level concentrations and fluxes.
!                  ZACL : Acl in Cl=Acl*Jc+Bcl                (m2s/kg)
!                  ZBCL : Bcl in Cl=Acl*Jc+Bcl                (kg/kg)

JK=KLEV
DO JL=KIDIA,KFDIA
  ZQDP5=1.0_JPRB/(PAPHM15(JL,JK+1)-PAPHM15(JL,JK))
  ZQDP =-(PAPHM1 (JL,JK+1)-PAPHM1 (JL,JK))*ZQDP5**2.0_JPRB

  ZFAC5(JL)=ZTCOE5(JL)*ZQDP5
  ZFAC (JL)=ZTCOE (JL)*ZQDP5+ZTCOE5(JL)*ZQDP

  ZDISC5(JL)=1.0_JPRB/(1.0_JPRB+ZFAC5(JL)*(1.0_JPRB-ZEBSH5(JL,JK-1)))
  ZDISC (JL)=-(ZFAC (JL)*(1.0_JPRB-ZEBSH5(JL,JK-1)) &
          & -  ZFAC5(JL)*ZEBSH (JL,JK-1)) &
          & * ZDISC5(JL)**2.0_JPRB

  ZACL5(JL)=-ZDISC5(JL)*RG*PTMST*ZQDP5*ZALF
  ZACL (JL)=-RG*PTMST*ZALF*(ZDISC (JL)*ZQDP5+ZDISC5(JL)*ZQDP )
ENDDO
DO JTR=1,KTRAC
  DO JL=KIDIA,KFDIA
    ZBCL5(JL,JTR)=ZDISC5(JL)*(ZCDIF5(JL,JK,JTR)+ZFAC5(JL)*ZCDIF5(JL,JK-1,JTR))*ZALF
    ZBCL (JL,JTR)=( ZDISC (JL)*(ZCDIF5(JL,JK,JTR)+ZFAC5(JL)*ZCDIF5(JL,JK-1,JTR)) &
               & +  ZDISC5(JL)*(ZCDIF (JL,JK,JTR)+ZFAC (JL)*ZCDIF5(JL,JK-1,JTR) &
               & +  ZFAC5(JL)*ZCDIF (JL,JK-1,JTR)) )*ZALF
  ENDDO
ENDDO

!*         3.     Compute lowest model level concentrations 

ZCOEF2=1.0_JPRB/ZALF
DO JTR=1,KTRAC
  DO JL=KIDIA,KFDIA
    ZCDIF5(JL,KLEV,JTR)=ZCOEF2*(ZACL5(JL)*PCFLX5(JL,JTR)+ZBCL5(JL,JTR))
    ZCDIF (JL,KLEV,JTR)=ZCOEF2*(ZACL (JL)*PCFLX5(JL,JTR) &
                     & +        ZACL5(JL)*PCFLX (JL,JTR)+ZBCL (JL,JTR))
  ENDDO
ENDDO

!*         4.     Back-substitution.

DO JTR=1,KTRAC
  DO JK=ILEVM1,KTOP,-1
    DO JL=KIDIA,KFDIA
      ZCDIF (JL,JK,JTR)=ZCDIF (JL,JK,JTR)+ZEBSH (JL,JK)*ZCDIF5(JL,JK+1,JTR) &
                     & +ZEBSH5(JL,JK)*ZCDIF (JL,JK+1,JTR)
      ZCDIF5(JL,JK,JTR)=ZCDIF5(JL,JK,JTR)+ZEBSH5(JL,JK)*ZCDIF5(JL,JK+1,JTR)
    ENDDO
  ENDDO
ENDDO

!*         5.    Update tendency (ZCDIF is C-hat divided by alpha in kg/kg)


DO JTR=1,KTRAC
  DO JK=KTOP,KLEV
    DO JL=KIDIA,KFDIA
      PTENC5(JL,JK,JTR)=(ZCDIF5(JL,JK,JTR)-ZTPFAC2*PCM15(JL,JK,JTR))*ZCONS13
      PTENC (JL,JK,JTR)=(ZCDIF (JL,JK,JTR)-ZTPFAC2*PCM1 (JL,JK,JTR))*ZCONS13
    ENDDO
  ENDDO
ENDDO


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





