get_halo.f90

!MNH_LIC Copyright 1994-2023 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_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,HDIR)
     IMPLICIT NONE
     !
     REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC    ! variable at t
     ! acc declare present (PSRC)
     INTEGER                               :: KNB_REQ ,  KREQ(8)
     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,HDIR)
     IMPLICIT NONE
     REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC    ! variable at t
     ! acc declare present (PSRC)
     INTEGER                               :: KNB_REQ , KREQ(8)
     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_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_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(:,:)  :: 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 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,HDIR)
CALL GET_HALO_STOP_D(PSRC,INB_REQ,IREQ,HDIR)
!
CALL MPPDB_CHECK(PSRC,"GET_HALO_D end:PSRC")
!
END SUBROUTINE GET_HALO_D
!     #########################
      SUBROUTINE GET_HALO_START_D(PSRC,KNB_REQ,KREQ,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(:,:,:), INTENT(INOUT) :: PSRC    ! variable at t
! acc declare present (PSRC)
INTEGER                               :: KNB_REQ ,  KREQ(8)
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, JIU,JJU,JKU

JIU = SIZE(PSRC,1)
JJU = SIZE(PSRC,2)
JKU = SIZE(PSRC,3)

CALL INIT_HALO_D()

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

!$acc data present (PSRC) &
!$acc present (ZNORTH_IN, ZSOUTH_IN, ZWEST_IN, ZEAST_IN) &
!$acc present (ZNORTH_OUT, ZSOUTH_OUT, ZWEST_OUT, ZEAST_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 *,"IIB=",IIB," 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(ZWEST_OUT)
#endif
      NB_REQ = NB_REQ + 1
      CALL MPI_IRECV(ZWEST_OUT,SIZE(ZWEST_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(ZEAST_OUT)
#endif
      NB_REQ = NB_REQ + 1
      CALL MPI_IRECV(ZEAST_OUT,SIZE(ZEAST_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(ZSOUTH_OUT)
#endif
      NB_REQ = NB_REQ + 1
      CALL MPI_IRECV(ZSOUTH_OUT,SIZE(ZSOUTH_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(ZNORTH_OUT)
#endif
      NB_REQ = NB_REQ + 1
      CALL MPI_IRECV(ZNORTH_OUT,SIZE(ZNORTH_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=IIB:IIB+IHALO_1 , JJ=IJB:IJE , JK=1:JKU )
           ZWEST_IN ( IIB:IIB+IHALO_1  ,    IJB:IJE  , : )  = PSRC( IIB:IIB+IHALO_1  ,  IJB:IJE  , : )
      !$mnh_end_expand_array()
      !$acc end kernels
   END IF
   IF (.NOT.GEAST) THEN
      !$acc kernels async(IS_EAST)
      !$mnh_expand_array(JI=IIE-IHALO_1:IIE , JJ=IJB:IJE , JK=1:JKU)
           ZEAST_IN ( IIE-IHALO_1:IIE  ,    IJB:IJE  , : )  = PSRC( IIE-IHALO_1:IIE  ,  IJB:IJE  , : )
      !$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=IIB:IIE , JJ=IJB:IJB+IHALO_1 , JK=1:JKU )
           ZSOUTH_IN ( IIB:IIE  ,    IJB:IJB+IHALO_1  , : ) = PSRC( IIB:IIE  ,    IJB:IJB+IHALO_1  , : )
      !$mnh_end_expand_array()
      !$acc end kernels
   ENDIF
   IF (.NOT.GNORTH) THEN
      !$acc kernels async(IS_NORTH)
      !$mnh_expand_array(JI=IIB:IIE , JJ=IJE-IHALO_1:IJE , JK=1:JKU )
           ZNORTH_IN ( IIB:IIE  ,    IJE-IHALO_1:IJE  , : ) = PSRC( IIB:IIE  ,    IJE-IHALO_1:IJE  , : )
      !$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(ZWEST_IN)
#else
      !$acc update host(ZWEST_IN)
#endif
      NB_REQ = NB_REQ + 1
      CALL MPI_ISEND(ZWEST_IN,SIZE(ZWEST_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(ZEAST_IN)
#else
      !$acc update host(ZEAST_IN)
#endif
      NB_REQ = NB_REQ + 1
      CALL MPI_ISEND(ZEAST_IN,SIZE(ZEAST_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(ZSOUTH_IN)
#else
      !$acc update host(ZSOUTH_IN)
#endif
      NB_REQ = NB_REQ + 1
      CALL MPI_ISEND(ZSOUTH_IN,SIZE(ZSOUTH_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(ZNORTH_IN)
#else
      !$acc update host(ZNORTH_IN)
#endif
      NB_REQ = NB_REQ + 1
      CALL MPI_ISEND(ZNORTH_IN,SIZE(ZNORTH_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,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(:,:,:), INTENT(INOUT) :: PSRC    ! variable at t
! acc declare present (PSRC)
INTEGER                               :: KNB_REQ , KREQ(8)
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, JIU,JJU,JKU

JIU = SIZE(PSRC,1)
JJU = SIZE(PSRC,2)
JKU = SIZE(PSRC,3)

CALL INIT_HALO_D()

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

!$acc data  present (PSRC) &
!$acc present (ZNORTH_IN, ZSOUTH_IN, ZWEST_IN, ZEAST_IN) &
!$acc present (ZNORTH_OUT, ZSOUTH_OUT, ZWEST_OUT, ZEAST_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 *,"IIB=",IIB," 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(ZWEST_OUT) async(IS_WEST)
#endif
   !$acc kernels async(IS_WEST)
   !$mnh_expand_array(JI=1:IIB-1 , JJ=IJB:IJE , JK=1:JKU )
        PSRC( 1:IIB-1  ,      IJB:IJE      , : ) = ZWEST_OUT( 1:IIB-1  ,   IJB:IJE    , : )
   !$mnh_end_expand_array()
   !$acc end kernels
   ENDIF
   IF (.NOT.GEAST) THEN
#ifndef MNH_GPUDIRECT
   !$acc update device(ZEAST_OUT) async(IS_EAST)
#endif
   !$acc kernels async(IS_EAST)
   !$mnh_expand_array(JI=IIE+1:IIU , JJ=IJB:IJE , JK=1:JKU )
        PSRC( IIE+1:IIU  ,      IJB:IJE      , : ) = ZEAST_OUT( IIE+1:IIU  ,   IJB:IJE    , : )  
   !$mnh_end_expand_array()
   !$acc end kernels
   ENDIF
END IF
IF (LY) THEN
   IF (.NOT.GSOUTH) THEN
#ifndef MNH_GPUDIRECT
   !$acc update device(ZSOUTH_OUT) async(IS_SOUTH)
#endif
   !$acc kernels async(IS_SOUTH)
   !$mnh_expand_array(JI=IIB:IIE , JJ=1:IJB-1 , JK=1:JKU )
        PSRC(      IIB:IIE       ,  1:IJB-1 , : ) = ZSOUTH_OUT(  IIB:IIE     , 1:IJB-1  , : )
   !$mnh_end_expand_array()
   !$acc end kernels
   ENDIF
   IF (.NOT.GNORTH) THEN
#ifndef MNH_GPUDIRECT
   !$acc update device(ZNORTH_OUT) async(IS_NORTH)
#endif
   !$acc kernels async(IS_NORTH)
   !$mnh_expand_array(JI=IIB:IIE , JJ=IJE+1:IJU , JK=1:JKU )
        PSRC(      IIB:IIE       , IJE+1:IJU , : ) = ZNORTH_OUT (  IIB:IIE     , IJE+1:IJU  , : )
   !$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
      !$acc update host(ZWEST_IN)
#endif
      INB_REQ = INB_REQ + 1
      CALL MPI_ISEND(ZWEST_IN,SIZE(ZWEST_IN)  ,MNHREAL_MPI,NP_WEST-1,1000+IS_WEST,&
                     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_IN)
#else
      !$acc update host(ZEAST_IN)
#endif
      INB_REQ = INB_REQ + 1
      CALL MPI_ISEND(ZEAST_IN,SIZE(ZEAST_IN)  ,MNHREAL_MPI,NP_EAST-1,1000+IS_EAST,&
                     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_IN)
#else
      !$acc update host(ZSOUTH_IN)
#endif
      INB_REQ = INB_REQ + 1
      CALL MPI_ISEND(ZSOUTH_IN,SIZE(ZSOUTH_IN)  ,MNHREAL_MPI,NP_SOUTH-1,1000+IS_SOUTH,&
                     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_IN)
#else
      !$acc update host(ZNORTH_IN)
#endif
      INB_REQ = INB_REQ + 1
      CALL MPI_ISEND(ZNORTH_IN,SIZE(ZNORTH_IN)  ,MNHREAL_MPI,NP_NORTH-1,1000+IS_NORTH,&
                     NMNH_COMM_WORLD,IREQ(INB_REQ),IERR)
#ifdef MNH_GPUDIRECT
      !$acc end host_data
#endif
   ENDIF   
ENDIF

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

IF ( INB_REQ > 0 ) THEN
   CALL MPI_WAITALL(INB_REQ,IREQ,MPI_STATUSES_IGNORE,IERR)
END IF

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

! Is update halo

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


IF (LX) THEN
   IF (.NOT.GWEST) THEN
#ifndef MNH_GPUDIRECT
   !$acc update device(ZWEST_OUT) async(IS_WEST)
#endif
   !$acc kernels async(IS_WEST)
   PSRC( 1:IIB-1  ,      IJB:IJE      , : ) = ZWEST_OUT( 1:IIB-1  ,   IJB:IJE    , : )
   !$acc end kernels
   ENDIF
   IF (.NOT.GEAST) THEN
#ifndef MNH_GPUDIRECT
   !$acc update device(ZEAST_OUT) async(IS_EAST)
#endif
   !$acc kernels async(IS_EAST)
   PSRC( IIE+1:IIU  ,      IJB:IJE      , : ) = ZEAST_OUT( IIE+1:IIU  ,   IJB:IJE    , : )  
   !$acc end kernels
   ENDIF
END IF
IF (LY) THEN
   IF (.NOT.GSOUTH) THEN
#ifndef MNH_GPUDIRECT
   !$acc update device(ZSOUTH_OUT) async(IS_SOUTH)
#endif
   !$acc kernels async(IS_SOUTH)
   PSRC(      IIB:IIE       ,  1:IJB-1 , : ) = ZSOUTH_OUT(  IIB:IIE     , 1:IJB-1  , : )
   !$acc end kernels
   ENDIF
   IF (.NOT.GNORTH) THEN
#ifndef MNH_GPUDIRECT
   !$acc update device(ZNORTH_OUT) async(IS_NORTH)
#endif
   !$acc kernels async(IS_NORTH)
   PSRC(      IIB:IIE       , IJE+1:IJU , : ) = ZNORTH_OUT (  IIB:IIE     , IJE+1:IJU  , : )
   !$acc end kernels
   ENDIF
END IF
!$acc wait

!$acc end data

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

END SUBROUTINE GET_HALO_DD
!-------------------------------------------------------------------------------
!     ########################################
      SUBROUTINE GET_HALO_DDC(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