SUBROUTINE JBVCOR_WAVELET (KSCALE,YD_PCV,PSPA3,PSPA2)

!**** *JBVCOR_WAVELET* - "Wrapper" for wavelet Jb grid space computations

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

!        Multiple-resolution grid space computations for wavelet Jb.
!        Stores in YD_PCV the contribution from scale KSCALE.

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

!        *CALL* *JBVCOR_WAVELET* (KSCALE,YD_PCV,PSPA3,PSPA2)

!     KSCALE    :  Wavelet scale (or 0 to indicate full model resolution)
!     YD_PCV    :  Control vector (output)
!     PSPA3     :  Spectral 3d fields (input)
!     PSPA2     :  Spectral 2d fields (input)


!     METHOD.
!     -------

!     EXTERNALS.
!     ----------
!             *TRANSINV_WAVELET*   - inverse spherical transform
!             *JBVCORG*            - apply sqrt vertical covariance matrices

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

!        ECMWF Research Department documentation of the IFS

!     AUTHOR.
!     -------

!        M. Fisher     *ECMWF*

!     MODIFICATIONS.
!     --------------
!        ORIGINAL 2001-08-23
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Hamrud      10-Jan-2004 CY28R1 Cleaning
!        M.Fisher      17-Mar-2004 Control vector in grid space(s)

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

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMCVA   , ONLY : NVA3D    ,NVA2D
USE YOMDIM   , ONLY : NPROMA, NFLEVG, NFLSUR, NSPEC2
USE YOMGEM   , ONLY : NGPTOT
USE YOMMP    , ONLY : NPSP
USE YOMWAVELET , ONLY : GRID_DEFINITION
USE CONTROL_VECTORS, ONLY : CONTROL_VECTOR

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)       :: KSCALE 
TYPE(CONTROL_VECTOR),INTENT(INOUT)  :: YD_PCV
REAL(KIND=JPRB)   ,INTENT(IN)       :: PSPA3(NFLSUR,NSPEC2,NVA3D)
REAL(KIND=JPRB)   ,INTENT(IN)       :: PSPA2(NSPEC2,NVA2D)

REAL(KIND=JPRB), ALLOCATABLE :: ZGP3(:,:,:), ZGP2(:,:,:), &
                              & ZGT3(:,:), ZGT2(:,:), &
                              & ZSPA3(:,:,:), ZSPA2(:,:)

INTEGER(KIND=JPIM) :: JKGLO, ICEND, IBL, IOFF, &
 & IGPTOT, INGPBLKS, ISTART, JFLD, IEND
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "jbvcorg.intfb.h"
#include "transinv_wavelet.intfb.h"
#include "wavxform.intfb.h"

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

IF (LHOOK) CALL DR_HOOK('JBVCOR_WAVELET',0,ZHOOK_HANDLE)
IGPTOT = GRID_DEFINITION(KSCALE)%NGPTOT

INGPBLKS = (IGPTOT+NPROMA-1)/NPROMA

ALLOCATE (ZGP3(NPROMA,NFLEVG*NVA3D,INGPBLKS))
ALLOCATE (ZGP2(NPROMA,NVA2D,INGPBLKS))

ALLOCATE (ZSPA3(NFLSUR,NSPEC2,NVA3D))
ALLOCATE (ZSPA2(NSPEC2,NVA2D))

ZSPA3(:,:,:)     = PSPA3(:,:,:)
IF (NPSP==1) ZSPA2(:,1:NVA2D) = PSPA2(:,1:NVA2D)

CALL WAVXFORM (KSCALE,ZSPA3,ZSPA2)
CALL TRANSINV_WAVELET (KSCALE, ZSPA3, ZSPA2, ZGP3, ZGP2)

DEALLOCATE (ZSPA3)
DEALLOCATE (ZSPA2)


!    Apply square-roots ,or inverse square-roots, of vertical covariance
!    matrices in scale-dependent grid space for wavelet Jb.

!$OMP PARALLEL PRIVATE(JKGLO,ICEND,IBL,IOFF,ZGT3,ZGT2)
ALLOCATE (ZGT3(NPROMA,NFLEVG*NVA3D))
ALLOCATE (ZGT2(NPROMA,NVA2D))

!$OMP DO SCHEDULE(DYNAMIC,1)
DO JKGLO=1,IGPTOT,NPROMA
  ICEND=MIN(NPROMA,IGPTOT-JKGLO+1)
  IBL=(JKGLO-1)/NPROMA+1
  IOFF=JKGLO

  CALL JBVCORG ('P',KSCALE,ICEND,&
   & GRID_DEFINITION(KSCALE)%GELAM(IOFF:),&
   & GRID_DEFINITION(KSCALE)%GELAT(IOFF:),&
   & ZGP3(1,1,IBL) ,ZGP2(1,1,IBL),&
   & ZGT3(1,1)     ,ZGT2(1,1))

  ZGP3(1:ICEND,:,IBL) = ZGT3(1:ICEND,:)
  ZGP2(1:ICEND,:,IBL) = ZGT2(1:ICEND,:)
ENDDO
!$OMP END DO

DEALLOCATE (ZGT2)
DEALLOCATE (ZGT3)
!$OMP END PARALLEL

DO JFLD=1,NFLEVG*NVA3D
  DO JKGLO=1,IGPTOT,NPROMA
    ICEND=MIN(NPROMA,IGPTOT-JKGLO+1)
    IBL=(JKGLO-1)/NPROMA+1

    ISTART = YD_PCV%ibgn_scale(KSCALE) + (JFLD-1)*NPROMA &
            & + (IBL-1)*NPROMA*(NFLEVG*NVA3D+NVA2D)
    IEND  =ISTART-1+ICEND

    YD_PCV%initcv(ISTART:IEND) = ZGP3(1:ICEND,JFLD,IBL)
  ENDDO
ENDDO

DO JFLD=1,NVA2D
  DO JKGLO=1,IGPTOT,NPROMA
    ICEND=MIN(NPROMA,IGPTOT-JKGLO+1)
    IBL=(JKGLO-1)/NPROMA+1

    ISTART = YD_PCV%ibgn_scale(KSCALE) + (JFLD-1+NFLEVG*NVA3D)*NPROMA &
            & + (IBL-1)*NPROMA*(NFLEVG*NVA3D+NVA2D)
    IEND  =ISTART-1+ICEND

    YD_PCV%initcv(ISTART:IEND) = ZGP2(1:ICEND,JFLD,IBL)
  ENDDO
ENDDO

DEALLOCATE (ZGP2)
DEALLOCATE (ZGP3)

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

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