SUBROUTINE GATHERGPF_WAVELET(PLOCGP,PGLOBGP,KFLDS,KROOT,YDGRID_DEFINITION)

!**** *GATHERGPF_WAVELET* - Gather global gridpoint fields for a set of wavelet scales

!     Purpose.
!     --------
!     Gather global gridpoint fields for a set of wavelet scales

!**   Interface.
!     ----------
!        *CALL* *GATHERGPF_WAVELET*(...)

!        Explicit arguments : PLOCGP - local gridpoint fields
!        -------------------- PGLOBGP global gridpoint fields (on KROOT)
!                             KFLDS - number of fields
!                             KROOT - master process
!                             YDGRID_DEFINITION

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

!     Method.
!     -------
!        See documentation

!     Externals.    - MPL_GATHERV
!                     MPL_ALLGATHERV 

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

!     Author.
!     -------
!        Mike Fisher  *ECMWF* (Based closely on GATHERGPF)

!     Modifications.
!     --------------
!       Original : 12-03-2004

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

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMCT0   , ONLY : NPROC    ,N_REGIONS   ,N_REGIONS_NS   ,N_REGIONS_EW
USE YOMMP    , ONLY : MYPROC,&
 & NSTA     ,NONL    ,NPTRFRSTLAT, NFRSTLAT ,NLSTLAT  
USE YOMGEM   , ONLY : NLOENG   ,NGPTOT, NGPTOTG, NGPTOTL
USE MPL_MODULE, ONLY : MPL_ALLGATHERV, MPL_GATHERV
USE YOMWAVELET, ONLY : WAVELET_GRID_STRUCT

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KFLDS 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLOCGP(:)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PGLOBGP(:,:) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KROOT 
TYPE(WAVELET_GRID_STRUCT), INTENT(IN) :: YDGRID_DEFINITION(:)

REAL(KIND=JPRB), ALLOCATABLE :: ZRECVBUF(:)
 
INTEGER(KIND=JPIM) :: IRECVCOUNTS(NPROC),IOFFPROC(NPROC+1),IOFFSCALEL(N_REGIONS_NS,N_REGIONS_EW)
INTEGER(KIND=JPIM) :: JROC,JFLD,JA,JB,JROF,JGL,JLON,JSCALE
INTEGER(KIND=JPIM) :: IA,IB,IDUM1,IDUM2,IGLOFF,IGL1,IGL2,IOFF,ILAST
INTEGER(KIND=JPIM) :: ILEN,ILOFF,IOFFR,IOFFSCALE

INTEGER(KIND=JPIM) :: IOFFSCALEX(SIZE(YDGRID_DEFINITION))
INTEGER(KIND=JPIM) :: IOFFSCALELX(N_REGIONS_NS,N_REGIONS_EW,SIZE(YDGRID_DEFINITION))

INTEGER(KIND=JPIM) :: II,JJ,IPROC
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "pe2set.intfb.h"
#include "set2pe.intfb.h"

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

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

ALLOCATE (ZRECVBUF(SUM(YDGRID_DEFINITION(:)%NGPTOTG)*KFLDS))

IF(NPROC > 1) THEN

! Prepare for message passing

  IOFFPROC(1) = 0
  DO JROC=1,NPROC
    CALL PE2SET(JROC,IA,IB,IDUM1,IDUM2)
    IRECVCOUNTS(JROC)=0
    DO JSCALE=1,SIZE(YDGRID_DEFINITION)
      IRECVCOUNTS(JROC)= IRECVCOUNTS(JROC) + YDGRID_DEFINITION(JSCALE)%NGPTOTL(IA,IB)*KFLDS
    ENDDO
    IOFFPROC(JROC+1) = IOFFPROC(JROC)+IRECVCOUNTS(JROC)
  ENDDO
  
! Gather field
  CALL GSTATS(604,0)
  IF(KROOT == -1) THEN
    CALL MPL_ALLGATHERV(PLOCGP,&
     & PRECVBUF=ZRECVBUF,KRECVCOUNTS=IRECVCOUNTS, &
     & CDSTRING='GATHERGPF_WAVELET')  
  ELSE
    CALL MPL_GATHERV(PLOCGP,KROOT=KROOT,&
     & PRECVBUF=ZRECVBUF,KRECVCOUNTS=IRECVCOUNTS, &
     & CDSTRING='GATHERGPF_WAVELET')  
  ENDIF
  CALL GSTATS(604,1)

! Unpack recieve buffer

  IF(KROOT == -1 .OR. MYPROC == KROOT) THEN
    CALL GSTATS(1428,0)
    IOFFSCALE=0
    IOFFSCALEL(:,:)=0
    DO JSCALE=1,SIZE(YDGRID_DEFINITION)
      IOFFSCALEX(JSCALE)=IOFFSCALE
      IOFFSCALELX(:,:,JSCALE)=IOFFSCALEL(:,:)
      IOFFSCALE=IOFFSCALE+YDGRID_DEFINITION(JSCALE)%NGPTOTG
      IOFFSCALEL(:,:) = IOFFSCALEL(:,:) + YDGRID_DEFINITION(JSCALE)%NGPTOTL(:,:)
    ENDDO
!$OMP PARALLEL DO SCHEDULE(STATIC)&
!$OMP&PRIVATE(JA,JB,IPROC,JFLD,JSCALE,IGLOFF,IGL1,IGL2,IOFF,ILAST,JJ,&
!$OMP&ILEN,ILOFF,IOFFR,JGL,JLON)
    DO JA=1,N_REGIONS_NS
      DO JB=1,N_REGIONS(JA)
        CALL SET2PE(IPROC,JA,JB,0,0)
        DO JFLD=1,KFLDS
          DO JSCALE=1,SIZE(YDGRID_DEFINITION)
            IGLOFF = YDGRID_DEFINITION(JSCALE)%NPTRFRSTLAT(JA)
            IGL1 = YDGRID_DEFINITION(JSCALE)%NFRSTLAT(JA)
            IGL2 = YDGRID_DEFINITION(JSCALE)%NLSTLAT(JA)
            IOFF = 0
            IF(JA > 1) THEN
              IF( YDGRID_DEFINITION(JSCALE)%NLSTLAT(JA-1) == &
                & YDGRID_DEFINITION(JSCALE)%NFRSTLAT(JA)      )THEN
                ILAST = YDGRID_DEFINITION(JSCALE)%NLSTLAT(JA-1)-1
              ELSE
                ILAST = YDGRID_DEFINITION(JSCALE)%NLSTLAT(JA-1)
              ENDIF
              DO JJ=YDGRID_DEFINITION(JSCALE)%NFRSTLAT(1),ILAST
                IOFF = IOFF+YDGRID_DEFINITION(JSCALE)%NLOENG(JJ)
              ENDDO
            ENDIF
            ILEN = 0
            ILOFF = 0
            IOFFR = IOFFPROC(IPROC)+(JFLD-1)*YDGRID_DEFINITION(JSCALE)%NGPTOTL(JA,JB)
            DO JGL=IGL1,IGL2
              DO JLON=1,YDGRID_DEFINITION(JSCALE)%NONL(IGLOFF+JGL-IGL1,JB)
                PGLOBGP( IOFF+ILOFF+YDGRID_DEFINITION(JSCALE)%NSTA(IGLOFF+JGL-IGL1,JB) &
                        & +JLON-1+IOFFSCALEX(JSCALE),JFLD) &
                 & = ZRECVBUF(IOFFR+ILEN+JLON+IOFFSCALELX(JA,JB,JSCALE))  
              ENDDO
              ILEN = ILEN + YDGRID_DEFINITION(JSCALE)%NONL(IGLOFF+JGL-IGL1,JB)
              ILOFF = ILOFF + YDGRID_DEFINITION(JSCALE)%NLOENG(JGL)
            ENDDO
          ENDDO
        ENDDO
      ENDDO
    ENDDO
!$OMP END PARALLEL DO
    CALL GSTATS(1428,1)
  ENDIF

ELSE ! If only one PE copy

  CALL GSTATS(1428,0)
  IOFFSCALE=0
  DO JSCALE=1,SIZE(YDGRID_DEFINITION)
    DO JFLD=1,KFLDS
!$OMP PARALLEL DO SCHEDULE(STATIC,1) PRIVATE(JROF,II)
     DO JROF=1,YDGRID_DEFINITION(JSCALE)%NGPTOT
        II=YDGRID_DEFINITION(JSCALE)%NGPTOT*(JFLD-1)+JROF
        PGLOBGP(JROF+IOFFSCALE,JFLD) = PLOCGP(II+IOFFSCALE)
      ENDDO
!$OMP END PARALLEL DO
    ENDDO
    IOFFSCALE=IOFFSCALE+YDGRID_DEFINITION(JSCALE)%NGPTOT
  ENDDO
  CALL GSTATS(1428,1)
ENDIF

DEALLOCATE (ZRECVBUF)
IF (LHOOK) CALL DR_HOOK('GATHERGPF_WAVELET',1,ZHOOK_HANDLE)

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

END SUBROUTINE GATHERGPF_WAVELET
