SUBROUTINE SPNHSI_GEOGW(&
 ! --- INPUT -----------------------------------------------------------------
 & CDCONF,KM,KMLOC,KSTA,KEND,LDONEM, &
 ! --- INOUT -----------------------------------------------------------------
 & PSPVORG,PSPDIVG,PSPTG,PSPSPG,PSPSPDG,PSPSVDG)  

!**** *SPNHSI_GEOGW* - SPECTRAL SPACE SEMI-IMPLICIT COMPUTATIONS FOR
!                      (Phi-gw) NH MODEL.

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

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

!        Explicit arguments :
!        --------------------
!         INPUT:
!          CDCONF    - configuration of work (see doc.)
!          KM        - Zonal wavenumber
!          KMLOC     - Zonal wavenumber (DM-local numbering)
!          KSTA      - first column processed
!          KEND      - last column processed
!          LDONEM    - T if only one m if processed

!         INOUT:
!          PSPVORG   - Vorticity columns
!          PSPDIVG   - divergence columns
!          PSPTG     - temperature columns
!          PSPSPG    - surface pressure
!          PSPSPDG   - pressure departure variable (i.e. Phi) columns
!          PSPSVDG   - vertical divergence variable (i.e. gw) columns

!     Method.
!     -------

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

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

!     Author.
!     -------
!        K. YESSAD (CNRM/GMAP)

!     Modifications.
!     --------------
!   Original : Dec 2007
!     ------------------------------------------------------------------

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

USE YOMMP    , ONLY : MYSETV   ,NPTRSV   ,NPTRSVF
USE YOMDIM   , ONLY : NFLEVG   ,NSMAX
USE YOMCST   , ONLY : ROMEGA   ,RD       ,RG       ,RCVD     ,RCPD
USE YOMCT0   , ONLY : NCONF    ,LSLAG    ,LTWOTL   ,LSITRIC
USE YOMDYN   , ONLY : SCGMAP   ,SIMO     ,SIMI     ,SIFACI   ,&
 & SIVP     ,SIHEG    ,SIHEG2   ,SITR     ,SITRA    ,&
 & TDT      ,BETADT   ,VESL     ,LSIDG    ,XIDT     ,LIMPF
USE YOMLAP   , ONLY : NVALUE   ,NSE0L    ,RLAPDI   ,RLAPIN
USE YOMGEM   , ONLY : RSTRET
USE YOMCVER  , ONLY : LVFE_DBCS,LVFE_DBCT,LVFE_DERIB

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

IMPLICIT NONE

CHARACTER(LEN=1)  ,INTENT(IN)    :: CDCONF 
INTEGER(KIND=JPIM),INTENT(IN)    :: KM 
INTEGER(KIND=JPIM),INTENT(IN)    :: KMLOC
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KEND 
LOGICAL           ,INTENT(IN)    :: LDONEM 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPVORG(:,:) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPDIVG(:,:) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPTG(:,:) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPSPG(:) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPSPDG(:,:) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPSVDG(:,:) 

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

REAL(KIND=JPRB) :: ZZSPVORG(NFLEVG,KSTA:KEND)
REAL(KIND=JPRB) :: ZZSPDIVG(NFLEVG,KSTA:KEND)
REAL(KIND=JPRB) :: ZZSPTG  (NFLEVG,KSTA:KEND)
REAL(KIND=JPRB) :: ZZSPSPG (       KSTA:KEND)
REAL(KIND=JPRB) :: ZZSPSPDG(NFLEVG,KSTA:KEND)
REAL(KIND=JPRB) :: ZZSPSVDG(NFLEVG,KSTA:KEND)

REAL(KIND=JPRB) :: ZSDIV  (NFLEVG,KSTA:KEND)
REAL(KIND=JPRB) :: ZHELP  (NFLEVG,KSTA:KEND)
REAL(KIND=JPRB) :: ZST    (NFLEVG,KSTA:KEND)
REAL(KIND=JPRB) :: ZSP    (       KSTA:KEND)
REAL(KIND=JPRB) :: ZSDIVP (NFLEVG,KSTA:KEND)
REAL(KIND=JPRB) :: ZSPDIVP(NFLEVG,KSTA:KEND)

REAL(KIND=JPRB) :: ZSDIVPL (NFLEVG,KM:NSMAX,2)
REAL(KIND=JPRB) :: ZSPDIVPL(NFLEVG,KM:NSMAX,2)

REAL(KIND=JPRB) :: ZW1(0:NFLEVG+1,KSTA:KEND)
REAL(KIND=JPRB) :: ZW2(0:NFLEVG+1,KSTA:KEND)
REAL(KIND=JPRB) :: ZW3(0:NFLEVG+1,KSTA:KEND)
REAL(KIND=JPRB) :: ZIN(0:NFLEVG+1,KSTA:KEND)
REAL(KIND=JPRB) :: ZD_STST(NFLEVG,KSTA:KEND)
REAL(KIND=JPRB) :: ZGW_STST(NFLEVG,KSTA:KEND)

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

INTEGER(KIND=JPIM) :: II, ILO, IMSP, IN, IOFF, IRSP, IS0, IS02,&
 & ISE, ISPCOL, JL, JLEV, JN, JSP  

REAL(KIND=JPRB) :: ZAL, ZBDT, ZBDT2, ZEM, ZEN, ZF, ZTEMP
REAL(KIND=JPRB) :: ZCOEF, ZCOEG, ZCT

LOGICAL :: LL3D,LLDOSI

REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

INTERFACE
#include "mxmaop.h"
END INTERFACE

#include "mxptma.h"
#include "mxture.h"
#include "mxturs.h"
#include "simplico.h"
#include "sitnu.intfb.h"
#include "sivderi.intfb.h"

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

IF (LHOOK) CALL DR_HOOK('SPNHSI_GEOGW',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')

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

!*       1.    MEMORY TRANSFER.
!              ----------------

IF (LL3D) THEN
  IF (LIMPF) ZZSPVORG(1:NFLEVG,KSTA:KEND)=&
   & PSPVORG(1:NFLEVG,KSTA:KEND)  
  ZZSPDIVG(1:NFLEVG,KSTA:KEND)=PSPDIVG(1:NFLEVG,KSTA:KEND)
  ZZSPTG  (1:NFLEVG,KSTA:KEND)=PSPTG  (1:NFLEVG,KSTA:KEND)
  ZZSPSPG (         KSTA:KEND)=PSPSPG (         KSTA:KEND)
  ZZSPSPDG(1:NFLEVG,KSTA:KEND)=PSPSPDG(1:NFLEVG,KSTA:KEND)
  ZZSPSVDG(1:NFLEVG,KSTA:KEND)=PSPSVDG(1:NFLEVG,KSTA:KEND)
ENDIF

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

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

IF (LLDOSI) THEN

  !*        2.1  Preliminary initialisations.

  IF (LDONEM) THEN
    IOFF=NPTRSVF(MYSETV)-1
  ELSE
    IOFF=NPTRSV(MYSETV)-1
  ENDIF
  ISPCOL=KEND-KSTA+1

  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.

  IF (LIMPF) THEN
    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
  ENDIF

  !*        2.3  Computes right-hand side of Helmholtz equation.

  !        Compute (sivderi+1) ZZSPTG, (sivderi+1) ZZSPSPDG,
  !        sivderi(sivderi+1) ZZSPSPDG.

  ! Constant upper BC; constant lower BC.
  ZIN(1:NFLEVG,KSTA:KEND)=ZZSPTG(1:NFLEVG,KSTA:KEND)
  ZIN(0,KSTA:KEND)=ZIN(1,KSTA:KEND)
  ZIN(NFLEVG+1,KSTA:KEND)=ZIN(NFLEVG,KSTA:KEND)
  CALL SIVDERI(ISPCOL,1,LDVDERIB=LVFE_DERIB,LDBCS=LVFE_DBCS,LDBCT=LVFE_DBCT, &
   & PSPIN=ZIN,PSPOUT=ZW1)

  ! Constant upper BC; lower BC=0 (OK at least for (NPDVAR,NVDVAR)=(3,5)).
  ! k.y.: I don't know what lower BC to put if (NPDVAR,NVDVAR)/=(3,5).
  ZIN(1:NFLEVG,KSTA:KEND)=ZZSPSPDG(1:NFLEVG,KSTA:KEND)
  ZIN(0,KSTA:KEND)=ZIN(1,KSTA:KEND)
  ZIN(NFLEVG+1,KSTA:KEND)=0.0_JPRB
  CALL SIVDERI(ISPCOL,1,LDVDERIB=LVFE_DERIB,LDBCS=LVFE_DBCS,LDBCT=LVFE_DBCT, &
   & PSPIN=ZIN,PSPOUT=ZW2)

  ! Constant upper BC; lower BC=0 (OK at least for (NPDVAR,NVDVAR)=(3,5)).
  ! k.y.: I don't know what lower BC to put if (NPDVAR,NVDVAR)/=(3,5).
  ZIN(1:NFLEVG,KSTA:KEND)=ZW2(1:NFLEVG,KSTA:KEND)
  ZIN(0,KSTA:KEND)=ZIN(1,KSTA:KEND)
  ZIN(NFLEVG+1,KSTA:KEND)=0.0_JPRB
  CALL SIVDERI(ISPCOL,0,LDVDERIB=LVFE_DERIB,LDBCS=LVFE_DBCS,LDBCT=LVFE_DBCT, &
   & PSPIN=ZIN,PSPOUT=ZW3)

  !        Compute D'** and g*W**.

  DO JLEV=1,NFLEVG
    DO JSP=KSTA,KEND
      IN=NVALUE(JSP+IOFF)
      ZD_STST(JLEV,JSP)=ZZSPDIVG(JLEV,JSP)-ZBDT*RLAPDI(IN)* &
       & (RD*SITR*ZZSPSPG(JSP)+RD*ZZSPTG(JLEV,JSP)+ZW2(JLEV,JSP))
      ZGW_STST(JLEV,JSP)=ZZSPSVDG(JLEV,JSP)+ZBDT*(RG*RG/(RD*SITRA))* &
       & (RD*ZW1(JLEV,JSP)+ZW3(JLEV,JSP))
    ENDDO
  ENDDO

  !        Compute the RHS

  ! BC OK at least for (NPDVAR,NVDVAR)=(3,5), for term ZZSPSVDG.
  ! k.y.: I don't know what lower BC to put if (NPDVAR,NVDVAR)/=(3,5).
  ZIN(1:NFLEVG,KSTA:KEND)=ZGW_STST(1:NFLEVG,KSTA:KEND)
  ZIN(0,KSTA:KEND)=ZZSPSVDG(1,KSTA:KEND)+ZBDT*(RG*RG/SITRA)*ZZSPTG(1,KSTA:KEND)
  ZIN(NFLEVG+1,KSTA:KEND)=ZBDT*(RG*RG/SITRA)*ZZSPTG(NFLEVG,KSTA:KEND)
  CALL SIVDERI(ISPCOL,0,LDVDERIB=LVFE_DERIB,LDBCS=LVFE_DBCS,LDBCT=LVFE_DBCT, &
   & PSPIN=ZIN,PSPOUT=ZW1)

  ZCOEF=((RD*SITR)/(RCVD*SITRA))+1.0_JPRB
  DO JLEV=1,NFLEVG
    DO JSP=KSTA,KEND
      ZW2(JLEV,JSP)=ZBDT*(ZCOEF*ZW1(JLEV,JSP)+ZGW_STST(JLEV,JSP))
    ENDDO
  ENDDO

  CALL MXMAOP(SIFACI,1,NFLEVG,ZW2(1:NFLEVG,KSTA:KEND),1,NFLEVG,ZSDIV,1,NFLEVG, &
   & NFLEVG,NFLEVG,ISPCOL)

  IF (LSIDG) THEN
    IF (KM > 0) THEN
      DO JLEV=1,NFLEVG
        DO JSP=KSTA,KEND
          IN=NVALUE(JSP+IOFF)
          ZSDIV(JLEV,JSP)=RLAPIN(IN)*ZD_STST(JLEV,JSP)&
           & -ZBDT*ZSDIV(JLEV,JSP)      
        ENDDO
      ENDDO
    ELSE
      DO JLEV=1,NFLEVG
        DO JSP=KSTA,KEND
          IN=NVALUE(JSP+IOFF)
          ZSDIV(JLEV,JSP)=ZD_STST(JLEV,JSP)&
           & -ZBDT*RLAPDI(IN)*ZSDIV(JLEV,JSP)  
        ENDDO
      ENDDO
    ENDIF
  ELSE

    ! Case of No Stretching

    DO JLEV=1,NFLEVG
      DO JSP=KSTA,KEND
        IN=NVALUE(JSP+IOFF)
        ZSDIV(JLEV,JSP)=ZD_STST(JLEV,JSP)-ZBDT*RLAPDI(IN)*ZSDIV(JLEV,JSP)
      ENDDO
    ENDDO
  ENDIF

  !        For implicit Coriolis case, multiply rhs of vorticity equn by INV[J]
  !        Careful : LIMPF assumes all n-values are available !

  IF (LIMPF) THEN
    IF (KM > 0) THEN
      DO JLEV=1,NFLEVG
        DO JN=KM,NSMAX
          IRSP=KSTA+(JN-KM)*2
          IMSP=IRSP+1
          ZTEMP=ZDENIM(JN)*(ZZSPVORG(JLEV,IMSP)&
           & +ZALPHA(JN)*ZZSPVORG(JLEV,IRSP))  
          ZZSPVORG(JLEV,IRSP)=ZDENIM(JN)*(ZZSPVORG(JLEV,IRSP)&
           & -ZALPHA(JN)*ZZSPVORG(JLEV,IMSP))  
          ZZSPVORG(JLEV,IMSP)=ZTEMP
        ENDDO
      ENDDO
    ENDIF

    !        Add [F] * result to rhs of Helmholtz equation

    DO JLEV=1,NFLEVG
      DO JN=KM+1,NSMAX
        IRSP=KSTA+(JN-KM)*2
        IMSP=IRSP+1
        ZSDIV(JLEV,IRSP)=ZSDIV(JLEV,IRSP)&
         & + ZFMINUS(JN)*ZZSPVORG(JLEV,IRSP-2)  
        ZSDIV(JLEV,IMSP)=ZSDIV(JLEV,IMSP)&
         & + ZFMINUS(JN)*ZZSPVORG(JLEV,IMSP-2)  
      ENDDO
    ENDDO

    DO JLEV=1,NFLEVG
      DO JN=KM,NSMAX-1
        IRSP=KSTA+(JN-KM)*2
        IMSP=IRSP+1
        ZSDIV(JLEV,IRSP)=ZSDIV(JLEV,IRSP)+ ZFPLUS(JN)*ZZSPVORG(JLEV,IRSP+2)
        ZSDIV(JLEV,IMSP)=ZSDIV(JLEV,IMSP)+ ZFPLUS(JN)*ZZSPVORG(JLEV,IMSP+2)
      ENDDO
    ENDDO
  ENDIF

  !*        2.4  Solve Helmholtz equation

  IF (LSITRIC) THEN

    ! Not yet coded.
    CALL ABOR1(' SPNHSI_GEOGW: LSITRIC NOT CODED')

  ELSE

    !           Current space --> vertical eigenmodes space.

    CALL MXMAOP(SIMI,1,NFLEVG,ZSDIV,1,NFLEVG,ZSDIVP,1,NFLEVG,&
     & NFLEVG,NFLEVG,ISPCOL)  
    IF (LSIDG) THEN

      !             Inversion of two tridiagonal systems (Helmholtz equation)
      !                --> (SIMI*DIVprim(t+dt)).

      !             Reorganisation of divergence

      IS0=NSE0L(KMLOC)
      IS02=0
      II=MIN(KM,1)+1
      ZSDIVPL(:,:,:)=0.0_JPRB
      ZSPDIVPL(:,:,:)=0.0_JPRB

      DO JN=KM,NSMAX
        ISE=KSTA+2*(JN-KM)
        ZSDIVPL(:,JN,1:2)=ZSDIVP(:,ISE:ISE+1)
      ENDDO
      IF (KM > 0) THEN

        !               Inversion of a symmetric matrix.

        CALL MXTURS(NSMAX+1-KM,NFLEVG,NFLEVG,II,&
         & SIHEG(1,IS0+1,1),SIHEG(1,IS0+1,2),SIHEG(1,IS0+1,3),&
         & ZSDIVPL,ZSPDIVPL)  
      ELSE

        !               Inversion of a non-symmetric matrix.

        CALL MXTURE(NSMAX+1-KM,NFLEVG,NFLEVG,II,-2,.TRUE.,&
         & SIHEG(1,IS0+1,1),SIHEG(1,IS0+1,2),SIHEG(1,IS0+1,3),&
         & ZSDIVPL,ZSPDIVPL)  
        CALL MXTURE(NSMAX+1-KM,NFLEVG,NFLEVG,II,3,.FALSE.,&
         & SIHEG(1,IS0+1,1),SIHEG2(1,IS02+1,2),&
         & SIHEG2(1,IS02+1,3),ZSDIVPL,ZSPDIVPL)  
      ENDIF

      DO JN=KM,NSMAX
        ISE=KSTA+2*(JN-KM)
        ZSPDIVP(:,ISE:ISE+1)=ZSPDIVPL(:,JN,1:2)
      ENDDO
    ELSE

      !             Case with NO Stretching :

      IF (LIMPF) THEN

        !               Solve complex pentadiagonal system

        CALL SIMPLICO(KM,NSMAX,NFLEVG,NFLEVG,ZALPHA(KM),&
         & ZDENIM(KM),ZFPLUS(KM),ZFMINUS(KM),SIVP,RLAPDI(0),&
         & ZBDT2,ZSDIVP,ZSPDIVP)  
      ELSE

        !                 Inversion of a diagonal system (Helmholtz equation)
        !                 --> (SIMI*DIVprim(t+dt)).

        DO JLEV=1,NFLEVG
          DO JSP=KSTA,KEND
            ZSPDIVP(JLEV,JSP)=ZSDIVP(JLEV,JSP)&
             & /(1.0_JPRB-ZBDT2*SIVP(JLEV)*RLAPDI(NVALUE(JSP+IOFF)))  
          ENDDO
        ENDDO
      ENDIF
    ENDIF

    !           Vertical eigenmodes space --> current space.

    CALL MXMAOP(SIMO,1,NFLEVG,ZSPDIVP,1,NFLEVG,ZZSPDIVG,1,&
     & NFLEVG,NFLEVG,NFLEVG,ISPCOL)  
  ENDIF
  IF (LSIDG) THEN

    !           ZSPDIV=(DIVprim(t+dt)) --> ZSPDIVG=(GM**2 * DIVprim(t+dt)) .

    ZSDIVPL(:,:,:)=0.0_JPRB
    ZSPDIVPL(:,:,:)=0.0_JPRB

    !           Reorganisation of ZSDIVP (Back to the USSR)

    DO JN=KM,NSMAX
      ISE=KSTA+2*(JN-KM)
      ZSDIVPL(:,JN,1:2)=ZZSPDIVG(:,ISE:ISE+1)
    ENDDO

    !        ZSPDIV=(DIVprim(t+dt)) --> ZPSPDIVG=(GMBAR**2 * DIVprim(t+dt)).

    CALL MXPTMA(NSMAX+1-KM,NFLEVG,NFLEVG,II,SCGMAP(IS0+1,1),&
     & SCGMAP(IS0+1,2),SCGMAP(IS0+1,3),&
     & SCGMAP(IS0+1,2),SCGMAP(IS0+1,3),&
     & ZSDIVPL,ZSPDIVPL)  

    !           Reorganisation of ZSPDIVPL

    DO JN=KM,NSMAX
      ISE=KSTA+2*(JN-KM)
      ZHELP(:,ISE:ISE+1)=ZSPDIVPL(:,JN,1:2)
    ENDDO
  ELSE

    !       ZSPDIV=(DIVprim(t+dt)) --> ZSPDIVG=(GMBAR**2 * DIVprim(t+dt)) .

    DO JLEV=1,NFLEVG
      DO JSP=KSTA,KEND
        ZHELP(JLEV,JSP)=ZZSPDIVG(JLEV,JSP)*RSTRET*RSTRET
      ENDDO
    ENDDO

  ENDIF

  !*       2.5  Increment g*w.

  CALL SITNU(1,NFLEVG,ZHELP,ZST,ZSP,ISPCOL)

  DO JLEV=1,NFLEVG
    DO JSP=KSTA,KEND
      ZW1(JLEV,JSP)=ZSP(JSP)-(RCPD/(RD*SITR))*ZST(JLEV,JSP)
    ENDDO
  ENDDO

  ! Upper BC: ZST=0; lower BC: ZW1=0.
  ZIN(1:NFLEVG,KSTA:KEND)=ZW1(1:NFLEVG,KSTA:KEND)
  ZIN(0,KSTA:KEND)=ZSP(KSTA:KEND)
  ZIN(NFLEVG+1,KSTA:KEND)=0.0_JPRB
  CALL SIVDERI(ISPCOL,2,LDVDERIB=LVFE_DERIB,LDBCS=LVFE_DBCS,LDBCT=LVFE_DBCT, &
   & PSPIN=ZIN,PSPOUT=ZW3)

  ! Constant upper BC; constant lower BC.
  ZIN(1:NFLEVG,KSTA:KEND)=ZHELP(1:NFLEVG,KSTA:KEND)
  ZIN(0,KSTA:KEND)=ZIN(1,KSTA:KEND)
  ZIN(NFLEVG+1,KSTA:KEND)=ZIN(NFLEVG,KSTA:KEND)
  CALL SIVDERI(ISPCOL,1,LDVDERIB=LVFE_DERIB,LDBCS=LVFE_DBCS,LDBCT=LVFE_DBCT, &
   & PSPIN=ZIN,PSPOUT=ZW2)

  ZCOEF=(RG*RG*RD*SITR)/(RCVD*SITRA)
  ZCOEG=(RG*RG*SITR)/SITRA
  DO JLEV=1,NFLEVG
    DO JSP=KSTA,KEND
      ZW2(JLEV,JSP)=ZGW_STST(JLEV,JSP) &
       & -ZBDT*ZBDT*(ZCOEF*ZW2(JLEV,JSP)-ZCOEG*ZW3(JLEV,JSP))
    ENDDO
  ENDDO

  CALL MXMAOP(SIFACI,1,NFLEVG,ZW2(1:NFLEVG,KSTA:KEND),1,NFLEVG, &
   & ZZSPSVDG,1,NFLEVG,NFLEVG,NFLEVG,ISPCOL)

  !*       2.6  Increment Phi.

  DO JLEV=1,NFLEVG
    DO JSP=KSTA,KEND
      ZZSPSPDG(JLEV,JSP)=ZZSPSPDG(JLEV,JSP) &
       & +ZBDT*(ZZSPSVDG(JLEV,JSP)+RD*SITR*ZW1(JLEV,JSP))
    ENDDO
  ENDDO

  !*       2.7  Increment Temperature.

  ! Constant upper BC; lower BC=0 (OK at least for (NPDVAR,NVDVAR)=(3,5)).
  ! k.y.: I don't know what lower BC to put if (NPDVAR,NVDVAR)/=(3,5).
  ZIN(1:NFLEVG,KSTA:KEND)=ZZSPSVDG(1:NFLEVG,KSTA:KEND)
  ZIN(0,KSTA:KEND)=ZIN(1,KSTA:KEND)
  ZIN(NFLEVG+1,KSTA:KEND)=0.0_JPRB
  CALL SIVDERI(ISPCOL,1,LDVDERIB=LVFE_DERIB,LDBCS=LVFE_DBCS,LDBCT=LVFE_DBCT, &
   & PSPIN=ZIN,PSPOUT=ZST)

  ZCOEF=RD*SITR/RCVD
  ZCOEG=1.0_JPRB/(RD*SITRA)
  DO JLEV=1,NFLEVG
    DO JSP=KSTA,KEND
      ZST(JLEV,JSP)=ZCOEF*(ZHELP(JLEV,JSP)-ZCOEG*ZST(JLEV,JSP))
    ENDDO
  ENDDO

  DO JLEV=1,NFLEVG
    DO JSP=KSTA,KEND
      ZZSPTG(JLEV,JSP)=ZZSPTG(JLEV,JSP)-ZBDT*ZST(JLEV,JSP)
    ENDDO
  ENDDO

  !*       2.8  Increment surface pressure.

  DO JSP=KSTA,KEND
    ZZSPSPG(JSP)=ZZSPSPG(JSP)-ZBDT*ZSP(JSP)
  ENDDO

  !*       2.9  Increment vorticity

  IF (LIMPF) THEN
    DO JLEV=1,NFLEVG
      IF (KM == 0) THEN
        DO JN=2,NSMAX
          IRSP=KSTA+(JN-KM)*2
          ZZSPVORG(JLEV,IRSP)=ZZSPVORG(JLEV,IRSP)&
           & -ZDENIM(JN)*ZFMINUS(JN)*ZZSPDIVG(JLEV,IRSP-2)  
        ENDDO
        DO JN=1,NSMAX-1
          IRSP=KSTA+(JN-KM)*2
          ZZSPVORG(JLEV,IRSP)=ZZSPVORG(JLEV,IRSP)&
           & -ZDENIM(JN)*ZFPLUS(JN)*ZZSPDIVG(JLEV,IRSP+2)  
        ENDDO
      ELSE
        DO JN=KM+1,NSMAX
          IRSP=KSTA+(JN-KM)*2
          IMSP=IRSP+1
          ZZSPVORG(JLEV,IRSP)=ZZSPVORG(JLEV,IRSP)&
           & -ZDENIM(JN)*ZFMINUS(JN)*(ZZSPDIVG(JLEV,IRSP-2)&
           & -ZALPHA(JN)*ZZSPDIVG(JLEV,IMSP-2))  
          ZZSPVORG(JLEV,IMSP)=ZZSPVORG(JLEV,IMSP)&
           & -ZDENIM(JN)*ZFMINUS(JN)*(ZZSPDIVG(JLEV,IMSP-2)&
           & +ZALPHA(JN)*ZZSPDIVG(JLEV,IRSP-2))  
        ENDDO
        DO JN=KM,NSMAX-1
          IRSP=KSTA+(JN-KM)*2
          IMSP=IRSP+1
          ZZSPVORG(JLEV,IRSP)=ZZSPVORG(JLEV,IRSP)&
           & -ZDENIM(JN)*ZFPLUS(JN)*(ZZSPDIVG(JLEV,IRSP+2)&
           & -ZALPHA(JN)*ZZSPDIVG(JLEV,IMSP+2))  
          ZZSPVORG(JLEV,IMSP)=ZZSPVORG(JLEV,IMSP)&
           & -ZDENIM(JN)*ZFPLUS(JN)*(ZZSPDIVG(JLEV,IMSP+2)&
           & +ZALPHA(JN)*ZZSPDIVG(JLEV,IRSP+2))  
        ENDDO
      ENDIF
    ENDDO
  ENDIF

ENDIF

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

!*       3.    MEMORY TRANSFER.
!              ----------------

IF (LL3D) THEN
  IF (LIMPF) PSPVORG(1:NFLEVG,KSTA:KEND)=&
   & ZZSPVORG(1:NFLEVG,KSTA:KEND)  
  PSPDIVG(1:NFLEVG,KSTA:KEND)=ZZSPDIVG(1:NFLEVG,KSTA:KEND)
  PSPTG  (1:NFLEVG,KSTA:KEND)=ZZSPTG  (1:NFLEVG,KSTA:KEND)
  PSPSPG (         KSTA:KEND)=ZZSPSPG (         KSTA:KEND)
  PSPSPDG(1:NFLEVG,KSTA:KEND)=ZZSPSPDG(1:NFLEVG,KSTA:KEND)
  PSPSVDG(1:NFLEVG,KSTA:KEND)=ZZSPSVDG(1:NFLEVG,KSTA:KEND)
ENDIF

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

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