SUBROUTINE TRANSINV_WAVELET (KSCALE, PSPA3JB, PSPA2JB, PGP3, PGP2)

!**** *TRANSINV_MDL * - Inverse transforms for wavelet Jb

!     Purpose.  Perform inverse transforms for wavelet Jb
!     --------

!**   Interface.  CALL TRANSINV_WAVELET
!     ---------- 

!     Explicit arguments : 
!     --------------------

!        KSCALE   (input)    - Wavelet scale. (Note: if KSCALE==0 or
!                              LJBWAVELET==.false. then the standard model
!                              grid resolution is used. Otherwise, the
!                              grid defined by GRID_DEFINITION(KSCALE) is
!                              used.)
!        PSPA3JB    (input)   - Spectral fields (arranged similar to SPA3JB)
!        PSPA2JB    (input)   - Spectral fields (arranged similar to SPA2JB)
!        PGP3       (output)  - Gridpoint fields corresponding to PSPA3JB
!        PGP2       (output)  - Gridpoint fields corresponding to PSPA2JB

!     Externals.
!     ----------
!     INV_TRANS - inverse transform (TRANS library)

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

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

!     Modifications.
!     --------------
!        Original : 2001-08-16
!        M.Hamrud      01-Oct-2003 CY28 Cleaning

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

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

USE YOMLUN     , ONLY : NULOUT
USE YOMGEM     , ONLY : NGPTOT
USE YOMDIM     , ONLY : NPROMA, NSPEC2, NFLEVL, NFLEVG, NFLSUR, &
 & NUMP, NSMAX  
USE YOMLAP     , ONLY : NASM0, MYMS
USE YOMCVA     , ONLY : NVA3D, NVA2D
USE YOMMP      , ONLY : NBSETLEV, NBSETSP, MYSETV, NPSP
USE YOMWAVELET , ONLY : LJBWAVELET, GRID_DEFINITION

IMPLICIT NONE

!     Arguments

INTEGER(KIND=JPIM),INTENT(IN)    :: KSCALE 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PGP3(:,:,:), PGP2(:,:,:)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSPA3JB(NFLSUR,NSPEC2,NVA3D) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSPA2JB(NSPEC2,NVA2D) 
! === END OF INTERFACE BLOCK ===


REAL(KIND=JPRB), ALLOCATABLE :: ZSP(:,:), ZGP(:,:,:)
INTEGER(KIND=JPIM), ALLOCATABLE :: IVSETSC(:)
INTEGER(KIND=JPIM), POINTER     :: IMYMS(:), INASM0(:)


INTEGER(KIND=JPIM) :: IGPTOT, IRESOL, IG, JFIE, ISPEC2, JF, IL, IOFF, IOFF_SCALE, &
 & ILEN_SCALE, JMLOC, IM, INUMP, INSMAX, IBLOCKSL, J
REAL(KIND=JPRB) :: ZHOOK_HANDLE

INTERFACE
#include "inv_trans.h"
END INTERFACE

#include "abor1.intfb.h"

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

!     Get the grid definition

IF (LHOOK) CALL DR_HOOK('TRANSINV_WAVELET',0,ZHOOK_HANDLE)
IF (KSCALE==0 .OR. .NOT.LJBWAVELET) THEN
  IGPTOT = NGPTOT 
  IRESOL = 1
  ISPEC2 = NSPEC2
  INSMAX = NSMAX
  INUMP  = NUMP
  IBLOCKSL = (NGPTOT+NPROMA-1)/NPROMA
  IMYMS  => MYMS
  INASM0 => NASM0
ELSE
  IGPTOT = GRID_DEFINITION(KSCALE)%NGPTOT
  IRESOL = GRID_DEFINITION(KSCALE)%NRESOL_ID
  ISPEC2 = GRID_DEFINITION(KSCALE)%NSPEC2
  INSMAX = GRID_DEFINITION(KSCALE)%NSMAX
  INUMP  = GRID_DEFINITION(KSCALE)%NUMP
  IBLOCKSL = GRID_DEFINITION(KSCALE)%NBLOCKSL
  IMYMS  => GRID_DEFINITION(KSCALE)%MYMS
  INASM0 => GRID_DEFINITION(KSCALE)%NASM0
ENDIF

!     Check the dimensions of PGP3 and PGP2

IF (  SIZE(PGP3,1) /= NPROMA .OR. &
   & SIZE(PGP3,2) /= NFLEVG*NVA3D .OR. &
   & SIZE(PGP3,3) /= IBLOCKSL) THEN  
  WRITE (NULOUT,*) 'TRANSINV_WAVELET: BAD DIMENSIONS FOR PGP3: ',SHAPE(PGP3)
  WRITE (NULOUT,*) '  EXPECTED: ',NPROMA, NFLEVG*NVA3D, &
   & GRID_DEFINITION(KSCALE)%NBLOCKSL, ' FOR SCALE ',KSCALE  
  CALL ABOR1 ('TRANSINV_WAVELET: BAD DIMENSIONS FOR PGP3')
ENDIF

IF (  SIZE(PGP2,1) /= NPROMA .OR. &
   & SIZE(PGP2,2) /= NVA2D .OR. &
   & SIZE(PGP2,3) /= IBLOCKSL) THEN  
  WRITE (NULOUT,*) 'TRANSINV_WAVELET: BAD DIMENSIONS FOR PGP2: ',SHAPE(PGP2)
  WRITE (NULOUT,*) '  EXPECTED: ',NPROMA, NVA2D, &
   & GRID_DEFINITION(KSCALE)%NBLOCKSL, ' FOR SCALE ',KSCALE  
  CALL ABOR1 ('TRANSINV_WAVELET: BAD DIMENSIONS FOR PGP2')
ENDIF

ALLOCATE (IVSETSC(NFLEVG*NVA3D+NVA2D))
ALLOCATE (ZSP(NFLEVL*NVA3D + NPSP*NVA2D,ISPEC2))
ALLOCATE (ZGP(NPROMA,NFLEVG*NVA3D+NVA2D,IBLOCKSL))

!     Calculate IVSETSC (The distribution over B-sets)

IG=0
DO JFIE=1,NVA3D
  IVSETSC(IG+1:IG+NFLEVG) = NBSETLEV(1:NFLEVG)
  IG=IG+NFLEVG
ENDDO

DO JFIE=1,NVA2D
  IVSETSC(IG+1) = NBSETSP
  IG=IG+1
ENDDO

!     Extract spectral components from PSPA3JB and PSPA2JB into ZSP
!     NB: This assumes that the wavenumbers are distributed in the
!     same way for all scales!

IF (INUMP > NUMP) THEN
  WRITE (NULOUT,*) 'transinv_wavelet: wavenumber distribution problem '
  WRITE (NULOUT,*) 'scale=',KSCALE,' INUMP=',INUMP,' model NUMP=',NUMP
  CALL ABOR1 ('transinv_wavelet: wavenumber distribution problem: NUMP')
ENDIF

CALL GSTATS(1452,0)
!$OMP PARALLEL DO SCHEDULE(DYNAMIC,1) PRIVATE(JMLOC,IL,JF,IM,IOFF_SCALE,ILEN_SCALE,IOFF)
DO JMLOC=1,INUMP
  IF (IMYMS(JMLOC) /= MYMS(JMLOC)) THEN
    WRITE (NULOUT,*) 'transinv_wavelet: wavenumber distribution problem '
    WRITE (NULOUT,*) 'scale=',KSCALE,' JMLOC=',JMLOC,' IMYMS=',IMYMS(:)
    WRITE (NULOUT,*) 'model MYMS array=',MYMS(:)
    CALL ABOR1 ('transinv_wavelet: wavenumber distribution problem: MYMS')
  ENDIF

  IL=0
  DO JF=1,NVA3D
    IM         = IMYMS(JMLOC)
    IOFF_SCALE = INASM0(IM)-1
    ILEN_SCALE = (INSMAX-IM)*2 + 2
    IOFF       = NASM0(IM)-1

    ZSP(IL+1:IL+NFLEVL,IOFF_SCALE+1:IOFF_SCALE+ILEN_SCALE) = &
     & PSPA3JB(:,IOFF+1:IOFF+ILEN_SCALE,JF)  
    IL=IL+NFLEVL
  ENDDO
  IF (NBSETSP == MYSETV) THEN
    DO JF=1,NVA2D
      IM         = IMYMS(JMLOC)
      IOFF_SCALE = INASM0(IM)-1
      ILEN_SCALE = (INSMAX-IM)*2 + 2
      IOFF       = NASM0(IM)-1

      ZSP(IL+1,IOFF_SCALE+1:IOFF_SCALE+ILEN_SCALE) = &
       & PSPA2JB(IOFF+1:IOFF+ILEN_SCALE,JF)  
      IL=IL+1
    ENDDO
  ENDIF
ENDDO
!$OMP END PARALLEL DO
CALL GSTATS(1452,1)

!     Transform to grid space

CALL INV_TRANS (PSPSCALAR=ZSP(:,:), PGP=ZGP(:,:,:), KRESOL=IRESOL, &
 & KPROMA=NPROMA, KVSETSC=IVSETSC(:))  

!     Copy from ZGP into output arrays

CALL GSTATS(1452,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(J)
DO J=1,NFLEVG*NVA3D
  PGP3(:,J,:) = ZGP(:,J,:)
ENDDO
!$OMP END PARALLEL DO
CALL GSTATS(1452,1)
PGP2(:,1:NVA2D,:) = ZGP(:,NFLEVG*NVA3D+1:NFLEVG*NVA3D+NVA2D,:)

DEALLOCATE (ZGP)
DEALLOCATE (ZSP)
DEALLOCATE (IVSETSC)

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

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