SUBROUTINE DISFOU(KNMAX,KDGLL,KDGLG,KDGLMX,KNUMF,KIND,&
 & KMTAGDISTFO,KNUM,KIOPROC,KDIM,PFO)  

!**** *DISFOU*  - SEND OR RECEIVE FOURIER SPACE DATA (INPUT)

!     Purpose.
!     --------
!       Dispatches DM-local Fourier space data of truncation KNMAX
!        and DM-local latitudes 1 to KDGLL. The DM-global array
!        to be read has truncation KNMAX and latitudes 1 to KDGLG.
!        All wave numbers 0 to KNMAX are communicated even if zero
!        (reduced grid is currently not taken in account for simplification).
!       One call of MPL_SEND and MPL_RECV communicates the KNUMF fields.

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

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

!        INPUT:
!          KNMAX        - truncation. 
!          KDGLL        - DM-local number of latitudes which are treated
!                         in slow Fourier transforms by the current proc.
!          KDGLG        - DM-global number of latitudes.
!          KDGLMX       - is above or equal to the max of KDGLL on all procs. 
!          KNUMF        - number of fields.
!          KIND         - 0: send data; 1: receive data.
!          KMTAGDISTFO  - 'tag' number.
!          KNUM         - index of field.
!          KIOPROC      - processor which dispatches data.
!          KDIM         - dimension of PFO: is > or = KDGLG*(2*KNMAX+1)*KNUMF

!        INPUT/OUTPUT:
!          PFO          - field to be communicated.
!                         as input: the DM-global field.
!                         as output: the DM-local field of the current proc.

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

!     Externals.
!     ----------
!       Calls MPL_SEND, MPL_RECV. 

!     Reference.
!     ----------

!     Author.
!     -------
!        K. YESSAD (CNRM/GMAP), written after DISGRID. 

!     Modifications.
!     --------------
!        Original : FEB 1999
!        Modified by G> Radnoti 99/11/07  ALADIN geometry
!        Modified: 00-09-01 by D.Dent : MPE to MPL conversion
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!     ------------------------------------------------------------------

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

USE YOMLUN   , ONLY : NULOUT
USE YOMCT0   , ONLY : NPROC    ,NPRINTLEV ,N_REGIONS ,N_REGIONS_NS
USE YOMMP    , ONLY : MYPROC   ,NFRSTLAT ,NLSTLAT  ,NPRCIDS ,NGPSET2PE
USE YOMDIM   , ONLY : NDGUNG   ,NDGUXG
USE MPL_MODULE

IMPLICIT NONE

! * DUMMY:
INTEGER(KIND=JPIM),INTENT(IN)    :: KDIM 
INTEGER(KIND=JPIM),INTENT(IN)    :: KNMAX 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDGLL 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDGLG 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDGLMX
INTEGER(KIND=JPIM),INTENT(IN)    :: KNUMF 
INTEGER(KIND=JPIM),INTENT(IN)    :: KIND 
INTEGER(KIND=JPIM),INTENT(IN)    :: KMTAGDISTFO 
INTEGER(KIND=JPIM),INTENT(IN)    :: KNUM 
INTEGER(KIND=JPIM),INTENT(IN)    :: KIOPROC 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PFO(KDIM) 
INTEGER(KIND=JPIM) :: IFOTOT
INTEGER(KIND=JPIM) :: IFOTOTG
INTEGER(KIND=JPIM) :: IGL1
INTEGER(KIND=JPIM) :: IGL2
INTEGER(KIND=JPIM) :: ILAST
INTEGER(KIND=JPIM) :: ILEN
INTEGER(KIND=JPIM) :: IOFF
INTEGER(KIND=JPIM) :: ISND
INTEGER(KIND=JPIM) :: ITAG
INTEGER(KIND=JPIM) :: ISENDER
INTEGER(KIND=JPIM) :: ILENR
INTEGER(KIND=JPIM) :: ITAGR
INTEGER(KIND=JPIM) :: JA
INTEGER(KIND=JPIM) :: JB
REAL(KIND=JPRB) :: ZFLD(KDGLMX*(2*KNMAX+1)*KNUMF)
REAL(KIND=JPRB) :: ZHOOK_HANDLE


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

!*  0. PRELIMINARY INITIALISATIONS.
!   -------------------------------

IF (LHOOK) CALL DR_HOOK('DISFOU',0,ZHOOK_HANDLE)
IFOTOT=KDGLL*(2*KNMAX+1)
IFOTOTG=KDGLG*(2*KNMAX+1)

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

!*  1. SENDS DM-LOCAL FIELDS FROM 'KIOPROC' TO THE OTHER NODES.
!   -----------------------------------------------------------

IF (KIND == 0) THEN

  DO JA=1,N_REGIONS_NS
    DO JB=1,N_REGIONS(JA)

      IGL1=MAX(NDGUNG,NFRSTLAT(JA))
      IGL2=MIN(NDGUXG,NLSTLAT(JA))
      IF (JA > 1) THEN
        IF ( NLSTLAT(JA-1) == NFRSTLAT(JA) ) THEN
          ILAST=NLSTLAT(JA-1)-1
        ELSE
          ILAST=NLSTLAT(JA-1)
        ENDIF
        IOFF=(ILAST+1-NFRSTLAT(1))*(1+2*KNMAX)*KNUMF
      ELSE
        IOFF=0
      ENDIF
      ILEN=(IGL2+1-IGL1)*(1+2*KNMAX)*KNUMF
      ZFLD(1:ILEN)=PFO(IOFF+1:IOFF+ILEN)

      IF (ILEN > 0) THEN
        ISND=NGPSET2PE(JA,JB)
        ITAG=KMTAGDISTFO+KNUM*NPROC+ISND
        IF (ISND /= MYPROC) THEN
          CALL MPL_SEND(ZFLD(1:ILEN),KDEST=NPRCIDS(ISND),KTAG=ITAG, &
           & CDSTRING='DISFOU:')  
          IF (NPRINTLEV == 2) THEN
            WRITE(NULOUT,*) 'DISFOU : send Fourier space field', &
             & ' num ',KNUM,' to ',ISND,' with tag ',ITAG  
          ENDIF
        ELSE
          PFO(1:IFOTOT*KNUMF)=ZFLD(1:IFOTOT*KNUMF)
        ENDIF
      ENDIF

    ENDDO
  ENDDO

ENDIF

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

!*  2. RECEIVES DM-LOCAL FIELDS FROM NODE 'KIOPROC'.
!   ------------------------------------------------

IF (KIND == 1) THEN

  IF (IFOTOT > 0) THEN
    ILEN=IFOTOT*KNUMF
    ITAG=KMTAGDISTFO+KNUM*NPROC+MYPROC
    IF( NPROC > 1 )THEN
      CALL MPL_RECV(PFO(1:ILEN),KSOURCE=NPRCIDS(KIOPROC),KTAG=ITAG, &
       & KOUNT=ILENR,KFROM=ISENDER,KRECVTAG=ITAGR,CDSTRING='DISFOU:')  
      IF (NPRINTLEV == 2) THEN
        WRITE(NULOUT,*) 'DISFOU : recv Fourier space field', &
         & ' num ',KNUM,' from ',ISENDER,' with tag ',ITAGR  
      ENDIF
    ENDIF
  ENDIF

ENDIF

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

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