get_halo.f90

!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! Modifications:
!  P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
!  P. Wautelet 18/07/2019: add optional dummy argument with name of the field
!-----------------------------------------------------------------
!     ####################
      MODULE MODI_GET_HALO
!     ####################
!
INTERFACE
   SUBROUTINE GET_HALO2(PSRC, TP_PSRC_HALO2_ll, HNAME)
     !
     USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
     !
     IMPLICIT NONE
     !
     REAL, DIMENSION(:,:,:), INTENT(IN)  :: PSRC    ! variable at t
     TYPE(HALO2LIST_ll), POINTER         :: TP_PSRC_HALO2_ll          ! halo2 for SRC
     character(len=*), optional, intent(in) :: HNAME ! Name of the field to be added
     !
   END SUBROUTINE GET_HALO2
END INTERFACE
!
INTERFACE 
   SUBROUTINE GET_HALO(PSRC, HDIR, HNAME)
     IMPLICIT NONE
     !
     REAL, DIMENSION(:,:,:), INTENT(IN)  :: PSRC    ! variable at t
     CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
     character(len=*), optional, intent(in) :: HNAME ! Name of the field to be added
     !
   END SUBROUTINE GET_HALO
END INTERFACE
! 
#ifdef MNH_OPENACC
INTERFACE
   SUBROUTINE GET_HALO2_D(PSRC, TP_PSRC_HALO2_ll, HNAME)
     !
     USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
     !
     IMPLICIT NONE
     !
     REAL, DIMENSION(:,:,:), INTENT(INOUT)  :: PSRC    ! variable at t
     TYPE(HALO2LIST_ll), POINTER         :: TP_PSRC_HALO2_ll          ! halo2 for SRC
     character(len=*), optional, intent(in) :: HNAME ! Name of the field to be added
     !
   END SUBROUTINE GET_HALO2_D
END INTERFACE
INTERFACE
   SUBROUTINE GET_HALO2_DD(PSRC, TP_PSRC_HALO2_ll, HNAME)
     !
     USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
     !
     IMPLICIT NONE
     !
     REAL, DIMENSION(:,:,:), INTENT(INOUT)  :: PSRC    ! variable at t
     TYPE(HALO2LIST_ll), POINTER         :: TP_PSRC_HALO2_ll          ! halo2 for SRC
     character(len=*), optional, intent(in) :: HNAME ! Name of the field to be added
     !
   END SUBROUTINE GET_HALO2_DD
END INTERFACE
INTERFACE
   SUBROUTINE GET_HALO2_DF(PSRC, TP_PSRC_HALO2_ll, HNAME)
     !
     USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
     !
     IMPLICIT NONE
     !
     REAL, DIMENSION(:,:,:), INTENT(INOUT)  :: PSRC    ! variable at t
     TYPE(HALO2LIST_ll), POINTER         :: TP_PSRC_HALO2_ll          ! halo2 for SRC
     character(len=*), optional, intent(in) :: HNAME ! Name of the field to be added
     !
   END SUBROUTINE GET_HALO2_DF
END INTERFACE
INTERFACE
   SUBROUTINE GET_HALO_D(PSRC, HDIR, HNAME)
     IMPLICIT NONE
     !
     REAL, DIMENSION(:,:,:), INTENT(INOUT)   :: PSRC    ! variable at t
     CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
     character(len=*), optional, intent(in) :: HNAME ! Name of the field to be added
     !
   END SUBROUTINE GET_HALO_D
END INTERFACE
!
INTERFACE
   SUBROUTINE GET_HALO_START_D(PSRC,KNB_REQ,KREQ,&
     PZNORTH_IN , PZSOUTH_IN , PZWEST_IN , PZEAST_IN , &
     PZNORTH_OUT, PZSOUTH_OUT, PZWEST_OUT, PZEAST_OUT, &
     KIIB,KIIE,KIJB,KIJE,KIIU,KIJU,KIKU,KIHALO_1,&
     HDIR)
     
     IMPLICIT NONE
     !
     REAL, DIMENSION(KIIU,KIJU,KIKU), INTENT(INOUT) :: PSRC    ! variable at t
     ! acc declare present (PSRC)
     INTEGER                               :: KNB_REQ ,  KREQ(8)
     REAL            :: PZSOUTH_IN ( KIIB:KIIE   , KIJB:KIJB+KIHALO_1   , KIKU ) ,&
                        PZNORTH_IN ( KIIB:KIIE   , KIJE-KIHALO_1:KIJE   , KIKU ) ,&
                        PZWEST_IN  ( KIIB:KIIB+KIHALO_1   , KIJB:KIJE   , KIKU ) ,&
                        PZEAST_IN  ( KIIE-KIHALO_1:KIIE   , KIJB:KIJE   , KIKU ) ,&
       !
                        PZSOUTH_OUT (   KIIB:KIIE   , 1:KIJB-1 , KIKU ) ,&
                        PZNORTH_OUT (   KIIB:KIIE   , KIJE+1:KIJU , KIKU ) ,&
                        PZWEST_OUT  ( 1:KIIB-1 ,   KIJB:KIJE   , KIKU ) ,&
                        PZEAST_OUT  ( KIIE+1:KIIU ,   KIJB:KIJE   , KIKU ) 
     INTEGER         :: KIIB,KIIE,KIJB,KIJE,KIIU,KIJU,KIKU,KIHALO_1
     CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
     !
   END SUBROUTINE GET_HALO_START_D
END INTERFACE
INTERFACE
   SUBROUTINE GET_HALO_STOP_D(PSRC,KNB_REQ,KREQ,&
     PZNORTH_OUT, PZSOUTH_OUT, PZWEST_OUT, PZEAST_OUT, &
     KIIB,KIIE,KIJB,KIJE,KIIU,KIJU,KIKU,&
     HDIR)
     
     IMPLICIT NONE
     !
     REAL, DIMENSION(KIIU,KIJU,KIKU), INTENT(INOUT) :: PSRC    ! variable at t
     ! acc declare present (PSRC)
     INTEGER                               :: KNB_REQ ,  KREQ(8)
     REAL            :: PZSOUTH_OUT (   KIIB:KIIE   , 1:KIJB-1 , KIKU ) ,&
                        PZNORTH_OUT (   KIIB:KIIE   , KIJE+1:KIJU , KIKU ) ,&
                        PZWEST_OUT  ( 1:KIIB-1 ,   KIJB:KIJE   , KIKU ) ,&
                        PZEAST_OUT  ( KIIE+1:KIIU ,   KIJB:KIJE   , KIKU ) 
     INTEGER         :: KIIB,KIIE,KIJB,KIJE,KIIU,KIJU,KIKU
     CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
     !
   END SUBROUTINE GET_HALO_STOP_D
END INTERFACE
INTERFACE
   SUBROUTINE GET_HALO_DD(PSRC, HDIR, HNAME)
     IMPLICIT NONE
     !
     REAL, DIMENSION(:,:,:), INTENT(INOUT)   :: PSRC    ! variable at t
     CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
     character(len=*), optional, intent(in) :: HNAME ! Name of the field to be added
     !
   END SUBROUTINE GET_HALO_DD
END INTERFACE
INTERFACE
   SUBROUTINE GET_HALO_DDC(PSRC, HDIR, HNAME)
     IMPLICIT NONE
     !
     REAL, DIMENSION(:,:,:), INTENT(INOUT)   :: PSRC    ! variable at t
     CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
     character(len=*), optional, intent(in) :: HNAME ! Name of the field to be added
     !
   END SUBROUTINE GET_HALO_DDC
END INTERFACE
INTERFACE
   SUBROUTINE GET_2D_HALO_DD(PSRC, HDIR, HNAME)
     IMPLICIT NONE
     !
     REAL, DIMENSION(:,:), INTENT(INOUT)   :: PSRC    ! variable at t
     CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
     character(len=*), optional, intent(in) :: HNAME ! Name of the field to be added
     !
   END SUBROUTINE GET_2D_HALO_DD
END INTERFACE
INTERFACE
   SUBROUTINE GET_2D_HALO_DDC(PSRC, HDIR, HNAME)
     IMPLICIT NONE
     !
     REAL, DIMENSION(:,:), INTENT(INOUT)   :: PSRC    ! variable at t
     CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
     character(len=*), optional, intent(in) :: HNAME ! Name of the field to be added
     !
   END SUBROUTINE GET_2D_HALO_DDC
END INTERFACE
#endif
!
INTERFACE
   SUBROUTINE DEL_HALO2_ll(TPHALO2LIST)
     !
     USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
     !
     IMPLICIT NONE
     !
     TYPE(HALO2LIST_ll), POINTER :: TPHALO2LIST ! list of HALO2_lls
     !
   END SUBROUTINE DEL_HALO2_ll
   !
END INTERFACE
!
END MODULE MODI_GET_HALO
!
!     ###################################################
      SUBROUTINE GET_HALO2(PSRC, TP_PSRC_HALO2_ll, HNAME)
!     ###################################################
!
USE MODE_ll
USE MODD_ARGSLIST_ll, ONLY : LIST_ll, HALO2LIST_ll
!
IMPLICIT NONE
!
REAL, DIMENSION(:,:,:), INTENT(IN)  :: PSRC    ! variable at t
TYPE(HALO2LIST_ll), POINTER         :: TP_PSRC_HALO2_ll          ! halo2 for SRC
character(len=*), optional, intent(in) :: HNAME ! Name of the field to be added
!
character(len=:), allocatable    :: yname
INTEGER                          :: IIU,IJU,IKU            ! domain sizes
TYPE(LIST_ll)     , POINTER      :: TZ_PSRC_ll               ! halo
INTEGER                          :: IERROR                 ! error return code 
!
IIU = SIZE(PSRC,1)
IJU = SIZE(PSRC,2)
IKU = SIZE(PSRC,3)

if ( present ( hname ) ) then
  yname = hname
else
  yname = 'PSRC'
end if

NULLIFY( TZ_PSRC_ll,TP_PSRC_HALO2_ll)
CALL INIT_HALO2_ll(TP_PSRC_HALO2_ll,1,IIU,IJU,IKU)
!
CALL ADD3DFIELD_ll( TZ_PSRC_ll, PSRC, 'GET_HALO2::'//trim( yname ) )
CALL UPDATE_HALO_ll(TZ_PSRC_ll,IERROR)
CALL UPDATE_HALO2_ll(TZ_PSRC_ll,TP_PSRC_HALO2_ll,IERROR)
!
!   clean local halo list
!
CALL CLEANLIST_ll(TZ_PSRC_ll)
!
END SUBROUTINE GET_HALO2
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!     ######################################
      SUBROUTINE GET_HALO(PSRC, HDIR, HNAME)
!     ######################################
!
USE MODE_ll
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
!
IMPLICIT NONE
!
REAL, DIMENSION(:,:,:), INTENT(IN)  :: PSRC    ! variable at t
CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
character(len=*), optional, intent(in) :: HNAME ! Name of the field to be added
!
character(len=:), allocatable    :: yname
TYPE(LIST_ll)     , POINTER      :: TZ_PSRC_ll               ! halo
INTEGER                          :: IERROR                 ! error return code 
!
NULLIFY( TZ_PSRC_ll)

if ( present ( hname ) ) then
  yname = hname
else
  yname = 'PSRC'
end if

CALL ADD3DFIELD_ll( TZ_PSRC_ll, PSRC, 'GET_HALO::'//trim( yname ) )
CALL UPDATE_HALO_ll(TZ_PSRC_ll,IERROR, HDIR=HDIR )
CALL CLEANLIST_ll(TZ_PSRC_ll)
!
END SUBROUTINE GET_HALO
!-----------------------------------------------------------------------
#ifdef MNH_OPENACC
MODULE MODD_HALO_D
  
  IMPLICIT NONE
  
  REAL, SAVE , ALLOCATABLE, DIMENSION(:,:,:)  :: ZNORTH_IN, ZSOUTH_IN, ZWEST_IN, ZEAST_IN
  REAL, SAVE , ALLOCATABLE, DIMENSION(:,:,:)  :: ZNORTH_OUT, ZSOUTH_OUT, ZWEST_OUT, ZEAST_OUT

  REAL, SAVE , ALLOCATABLE, DIMENSION(:,:,:)  :: ZNORTHC_IN, ZSOUTHC_IN, ZWESTC_IN, ZEASTC_IN
  REAL, SAVE , ALLOCATABLE, DIMENSION(:,:,:)  :: ZNORTHC_OUT, ZSOUTHC_OUT, ZWESTC_OUT, ZEASTC_OUT 

  REAL, SAVE , ALLOCATABLE, DIMENSION(:,:)  :: ZNORTH2_IN, ZSOUTH2_IN, ZWEST2_IN, ZEAST2_IN
  REAL, SAVE , ALLOCATABLE, DIMENSION(:,:)  :: ZNORTH2_OUT, ZSOUTH2_OUT, ZWEST2_OUT, ZEAST2_OUT

  REAL, SAVE , ALLOCATABLE, DIMENSION(:,:)  :: ZNORTH_2D_IN, ZSOUTH_2D_IN, ZWEST_2D_IN, ZEAST_2D_IN
  REAL, SAVE , ALLOCATABLE, DIMENSION(:,:)  :: ZNORTH_2D_OUT, ZSOUTH_2D_OUT, ZWEST_2D_OUT, ZEAST_2D_OUT

  REAL, SAVE , ALLOCATABLE, DIMENSION(:,:)  :: ZNORTHC_2D_IN, ZSOUTHC_2D_IN, ZWESTC_2D_IN, ZEASTC_2D_IN
  REAL, SAVE , ALLOCATABLE, DIMENSION(:,:)  :: ZNORTHC_2D_OUT, ZSOUTHC_2D_OUT, ZWESTC_2D_OUT, ZEASTC_2D_OUT

  REAL, SAVE , ALLOCATABLE, DIMENSION(:,:,:)  :: ZNORTH2F_IN, ZSOUTH2F_IN, ZWEST2F_IN, ZEAST2F_IN
  REAL, SAVE , ALLOCATABLE, DIMENSION(:,:,:)  :: ZNORTH2F_OUT, ZSOUTH2F_OUT, ZWEST2F_OUT, ZEAST2F_OUT  
    
  LOGICAL, SAVE                               :: GFIRST_GET_HALO_D = .TRUE.
  
  LOGICAL, SAVE     :: GFIRST_INIT_HALO_D = .TRUE.
  INTEGER, SAVE     :: IHALO_1  
  INTEGER, SAVE     :: NP_NORTH,NP_SOUTH,NP_WEST,NP_EAST
  INTEGER, SAVE     :: IHALO2,IHALO2_1

CONTAINS
  
  SUBROUTINE INIT_HALO_D()

    USE MODE_MNH_ZWORK, ONLY : IIU,IJU,IKU
    USE MODE_MNH_ZWORK, ONLY : IIB,IJB ,IIE,IJE 
    USE MODE_MNH_ZWORK, ONLY : GWEST , GEAST, GSOUTH , GNORTH
    USE MODD_CONF, ONLY      : NHALO

    USE MODD_VAR_ll, ONLY    : IP,NPROC,NP1,NP2


    IMPLICIT NONE

    IF (GFIRST_INIT_HALO_D) THEN 
       !
       IHALO_1  = NHALO-1
       IHALO2   = MAX(2,NHALO)
       IHALO2_1 = IHALO2-1
       !
       !  Init HALO
       !
       ALLOCATE  ( ZSOUTH_IN ( IIB:IIE   , IJB:IJB+IHALO_1   , IKU ) )
       ALLOCATE  ( ZNORTH_IN ( IIB:IIE   , IJE-IHALO_1:IJE   , IKU ) )
       ALLOCATE  ( ZWEST_IN  ( IIB:IIB+IHALO_1   , IJB:IJE   , IKU ) )
       ALLOCATE  ( ZEAST_IN  ( IIE-IHALO_1:IIE   , IJB:IJE   , IKU ) )
       !$acc enter data create (ZNORTH_IN, ZSOUTH_IN, ZWEST_IN, ZEAST_IN)
       !
       ALLOCATE  ( ZSOUTH_OUT (   IIB:IIE   , 1:IJB-1 , IKU ) )
       ALLOCATE  ( ZNORTH_OUT (   IIB:IIE   , IJE+1:IJU , IKU ) )
       ALLOCATE  ( ZWEST_OUT  ( 1:IIB-1 ,   IJB:IJE   , IKU ) )
       ALLOCATE  ( ZEAST_OUT  ( IIE+1:IIU ,   IJB:IJE   , IKU ) )
       !$acc enter data create (ZNORTH_OUT, ZSOUTH_OUT, ZWEST_OUT, ZEAST_OUT)
       !
       !  Init HALO with Corner
       !
       ALLOCATE  ( ZSOUTHC_IN (   1:IIU   , IJB:IJB+IHALO_1   , IKU ) )
       ALLOCATE  ( ZNORTHC_IN (   1:IIU   , IJE-IHALO_1:IJE   , IKU ) )
       ALLOCATE  ( ZWESTC_IN  ( IIB:IIB+IHALO_1   , IJB:IJE   , IKU ) )
       ALLOCATE  ( ZEASTC_IN  ( IIE-IHALO_1:IIE   , IJB:IJE   , IKU ) )
       !$acc enter data create (ZNORTHC_IN, ZSOUTHC_IN, ZWESTC_IN, ZEASTC_IN)
       !
       ALLOCATE  ( ZSOUTHC_OUT (   1:IIU   , 1:IJB-1 , IKU ) )
       ALLOCATE  ( ZNORTHC_OUT (   1:IIU   , IJE+1:IJU , IKU ) )
       ALLOCATE  ( ZWESTC_OUT  ( 1:IIB-1 ,   IJB:IJE   , IKU ) )
       ALLOCATE  ( ZEASTC_OUT  ( IIE+1:IIU ,   IJB:IJE   , IKU ) )
       !$acc enter data create (ZNORTHC_OUT, ZSOUTHC_OUT, ZWESTC_OUT, ZEASTC_OUT)       
       !
       !  Init HALO2
       !
       ALLOCATE  ( ZSOUTH2_IN ( IIU , IKU ) )
       ALLOCATE  ( ZNORTH2_IN ( IIU , IKU ) )
       ALLOCATE  ( ZWEST2_IN  ( IJU , IKU ) )
       ALLOCATE  ( ZEAST2_IN  ( IJU , IKU ) )
       !$acc enter data create (ZNORTH2_IN, ZSOUTH2_IN, ZWEST2_IN, ZEAST2_IN)
       !
       ALLOCATE  ( ZSOUTH2_OUT ( IIU , IKU ) )
       ALLOCATE  ( ZNORTH2_OUT ( IIU , IKU ) )
       ALLOCATE  ( ZWEST2_OUT  ( IJU , IKU ) )
       ALLOCATE  ( ZEAST2_OUT  ( IJU , IKU ) )
       !$acc enter data create (ZNORTH2_OUT, ZSOUTH2_OUT, ZWEST2_OUT, ZEAST2_OUT)
       !
       !  Init HALO_2D
       !
       ALLOCATE  ( ZSOUTH_2D_IN ( IIB:IIE   , IJB:IJB+IHALO_1  ) )
       ALLOCATE  ( ZNORTH_2D_IN ( IIB:IIE   , IJE-IHALO_1:IJE  ) )
       ALLOCATE  ( ZWEST_2D_IN  ( IIB:IIB+IHALO_1   , IJB:IJE  ) )
       ALLOCATE  ( ZEAST_2D_IN  ( IIE-IHALO_1:IIE   , IJB:IJE  ) )
       !$acc enter data create (ZNORTH_2D_IN, ZSOUTH_2D_IN, ZWEST_2D_IN, ZEAST_2D_IN)
       !
       ALLOCATE  ( ZSOUTH_2D_OUT (   IIB:IIE   , 1:IJB-1) )
       ALLOCATE  ( ZNORTH_2D_OUT (   IIB:IIE   , IJE+1:IJU) )
       ALLOCATE  ( ZWEST_2D_OUT  ( 1:IIB-1 ,   IJB:IJE  ) )
       ALLOCATE  ( ZEAST_2D_OUT  ( IIE+1:IIU ,   IJB:IJE  ) )
       !$acc enter data create (ZNORTH_2D_OUT, ZSOUTH_2D_OUT, ZWEST_2D_OUT, ZEAST_2D_OUT)
       !
       !  Init HALO 2D with Corner
       !
       ALLOCATE  ( ZSOUTHC_2D_IN (   1:IIU   , IJB:IJB+IHALO_1   ) )
       ALLOCATE  ( ZNORTHC_2D_IN (   1:IIU   , IJE-IHALO_1:IJE   ) )
       ALLOCATE  ( ZWESTC_2D_IN  ( IIB:IIB+IHALO_1   , IJB:IJE   ) )
       ALLOCATE  ( ZEASTC_2D_IN  ( IIE-IHALO_1:IIE   , IJB:IJE   ) )
       !$acc enter data create (ZNORTHC_2D_IN, ZSOUTHC_2D_IN, ZWESTC_2D_IN, ZEASTC_2D_IN)
       !
       ALLOCATE  ( ZSOUTHC_2D_OUT (   1:IIU   , 1:IJB-1 ) )
       ALLOCATE  ( ZNORTHC_2D_OUT (   1:IIU   , IJE+1:IJU ) )
       ALLOCATE  ( ZWESTC_2D_OUT  ( 1:IIB-1 ,   IJB:IJE   ) )
       ALLOCATE  ( ZEASTC_2D_OUT  ( IIE+1:IIU ,   IJB:IJE   ) )
       !$acc enter data create (ZNORTHC_2D_OUT, ZSOUTHC_2D_OUT, ZWESTC_2D_OUT, ZEASTC_2D_OUT)
       !
       !  Init HALO2 for Full update in 1 time <-> GET_HALO + GET_HALO2 
       !
       ALLOCATE  ( ZSOUTH2F_IN ( IIB:IIE   , IJB:IJB+IHALO2_1   , IKU ) )
       ALLOCATE  ( ZNORTH2F_IN ( IIB:IIE   , IJE-IHALO2_1:IJE   , IKU ) )
       ALLOCATE  ( ZWEST2F_IN  ( IIB:IIB+IHALO2_1   , IJB:IJE   , IKU ) )
       ALLOCATE  ( ZEAST2F_IN  ( IIE-IHALO2_1:IIE   , IJB:IJE   , IKU ) )
       !$acc enter data create (ZNORTH2F_IN, ZSOUTH2F_IN, ZWEST2F_IN, ZEAST2F_IN)
       !
       ALLOCATE  ( ZSOUTH2F_OUT (   IIB:IIE   , IJB-IHALO2:IJB-1 , IKU ) )
       ALLOCATE  ( ZNORTH2F_OUT (   IIB:IIE   , IJE+1:IJE+IHALO2 , IKU ) )
       ALLOCATE  ( ZWEST2F_OUT  ( IIB-IHALO2:IIB-1 ,   IJB:IJE   , IKU ) )
       ALLOCATE  ( ZEAST2F_OUT  ( IIE+1:IIE+IHALO2 ,   IJB:IJE   , IKU ) )
       !$acc enter data create (ZNORTH2F_OUT, ZSOUTH2F_OUT, ZWEST2F_OUT, ZEAST2F_OUT)
       
       IF (.NOT. GWEST ) THEN
          NP_WEST = ( IP-1 -1 ) + 1
       ELSE
          NP_WEST = 0
       ENDIF
       IF (.NOT. GEAST ) THEN
          NP_EAST = ( IP-1 +1 ) + 1
       ELSE
          NP_EAST = 0
       ENDIF
       IF (.NOT. GSOUTH ) THEN
          NP_SOUTH =  ( IP-1 -NP1 ) + 1
       ELSE
          NP_SOUTH = 0
       ENDIF
       IF (.NOT. GNORTH ) THEN
          NP_NORTH =  ( IP-1 +NP1 ) + 1
       ELSE
          NP_NORTH = 0
       ENDIF

       !print*,"PROC=",IP, GWEST,NP_WEST, GEAST,NP_EAST, GSOUTH,NP_SOUTH ,  GNORTH,NP_NORTH
       
       GFIRST_INIT_HALO_D = .FALSE.
       
    END IF

  END SUBROUTINE INIT_HALO_D

END MODULE MODD_HALO_D
!     #########################
      SUBROUTINE GET_HALO_D(PSRC,HDIR,HNAME)
!     #########################
!define MNH_GPUDIRECT
!
USE MODD_HALO_D

!USE MODE_MNH_ZWORK, ONLY : GWEST , GEAST, GSOUTH , GNORTH
USE MODE_MNH_ZWORK, ONLY : IIU,IJU,IKU
USE MODE_MNH_ZWORK, ONLY : IIB,IJB ,IIE,IJE

!!
!USE MODE_DEVICE
USE MODE_MPPDB
USE MODI_GET_HALO, ONLY : GET_HALO_START_D,GET_HALO_STOP_D
!
IMPLICIT NONE
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC    ! variable at t
! acc declare present (PSRC)
CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
character(len=*), optional, intent(in) :: HNAME ! Name of the field to be added
!
INTEGER            :: INB_REQ , IREQ(8)
!
CALL MPPDB_CHECK(PSRC,"GET_HALO_D big:PSRC")
!
CALL GET_HALO_START_D(PSRC,INB_REQ,IREQ,&
     ZNORTH_IN , ZSOUTH_IN , ZWEST_IN , ZEAST_IN , &
     ZNORTH_OUT, ZSOUTH_OUT, ZWEST_OUT, ZEAST_OUT, &
     IIB,IIE,IJB,IJE,IIU,IJU,IKU,IHALO_1,HDIR)

CALL GET_HALO_STOP_D(PSRC,INB_REQ,IREQ,&
     ZNORTH_OUT, ZSOUTH_OUT, ZWEST_OUT, ZEAST_OUT, &
     IIB,IIE,IJB,IJE,IIU,IJU,IKU,HDIR)
!
CALL MPPDB_CHECK(PSRC,"GET_HALO_D end:PSRC")
!
END SUBROUTINE GET_HALO_D
!     #########################
SUBROUTINE GET_HALO_START_D(PSRC,KNB_REQ,KREQ,&
     PZNORTH_IN , PZSOUTH_IN , PZWEST_IN , PZEAST_IN , &
     PZNORTH_OUT, PZSOUTH_OUT, PZWEST_OUT, PZEAST_OUT, &
     KIIB,KIIE,KIJB,KIJE,KIIU,KIJU,KIKU,KIHALO_1,&
     HDIR)
!     #########################
!define MNH_GPUDIRECT
!
USE MODD_HALO_D

USE MODE_MNH_ZWORK, ONLY : GWEST , GEAST, GSOUTH , GNORTH
!
USE MODD_VAR_ll, ONLY : NMNH_COMM_WORLD
USE MODD_MPIF,    ONLY : MPI_STATUSES_IGNORE
USE MODD_PRECISION,  ONLY : MNHREAL_MPI
!
USE MODE_DEVICE
USE MODE_MPPDB
!
IMPLICIT NONE
!
REAL, DIMENSION(KIIU,KIJU,KIKU), INTENT(INOUT) :: PSRC    ! variable at t
! acc declare present (PSRC)
INTEGER                               :: KNB_REQ ,  KREQ(8)
REAL            :: PZSOUTH_IN ( KIIB:KIIE   , KIJB:KIJB+KIHALO_1   , KIKU ) ,&
                   PZNORTH_IN ( KIIB:KIIE   , KIJE-KIHALO_1:KIJE   , KIKU ) ,&
                   PZWEST_IN  ( KIIB:KIIB+KIHALO_1   , KIJB:KIJE   , KIKU ) ,&
                   PZEAST_IN  ( KIIE-KIHALO_1:KIIE   , KIJB:KIJE   , KIKU ) ,&
       !
                   PZSOUTH_OUT (   KIIB:KIIE   , 1:KIJB-1 , KIKU ) ,&
                   PZNORTH_OUT (   KIIB:KIIE   , KIJE+1:KIJU , KIKU ) ,&
                   PZWEST_OUT  ( 1:KIIB-1 ,   KIJB:KIJE   , KIKU ) ,&
                   PZEAST_OUT  ( KIIE+1:KIIU ,   KIJB:KIJE   , KIKU ) 
INTEGER         :: KIIB,KIIE,KIJB,KIJE,KIIU,KIJU,KIKU,KIHALO_1

CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
!
INTEGER                          :: IERROR                 ! error return code 

INTEGER,PARAMETER :: IS_WEST=1 , IS_EAST=2, IS_SOUTH=3, IS_NORTH=4
LOGICAL      :: LX , LY
INTEGER      :: NB_REQ, IERR
!
INTEGER :: JI,JJ,JK 

CALL INIT_HALO_D()

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

!$acc data present (PSRC) &
!$acc present (PZNORTH_IN, PZSOUTH_IN, PZWEST_IN, PZEAST_IN) &
!$acc present (PZNORTH_OUT, PZSOUTH_OUT, PZWEST_OUT, PZEAST_OUT) 


LX = .FALSE.
LY = .FALSE. 

IF (.NOT. PRESENT(HDIR) ) THEN
LX = .TRUE.
LY = .TRUE.
ELSE
!!$LX = ( HDIR == "01_X"  .OR. HDIR == "S0_X" )
!!$LY = ( HDIR == "01_Y"  .OR. HDIR == "S0_Y" )
LX = ( HDIR == "01_X" .OR. HDIR == "S0_X" .OR. HDIR == "S0_Y" )
LY = ( HDIR == "01_Y" .OR. HDIR == "S0_Y" .OR. HDIR == "S0_X" )
!!$print *,"KIIB=",KIIB," HDIR=",HDIR," LX=",LX," LY=",LY ; call flush(6)
END IF

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

NB_REQ = 0

!
! Post the recieve of Zxxxx_IN buffer first via MPI(Gpu_direct)
!

IF (LX) THEN
   IF (.NOT. GWEST) THEN
#ifdef MNH_GPUDIRECT
      !$acc host_data use_device(PZWEST_OUT)
#endif
      NB_REQ = NB_REQ + 1
      CALL MPI_IRECV(PZWEST_OUT,SIZE(PZWEST_OUT),MNHREAL_MPI,NP_WEST-1,1000+IS_EAST,&
                     NMNH_COMM_WORLD,KREQ(NB_REQ),IERR)
#ifdef MNH_GPUDIRECT
      !$acc end host_data
#endif
   END IF
   IF (.NOT.GEAST) THEN 
#ifdef MNH_GPUDIRECT
      !$acc host_data use_device(PZEAST_OUT)
#endif
      NB_REQ = NB_REQ + 1
      CALL MPI_IRECV(PZEAST_OUT,SIZE(PZEAST_OUT),MNHREAL_MPI,NP_EAST-1,1000+IS_WEST,&
                     NMNH_COMM_WORLD,KREQ(NB_REQ),IERR)
#ifdef MNH_GPUDIRECT
      !$acc end host_data
#endif
   ENDIF
END IF

IF (LY) THEN
   IF (.NOT.GSOUTH) THEN
#ifdef MNH_GPUDIRECT
      !$acc host_data use_device(PZSOUTH_OUT)
#endif
      NB_REQ = NB_REQ + 1
      CALL MPI_IRECV(PZSOUTH_OUT,SIZE(PZSOUTH_OUT),MNHREAL_MPI,NP_SOUTH-1,1000+IS_NORTH,&
                     NMNH_COMM_WORLD,KREQ(NB_REQ),IERR)
#ifdef MNH_GPUDIRECT
      !$acc end host_data
#endif
   ENDIF
   IF (.NOT.GNORTH) THEN
#ifdef MNH_GPUDIRECT
      !$acc host_data use_device(PZNORTH_OUT)
#endif
      NB_REQ = NB_REQ + 1
      CALL MPI_IRECV(PZNORTH_OUT,SIZE(PZNORTH_OUT),MNHREAL_MPI,NP_NORTH-1,1000+IS_SOUTH,&
                     NMNH_COMM_WORLD,KREQ(NB_REQ),IERR)
#ifdef MNH_GPUDIRECT
      !$acc end host_data
#endif
   ENDIF
END IF

!
! Copy the halo(async) on the device PSRC to Zxxxx_IN buffer 
!

IF (LX) THEN
   IF (.NOT. GWEST) THEN
      !$acc kernels async(IS_WEST)
      !$mnh_expand_array(JI=KIIB:KIIB+KIHALO_1 , JJ=KIJB:KIJE , JK=1:KIKU )
           PZWEST_IN ( KIIB:KIIB+KIHALO_1  ,    KIJB:KIJE  , : )  = PSRC( KIIB:KIIB+KIHALO_1  ,  KIJB:KIJE  , : )
      !$mnh_end_expand_array()
      !$acc end kernels
   END IF
   IF (.NOT.GEAST) THEN
      !$acc kernels async(IS_EAST)
      !$mnh_expand_array(JI=KIIE-KIHALO_1:KIIE , JJ=KIJB:KIJE , JK=1:KIKU)
           PZEAST_IN ( KIIE-KIHALO_1:KIIE  ,    KIJB:KIJE  , : )  = PSRC( KIIE-KIHALO_1:KIIE  ,  KIJB:KIJE  , : )
      !$mnh_end_expand_array()
      !$acc end kernels
   ENDIF
END IF

IF (LY) THEN
   IF (.NOT.GSOUTH) THEN
      !$acc kernels async(IS_SOUTH)
      !$mnh_expand_array(JI=KIIB:KIIE , JJ=KIJB:KIJB+KIHALO_1 , JK=1:KIKU )
           PZSOUTH_IN ( KIIB:KIIE  ,    KIJB:KIJB+KIHALO_1  , : ) = PSRC( KIIB:KIIE  ,    KIJB:KIJB+KIHALO_1  , : )
      !$mnh_end_expand_array()
      !$acc end kernels
   ENDIF
   IF (.NOT.GNORTH) THEN
      !$acc kernels async(IS_NORTH)
      !$mnh_expand_array(JI=KIIB:KIIE , JJ=KIJE-KIHALO_1:KIJE , JK=1:KIKU )
           PZNORTH_IN ( KIIB:KIIE  ,    KIJE-KIHALO_1:KIJE  , : ) = PSRC( KIIB:KIIE  ,    KIJE-KIHALO_1:KIJE  , : )
      !$mnh_end_expand_array()
      !$acc end kernels
   ENDIF   
ENDIF

!$acc wait

!
! Send  Zxxxx_IN buffer via MPI(Gpu_direct)
!
IF (LX) THEN
   IF (.NOT. GWEST) THEN
#ifdef MNH_GPUDIRECT
      !$acc host_data use_device(PZWEST_IN)
#else
      !$acc update host(PZWEST_IN)
#endif
      NB_REQ = NB_REQ + 1
      CALL MPI_ISEND(PZWEST_IN,SIZE(PZWEST_IN)  ,MNHREAL_MPI,NP_WEST-1,1000+IS_WEST,&
                     NMNH_COMM_WORLD,KREQ(NB_REQ),IERR)
#ifdef MNH_GPUDIRECT
      !$acc end host_data
#endif
   END IF
   IF (.NOT.GEAST) THEN
#ifdef MNH_GPUDIRECT
      !$acc host_data use_device(PZEAST_IN)
#else
      !$acc update host(PZEAST_IN)
#endif
      NB_REQ = NB_REQ + 1
      CALL MPI_ISEND(PZEAST_IN,SIZE(PZEAST_IN)  ,MNHREAL_MPI,NP_EAST-1,1000+IS_EAST,&
                     NMNH_COMM_WORLD,KREQ(NB_REQ),IERR)
#ifdef MNH_GPUDIRECT
      !$acc end host_data
#endif
   ENDIF
END IF

IF (LY) THEN
   IF (.NOT.GSOUTH) THEN
#ifdef MNH_GPUDIRECT
      !$acc host_data use_device(PZSOUTH_IN)
#else
      !$acc update host(PZSOUTH_IN)
#endif
      NB_REQ = NB_REQ + 1
      CALL MPI_ISEND(PZSOUTH_IN,SIZE(PZSOUTH_IN)  ,MNHREAL_MPI,NP_SOUTH-1,1000+IS_SOUTH,&
                     NMNH_COMM_WORLD,KREQ(NB_REQ),IERR)
#ifdef MNH_GPUDIRECT
      !$acc end host_data
#endif
   ENDIF
   IF (.NOT.GNORTH) THEN
#ifdef MNH_GPUDIRECT
      !$acc host_data use_device(PZNORTH_IN)
#else
      !$acc update host(PZNORTH_IN)
#endif
      NB_REQ = NB_REQ + 1
      CALL MPI_ISEND(PZNORTH_IN,SIZE(PZNORTH_IN)  ,MNHREAL_MPI,NP_NORTH-1,1000+IS_NORTH,&
                     NMNH_COMM_WORLD,KREQ(NB_REQ),IERR)
#ifdef MNH_GPUDIRECT
      !$acc end host_data
#endif
   ENDIF   
ENDIF

!$acc end data

KNB_REQ = NB_REQ
!
END SUBROUTINE GET_HALO_START_D
!
!     #########################
SUBROUTINE GET_HALO_STOP_D(PSRC,KNB_REQ,KREQ,&
     PZNORTH_OUT, PZSOUTH_OUT, PZWEST_OUT, PZEAST_OUT, &
     KIIB,KIIE,KIJB,KIJE,KIIU,KIJU,KIKU,&
     HDIR)
!     #########################
!define MNH_GPUDIRECT
!
USE MODD_HALO_D

USE MODE_MNH_ZWORK, ONLY : GWEST , GEAST, GSOUTH , GNORTH
!!$USE MODE_MNH_ZWORK, ONLY : IIU,IJU,IKU
!!$USE MODE_MNH_ZWORK, ONLY : IIB,IJB ,IIE,IJE 
!
USE MODD_VAR_ll, ONLY : NMNH_COMM_WORLD
USE MODD_MPIF,    ONLY : MPI_STATUSES_IGNORE
USE MODD_PRECISION,  ONLY : MNHREAL_MPI
!
USE MODE_DEVICE
USE MODE_MPPDB
!
IMPLICIT NONE
!
REAL, DIMENSION(KIIU,KIJU,KIKU), INTENT(INOUT) :: PSRC    ! variable at t
! acc declare present (PSRC)
INTEGER                               :: KNB_REQ , KREQ(8)
REAL            :: PZSOUTH_OUT (   KIIB:KIIE   , 1:KIJB-1 , KIKU ) ,&
                   PZNORTH_OUT (   KIIB:KIIE   , KIJE+1:KIJU , KIKU ) ,&
                   PZWEST_OUT  ( 1:KIIB-1 ,   KIJB:KIJE   , KIKU ) ,&
                   PZEAST_OUT  ( KIIE+1:KIIU ,   KIJB:KIJE   , KIKU ) 
INTEGER         :: KIIB,KIIE,KIJB,KIJE,KIIU,KIJU,KIKU

CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
!
INTEGER                          :: IERROR                 ! error return code 

INTEGER,PARAMETER :: IS_WEST=1 , IS_EAST=2, IS_SOUTH=3, IS_NORTH=4
LOGICAL      :: LX , LY
INTEGER      :: NB_REQ, IERR
!
INTEGER :: JI,JJ,JK

CALL INIT_HALO_D()

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

!$acc data  present (PSRC) &
!$acc & present (PZNORTH_OUT,PZSOUTH_OUT,PZWEST_OUT,PZEAST_OUT)

LX = .FALSE.
LY = .FALSE. 

IF (.NOT. PRESENT(HDIR) ) THEN
LX = .TRUE.
LY = .TRUE.
ELSE
!!$LX = ( HDIR == "01_X"  .OR. HDIR == "S0_X" )
!!$LY = ( HDIR == "01_Y"  .OR. HDIR == "S0_Y" )
LX = ( HDIR == "01_X" .OR. HDIR == "S0_X" .OR. HDIR == "S0_Y" )
LY = ( HDIR == "01_Y" .OR. HDIR == "S0_Y" .OR. HDIR == "S0_X" )
!!$print *,"KIIB=",KIIB," HDIR=",HDIR," LX=",LX," LY=",LY ; call flush(6)
END IF

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

NB_REQ = KNB_REQ

CALL MPI_WAITALL(NB_REQ,KREQ,MPI_STATUSES_IGNORE,IERR)

!
!   Copy back the Zxxx_OUT buffer recv via MPI(gpu_direct) to PSRC halo
! 

IF (LX) THEN
   IF (.NOT.GWEST) THEN
#ifndef MNH_GPUDIRECT
   !$acc update device(PZWEST_OUT) async(IS_WEST)
#endif
   !$acc kernels async(IS_WEST)
   !$mnh_expand_array(JI=1:KIIB-1 , JJ=KIJB:KIJE , JK=1:KIKU )
        PSRC( 1:KIIB-1  ,      KIJB:KIJE      , : ) = PZWEST_OUT( 1:KIIB-1  ,   KIJB:KIJE    , : )
   !$mnh_end_expand_array()
   !$acc end kernels
   ENDIF
   IF (.NOT.GEAST) THEN
#ifndef MNH_GPUDIRECT
   !$acc update device(PZEAST_OUT) async(IS_EAST)
#endif
   !$acc kernels async(IS_EAST)
   !$mnh_expand_array(JI=KIIE+1:KIIU , JJ=KIJB:KIJE , JK=1:KIKU )
        PSRC( KIIE+1:KIIU  ,      KIJB:KIJE      , : ) = PZEAST_OUT( KIIE+1:KIIU  ,   KIJB:KIJE    , : )  
   !$mnh_end_expand_array()
   !$acc end kernels
   ENDIF
END IF
IF (LY) THEN
   IF (.NOT.GSOUTH) THEN
#ifndef MNH_GPUDIRECT
   !$acc update device(PZSOUTH_OUT) async(IS_SOUTH)
#endif
   !$acc kernels async(IS_SOUTH)
   !$mnh_expand_array(JI=KIIB:KIIE , JJ=1:KIJB-1 , JK=1:KIKU )
        PSRC(      KIIB:KIIE       ,  1:KIJB-1 , : ) = PZSOUTH_OUT(  KIIB:KIIE     , 1:KIJB-1  , : )
   !$mnh_end_expand_array()
   !$acc end kernels
   ENDIF
   IF (.NOT.GNORTH) THEN
#ifndef MNH_GPUDIRECT
   !$acc update device(PZNORTH_OUT) async(IS_NORTH)
#endif
   !$acc kernels async(IS_NORTH)
   !$mnh_expand_array(JI=KIIB:KIIE , JJ=KIJE+1:KIJU , JK=1:KIKU )
        PSRC(      KIIB:KIIE       , KIJE+1:KIJU , : ) = PZNORTH_OUT (  KIIB:KIIE     , KIJE+1:KIJU  , : )
   !$mnh_end_expand_array()
   !$acc end kernels
   ENDIF
END IF
!$acc wait

!$acc end data
!
END SUBROUTINE GET_HALO_STOP_D
!-------------------------------------------------------------------------------
!     ########################################
      SUBROUTINE GET_HALO_DD(PSRC, HDIR, HNAME)
!     ########################################
!define MNH_GPUDIRECT
!
USE MODD_HALO_D
USE MODE_ll
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
USE MODD_PARAMETERS, ONLY : JPHEXT
!
USE MODD_IO,        ONLY : GSMONOPROC
USE MODE_MNH_ZWORK, ONLY : GWEST , GEAST, GSOUTH , GNORTH
!
USE MODD_CONF, ONLY : NHALO
USE MODE_DEVICE
USE MODE_MPPDB

USE MODD_VAR_ll, ONLY    : IP,NPROC,NP1,NP2
USE MODD_VAR_ll, ONLY : NMNH_COMM_WORLD
USE MODD_MPIF,    ONLY : MPI_STATUSES_IGNORE
USE MODD_PRECISION,  ONLY : MNHREAL_MPI
!
USE MODE_MNH_ZWORK, ONLY : IIU,IJU,IKU
USE MODE_MNH_ZWORK, ONLY : IIB,IJB ,IIE,IJE 
!
IMPLICIT NONE
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC    ! variable at t
CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
character(len=*), optional, intent(in) :: HNAME ! Name of the field to be added
!
character(len=:), allocatable    :: yname
TYPE(LIST_ll)     , POINTER      :: TZ_PSRC_ll               ! halo
INTEGER                          :: IERROR                 ! error return code 

INTEGER,PARAMETER :: IS_WEST=1 , IS_EAST=2, IS_SOUTH=3, IS_NORTH=4

LOGICAL      :: LX , LY

INTEGER      :: INB_REQ , IREQ(8)
INTEGER      :: IERR

CALL MPPDB_CHECK(PSRC,"GET_HALO_DD big:PSRC")

if ( NPROC == 1 ) THEN
   CALL MPPDB_CHECK(PSRC,"GET_HALO_DD end:PSRC")
   RETURN
end if

CALL INIT_HALO_D()

!$acc data present ( PSRC )

NULLIFY( TZ_PSRC_ll)
!

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

LX = .FALSE.
LY = .FALSE. 

IF (.NOT. PRESENT(HDIR) ) THEN
LX = .TRUE.
LY = .TRUE.
ELSE
   !
   !  Problem of reproductibility in ppm_s0_x/y if only S0_X or S0_Y
   !  so add S0_X + S0_Y for ppm_s0*
   !
!!$LX = ( HDIR == "01_X" .OR. HDIR == "S0_X" )
!!$LY = ( HDIR == "01_Y" .OR. HDIR == "S0_Y" )
LX = ( HDIR == "01_X" .OR. HDIR == "S0_X" .OR. HDIR == "S0_Y" )
LY = ( HDIR == "01_Y" .OR. HDIR == "S0_Y" .OR. HDIR == "S0_X" )
END IF

!!$LX = .TRUE.
!!$LY = .TRUE.

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

INB_REQ = 0

!
! Post the recieve of Zxxxx_IN buffer first via MPI(Gpu_direct)
!

IF (LX) THEN
   IF (.NOT. GWEST) THEN
#ifdef MNH_GPUDIRECT
      !$acc host_data use_device(ZWEST_OUT)
#endif
      INB_REQ = INB_REQ + 1
      CALL MPI_IRECV(ZWEST_OUT,SIZE(ZWEST_OUT),MNHREAL_MPI,NP_WEST-1,1000+IS_EAST,&
                     NMNH_COMM_WORLD,IREQ(INB_REQ),IERR)
#ifdef MNH_GPUDIRECT
      !$acc end host_data
#endif
   END IF
   IF (.NOT.GEAST) THEN 
#ifdef MNH_GPUDIRECT
      !$acc host_data use_device(ZEAST_OUT)
#endif
      INB_REQ = INB_REQ + 1
      CALL MPI_IRECV(ZEAST_OUT,SIZE(ZEAST_OUT),MNHREAL_MPI,NP_EAST-1,1000+IS_WEST,&
                     NMNH_COMM_WORLD,IREQ(INB_REQ),IERR)
#ifdef MNH_GPUDIRECT
      !$acc end host_data
#endif
   ENDIF
END IF

IF (LY) THEN
   IF (.NOT.GSOUTH) THEN
#ifdef MNH_GPUDIRECT
      !$acc host_data use_device(ZSOUTH_OUT)
#endif
      INB_REQ = INB_REQ + 1
      CALL MPI_IRECV(ZSOUTH_OUT,SIZE(ZSOUTH_OUT),MNHREAL_MPI,NP_SOUTH-1,1000+IS_NORTH,&
                     NMNH_COMM_WORLD,IREQ(INB_REQ),IERR)
#ifdef MNH_GPUDIRECT
      !$acc end host_data
#endif
   ENDIF
   IF (.NOT.GNORTH) THEN
#ifdef MNH_GPUDIRECT
      !$acc host_data use_device(ZNORTH_OUT)
#endif
      INB_REQ = INB_REQ + 1
      CALL MPI_IRECV(ZNORTH_OUT,SIZE(ZNORTH_OUT),MNHREAL_MPI,NP_NORTH-1,1000+IS_SOUTH,&
                     NMNH_COMM_WORLD,IREQ(INB_REQ),IERR)
#ifdef MNH_GPUDIRECT
      !$acc end host_data
#endif
   ENDIF
END IF

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

!Copy the halo on the device PSRC to Zxxxx_IN

IF (LX) THEN
   IF (.NOT. GWEST) THEN
   !$acc kernels async(IS_WEST)
   ZWEST_IN ( IIB:IIB+IHALO_1  ,    IJB:IJE  , : )  = PSRC( IIB:IIB+IHALO_1  ,  IJB:IJE  , : )
   !$acc end kernels
      END IF
   IF (.NOT.GEAST) THEN
   !$acc kernels async(IS_EAST)
   ZEAST_IN ( IIE-IHALO_1:IIE  ,    IJB:IJE  , : )  = PSRC( IIE-IHALO_1:IIE  ,  IJB:IJE  , : )
   !$acc end kernels
      ENDIF
END IF
IF (LY) THEN
   IF (.NOT.GSOUTH) THEN
   !$acc kernels async(IS_SOUTH)
   ZSOUTH_IN ( IIB:IIE  ,    IJB:IJB+IHALO_1  , : ) = PSRC( IIB:IIE  ,    IJB:IJB+IHALO_1  , : )
   !$acc end kernels
      ENDIF
   IF (.NOT.GNORTH) THEN
   !$acc kernels async(IS_NORTH)
   ZNORTH_IN ( IIB:IIE  ,    IJE-IHALO_1:IJE  , : ) = PSRC( IIB:IIE  ,    IJE-IHALO_1:IJE  , : )
   !$acc end kernels
   ENDIF
ENDIF
!$acc wait

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Send  Zxxxx_IN buffer via MPI(Gpu_direct) or copy to host
!
IF (LX) THEN
   IF (.NOT. GWEST) THEN
#ifdef MNH_GPUDIRECT
      !$acc host_data use_device(ZWEST_IN)
#else