SUBROUTINE SPCHOR(CDCONF,KSTA,KEND, &
 & PSPVOR,PSPDIV,PSPT,PSPSPD,PSPSVD,PSPSNHX,PSPGFL,PSPSP)

USE PARKIND1 , ONLY : JPIM     ,JPRB

USE YOMCST   , ONLY : RA
USE YOMCT0   , ONLY : NCONF    ,LNHDYN   ,LSPBSBAL
USE YOMCT3   , ONLY : NSTEP
USE YOMDIM   , ONLY : NFLEVL   ,NSMAX    ,NFTHER   ,LSPT     ,NUMP     , &
 &                    NS3D     ,NPROMA   
USE YOMDYN   , ONLY : RDIVOR   ,RDIDIV   ,RDITG    ,RDIGFL   ,RDISP    , &
 &                    RDIPD    ,RDIVD    , &
 &                    RCORDIT  ,RDHI     ,TDT      ,LSTRHD   , &
 &                    RDSVOR   ,RDSDIV   ,RDSVD    ,RDHS
USE YOMDYNA  , ONLY : LSLHD_STATIC ,LSLHD_W  ,LSLHD_SVD,LNHX
USE YOMHOOK  , ONLY : LHOOK    ,DR_HOOK
USE YOMJG    , ONLY : LJB_NONLINEAR_BALANCE, LJB_OMEGA_BALANCE
USE YOMLAP   , ONLY : NASM0    ,NVALUE   ,MYMS     ,NSE0L    ,RLAPDI   , &
 &                    RLAPIN
USE STOPH_MIX , ONLY : LSTOPH_SPBS, LSTOPH_SPBS_VORT, LSTOPH_CASBS, LVORTCON,  & 
 &                    GPSTREAM,  GPTOTDISS, GPTOTDISS_SMOOTH, RSMOOTH, &
 &                    SPSTREAM, SPSTREAM_FORC, NFRSTOPH_SPBS, NFRSTOPH_VC, &
 &                    GPVORTGRAD, &
 &                    LSTOPH_SPBS_T, SPTEMP, SPTEMP_FORC, GPTEMP, &
 &                    SPNORMBS, LSPBSNORM
USE YOMMP    , ONLY : MYSETV   ,NPTRLL   ,MYLEVS   ,NPSP     ,NBSETLEV
USE YOMNUD   , ONLY : NFNUDG   ,NTNUDG   ,LNUDG    ,LNUDDI   ,LNUDLP   , &
 &                    LNUDSH   ,LNUDTE   ,LNUDVO   ,XNUDDI   ,XNUDLP   , &
 &                    XNUDSH   ,XNUDTE   ,XNUDVO   ,NSPNU1   ,NSPNU2
USE YOMSNU   , ONLY : XPNUDG   ,TNUDTE   ,TNUDSH   ,TNUDDI   ,TNUDVO   , &
 &                    TNUDLP   ,XWNUDG
USE YOM_YGFL , ONLY : YGFL     ,YGFLC    ,YQ

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

!**** *SPCHOR* - HORIZONTAL SPECTRAL SPACE COMPUTATIONS

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

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

!        Explicit arguments :  CDCONF  - configuration (see doc.)
!        --------------------  
!                              KSTA    - First column processed
!                              KEND    - Last columns processed
!                              PSPVOR - Vorticity columns
!                              PSPDIV - Divergence columns
!                              PSPT   - Temperature columns
!                              PSPSPD - NH pressure departure var.
!                              PSPSVD - NH vertical divergence var.
!                              PSPSNHX - NH "X" part divergence var.
!                              PSPGFL - GFL
!                              PSPSP  - Surface Pressure

!     Method.
!     -------
!        SPCHOR  works in the "normal" spectral domain where a
!                given processor owns NFLEVL levels and NSPEC2
!                spectral coefficients. NSPEC2 depends on MYSETW only,
!                and NFLEVL depends on MYSETV only

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

!     Author.
!     -------
!        Mats Hamrud and Philippe Courtier  *ECMWF*

! Modifications
! -------------
!   Original   : 87-11-24 (before 1997 spchor.F was part of spc.F)
!   R. EL Khatib 93-05-10: Spectral "brake"
!   D GIARD (Jan 1994): CDCONF='I'.
!   K. Yessad (Jan 1994): semi-implicit computations
!      with not reduced divergence + new formulation of variable
!      mesh horizontal diffusion + multitasking on m instead of n.
!   K. Yessad and R. El Khatib 94-02-18:
!                    Harmonisation of enhanced diffusions (LFREIN).
!   K. Yessad (April 1994): Unified horizontal diffusion scheme.
!   M. Hamrud 94-06-20: upper air grid-point file
!   M. Tolstykh 94-09-08: modified decentering in semi-Lag scheme
!   L. Isaksen 95-06-06: Reordering of spectral arrays
!   K. YESSAD (Nov 1995): removal of HDC horizontal diffusion scheme.
!   M. Hortal 96-04-25: CDCONF='F' for filtering spectral fields
!   L. Isaksen 96-05-05: NFLEV --> NFLEVG  for consistency only
!   M. Deque 96-07-03 : Nudging
!   M. Tolstykh 96-10-14: Fourier space horizontal diffusion
!   L. Isaksen 96-12-12: Merged with message passing version.
!                        Renamed and recoded. Based on J. Latour version
!   R. EL Khatib 00-12-04 spectral enhanced diff. from the jet level to the top
!   M. Szczech 00-04-18: Add horizontal diffusion for thermodynamic ozon
!   M. Tolstykh 02-02-12: No diffusion on the work sphere if
!                         Fourier diffusion is chosen
!   K. YESSAD 03-04-16: bug correction in call MXTURHD.
!   01-Oct-2003 M. Hamrud           CY28 Cleaning
!      Dec-2003 K. Yessad           cleaning in horizontal diffusion
!               F. Vana, K. Yessad  modify diffusion when LSLHD=T
!   10-Jun-2004 J. Masek            NH cleaning (LFULLIMP)
!   K. Yessad 04-11-15: update the enhanced diffusion
!   F. Vana   05-02-11: split of global LSLHD key + cleaning
!   K. Yessad 08-Feb-2005: horizontal diffusion for NH variables (case c=1)
!   K. Yessad 12-Dec-2005: horizontal diffusion for NH variables (case c>1)
!   K. Yessad 12-Dec-2005: bug corrections for SLHD applied to SVD,NHX.
!   J. Berner 06-09-2006 : added streamfunction perturbations and
!                          computation for dissipations rate for stochstic phys
!   A. Alias  06-03-09: Nudging
!        M. Deque : Nudging in correction mode
!        M. Deque : Nudging with time-variable coefficients
!        P. Marquet : XWNUDG in YOMSNU
!        M. Deque : Nudging with vert-variable coefficients
!   K. Yessad 15-May-2006: memory optimisations for stretched geometry
!   A. Alias 05-11-20  M. Deque : Nudging with wave-variable coefficients
!   K. Yessad (Sep 2008): prune enhanced diffusion (lfrein).
!   F. Vana 13-Jan-2009: recognized case LSLHD_STATIC
! End Modifications
!------------------------------------------------------------------------------

IMPLICIT NONE

CHARACTER(LEN=1)  ,INTENT(IN)    :: CDCONF 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KEND 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPVOR(:,:) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPDIV(:,:) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPT(:,:) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPSPD(:,:) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPSVD(:,:) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPSNHX(:,:) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPGFL(:,:,:) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPSP(:) 

!     ------------------------------------------------------------------
REAL(KIND=JPRB) :: ZSPX(NFLEVL*NS3D+1,0:NSMAX,2)
REAL(KIND=JPRB) :: ZSPY(NFLEVL*NS3D+1,0:NSMAX,2)
REAL(KIND=JPRB) :: ZUSNUD2(KSTA:KEND),ZUSNUD1(KSTA:KEND)
REAL(KIND=JPRB),ALLOCATABLE :: ZSPX_HDS(:,:,:)
REAL(KIND=JPRB),ALLOCATABLE :: ZSPY_HDS(:,:,:)
REAL(KIND=JPRB) :: ZREF(KSTA:KEND)

INTEGER(KIND=JPIM) :: IJSE, ILEV, ILEV0, ILEVG, IL, ILL, IM, IN, INUM_GFL0, &
 & INUM_THE0, IS0, IVTHS, JLEV, JMLOC, JN, JSP, JSTEP, JGFL  

REAL(KIND=JPRB) :: ZDT, ZLAPDI, ZLAPIN
REAL(KIND=JPRB) :: ZCON1
REAL(KIND=JPRB) :: ZHOOK_HANDLE

!     local variables for stochastic backscatter------------------------
REAL(KIND=JPRB) :: ZSPTOTDISS(NFLEVL,KSTA:KEND)  ! spectral coeffs of total dissipation
REAL(KIND=JPRB) :: ZZP(NFLEVL,KSTA:KEND)
REAL(KIND=JPRB) :: ZSPVORPERT(NFLEVL,KSTA:KEND)   ! spectral vorticity  increment due to backscatter
!REAL(KIND=JPRB) :: ZSPDIVPERT(NFLEVL,KSTA:KEND)   ! spectral divergence increment due to backscatter
REAL(KIND=JPRB) :: ZSPVORT(NFLEVL,KSTA:KEND)      ! spectral representation of vorticity forcing pattern
REAL(KIND=JPRB) :: ZSPDIVBALPERT(NFLEVL,KSTA:KEND)
REAL(KIND=JPRB) :: ZSPDIVOMEGAPERT(NFLEVL,KSTA:KEND)
REAL(KIND=JPRB) :: ZSPTPERT(NFLEVL,KSTA:KEND) 
REAL(KIND=JPRB) :: ZSPSPPERT(KSTA:KEND) 

!     ------------------------------------------------------------------
INTERFACE
#include "inv_trans.h"
#include "dir_trans.h"
END INTERFACE

#include "mxturhd.h"
#include "balnonlintl.intfb.h"
#include "balvert.intfb.h"
#include "balomegatl.intfb.h"

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

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

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

!  ILEV0 is the ordinal of the first level for this processor
!  in the interval 1:NFLEVG

ILEV0=NPTRLL(MYSETV) - 1

!  The use of NVALUE must match the definition in sulap.F
!  NVALUE is the value of N for the index given (1:NSPEC2)

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

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

  IF (CDCONF == 'A'.OR.CDCONF == 'I') THEN

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

!*        2.    MAIN HORIZONTAL DIFFUSION.
!              ---------------------------

    IF (CDCONF == 'A') THEN

      IF (LSTRHD) THEN

!           2.1  Diffusion when stretching.

!       * The order in ZSPX, ZSPY and also in RDHI is assumed to be the
!         following one:
!         - VOR,DIV.
!         - Thermodynamic variables.
!         - NH variables (SPD,SVD,NHX).
!         - GFL variables.
!         - GMVS variables.
        INUM_GFL0=2+NFTHER

        ZSPX(:,:,:)=0.0_JPRB
        ZSPY(:,:,:)=0.0_JPRB

        DO JMLOC=1,NUMP

          IM=MYMS(JMLOC)

          DO JN=IM,NSMAX
            IJSE=NASM0(IM)+2*(JN-IM)
            INUM_THE0=0
            ! * Vor,Div.
            ZLAPIN=RLAPIN(JN)
            DO JLEV=1,NFLEVL
              ZSPX(JLEV         ,JN,1)=PSPVOR(JLEV,IJSE  )*ZLAPIN
              ZSPX(JLEV         ,JN,2)=PSPVOR(JLEV,IJSE+1)*ZLAPIN
              ZSPX(JLEV+  NFLEVL,JN,1)=PSPDIV(JLEV,IJSE  )*ZLAPIN
              ZSPX(JLEV+  NFLEVL,JN,2)=PSPDIV(JLEV,IJSE+1)*ZLAPIN
            ENDDO
            INUM_THE0=INUM_THE0+2
            ! * Temperature.
            IF (LSPT) THEN
              DO JLEV=1,NFLEVL
                ILEVG=ILEV0+JLEV
                ZSPX(JLEV+INUM_THE0*NFLEVL,JN,1)=PSPT(JLEV,IJSE  )&
                 & -RCORDIT(ILEVG)*PSPSP(IJSE  )  
                ZSPX(JLEV+INUM_THE0*NFLEVL,JN,2)=PSPT(JLEV,IJSE+1)&
                 & -RCORDIT(ILEVG)*PSPSP(IJSE+1)  
              ENDDO
              INUM_THE0=INUM_THE0+1
            ENDIF
            ! * Pressure departure.
            IF (LNHDYN) THEN
              DO JLEV=1,NFLEVL
                ZSPX(JLEV+INUM_THE0*NFLEVL,JN,1)=PSPSPD(JLEV,IJSE  )
                ZSPX(JLEV+INUM_THE0*NFLEVL,JN,2)=PSPSPD(JLEV,IJSE+1)
              ENDDO
              INUM_THE0=INUM_THE0+1
            ENDIF
            ! * Vertical divergence.
            IF (LNHDYN) THEN
              DO JLEV=1,NFLEVL
                ZSPX(JLEV+INUM_THE0*NFLEVL,JN,1)=PSPSVD(JLEV,IJSE  )
                ZSPX(JLEV+INUM_THE0*NFLEVL,JN,2)=PSPSVD(JLEV,IJSE+1)
              ENDDO
              INUM_THE0=INUM_THE0+1
            ENDIF
            ! * NHX.
            IF (LNHX) THEN
              DO JLEV=1,NFLEVL
                ZSPX(JLEV+INUM_THE0*NFLEVL,JN,1)=PSPSNHX(JLEV,IJSE  )
                ZSPX(JLEV+INUM_THE0*NFLEVL,JN,2)=PSPSNHX(JLEV,IJSE+1)
              ENDDO
              INUM_THE0=INUM_THE0+1
            ENDIF
            ! * GFL.
            DO JGFL=1,YGFL%NUMFLDS
              IF (YGFLC(JGFL)%LSP) THEN
                DO JLEV=1,NFLEVL
                  ZSPX(JLEV+(INUM_GFL0+YGFLC(JGFL)%MPSP-1)*NFLEVL,JN,1)=&
                   & PSPGFL(JLEV,IJSE  ,YGFLC(JGFL)%MPSP)  
                  ZSPX(JLEV+(INUM_GFL0+YGFLC(JGFL)%MPSP-1)*NFLEVL,JN,2)=&
                   & PSPGFL(JLEV,IJSE+1,YGFLC(JGFL)%MPSP)  
                ENDDO
              ENDIF
            ENDDO
          ENDDO

          ! * ln(prehyds).
          ILL=NFLEVL*NS3D+1
          DO JN=IM,NSMAX
            IJSE=NASM0(IM)+2*(JN-IM)
            ZSPX(ILL,JN,1)=PSPSP(IJSE  )
            ZSPX(ILL,JN,2)=PSPSP(IJSE+1)
          ENDDO

          IS0=NSE0L(JMLOC)
          CALL MXTURHD(NSMAX+1-IM,ILL,ILL,-2,.TRUE.,&
           & RDHI(1,IS0+1,1),RDHI(1,IS0+1,2),ZSPX(1,IM,1),ZSPY(1,IM,1))  
          CALL MXTURHD(NSMAX+1-IM,ILL,ILL,3,.FALSE.,&
           & RDHI(1,IS0+1,1),RDHI(1,IS0+1,3),ZSPX(1,IM,1),ZSPY(1,IM,1))  

          IF (IM > 0) THEN
            CALL MXTURHD(NSMAX+1-IM,ILL,ILL,-2,.TRUE.,&
             & RDHI(1,IS0+1,1),RDHI(1,IS0+1,2),ZSPX(1,IM,2),ZSPY(1,IM,2))  
            CALL MXTURHD(NSMAX+1-IM,ILL,ILL,3,.FALSE.,&
             & RDHI(1,IS0+1,1),RDHI(1,IS0+1,3),ZSPX(1,IM,2),ZSPY(1,IM,2))  
          ENDIF

          DO JN=IM,NSMAX
            IJSE=NASM0(IM)+2*(JN-IM)
            INUM_THE0=0
            ! * Vor,Div.
            ZLAPDI=RLAPDI(JN)
            DO JLEV=1,NFLEVL
              ILEVG=ILEV0+JLEV
              PSPVOR(JLEV,IJSE  )=ZSPY(JLEV       ,JN,1)*ZLAPDI
              PSPVOR(JLEV,IJSE+1)=ZSPY(JLEV       ,JN,2)*ZLAPDI
              PSPDIV(JLEV,IJSE  )=ZSPY(JLEV+NFLEVL,JN,1)*ZLAPDI
              PSPDIV(JLEV,IJSE+1)=ZSPY(JLEV+NFLEVL,JN,2)*ZLAPDI
            ENDDO
            INUM_THE0=INUM_THE0+2
            ! * Temperature.
            IF (LSPT) THEN
              DO JLEV=1,NFLEVL
                ILEVG=ILEV0+JLEV
                PSPT(JLEV,IJSE  )=ZSPY(JLEV+INUM_THE0*NFLEVL,JN,1)&
                 & +RCORDIT(ILEVG)*ZSPY(ILL,JN,1)  
                PSPT(JLEV,IJSE+1)=ZSPY(JLEV+INUM_THE0*NFLEVL,JN,2)&
                 & +RCORDIT(ILEVG)*ZSPY(ILL,JN,2)  
              ENDDO
              INUM_THE0=INUM_THE0+1
            ENDIF
            ! * Pressure departure.
            IF (LNHDYN) THEN
              DO JLEV=1,NFLEVL
                PSPSPD(JLEV,IJSE  )=ZSPY(JLEV+INUM_THE0*NFLEVL,JN,1)
                PSPSPD(JLEV,IJSE+1)=ZSPY(JLEV+INUM_THE0*NFLEVL,JN,2)
              ENDDO
              INUM_THE0=INUM_THE0+1
            ENDIF
            ! * Vertical divergence.
            IF (LNHDYN) THEN
              DO JLEV=1,NFLEVL
                PSPSVD(JLEV,IJSE  )=ZSPY(JLEV+INUM_THE0*NFLEVL,JN,1)
                PSPSVD(JLEV,IJSE+1)=ZSPY(JLEV+INUM_THE0*NFLEVL,JN,2)
              ENDDO
              INUM_THE0=INUM_THE0+1
            ENDIF
            ! * NHX.
            IF (LNHX) THEN
              DO JLEV=1,NFLEVL
                PSPSNHX(JLEV,IJSE  )=ZSPY(JLEV+INUM_THE0*NFLEVL,JN,1)
                PSPSNHX(JLEV,IJSE+1)=ZSPY(JLEV+INUM_THE0*NFLEVL,JN,2)
              ENDDO
              INUM_THE0=INUM_THE0+1
            ENDIF
            ! * GFL.
            DO JGFL=1,YGFL%NUMFLDS
              IF (YGFLC(JGFL)%LSP) THEN
                DO JLEV=1,NFLEVL
                  PSPGFL(JLEV,IJSE  ,YGFLC(JGFL)%MPSP)=&
                   & ZSPY(JLEV+(INUM_GFL0+YGFLC(JGFL)%MPSP-1)*NFLEVL,JN,1)  
                  PSPGFL(JLEV,IJSE+1,YGFLC(JGFL)%MPSP)=&
                   & ZSPY(JLEV+(INUM_GFL0+YGFLC(JGFL)%MPSP-1)*NFLEVL,JN,2)  
                ENDDO
              ENDIF
            ENDDO
          ENDDO

          DO JN=IM,NSMAX
            IJSE=NASM0(IM)+2*(JN-IM)
            PSPSP(IJSE  )=ZSPY(ILL,JN,1)
            PSPSP(IJSE+1)=ZSPY(ILL,JN,2)
          ENDDO

        ENDDO

        IF ((LSLHD_W.OR.LSLHD_SVD).AND.(.NOT.LSLHD_STATIC)) THEN

          ! * Additional diffusion done in the direct integration only.
          !   The order in ZSPX_HDS, ZSPY_HDS and also in RDHS is assumed to be
          !   the following one: VOR,DIV,SVD,NHX.

          ! * First compute the number of prognostic variables on which the HDS
          !   diffusion is applied (currently IVTHS=(IL/NFLEVL) is between 0 and 4).
          !   This piece of code must remain consistent with the equivalent one done
          !   in SUHDU and SUALDYNB.
          IVTHS=0
          IF (LSLHD_W) IVTHS=IVTHS+2
          IF (LNHDYN.AND.LSLHD_SVD) IVTHS=IVTHS+1
          IF (LNHX.AND.LSLHD_SVD) IVTHS=IVTHS+1
          IL=IVTHS*NFLEVL

          ! * Allocate ZSPX_HDS,ZSPY_HDS, then fill them with zeros.
          ALLOCATE(ZSPX_HDS(IL,0:NSMAX,2))
          ALLOCATE(ZSPY_HDS(IL,0:NSMAX,2))
          ZSPX_HDS(:,:,:)=0.0_JPRB
          ZSPY_HDS(:,:,:)=0.0_JPRB

          DO JMLOC=1,NUMP

            IM=MYMS(JMLOC)

            DO JN=IM,NSMAX
              IJSE=NASM0(IM)+2*(JN-IM)
              INUM_THE0=0
              ! * Vor,Div.
              IF (LSLHD_W) THEN
                ZLAPIN=RLAPIN(JN)
                DO JLEV=1,NFLEVL
                  ZSPX_HDS(JLEV         ,JN,1)=PSPVOR(JLEV,IJSE  )*ZLAPIN
                  ZSPX_HDS(JLEV         ,JN,2)=PSPVOR(JLEV,IJSE+1)*ZLAPIN
                  ZSPX_HDS(JLEV+  NFLEVL,JN,1)=PSPDIV(JLEV,IJSE  )*ZLAPIN
                  ZSPX_HDS(JLEV+  NFLEVL,JN,2)=PSPDIV(JLEV,IJSE+1)*ZLAPIN
                ENDDO
                INUM_THE0=INUM_THE0+2
              ENDIF
              ! * Vertical divergence.
              IF (LNHDYN.AND.LSLHD_SVD) THEN
                DO JLEV=1,NFLEVL
                  ZSPX_HDS(JLEV+INUM_THE0*NFLEVL,JN,1)=PSPSVD(JLEV,IJSE  )
                  ZSPX_HDS(JLEV+INUM_THE0*NFLEVL,JN,2)=PSPSVD(JLEV,IJSE+1)
                ENDDO
                INUM_THE0=INUM_THE0+1
              ENDIF
              ! * NHX.
              IF (LNHX.AND.LSLHD_SVD) THEN
                DO JLEV=1,NFLEVL
                  ZSPX_HDS(JLEV+INUM_THE0*NFLEVL,JN,1)=PSPSNHX(JLEV,IJSE  )
                  ZSPX_HDS(JLEV+INUM_THE0*NFLEVL,JN,2)=PSPSNHX(JLEV,IJSE+1)
                ENDDO
                INUM_THE0=INUM_THE0+1
              ENDIF
            ENDDO

            ILL=IL
            IS0=NSE0L(JMLOC)
            CALL MXTURHD(NSMAX+1-IM,ILL,ILL,-2,.TRUE.,&
             & RDHS(1,IS0+1,1),RDHS(1,IS0+1,2),&
             & ZSPX_HDS(1,IM,1),ZSPY_HDS(1,IM,1))  
            CALL MXTURHD(NSMAX+1-IM,ILL,ILL,3,.FALSE.,&
             & RDHS(1,IS0+1,1),RDHS(1,IS0+1,3),&
             & ZSPX_HDS(1,IM,1),ZSPY_HDS(1,IM,1))  

            IF (IM > 0) THEN
              CALL MXTURHD(NSMAX+1-IM,ILL,ILL,-2,.TRUE.,&
               & RDHS(1,IS0+1,1),RDHS(1,IS0+1,2),&
               & ZSPX_HDS(1,IM,2),ZSPY_HDS(1,IM,2))  
              CALL MXTURHD(NSMAX+1-IM,ILL,ILL,3,.FALSE.,&
               & RDHS(1,IS0+1,1),RDHS(1,IS0+1,3),&
               & ZSPX_HDS(1,IM,2),ZSPY_HDS(1,IM,2))  
            ENDIF

            DO JN=IM,NSMAX
              IJSE=NASM0(IM)+2*(JN-IM)
              INUM_THE0=0
              ! * Vor,Div.
              IF (LSLHD_W) THEN
                ZLAPDI=RLAPDI(JN)
                DO JLEV=1,NFLEVL
                  PSPVOR(JLEV,IJSE  )=ZSPY_HDS(JLEV       ,JN,1)*ZLAPDI
                  PSPVOR(JLEV,IJSE+1)=ZSPY_HDS(JLEV       ,JN,2)*ZLAPDI
                  PSPDIV(JLEV,IJSE  )=ZSPY_HDS(JLEV+NFLEVL,JN,1)*ZLAPDI
                  PSPDIV(JLEV,IJSE+1)=ZSPY_HDS(JLEV+NFLEVL,JN,2)*ZLAPDI
                ENDDO
                INUM_THE0=INUM_THE0+2
              ENDIF
              ! * Vertical divergence.
              IF (LNHDYN.AND.LSLHD_SVD) THEN
                DO JLEV=1,NFLEVL
                  PSPSVD(JLEV,IJSE  )=ZSPY_HDS(JLEV+INUM_THE0*NFLEVL,JN,1)
                  PSPSVD(JLEV,IJSE+1)=ZSPY_HDS(JLEV+INUM_THE0*NFLEVL,JN,2)
                ENDDO
                INUM_THE0=INUM_THE0+1
              ENDIF
              ! * NHX.
              IF (LNHX.AND.LSLHD_SVD) THEN
                DO JLEV=1,NFLEVL
                  PSPSNHX(JLEV,IJSE  )=ZSPY_HDS(JLEV+INUM_THE0*NFLEVL,JN,1)
                  PSPSNHX(JLEV,IJSE+1)=ZSPY_HDS(JLEV+INUM_THE0*NFLEVL,JN,2)
                ENDDO
                INUM_THE0=INUM_THE0+1
              ENDIF
            ENDDO
            
          ENDDO

          DEALLOCATE(ZSPX_HDS)
          DEALLOCATE(ZSPY_HDS)

        ENDIF

      ELSE

!           2.2  Diffusion when no stretching.

        ZDT=ABS(TDT)
        CALL GSTATS(1037,0)
!$OMP  PARALLEL&
!$OMP& PRIVATE(JLEV,ILEVG,JSP,IN,JGFL)

!$OMP DO SCHEDULE(STATIC)
        DO JSP=KSTA,KEND
          IN=NVALUE(JSP)

          ! * 2.2.1: GMV variables
!OCL NOVREC
          DO JLEV=1,NFLEVL
            PSPVOR(JLEV,JSP)=PSPVOR(JLEV,JSP)/(1.0_JPRB+ZDT*RDIVOR(JLEV,IN))
            PSPDIV(JLEV,JSP)=PSPDIV(JLEV,JSP)/(1.0_JPRB+ZDT*RDIDIV(JLEV,IN))
          ENDDO
          IF (LSLHD_W.AND.(.NOT.LSLHD_STATIC)) THEN
            ! * Additional diffusion 
!OCL NOVREC
            DO JLEV=1,NFLEVL
              PSPVOR(JLEV,JSP)=PSPVOR(JLEV,JSP)/(1.0_JPRB+ZDT*RDSVOR(JLEV,IN))
              PSPDIV(JLEV,JSP)=PSPDIV(JLEV,JSP)/(1.0_JPRB+ZDT*RDSDIV(JLEV,IN))
            ENDDO
          ENDIF
          IF (LSPT) THEN
!OCL NOVREC
            DO JLEV=1,NFLEVL
              ILEVG=ILEV0+JLEV
              PSPT  (JLEV,JSP)=(PSPT  (JLEV,JSP)&
               & +RCORDIT(ILEVG)*PSPSP(JSP)*ZDT*RDITG(ILEVG,IN))&
               & /(1.0_JPRB+ZDT*RDITG(ILEVG,IN))  
            ENDDO
          ENDIF

          IF (LNHDYN) THEN
!OCL NOVREC
            DO JLEV=1,NFLEVL
              PSPSPD(JLEV,JSP)=PSPSPD(JLEV,JSP)/(1.0_JPRB+ZDT*RDIPD(JLEV,IN))
              PSPSVD(JLEV,JSP)=PSPSVD(JLEV,JSP)/(1.0_JPRB+ZDT*RDIVD(JLEV,IN))
            ENDDO
            IF (LNHX) THEN
              DO JLEV=1,NFLEVL
                PSPSNHX(JLEV,JSP)= &
                 & PSPSNHX(JLEV,JSP)/(1.0_JPRB+ZDT*RDIVD(JLEV,IN))
              ENDDO
            ENDIF
            IF (LSLHD_SVD.AND.(.NOT.LSLHD_STATIC)) THEN
              ! * Additional diffusion
!OCL NOVREC
              DO JLEV=1,NFLEVL
                PSPSVD(JLEV,JSP)=PSPSVD(JLEV,JSP)/(1.0_JPRB+ZDT*RDSVD(JLEV,IN))
              ENDDO
              IF (LNHX) THEN
                DO JLEV=1,NFLEVL
                  PSPSNHX(JLEV,JSP)= &
                   & PSPSNHX(JLEV,JSP)/(1.0_JPRB+ZDT*RDSVD(JLEV,IN))
                ENDDO
              ENDIF
            ENDIF
          ENDIF

          ! * 2.2.2: GFL variables
          DO JGFL=1,YGFL%NUMFLDS
            IF(YGFLC(JGFL)%LSP) THEN
!OCL NOVREC
              DO JLEV=1,NFLEVL
                PSPGFL(JLEV,JSP,YGFLC(JGFL)%MPSP) = &
                 & PSPGFL(JLEV,JSP,YGFLC(JGFL)%MPSP)/ &
                 & (1.0_JPRB+ZDT*RDIGFL(JLEV,IN,YGFLC(JGFL)%MPSP))  
              ENDDO
            ENDIF
          ENDDO
        ENDDO
!$OMP END DO

        ! * 2.2.3: GMVS variables
!OCL NOVREC
!$OMP DO SCHEDULE(STATIC)
        DO JSP=KSTA,KEND
          PSPSP(JSP)=PSPSP(JSP)/(1.0_JPRB+ZDT*RDISP(NVALUE(JSP)))
        ENDDO
!$OMP END DO

!$OMP END PARALLEL
        CALL GSTATS(1037,1)

      ENDIF

    ENDIF

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

!*        2.B   UPDATE STOCHASTIC BACKSCATTER VORTICITY INCREMENT
!               -------------------------------------------------

    ! * Update stochastic backscatter vorticity increment every NFSTOPH_SPBS steps

    IF (CDCONF == 'A'.AND.(LSTOPH_SPBS.OR.LSTOPH_CASBS).AND.(MOD(NSTEP,NFRSTOPH_SPBS) == 0)) THEN
      CALL DIR_TRANS(PSPSCALAR=SPSTREAM_FORC,KPROMA=NPROMA,KVSETSC=NBSETLEV,PGP=GPSTREAM)
      ! CALL DIR_TRANS(PSPSCALAR=SPVELPOT_FORC,KPROMA=NPROMA,KVSETSC=NBSETLEV,PGP=GPVELPOT)
      IF (LSTOPH_SPBS_T) CALL DIR_TRANS(PSPSCALAR=SPTEMP_FORC,KPROMA=NPROMA,KVSETSC=NBSETLEV,PGP=GPTEMP)

      IF (LSPBSBAL) THEN
        ZCON1= RA**(-2)
        DO JSP=KSTA,KEND
          IN=NVALUE(JSP)
          DO JLEV=1,NFLEVL
            ZSPVORPERT(JLEV,JSP)   = -SPSTREAM_FORC(JLEV,JSP)*IN*(IN+1)*ZCON1*TDT
            ! ZSPDIVPERT(JLEV,JSP)   = -SPVELPOT_FORC(JLEV,JSP)*IN*(IN+1)*ZCON1*TDT
          ENDDO
        ENDDO
        IF (LJB_NONLINEAR_BALANCE) THEN
          !                 In         In     out
          CALL BALNONLINTL (ZSPVORPERT,PSPVOR,ZZP)
          !            In                  out                  out
          CALL BALVERT(ZZP,LDJBBAL=.FALSE.,PSPDIV=ZSPDIVBALPERT,PSPT=ZSPTPERT, &
          !            out
           & PSPSP=ZSPSPPERT)
        ENDIF
        IF (LJB_OMEGA_BALANCE) THEN
          IF (.NOT.LJB_NONLINEAR_BALANCE) ZSPTPERT(:,:)=0.0_JPRB
          !                In         In       In     In   Out
          CALL BALOMEGATL (ZSPVORPERT,ZSPTPERT,PSPVOR,PSPT,ZSPDIVOMEGAPERT)
        ENDIF

        IF (LJB_NONLINEAR_BALANCE) THEN
          PSPDIV(:,:) = PSPDIV(:,:) + ZSPDIVBALPERT(:,:)
          PSPT(:,:)   = PSPT(:,:)   + ZSPTPERT(:,:)
          PSPSP(:)    = PSPSP(:)    + ZSPSPPERT(:)
        ENDIF
        IF (LJB_OMEGA_BALANCE) THEN
          PSPDIV(:,:) = PSPDIV(:,:) + ZSPDIVOMEGAPERT(:,:)
        ENDIF
      ENDIF
    ENDIF

    ! * Apply spectral stochastic vorticity increment at every step.

    IF (CDCONF == 'A'.AND.(LSTOPH_SPBS.OR.LSTOPH_CASBS)) THEN
      ZCON1= RA**(-2)
      DO JSP=KSTA,KEND
        IN=NVALUE(JSP)
        DO JLEV=1,NFLEVL
          ! convert streamfunction and velocity potential forcing to vorticity and divergence forcing
          IF (LSTOPH_SPBS_VORT) THEN
            ZSPVORPERT(JLEV,JSP)   =  SPSTREAM_FORC(JLEV,JSP)*TDT  ! SPSTREAM holds vorticity forcing
          ELSE
            ZSPVORPERT(JLEV,JSP)   = -SPSTREAM_FORC(JLEV,JSP)*IN*(IN+1)*ZCON1*TDT
          ENDIF
          ! ZSPDIVPERT(JLEV,JSP)   = -SPVELPOT_FORC(JLEV,JSP)*IN*(IN+1)*ZCON1*TDT
        ENDDO
      ENDDO
      IF (LSPBSNORM) THEN
          CALL SPNORMBS(PSPVOR,PSPDIV*0._JPRB,ZSPVORPERT,ZSPVORPERT*0._JPRB,.FALSE.)
      ENDIF

      PSPVOR(:,:) = PSPVOR(:,:) + ZSPVORPERT(:,:)   !  add spectral stochastic vorticity increment
      ! PSPDIV(:,:) = PSPDIV(:,:) + ZSPDIVPERT(:,:)   !  add spectral stochastic divergence increment
!      IF (LSTOPH_SPBS_T) PSPT(:,:) = PSPT(:,:) + SPTEMP_FORC(:,:)*TDT    ! 2nd attempt scheme
   

      IF (LSTOPH_SPBS_T) THEN
        ZCON1= RA**(-1)
        DO JSP=KSTA,KEND
          IN=NVALUE(JSP)
          DO JLEV=1,NFLEVL
            PSPT(JLEV,JSP)=  PSPT(JLEV,JSP) + SPTEMP_FORC(JLEV,JSP)*IN*ZCON1*TDT
          ENDDO
        ENDDO
      ENDIF

    ENDIF

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

!*       3     NUDGING.
!              --------

    IF (CDCONF == 'A'.AND.LNUDG) THEN

      !     3.1 GMV VARIABLES:

      ! * Vorticity:
      IF(LNUDVO)THEN
        IF(XNUDVO <= 0) THEN
          DO JSP=KSTA,KEND
            ZUSNUD2(JSP)=XNUDVO
            ZUSNUD1(JSP)=1.0_JPRB
          ENDDO
        ELSE
          DO JSP=KSTA,KEND
            ZUSNUD2(JSP)=XNUDVO*XWNUDG*&
            &MIN(1.0_JPRB,MAX(0.0_JPRB,1.0_JPRB*(NSPNU2-NVALUE(JSP))/REAL(NSPNU2-NSPNU1)))
            ZUSNUD1(JSP)=1.0_JPRB/(1.0_JPRB+ZUSNUD2(JSP))
          ENDDO
        ENDIF
        DO JLEV=1,NFLEVL
          ILEV=MYLEVS(JLEV)
          IF (ILEV >= NTNUDG) THEN
            ZREF(:)=0.0_JPRB
            DO JSTEP=1,NFNUDG
              DO JSP=KSTA,KEND
                ZREF(JSP)=ZREF(JSP)+TNUDVO(JSP,JLEV,JSTEP)*XPNUDG(JSTEP)
              ENDDO
            ENDDO

            DO JSP=KSTA,KEND
              PSPVOR(JLEV,JSP)=(PSPVOR(JLEV,JSP)+ZUSNUD2(JSP)*ZREF(JSP))*ZUSNUD1(JSP)
            ENDDO
          ENDIF
        ENDDO
      ENDIF

      ! * Divergence:
      IF(LNUDDI)THEN
        IF(XNUDDI <= 0) THEN
          DO JSP=KSTA,KEND
            ZUSNUD2(JSP)=XNUDDI
            ZUSNUD1(JSP)=1.0_JPRB
          ENDDO
        ELSE
          DO JSP=KSTA,KEND
            ZUSNUD2(JSP)=XNUDDI*XWNUDG*&
            &MIN(1.0_JPRB,MAX(0.0_JPRB,1.0_JPRB*(NSPNU2-NVALUE(JSP))/REAL(NSPNU2-NSPNU1)))
            ZUSNUD1(JSP)=1.0_JPRB/(1.0_JPRB+ZUSNUD2(JSP))
          ENDDO
        ENDIF
        DO JLEV=1,NFLEVL
          ILEV=MYLEVS(JLEV)
          IF (ILEV >= NTNUDG) THEN
            ZREF(:)=0.0_JPRB
            DO JSTEP=1,NFNUDG
              DO JSP=KSTA,KEND
                ZREF(JSP)=ZREF(JSP)+TNUDDI(JSP,JLEV,JSTEP)*XPNUDG(JSTEP)
              ENDDO
            ENDDO

            DO JSP=KSTA,KEND
              PSPDIV(JLEV,JSP)=(PSPDIV(JLEV,JSP)+ZUSNUD2(JSP)*ZREF(JSP))*ZUSNUD1(JSP)
            ENDDO
          ENDIF
        ENDDO
      ENDIF

      ! * Temperature:
      IF(LSPT.AND.LNUDTE)THEN
        IF(XNUDTE <= 0) THEN
          DO JSP=KSTA,KEND
            ZUSNUD2(JSP)=XNUDTE
            ZUSNUD1(JSP)=1.0_JPRB
          ENDDO
        ELSE
          DO JSP=KSTA,KEND
            ZUSNUD2(JSP)=XNUDTE*XWNUDG*&
            &MIN(1.0_JPRB,MAX(0.0_JPRB,1.0_JPRB*(NSPNU2-NVALUE(JSP))/REAL(NSPNU2-NSPNU1)))
            ZUSNUD1(JSP)=1.0_JPRB/(1.0_JPRB+ZUSNUD2(JSP))
          ENDDO
        ENDIF
        DO JLEV=1,NFLEVL
          ILEV=MYLEVS(JLEV)
          IF (ILEV >= NTNUDG) THEN
            ZREF(:)=0.0_JPRB
            DO JSTEP=1,NFNUDG
              DO JSP=KSTA,KEND
                ZREF(JSP)=ZREF(JSP)+TNUDTE(JSP,JLEV,JSTEP)*XPNUDG(JSTEP)
              ENDDO
            ENDDO

            DO JSP=KSTA,KEND
              PSPT(JLEV,JSP)=(PSPT(JLEV,JSP)+ZUSNUD2(JSP)*ZREF(JSP))*ZUSNUD1(JSP)
            ENDDO
          ENDIF
        ENDDO
      ENDIF

      ! * Pressure departure variable:
      !   Currently not yet coded, no nudging is done on this variable.

      ! * Vertical divergence variable:
      !   Currently not yet coded, no nudging is done on this variable.


      !     3.2 GFL VARIABLES

      ! * In a final stage, this part of code must be valid for all
      !   GFL variables with a loop on JGFL; for that it needs to
      !   update the setup, i.e. define quantities TNUDGFL, LNUDGFL, XNUDGFL
      !   replacing the current (TNUDSH,TNUDSV), (LNUDSH,LNUDSV),
      !   (XNUDSH,XNUDSV).
      !   The provisional way of updating the code which has been adopted
      !   is to use LNUDSH,XNUDSH for all GFL variables.
      !   Recoding the setup has not yet been done for the moment.

      DO JGFL=1,YGFL%NUMFLDS
        IF (YGFLC(JGFL)%LSP) THEN
          IF(LNUDSH)THEN
            IF(XNUDSH <= 0) THEN
              DO JSP=KSTA,KEND
                ZUSNUD2(JSP)=XNUDSH
                ZUSNUD1(JSP)=1.0_JPRB
              ENDDO
            ELSE
              DO JSP=KSTA,KEND
                ZUSNUD2(JSP)=XNUDSH*XWNUDG*&
                &MIN(1.0_JPRB,MAX(0.0_JPRB,1.0_JPRB*(NSPNU2-NVALUE(JSP))/REAL(NSPNU2-NSPNU1)))
                ZUSNUD1(JSP)=1.0_JPRB/(1.0_JPRB+ZUSNUD2(JSP))
              ENDDO
            ENDIF
            DO JLEV=1,NFLEVL
              ILEV=MYLEVS(JLEV)
              IF (ILEV >= NTNUDG) THEN
                ZREF(:)=0.0_JPRB
                DO JSTEP=1,NFNUDG
                  DO JSP=KSTA,KEND
                    ZREF(JSP)=ZREF(JSP)+TNUDSH(JSP,JLEV,JSTEP)*XPNUDG(JSTEP)
                  ENDDO
                ENDDO
                DO JSP=KSTA,KEND
                  PSPGFL(JLEV,JSP,YQ%MPSP)=(PSPGFL(JLEV,JSP,YQ%MPSP)+&
                   & ZUSNUD2(JSP)*ZREF(JSP))*ZUSNUD1(JSP)
                ENDDO
              ENDIF
            ENDDO
          ENDIF
        ENDIF
      ENDDO


      !     3.3 GMVS VARIABLES

      ! * Logarithm of hydrostatic surface pressure:
      IF(LNUDLP.AND.NPSP == 1)THEN
        IF(XNUDLP <= 0) THEN
          DO JSP=KSTA,KEND
            ZUSNUD2(JSP)=XNUDLP
            ZUSNUD1(JSP)=1.0_JPRB
          ENDDO
        ELSE
          DO JSP=KSTA,KEND
            ZUSNUD2(JSP)=XNUDLP*XWNUDG*&
            &MIN(1.0_JPRB,MAX(0.0_JPRB,1.0_JPRB*(NSPNU2-NVALUE(JSP))/REAL(NSPNU2-NSPNU1)))
            ZUSNUD1(JSP)=1.0_JPRB/(1.0_JPRB+ZUSNUD2(JSP))
          ENDDO
        ENDIF
        ZREF(:)=0.0_JPRB
        DO JSTEP=1,NFNUDG
          DO JSP=KSTA,KEND
            ZREF(JSP)=ZREF(JSP)+TNUDLP(JSP,JSTEP)*XPNUDG(JSTEP)
          ENDDO
        ENDDO
        DO JSP=KSTA,KEND
          PSPSP(JSP)=(PSPSP(JSP)+ZUSNUD2(JSP)*ZREF(JSP))*ZUSNUD1(JSP)
        ENDDO
      ENDIF

    ENDIF

  ENDIF

ENDIF

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

!*        4.    INVERSE SPECTRAL TRANSFORMS REQUIRED FOR STOCHASTIC BACKSCATTER
!               ---------------------------------------------------------------

! k.y.: these inverse spectral transforms should be moved under
!       STEPO -> TRANSINVH -> (new) TRANSINV_STOPH in the future,
!       SPCHOR is not the right place to put spectral transforms!

IF (CDCONF == 'A'.AND.( ((LSTOPH_SPBS.OR.LSTOPH_CASBS).AND.(MOD(NSTEP+2,NFRSTOPH_SPBS) == 0)) &
  & .OR. (LVORTCON .AND. MOD(NSTEP,NFRSTOPH_VC) == 0))) THEN
  ! compute horizontal vorticity gradients for +ve definite numerical diffusion scheme
  CALL INV_TRANS(PSPSCALAR=PSPVOR,KPROMA=NPROMA,LDSCDERS=.TRUE.,&
   &KVSETSC=NBSETLEV,PGP=GPVORTGRAD)
ENDIF

! Transform spectral 'pattern' fields to gridpoint fields
IF (CDCONF == 'A'.AND.LSTOPH_SPBS.AND.(MOD(NSTEP+1,NFRSTOPH_SPBS) == 0)) THEN
  ! WRITE(NULOUT,*) 'spchor: convert psi forcing pattern to gridpoint space  at NSTEP=',NSTEP
  IF (LSTOPH_SPBS_VORT) THEN
  ! make spectral pattern a vorticity field
    ZCON1= RA**(-2)   
    DO JSP=KSTA,KEND
      IN=NVALUE(JSP)
      DO JLEV=1,NFLEVL
        ZSPVORT(JLEV,JSP)   = -SPSTREAM(JLEV,JSP)*IN*(IN+1)*ZCON1
      ENDDO
    ENDDO

    CALL INV_TRANS(PSPSCALAR=ZSPVORT,KPROMA=NPROMA,KVSETSC=NBSETLEV,PGP=GPSTREAM)
  ELSE
    CALL INV_TRANS(PSPSCALAR=SPSTREAM,KPROMA=NPROMA,KVSETSC=NBSETLEV,PGP=GPSTREAM)
  ENDIF
  ! CALL INV_TRANS(PSPSCALAR=SPVELPOT,KPROMA=NPROMA,KVSETSC=NBSETLEV,PGP=GPVELPOT)
  IF (LSTOPH_SPBS_T) CALL INV_TRANS(PSPSCALAR=SPTEMP,KPROMA=NPROMA,KVSETSC=NBSETLEV,PGP=GPTEMP)
ENDIF

IF (CDCONF == 'A'.AND.(LSTOPH_SPBS.OR.LSTOPH_CASBS).AND.(MOD(NSTEP+1,NFRSTOPH_SPBS) == 0)) THEN

  ! convert unsmoothed dissipation rate to spectral space

  CALL DIR_TRANS(PSPSCALAR=ZSPTOTDISS,KPROMA=NPROMA,KVSETSC=NBSETLEV,PGP=GPTOTDISS)

  ! spectral  smoothing of the  total dissipation rate field

  DO JSP=KSTA,KEND
    IN=NVALUE(JSP)
    DO JLEV=1,NFLEVL
      ZSPTOTDISS(JLEV,JSP)= ZSPTOTDISS(JLEV,JSP)*RSMOOTH(IN)
    ENDDO
  ENDDO

  ! transform smoothed total dissipation field back to gridpoint space (for use in callpar.F90)

  CALL INV_TRANS(PSPSCALAR=ZSPTOTDISS,KPROMA=NPROMA,KVSETSC=NBSETLEV,PGP=GPTOTDISS_SMOOTH)
ENDIF

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

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