SUBROUTINE VDFDIFHSTL (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  ,&
 & PTDIF    ,PQDIF    ,PCPTSTI   ,PQSTI   ,&
 & PCAIRTI  ,PCSATTI  ,PDQSTI    ,PTSKTI  ,PTSKRAD  ,&
 & PTSM1M   ,&
 & PTSKTIP1 ,PQSTIP1  ,PCPTSTIP1 ,&
 & PTE      ,PQE      ,&
 & PJQ      ,PSSH     ,PSLH      ,PSTR    ,PG0 )  
!     ------------------------------------------------------------------

!**   *VDFDIFHSTL* - DOES THE IMPLICIT CALCULATION FOR DIFFUSION OF S. L.
!                    (Tangent linear)

!     J.F. MAHFOUF       E.C.M.W.F.    02/10/95

!     Modified TL code by

!     M. Janiskova                     07/06/99 (TL for tile boundary
!                                                cond. modifications)
!     M. Janiskova                     14/08/03 (TL of new tile coupling)
! -------------------------------------

!     MODIFIED BY

!     P.VITERBO          E.C.M.W.F.    29/11/96 (INTRODUCTION OF VDFTSK)
!     ACMB               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; IN SO DOING, IT ALSO SOLVES THE SKIN TEMPERATURE
!     EQUATION.

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

!     *VDFDIFHSTL* 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

!*      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
!  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 "surfsebtl.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(IN)    :: PCPTSTI5(KLON,KTILES) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: 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)    :: PTICE5(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSST(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: 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(IN)    :: PSSRFLTI(KLON,KTILES) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLRFL(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PEVAPSNW(KLON)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PJQ(KLON,KTILES)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSSH(KLON,KTILES)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSLH(KLON,KTILES)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSTR(KLON,KTILES)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PG0(KLON,KTILES) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCPTGZ(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTM1(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQM1(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPHM1(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCFH(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCFHTI(KLON,KTILES) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCFQTI(KLON,KTILES) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTDIF(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PQDIF(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCPTSTI(KLON,KTILES) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQSTI(KLON,KTILES) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCAIRTI(KLON,KTILES) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCSATTI(KLON,KTILES) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDQSTI(KLON,KTILES) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTSKTI(KLON,KTILES) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTSKRAD(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: 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(IN)    :: PTE(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: 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) :: 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)

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

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

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

IF (LHOOK) CALL DR_HOOK('VDFDIFHSTL',0,ZHOOK_HANDLE)
ZALF=RVDIFTS
ZTPFAC2 = 1.0_JPRB/RVDIFTS
ZTPFAC3 = 1-ZTPFAC2

!*         1.1     SETTING OF RIGHT HAND SIDES.

DO JK = KTOP, KLEV
  DO JL = KIDIA, KFDIA
    Z1S  = RVTMP2*PTM1 (JL,JK)
    Z1S5 = RVTMP2*PTM15(JL,JK)
    Z2S  = RCPD*PTMST
    PTDIF (JL,JK) = ZTPFAC2*PCPTGZ (JL,JK)+&
     & Z2S*(RVTMP2*PQM1(JL,JK)*PTE5(JL,JK)+&
     & (1.0_JPRB+RVTMP2*PQM15(JL,JK))*PTE (JL,JK)+  &
     & Z1S5*PQE(JL,JK) + Z1S*PQE5(JL,JK))     
    PTDIF5(JL,JK) = ZTPFAC2*PCPTGZ5(JL,JK)+&
     & Z2S*((1.0_JPRB+RVTMP2*PQM15(JL,JK))*&
     & PTE5(JL,JK)+Z1S5*PQE5(JL,JK))  
    PQDIF (JL,JK) = ZTPFAC2*PQM1 (JL,JK)+PTMST*PQE (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

JK=KLEV
DO JL=KIDIA,KFDIA
  ZCSNQ=RG*PTMST*PFRTI(JL,7)*PEVAPSNW(JL)/&
   & (PAPHM15(JL,JK)-PAPHM15(JL,JK-1))-&
   & RG*PTMST*PFRTI(JL,7)*PEVAPSNW5(JL)*&
   & (PAPHM1(JL,JK)-PAPHM1(JL,JK-1))/(PAPHM15(JL,JK)-PAPHM15(JL,JK-1))**2  
  ZCSNQ5=RG*PTMST*PFRTI(JL,7)*PEVAPSNW5(JL)/&
   & (PAPHM15(JL,JK)-PAPHM15(JL,JK-1))  
  ZCSNS=RCPD*RVTMP2*PTSKTI(JL,7)*ZCSNQ5+RCPD*RVTMP2*PTSKTI5(JL,7)*ZCSNQ
  ZCSNS5=RCPD*RVTMP2*PTSKTI5(JL,7)*ZCSNQ5

  PTDIF(JL,JK)=PTDIF(JL,JK)-ZCSNS
  PTDIF5(JL,JK)=PTDIF5(JL,JK)-ZCSNS5
  PQDIF(JL,JK)=PQDIF(JL,JK)-ZCSNQ
  PQDIF5(JL,JK)=PQDIF5(JL,JK)-ZCSNQ5
ENDDO

!*         2.1     TOP LAYER ELIMINATION.

DO JL = KIDIA, KFDIA
  ZTCOE (JL) = PCFH (JL,KTOP)
  ZTCOE5(JL) = PCFH5(JL,KTOP)
  ZQDP  = -(PAPHM1 (JL,KTOP)-PAPHM1 (JL,KTOP-1))/&
   & (PAPHM15(JL,KTOP)-PAPHM15(JL,KTOP-1))**2  
  ZQDP5 = 1.0_JPRB/(PAPHM15(JL,KTOP)-PAPHM15(JL,KTOP-1))
  ZDISC  = -(ZQDP*PCFH5(JL,KTOP)+ZQDP5*PCFH(JL,KTOP))/&
   & (1.0_JPRB+PCFH5(JL,KTOP)*ZQDP5)**2  
  ZDISC5 = 1.0_JPRB/(1.0_JPRB+PCFH5(JL,KTOP)*ZQDP5)
  ZEBSH (JL,KTOP) = (ZQDP*PCFH5(JL,KTOP)+ZQDP5*PCFH(JL,KTOP))*&
   & ZDISC5+(PCFH5(JL,KTOP)*ZQDP5)*ZDISC  
  ZEBSH5(JL,KTOP) =  ZDISC5*(PCFH5(JL,KTOP)*ZQDP5)
  PTDIF (JL,KTOP) = PTDIF(JL,KTOP)*ZDISC5+PTDIF5(JL,KTOP)*ZDISC
  PTDIF5(JL,KTOP) = ZDISC5*PTDIF5(JL,KTOP)
  PQDIF (JL,KTOP) = PQDIF(JL,KTOP)*ZDISC5+PQDIF5(JL,KTOP)*ZDISC
  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))
    ZQDP  = -(PAPHM1 (JL,JK)-PAPHM1 (JL,JK-1))*ZQDP5**2
    ZFAC  = ZQDP*ZTCOE5(JL)+ZQDP5*ZTCOE(JL)
    ZFAC5 = ZTCOE5(JL)*ZQDP5
    ZTCOE (JL) = PCFH (JL,JK)
    ZTCOE5(JL) = PCFH5(JL,JK)
    ZTEMP5=PCFH5(JL,JK)*ZQDP5
    ZDISC = -   (  -ZEBSH (JL,JK-1)*ZFAC5 +&
     & (1.0_JPRB-ZEBSH5(JL,JK-1))*ZFAC +&
     & ZQDP*PCFH5(JL,JK)+ZQDP5*PCFH(JL,JK))/&
     & (1.0_JPRB+ZFAC5*(1.0_JPRB-ZEBSH5(JL,JK-1))+&
     & ZTEMP5)**2  
    ZDISC5 = 1.0_JPRB/(1.0_JPRB+ZFAC5*(1.0_JPRB-ZEBSH5(JL,JK-1))+ZTEMP5)
    ZEBSH (JL,JK) =(ZQDP*PCFH5(JL,JK)+ZQDP5*PCFH(JL,JK))*ZDISC5+ZDISC*ZTEMP5
    ZEBSH5(JL,JK) = ZDISC5*ZTEMP5
    PTDIF (JL,JK) = (PTDIF(JL,JK)+(PTDIF(JL,JK-1)*ZFAC5+&
     & PTDIF5(JL,JK-1)*ZFAC))*ZDISC5+&
     & (PTDIF5(JL,JK)+ZFAC5*PTDIF5(JL,JK-1))*ZDISC  
    PTDIF5(JL,JK) = ZDISC5*(PTDIF5(JL,JK)+ZFAC5*PTDIF5(JL,JK-1))
    PQDIF (JL,JK) = (PQDIF(JL,JK)+(PQDIF(JL,JK-1)*ZFAC5+&
     & PQDIF5(JL,JK-1)*ZFAC))*ZDISC5+&
     & (PQDIF5(JL,JK)+ZFAC5*PQDIF5(JL,JK-1))*ZDISC  
    PQDIF5(JL,JK) = ZDISC5*(PQDIF5(JL,JK)+ZFAC5*PQDIF5(JL,JK-1))
  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))
  ZQDP  = -(PAPHM1 (JL,KLEV)-PAPHM1 (JL,KLEV-1))*ZQDP5**2

  ZFAC  = ZTCOE5(JL)*ZQDP+ZQDP5*ZTCOE(JL)
  ZFAC5 = ZTCOE5(JL)*ZQDP5
  ZDISC  = (-(1.0_JPRB-ZEBSH5(JL,KLEV-1))*ZFAC+ZFAC5*ZEBSH(JL,KLEV-1)) &
   &     / (1.0_JPRB+ZFAC5*(1.0_JPRB-ZEBSH5(JL,KLEV-1)))**2
  ZDISC5 = 1.0_JPRB/(1.0_JPRB+ZFAC5*(1.0_JPRB-ZEBSH5(JL,KLEV-1)))
  ZBSL(JL) = (PTDIF5(JL,KLEV)+ZFAC5*PTDIF5(JL,KLEV-1))*ZALF*ZDISC &
   &       + ZDISC5*ZALF*PTDIF(JL,KLEV) &
   &       + ZDISC5*ZALF*(ZFAC5*PTDIF(JL,KLEV-1)+PTDIF5(JL,KLEV-1)*ZFAC)
  ZBSL5(JL)= ZDISC5*(PTDIF5(JL,KLEV)+ZFAC5*PTDIF5(JL,KLEV-1))*ZALF
  ZBQL(JL) = (PQDIF5(JL,KLEV)+ZFAC5*PQDIF5(JL,KLEV-1))*ZALF*ZDISC &
   &       + ZDISC5*ZALF*PQDIF(JL,KLEV) &
   &       + ZDISC5*ZALF*(ZFAC5*PQDIF(JL,KLEV-1)+PQDIF5(JL,KLEV-1)*ZFAC)
  ZBQL5(JL)= ZDISC5*(PQDIF5(JL,KLEV)+ZFAC5*PQDIF5(JL,KLEV-1))*ZALF
  ZASL(JL) = -RG*PTMST*ZALF*(ZDISC5*ZQDP+ZQDP5*ZDISC)
  ZASL5(JL)= -ZDISC5*RG*PTMST*ZQDP5*ZALF
  ZAQL(JL) = ZASL(JL)
  ZAQL5(JL)= ZASL5(JL)
ENDDO


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

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

ZCOEF1=1.0_JPRB/(RG*ZALF*PTMST)
DO JT=1,KTILES
  DO JL=KIDIA,KFDIA
    ZRHOCHU (JL,JT) = PCFHTI(JL,JT)*ZCOEF1
    ZRHOCHU5(JL,JT) = PCFHTI5(JL,JT)*ZCOEF1
    ZRHOCQU (JL,JT) = PCFQTI(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 SURFSEBTL(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.2a    ADD SNOW EVAPORATION TO FLUXES

PJQ (KIDIA:KFDIA,7) = PJQ (KIDIA:KFDIA,7)+PEVAPSNW (KIDIA:KFDIA)
PJQ5(KIDIA:KFDIA,7) = PJQ5(KIDIA:KFDIA,7)+PEVAPSNW5(KIDIA:KFDIA)
PSLH (KIDIA:KFDIA,7) = PSLH (KIDIA:KFDIA,7)+PEVAPSNW (KIDIA:KFDIA)*RLSTT
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
    PTSKTIP1 (JL,JT) = ZTPFAC2*ZTSK (JL,JT)+ZTPFAC3*PTSKTI (JL,JT)
    PTSKTIP15(JL,JT) = ZTPFAC2*ZTSK5(JL,JT)+ZTPFAC3*PTSKTI5(JL,JT)
    ZQSP1 = PQSTI(JL,JT)+(ZTSK5(JL,JT)-PTSKTI5(JL,JT))*PDQSTI(JL,JT) &
     &    + PDQSTI5(JL,JT)*(ZTSK(JL,JT)-PTSKTI(JL,JT))
    ZQSP15= PQSTI5(JL,JT)+PDQSTI5(JL,JT)*(ZTSK5(JL,JT)-PTSKTI5(JL,JT))
    PQSTIP1 (JL,JT) = ZTPFAC2*ZQSP1 +ZTPFAC3*PQSTI (JL,JT)
    PQSTIP15(JL,JT) = ZTPFAC2*ZQSP15+ZTPFAC3*PQSTI5(JL,JT)
    PCPTSTIP1 (JL,JT) = ZTPFAC2*ZSSK (JL,JT)+ZTPFAC3*PCPTSTI (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
  PTDIF (JL,KLEV) = ZSL (JL)*ZCOEF2
  PTDIF5(JL,KLEV) = ZSL5(JL)*ZCOEF2
  PQDIF (JL,KLEV) = ZQL (JL)*ZCOEF2
  PQDIF5(JL,KLEV) = ZQL5(JL)*ZCOEF2
ENDDO


!*         4.     BACK-SUBSTITUTION.

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

IF (LHOOK) CALL DR_HOOK('VDFDIFHSTL',1,ZHOOK_HANDLE)

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

END SUBROUTINE VDFDIFHSTL
