SUBROUTINE DISGRIDFP(KMTAGDISTGP,KNFG,KDIMGP,KGPL,KGPLX,KNFL, &
 & KGPIND,KGPD,KNFD,KFLDOFF,PREALG,PREALL)

!**** *DISGRIDFP* - Routine to send and receive all distributed output 
!                  grid point fields for FULL-POS fields

!     Purpose.
!     --------
!       To transpose a field-distributed set of global gridpoint fields to 
!       a gridpoint-distributed set of fields.

!**   Interface.
!     ----------
!        *CALL* *DISGRIDFP*

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

!        * INPUT:
!        KMTAGDISTGP: tag for processor communication.
!        KNFG   : global number of fields
!        KDIMGP : first dimension of PREALG (over-dimensioning for gridpoints)
!        KGPL   : number of gridpoints on the processor at output distribution
!        KGPLX  : maximum number of gridpoints (taken among all processors)
!        KNFL   : number of local fields on output distribution
!        KGPIND : KGPIND(i,j)=k mean: i-th gridpoint on j-th processor is k-th
!                 global gp 
!        KGPD   : number of gridpoints on each processor
!        KNFD   : number of fields on output distribution for each processor
!        KFLDOFF: offset to the first local field for each processor
!        PREALG : field-distributed gridpoints

!        * OUTPUT:
!        PREALL : gridpoint-distributed fields

!        Implicit arguments :
!        --------------------
!           See modules above.

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

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

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

!     Author.
!     -------
!       G. Radnoti

!     Modifications.
!     --------------
!        Original : 98-10
!        R. El Khatib 99-02-16 Symetry with DIWRGRFP
!        D.Dent     : 00-09-01  MPE to MPL conversion
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        K.Yessad   : 31-Jan-2007: cleaning, tag becomes dummy argument.
!     -------------------------------------------------------------------------

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

USE YOMMP    , ONLY : MYPROC   ,NPRCIDS
USE YOMCT0   , ONLY : NPROC
USE MPL_MODULE

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

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KMTAGDISTGP
INTEGER(KIND=JPIM),INTENT(IN)    :: KNFG 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDIMGP 
INTEGER(KIND=JPIM),INTENT(IN)    :: KGPL 
INTEGER(KIND=JPIM),INTENT(IN)    :: KGPLX 
INTEGER(KIND=JPIM),INTENT(IN)    :: KNFL 
INTEGER(KIND=JPIM),INTENT(IN)    :: KGPIND(KGPLX,NPROC) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KGPD(NPROC) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KNFD(NPROC) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFLDOFF(NPROC) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PREALG(KDIMGP,KNFL)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PREALL(KGPL,KNFG)

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

!     LLWAITRECV : .TRUE. if I wait for a message from processor JROC 
!     LLGDONE    : .TRUE. when all messages have been received.
!     ZBUF       : message
!     LLEXIST    : .TRUE. if the requested message is available
!     LLWAIT     : .FALSE. in order not to wait until the requested message is available

REAL(KIND=JPRB), ALLOCATABLE :: ZBUF(:)

LOGICAL :: LLEXIST, LLGDONE, LLWAIT, LLWAITRECV(NPROC)

INTEGER(KIND=JPIM) :: I, IFLD, ILEN, ILENB, IRCV, ITAG, JFLD, JJ, JROC  

REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "abor1.intfb.h"

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

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

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

!*     1. PREPARATIONS
!         ------------

IF (KNFL /= KNFD(MYPROC)) THEN
  CALL ABOR1('DISGRIDFP : INTERNAL ERROR KNFL/KNFD')
ENDIF
IF (KGPL /= KGPD(MYPROC)) THEN
  CALL ABOR1('DISGRIDFP : INTERNAL ERROR KGPL/KGPD')
ENDIF
IF (KGPLX < MAXVAL(KGPD)) THEN
  CALL ABOR1('DISGRIDFP : INTERNAL ERROR KGPLX/KGPD')
ENDIF

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

!*     2. LOOP TO SEND FIELD-DISTRIBUTED GRIDPOINTS 
!         -----------------------------------------

IF (KNFL > 0) THEN
  ALLOCATE(ZBUF(KGPLX*KNFL))
  DO JROC = 1, NPROC
    IF (KGPD(JROC) > 0) THEN
      IF (JROC == MYPROC) THEN
        ! local contribution to PREALL : 
        DO JFLD=1,KNFL
          IFLD=KFLDOFF(MYPROC)+JFLD
          DO JJ=1,KGPL
            PREALL(JJ,IFLD)=PREALG(KGPIND(JJ,JROC),JFLD)
          ENDDO
        ENDDO
      ELSE
        ! Send the chunk of fields :                          
        DO JFLD=1,KNFL
          DO JJ=1,KGPD(JROC)
            I=JJ+KGPD(JROC)*(JFLD-1)
            ZBUF(I)=PREALG(KGPIND(JJ,JROC),JFLD)
          ENDDO
        ENDDO
        ITAG = KMTAGDISTGP + MYPROC
        ILEN=KGPD(JROC)*KNFL
        CALL MPL_SEND(ZBUF(1:ILEN),KDEST=NPRCIDS(JROC),KTAG=ITAG, &
         & CDSTRING='DISGRIDFP:')  
      ENDIF
    ENDIF
  ENDDO
  DEALLOCATE(ZBUF)
ENDIF

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

!*     3. LOOP TO RECEIVE GRIDPOINT-DISTRIBUTED FIELDS 
!         --------------------------------------------

IF (KGPL > 0) THEN
  ALLOCATE(ZBUF(KGPL*MAXVAL(KNFD)))
  LLWAITRECV(:)=.TRUE.
  LLWAITRECV(MYPROC)=.FALSE.
  LLGDONE= .FALSE.
  LLWAIT = .FALSE.
  DO WHILE (.NOT.LLGDONE)
    LLGDONE=.TRUE.
    DO JROC = 1, NPROC
      IF (KNFD(JROC) > 0.AND.LLWAITRECV(JROC)) THEN
        IRCV = JROC
        ITAG = KMTAGDISTGP + IRCV
        ILENB=KGPL*KNFD(JROC)
        CALL MPL_PROBE(KSOURCE=IRCV,KTAG=ITAG,LDWAIT=LLWAIT,LDFLAG=LLEXIST, &
         & CDSTRING='DISGRIDFP:')  
        IF (LLEXIST) THEN
          CALL MPL_RECV(ZBUF(1:ILENB),KSOURCE=NPRCIDS(IRCV),KTAG=ITAG, &
           & CDSTRING='DISGRIDFP:')  
          LLWAITRECV(JROC)=.FALSE.
          DO JFLD=1,KNFD(JROC)
            IFLD=KFLDOFF(JROC)+JFLD
            DO JJ=1,KGPL
              I=JJ+KGPL*(JFLD-1)
              PREALL(JJ,IFLD)=ZBUF(I)
            ENDDO
          ENDDO
        ELSE
          LLGDONE=.FALSE.
        ENDIF
      ENDIF
    ENDDO
  ENDDO
  DEALLOCATE(ZBUF)
ENDIF

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

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