#ifdef RS6K
@PROCESS NOOPTIMIZE
#endif
!OCL  NOUNROLL,NOPREEX,NOEVAL
SUBROUTINE SUHDFVAREPS (KTT)

!**** *SUHDFVAREPS*   - Modify hor-diffusion in VAREPS configuration

!     Purpose.
!     --------

!         Redefine hor-diff coefficients and shape functions

!**   Interface.
!     ----------
!        *CALL* *SUHDFVAREPS

!        Explicit arguments :
!        --------------------

!        Implicit arguments :
!        --------------------

!     Method.
!     -------
!        See documentation

!     Externals.
!     ----------
!        Called by CNT4.

!     Reference.
!     ----------
!        See documentation

!     Author.
!     -------
!        Roberto Buizza

!     Modifications.
!     --------------
!        Original : 2003-10-09
!        F. Vana 13-Jan-2009 : Updated call of SUHDF
!     ------------------------------------------------------------------

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

USE YOMLUN   , ONLY : NULOUT
USE YOMDYN   , ONLY : LNEWHD   ,HDIRVOR, HDIRDIV, HDIRT, HDIRQ
USE YOMVAREPS, ONLY : HDIRVOR_MA, HDIRDIV_MA, HDIRT_MA, HDIRQ_MA, &
                     &HDIRVOR_MB, HDIRDIV_MB, HDIRT_MB, HDIRQ_MB, &
                     &NST_TRUNC, NST_HDIF_INI
USE YOMCT0B  , ONLY : LECMWF

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

IMPLICIT NONE

INTEGER(KIND=JPIM), INTENT(IN) :: KTT

INTEGER(KIND=JPIM) :: JT0, JT1
REAL(KIND=JPRB) :: ZHDIRVOR_NEW, ZHDIRDIV_NEW, ZHDIRQ_NEW, ZHDIRT_NEW,&
                   & ZRDTT, ZALPHA, ZBETA, ZH0, ZH1, ZHH
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "abor1.intfb.h"
#include "suhdf.intfb.h"

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

IF (LHOOK) CALL DR_HOOK('SUHDFVAREPS',0,ZHOOK_HANDLE)

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

!*       1.    Redefine hor-diff control parameters
!              ------------------------------------

IF (.NOT.(LECMWF.AND.(.NOT.LNEWHD))) THEN
  ! * this routine is consistent with what is coded in SUHDIR
  !   only in the case (lecmwf=t,lnewhd=f).
  CALL ABOR1(' SUHDFVAREPS only works for (LECMWF=T,LNEWHD=F)')
ENDIF

JT1=NST_TRUNC
JT0=NST_HDIF_INI
ZRDTT=1./FLOAT(JT0-JT1)

!     Linear variation of hdiff coeff from initial NTS_HDIF_INI
!     time to final time NST_TRUNC (ZHH=ZALPHA*T+ZBETA)

IF (KTT<JT0) THEN

  ZHDIRVOR_NEW=HDIRVOR_MA
  ZHDIRDIV_NEW=HDIRDIV_MA
  ZHDIRQ_NEW=HDIRQ_MA
  ZHDIRT_NEW=HDIRT_MA

ELSEIF (KTT>=JT0) THEN

  ZH0=HDIRVOR_MA
  ZH1=HDIRVOR_MB
  ZALPHA=ZRDTT*(ZH0-ZH1)
  ZBETA=ZRDTT*(ZH1*JT0-ZH0*JT1)
  ZHH=ZALPHA*KTT+ZBETA
  ZHDIRVOR_NEW=ZHH

  ZH0=HDIRDIV_MA
  ZH1=HDIRDIV_MB
  ZALPHA=ZRDTT*(ZH0-ZH1)
  ZBETA=ZRDTT*(ZH1*JT0-ZH0*JT1)
  ZHH=ZALPHA*KTT+ZBETA
  ZHDIRDIV_NEW=ZHH

  ZH0=HDIRT_MA
  ZH1=HDIRT_MB
  ZALPHA=ZRDTT*(ZH0-ZH1)
  ZBETA=ZRDTT*(ZH1*JT0-ZH0*JT1)
  ZHH=ZALPHA*KTT+ZBETA
  ZHDIRT_NEW=ZHH

  ZH0=HDIRQ_MA
  ZH1=HDIRQ_MB
  ZALPHA=ZRDTT*(ZH0-ZH1)
  ZBETA=ZRDTT*(ZH1*JT0-ZH0*JT1)
  ZHH=ZALPHA*KTT+ZBETA
  ZHDIRQ_NEW=ZHH

ENDIF

HDIRVOR=ZHDIRVOR_NEW
HDIRDIV=ZHDIRDIV_NEW
HDIRQ=ZHDIRQ_NEW
HDIRT=ZHDIRT_NEW

WRITE(NULOUT,'('' >> Sub SUHDFVAREPS '')')
WRITE(NULOUT,'('' JT0='',I10)') JT0
WRITE(NULOUT,'('' JT1='',I10)') JT1
WRITE(NULOUT,'('' KTT='',I10)') KTT
WRITE(NULOUT,'('' New HDIRVOR='',E26.20)') HDIRVOR
WRITE(NULOUT,'('' >>'')')

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

!*       2.    Call SUHDF to re-define shape functions
!              ---------------------------------------

CALL SUHDF

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

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