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

!**   *VDFDIFCSAD* - Does the implicit computation for diffusion of tracers
!                   (Adjoint version)

!     P. Lopez       ECMWF    18-01-2006

!     PURPOSE
!     -------

!     Solve the tridiagonal equations for the diffusion of tracers. 

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

!     *VDFDIFCSAD* 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
!     *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)

!     UPDATED PARAMETERS (REAL):

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

!     *PTENC *       Perturbation of tendency of tracer concentration  (1/s)
!     *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)

!     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
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(INOUT) :: PCM1(KLON,KLEV,KTRAC) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTENC(KLON,KLEV,KTRAC) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PAPHM1(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCFH(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCFLX(KLON,KTRAC) 

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

REAL(KIND=JPRB) ::  ZTCOE5(KLON,KLEV-1),ZEBSH5(KLON,KLEV)
REAL(KIND=JPRB) ::  ZACL5(KLON),ZBCL5(KLON,KTRAC),ZDISC5(KLON,KLEV)
REAL(KIND=JPRB) ::  ZFAC5(KLON,KTOP+1:KLEV),ZCDIF5(KLON,KLEV,KTRAC)
REAL(KIND=JPRB) ::  ZCDIF15(KLON,KLEV,KTRAC),ZCDIF25(KLON,KLEV-1,KTRAC)
REAL(KIND=JPRB) ::  ZQDP5(KLON,KLEV)

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,ZTPFAC2,ZCOEF2,ZCONS13,ZQDP,ZFAC1 
REAL(KIND=JPRB) :: ZHOOK_HANDLE

IF (LHOOK) CALL DR_HOOK('VDFDIFCSAD',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)
    ENDDO
  ENDDO
ENDDO


!*         2.1     Top layer elimination.

DO JL=KIDIA,KFDIA
  ZTCOE5(JL,KTOP)=PCFH5(JL,KTOP)
  ZQDP5(JL,KTOP)=1.0_JPRB/(PAPHM15(JL,ITOPP1)-PAPHM15(JL,KTOP))
  ZDISC5(JL,KTOP)=1.0_JPRB/(1.0_JPRB+PCFH5(JL,KTOP)*ZQDP5(JL,KTOP))
  ZEBSH5(JL,KTOP)=ZDISC5(JL,KTOP)*(PCFH5(JL,KTOP)*ZQDP5(JL,KTOP))
ENDDO
DO JTR=1,KTRAC
  DO JL=KIDIA,KFDIA
! Store trajectory for adjoint
    ZCDIF15(JL,KTOP,JTR)=ZCDIF5(JL,KTOP,JTR)
    ZCDIF5(JL,KTOP,JTR)=ZDISC5(JL,KTOP)*ZCDIF5(JL,KTOP,JTR)
  ENDDO
ENDDO

!*         2.2     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)=PCFH5(JL,JK)
    ZDISC5(JL,JK)=1.0_JPRB/(1.0_JPRB+ZFAC5(JL,JK)*(1.0_JPRB-ZEBSH5(JL,JK-1))&
               & +PCFH5(JL,JK)*ZQDP5(JL,JK))
    ZEBSH5(JL,JK)=ZDISC5(JL,JK)*(PCFH5(JL,JK)*ZQDP5(JL,JK))
  ENDDO
  DO JTR=1,KTRAC
    DO JL=KIDIA,KFDIA
! Store trajectory for adjoint
      ZCDIF15(JL,JK,JTR)=ZCDIF5(JL,JK,JTR)
      ZCDIF25(JL,JK-1,JTR)=ZCDIF5(JL,JK-1,JTR)
      ZCDIF5(JL,JK,JTR)=ZDISC5(JL,JK) &
                     & *(ZCDIF5(JL,JK,JTR)+ZFAC5(JL,JK)*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(JL,JK)=1.0_JPRB/(PAPHM15(JL,JK+1)-PAPHM15(JL,JK))
  ZFAC5(JL,JK)=ZTCOE5(JL,JK-1)*ZQDP5(JL,JK)
  ZDISC5(JL,JK)=1.0_JPRB/(1.0_JPRB+ZFAC5(JL,JK)*(1.0_JPRB-ZEBSH5(JL,JK-1)))
  ZACL5(JL)=-ZDISC5(JL,JK)*RG*PTMST*ZQDP5(JL,JK)*ZALF
ENDDO
DO JTR=1,KTRAC
  DO JL=KIDIA,KFDIA
! Store trajectory for adjoint
    ZCDIF15(JL,JK,JTR)=ZCDIF5(JL,JK,JTR)  
    ZCDIF25(JL,JK-1,JTR)=ZCDIF5(JL,JK-1,JTR)  
    ZBCL5(JL,JTR)=ZDISC5(JL,JK) &
               & *(ZCDIF5(JL,JK,JTR)+ZFAC5(JL,JK)*ZCDIF5(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))
  ENDDO
ENDDO

!*         4.     Back-substitution.

DO JTR=1,KTRAC
  DO JK=ILEVM1,KTOP,-1
    DO JL=KIDIA,KFDIA
      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
    ENDDO
  ENDDO
ENDDO

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

!*****                ADJOINT CALCULATIONS                    *********

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

! Initializations

ZCDIF(:,:,:)=0.0_JPRB
ZEBSH(:,:)=0.0_JPRB
ZACL(:)=0.0_JPRB
ZBCL(:,:)=0.0_JPRB
ZTCOE(:)=0.0_JPRB

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

DO JTR=1,KTRAC
  DO JK=KLEV,KTOP,-1
    DO JL=KIDIA,KFDIA
      ZCDIF(JL,JK,JTR) = ZCDIF(JL,JK,JTR) +         ZCONS13*PTENC(JL,JK,JTR)
      PCM1 (JL,JK,JTR) = PCM1 (JL,JK,JTR) - ZTPFAC2*ZCONS13*PTENC(JL,JK,JTR)
      PTENC(JL,JK,JTR)=0.0_JPRB
    ENDDO
  ENDDO
ENDDO

!*         4.     Back-substitution.

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

!*         3.     Compute lowest model level concentrations 

DO JTR=1,KTRAC
  DO JL=KIDIA,KFDIA
    ZACL(JL)     = ZACL(JL)      + ZCOEF2*PCFLX5(JL,JTR)*ZCDIF(JL,KLEV,JTR)
    PCFLX(JL,JTR)= PCFLX(JL,JTR) + ZCOEF2*ZACL5(JL)*ZCDIF(JL,KLEV,JTR)
    ZBCL(JL,JTR) = ZBCL(JL,JTR)  + ZCOEF2*ZCDIF(JL,KLEV,JTR)
    ZCDIF(JL,KLEV,JTR)=0.0_JPRB
  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)

ZDISC(:)=0.0_JPRB
ZFAC(:)=0.0_JPRB

JK=KLEV
DO JTR=1,KTRAC
  DO JL=KIDIA,KFDIA
    ZDISC(JL) = ZDISC(JL)+(ZCDIF15(JL,JK,JTR) + ZFAC5(JL,JK)*ZCDIF25(JL,JK-1,JTR))&
            & * ZALF*ZBCL(JL,JTR)
    ZCDIF(JL,JK,JTR) = ZCDIF(JL,JK,JTR) + ZDISC5(JL,JK)*ZALF*ZBCL(JL,JTR)
    ZFAC(JL) = ZFAC(JL) + ZDISC5(JL,JK)*ZCDIF25(JL,JK-1,JTR)*ZALF*ZBCL(JL,JTR)
    ZCDIF(JL,JK-1,JTR) = ZCDIF(JL,JK-1,JTR) + ZDISC5(JL,JK)*ZFAC5(JL,JK)*ZALF*ZBCL(JL,JTR)
    ZBCL(JL,JTR)=0.0_JPRB
  ENDDO
ENDDO

DO JL=KIDIA,KFDIA
  ZQDP=0.0_JPRB

  ZDISC(JL)=ZDISC(JL)-RG*PTMST*ZALF*ZQDP5(JL,JK)*ZACL(JL)
  ZQDP     =ZQDP     -RG*PTMST*ZALF*ZDISC5(JL,JK)*ZACL(JL)
  ZACL(JL)=0.0_JPRB

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

  ZTCOE(JL)=ZTCOE(JL)+ZQDP5(JL,JK)*ZFAC(JL)
  ZQDP     =ZQDP     +ZTCOE5(JL,JK-1)*ZFAC(JL)
  ZFAC(JL)=0.0_JPRB

  ZFAC1=(ZQDP5(JL,JK)**2.0_JPRB)*ZQDP
  PAPHM1(JL,JK+1)=PAPHM1(JL,JK+1)-ZFAC1
  PAPHM1(JL,JK  )=PAPHM1(JL,JK  )+ZFAC1
  ZQDP=0.0_JPRB
ENDDO

!*         2.2     Elimination for middle layers.

ZDISC(:)=0.0_JPRB
ZFAC(:)=0.0_JPRB

DO JK=ILEVM1,ITOPP1,-1
  DO JTR=1,KTRAC
    DO JL=KIDIA,KFDIA
      ZDISC(JL) = ZDISC(JL) + (ZCDIF15(JL,JK,JTR)+ZFAC5(JL,JK)*ZCDIF25(JL,JK-1,JTR)) &
              & * ZCDIF(JL,JK,JTR)
      ZFAC(JL) = ZFAC(JL) + ZDISC5(JL,JK)*ZCDIF25(JL,JK-1,JTR)*ZCDIF(JL,JK,JTR)
      ZCDIF(JL,JK-1,JTR) = ZCDIF(JL,JK-1,JTR) &
                       & + ZDISC5(JL,JK)*ZFAC5(JL,JK)*ZCDIF(JL,JK,JTR)
      ZCDIF(JL,JK,JTR) = ZDISC5(JL,JK)*ZCDIF(JL,JK,JTR)
    ENDDO
  ENDDO
  DO JL=KIDIA,KFDIA
    ZQDP=0.0_JPRB

    ZDISC(JL)  = ZDISC(JL)  +PCFH5 (JL,JK)*ZQDP5(JL,JK)*ZEBSH(JL,JK)
    PCFH(JL,JK)= PCFH(JL,JK)+ZDISC5(JL,JK)*ZQDP5(JL,JK)*ZEBSH(JL,JK)
    ZQDP       = ZQDP       +ZDISC5(JL,JK)*PCFH5(JL,JK)*ZEBSH(JL,JK)
    ZEBSH(JL,JK)=0.0_JPRB

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

    ZTCOE(JL)=ZTCOE(JL)+ZQDP5(JL,JK)*ZFAC(JL)
    ZQDP     =ZQDP     +ZTCOE5(JL,JK-1)*ZFAC(JL)
    ZFAC(JL)=0.0_JPRB

    ZFAC1=(ZQDP5(JL,JK)**2.0_JPRB)*ZQDP
    PAPHM1(JL,JK+1)=PAPHM1(JL,JK+1)-ZFAC1
    PAPHM1(JL,JK  )=PAPHM1(JL,JK  )+ZFAC1
    ZQDP=0.0_JPRB
  ENDDO
ENDDO

!*         2.1     Top layer elimination.

ZDISC(:)=0.0_JPRB

DO JTR=1,KTRAC
  DO JL=KIDIA,KFDIA
    ZDISC(JL) = ZDISC(JL) + ZCDIF15(JL,KTOP,JTR)*ZCDIF(JL,KTOP,JTR)
    ZCDIF(JL,KTOP,JTR) = ZDISC5(JL,KTOP)*ZCDIF(JL,KTOP,JTR)
  ENDDO
ENDDO
DO JL=KIDIA,KFDIA
  ZQDP=0.0_JPRB

  ZDISC(JL)    = ZDISC(JL)    +PCFH5 (JL,KTOP)*ZQDP5(JL,KTOP)*ZEBSH(JL,KTOP)
  PCFH(JL,KTOP)= PCFH(JL,KTOP)+ZDISC5(JL,KTOP)*ZQDP5(JL,KTOP)*ZEBSH(JL,KTOP)
  ZQDP         = ZQDP         +ZDISC5(JL,KTOP)*PCFH5(JL,KTOP)*ZEBSH(JL,KTOP)
  ZEBSH(JL,KTOP)=0.0_JPRB

  ZFAC1=(ZDISC5(JL,KTOP)**2.0_JPRB)*ZDISC(JL)
  PCFH(JL,KTOP) = PCFH(JL,KTOP) - ZQDP5(JL,KTOP)*ZFAC1
  ZQDP          = ZQDP          - PCFH5(JL,KTOP)*ZFAC1
  ZDISC(JL)=0.0_JPRB
  
  ZFAC1=(ZQDP5(JL,KTOP)**2.0_JPRB)*ZQDP
  PAPHM1(JL,ITOPP1)=PAPHM1(JL,ITOPP1)-ZFAC1
  PAPHM1(JL,KTOP  )=PAPHM1(JL,KTOP  )+ZFAC1
  ZQDP=0.0_JPRB

  PCFH(JL,KTOP)=PCFH(JL,KTOP)+ZTCOE(JL)
  ZTCOE(JL)=0.0_JPRB
ENDDO

!*         1.1      Setting of right hand sides.

DO JTR=1,KTRAC
  DO JK=KLEV,KTOP,-1
    DO JL=KIDIA,KFDIA
      PCM1(JL,JK,JTR) =PCM1(JL,JK,JTR) +ZTPFAC2*ZCDIF(JL,JK,JTR)
      PTENC(JL,JK,JTR)=PTENC(JL,JK,JTR)+PTMST*ZCDIF(JL,JK,JTR)
      ZCDIF(JL,JK,JTR)=0.0_JPRB
    ENDDO
  ENDDO
ENDDO


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





