SUBROUTINE SUTRIC

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

USE YOMDIM   , ONLY : NFLEVG   ,NSMAX
USE YOMCT0   , ONLY : LSLAG    ,LTWOTL
USE YOMCST   , ONLY : RD       ,RKAPPA
USE YOMDYN   , ONLY : SIALPH   ,SILNPR   ,SIRDEL   ,SITRICA  ,&
 & SITRICB  ,SITRICC  ,TDT      ,BETADT   ,SIPR     ,&
 & SITR     ,VESL     ,XIDT  
USE YOMLAP   , ONLY : RLAPDI
USE YOMLUN   , ONLY : NULOUT

!**** *SUTRIC*   - Initialize the solver of the Helmholz equation

!     Purpose.    Initialize the solver of the Helmholz equation
!     --------    in the semi-implicit, in simple cases (for which
!                 horizontal wavenumbers are independent)

!**   Interface.
!     ----------
!        *CALL* *SUTRIC

!        Explicit arguments :
!        --------------------
!        KSTEP: step number

!        Implicit arguments :
!        --------------------
!        COMMON YOMDYN

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

!     Externals.
!     ----------
!          None.
!          Called by SUDYN.

!     Reference.
!     ----------
!        ECMWF Research Department documentation of the IFS

!     Author.
!     -------
!        CLIVE TEMPERTON (MAY 1996)

!     Modifications.
!     --------------
!   C. Temperton 97-02-24: modified first timestep when XIDT>0
!   M.Hamrud      01-Oct-2003 CY28 Cleaning
!   N. Wedi and K. Yessad (Jan 2008): different dev for NH model and PC scheme
!     ------------------------------------------------------------------

IMPLICIT NONE

INTEGER(KIND=JPIM) :: JLEV, JN

REAL(KIND=JPRB) :: ZA, ZB, ZBETADT, ZC, ZFAC
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

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

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

WRITE(NULOUT,*) ' SUTRIC: COMPUTES HELMHOLTZ EQUATION OPERATOR'&
 & ,' IN SIMPLE CASE OF SEMI-IMPLICIT SCHEME'  

IF (LSLAG) THEN
  IF (LTWOTL) THEN
    ZBETADT=(1.0_JPRB+VESL)*(1.0_JPRB+XIDT)*BETADT
  ELSE
    ZBETADT=(1.0_JPRB+VESL)*BETADT
  ENDIF
ELSE
  ZBETADT=BETADT
ENDIF

ZFAC=RD*SITR*(0.5_JPRB*ZBETADT*TDT)**2

!*       1.    COMPUTE ENTRIES OF TRIDIAGONAL MATRICES
!              ---------------------------------------

ZB=ZFAC*RKAPPA*(SIRDEL(1)*SIALPH(1)*SIALPH(1)&
 & +SIRDEL(2)*(SIALPH(2)-SILNPR(2))**2)  
ZC=ZFAC*RKAPPA*SIRDEL(2)*SIALPH(2)*(SIALPH(2)-SILNPR(2))

DO JN=1,NSMAX
  SITRICA(JN,1)=0.0_JPRB
  SITRICB(JN,1)=SIRDEL(1)+SIRDEL(2)-RLAPDI(JN)*ZB
  SITRICC(JN,1)=-SIRDEL(2)+RLAPDI(JN)*ZC
ENDDO

DO JLEV=2,NFLEVG-1

  ZA=ZFAC*RKAPPA*SIRDEL(JLEV)*SIALPH(JLEV)*(SIALPH(JLEV)-SILNPR(JLEV))
  ZB=ZFAC*RKAPPA*(SIRDEL(JLEV)*SIALPH(JLEV)*SIALPH(JLEV)&
   & +SIRDEL(JLEV+1)*(SIALPH(JLEV+1)-SILNPR(JLEV+1))**2)  
  ZC=ZFAC*RKAPPA*SIRDEL(JLEV+1)*SIALPH(JLEV+1)*&
   & (SIALPH(JLEV+1)-SILNPR(JLEV+1))  

  DO JN=1,NSMAX
    SITRICA(JN,JLEV)=-SIRDEL(JLEV)+RLAPDI(JN)*ZA
    SITRICB(JN,JLEV)=SIRDEL(JLEV)+SIRDEL(JLEV+1)-RLAPDI(JN)*ZB
    SITRICC(JN,JLEV)=-SIRDEL(JLEV+1)+RLAPDI(JN)*ZC
  ENDDO

ENDDO

ZA=ZFAC*RKAPPA*SIRDEL(NFLEVG)*SIALPH(NFLEVG)*(SIALPH(NFLEVG)-SILNPR(NFLEVG))
ZB=ZFAC*(RKAPPA*SIRDEL(NFLEVG)*SIALPH(NFLEVG)*SIALPH(NFLEVG)+1.0_JPRB/SIPR)

DO JN=1,NSMAX
  SITRICA(JN,NFLEVG)=-SIRDEL(NFLEVG)+RLAPDI(JN)*ZA
  SITRICB(JN,NFLEVG)=SIRDEL(NFLEVG)-RLAPDI(JN)*ZB
  SITRICC(JN,NFLEVG)=0.0_JPRB
ENDDO

!*       2.    COMPUTE COEFFS TO SOLVE TRIDIAGONAL SYSTEMS
!              -------------------------------------------

DO JN=1,NSMAX
  SITRICB(JN,1)=1.0_JPRB/SITRICB(JN,1)
  SITRICC(JN,1)=-SITRICC(JN,1)*SITRICB(JN,1)
ENDDO

DO JLEV=2,NFLEVG

  DO JN=1,NSMAX
    SITRICB(JN,JLEV)=&
     & 1.0_JPRB/(SITRICB(JN,JLEV)+SITRICA(JN,JLEV)*SITRICC(JN,JLEV-1))  
    SITRICC(JN,JLEV)=-SITRICC(JN,JLEV)*SITRICB(JN,JLEV)
  ENDDO

ENDDO

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

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