SUBROUTINE DIWRGRID(KIOPROC,KNUM,KIND,KDIM,PREAL)

!**** *DIWRGRID*  - SEND OR RECEIVE GRID-POINT DATA (OUTPUT)

!     Purpose.
!     --------
!           ARPEGE file.

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

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

!        Implicit arguments :
!        --------------------
!        The grid point fields of the model.

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

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

!     Author.
!     -------
!        MPP Group *METEO-FRANCE*

!     Modifications.
!     --------------
!        Modified : 97-12-08 R. El Khatib NPRINTLEV
!        Modified : 98-03-13 VALPARAISO team
!        Modified 98-08-10 by K. YESSAD: removal of LRPOLE option.
!          - PREAL does not contain polar values any longer, and non polar
!            values are stored from its element 1 in all cases.
!          - removal of dummy argument LDWRMO.
!        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 YOMMP    , ONLY : MYPROC   ,NSTA     ,NONL     ,&
 & NPTRFRSTLAT,NFRSTLAT ,NLSTLAT  ,NPRCIDS ,NGPSET2PE
USE YOMTAG   , ONLY : MTAGDISTGP
USE YOMGEM   , ONLY : NLOENG   ,NGPTOT   ,NGPTOTG  ,NGPTOTMX
USE YOMCT0   , ONLY : N_REGIONS ,N_REGIONS_NS ,NPRINTLEV
USE MPL_MODULE

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KDIM 
INTEGER(KIND=JPIM),INTENT(IN)    :: KIOPROC 
INTEGER(KIND=JPIM),INTENT(IN)    :: KNUM 
INTEGER(KIND=JPIM),INTENT(IN)    :: KIND 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PREAL(KDIM)
REAL(KIND=JPRB) :: ZREALTOT(NGPTOTG)
REAL(KIND=JPRB) :: ZFLD(NGPTOTMX)

INTEGER(KIND=JPIM) ::  IGL1, IGL2, IGLOFF, ILAST, ILEN, ILENB, ILOFF, IOFF, IRCV, ISENDER, ITAG, &
 & ITAGR, J, JA, JB, JGL, JLON  
REAL(KIND=JPRB) :: ZHOOK_HANDLE


IF (LHOOK) CALL DR_HOOK('DIWRGRID',0,ZHOOK_HANDLE)
IF (KIND == 0) THEN

!     send fields to output node  :  KIOPROC

  IF (NGPTOT > 0) THEN
    ILEN=NGPTOT
    ITAG=MTAGDISTGP
    IF(KIOPROC /= MYPROC)THEN
      CALL MPL_SEND(PREAL(1:ILEN),KDEST=NPRCIDS(KIOPROC),KTAG=ITAG, &
       & CDSTRING='DIWRGRID:')  
      IF (NPRINTLEV == 2) THEN
        WRITE(NULOUT,*) 'DIWRGRID : send gridpoint field',&
         & ' num ',KNUM,' from ',MYPROC,' to ',KIOPROC,&
         & ' with tag ',ITAG  
      ENDIF
    ENDIF
  ENDIF
ENDIF

IF (KIND == 1) THEN

!     KIOPROC receives gridpoint field

  DO JA=1,N_REGIONS_NS
    DO JB=1,N_REGIONS(JA)
      IRCV=NGPSET2PE(JA,JB)
      ITAG=MTAGDISTGP
      ILENB=NGPTOTMX
      IF (IRCV /= KIOPROC) THEN
        CALL MPL_RECV(ZFLD(1:ILENB),KSOURCE=NPRCIDS(IRCV),KTAG=ITAG, &
         & KFROM=ISENDER,KRECVTAG=ITAGR,CDSTRING='DIWRGRID:')  
        IF (NPRINTLEV == 2) THEN
          WRITE(NULOUT,*) 'DIWRGRID : recv gridpoint field',&
           & ' num ',KNUM,' from ',ISENDER,' to ',KIOPROC,&
           & ' with tag ',ITAGR  
        ENDIF
      ELSE
        DO J=1,NGPTOT
          ZFLD(J)=PREAL(J)
        ENDDO
      ENDIF

      IGLOFF=NPTRFRSTLAT(JA)
      IGL1  = NFRSTLAT(JA)
      IGL2  = NLSTLAT(JA)
      IOFF=0
      IF (JA > 1) THEN
        IF (NLSTLAT(JA-1) == NFRSTLAT(JA)) THEN
          ILAST=NLSTLAT(JA-1)-1
        ELSE
          ILAST=NLSTLAT(JA-1)
        ENDIF
        DO J=NFRSTLAT(1),ILAST
          IOFF=IOFF+NLOENG(J)
        ENDDO
      ENDIF
      ILEN=0
      ILOFF=0
      DO JGL=IGL1,IGL2
        DO JLON=1,NONL(IGLOFF+JGL-IGL1,JB)
          ZREALTOT(IOFF+ILOFF+NSTA(IGLOFF+JGL-IGL1,JB)+JLON-1)=&
           & ZFLD(ILEN+JLON)  
        ENDDO
        ILEN=ILEN+NONL(IGLOFF+JGL-IGL1,JB)
        ILOFF=ILOFF + NLOENG(JGL)
      ENDDO
    ENDDO
  ENDDO

  PREAL(1:NGPTOTG)=ZREALTOT(1:NGPTOTG)

ENDIF

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