SUBROUTINE JGCOR(LDTOUQ,KSPSTA,KSPEND,YDCV,YDSPEC)

!**** *JGCOR*    - INTERFACE TO MULTIPLICATION/DIVISION
!*                 BY SQRT OF CORRELATION MATRIX

!     PURPOSE.
!     --------

!        MULTIPLICATION/DIVISION OF NORMALISED
!        BACKGROUND ERRORS IN SPECTRAL SPACE BY
!        SQRT OF CORRELATION MATRIX

!**   INTERFACE.
!     ----------

!        *CALL* *JGCOR*

!        INPUT:
!                LDTOUQ : .TRUE. The Q field may be modified
!                         .FALSE. The Q field is not touched
!                KSPSTA : First spectral coefficients handled
!                KSPEND : Last spectral columns handled
!        OUTPUT:
!                PCV

!     METHOD.
!     -------
!        For each spectral coefficient multiply by square root of
!              1) horizontal correlations
!              2) vertical correlations

!     EXTERNALS.
!     ----------
!        JGHCOR, JGVCOR, JGHCOS

!     REFERENCE.
!     ----------

!        ECMWF Research Department documentation of the IFS

!     AUTHOR.
!     -------

!        F. Bouttier   *CNRM/GMAP*

!     MODIFICATIONS.
!     --------------

!        ORIGINAL     94-10-07
!        L. Isaksen   95-06-06  Reordering of spectral arrays
!        Mats Hamrud  95-12-15  Remove NFGM .ne. 1, cleaning
!        L. Isaksen   96-05-05  Adapted for Message Passing
!        F.Bouttier   96-16-12  John Derber's balance option
!        E.Holm       97-08-20  Ozone included
!        S.Issara     97-05-09  3DVAR ALADIN
!        M.Siroka     98-05-04  phasing new Jb + ALADIN
!        Y.Tremolet   02-08-05  Use control_vectors.
!        M.Hamrud     03-08-01  GFL introduction
!        C.Fischer    03-09-30  GFL introduction for Aladin
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Hamrud      10-Jan-2004 CY28R1 Cleaning
!        M.Fisher      17-Mar-2004 Wavelet Jb
!        B.Chapnik    03-Mar-2006 Phase 30R2, Merge ejgvcor(i) jgvcor 
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMDIM   , ONLY : NFLEVL   ,NFLEVG   ,NFLSUR   ,NSMAX    ,&
 & NSPEC2   ,NUMP
USE YOMLAP   , ONLY : NASM0    ,NVALUE   ,MYMS
USE YOMJG    , ONLY : NGEOCOR, SPJB_VARS_INFO
USE YOMCT0   , ONLY : NCONF    ,NPRTRV   ,LELAM
USE YOMMP    , ONLY : NSPEC2V, NPSP
USE YOMCVA   , ONLY : NVA3D, NVA2D
USE YOMWAVELET,ONLY : LJBWAVELET, N_WAVELET_SCALES
USE CONTROL_VECTORS, ONLY : CONTROL_VECTOR
USE YOMGRB   , ONLY : NGRBQ, NGRBO3
USE SPECTRAL_FIELDS_MOD

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

IMPLICIT NONE

LOGICAL           ,INTENT(IN)    :: LDTOUQ 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSPSTA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSPEND 
TYPE(CONTROL_VECTOR), INTENT(INOUT) :: YDCV 
TYPE(SPECTRAL_FIELD), INTENT(INOUT) :: YDSPEC

REAL(KIND=JPRB) :: ZSP3DG(NFLEVG,NSPEC2V,NVA3D)
REAL(KIND=JPRB) :: ZSP2DG(NSPEC2V,NVA2D)
REAL(KIND=JPRB) :: ZSP(NSPEC2,NVA2D)

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

INTEGER(KIND=JPIM) :: JMLOC, IDIM, IM, ISP2END, ISP2STA, ISURDIM, JSCALE
LOGICAL :: LLSELECT3D(NVA3D), LLSELECT2D(NVA2D)
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
#include "ejghcor.intfb.h"
#include "jghcor.intfb.h"
#include "jgvcor.intfb.h"
#include "jbvcor_wavelet.intfb.h"
#include "jghcos.intfb.h"
#include "trmtos.intfb.h"
#include "trstom.intfb.h"

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

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

!*    1.    HOMOGENEOUS ISOTROPIC CORRELATIONS ON WORK SPHERE
!           -------------------------------------------------

IF (LJBWAVELET .AND. NGEOCOR == 1) THEN

!           1.1  Loop over wavelet scales, applying vertical correlation

  DO JSCALE=1,N_WAVELET_SCALES+1
    CALL JBVCOR_WAVELET (JSCALE,YDCV,YDSPEC%SP3D,YDSPEC%SP2D)
  ENDDO

ELSEIF(NGEOCOR == 1)THEN

!           1.1  Multiply by horizontal correlations

  IF (LELAM) THEN
    CALL EJGHCOR(LDTOUQ,YDSPEC%SP3D,YDSPEC%SP2D,KSPSTA,KSPEND,NVALUE)
  ELSE
    CALL JGHCOR(LDTOUQ,YDSPEC%SP3D,YDSPEC%SP2D,KSPSTA,KSPEND,NVALUE)
  ENDIF
  IF (NPRTRV > 1) THEN

!           1.2  Transpose spectral data to vertical columns

    LLSELECT3D(:)=.TRUE.
    LLSELECT2D(:)=.TRUE.
    IF (NPSP==1) ZSP=YDSPEC%SP2D
    CALL TRMTOS (PSPSEL3D=YDSPEC%SP3D,PSPSEL2D=ZSP,  &
               & PSPSEL3DG=ZSP3DG,PSPSEL2DG=ZSP2DG,&
               & LDSELECT3D=LLSELECT3D,LDSELECT2D=LLSELECT2D) 

!           1.3  Multiply by vertical correlations

    CALL JGVCOR(ZSP3DG,ZSP2DG,1,NSPEC2V,.TRUE.)
!           1.4  Transpose spectral data back to level structure

    CALL TRSTOM (PSPSEL3DG=ZSP3DG,PSPSEL2DG=ZSP2DG,&
               & PSPSEL3D=YDSPEC%SP3D,PSPSEL2D=ZSP,  &
               & LDSELECT3D=LLSELECT3D,LDSELECT2D=LLSELECT2D)
    IF (NPSP==1) YDSPEC%SP2D=ZSP

  ELSE
      CALL JGVCOR(YDSPEC%SP3D,YDSPEC%SP2D,KSPSTA,KSPEND,.TRUE.)
  ENDIF

  IF (LELAM .AND. NCONF/100 == 1) YDSPEC%SP1D(:,:) = 0.0_JPRB

  YDCV%initcv=YDSPEC

!*    2.    HOMOGENEOUS ISOTROPIC CORRELS ON DESTRETCHED SPHERE
!           ---------------------------------------------------

ELSEIF(NGEOCOR == 2)THEN

!        2.1 Work array dimensioning and overdimensioning

  IDIM=3*NFLEVL
  IF(LDTOUQ .AND. ANY(SPJB_VARS_INFO%IGRIBCODE==NGRBQ)) IDIM=IDIM+NFLEVL
  IF(ANY(SPJB_VARS_INFO%IGRIBCODE==NGRBO3)) IDIM=IDIM+NFLEVL
  ISURDIM=1-MOD(IDIM,2)
  IDIM=IDIM+ISURDIM

!        2.2  Multitasking loop on M

  DO JMLOC=1,NUMP
    IM=MYMS(JMLOC)
    ISP2STA=NASM0(IM)
    ISP2END=NASM0(IM)+2*(NSMAX+1-IM)-1

!         2.3  Horizontal correls on destretched sphere

    CALL JGHCOS(LDTOUQ,IDIM,IM,ISP2STA,ISP2END,YDSPEC)

!         2.4  Vertical correls on work sphere (not for nonsep case)

    CALL JGVCOR(YDSPEC%SP3D,YDSPEC%SP2D,ISP2STA,ISP2END,.TRUE.)

  ENDDO

  YDCV%initcv=YDSPEC

ELSE
  CALL ABOR1('UNAUTHORIZED NGEOCOR IN JGCOR')
ENDIF

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

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