SUBROUTINE WAVXFORM (KSCALE,PSPA3,PSPA2)

!     *WAVXFORM*      - Multiscale ("wavelet") decomposition

!     Purpose.
!     --------
!           Perform the spectral-space part of the wavelet transform

!**   Interface.
!     ----------
!        *CALL* *WAVXFORM (KSCALE,PSPA3,PSPA2)

!        Explicit arguments :
!        --------------------
!               KSCALE : "scale" index
!               PSPA3  : input and output - organized like SPA3
!               PSPA2  : input and output - organized like SPA2

!           For KSCALE.LE.N_WAVELET_SCALES, PSPA3 and PSPA2 are
!           converted to spectral-space detail coefficients.

!           For KSCALE.GT.N_WAVELET_SCALES, PSPA3 and PSPA2 are
!           converted to spectral-space structure coefficients for the
!           coarsest scale.

!        Implicit arguments :
!        --------------------

!     Method.
!     -------

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

!     Reference.
!     ----------

!     Author.
!     -------
!        Mike Fisher *ECMWF*

!     Modifications.
!     --------------
!        Original : 1998/05/12
!        Modified : 
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!     ------------------------------------------------------------------

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

USE YOMDIM   , ONLY : NFLEVL   ,NSMAX    ,NSPEC2   ,NUMP     ,&
 & NFLSUR
USE YOMCVA   , ONLY :    NVA3D, NVA2D
USE YOMMP    , ONLY :    NPSP
USE YOMLAP   , ONLY : NASM0    ,MYMS
USE YOMWAVELET,ONLY : N_WAVELET_SCALES,   WAVELET_FILTERS
USE YOMPLDSW , ONLY : LOPT_SCALAR

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KSCALE 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPA3(NFLSUR,NSPEC2,NVA3D) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPA2(NSPEC2,NVA2D) 
INTEGER(KIND=JPIM) :: JN,JFIE,JLEV,JMLOC,JIR,IM,ISP
REAL(KIND=JPRB) :: ZFILT(0:NSMAX)
REAL(KIND=JPRB) :: ZHOOK_HANDLE

!     1.    Calculate the filter coefficients
!           ---------------------------------

IF (LHOOK) CALL DR_HOOK('WAVXFORM',0,ZHOOK_HANDLE)
CALL GSTATS(2000,0)
IF (KSCALE > N_WAVELET_SCALES) THEN
  DO JN=0,NSMAX
    ZFILT(JN) = SQRT(WAVELET_FILTERS(JN,N_WAVELET_SCALES)) ! s_L
  ENDDO
ELSEIF (KSCALE == 1) THEN
  DO JN=0,NSMAX
    ZFILT(JN) = SQRT( (1.0_JPRB-WAVELET_FILTERS(JN,KSCALE)) )   ! d_1
  ENDDO
ELSE
  DO JN=0,NSMAX
    ZFILT(JN) = SQRT( (1.0_JPRB-WAVELET_FILTERS(JN,KSCALE))&
     & *WAVELET_FILTERS(JN,KSCALE-1))        ! d_p  
  ENDDO
ENDIF
CALL GSTATS(2000,1)

!     2.    Apply the Filter
!           ----------------

IF( LOPT_SCALAR )THEN
  CALL GSTATS(1443,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JFIE,JMLOC,IM,JIR,JN,ISP,JLEV)
  DO JFIE=1,NVA3D
    DO JMLOC=1,NUMP
      IM=MYMS(JMLOC)
      DO JIR=0,1
        DO JN=IM,NSMAX
          ISP =NASM0 (IM)+(JN-IM)*2+JIR
          DO JLEV=1,NFLEVL
            PSPA3(JLEV,ISP,JFIE) = PSPA3(JLEV,ISP,JFIE)*ZFILT(JN)
          ENDDO
        ENDDO
      ENDDO
    ENDDO
  ENDDO
!$OMP END PARALLEL DO
  IF (NPSP == 1) THEN
!$OMP PARALLEL DO SCHEDULE(DYNAMIC,1) PRIVATE(JMLOC,JFIE,IM,JIR,JN,ISP)
    DO JMLOC=1,NUMP
      DO JFIE=1,NVA2D
        IM=MYMS(JMLOC)
        DO JIR=0,1
          DO JN=IM,NSMAX
            ISP =NASM0 (IM)+(JN-IM)*2+JIR
            PSPA2(ISP,JFIE) = PSPA2(ISP,JFIE)*ZFILT(JN)
          ENDDO
        ENDDO
      ENDDO
    ENDDO
!$OMP END PARALLEL DO
  ENDIF
  CALL GSTATS(1443,1)
ELSE
  CALL GSTATS(2006,0)
  DO JFIE=1,NVA3D
    DO JLEV=1,NFLEVL
      DO JMLOC=1,NUMP
        IM=MYMS(JMLOC)
        DO JIR=0,1
          DO JN=IM,NSMAX
            ISP =NASM0 (IM)+(JN-IM)*2+JIR
            PSPA3(JLEV,ISP,JFIE) = PSPA3(JLEV,ISP,JFIE)*ZFILT(JN)
          ENDDO
        ENDDO
      ENDDO
    ENDDO
  ENDDO
  IF (NPSP == 1) THEN
    DO JFIE=1,NVA2D
      DO JMLOC=1,NUMP
        IM=MYMS(JMLOC)
        DO JIR=0,1
          DO JN=IM,NSMAX
            ISP =NASM0 (IM)+(JN-IM)*2+JIR
            PSPA2(ISP,JFIE) = PSPA2(ISP,JFIE)*ZFILT(JN)
          ENDDO
        ENDDO
      ENDDO
    ENDDO
  ENDIF
  CALL GSTATS(2006,1)
ENDIF

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