SUBROUTINE SPCIMPFINIT(&
 ! --- INPUT -----------------------------------------------------------------
 & CDCONF,KM,KSTA,KEND,PSPVOR, &
 ! --- INOUT -----------------------------------------------------------------
 & PSPAUX)  

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

USE YOMMP    , ONLY : MYSETV   ,NPTRSV   ,NPTRSVF
USE YOMDIM   , ONLY : NFLEVL   ,NSMAX
USE YOMCST   , ONLY : ROMEGA
USE YOMCT0   , ONLY : NCONF    ,LSLAG    ,LTWOTL
USE YOMDYN   , ONLY : TDT      ,BETADT   ,VESL     ,XIDT
USE YOMGEM   , ONLY : RSTRET

!**** *SPCIMPFINIT* - PREPARATION FOR IMPLICIT CORIOLIS CASE.

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

!**   Interface.
!     ----------
!        *CALL* *SPCIMFINIT(..)

!        Explicit arguments :  CDCONF - configuration (see doc.)
!        --------------------  KM     - Zonal wavenumber 
!                              KSTA   - First column processed
!                              KEND   - Last column processed
!                              PSPVOR - Distributed vorticity
!                              PSPAUX - Correction to ZSPDIV

!     Method.
!     -------

!     Externals.
!     ----------

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

!     Author.
!     -------
!        Tomas Wilhelmsson *ECMWF*

!     Modifications.
!     --------------
!        22-09-2009 Original with extracted code from spcsi.F90
!     ------------------------------------------------------------------

IMPLICIT NONE

CHARACTER(LEN=1)  ,INTENT(IN)    :: CDCONF 
INTEGER(KIND=JPIM),INTENT(IN)    :: KM
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KEND 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPVOR(:,:) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPAUX(:,:) 

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

REAL(KIND=JPRB) :: ZALPHA (0:NSMAX+1)
REAL(KIND=JPRB) :: ZDENIM (0:NSMAX+1)
REAL(KIND=JPRB) :: ZEPSI  (0:NSMAX)
REAL(KIND=JPRB) :: ZFPLUS (0:NSMAX+1)
REAL(KIND=JPRB) :: ZFMINUS(0:NSMAX+1)

INTEGER(KIND=JPIM) :: ILO, IMSP, IN, IRSP, JL, JLEV, JN 

LOGICAL :: LL3D, LLDOSI

REAL(KIND=JPRB) :: ZAL, ZBDT, ZBDT2, ZEM, ZEN, ZF, ZTEMP
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

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

LL3D=(NCONF == 1.OR.NCONF == 131.OR.NCONF == 302.OR.NCONF == 401 &
 & .OR.NCONF == 501.OR.NCONF == 601.OR.NCONF == 801)

LLDOSI=LL3D.AND.(CDCONF == 'A'.OR.CDCONF == 'I'.OR.&
 & CDCONF == 'S' .OR. CDCONF == 'T')

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

!*       2.    SEMI-IMPLICIT SPECTRAL COMPUTATIONS.
!              ------------------------------------

IF (LLDOSI) THEN

  !*        2.1  Preliminary initialisations.

  IF (LSLAG) THEN
    IF (LTWOTL) THEN
      ZBDT=(1.0_JPRB+VESL)*0.5_JPRB*TDT*BETADT*(1.0_JPRB+XIDT)
    ELSE
      ZBDT=(1.0_JPRB+VESL)*0.5_JPRB*TDT*BETADT
    ENDIF
  ELSE
    ZBDT=0.5_JPRB*TDT*BETADT
  ENDIF
  ZBDT2=(ZBDT*RSTRET)**2

  !*        2.2  Set up helper arrays for implicit Coriolis case.

  ZEM=REAL(KM,JPRB)
  ZAL=2.0_JPRB*ZBDT*ROMEGA*ZEM
  ILO=KM
  IF (KM == 0) THEN
    ZALPHA(0)=0.0_JPRB
    ZDENIM(0)=0.0_JPRB
    ZEPSI(0)=0.0_JPRB
    ILO=1
  ENDIF
  DO JL=ILO,NSMAX
    ZEN=REAL(JL,JPRB)
    ZALPHA(JL)=ZAL/(ZEN*(ZEN+1.0_JPRB))
    ZDENIM(JL)=1.0_JPRB/(1.0_JPRB+ZALPHA(JL)**2)
    ZEPSI(JL)=SQRT((ZEN*ZEN-ZEM*ZEM)/(4.0_JPRB*ZEN*ZEN-1.0_JPRB))
  ENDDO
  ZALPHA(NSMAX+1)=0.0_JPRB
  ZDENIM(NSMAX+1)=0.0_JPRB

  IF (KM == 0) THEN
    ZFPLUS(0)=0.0_JPRB
    ZFMINUS(0)=0.0_JPRB
  ENDIF
  ZF=2.0_JPRB*ZBDT*ROMEGA
  DO JL=ILO,NSMAX-1
    ZEN=REAL(JL,JPRB)
    ZFPLUS(JL)=ZF*ZEN*ZEPSI(JL+1)/(ZEN+1.0_JPRB)
    ZFMINUS(JL)=ZF*(ZEN+1.0_JPRB)*ZEPSI(JL)/ZEN
  ENDDO
  ZEN=REAL(NSMAX,JPRB)
  ZFPLUS(NSMAX)=0.0_JPRB
  ZFMINUS(NSMAX)=ZF*(ZEN+1.0_JPRB)*ZEPSI(NSMAX)/ZEN
  ZFPLUS(NSMAX+1)=0.0_JPRB
  ZFMINUS(NSMAX+1)=0.0_JPRB

  !      Multiply rhs of vorticity equn by INV[J]

  IF (KM > 0) THEN
    DO JN=KM,NSMAX
      DO JLEV=1,NFLEVL
        IRSP=KSTA+(JN-KM)*2
        IMSP=IRSP+1
        ZTEMP=ZDENIM(JN)*(PSPVOR(JLEV,IMSP)&
          & +ZALPHA(JN)*PSPVOR(JLEV,IRSP))  
        PSPVOR(JLEV,IRSP)=ZDENIM(JN)*(PSPVOR(JLEV,IRSP)&
          & -ZALPHA(JN)*PSPVOR(JLEV,IMSP))  
        PSPVOR(JLEV,IMSP)=ZTEMP
      ENDDO
    ENDDO
  ENDIF
  
  DO JN=KM,NSMAX
    DO JLEV=1,NFLEVL
      IRSP=KSTA+(JN-KM)*2
      IMSP=IRSP+1
      PSPAUX(JLEV,IRSP) = 0.0_JPRB
      PSPAUX(JLEV,IMSP) = 0.0_JPRB
    ENDDO
  ENDDO
  
  !      Add [F] * result to rhs of Helmholtz equation
  
  DO JN=KM+1,NSMAX
    DO JLEV=1,NFLEVL
      IRSP=KSTA+(JN-KM)*2
      IMSP=IRSP+1
      PSPAUX(JLEV,IRSP)=PSPAUX(JLEV,IRSP)&
        & + ZFMINUS(JN)*PSPVOR(JLEV,IRSP-2)  
      PSPAUX(JLEV,IMSP)=PSPAUX(JLEV,IMSP)&
        & + ZFMINUS(JN)*PSPVOR(JLEV,IMSP-2)  
    ENDDO
  ENDDO

  DO JN=KM,NSMAX-1
    DO JLEV=1,NFLEVL
      IRSP=KSTA+(JN-KM)*2
      IMSP=IRSP+1
      PSPAUX(JLEV,IRSP)=PSPAUX(JLEV,IRSP)&
        & + ZFPLUS(JN)*PSPVOR(JLEV,IRSP+2)
      PSPAUX(JLEV,IMSP)=PSPAUX(JLEV,IMSP)&
        & + ZFPLUS(JN)*PSPVOR(JLEV,IMSP+2)
    ENDDO
  ENDDO
ENDIF

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

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