SUBROUTINE CVARGPAD(CDSELECT,KSCALE,PSP3,PSP2,PSP1,PGP3,PGP2)

!     Purpose:
!     --------
!       Grid-point part of change of variable.
!       This subroutine replaces calls to STEPOAD('0AA00GAG0')
!       and STEPOAD('0AA00XAG0'). This makes the Jb code more
!       modular and independent of model arrays (SPA3, GPPBUF...).
!     Author.
!     -------
!       L. Isaksen

!     Modifications.
!     --------------
!       28-06-04: Original
!       23-05-05: C. Fischer  add Aladin transforms (bi-Fourier)
!       31-01-08: M. Fisher   Optionally return the gridpoint fields
!       01-08-07: R. El Ouaraini: add news arguments in ejgnrgg and ejgnrggi routines
!                                (for new humidity control variable purpose)
!       06-02-08: B. Strajnar: remove first argument for ejgnrgg and ejgnrggi
!       20-10-08: E. Holm     Move gridpoint change of variable from
!                             jgnr* in here to the new jbchvar* called
!                             in cvar3*. Move transformation to/from Jb
!                             vertical coordinate here from cvar3*
!                             and perform together with fcerror mult/div.

!       26-05-209 A.Bogatchev: Activated calls to modified ejgnrggad ejgnrggiad
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMDIM, ONLY: NSPEC2, NFLEVL, NFLEVG, NPROMA, NFLSUR
USE YOMGEM, ONLY: NGPTOT
USE YOMCVA, ONLY: NVA3D, NVA2D, NVA1D
USE YOMJG , ONLY: L_JBVCOORD
USE YEMVARGP , ONLY : GVARGP
USE YOMLUN   , ONLY : NULOUT
USE YOMCT0   , ONLY : LELAM
USE YOMWAVELET,ONLY : LJBWAVELET, GRID_DEFINITION
USE YOMMP    , ONLY : NPSP

IMPLICIT NONE

CHARACTER(LEN=1)  ,INTENT(IN)    :: CDSELECT
INTEGER(KIND=JPIM),INTENT(IN)    :: KSCALE
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSP3(:,:,:)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSP2(:,:)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSP1(:,:)
REAL(KIND=JPRB)   ,INTENT(INOUT), OPTIONAL :: PGP3(:,:,:)
REAL(KIND=JPRB)   ,INTENT(INOUT), OPTIONAL :: PGP2(:,:,:)

REAL(KIND=JPRB), ALLOCATABLE :: ZGP3(:,:,:), ZGP2(:,:,:)
REAL(KIND=JPRB) :: ZSP2(NSPEC2,NVA2D)
REAL(KIND=JPRB) :: ZHOOK_HANDLE
INTEGER(KIND=JPIM) :: INGPBLKS
INTEGER(KIND=JPIM) :: ICEND,IBL,JKGLO,IGPTOT,IOFF
INTEGER(KIND=JPIM) :: IVOR, IDIV, IT, IQ, ISP, J, I

#include "abor1.intfb.h"
#include "transinv_waveletad.intfb.h"
#include "ejgnrggad.intfb.h"
#include "ejgnrggiad.intfb.h"
#include "etransinv_jbad.intfb.h"
#include "transdir_waveletad.intfb.h"
#include "etransdir_jbad.intfb.h"
#include "jgnrad.intfb.h"
#include "jgnriad.intfb.h"
#include "jbvcoord_interpolate_ad.intfb.h"
!     ------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('CVARGPAD',0,ZHOOK_HANDLE)

!*       1. SETUP
!           -----

IF (KSCALE==0 .OR. .NOT.LJBWAVELET) THEN
  IGPTOT = NGPTOT
ELSE
  IGPTOT = GRID_DEFINITION(KSCALE)%NGPTOT
ENDIF

INGPBLKS = (IGPTOT+NPROMA-1)/NPROMA

! positions for vor, div Q T and Ps in ZGP2 and ZGP3 arrays :
! IVOR, IDIV, IT, IQ and ISP needed for ALADIN

IVOR=1
IDIV=IVOR+NFLEVG
IT=IDIV+NFLEVG
IQ=IT+NFLEVG
ISP=1

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

CALL GSTATS(1049,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(1049,1)
ZGP2(:,:,:)=0.0_JPRB
IF (NPSP==1) ZSP2(:,:)=PSP2(:,:)

IF(.NOT. LELAM) THEN
  CALL TRANSDIR_WAVELETAD (KSCALE, PSP3, ZSP2, ZGP3, ZGP2)
ELSE
  CALL ETRANSDIR_JBAD(KSCALE, PSP3, ZSP2, PSP1, ZGP3, ZGP2)
ENDIF

IF (PRESENT(PGP3).AND.PRESENT(PGP2)) THEN
  CALL GSTATS(1049,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(J)
  DO J=1,NFLEVG*NVA3D
    ZGP3(:,J,:) = ZGP3(:,J,:) + PGP3(:,J,:)
    PGP3(:,J,:) = 0.0_JPRB
  ENDDO
!$OMP END PARALLEL DO
  CALL GSTATS(1049,1)
  DO JKGLO=1,IGPTOT,NPROMA
    ICEND=MIN(NPROMA,IGPTOT-JKGLO+1)
    IBL=(JKGLO-1)/NPROMA+1
    DO J=1,NVA2D
      DO I=1,ICEND
        ZGP2(I,J,IBL) = ZGP2(I,J,IBL) + PGP2(I,J,IBL)
      ENDDO
    ENDDO
  ENDDO

  PGP2(:,:,:) = 0.0_JPRB

ENDIF


CALL GSTATS(1049,0)
!$OMP PARALLEL DO SCHEDULE(DYNAMIC,1) PRIVATE(JKGLO,ICEND,IBL,IOFF)
DO JKGLO=1,IGPTOT,NPROMA
  ICEND=MIN(NPROMA,IGPTOT-JKGLO+1)
  IBL=(JKGLO-1)/NPROMA+1
  IOFF=JKGLO

!*       1. TRANSFORM TO CONTROL VARIABLE
!*          -----------------------------

!*       1.1 Division by forecast errors and vertical coordinate transform

  IF (CDSELECT == 'G') THEN
    IF (LELAM) THEN
!     CALL ABOR1('CVARGPAD:HUMIDITY ANALYSIS CHANGE - CONTACT E. HOLM')
      CALL EJGNRGGAD(ICEND,JKGLO,GVARGP(IOFF),&
       & ZGP3(1,IVOR,IBL),ZGP3(1,IDIV,IBL),ZGP3(1,IT,IBL),&
       & ZGP3(1,IQ,IBL),ZGP2(1,ISP,IBL))
    ELSE
      CALL JGNRAD(ICEND,JKGLO,ZGP3(1,1,IBL),ZGP2(1,1,IBL))
    ENDIF
    IF (L_JBVCOORD) THEN
      CALL JBVCOORD_INTERPOLATE_AD('N',ICEND,JKGLO,ZGP3(1,1,IBL),ZGP2(1,1,IBL))
    ENDIF
!*       2. TRANSFORM BACK FROM CONTROL VARIABLE
!*          ------------------------------------

!*       2.1 Multiplication by forecast errors and vertical coordinate transform

  ELSEIF (CDSELECT == 'X') THEN
    IF (L_JBVCOORD) THEN
      CALL JBVCOORD_INTERPOLATE_AD('M',ICEND,JKGLO,ZGP3(1,1,IBL),ZGP2(1,1,IBL))
    ENDIF
    IF (LELAM) THEN
!     CALL ABOR1('CVARGPAD:ONLY WORKS IF LTRAJGP=.T.')
      CALL EJGNRGGIAD(ICEND,JKGLO,GVARGP(IOFF),&
       & ZGP3(1,IVOR,IBL),ZGP3(1,IDIV,IBL),ZGP3(1,IT,IBL),&
       & ZGP3(1,IQ,IBL),ZGP2(1,ISP,IBL))
    ELSE
      CALL JGNRIAD(ICEND,JKGLO,ZGP3(1,1,IBL),ZGP2(1,1,IBL))
    ENDIF

  ELSE
    WRITE (NULOUT,*) 'CVARGPAD: INVALID VALUE FOR CDSELECT: ',CDSELECT
    CALL ABOR1 ('CVARGPAD: INVALID VALUE FOR CDSELECT')
  ENDIF

ENDDO
!$OMP END PARALLEL DO

!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(J)
DO J=1,SIZE(PSP3,2)
  PSP3(:,J,:)=0.0_JPRB
ENDDO
!$OMP END PARALLEL DO
CALL GSTATS(1049,1)
ZSP2(:,:)  =0.0_JPRB

IF (LELAM) THEN
  CALL ETRANSINV_JBAD(KSCALE, PSP3, ZSP2, PSP1, ZGP3, ZGP2)
ELSE
  CALL TRANSINV_WAVELETAD (KSCALE, PSP3, ZSP2, ZGP3, ZGP2)
ENDIF

IF (NPSP==1) PSP2(:,:)=ZSP2(:,:)

DEALLOCATE (ZGP2)
DEALLOCATE (ZGP3)


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