MODULE WAV_LIFTING_MOD
!     Purpose.
!     --------
!     A module implementing Dual Tree Complex Wavelet Transforms for Aladin

!     Method :
!     --------
!     The routines in the various submodules use the LIFTING technique

!     Reference :
!     -----------
! 1.   I. Daubechies & W. Sweldens: 
!      "Factoring wavelet transforms into lifting steps"
!         J. Fourier Anal. Appl., 4(3):245--267, 1998.
!         available from http://cm.bell-labs.com/who/wim/papers/factor

! 2.   I. W. Selesnick, R. G. Baraniuk and N. G. Kingsbury :
!      "The Dual-Tree Complex Wavelet Transform"
!         IEEE Signal Processing Magazine vol 22 no 6 (2005) pp 123-151.
!         available from http://www-sigproc.eng.cam.ac.uk/%7Engk/publications/ngk_SPmag_nov05.pdf

! 1. one-step forward 2D-transforms
! ---------------------------------

! ---------------------------------
! Top level routines (2D dual tree)
! ---------------------------------
! EJBWAV_DIRTRANS : direct transform Grid point -> wavelet space
! EJBWAV_INVTRANS : inverse transform (currently ==adjoint)
!-------------------------
! Single step 2D routines:
!-------------------------

! WAVSTEP_FARAS      : the "faras" wavelet used in the first step
! WAVSTEP_FARAS_INV 

! WAVSTEP_Q6         : Kingsbury's Q6 wavelet used in all later steps 
! WAVSTEP_Q6_INV

! -----------------------------------------
! 1D wavelet transforms (lifting algorithm)
! -----------------------------------------

! EJBWAV_TRANS_FARAS       : lifting code for FARAS almost-symmetric wavelet.
! EJBWAV_TRANS_FARAS_INV
! EJBWAV_TRANS_FARASAD    : adjoint transform. Equal to inverse when
!       the transform is orthogonal (periodic boundaries)
! EJBWAV_TRANS_FARASAD_INV : inverse of adjoint. =1 for orthogonal case.

! EJBWAV_TRANS_SHIFTFARAS  : lifting code for the shifted FARAS wavelet
! EJBWAV_TRANS_SHIFTFARAS_INV
! EJBWAV_TRANS_SHIFTFARASAD
! EJBWAV_TRANS_SHIFTFARASAD_INV 

! EJBWAV_TRANS_Q6          : Kingsbury's Q6 wavelet
! EJBWAV_TRANS_Q6_INV
! EJBWAV_TRANS_Q6AD
! EJBWAV_TRANS_Q6AD_INV

! EJBWAV_TRANS_REVQ6          : Kingsbury's Q6 wavelet, reversed filter
! EJBWAV_TRANS_REVQ6_INV
! EJBWAV_TRANS_REVQ6AD
! EJBWAV_TRANS_REVQ6AD_INV

!     Author :
!     --------
!     Alex Deckmyn 

!     Modifications.
!     --------------
!      29-Sep-2008     Original
!     ------------------------------------------------------------------

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

IMPLICIT NONE

SAVE
INTEGER(KIND=JPIM) :: NPERIODIC

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

CONTAINS

! The actual 2D dual-tree complex wavelet transform
! -------------------------------------------------
SUBROUTINE EJBWAV_DIRTRANS(PGP,PWAV,KGPX,KGPY,KWAVDIMX,KWAVDIMY,KWAVITER)
IMPLICIT NONE
! input:
! PGP : a grid point field (real valued)
! KGPX,KGPY : dimension of the GP fields with additional padding
!             (so should be >= SIZE(PGP) )
! KWAVDIMX,KWAVDIMY : size of the wavelet transform
!             if the smallest scale is ignored, KWAVDIMX=KGPX/2
! KWAVITER : number of wavelet transform iterations

! output:
! PWAV (output) : the dual tree wavelet transformed data
!      it is a 3D array. The 3rd dimension holds 2 complex values, so it 
!      has 4 real elements.
!      Dimensions should be (NGPX/2^n,NGPY/2^n,4) where n is the number
!      of wavelet scales that are ignored (n<KWAVITER)

REAL(KIND=JPRB), INTENT(IN)    :: PGP(:,:)
INTEGER(KIND=JPIM), INTENT(IN) :: KGPX,KGPY,KWAVDIMX,KWAVDIMY,KWAVITER
REAL(KIND=JPRB), INTENT(OUT)   :: PWAV(KWAVDIMX,KWAVDIMY,4)

REAL (KIND=JPRB)    :: ZX(KGPX,KGPY,4)
INTEGER(KIND=JPIM) :: IX,IY,JJ,IDIMX,IDIMY
REAL(KIND=JPRB) :: ZHOOK_HANDLE
! -----------------------------------------
IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:EJBWAV_DIRTRANS',0,ZHOOK_HANDLE)

IDIMX=SIZE(PGP,1)
IDIMY=SIZE(PGP,2)

! ZX contains the GP date with additional 0 padding
ZX(:,:,:)=0.0_JPRB
ZX(1:IDIMX,1:IDIMY,1) = PGP(:,:)
ZX(1:IDIMX,1:IDIMY,2) = PGP(:,:)
ZX(1:IDIMX,1:IDIMY,3) = PGP(:,:)
ZX(1:IDIMX,1:IDIMY,4) = PGP(:,:)

CALL WAVSTEP_FARAS(ZX(:,:,1),0,0)
CALL WAVSTEP_FARAS(ZX(:,:,2),0,1)
CALL WAVSTEP_FARAS(ZX(:,:,3),1,0)
CALL WAVSTEP_FARAS(ZX(:,:,4),1,1)

IF (KWAVITER>1) THEN
  IX=KGPX/2
  IY=KGPY/2

  DO JJ=1,KWAVITER-1
    CALL WAVSTEP_Q6(ZX(1:IX,1:IY,1),0,0)
    CALL WAVSTEP_Q6(ZX(1:IX,1:IY,2),0,1)
    CALL WAVSTEP_Q6(ZX(1:IX,1:IY,3),1,0)
    CALL WAVSTEP_Q6(ZX(1:IX,1:IY,4),1,1)
    IX=IX/2
    IY=IY/2
  ENDDO
ENDIF

! 1st component, real part
PWAV(:,:,1) = ( ZX(1:KWAVDIMX,1:KWAVDIMY,1) + &
                 & ZX(1:KWAVDIMX,1:KWAVDIMY,4) )/2.
! 1st component, imaginary part
PWAV(:,:,2) = ( ZX(1:KWAVDIMX,1:KWAVDIMY,2) - &
                 & ZX(1:KWAVDIMX,1:KWAVDIMY,3) )/2.
! 2nd component, real part
PWAV(:,:,3) = ( ZX(1:KWAVDIMX,1:KWAVDIMY,2) + &
                 & ZX(1:KWAVDIMX,1:KWAVDIMY,3) )/2.
! 2nd component, imaginary part
PWAV(:,:,4) = ( ZX(1:KWAVDIMX,1:KWAVDIMY,1) - &
                 & ZX(1:KWAVDIMX,1:KWAVDIMY,4) )/2.

IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:EJBWAV_DIRTRANS',1,ZHOOK_HANDLE)
END SUBROUTINE EJBWAV_DIRTRANS

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

SUBROUTINE EJBWAV_INVTRANS(PGP,PWAV,KGPX,KGPY,KWAVDIMX,KWAVDIMY,KWAVITER)
IMPLICIT NONE

REAL(KIND=JPRB), INTENT(OUT)    :: PGP(:,:)
REAL(KIND=JPRB), INTENT(IN)   :: PWAV(:,:,:)
INTEGER(KIND=JPIM), INTENT(IN) :: KGPX,KGPY,KWAVDIMX,KWAVDIMY,KWAVITER

REAL (KIND=JPRB)    :: ZX(KGPX,KGPY,4)
INTEGER(KIND=JPIM) :: IX,IY,JJ,IDIMX,IDIMY
REAL(KIND=JPRB) :: ZHOOK_HANDLE
! -----------------------------------------
IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:EJBWAV_INVTRANS',0,ZHOOK_HANDLE)

IDIMX=SIZE(PGP,1)
IDIMY=SIZE(PGP,2)

ZX(:,:,:) = 0.0_JPRB
ZX(1:KWAVDIMX,1:KWAVDIMY,1) = PWAV(:,:,1) + PWAV(:,:,4)
ZX(1:KWAVDIMX,1:KWAVDIMY,2) = PWAV(:,:,2) + PWAV(:,:,3) 
ZX(1:KWAVDIMX,1:KWAVDIMY,3) = - PWAV(:,:,2) + PWAV(:,:,3)
ZX(1:KWAVDIMX,1:KWAVDIMY,4) = PWAV(:,:,1) - PWAV(:,:,4)

IF (KWAVITER>1) THEN
  IX=KGPX/2**(KWAVITER-1)
  IY=KGPY/2**(KWAVITER-1)

  DO JJ=1,KWAVITER-1
    CALL WAVSTEP_Q6_INV(ZX(1:IX,1:IY,1),0,0)
    CALL WAVSTEP_Q6_INV(ZX(1:IX,1:IY,2),0,1)
    CALL WAVSTEP_Q6_INV(ZX(1:IX,1:IY,3),1,0)
    CALL WAVSTEP_Q6_INV(ZX(1:IX,1:IY,4),1,1)
    IX=IX*2
    IY=IY*2
  ENDDO
ENDIF

CALL WAVSTEP_FARAS_INV(ZX(:,:,1),0,0)
CALL WAVSTEP_FARAS_INV(ZX(:,:,2),0,1)
CALL WAVSTEP_FARAS_INV(ZX(:,:,3),1,0)
CALL WAVSTEP_FARAS_INV(ZX(:,:,4),1,1)


PGP(:,:) = ( ZX(1:IDIMX,1:IDIMY,1) +  ZX(1:IDIMX,1:IDIMY,2) + &
          &  ZX(1:IDIMX,1:IDIMY,3) +  ZX(1:IDIMX,1:IDIMY,4) )*.25_JPRB

IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:EJBWAV_INVTRANS',1,ZHOOK_HANDLE)
END SUBROUTINE EJBWAV_INVTRANS

! ===============================================================
! ===============================================================
! 1. one-step forward 2D-transforms
! ---------------------------------

SUBROUTINE WAVSTEP_FARAS(PX,KX,KY)
IMPLICIT NONE

REAL(KIND=JPRB), INTENT(INOUT) :: PX(:,:)
INTEGER(KIND=JPIM), INTENT(IN) :: KX,KY

INTEGER(KIND=JPIM) :: JJ,JX,JY
REAL(KIND=JPRB) :: ZHOOK_HANDLE
! -----------------------------------------
IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:WAVSTEP_FARAS',0,ZHOOK_HANDLE)

JX=SIZE(PX,1)
JY=SIZE(PX,2)

IF (KX==0) THEN
  DO JJ=1,JY
    CALL EJBWAV_TRANS_FARAS(PX(:,JJ),JX,NPERIODIC)
  ENDDO
ELSE
  DO JJ=1,JY
    CALL EJBWAV_TRANS_SHIFTFARAS(PX(:,JJ),JX,NPERIODIC)
  ENDDO
ENDIF

IF (KY==0) THEN
  DO JJ=1,JX
    CALL EJBWAV_TRANS_FARAS(PX(JJ,:),JY,NPERIODIC)
  ENDDO
ELSE
  DO JJ=1,JX
    CALL EJBWAV_TRANS_SHIFTFARAS(PX(JJ,:),JY,NPERIODIC)
  ENDDO
ENDIF
IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:WAVSTEP_FARAS',1,ZHOOK_HANDLE)

END SUBROUTINE WAVSTEP_FARAS

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

SUBROUTINE WAVSTEP_FARAS_INV(PX,KX,KY)
IMPLICIT NONE

REAL(KIND=JPRB), INTENT(INOUT) :: PX(:,:)
INTEGER(KIND=JPIM), INTENT(IN) :: KX,KY

INTEGER(KIND=JPIM) :: JJ,JX,JY
REAL(KIND=JPRB) :: ZHOOK_HANDLE
! -----------------------------------------
IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:WAVSTEP_FARAS_INV',0,ZHOOK_HANDLE)

JX=SIZE(PX,1)
JY=SIZE(PX,2)

IF (KY==0) THEN
  DO JJ=1,JX
    CALL EJBWAV_TRANS_FARAS_INV(PX(JJ,:),JY,NPERIODIC)
  ENDDO
ELSE
  DO JJ=1,JX
    CALL EJBWAV_TRANS_SHIFTFARAS_INV(PX(JJ,:),JY,NPERIODIC)
  ENDDO
ENDIF

IF (KX==0) THEN
  DO JJ=1,JY
    CALL EJBWAV_TRANS_FARAS_INV(PX(:,JJ),JX,NPERIODIC)
  ENDDO
ELSE
  DO JJ=1,JY
    CALL EJBWAV_TRANS_SHIFTFARAS_INV(PX(:,JJ),JX,NPERIODIC)
  ENDDO
ENDIF

IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:WAVSTEP_FARAS_INV',1,ZHOOK_HANDLE)
END SUBROUTINE WAVSTEP_FARAS_INV

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

SUBROUTINE WAVSTEP_Q6(PX,KX,KY)
IMPLICIT NONE

REAL(KIND=JPRB), INTENT(INOUT) :: PX(:,:)
INTEGER(KIND=JPIM), INTENT(IN) :: KX,KY

INTEGER(KIND=JPIM) :: JJ,JX,JY
REAL(KIND=JPRB) :: ZHOOK_HANDLE
! -----------------------------------------
IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:WAVSTEP_Q6',0,ZHOOK_HANDLE)

JX=SIZE(PX,1)
JY=SIZE(PX,2)

IF (KX==0) THEN
  DO JJ=1,JY
    CALL EJBWAV_TRANS_Q6(PX(:,JJ),JX,NPERIODIC)
  ENDDO
ELSE
  DO JJ=1,JY
    CALL EJBWAV_TRANS_REVQ6(PX(:,JJ),JX,NPERIODIC)
  ENDDO
ENDIF

IF (KY==0) THEN
  DO JJ=1,JX
    CALL EJBWAV_TRANS_Q6(PX(JJ,:),JY,NPERIODIC)
  ENDDO
ELSE
  DO JJ=1,JX
    CALL EJBWAV_TRANS_REVQ6(PX(JJ,:),JY,NPERIODIC)
  ENDDO
ENDIF

IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:WAVSTEP_Q6',1,ZHOOK_HANDLE)
END SUBROUTINE WAVSTEP_Q6

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

SUBROUTINE WAVSTEP_Q6_INV(PX,KX,KY)
IMPLICIT NONE

REAL(KIND=JPRB), INTENT(INOUT) :: PX(:,:)
INTEGER(KIND=JPIM), INTENT(IN) :: KX,KY

INTEGER(KIND=JPIM) :: JJ,JX,JY
REAL(KIND=JPRB) :: ZHOOK_HANDLE
! -----------------------------------------
IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:WAVSTEP_Q6_INV',0,ZHOOK_HANDLE)

JX=SIZE(PX,1)
JY=SIZE(PX,2)

IF (KY==0) THEN
  DO JJ=1,JX
    CALL EJBWAV_TRANS_Q6_INV(PX(JJ,:),JY,NPERIODIC)
  ENDDO
ELSE
  DO JJ=1,JX
    CALL EJBWAV_TRANS_REVQ6_INV(PX(JJ,:),JY,NPERIODIC)
  ENDDO
ENDIF

IF (KX==0) THEN
  DO JJ=1,JY
    CALL EJBWAV_TRANS_Q6_INV(PX(:,JJ),JX,NPERIODIC)
  ENDDO
ELSE
  DO JJ=1,JY
    CALL EJBWAV_TRANS_REVQ6_INV(PX(:,JJ),JX,NPERIODIC)
  ENDDO
ENDIF

IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:WAVSTEP_Q6_INV',1,ZHOOK_HANDLE)
END SUBROUTINE WAVSTEP_Q6_INV

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

! =============
! FARAS wavelet
! =============
! This are the "Faras" quasi-symmetric orthogonal wavelets
! used only for the 1st stage of the complex wavel transform

! ATTENTION : for non-KPERIODIC transforms the adjoint is no longer equal to the inverse!
! contains 4 routines: direct, inverse, adjoint, inverse-adjoint
! in the orthogonal (KPERIODIC) case, this is redundant...

SUBROUTINE EJBWAV_TRANS_FARAS(PX ,KN,KPERIODIC)
implicit none

REAL(KIND=JPRB), INTENT(INOUT) :: PX(:) 
INTEGER(KIND=JPIM), INTENT(IN) :: KN,KPERIODIC
REAL(KIND=JPRB)    :: ZA1,ZA2,ZA3,ZA4,ZSCALE,ZLP(KN/2),ZHP(KN/2)
INTEGER(KIND=JPIM) :: I,INH
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!     ------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:EJBWAV_TRANS_FARAS',0,ZHOOK_HANDLE)

INH=KN/2

!!!!!!!!!!!!
DO I=2,KN,2
   PX(I) = PX(I) + PX(I-1)
ENDDO

!!!!!!!!!!!!

!a1=sqrt(15._JPRB/4.)-2.0_JPRB
ZA1= -0.063508326896291489305_JPRB
ZA2= -.5_JPRB

DO I=3,KN-1,2
   PX(I) = PX(I) + ZA2*PX(I+1) + ZA1*PX(I-1)
ENDDO

IF (KPERIODIC==0) THEN
   PX(1) = PX(1) + ZA2*PX(2) + ZA1*PX(2)
ELSE
   PX(1) = PX(1) + ZA2*PX(2) + ZA1*PX(KN)
ENDIF

!!!!!!!!!!!!!!!

ZA3=-.25_JPRB

DO I=4,KN-2,2
   PX(I) = PX(I) + ZA3*(PX(I-3)-PX(I+1))
ENDDO

IF (KPERIODIC==0) THEN
   PX(2) = PX(2) 
   PX(KN) = PX(KN) + ZA3*(PX(KN-3) - PX(KN-1))
ELSE
   PX(2) = PX(2) + ZA3*(PX(KN-1) - PX(3))
   PX(KN) = PX(KN) + ZA3*(PX(KN-3) - PX(1))
ENDIF

!!!!!!!!!

!ZA4=2._JPRB-sqrt(15._JPRB/4.)
ZA4= 0.063508326896291489305_JPRB
DO I=1,KN-3,2
   PX(I)=PX(I) + ZA4*PX(I+3)
ENDDO

IF (KPERIODIC==0) THEN
   PX(KN-1)=PX(KN-1)+ZA4*PX(KN-2)
ELSE
   PX(KN-1)=PX(KN-1)+ZA4*PX(2)
ENDIF


!!!!!!!!!!!!!!!!

ZSCALE=-1._JPRB/sqrt(2._JPRB)

ZLP=PX(2:KN:2)
ZHP=PX(1:(KN-1):2)

PX(1:INH)=ZLP*ZSCALE
PX((INH+1):KN)=ZHP/ZSCALE

IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:EJBWAV_TRANS_FARAS',1,ZHOOK_HANDLE)

END SUBROUTINE EJBWAV_TRANS_FARAS

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

SUBROUTINE EJBWAV_TRANS_FARAS_INV(PX,KN,KPERIODIC)
implicit none
REAL(KIND=JPRB), INTENT(INOUT) :: PX(:) 
INTEGER(KIND=JPIM), INTENT(IN) :: KN,KPERIODIC
REAL(KIND=JPRB)    :: ZA1,ZA2,ZA3,ZA4,ZSCALE,ZLP(KN/2),ZHP(KN/2)
INTEGER(KIND=JPIM) :: I,INH
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!     ------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:EJBWAV_TRANS_FARAS_INV',0,ZHOOK_HANDLE)

INH=KN/2

ZSCALE= -1._JPRB/sqrt(2._JPRB)

ZLP=PX(1:INH)/ZSCALE
ZHP=PX((INH+1):KN)*ZSCALE

!!!!!!!!!!!!!!!

!a1=2._JPRB-sqrt(15._JPRB/4.)
ZA4=0.063508326896291489305_JPRB

DO I=1,INH-1
   ZHP(I)=ZHP(I) - ZA4*ZLP(I+1) 
ENDDO

IF (KPERIODIC==0) THEN
  ZHP(INH)=ZHP(INH) - ZA4*ZLP(INH-1) 
ELSE
  ZHP(INH)=ZHP(INH) - ZA4*ZLP(1) 
ENDIF

!!!!!!!!!!
ZA3=-.25_JPRB

DO I=2,INH-1
   ZLP(I)=ZLP(I) - ZA3*(ZHP(I-1) - ZHP(I+1))
ENDDO

IF (KPERIODIC==0) THEN
   ZLP(1) = ZLP(1) - ZA3*(ZHP(2) - ZHP(2))
   ZLP(INH) = ZLP(INH) - ZA3*(ZHP(INH-1) - ZHP(INH-1))
ELSE
   ZLP(1) = ZLP(1) - ZA3*(ZHP(INH) - ZHP(2))
   ZLP(INH) = ZLP(INH) - ZA3*(ZHP(INH-1) - ZHP(1))
ENDIF

!!!!!!!!!!!!
!a1=sqrt(15._JPRB/4.)-2._JPRB
ZA1= -0.063508326896291489305_JPRB
ZA2=-.5_JPRB

DO I=2,INH
   ZHP(I)=ZHP(I) - ZA2*ZLP(I) - ZA1*ZLP(I-1)
ENDDO

IF (KPERIODIC==0) THEN
   ZHP(1)=ZHP(1) - ZA2*ZLP(1) - ZA1*ZLP(1)
ELSE
   ZHP(1)=ZHP(1) - ZA2*ZLP(1) - ZA1*ZLP(INH)
ENDIF

!!!!!!!!!!!!

DO I=1,INH
   ZLP(I)=ZLP(I) - ZHP(I)
ENDDO

PX(1:(KN-1):2)=ZHP
PX(2:KN:2)=ZLP

IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:EJBWAV_TRANS_FARAS_INV',1,ZHOOK_HANDLE)

END SUBROUTINE EJBWAV_TRANS_FARAS_INV

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

SUBROUTINE EJBWAV_TRANS_FARASAD(PX,KN,KPERIODIC)
implicit none

REAL(KIND=JPRB), INTENT(INOUT) :: PX(:) 
INTEGER(KIND=JPIM), INTENT(IN) :: KN,KPERIODIC
REAL(KIND=JPRB)    :: ZA1,ZA2,ZA3,ZA4,ZSCALE,ZLP(KN/2),ZHP(KN/2)
INTEGER(KIND=JPIM) :: I,INH
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!     ------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:EJBWAV_TRANS_FARASAD',0,ZHOOK_HANDLE)

INH=KN/2

ZSCALE= -1._JPRB/sqrt(2._JPRB)

ZLP=PX(1:INH)*ZSCALE
ZHP=PX((INH+1):KN)/ZSCALE

PX(2:KN:2)=ZLP
PX(1:(KN-1):2)=ZHP

!!!!!!!!!!!!!!!

!a1=2._JPRB-sqrt(15._JPRB/4.)
ZA4= 0.063508326896291489305_JPRB

DO I=1,KN-3,2
   PX(I+3) = PX(I+3) + ZA4*PX(I)
ENDDO

IF (KPERIODIC==0) THEN
   PX(KN-2) = PX(KN-2) + ZA4*PX(KN-1)
ELSE
   PX(2)   = PX(2)   + ZA4*PX(KN-1)
ENDIF

!!!!!!!!!!

ZA3=-.25_JPRB

DO I=4,KN-2,2
   PX(I-3)=PX(I-3) + ZA3*PX(I)
   PX(I+1)=PX(I+1) - ZA3*PX(I)
ENDDO

IF (KPERIODIC==0) THEN
   PX(KN-3) = PX(KN-3) + ZA3*PX(KN)
   PX(KN-1) = PX(KN-1) - ZA3*PX(KN)
ELSE
  PX(1) = PX(1) - ZA3*PX(KN)
  PX(3) = PX(3) - ZA3*PX(2)
  PX(KN-3) = PX(KN-3) + ZA3*PX(KN)
  PX(KN-1) = PX(KN-1) + ZA3*PX(2)
ENDIF

!!!!!!!!!!!!

!a1=sqrt(15._JPRB/4.)-2._JPRB
ZA1= -0.063508326896291489305_JPRB
ZA2=-.5_JPRB

DO I=3,KN-1,2
  PX(I+1) = PX(I+1) + ZA2*PX(I)
  PX(I-1) = PX(I-1) + ZA1*PX(I)
ENDDO

IF (KPERIODIC==0) THEN
  PX(2) = PX(2) + (ZA2+ZA1)*PX(1)
ELSE
  PX(2) = PX(2) + ZA2*PX(1)
  PX(KN) = PX(KN) + ZA1*PX(1)
ENDIF

!!!!!!!!!

DO I=2,KN,2
   PX(I-1) = PX(I-1) + PX(I)
ENDDO

IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:EJBWAV_TRANS_FARASAD',1,ZHOOK_HANDLE)

END SUBROUTINE EJBWAV_TRANS_FARASAD

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

SUBROUTINE EJBWAV_TRANS_FARASAD_INV(PX,KN,KPERIODIC)

implicit none

REAL(KIND=JPRB), INTENT(INOUT) :: PX(:) 
INTEGER(KIND=JPIM), INTENT(IN) :: KN,KPERIODIC
REAL(KIND=JPRB)    :: ZA1,ZA2,ZA3,ZA4,ZSCALE,ZLP(KN/2),ZHP(KN/2)
INTEGER(KIND=JPIM) :: I,INH
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!     ------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:EJBWAV_TRANS_FARASAD_INV',0,ZHOOK_HANDLE)

INH=KN/2

DO I=2,KN,2
   PX(I-1) = PX(I-1) - PX(I)
ENDDO

!!!!!!!!!!

!a1=sqrt(15._JPRB/4._JPRB)-2._JPRB
ZA1= -0.063508326896291489305_JPRB
ZA2=-.5_JPRB

DO I=3,KN-1,2
  PX(I+1) = PX(I+1) - ZA2*PX(I)
  PX(I-1) = PX(I-1) - ZA1*PX(I)
ENDDO

IF (KPERIODIC==0) THEN
  PX(2) = PX(2) - (ZA2+ZA1)*PX(1)
ELSE
  PX(2) = PX(2) - ZA2*PX(1)
  PX(KN) = PX(KN) - ZA1*PX(1)
ENDIF

!!!!!!!!!

ZA3=-.25_JPRB

DO I=4,KN-2,2
   PX(I-3)=PX(I-3) - ZA3*PX(I)
   PX(I+1)=PX(I+1) + ZA3*PX(I)
ENDDO

IF (KPERIODIC==0) THEN
   PX(KN-3) = PX(KN-3) - ZA3*PX(KN)
   PX(KN-1) = PX(KN-1) + ZA3*PX(KN)
ELSE
  PX(1) = PX(1) + ZA3*PX(KN)
  PX(3) = PX(3) + ZA3*PX(2)
  PX(KN-3) = PX(KN-3) - ZA3*PX(KN)
  PX(KN-1) = PX(KN-1) - ZA3*PX(2)
ENDIF

!!!!!!!!!!!!

!a1=2._JPRB-sqrt(15._JPRB/4._JPRB)
ZA4= 0.063508326896291489305_JPRB

DO I=1,KN-3,2
   PX(I+3) = PX(I+3) - ZA4*PX(I)
ENDDO

IF (KPERIODIC==0) THEN
   PX(KN-2) = PX(KN-2) - ZA4*PX(KN-1)
ELSE
   PX(2)   = PX(2)   - ZA4*PX(KN-1)
ENDIF

!!!!!!!!!!!!!!!

ZSCALE=-1._JPRB/sqrt(2._JPRB)

ZLP=PX(2:KN:2)
ZHP=PX(1:(KN-1):2)

PX(1:INH)=ZLP/ZSCALE
PX((INH+1):KN)=ZHP*ZSCALE

IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:EJBWAV_TRANS_FARASAD_INV',1,ZHOOK_HANDLE)

END SUBROUTINE EJBWAV_TRANS_FARASAD_INV

! ==============================================

! =============
! Shifted FARAS wavelet
! =============
! This are the "Faras" quasi-symmetric orthogonal wavelets
! used only for the 1st stage of the complex wavel transform

! ATTENTION : for non-periodic transforms the adjoint is no longer equal to the inverse!

SUBROUTINE EJBWAV_TRANS_SHIFTFARAS(PX,KN,KPERIODIC)
implicit none

REAL(KIND=JPRB), INTENT(INOUT) :: PX(:) 
INTEGER(KIND=JPIM), INTENT(IN) :: KN,KPERIODIC
REAL(KIND=JPRB)    ::  ZA1,ZA2,ZA3,ZA4,ZSCALE,ZLP(KN/2),ZHP(KN/2)
INTEGER(KIND=JPIM) :: I,INH
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!     ------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:EJBWAV_TRANS_SHIFTFARAS',0,ZHOOK_HANDLE)

INH=KN/2

DO I=3,KN-1,2
   PX(I)=PX(I) + PX(I-1)
ENDDO

IF (KPERIODIC==0) THEN
   PX(1)=PX(1) + PX(2)
ELSE
   PX(1)=PX(1) + PX(KN)
ENDIF

!!!!!!!!!!!!

ZA1=sqrt(15._JPRB/4.)-2._JPRB
ZA2=-.5_JPRB

DO I=2,KN-2,2
   PX(I)=PX(I) + ZA2*PX(I+1) + ZA1*PX(I-1)
ENDDO
IF (KPERIODIC==0) THEN
   PX(KN)=PX(KN) + ZA2*PX(KN-1) + ZA1*PX(KN-1)
ELSE
   PX(KN)=PX(KN) + ZA2*PX(1) + ZA1*PX(KN-1)
ENDIF

!!!!!!!!!!!!!!!

ZA3=-.25_JPRB

DO I=5,KN-1,2
   PX(I)=PX(I) + ZA3*(PX(I-3)-PX(I+1))
ENDDO

IF (KPERIODIC==0) THEN
   PX(1)=PX(1) + ZA3*(PX(4)-PX(2))
   PX(3)=PX(3) + ZA3*(PX(2)-PX(2))
ELSE
   PX(1)=PX(1) + ZA3*(PX(KN-2)-PX(2))
   PX(3)=PX(3) + ZA3*(PX(KN)-PX(4))
ENDIF

!!!!!!!!!

ZA4=2._JPRB-sqrt(15._JPRB/4.)
DO I=2,KN-4,2
   PX(I) = PX(I) + ZA4*PX(I+3)
ENDDO
IF (KPERIODIC==0) THEN
   PX(KN-2) = PX(KN-2) + ZA4*PX(KN-1)
   PX(KN)   = PX(KN) +  ZA4*PX(KN-3)
ELSE
   PX(KN-2) = PX(KN-2) + ZA4*PX(1)
   PX(KN)   = PX(KN) + ZA4*PX(3)
ENDIF

!!!!!!!!!

ZSCALE=-1./sqrt(2._JPRB)

ZLP=PX(1:(KN-1):2)
ZHP=PX(2:KN:2)

PX(1:INH)=ZLP*ZSCALE
PX((INH+1):KN)=ZHP/ZSCALE

IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:EJBWAV_TRANS_SHIFTFARAS',1,ZHOOK_HANDLE)
END SUBROUTINE EJBWAV_TRANS_SHIFTFARAS

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

SUBROUTINE EJBWAV_TRANS_SHIFTFARAS_INV(PX,KN,KPERIODIC)
implicit none

REAL(KIND=JPRB), INTENT(INOUT) :: PX(:) 
INTEGER(KIND=JPIM), INTENT(IN) :: KN,KPERIODIC
REAL(KIND=JPRB)    ::  ZA1,ZA2,ZA3,ZA4,ZSCALE,ZLP(KN/2),ZHP(KN/2)
INTEGER(KIND=JPIM) :: I,INH
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!     ------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:EJBWAV_TRANS_SHIFTFARAS_INV',0,ZHOOK_HANDLE)

INH=KN/2

! Scaling step (combine with re-ordering)

ZSCALE= -1./sqrt(2._JPRB)
ZLP=PX(1:INH)/ZSCALE
ZHP=PX((INH+1):KN)*ZSCALE

PX(1:(KN-1):2)=ZLP
PX(2:KN:2)=ZHP

!!!!!!!!!!!!!!!
ZA4=2.-sqrt(15./4.)
DO I=2,KN-4,2
   PX(I)  = PX(I)   - ZA4*PX(I+3)
ENDDO
IF (KPERIODIC==0) THEN
   PX(KN-2)= PX(KN-2) - ZA4*PX(KN-1)
   PX(KN)  = PX(KN)   - ZA4*PX(KN-3)
ELSE
   PX(KN-2)= PX(KN-2) - ZA4*PX(1)
   PX(KN)  = PX(KN)   - ZA4*PX(3)
ENDIF


!!!!!!!!!!
ZA3=-.25_JPRB

DO I=5,KN-1,2
   PX(I)=PX(I) - ZA3*(PX(I-3)-PX(I+1))
ENDDO

IF (KPERIODIC==0) THEN
   PX(1)=PX(1) - ZA3*(PX(4)-PX(2))
   PX(3)=PX(3) - ZA3*(PX(2)-PX(2))
ELSE
   PX(1)=PX(1) - ZA3*(PX(KN-2)-PX(2))
   PX(3)=PX(3) - ZA3*(PX(KN)-PX(4))
ENDIF

!!!!!!!!!!!!
ZA1=sqrt(15._JPRB/4.)-2._JPRB
ZA2=-.5_JPRB

DO I=2,KN-2,2
   PX(I)=PX(I) - ZA2*PX(I+1) - ZA1*PX(I-1)
ENDDO
IF (KPERIODIC==0) THEN
   PX(KN)=PX(KN) - ZA2*PX(KN-1) - ZA1*PX(KN-1)
ELSE
   PX(KN)=PX(KN) - ZA2*PX(1) - ZA1*PX(KN-1)
ENDIF


!!!!!!!!!!!!
DO I=3,KN-1,2
   PX(I)=PX(I) - PX(I-1)
ENDDO
IF (KPERIODIC==0) THEN
   PX(1)=PX(1) - PX(2)
ELSE
   PX(1)=PX(1) - PX(KN)
ENDIF
IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:EJBWAV_TRANS_SHIFTFARAS_INV',1,ZHOOK_HANDLE)

END SUBROUTINE EJBWAV_TRANS_SHIFTFARAS_INV

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

SUBROUTINE EJBWAV_TRANS_SHIFTFARASAD(PX,KN,KPERIODIC)
implicit none

REAL(KIND=JPRB), INTENT(INOUT) :: PX(:) 
INTEGER(KIND=JPIM), INTENT(IN) :: KN,KPERIODIC
REAL(KIND=JPRB)    ::  ZA1,ZA2,ZA3,ZA4,ZSCALE,ZLP(KN/2),ZHP(KN/2)
INTEGER(KIND=JPIM) :: I,INH
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!     ------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:EJBWAV_TRANS_SHIFTFARASAD',0,ZHOOK_HANDLE)

INH=KN/2

! Scaling step (combine with re-ordering)

ZSCALE= -1./sqrt(2._JPRB)
ZLP=PX(1:INH)*ZSCALE
ZHP=PX((INH+1):KN)/ZSCALE

PX(1:KN:2)=ZLP
PX(2:KN:2)=ZHP

!!!!!!!!!!!!!!!

ZA4=2._JPRB-sqrt(15._JPRB/4.)
DO I=2,KN-4,2
   PX(I+3) = PX(I+3) + ZA4*PX(I)
ENDDO
IF (KPERIODIC==0) THEN
   PX(KN-1) = PX(KN-1) + ZA4*PX(KN-2)
   PX(KN-3) = PX(KN-3) + ZA4*PX(KN)
ELSE
   PX(1) = PX(1) + ZA4*PX(KN-2)
   PX(3) = PX(3) + ZA4*PX(KN)
ENDIF

!!!!!!!!!!

ZA3=-.25_JPRB

DO I=5,KN-1,2
   PX(I-3) = PX(I-3) + ZA3*PX(I)
   PX(I+1) = PX(I+1) - ZA3*PX(I)
ENDDO

IF (KPERIODIC==0) THEN
   PX(2) = PX(2) - ZA3*PX(1) 
   PX(4) = PX(4) + ZA3*PX(1)
ELSE
   PX(2)   = PX(2) - ZA3*PX(1) 
   PX(4)   = PX(4) - ZA3*PX(3)
   PX(KN-2) = PX(KN-2) + ZA3*PX(1)
   PX(KN)   = PX(KN) + ZA3*PX(3)
ENDIF

!!!!!!!!!!!!

ZA1=sqrt(15._JPRB/4.)-2._JPRB
ZA2=-.5_JPRB

DO I=2,KN-2,2
   PX(I+1) = PX(I+1) + ZA2*PX(I)
   PX(I-1) = PX(I-1) + ZA1*PX(I)
ENDDO

IF (KPERIODIC==0) THEN
   PX(KN-1) = PX(KN-1) + (ZA2+ZA1)*PX(KN)
ELSE
   PX(1)   = PX(1)   + ZA2*PX(KN)
   PX(KN-1) = PX(KN-1) + ZA1*PX(KN)
ENDIF

!!!!!!!!!!!!

DO I=3,KN-1,2
   PX(I-1)=PX(I-1) + PX(I)
ENDDO

IF (KPERIODIC==0) THEN
   PX(2)=PX(2) + PX(1)
ELSE
   PX(KN)=PX(KN) + PX(1)
ENDIF
IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:EJBWAV_TRANS_SHIFTFARASAD',1,ZHOOK_HANDLE)

END SUBROUTINE EJBWAV_TRANS_SHIFTFARASAD

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

SUBROUTINE EJBWAV_TRANS_SHIFTFARASAD_INV(PX,KN,KPERIODIC)
implicit none

REAL(KIND=JPRB), INTENT(INOUT) :: PX(:) 
INTEGER(KIND=JPIM), INTENT(IN) :: KN,KPERIODIC
REAL(KIND=JPRB)    ::  ZA1,ZA2,ZA3,ZA4,ZSCALE,ZLP(KN/2),ZHP(KN/2)
INTEGER(KIND=JPIM) :: I,INH
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!     ------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:EJBWAV_TRANS_SHIFTFARASAD_INV',0,ZHOOK_HANDLE)

INH=KN/2

!!!!!!!!!!!!

DO I=3,KN-1,2
   PX(I-1)=PX(I-1) - PX(I)
ENDDO

IF (KPERIODIC==0) THEN
   PX(2)=PX(2) - PX(1)
ELSE
   PX(KN)=PX(KN) - PX(1)
ENDIF

!!!!!!!!!!!!

ZA1=sqrt(15._JPRB/4.)-2._JPRB
ZA2=-.5_JPRB

DO I=2,KN-2,2
   PX(I+1) = PX(I+1) - ZA2*PX(I)
   PX(I-1) = PX(I-1) - ZA1*PX(I)
ENDDO

IF (KPERIODIC==0) THEN
   PX(KN-1) = PX(KN-1) - (ZA2+ZA1)*PX(KN)
ELSE
   PX(1)   = PX(1) - ZA2*PX(KN)
   PX(KN-1) = PX(KN-1) - ZA1*PX(KN)
ENDIF

!!!!!!!!!!!!!!!

ZA3=-.25_JPRB

DO I=5,KN-1,2
  PX(I-3) = PX(I-3) - ZA3*PX(I)
  PX(I+1) = PX(I+1) + ZA3*PX(I)
ENDDO

IF (KPERIODIC==0) THEN
   PX(2) = PX(2) + ZA3*PX(1) 
   PX(4) = PX(4) - ZA3*PX(1)
ELSE
   PX(2) = PX(2) + ZA3*PX(1) 
   PX(4) = PX(4) + ZA3*PX(3)
   PX(KN-2) = PX(KN-2) - ZA3*PX(1)
   PX(KN) = PX(KN) - ZA3*PX(3)
ENDIF

!!!!!!!!!

ZA4=2._JPRB-sqrt(15._JPRB/4.)
DO I=2,KN-4,2
   PX(I+3) = PX(I+3) - ZA4*PX(I)
ENDDO
IF (KPERIODIC==0) THEN
   PX(KN-1) = PX(KN-1) - ZA4*PX(KN-2)
   PX(KN-3) = PX(KN-3) - ZA4*PX(KN)
ELSE
   PX(1) = PX(1) - ZA4*PX(KN-2)
   PX(3) = PX(3) - ZA4*PX(KN)
ENDIF

!!!!!!!!!

ZSCALE=-1./sqrt(2._JPRB)

ZLP=PX(1:KN:2)
ZHP=PX(2:KN:2)

PX(1:INH)=ZLP/ZSCALE
PX((INH+1):KN)=ZHP*ZSCALE
IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:EJBWAV_TRANS_SHIFTFARASAD_INV',1,ZHOOK_HANDLE)

END SUBROUTINE EJBWAV_TRANS_SHIFTFARASAD_INV


! ==========
! Q6 wavelet
! ==========
! a lifting-implementation of Q6
! 1) the direct transform
! 2) the inverse
! 3) the adjoint transform
! 4) the inverse adjoint

! When using KPERIODIC boundary conditions, this transform is orthogonal
! thus the adjoint is equal to the inverse (up to numerical precision).
! In this case, only 2 routines are necessary.

! However, with SYMMETRIC BOUNDARY conditions, we have a BI-ORTHOGONAL transform
! and the ADJOINT transform is equal to the INVERSE *DUAL* transform. 

SUBROUTINE EJBWAV_TRANS_Q6(PX,KN,KPERIODIC)
implicit none

REAL(KIND=JPRB), INTENT(INOUT) :: PX(:) 
INTEGER(KIND=JPIM), INTENT(IN) :: KN,KPERIODIC
REAL(KIND=JPRB)    :: ZA1,ZA2,ZA3,ZA4,ZA5,ZA6,ZSCALE,ZLP(KN/2),ZHP(KN/2)
INTEGER(KIND=JPIM) :: I,INH
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!     ------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:EJBWAV_TRANS_Q6',0,ZHOOK_HANDLE)

INH=KN/2
ZLP=PX(2:KN:2)
ZHP=PX(1:(KN-1):2)

!!!!!!!!!!!!

ZA1=0.15034327406196593135_JPRB
DO I=2,INH
  ZLP(I)=ZLP(I) + ZA1*ZHP(I-1)
ENDDO

IF (KPERIODIC==0) THEN
  ZLP(1) = ZLP(1) + ZA1*ZHP(2)
ELSE
  ZLP(1) = ZLP(1) + ZA1*ZHP(INH)
ENDIF

!!!!!!!!!!!!

ZA2=-1.32396606261592508780_JPRB
ZA3=-0.14702016261615197257_JPRB

DO I=1,INH-1
  ZHP(I)=ZHP(I) + ZA2*ZLP(I) + ZA3*ZLP(I+1)
ENDDO

IF (KPERIODIC==0) THEN
  ZHP(INH)=ZHP(INH) + ZA2*ZLP(INH) + ZA3*ZLP(INH-1)
ELSE
  ZHP(INH)=ZHP(INH) + ZA2*ZLP(INH) + ZA3*ZLP(1)
ENDIF

!!!!!!!!!!!!!!!

ZA4= 0.48869844997216427274_JPRB
ZA5= -0.11104526525828455064_JPRB
DO I=2,INH
  ZLP(I)=ZLP(I) + ZA4*ZHP(I) + ZA5*ZHP(I-1)
ENDDO

IF (KPERIODIC==0) THEN
  ZLP(1) = ZLP(1) + ZA4*ZHP(1) + ZA5*ZHP(2)
ELSE
  ZLP(1) = ZLP(1) + ZA4*ZHP(1) + ZA5*ZHP(INH)
ENDIF

!!!!!!!!!
!!!!!!!!!

! A final lifting step for the high pass
ZA6=0.77859882329623919528_JPRB
DO I=1,INH-1
  ZHP(I)=ZHP(I) + ZA6*ZLP(I+1) 
ENDDO

IF (KPERIODIC==0) THEN
  ZHP(INH)=ZHP(INH) + ZA6*ZLP(INH-1) 
ELSE
  ZHP(INH)=ZHP(INH) + ZA6*ZLP(1) 
ENDIF


! Scaling step (combine with re-ordering)
ZSCALE= 1.5908724112752410385_JPRB

PX(1:INH)=ZLP*ZSCALE
PX(INH+1:KN)=ZHP/ZSCALE

IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:EJBWAV_TRANS_Q6',1,ZHOOK_HANDLE)

END SUBROUTINE EJBWAV_TRANS_Q6

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

SUBROUTINE EJBWAV_TRANS_Q6_INV(PX,KN,KPERIODIC)
implicit none

REAL(KIND=JPRB), INTENT(INOUT) :: PX(:) 
INTEGER(KIND=JPIM), INTENT(IN) :: KN,KPERIODIC
REAL(KIND=JPRB)    :: ZA1,ZA2,ZA3,ZA4,ZA5,ZA6,ZSCALE,ZLP(KN/2),ZHP(KN/2)
INTEGER(KIND=JPIM) :: I,INH
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!     ------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:EJBWAV_TRANS_Q6_INV',0,ZHOOK_HANDLE)

INH=KN/2

! Scaling step (combine with re-ordering)

ZSCALE= 1.5908724112752410385_JPRB
ZLP=PX(1:INH)/ZSCALE
ZHP=PX((INH+1):KN)*ZSCALE

!!!!!!!!!!!!!!!
! s(z)
ZA6= 0.77859882329623919528_JPRB
DO I=1,INH-1
  ZHP(I)=ZHP(I) - ZA6*ZLP(I+1) 
ENDDO

IF (KPERIODIC==0) THEN
  ZHP(INH)=ZHP(INH) - ZA6*ZLP(INH-1) 
ELSE
  ZHP(INH)=ZHP(INH) - ZA6*ZLP(1) 
ENDIF

!!!!!!!!!!
! q3
ZA4= 0.48869844997216427274_JPRB
ZA5=-0.11104526525828455064_JPRB
DO I=2,INH
  ZLP(I)=ZLP(I) - ZA4*ZHP(I) - ZA5*ZHP(I-1)
ENDDO

IF (KPERIODIC==0) THEN
  ZLP(1) = ZLP(1) - ZA4*ZHP(1) - ZA5*ZHP(2)
ELSE
  ZLP(1) = ZLP(1) - ZA4*ZHP(1) - ZA5*ZHP(INH)
ENDIF

!!!!!!!!!!!!

ZA2= -1.32396606261592508780_JPRB
ZA3= -0.14702016261615197257_JPRB

DO I=1,INH-1
  ZHP(I)=ZHP(I) - ZA2*ZLP(I) - ZA3*ZLP(I+1)
ENDDO

IF (KPERIODIC==0) THEN
  ZHP(INH)=ZHP(INH) - ZA2*ZLP(INH) - ZA3*ZLP(INH-1)
ELSE
  ZHP(INH)=ZHP(INH) - ZA2*ZLP(INH) - ZA3*ZLP(1)
ENDIF

!!!!!!!!!!!!

ZA1=0.15034327406196593135_JPRB
DO I=2,INH
  ZLP(I)=ZLP(I) - ZA1*ZHP(I-1)
ENDDO

IF (KPERIODIC==0) THEN
  ZLP(1) = ZLP(1) - ZA1*ZHP(2)
ELSE
  ZLP(1) = ZLP(1) - ZA1*ZHP(INH)
ENDIF

PX(1:(KN-1):2)=ZHP
PX(2:KN:2)=ZLP

IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:EJBWAV_TRANS_Q6_INV',1,ZHOOK_HANDLE)

END SUBROUTINE EJBWAV_TRANS_Q6_INV

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

SUBROUTINE EJBWAV_TRANS_Q6AD(PX,KN,KPERIODIC)
implicit none

REAL(KIND=JPRB), INTENT(INOUT) :: PX(:) 
INTEGER(KIND=JPIM), INTENT(IN) :: KN,KPERIODIC
REAL(KIND=JPRB)    :: ZA1,ZA2,ZA3,ZA4,ZA5,ZA6,ZSCALE,ZLP(KN/2),ZHP(KN/2)
INTEGER(KIND=JPIM) :: I,INH
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!     ------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:EJBWAV_TRANS_Q6AD',0,ZHOOK_HANDLE)

INH=KN/2
ZSCALE= 1.5908724112752410385_JPRB

ZLP=PX(1:INH)*ZSCALE
ZHP=PX((INH+1):KN)/ZSCALE

!!!!!!!!!

ZA6=0.77859882329623919528_JPRB

IF (KPERIODIC==0) THEN
  ZLP(INH-1) = ZLP(INH-1) + ZA6*ZHP(INH)
ELSE
  ZLP(1) = ZLP(1) + ZA6*ZHP(INH)
ENDIF
DO I=1,INH-1
  ZLP(I+1) = ZLP(I+1) + ZA6*ZHP(I)
ENDDO

!!!!!!!!!!!!!!!

ZA4= 0.48869844997216427274_JPRB
ZA5= -0.11104526525828455064_JPRB
IF (KPERIODIC==0) THEN
  ZHP(1) = ZHP(1) + ZA4*ZLP(1)
  ZHP(2) = ZHP(2) + ZA5*ZLP(1)
ELSE
  ZHP(1) = ZHP(1) + ZA4*ZLP(1)
  ZHP(INH) = ZHP(INH) + ZA5*ZLP(1)
ENDIF
DO I=2,INH
  ZHP(I) = ZHP(I) + ZA4*ZLP(I)
  ZHP(I-1) = ZHP(I-1) + ZA5*ZLP(I)
ENDDO

!!!!!!!!!!

ZA2=-1.32396606261592508780_JPRB
ZA3=-0.14702016261615197257_JPRB
IF (KPERIODIC==0) THEN
  ZLP(INH) = ZLP(INH) + ZA2*ZHP(INH)
  ZLP(INH-1) = ZLP(INH-1) + ZA3*ZHP(INH)
ELSE
  ZLP(INH) = ZLP(INH) + ZA2*ZHP(INH)
  ZLP(1) = ZLP(1) + ZA3*ZHP(INH)
ENDIF

DO I=1,INH-1
  ZLP(I) = ZLP(I) + ZA2*ZHP(I)
  ZLP(I+1) = ZLP(I+1) + ZA3*ZHP(I)
ENDDO

!!!!!!!!!!!!

ZA1=0.15034327406196593135_JPRB

IF (KPERIODIC==0) THEN
  ZHP(2) = ZHP(2) + ZA1*ZLP(1)
ELSE
  ZHP(INH) = ZHP(INH) + ZA1*ZLP(1)
ENDIF

DO I=2,INH
  ZHP(I-1) = ZHP(I-1) + ZA1*ZLP(I)
ENDDO


PX(2:KN:2)=ZLP
PX(1:(KN-1):2)=ZHP

IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:EJBWAV_TRANS_Q6AD',1,ZHOOK_HANDLE)

END SUBROUTINE EJBWAV_TRANS_Q6AD

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

SUBROUTINE EJBWAV_TRANS_Q6AD_INV(PX,KN,KPERIODIC)
implicit none

REAL(KIND=JPRB), INTENT(INOUT) :: PX(:) 
INTEGER(KIND=JPIM), INTENT(IN) :: KN,KPERIODIC
REAL(KIND=JPRB)    :: ZA1,ZA2,ZA3,ZA4,ZA5,ZA6,ZSCALE,ZLP(KN/2),ZHP(KN/2)
INTEGER(KIND=JPIM) :: I,INH
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!     ------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:EJBWAV_TRANS_Q6AD_INV',0,ZHOOK_HANDLE)

INH=KN/2

ZLP=PX(2:KN:2)
ZHP=PX(1:(KN-1):2)

!!!!!!!!!!!!!!!
ZA1=0.15034327406196593135_JPRB

IF (KPERIODIC==0) THEN
  ZHP(2) = ZHP(2) - ZA1*ZLP(1)
ELSE
  ZHP(INH) = ZHP(INH) - ZA1*ZLP(1)
ENDIF

DO I=2,INH
  ZHP(I-1) = ZHP(I-1) - ZA1*ZLP(I)
ENDDO

!!!!!!!!!!

ZA2=-1.32396606261592508780_JPRB
ZA3=-0.14702016261615197257_JPRB
IF (KPERIODIC==0) THEN
  ZLP(INH) = ZLP(INH) - ZA2*ZHP(INH)
  ZLP(INH-1) = ZLP(INH-1) - ZA3*ZHP(INH)
ELSE
  ZLP(INH) = ZLP(INH) - ZA2*ZHP(INH)
  ZLP(1) = ZLP(1) - ZA3*ZHP(INH)
ENDIF

DO I=1,INH-1
  ZLP(I) = ZLP(I) - ZA2*ZHP(I)
  ZLP(I+1) = ZLP(I+1) - ZA3*ZHP(I)
ENDDO

!!!!!!!!!!!!

ZA4= 0.48869844997216427274_JPRB
ZA5= -0.11104526525828455064_JPRB
IF (KPERIODIC==0) THEN
  ZHP(1) = ZHP(1) - ZA4*ZLP(1)
  ZHP(2) = ZHP(2) - ZA5*ZLP(1)
ELSE
  ZHP(1) = ZHP(1) - ZA4*ZLP(1)
  ZHP(INH) = ZHP(INH) - ZA5*ZLP(1)
ENDIF
DO I=2,INH
  ZHP(I) = ZHP(I) - ZA4*ZLP(I)
  ZHP(I-1) = ZHP(I-1) - ZA5*ZLP(I)
ENDDO

!!!!!!!!!!!!

ZA6=0.77859882329623919528_JPRB

IF (KPERIODIC==0) THEN
  ZLP(INH-1) = ZLP(INH-1) - ZA6*ZHP(INH)
ELSE
  ZLP(1) = ZLP(1) - ZA6*ZHP(INH)
ENDIF
DO I=1,INH-1
  ZLP(I+1) = ZLP(I+1) - ZA6*ZHP(I)
ENDDO

ZSCALE= 1.5908724112752410385_JPRB

PX(1:INH)=ZLP/ZSCALE
PX((INH+1):KN)=ZHP*ZSCALE

IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:EJBWAV_TRANS_Q6AD_INV',1,ZHOOK_HANDLE)

END SUBROUTINE EJBWAV_TRANS_Q6AD_INV

!================================

! ==================
! Reverse Q6 wavelet
! ==================

! When using KPERIODIC boundary conditions, this transform is orthogonal
! thus the adjoint is equal to the inverse (up to numerical precision).
! In this case, only 2 routines are necessary.

! However, with SYMMETRIC BOUNDARY conditions, we have a BI-ORTHOGONAL transform
! and the ADJOINT transform is equal to the INVERSE *DUAL* transform. 

SUBROUTINE EJBWAV_TRANS_REVQ6(PX,KN,KPERIODIC)
implicit none

REAL(KIND=JPRB), INTENT(INOUT) :: PX(:) 
INTEGER(KIND=JPIM), INTENT(IN) :: KN,KPERIODIC
REAL(KIND=JPRB)  :: ZA1,ZA2,ZA3,ZA4,ZA5,ZA6,ZSCALE,ZLP(KN/2),ZHP(KN/2)
INTEGER(KIND=JPIM) :: I,INH
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!     ------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:EJBWAV_TRANS_REVQ6',0,ZHOOK_HANDLE)

INH=KN/2
ZLP=PX(2:KN:2)
ZHP=PX(1:(KN-1):2)

!!!!!!!!!!!!

ZA1=0.15034327406196593135_JPRB
DO I=1,INH-2
   ZLP(I)=ZLP(I) + ZA1*ZHP(I+2)
ENDDO

IF (KPERIODIC==0) THEN
   ZLP(INH) = ZLP(INH) + ZA1*ZHP(INH-1)
   ZLP(INH-1) = ZLP(INH-1) + ZA1*ZHP(INH-1)
ELSE
   ZLP(INH) = ZLP(INH) + ZA1*ZHP(2)
   ZLP(INH-1) = ZLP(INH-1) + ZA1*ZHP(1)
ENDIF

!!!!!!!!!!!!

ZA2=-1.32396606261592508780_JPRB
ZA3=-0.14702016261615197257_JPRB

DO I=3,INH
   ZHP(I)=ZHP(I) + ZA2*ZLP(I-1) + ZA3*ZLP(I-2)
ENDDO

IF (KPERIODIC==0) THEN
  ZHP(1)=ZHP(1) + ZA2*ZLP(1) + ZA3*ZLP(2)
  ZHP(2)=ZHP(2) + ZA2*ZLP(1) + ZA3*ZLP(1)
ELSE
  ZHP(1)=ZHP(1) + ZA2*ZLP(INH) + ZA3*ZLP(INH-1)
  ZHP(2)=ZHP(2) + ZA2*ZLP(1) + ZA3*ZLP(INH)
ENDIF

!!!!!!!!!!!!!!!

ZA4= 0.48869844997216427274_JPRB
ZA5= -0.11104526525828455064_JPRB
DO I=1,INH-2
   ZLP(I)=ZLP(I) + ZA4*ZHP(I+1) + ZA5*ZHP(I+2)
ENDDO

IF (KPERIODIC==0) THEN
  ZLP(INH)   = ZLP(INH)   + ZA4*ZHP(INH) + ZA5*ZHP(INH-1)
  ZLP(INH-1) = ZLP(INH-1) + ZA4*ZHP(INH) + ZA5*ZHP(INH)
ELSE
  ZLP(INH) = ZLP(INH) + ZA4*ZHP(1) + ZA5*ZHP(2)
  ZLP(INH-1) = ZLP(INH-1) + ZA4*ZHP(INH) + ZA5*ZHP(1)
ENDIF

!!!!!!!!!

ZA6=0.77859882329623919528_JPRB
DO I=3,INH
   ZHP(I)=ZHP(I) + ZA6*ZLP(I-2) 
ENDDO

IF (KPERIODIC==0) THEN
  ZHP(1)=ZHP(1) + ZA6*ZLP(2) 
  ZHP(2)=ZHP(2) + ZA6*ZLP(1) 
ELSE
  ZHP(1)=ZHP(1) + ZA6*ZLP(INH-1) 
  ZHP(2)=ZHP(2) + ZA6*ZLP(INH) 
ENDIF

!!!!!!!!!!!!

ZSCALE= 1.5908724112752410385_JPRB

PX(1:INH)=ZLP*ZSCALE
PX(INH+1:KN)=ZHP/ZSCALE

IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:EJBWAV_TRANS_REVQ6',1,ZHOOK_HANDLE)

END SUBROUTINE EJBWAV_TRANS_REVQ6

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

SUBROUTINE EJBWAV_TRANS_REVQ6_INV(PX,KN,KPERIODIC)

implicit none

REAL(KIND=JPRB), INTENT(INOUT) :: PX(:) 
INTEGER(KIND=JPIM), INTENT(IN) :: KN,KPERIODIC
REAL(KIND=JPRB)    :: ZA1,ZA2,ZA3,ZA4,ZA5,ZA6,ZSCALE,ZLP(KN/2),ZHP(KN/2)
INTEGER(KIND=JPIM) :: I,INH
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!     ------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:EJBWAV_TRANS_REVQ6_INV',0,ZHOOK_HANDLE)

INH=KN/2

! Scaling step (combine with re-ordering)

ZSCALE= 1.5908724112752410385_JPRB
ZLP=PX(1:INH)/ZSCALE
ZHP=PX((INH+1):KN)*ZSCALE

!!!!!!!!!!!!!!!
! s(z)
ZA6 = 0.77859882329623919528_JPRB
DO I=3,INH
  ZHP(I)=ZHP(I) - ZA6*ZLP(I-2) 
ENDDO

IF (KPERIODIC==0) THEN
  ZHP(1)=ZHP(1) - ZA6*ZLP(2) 
  ZHP(2)=ZHP(2) - ZA6*ZLP(1) 
ELSE
  ZHP(1)=ZHP(1) - ZA6*ZLP(INH-1) 
  ZHP(2)=ZHP(2) - ZA6*ZLP(INH) 
ENDIF

!!!!!!!!!!
! q3
ZA4= 0.48869844997216427274_JPRB
ZA5=-0.11104526525828455064_JPRB
DO I=1,INH-2
  ZLP(I)=ZLP(I) - ZA4*ZHP(I+1) - ZA5*ZHP(I+2)
ENDDO

IF (KPERIODIC==0) THEN
  ZLP(INH)   = ZLP(INH)   - ZA4*ZHP(INH) - ZA5*ZHP(INH-1)
  ZLP(INH-1) = ZLP(INH-1) - ZA4*ZHP(INH) - ZA5*ZHP(INH)
ELSE
  ZLP(INH) = ZLP(INH) - ZA4*ZHP(1) - ZA5*ZHP(2)
  ZLP(INH-1) = ZLP(INH-1) - ZA4*ZHP(INH) - ZA5*ZHP(1)
ENDIF

!!!!!!!!!!!!

ZA2= -1.32396606261592508780_JPRB
ZA3= -0.14702016261615197257_JPRB

DO I=3,INH
  ZHP(I)=ZHP(I) - ZA2*ZLP(I-1) - ZA3*ZLP(I-2)
ENDDO

IF (KPERIODIC==0) THEN
  ZHP(1)=ZHP(1) - ZA2*ZLP(1) - ZA3*ZLP(2)
  ZHP(2)=ZHP(2) - ZA2*ZLP(1) - ZA3*ZLP(1)
ELSE
  ZHP(1)=ZHP(1) - ZA2*ZLP(INH) - ZA3*ZLP(INH-1)
  ZHP(2)=ZHP(2) - ZA2*ZLP(1) - ZA3*ZLP(INH)
ENDIF

!!!!!!!!!!!!

ZA1=0.15034327406196593135_JPRB
DO I=1,INH-2
  ZLP(I)=ZLP(I) - ZA1*ZHP(I+2)
ENDDO

IF (KPERIODIC==0) THEN
  ZLP(INH) = ZLP(INH) - ZA1*ZHP(INH-1)
  ZLP(INH-1) = ZLP(INH-1) - ZA1*ZHP(INH-1)
ELSE
  ZLP(INH) = ZLP(INH) - ZA1*ZHP(2)
  ZLP(INH-1) = ZLP(INH-1) - ZA1*ZHP(1)
ENDIF

PX(1:(KN-1):2)=ZHP
PX(2:KN:2)=ZLP

IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:EJBWAV_TRANS_REVQ6_INV',1,ZHOOK_HANDLE)

END SUBROUTINE EJBWAV_TRANS_REVQ6_INV

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

SUBROUTINE EJBWAV_TRANS_REVQ6AD_INV(PX,KN,KPERIODIC)

implicit none

REAL(KIND=JPRB), INTENT(INOUT) :: PX(:) 
INTEGER(KIND=JPIM), INTENT(IN) :: KN,KPERIODIC
REAL(KIND=JPRB)    :: ZA1,ZA2,ZA3,ZA4,ZA5,ZA6,ZSCALE,ZLP(KN/2),ZHP(KN/2)
INTEGER(KIND=JPIM) :: I,INH
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!     ------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:EJBWAV_TRANS_REVQ6AD_INV',0,ZHOOK_HANDLE)

INH=KN/2
ZLP=PX(2:KN:2)
ZHP=PX(1:KN:2)

!!!!!!!!!!!!

ZA6=0.15034327406196593135_JPRB
DO I=1,INH-2
  ZHP(I+2)=ZHP(I+2) - ZA6*ZLP(I)
ENDDO

IF (KPERIODIC==0) THEN
  ZHP(INH-1)=ZHP(INH-1) - ZA6*(ZLP(INH)+ZLP(INH-1))
ELSE
  ZHP(2) = ZHP(2) - ZA6*ZLP(INH)
  ZHP(1) = ZHP(1) - ZA6*ZLP(INH-1)
ENDIF

!!!!!!!!!!!!

ZA4=-1.32396606261592508780_JPRB
ZA5=-0.14702016261615197257_JPRB

DO I=3,INH
  ZLP(I-1) = ZLP(I-1) - ZA4*ZHP(I)
  ZLP(I-2) = ZLP(I-2) - ZA5*ZHP(I)
ENDDO

IF (KPERIODIC==0) THEN
  ZLP(1)=ZLP(1) - ZA4*ZHP(1) - (ZA4+ZA5)*ZHP(2)
  ZLP(2)=ZLP(2) - ZA5*ZHP(1)
ELSE
  ZLP(1)   = ZLP(1)    - ZA4*ZHP(2)
  ZLP(INH-1)= ZLP(INH-1) - ZA5*ZHP(1)
  ZLP(INH)  = ZLP(INH)   - ZA4*ZHP(1) - ZA5*ZHP(2)
ENDIF

!!!!!!!!!!!!!!!

ZA2= 0.48869844997216427274_JPRB
ZA3= -0.11104526525828455064_JPRB
DO I=1,INH-2
  ZHP(I+1) = ZHP(I+1) - ZA2*ZLP(I)
  ZHP(I+2) = ZHP(I+2) - ZA3*ZLP(I)
ENDDO

IF (KPERIODIC==0) THEN
  ZHP(INH-1) = ZHP(INH-1) - ZA3*ZLP(INH)
  ZHP(INH)   = ZHP(INH)   - ZA2*(ZLP(INH)+ZLP(INH-1)) - ZA3*ZLP(INH-1)
ELSE
   ZHP(1)  = ZHP(1)  - ZA2*ZLP(INH) - ZA3*ZLP(INH-1)
   ZHP(2)  = ZHP(2)  - ZA3*ZLP(INH)
   ZHP(INH) = ZHP(INH) - ZA2*ZLP(INH-1)
ENDIF

!!!!!!!!!

ZA1=0.77859882329623919528_JPRB
DO I=3,INH
  ZLP(I-2) = ZLP(I-2) - ZA1*ZHP(I)
ENDDO

IF (KPERIODIC==0) THEN
  ZLP(2) = ZLP(2) - ZA1*ZHP(1)
  ZLP(1) = ZLP(1) - ZA1*ZHP(2)
ELSE
  ZLP(INH-1) = ZLP(INH-1) - ZA1*ZHP(1)
  ZLP(INH)   = ZLP(INH)   - ZA1*ZHP(2)
ENDIF

!!!!!!!!!!

ZSCALE= 1.5908724112752410385_JPRB

PX(1:INH)=ZLP/ZSCALE
PX(INH+1:KN)=ZHP*ZSCALE

IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:EJBWAV_TRANS_REVQ6AD_INV',1,ZHOOK_HANDLE)

END SUBROUTINE EJBWAV_TRANS_REVQ6AD_INV

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

SUBROUTINE EJBWAV_TRANS_REVQ6AD(PX,KN,KPERIODIC)

implicit none

REAL(KIND=JPRB), INTENT(INOUT) :: PX(:) 
INTEGER(KIND=JPIM), INTENT(IN) :: KN,KPERIODIC
REAL(KIND=JPRB)    :: ZA1,ZA2,ZA3,ZA4,ZA5,ZA6,ZSCALE,ZLP(KN/2),ZHP(KN/2)
INTEGER(KIND=JPIM) :: I,INH
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!     ------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:EJBWAV_TRANS_REVQ6AD',0,ZHOOK_HANDLE)

INH=KN/2

ZSCALE= 1.5908724112752410385_JPRB

ZLP=PX(1:INH)*ZSCALE
ZHP=PX((INH+1):KN)/ZSCALE

!!!!!!!!!!!!!!!

ZA6=0.77859882329623919528_JPRB
DO I=3,INH
  ZLP(I-2) = ZLP(I-2) + ZA6*ZHP(I)
ENDDO

IF (KPERIODIC==0) THEN
  ZLP(2) = ZLP(2) + ZA6*ZHP(1)
  ZLP(1) = ZLP(1) + ZA6*ZHP(2)
ELSE
  ZLP(INH-1) = ZLP(INH-1) + ZA6*ZHP(1)
  ZLP(INH)   = ZLP(INH)   + ZA6*ZHP(2)
ENDIF

!!!!!!!!!!

ZA4= 0.48869844997216427274_JPRB
ZA5= -0.11104526525828455064_JPRB
DO I=1,INH-2
  ZHP(I+1) = ZHP(I+1) + ZA4*ZLP(I)
  ZHP(I+2) = ZHP(I+2) + ZA5*ZLP(I)
ENDDO

IF (KPERIODIC==0) THEN
  ZHP(INH-1) = ZHP(INH-1) + ZA5*ZLP(INH)
  ZHP(INH)   = ZHP(INH)   + ZA4*(ZLP(INH)+ZLP(INH-1)) + ZA5*ZLP(INH-1)
ELSE
  ZHP(1)  = ZHP(1)  + ZA4*ZLP(INH) + ZA5*ZLP(INH-1)
  ZHP(2)  = ZHP(2)  + ZA5*ZLP(INH)
  ZHP(INH) = ZHP(INH) + ZA4*ZLP(INH-1)
ENDIF

!!!!!!!!!

ZA2=-1.32396606261592508780_JPRB
ZA3=-0.14702016261615197257_JPRB

DO I=3,INH
   ZLP(I-1) = ZLP(I-1) + ZA2*ZHP(I)
   ZLP(I-2) = ZLP(I-2) + ZA3*ZHP(I)
ENDDO

IF (KPERIODIC==0) THEN
   ZLP(1)=ZLP(1) + ZA2*ZHP(1) + (ZA2+ZA3)*ZHP(2)
   ZLP(2)=ZLP(2) + ZA3*ZHP(1)
ELSE
   ZLP(1)   = ZLP(1)    + ZA2*ZHP(2)
   ZLP(INH-1)= ZLP(INH-1) + ZA3*ZHP(1)
   ZLP(INH)  = ZLP(INH)   + ZA2*ZHP(1) + ZA3*ZHP(2)
ENDIF

!!!!!!!!!!!!!!!

ZA1=0.15034327406196593135_JPRB
DO I=1,INH-2
   ZHP(I+2)=ZHP(I+2) + ZA1*ZLP(I)
ENDDO

IF (KPERIODIC==0) THEN
   ZHP(INH-1)=ZHP(INH-1) + ZA1*(ZLP(INH)+ZLP(INH-1))
ELSE
   ZHP(2) = ZHP(2) + ZA1*ZLP(INH)
   ZHP(1) = ZHP(1) + ZA6*ZLP(INH-1)
ENDIF

!!!!!!!!!!!!

PX(1:KN:2)=ZHP
PX(2:KN:2)=ZLP

IF (LHOOK) CALL DR_HOOK('WAV_LIFTING_MOD:EJBWAV_TRANS_REVQ6AD',1,ZHOOK_HANDLE)
END SUBROUTINE EJBWAV_TRANS_REVQ6AD


END MODULE WAV_LIFTING_MOD

