SUBROUTINE VDFDIFHSAD (KIDIA, KFDIA, KLON, KLEV, KTOP,KTILES,&
 & PTMST    , &
 & PFRTI    ,PSSRFLTI5,PSLRFL5   ,PEMIS   ,PEVAPSNW5,&
 & PCPTGZ5  ,PTM15    ,PQM15     ,&
 & PAPHM15  ,PCFH5    ,PCFHTI5   ,PCFQTI5 ,&
 & PTDIF5   ,PQDIF5   ,PCPTSTI5  ,PQSTI5  ,&
 & PCAIRTI5 ,PCSATTI5 ,PDQSTI5   ,PTSKTI5 ,&
 & PTSKRAD5 ,PTSM1M5  ,PTSNOW5  ,PTICE5    ,PSST    ,&
 & PTSKTIP15,PQSTIP15 ,PCPTSTIP15,&
 & PTE5     ,PQE5     ,&
 & PJQ5     ,PSSH5    ,PSLH5     ,PSTR5   ,PG05     ,&
 & PSSRFLTI ,PSLRFL   ,PEVAPSNW  ,&
 & PCPTGZ   ,PTM1     ,PQM1      ,&
 & PAPHM1   ,PCFH     ,PCFHTI    ,PCFQTI  ,&
 & PTHKICE  ,PSNTICE  ,&
 & PTDIF    ,PQDIF    ,PCPTSTI   ,PQSTI   ,&
 & PCAIRTI  ,PCSATTI  ,PDQSTI    ,PTSKTI  ,&
 & PTSKRAD  ,PTSM1M   ,&
 & PTSKTIP1 ,PQSTIP1  ,PCPTSTIP1 ,&
 & PTE      ,PQE      ,&
 & PJQ      ,PSSH     ,PSLH      ,PSTR    ,PG0 )  
!     ------------------------------------------------------------------

!**   *VDFDIFHSAD* - DOES THE IMPLICIT CALCULATION FOR DIFFUSION OF S. L.
!                    (Adjoint)

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

!     Modified AD code by

!     M. Janiskova                     10/06/99 (AD for tile boundary
!                                                cond. modifications)
!     M. Janiskova                     13/10/03 (AD of new tile coupling)
!! -------------

!     MODIFIED BY

!     P.VITERBO          E.C.M.W.F.    29/11/96 (INTRODUCTION OF VDFTSK)
!     A.C.M.BELJAARS     E.C.M.W.F.    20/11/98 (TILE BOUNDARY COND.)

!     adapted from

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

!     OBUKHOV-L UPDATE      ACMB          26/03/90.

!     PURPOSE
!     -------

!     SOLVE TRIDIAGONAL MATRICES FOR DIFFUSION OF DRY STATIC ENERGY
!     AND MOISTURE.

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

!     *VDFDIFHSAD* 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
!  PCPTGZ5     PCPTGZ        DRY STATIC ENERGY AT T-1                  J/kg
!  PFRTI       ---           FRACTION OF SURFACE AREA COVERED          (0-1)
!                            BY TILES                           
!  PTM15       PTM1          TEMPERATURE AT T-1                        K
!  PQM15       PQM1          SPECIFIC HUMIDITY AT T-1                  kg/kg
!  PAPHM15     PAPHM1        PRESSURE AT T-1                           Pa
!  PCFH5       PCFH          PROP. TO EXCH. COEFF. FOR HEAT 
!                                         (C,K-STAR IN DOC.)
!  PCFHTI5     PCFHTI        IDEM FOR HEAT (SURFACE LAYER ONLY)
!  PCFQTI5     PCFQTI        IDEM FOR MOISTURE (SURFACE LAYER ONLY)
!  PCPTSTI5    PCPTSTI       DRY STATIC ENRGY AT SURFACE               J/kg
!  PQSTI5      PQSTI         SATURATION Q AT SURFACE                   kg/kg
!  PCAIRTI5    PCAIRTI       MULTIPLICATION FACTOR FOR Q AT LOWEST     -
!                            MODEL LEVEL FOR SURFACE FLUX COMPUTATION
!  PCSATTI5    PCSATTI       MULTIPLICATION FACTOR FOR QS AT SURFACE   -
!                            FOR SURFACE FLUX COMPUTATION
!  PDQSTI5     PDQSTI        D/DT (PQS)                                kg/kg/K 
!  PSSRFLTI5   PSSRFLTI      NET SOLAR RADIATION AT THE SURFACE,       W/m2
!                            FOR EACH TILE
!  PSLRFL5     PSLRFL        NET THERMAL RADIATION AT THE SURFACE      W/m2
!  PEVAPSNW5   PEVAPSNW      EVAPORATION FROM SNOW UNDER FOREST        kgm-2s-1
!  PTSKTI5     PTSKTI        SKIN TEMPERATURE AT T-1                   K
!  PTSKRAD5    PTSKRAD       SKIN TEMPERATURE at last call of full     K
!                            radiation
!  PTSM1M5     PTSM1M        TOP SOIL LAYER TEMPERATURE                K
!  PTSNOW5     ---           SNOW TEMPERATURE                          K
!  PTICE5      ---           ICE TEMPERATURE (TOP SLAB)                K
!  PTHKICE     ---           Sea ice thickness                         m
!  PSNTICE     ---           Thickness of snow layer on sea ice        m
!  PSST        ---           (OPEN) SEA SURFACE TEMPERATURE            K
!  PEMIS       ---           MODEL SURFACE LONGWAVE EMISSIVITY
!  PTE5        PTE           TEMPERATURE TENDENCY                      K/s
!  PQE5        PQE           MOISTURE TENDENCY                        kg/(kg s)

!*      OUTPUT PARAMETERS (REAL):
!  Trajectory  Perturbation  Description                               Unit
!  PTDIF5      PTDIF         S-DOUBLE-TILDE DEVIDED BY ALFA
!  PQDIF5      PQDIF         Q-DOUBLE-TILDE DEVIDED BY ALFA
!  PTSKTIP15   PTSKTIP1      SKIN TEMPERATURE AT T+1                   K
!  PCPTSTIP15  PCPTSTIP1     DRY STATIC ENERGY AT SURFACE AT T+1       J/kg
!  PQSTIP15    PQSTIP1       SATURATION Q AT SURFACE AT T+1            kg/kg
!  PJQ5        PJQ           Surface moisture flux                     (kg/m2s)
!  PSSH5       PSSH          Surface sensible heat flux                (W/m2)
!  PSLH5       PSLH          Surface latent heat flux                  (W/m2)
!  PSTR5       PSTR          Surface net thermal radiation             (W/m2)
!  PG05        PG0           Surface ground heat flux (solar radiation (W/m2)
!                            leakage is not included in this term)

!     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
USE YOMCST   , ONLY : RCPD, RG,  RLSTT
USE YOETHF   , ONLY : RVTMP2

IMPLICIT NONE

INTERFACE
#include "surfseb.h"
#include "surfsebad.h"
END INTERFACE

INTEGER(KIND=JPIM),INTENT(IN)    :: KLON 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
INTEGER(KIND=JPIM),INTENT(IN)    :: KTILES 
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)    :: PFRTI(KLON,KTILES) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSSRFLTI5(KLON,KTILES) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLRFL5(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMIS(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PEVAPSNW5(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PJQ5(KLON,KTILES)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSSH5(KLON,KTILES)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSLH5(KLON,KTILES)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSTR5(KLON,KTILES)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PG05(KLON,KTILES)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCPTGZ5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTM15(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQM15(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPHM15(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCFH5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCFHTI5(KLON,KTILES) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCFQTI5(KLON,KTILES) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTDIF5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PQDIF5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCPTSTI5(KLON,KTILES) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQSTI5(KLON,KTILES) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCAIRTI5(KLON,KTILES) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCSATTI5(KLON,KTILES) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDQSTI5(KLON,KTILES) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTSKTI5(KLON,KTILES) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTSKRAD5(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTSM1M5(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTSNOW5(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTHKICE(KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSNTICE(KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTICE5(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSST(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTSKTIP15(KLON,KTILES) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQSTIP15(KLON,KTILES) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCPTSTIP15(KLON,KTILES) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTE5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQE5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSSRFLTI(KLON,KTILES) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSLRFL(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PEVAPSNW(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PJQ(KLON,KTILES)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSSH(KLON,KTILES)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSLH(KLON,KTILES)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSTR(KLON,KTILES)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PG0(KLON,KTILES)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCPTGZ(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTM1(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQM1(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PAPHM1(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCFH(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCFHTI(KLON,KTILES) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCFQTI(KLON,KTILES) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTDIF(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQDIF(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCPTSTI(KLON,KTILES) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQSTI(KLON,KTILES) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCAIRTI(KLON,KTILES) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCSATTI(KLON,KTILES) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PDQSTI(KLON,KTILES) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTSKTI(KLON,KTILES) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTSKRAD(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTSM1M(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTSKTIP1(KLON,KTILES) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQSTIP1(KLON,KTILES) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCPTSTIP1(KLON,KTILES) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTE(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQE(KLON,KLEV) 

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

REAL(KIND=JPRB) :: ZTCOE5(KLON), ZEBSH5(KLON,KLEV)
REAL(KIND=JPRB) :: ZTSRF5(KLON,KTILES),ZRHOCHU5(KLON,KTILES),&
         &ZRHOCQU5(KLON,KTILES),&
         &ZJS5(KLON,KTILES) ,ZSSK5(KLON,KTILES)  ,ZTSK5(KLON,KTILES)
REAL(KIND=JPRB) :: ZAQL5(KLON),ZBQL5(KLON),ZASL5(KLON),ZBSL5(KLON),&
         &ZSL5(KLON), ZQL5(KLON)

REAL(KIND=JPRB) :: ZTCOE (KLON), ZEBSH (KLON,KLEV)
REAL(KIND=JPRB) :: ZCH (KLON)
REAL(KIND=JPRB) :: ZTSRF(KLON,KTILES),ZRHOCHU(KLON,KTILES),&
         &ZRHOCQU(KLON,KTILES),&
         &ZJS(KLON,KTILES)  ,ZSSK(KLON,KTILES)   ,ZTSK(KLON,KTILES)
REAL(KIND=JPRB) :: ZAQL(KLON),ZBQL(KLON),ZASL(KLON),ZBSL(KLON),&
         &ZSL(KLON), ZQL(KLON)

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

REAL(KIND=JPRB) :: ZTCOE55 (KLON,KLEV), ZQDP55 (KLON,KLEV),&
 & ZDISC55 (KLON,KLEV), ZFAC55 (KLON,KLEV),&
 & ZCSNQ55(KLON)      ,ZCSNS55(KLON),&
 & ZQDPA5(KLON), ZFACA5(KLON), ZDISCA5(KLON),&
 & ZHLICE5(KLON),&
 & ZTDIF55A  (KLON,KLEV), ZQDIF55A (KLON,KLEV),&
 & ZTDIF55B  (KLON,KLEV), ZQDIF55B (KLON,KLEV),&
 & ZTDIF55C  (KLON,KLEV), ZQDIF55C (KLON,KLEV),&
 & ZTDIF55D  (KLON,KLEV), ZQDIF55D (KLON,KLEV)
REAL(KIND=JPRB) :: ZQSP15(KLON,KTILES)

INTEGER(KIND=JPIM) :: JK, JL, JT

REAL(KIND=JPRB) :: ZALF,ZDISC, ZDISC5,&
 & ZFAC, ZFAC5,ZQDP, ZQDP5, ZQSP1,&
 & ZTPFAC2, ZTPFAC3 , ZCSNQ, ZCSNQ5, ZCSNS, ZCSNS5,&
 & ZHELPB5  
REAL(KIND=JPRB) :: ZCOEF1,ZCOEF2,ZTEMP5
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

IF (LHOOK) CALL DR_HOOK('VDFDIFHSAD',0,ZHOOK_HANDLE)
ZALF=RVDIFTS
ZTPFAC2 = 1.0_JPRB/RVDIFTS
ZTPFAC3 = 1-ZTPFAC2
ZHLICE5(:) = 0.0_JPRB
!--------------------------------------------------------------------------

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

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

!*         1.1     SETTING OF RIGHT HAND SIDES.

DO JK = KTOP, KLEV
  DO JL = KIDIA, KFDIA
    PTDIF5(JL,JK) =&
     & ZTPFAC2*PCPTGZ5(JL,JK)+RCPD*PTMST*&
     & ((1.0_JPRB+RVTMP2*PQM15(JL,JK))*PTE5(JL,JK)+&
     & RVTMP2*PTM15(JL,JK)*PQE5(JL,JK))  
    PQDIF5(JL,JK) = ZTPFAC2*PQM15(JL,JK)+PTMST*PQE5(JL,JK)
  ENDDO
ENDDO

!*         1.2    ADD MOISTURE FLUX FROM SNOW FROM TILE 7 AS EXPLICIT TERM

DO JL=KIDIA,KFDIA
  ZCSNQ5=RG*PTMST*PFRTI(JL,7)*PEVAPSNW5(JL)/&
   & (PAPHM15(JL,KLEV)-PAPHM15(JL,KLEV-1))  
  ZCSNQ55(JL)=ZCSNQ5
  ZCSNS5=RCPD*RVTMP2*PTSKTI5(JL,7)*ZCSNQ5
  ZCSNS55(JL)=ZCSNS5

  PTDIF5(JL,KLEV)=PTDIF5(JL,KLEV)-ZCSNS5
  PQDIF5(JL,KLEV)=PQDIF5(JL,KLEV)-ZCSNQ5
  ZTDIF55A(JL,KLEV)=PTDIF5(JL,KLEV)
  ZQDIF55A(JL,KLEV)=PQDIF5(JL,KLEV)
ENDDO

!*         2.1     TOP LAYER ELIMINATION.

DO JL = KIDIA, KFDIA
  ZTCOE5(JL) = PCFH5(JL,KTOP)
  ZTCOE55 (JL,KTOP) = ZTCOE5(JL)
  ZQDP5 = 1.0_JPRB/(PAPHM15(JL,KTOP)-PAPHM15(JL,KTOP-1))
  ZQDP55 (JL,KTOP) = ZQDP5
  ZDISC5 = 1.0_JPRB/(1.0_JPRB+PCFH5(JL,KTOP)*ZQDP5)
  ZDISC55 (JL,KTOP) = ZDISC5
  ZEBSH5(JL,KTOP) = ZDISC5*PCFH5(JL,KTOP)*ZQDP5
  ZTDIF55A(JL,KTOP) = PTDIF5(JL,KTOP)
  PTDIF5(JL,KTOP) = ZDISC5*PTDIF5(JL,KTOP)
  ZQDIF55A(JL,KTOP) = PQDIF5(JL,KTOP)
  PQDIF5(JL,KTOP) = ZDISC5*PQDIF5(JL,KTOP)
ENDDO

!*         2.2     ELIMINATION FOR MIDDLE LAYERS.

DO JK = KTOP+1, KLEV-1
  DO JL = KIDIA, KFDIA
    ZQDP5 = 1.0_JPRB/(PAPHM15(JL,JK)-PAPHM15(JL,JK-1))
    ZQDP55 (JL,JK) = ZQDP5
    ZTCOE55(JL,JK) = ZTCOE5(JL)
    ZFAC5 = ZTCOE5(JL)*ZQDP5
    ZFAC55 (JL,JK) = ZFAC5
    ZTCOE5(JL) = PCFH5(JL,JK)
    ZTEMP5=PCFH5(JL,JK)*ZQDP5
    ZDISC5 =1.0_JPRB/(1.0_JPRB+ZFAC5*(1.0_JPRB-ZEBSH5(JL,JK-1))+ZTEMP5)
    ZDISC55 (JL,JK) = ZDISC5
    ZEBSH5(JL,JK) = ZDISC5*ZTEMP5
    ZTDIF55A(JL,JK) = PTDIF5(JL,JK)
    ZTDIF55B(JL,JK-1) = PTDIF5(JL,JK-1)
    PTDIF5(JL,JK) =ZDISC5*(PTDIF5(JL,JK)+ZFAC5*PTDIF5(JL,JK-1))
    ZQDIF55A(JL,JK) = PQDIF5(JL,JK)
    ZQDIF55B(JL,JK-1) = PQDIF5(JL,JK-1)
    PQDIF5(JL,JK) =ZDISC5*(PQDIF5(JL,JK)+ZFAC5*PQDIF5(JL,JK-1))
    ZTDIF55D(JL,JK) = PTDIF5(JL,JK)
    ZQDIF55D(JL,JK) = PQDIF5(JL,JK)
  ENDDO
ENDDO

!*         2.3     BOTTOM LAYER, LINEAR RELATION BETWEEN LOWEST
!                  MODEL LEVEL S AND Q AND FLUXES.

DO JL = KIDIA, KFDIA
  ZQDP5=1.0_JPRB/(PAPHM15(JL,KLEV)-PAPHM15(JL,KLEV-1))
  ZQDPA5(JL) = ZQDP5
  ZFAC5=ZTCOE5(JL)*ZQDP5
  ZFACA5(JL) = ZFAC5
  ZDISC5=1.0_JPRB/(1.0_JPRB+ZFAC5*(1.0_JPRB-ZEBSH5(JL,KLEV-1)))
  ZDISCA5(JL) = ZDISC5
  ZBSL5(JL)= ZDISC5*(PTDIF5(JL,KLEV)+ZFAC5*PTDIF5(JL,KLEV-1))*ZALF
  ZBQL5(JL)= ZDISC5*(PQDIF5(JL,KLEV)+ZFAC5*PQDIF5(JL,KLEV-1))*ZALF
  ZASL5(JL)= -ZDISC5*RG*PTMST*ZQDP5*ZALF
  ZAQL5(JL)= ZASL5(JL)
ENDDO

!*         3.1     PREPARE ARRAY'S FOR CALL TO SURFACE ENERGY
!                  BALANCE ROUTINE

ZTSRF5(KIDIA:KFDIA,1) = PSST(KIDIA:KFDIA)
ZTSRF5(KIDIA:KFDIA,2) = PTICE5(KIDIA:KFDIA)
ZTSRF5(KIDIA:KFDIA,3) = PTSM1M5(KIDIA:KFDIA)
ZTSRF5(KIDIA:KFDIA,4) = PTSM1M5(KIDIA:KFDIA)
ZTSRF5(KIDIA:KFDIA,5) = PTSNOW5(KIDIA:KFDIA)
ZTSRF5(KIDIA:KFDIA,6) = PTSM1M5(KIDIA:KFDIA)
ZTSRF5(KIDIA:KFDIA,7) = PTSNOW5(KIDIA:KFDIA)
ZTSRF5(KIDIA:KFDIA,8) = PTSM1M5(KIDIA:KFDIA)

ZCOEF1=1.0_JPRB/(RG*ZALF*PTMST)
DO JT=1,KTILES
  DO JL=KIDIA,KFDIA
    ZRHOCHU5(JL,JT) = PCFHTI5(JL,JT)*ZCOEF1
    ZRHOCQU5(JL,JT) = PCFQTI5(JL,JT)*ZCOEF1
  ENDDO
ENDDO


!*         3.2     CALL TO SURFACE ENERGY BALANCE ROUTINE
!                  REMEMBER: OUTPUT IS EXTRAPOLATED IN TIME

!CALL SURFSEB(KIDIA=KIDIA,KFDIA=KFDIA,KLON=KLON,KTILES=KTILES,&
!           &PSSKM1M=PCPTSTI5,PTSKM1M=PTSKTI5,PQSKM1M=PQSTI5,&
!           &PDQSDT=PDQSTI5,PRHOCHU=ZRHOCHU5,PRHOCQU=ZRHOCQU5,&
!           &PALPHAL=PCAIRTI5,PALPHAS=PCSATTI5,PSSRFL=PSSRFLTI5,&
!           &PFRTI=PFRTI,PTSRF=ZTSRF5,&
!           &PHLICE=ZHLICE5,&
!           &PSLRFL=PSLRFL5,PTSKRAD=PTSKRAD5,PEMIS=PEMIS,&
!           &PASL=ZASL5,PBSL=ZBSL5,PAQL=ZAQL5,PBQL=ZBQL5,&
!	   &PTHKICE=PTHKICE,PSNTICE=PSNTICE,&
!           &PJS=ZJS5,PJQ=PJQ5,PSSK=ZSSK5,PTSK=ZTSK5,&
!           &PSSH=PSSH5,PSLH=PSLH5,PSTR=PSTR5,PG0=PG05,&
!           &PSL=ZSL5,PQL=ZQL5)

!*         3.2a    ADD SNOW EVAPORATION TO FLUXES


PJQ5(KIDIA:KFDIA,7) = PJQ5(KIDIA:KFDIA,7)+PEVAPSNW5(KIDIA:KFDIA)
PSLH5(KIDIA:KFDIA,7) = PSLH5(KIDIA:KFDIA,7)+PEVAPSNW5(KIDIA:KFDIA)*RLSTT


!*         3.3     COMPUTE PARAMETERS AT NEW TIME LEVEL 

DO JT=1,KTILES
  DO JL=KIDIA,KFDIA
    PTSKTIP15(JL,JT) = ZTPFAC2*ZTSK5(JL,JT)+ZTPFAC3*PTSKTI5(JL,JT)
    ZQSP15(JL,JT) = PQSTI5(JL,JT)+PDQSTI5(JL,JT)*(ZTSK5(JL,JT)-PTSKTI5(JL,JT))
    PQSTIP15(JL,JT) = ZTPFAC2*ZQSP15(JL,JT)+ZTPFAC3*PQSTI5(JL,JT)
    PCPTSTIP15(JL,JT) = ZTPFAC2*ZSSK5(JL,JT)+ZTPFAC3*PCPTSTI5(JL,JT)
  ENDDO
ENDDO


!*         3.5    COPY LOWEST MODEL SOLUTION FROM SURFSEB 

ZCOEF2=1.0_JPRB/ZALF
DO JL=KIDIA,KFDIA
  PTDIF5(JL,KLEV) = ZSL5(JL)*ZCOEF2
  PQDIF5(JL,KLEV) = ZQL5(JL)*ZCOEF2
ENDDO


!*         4.     BACK-SUBSTITUTION.

DO JK = KLEV-1, KTOP, -1
  DO JL = KIDIA, KFDIA
    ZTDIF55C(JL,JK+1) = PTDIF5(JL,JK+1)
    PTDIF5(JL,JK) = PTDIF5(JL,JK)+ZEBSH5(JL,JK)*PTDIF5(JL,JK+1)
    ZQDIF55C(JL,JK+1) = PQDIF5(JL,JK+1)
    PQDIF5(JL,JK) = PQDIF5(JL,JK)+ZEBSH5(JL,JK)*PQDIF5(JL,JK+1)
  ENDDO
ENDDO

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

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

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

!*         1.6     INITIALISATIONS

ZEBSH (:,:) = 0.0_JPRB
ZTSRF  (:,:) = 0.0_JPRB
ZRHOCHU(:,:) = 0.0_JPRB
ZRHOCQU(:,:) = 0.0_JPRB
ZSSK   (:,:) = 0.0_JPRB
ZTSK   (:,:) = 0.0_JPRB
ZJS    (:,:) = 0.0_JPRB

ZTCOE (:) = 0.0_JPRB
ZCH   (:) = 0.0_JPRB
ZBSL  (:) = 0.0_JPRB
ZBQL  (:) = 0.0_JPRB
ZASL  (:) = 0.0_JPRB
ZAQL  (:) = 0.0_JPRB
ZQL   (:) = 0.0_JPRB
ZSL   (:) = 0.0_JPRB


!*         4.     BACK-SUBSTITUTION.

DO JK = KTOP, KLEV-1
  DO JL = KIDIA, KFDIA
    PQDIF(JL,JK+1) = PQDIF(JL,JK+1) + ZEBSH5(JL,JK)*PQDIF(JL,JK)
    ZEBSH(JL,JK) = ZEBSH(JL,JK) + ZQDIF55C(JL,JK+1)*PQDIF(JL,JK)
    PTDIF(JL,JK+1) = PTDIF(JL,JK+1) + ZEBSH5(JL,JK)*PTDIF(JL,JK)
    ZEBSH(JL,JK) = ZEBSH(JL,JK) + ZTDIF55C(JL,JK+1)*PTDIF(JL,JK)
  ENDDO
ENDDO

!*         3.5    COPY LOWEST MODEL SOLUTION FROM SURFSEB 

DO JL=KIDIA,KFDIA
  ZQL (JL) = ZQL (JL)+ZCOEF2*PQDIF (JL,KLEV)
  PQDIF (JL,KLEV) = 0.0_JPRB
  ZSL (JL) = ZSL (JL)+ZCOEF2*PTDIF (JL,KLEV)
  PTDIF (JL,KLEV) = 0.0_JPRB
ENDDO

!*         3.3     COMPUTE PARAMETERS AT NEW TIME LEVEL 

DO JT=KTILES,1,-1
  DO JL=KIDIA,KFDIA
    ZQSP1 = 0.0_JPRB
    ZSSK (JL,JT) = ZSSK (JL,JT)+ZTPFAC2*PCPTSTIP1(JL,JT)
    PCPTSTI(JL,JT) =PCPTSTI (JL,JT)+ZTPFAC3*PCPTSTIP1(JL,JT)
    PCPTSTIP1(JL,JT) = 0.0_JPRB

    ZQSP1 = ZQSP1+ZTPFAC2*PQSTIP1(JL,JT)
    PQSTI(JL,JT) = PQSTI(JL,JT)+ZTPFAC3*PQSTIP1(JL,JT)
    PQSTIP1(JL,JT) = 0.0_JPRB

    PQSTI(JL,JT) = PQSTI(JL,JT)+ZQSP1
    PDQSTI(JL,JT) = PDQSTI(JL,JT)+(ZTSK5(JL,JT)-PTSKTI5(JL,JT))*ZQSP1
    ZTSK(JL,JT) = ZTSK(JL,JT)+PDQSTI5(JL,JT)*ZQSP1
    PTSKTI(JL,JT) = PTSKTI(JL,JT)-PDQSTI5(JL,JT)*ZQSP1

    ZTSK (JL,JT) = ZTSK (JL,JT)+ZTPFAC2*PTSKTIP1 (JL,JT)
    PTSKTI (JL,JT) = PTSKTI (JL,JT)+ZTPFAC3*PTSKTIP1 (JL,JT)
    PTSKTIP1 (JL,JT) = 0.0_JPRB
  ENDDO
ENDDO

!*         3.2a    ADD SNOW EVAPORATION TO FLUXES


PEVAPSNW(KIDIA:KFDIA) = PEVAPSNW(KIDIA:KFDIA)+RLSTT*PSLH (KIDIA:KFDIA,7)
PEVAPSNW(KIDIA:KFDIA) = PEVAPSNW(KIDIA:KFDIA)+PJQ(KIDIA:KFDIA,7)


!*         3.2     CALL TO SURFACE ENERGY BALANCE ROUTINE
!                  REMEMBER: OUTPUT IS EXTRAPOLATED IN TIME

CALL SURFSEBAD(KIDIA=KIDIA,KFDIA=KFDIA,KLON=KLON,KTILES=KTILES,&
             &PSSKM1M5=PCPTSTI5,PTSKM1M5=PTSKTI5,PQSKM1M5=PQSTI5,&
             &PDQSDT5=PDQSTI5,PRHOCHU5=ZRHOCHU5,PRHOCQU5=ZRHOCQU5,&
             &PALPHAL5=PCAIRTI5,PALPHAS5=PCSATTI5,PSSRFL5=PSSRFLTI5,&
             &PFRTI5=PFRTI,PTSRF5=ZTSRF5,&
             &PSLRFL5=PSLRFL5,PTSKRAD5=PTSKRAD5,PEMIS5=PEMIS,&
             &PASL5=ZASL5,PBSL5=ZBSL5,PAQL5=ZAQL5,PBQL5=ZBQL5,&
             &PJS5=ZJS5,PJQ5=PJQ5,PSSK5=ZSSK5,PTSK5=ZTSK5,&
             &PSSH5=PSSH5,PSLH5=PSLH5,PSTR5=PSTR5,PG05=PG05,&
             &PSL5=ZSL5,PQL5=ZQL5,&
             &PSSKM1M=PCPTSTI,PTSKM1M=PTSKTI,PQSKM1M=PQSTI,&
             &PDQSDT=PDQSTI,PRHOCHU=ZRHOCHU,PRHOCQU=ZRHOCQU,&
             &PALPHAL=PCAIRTI,PALPHAS=PCSATTI,PSSRFL=PSSRFLTI,PTSRF=ZTSRF,&
             &PSLRFL=PSLRFL,PTSKRAD=PTSKRAD,PASL=ZASL,&
             &PBSL=ZBSL,PAQL=ZAQL,PBQL=ZBQL,&
!out
             &PJS=ZJS,PJQ=PJQ,PSSK=ZSSK,PTSK=ZTSK,&
             &PSSH=PSSH,PSLH=PSLH,PSTR=PSTR,PG0=PG0,&
             &PSL=ZSL,PQL=ZQL)


!*         3.1     PREPARE ARRAY'S FOR CALL TO SURFACE ENERGY
!                  BALANCE ROUTINE

DO JT=KTILES,1,-1
  DO JL=KIDIA,KFDIA
    PCFQTI(JL,JT) = PCFQTI(JL,JT)+ZCOEF1*ZRHOCQU (JL,JT)
    ZRHOCQU(JL,JT) = 0.0_JPRB
    PCFHTI(JL,JT) = PCFHTI(JL,JT)+ZCOEF1*ZRHOCHU (JL,JT)
    ZRHOCHU(JL,JT) = 0.0_JPRB
  ENDDO
ENDDO

PTSM1M (KIDIA:KFDIA) = PTSM1M (KIDIA:KFDIA)+ZTSRF (KIDIA:KFDIA,8) &
 &                   + ZTSRF (KIDIA:KFDIA,6)+ZTSRF (KIDIA:KFDIA,4) &
 &                   + ZTSRF (KIDIA:KFDIA,3)
ZTSRF (KIDIA:KFDIA,:) = 0.0_JPRB


!*         2.3     BOTTOM LAYER, LINEAR RELATION BETWEEN LOWEST
!                  MODEL LEVEL S AND Q AND FLUXES.


DO JL=KIDIA,KFDIA
  
  ZQDP = 0.0_JPRB
  ZFAC = 0.0_JPRB
  ZDISC = 0.0_JPRB
  ZASL(JL) = ZASL(JL)+ZAQL(JL)
  ZAQL(JL) = 0.0_JPRB
  ZQDP = ZQDP-RG*PTMST*ZALF*ZDISCA5(JL)*ZASL(JL)
  ZDISC = ZDISC-RG*PTMST*ZALF*ZQDPA5(JL)*ZASL(JL)
  ZASL(JL) = 0.0_JPRB

  ZDISC = ZDISC+(ZQDIF55A(JL,KLEV)+ZFACA5(JL)*ZQDIF55D(JL,KLEV-1))*ZALF*ZBQL(JL)
  PQDIF(JL,KLEV) = PQDIF(JL,KLEV)+ZDISCA5(JL)*ZALF*ZBQL(JL)
  PQDIF(JL,KLEV-1) = PQDIF(JL,KLEV-1)+ZDISCA5(JL)*ZALF*ZFACA5(JL)*ZBQL(JL)
  ZFAC = ZFAC+ZDISCA5(JL)*ZALF*ZQDIF55D(JL,KLEV-1)*ZBQL(JL)
  ZBQL(JL) = 0.0_JPRB

  ZDISC = ZDISC+(ZTDIF55A(JL,KLEV)+ZFACA5(JL)*ZTDIF55D(JL,KLEV-1))*ZALF*ZBSL(JL)
  PTDIF(JL,KLEV) = PTDIF(JL,KLEV)+ZDISCA5(JL)*ZALF*ZBSL(JL)
  PTDIF(JL,KLEV-1) = PTDIF(JL,KLEV-1)+ZDISCA5(JL)*ZALF*ZFACA5(JL)*ZBSL(JL)
  ZFAC = ZFAC+ZDISCA5(JL)*ZALF*ZTDIF55D(JL,KLEV-1)*ZBSL(JL)
  ZBSL(JL) = 0.0_JPRB

  ZHELPB5 = 1.0_JPRB/(1.0_JPRB+ZFACA5(JL)*(1.0_JPRB-ZEBSH5(JL,KLEV-1)))**2
  ZFAC = ZFAC-(1.0_JPRB-ZEBSH5(JL,KLEV-1))*ZDISC*ZHELPB5
  ZEBSH(JL,KLEV-1) = ZEBSH(JL,KLEV-1)+ZFACA5(JL)*ZDISC*ZHELPB5

  ZQDP = ZQDP+ZTCOE5(JL)*ZFAC
  ZTCOE(JL) = ZTCOE(JL)+ZQDPA5(JL)*ZFAC

  PAPHM1(JL,KLEV)  =PAPHM1(JL,KLEV)  -ZQDP*ZQDPA5(JL)**2
  PAPHM1(JL,KLEV-1)=PAPHM1(JL,KLEV-1)+ZQDP*ZQDPA5(JL)**2
ENDDO


!*         2.2     ELIMINATION FOR MIDDLE LAYERS.

DO JK = KLEV-1, KTOP+1, -1
  DO JL = KIDIA, KFDIA

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

    ZDISC =  ZDISC + PQDIF(JL,JK)*&
     & (ZQDIF55A(JL,JK)+ZFAC55(JL,JK)*ZQDIF55B(JL,JK-1))  
    PQDIF(JL,JK-1) = PQDIF(JL,JK-1) + PQDIF(JL,JK)*&
     & ZDISC55(JL,JK)*ZFAC55(JL,JK)  
    ZFAC = ZFAC + PQDIF(JL,JK)*ZDISC55(JL,JK)*ZQDIF55B(JL,JK-1)
    PQDIF(JL,JK) = ZDISC55(JL,JK)*PQDIF(JL,JK)
    ZDISC =  ZDISC + PTDIF(JL,JK)*&
     & (ZTDIF55A(JL,JK)+ZFAC55(JL,JK)*ZTDIF55B(JL,JK-1))  
    PTDIF(JL,JK-1) = PTDIF(JL,JK-1) + PTDIF(JL,JK)*&
     & ZDISC55(JL,JK)*ZFAC55(JL,JK)  
    ZFAC = ZFAC + PTDIF(JL,JK)*ZDISC55(JL,JK)*ZTDIF55B(JL,JK-1)
    PTDIF(JL,JK) = ZDISC55(JL,JK)*PTDIF(JL,JK)
    ZDISC = ZDISC + ZEBSH(JL,JK)*PCFH5(JL,JK)*ZQDP55(JL,JK)
    PCFH(JL,JK) = PCFH(JL,JK) + ZEBSH(JL,JK)*ZDISC55(JL,JK)*ZQDP55(JL,JK)
    ZQDP = ZQDP + ZEBSH(JL,JK)*ZDISC55(JL,JK)*PCFH5(JL,JK)
    ZEBSH(JL,JK) = 0.0_JPRB
    ZFAC = ZFAC - ZDISC*(1.0_JPRB-ZEBSH5(JL,JK-1))/&
     & (1.0_JPRB+ZFAC55(JL,JK)*(1.0_JPRB-ZEBSH5(JL,JK-1))+&
     & PCFH5(JL,JK)*ZQDP55(JL,JK))**2  
    ZEBSH(JL,JK-1) = ZEBSH(JL,JK-1) + ZDISC*ZFAC55(JL,JK)/&
     & (1.0_JPRB+ZFAC55(JL,JK)*(1.0_JPRB-ZEBSH5(JL,JK-1))+&
     & PCFH5(JL,JK)*ZQDP55(JL,JK))**2  
    PCFH(JL,JK) = PCFH(JL,JK) - ZDISC*ZQDP55(JL,JK)/&
     & (1.0_JPRB+ZFAC55(JL,JK)*(1.0_JPRB-ZEBSH5(JL,JK-1))+&
     & PCFH5(JL,JK)*ZQDP55(JL,JK))**2  
    ZQDP = ZQDP - ZDISC*PCFH5(JL,JK)/&
     & (1.0_JPRB+ZFAC55(JL,JK)*(1.0_JPRB-ZEBSH5(JL,JK-1))+&
     & PCFH5(JL,JK)*ZQDP55(JL,JK))**2  
    PCFH(JL,JK) = PCFH(JL,JK) +  ZTCOE(JL)
    ZTCOE(JL) = 0.0_JPRB
    ZTCOE(JL) = ZTCOE(JL) + ZFAC*ZQDP55(JL,JK)
    ZQDP = ZQDP + ZFAC*ZTCOE55(JL,JK)
    PAPHM1(JL,JK) = PAPHM1(JL,JK) - ZQDP/&
     & (PAPHM15(JL,JK)-PAPHM15(JL,JK-1))**2  
    PAPHM1(JL,JK-1) = PAPHM1(JL,JK-1) + ZQDP/&
     & (PAPHM15(JL,JK)-PAPHM15(JL,JK-1))**2  
  ENDDO
ENDDO

!*         2.1     TOP LAYER ELIMINATION.

DO JL = KIDIA, KFDIA

  ZQDP    = 0.0_JPRB
  ZDISC   = 0.0_JPRB

  ZDISC = ZDISC + PQDIF(JL,KTOP)*ZQDIF55A(JL,KTOP)
  PQDIF(JL,KTOP) = ZDISC55(JL,KTOP)*PQDIF(JL,KTOP)
  ZDISC = ZDISC + PTDIF(JL,KTOP)*ZTDIF55A(JL,KTOP)
  PTDIF(JL,KTOP) = ZDISC55(JL,KTOP)*PTDIF(JL,KTOP)
  ZDISC = ZDISC + ZEBSH(JL,KTOP)*PCFH5(JL,KTOP)*ZQDP55(JL,KTOP)
  PCFH(JL,KTOP) = PCFH(JL,KTOP) + ZEBSH(JL,KTOP)*&
   & ZDISC55(JL,KTOP)*ZQDP55(JL,KTOP)  
  ZQDP = ZQDP + ZEBSH(JL,KTOP)*ZDISC55(JL,KTOP)*PCFH5(JL,KTOP)
  ZEBSH(JL,KTOP) = 0.0_JPRB
  PCFH(JL,KTOP) = PCFH(JL,KTOP) - ZDISC*ZQDP55(JL,KTOP)/&
   & (1.0_JPRB+PCFH5(JL,KTOP)*ZQDP55(JL,KTOP))**2  
  ZQDP = ZQDP -  ZDISC*PCFH5(JL,KTOP)/&
   & (1.0_JPRB+PCFH5(JL,KTOP)*ZQDP55(JL,KTOP))**2  
  PAPHM1(JL,KTOP) = PAPHM1(JL,KTOP) - ZQDP/&
   & (PAPHM15(JL,KTOP)-PAPHM15(JL,KTOP-1))**2  
  PAPHM1(JL,KTOP-1) = PAPHM1(JL,KTOP-1) + ZQDP/&
   & (PAPHM15(JL,KTOP)-PAPHM15(JL,KTOP-1))**2  
  PCFH(JL,KTOP) =  PCFH(JL,KTOP) + ZTCOE(JL)
  ZTCOE(JL) = 0.0_JPRB
ENDDO

!*         1.2     ADD MOISTURE FLUX FROM SNOW FROM TILE 7 AS EXPLICIT TERM

DO JL=KIDIA,KFDIA

  ZCSNQ=0.0_JPRB
  ZCSNS=0.0_JPRB

  ZCSNQ=ZCSNQ-PQDIF(JL,KLEV)
  ZCSNS=ZCSNS-PTDIF(JL,KLEV)
  PTSKTI(JL,7)=PTSKTI(JL,7)+RCPD*RVTMP2*ZCSNQ55(JL)*ZCSNS
  ZCSNQ=ZCSNQ+RCPD*RVTMP2*PTSKTI5(JL,7)*ZCSNS
  PEVAPSNW(JL)=PEVAPSNW(JL)+RG*PTMST*(PFRTI(JL,7)/&
   & (PAPHM15(JL,KLEV)-PAPHM15(JL,KLEV-1)))*ZCSNQ  
  PAPHM1(JL,KLEV)=PAPHM1(JL,KLEV)-RG*PTMST*(PFRTI(JL,7)*PEVAPSNW5(JL)&
   & /(PAPHM15(JL,KLEV)-PAPHM15(JL,KLEV-1))**2)*ZCSNQ  
  PAPHM1(JL,KLEV-1)=PAPHM1(JL,KLEV-1)+RG*PTMST*(PFRTI(JL,7)*PEVAPSNW5(JL)&
   & /(PAPHM15(JL,KLEV)-PAPHM15(JL,KLEV-1))**2)*ZCSNQ  
ENDDO

!*         1.1     SETTING OF RIGHT HAND SIDES.

DO JK = KLEV, KTOP, -1
  DO JL = KIDIA, KFDIA
    PQM1(JL,JK) = PQM1(JL,JK) + PQDIF(JL,JK)*ZTPFAC2
    PQE (JL,JK) = PQE (JL,JK) + PQDIF(JL,JK)*PTMST
    PQDIF(JL,JK) = 0.0_JPRB
    PCPTGZ(JL,JK) = PCPTGZ(JL,JK) + PTDIF(JL,JK)*ZTPFAC2
    PTM1(JL,JK) = PTM1(JL,JK) + PTDIF(JL,JK)*RCPD*PTMST*RVTMP2*PQE5(JL,JK)
    PQE(JL,JK) = PQE(JL,JK) + PTDIF(JL,JK)*RCPD*PTMST*RVTMP2*PTM15(JL,JK)
    PQM1(JL,JK) = PQM1(JL,JK) + PTDIF(JL,JK)*RCPD*PTMST*RVTMP2*PTE5(JL,JK)
    PTE(JL,JK) = PTE(JL,JK) + PTDIF(JL,JK)*RCPD*&
     & PTMST*(1.0_JPRB+RVTMP2*PQM15(JL,JK))  
    PTDIF(JL,JK) = 0.0_JPRB
  ENDDO
ENDDO

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