#ifdef RS6K
@PROCESS NOCHECK
#endif
SUBROUTINE JBVCOR_WAVELETINAD (KSCALE,YD_PCV,PSPA3,PSPA2)

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

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

!        Multiple-resolution grid space computations for wavelet Jb.
!        Adds to PSPA3 and PSPA2 the contribution from scale KSCALE -- ADJOINT.

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

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

!     KSCALE    :  Wavelet scale (or 0 to indicate full model resolution)
!     YD_PCV    :  Control vector
!     PSPA3     :  Contribution from scale KSACALE is added to PSPA3 on return -- ADJOINT
!     PSPA2     :  Contribution from scale KSACALE is added to PSPA2 on return -- ADJOINT


!     METHOD.
!     -------

!     EXTERNALS.
!     ----------
!             *TRANSINV_WAVELETAD* - inverse spherical transform ADJOINT
!             *TRANSDIR_WAVELETAD* - inverse spherical transform ADJOINT
!             *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

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

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

USE YOMCVA   , ONLY : NVA3D    ,NVA2D, YRSCALP
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, J
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

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

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

CALL GSTATS(1442,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(J)
DO J=1,NSPEC2
  ZSPA3(:,J,:)     = PSPA3(:,J,:)
ENDDO
!$OMP END PARALLEL DO
CALL GSTATS(1442,1)
IF (NPSP==1) ZSPA2(:,1:NVA2D) = PSPA2(:,1:NVA2D)

CALL WAVXFORM (KSCALE,ZSPA3,ZSPA2)

CALL GSTATS(1442,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(J)
DO J=1,NFLEVG*NVA3D
  ZGP3(:,J,:)=0.0_JPRB
ENDDO
!$OMP END PARALLEL DO
CALL GSTATS(1442,1)
ZGP2(:,:,:)=0.0_JPRB

CALL TRANSDIR_WAVELETAD (KSCALE, ZSPA3, ZSPA2, ZGP3, ZGP2)

DEALLOCATE (ZSPA3)
DEALLOCATE (ZSPA2)

!    Convert from Euclidean inner product to area-weighted inner product

CALL GSTATS(1442,0)
!$OMP PARALLEL PRIVATE(JKGLO,ICEND,IBL,JFLD,ISTART,IEND,IOFF,ZGT3,ZGT2)
ALLOCATE (ZGT3(NPROMA,NFLEVG*NVA3D))
ALLOCATE (ZGT2(NPROMA,NVA2D))

!$OMP DO SCHEDULE(STATIC)
DO JKGLO=1,IGPTOT,NPROMA
  ICEND=MIN(NPROMA,IGPTOT-JKGLO+1)
  IBL=(JKGLO-1)/NPROMA+1
  DO JFLD=1,NFLEVG*NVA3D
    ISTART = YD_PCV%ibgn_scale(KSCALE) + (JFLD-1)*NPROMA &
            & + (IBL-1)*NPROMA*(NFLEVG*NVA3D+NVA2D)
    IEND  =ISTART-1+ICEND

    ZGP3(1:ICEND,JFLD,IBL) = ZGP3(1:ICEND,JFLD,IBL)*YRSCALP%initcv(ISTART:IEND)
  ENDDO
  DO JFLD=1,NVA2D
    ISTART = YD_PCV%ibgn_scale(KSCALE) + (JFLD-1+NFLEVG*NVA3D)*NPROMA &
            & + (IBL-1)*NPROMA*(NFLEVG*NVA3D+NVA2D)
    IEND  =ISTART-1+ICEND

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

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

  IOFF=JKGLO

  CALL JBVCORG ('Q',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))

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

    YD_PCV%initcv(ISTART:IEND) = YD_PCV%initcv(ISTART:IEND) &
                                & + ZGT3(1:ICEND,JFLD)
  ENDDO
  DO JFLD=1,NVA2D
    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) = YD_PCV%initcv(ISTART:IEND) &
                                & + ZGT2(1:ICEND,JFLD)
  ENDDO

ENDDO
!$OMP END DO

DEALLOCATE (ZGT2)
DEALLOCATE (ZGT3)
!$OMP END PARALLEL
CALL GSTATS(1442,1)


DEALLOCATE (ZGP2)
DEALLOCATE (ZGP3)

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

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