From a364f222cb07110b7db59c7587038ecb06d6f272 Mon Sep 17 00:00:00 2001
From: Juan Escobar <juan.escobar@aero.obs-mip.fr>
Date: Fri, 17 Sep 2021 09:09:32 +0200
Subject: [PATCH] Juan 17/09/2021:get_halo.f90, add GET_2D_HALO_DDC for
turb.f90
---
src/ZSOLVER/get_halo.f90 | 628 ++++++++++++++++++++++++++++++++++++++-
1 file changed, 626 insertions(+), 2 deletions(-)
diff --git a/src/ZSOLVER/get_halo.f90 b/src/ZSOLVER/get_halo.f90
index 201e1170b..717d08414 100644
--- a/src/ZSOLVER/get_halo.f90
+++ b/src/ZSOLVER/get_halo.f90
@@ -114,6 +114,26 @@ INTERFACE
!
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
@@ -217,6 +237,13 @@ MODULE MODD_HALO_D
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
+
LOGICAL, SAVE :: GFIRST_GET_HALO_D = .TRUE.
@@ -282,8 +309,36 @@ CONTAINS
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)
-
+ !$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)
+
IF (.NOT. GWEST ) THEN
NP_WEST = ( IP-1 -1 ) + 1
ELSE
@@ -918,6 +973,275 @@ END IF
!$acc end data
END SUBROUTINE GET_HALO_DD
+! ########################################
+ SUBROUTINE GET_2D_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
+
+if ( NPROC == 1 ) RETURN
+
+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_2D_OUT buffer first via MPI(Gpu_direct)
+!
+
+IF (LX) THEN
+ IF (.NOT. GWEST) THEN
+#ifdef MNH_GPUDIRECT
+ !$acc host_data use_device(ZWEST_2D_OUT)
+#endif
+ INB_REQ = INB_REQ + 1
+ CALL MPI_IRECV(ZWEST_2D_OUT,SIZE(ZWEST_2D_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_2D_OUT)
+#endif
+ INB_REQ = INB_REQ + 1
+ CALL MPI_IRECV(ZEAST_2D_OUT,SIZE(ZEAST_2D_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_2D_OUT)
+#endif
+ INB_REQ = INB_REQ + 1
+ CALL MPI_IRECV(ZSOUTH_2D_OUT,SIZE(ZSOUTH_2D_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_2D_OUT)
+#endif
+ INB_REQ = INB_REQ + 1
+ CALL MPI_IRECV(ZNORTH_2D_OUT,SIZE(ZNORTH_2D_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_2D_IN
+
+IF (LX) THEN
+ IF (.NOT. GWEST) THEN
+ !$acc kernels async(IS_WEST)
+ ZWEST_2D_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_2D_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_2D_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_2D_IN ( IIB:IIE , IJE-IHALO_1:IJE ) = PSRC( IIB:IIE , IJE-IHALO_1:IJE )
+ !$acc end kernels
+ ENDIF
+ENDIF
+!$acc wait
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+! Send Zxxxx_2D_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_2D_IN)
+#else
+ !$acc update host(ZWEST_2D_IN)
+#endif
+ INB_REQ = INB_REQ + 1
+ CALL MPI_ISEND(ZWEST_2D_IN,SIZE(ZWEST_2D_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_2D_IN)
+#else
+ !$acc update host(ZEAST_2D_IN)
+#endif
+ INB_REQ = INB_REQ + 1
+ CALL MPI_ISEND(ZEAST_2D_IN,SIZE(ZEAST_2D_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_2D_IN)
+#else
+ !$acc update host(ZSOUTH_2D_IN)
+#endif
+ INB_REQ = INB_REQ + 1
+ CALL MPI_ISEND(ZSOUTH_2D_IN,SIZE(ZSOUTH_2D_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_2D_IN)
+#else
+ !$acc update host(ZNORTH_2D_IN)
+#endif
+ INB_REQ = INB_REQ + 1
+ CALL MPI_ISEND(ZNORTH_2D_IN,SIZE(ZNORTH_2D_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_2D_OUT) async(IS_WEST)
+#endif
+ !$acc kernels async(IS_WEST)
+ PSRC( 1:IIB-1 , IJB:IJE ) = ZWEST_2D_OUT( 1:IIB-1 , IJB:IJE )
+ !$acc end kernels
+ ENDIF
+ IF (.NOT.GEAST) THEN
+#ifndef MNH_GPUDIRECT
+ !$acc update device(ZEAST_2D_OUT) async(IS_EAST)
+#endif
+ !$acc kernels async(IS_EAST)
+ PSRC( IIE+1:IIU , IJB:IJE ) = ZEAST_2D_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_2D_OUT) async(IS_SOUTH)
+#endif
+ !$acc kernels async(IS_SOUTH)
+ PSRC( IIB:IIE , 1:IJB-1) = ZSOUTH_2D_OUT( IIB:IIE , 1:IJB-1 )
+ !$acc end kernels
+ ENDIF
+ IF (.NOT.GNORTH) THEN
+#ifndef MNH_GPUDIRECT
+ !$acc update device(ZNORTH_2D_OUT) async(IS_NORTH)
+#endif
+ !$acc kernels async(IS_NORTH)
+ PSRC( IIB:IIE , IJE+1:IJU) = ZNORTH_2D_OUT ( IIB:IIE , IJE+1:IJU )
+ !$acc end kernels
+ ENDIF
+END IF
+!$acc wait
+
+!$acc end data
+
+END SUBROUTINE GET_2D_HALO_DD
!-------------------------------------------------------------------------------
! ########################################
SUBROUTINE GET_HALO_DDC(PSRC, HDIR, HNAME)
@@ -1219,6 +1543,306 @@ END IF
END SUBROUTINE GET_HALO_DDC
!-------------------------------------------------------------------------------
+! ########################################
+ SUBROUTINE GET_2D_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
+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_REQEW , IREQEW(4)
+INTEGER :: INB_REQNS , IREQNS(4)
+INTEGER :: IERR
+
+if ( NPROC == 1 ) RETURN
+
+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.
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+! Post first the recieve of ZxxxxC_2D_OUT buffer via MPI(Gpu_direct)
+!
+!-------------------------------------------------------------------------------!
+! IRecv E/W !
+!-------------------------------------------------------------------------------!
+INB_REQEW = 0
+IF (LX) THEN
+ IF (.NOT. GWEST) THEN
+#ifdef MNH_GPUDIRECT
+ !$acc host_data use_device(ZWESTC_2D_OUT)
+#endif
+ INB_REQEW = INB_REQEW + 1
+ CALL MPI_IRECV(ZWESTC_2D_OUT,SIZE(ZWESTC_2D_OUT),MNHREAL_MPI,NP_WEST-1,1000+IS_EAST,NMNH_COMM_WORLD,IREQEW(INB_REQEW),IERR)
+#ifdef MNH_GPUDIRECT
+ !$acc end host_data
+#endif
+ END IF
+ IF (.NOT.GEAST) THEN
+#ifdef MNH_GPUDIRECT
+ !$acc host_data use_device(ZEASTC_2D_OUT)
+#endif
+ INB_REQEW = INB_REQEW + 1
+ CALL MPI_IRECV(ZEASTC_2D_OUT,SIZE(ZEASTC_2D_OUT),MNHREAL_MPI,NP_EAST-1,1000+IS_WEST,NMNH_COMM_WORLD,IREQEW(INB_REQEW),IERR)
+#ifdef MNH_GPUDIRECT
+ !$acc end host_data
+#endif
+ ENDIF
+END IF
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!Copy the halo E/W on the device PSRC to ZxxxxC_2D_IN
+
+IF (LX) THEN
+ IF (.NOT. GWEST) THEN
+ !$acc kernels async(IS_WEST)
+ ZWESTC_2D_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)
+ ZEASTC_2D_IN ( IIE-IHALO_1:IIE , IJB:IJE ) = PSRC( IIE-IHALO_1:IIE , IJB:IJE )
+ !$acc end kernels
+ ENDIF
+ !$acc wait
+END IF
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+! Send E/W ZxxxxC_2D_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(ZWESTC_2D_IN)
+#else
+ !$acc update host(ZWESTC_2D_IN)
+#endif
+ INB_REQEW = INB_REQEW + 1
+ CALL MPI_ISEND(ZWESTC_2D_IN,SIZE(ZWESTC_2D_IN) ,MNHREAL_MPI,NP_WEST-1,1000+IS_WEST,NMNH_COMM_WORLD,IREQEW(INB_REQEW),IERR)
+#ifdef MNH_GPUDIRECT
+ !$acc end host_data
+#endif
+ END IF
+ IF (.NOT.GEAST) THEN
+#ifdef MNH_GPUDIRECT
+ !$acc host_data use_device(ZEASTC_2D_IN)
+#else
+ !$acc update host(ZEASTC_2D_IN)
+#endif
+ INB_REQEW = INB_REQEW + 1
+ CALL MPI_ISEND(ZEASTC_2D_IN,SIZE(ZEASTC_2D_IN) ,MNHREAL_MPI,NP_EAST-1,1000+IS_EAST,NMNH_COMM_WORLD,IREQEW(INB_REQEW),IERR)
+#ifdef MNH_GPUDIRECT
+ !$acc end host_data
+#endif
+ ENDIF
+END IF
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+IF ( INB_REQEW > 0 ) THEN
+ CALL MPI_WAITALL(INB_REQEW,IREQEW,MPI_STATUSES_IGNORE,IERR)
+END IF
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! Update halo E/W from buffer to PSRC
+
+IF (LX) THEN
+ IF (.NOT.GWEST) THEN
+#ifndef MNH_GPUDIRECT
+ !$acc update device(ZWESTC_2D_OUT) async(IS_WEST)
+#endif
+ !$acc kernels async(IS_WEST)
+ PSRC( 1:IIB-1 , IJB:IJE ) = ZWESTC_2D_OUT( 1:IIB-1 , IJB:IJE )
+ !$acc end kernels
+ ENDIF
+ IF (.NOT.GEAST) THEN
+#ifndef MNH_GPUDIRECT
+ !$acc update device(ZEASTC_2D_OUT) async(IS_EAST)
+#endif
+ !$acc kernels async(IS_EAST)
+ PSRC( IIE+1:IIU , IJB:IJE ) = ZEASTC_2D_OUT( IIE+1:IIU , IJB:IJE )
+ !$acc end kernels
+ ENDIF
+ !$acc wait
+END IF
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+! Post first the recieve of N/S ZxxxxC_2D_OUT buffer via MPI(Gpu_direct)
+!
+!-------------------------------------------------------------------------------!
+! IRecv N/S !
+!-------------------------------------------------------------------------------!
+INB_REQNS = 0
+IF (LY) THEN
+ IF (.NOT.GSOUTH) THEN
+#ifdef MNH_GPUDIRECT
+ !$acc host_data use_device(ZSOUTHC_2D_OUT)
+#endif
+ INB_REQNS = INB_REQNS + 1
+ CALL MPI_IRECV(ZSOUTHC_2D_OUT,SIZE(ZSOUTHC_2D_OUT),MNHREAL_MPI,NP_SOUTH-1,1000+IS_NORTH,NMNH_COMM_WORLD,IREQNS(INB_REQNS),IERR)
+#ifdef MNH_GPUDIRECT
+ !$acc end host_data
+#endif
+ ENDIF
+ IF (.NOT.GNORTH) THEN
+#ifdef MNH_GPUDIRECT
+ !$acc host_data use_device(ZNORTHC_2D_OUT)
+#endif
+ INB_REQNS = INB_REQNS + 1
+ CALL MPI_IRECV(ZNORTHC_2D_OUT,SIZE(ZNORTHC_2D_OUT),MNHREAL_MPI,NP_NORTH-1,1000+IS_SOUTH,NMNH_COMM_WORLD,IREQNS(INB_REQNS),IERR)
+#ifdef MNH_GPUDIRECT
+ !$acc end host_data
+#endif
+ ENDIF
+END IF
+
+!
+!Copy the halo N/S on the device PSRC to ZxxxxC_2D_IN
+!
+IF (LY) THEN
+ IF (.NOT.GSOUTH) THEN
+ !$acc kernels async(IS_SOUTH)
+ ZSOUTHC_2D_IN ( 1:IIU , IJB:IJB+IHALO_1 ) = PSRC( 1:IIU , IJB:IJB+IHALO_1 )
+ !$acc end kernels
+ ENDIF
+ IF (.NOT.GNORTH) THEN
+ !$acc kernels async(IS_NORTH)
+ ZNORTHC_2D_IN ( 1:IIU , IJE-IHALO_1:IJE ) = PSRC( 1:IIU , IJE-IHALO_1:IJE )
+ !$acc end kernels
+ ENDIF
+ !$acc wait
+ENDIF
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+! Send N/S ZxxxxC_2D_IN buffer via MPI(Gpu_direct) or copy to host
+!
+IF (LY) THEN
+ IF (.NOT.GSOUTH) THEN
+#ifdef MNH_GPUDIRECT
+ !$acc host_data use_device(ZSOUTHC_2D_IN)
+#else
+ !$acc update host(ZSOUTHC_2D_IN)
+#endif
+ INB_REQNS = INB_REQNS + 1
+ CALL MPI_ISEND(ZSOUTHC_2D_IN,SIZE(ZSOUTHC_2D_IN) ,MNHREAL_MPI,NP_SOUTH-1,1000+IS_SOUTH,NMNH_COMM_WORLD,IREQNS(INB_REQNS),IERR)
+#ifdef MNH_GPUDIRECT
+ !$acc end host_data
+#endif
+ ENDIF
+ IF (.NOT.GNORTH) THEN
+#ifdef MNH_GPUDIRECT
+ !$acc host_data use_device(ZNORTHC_2D_IN)
+#else
+ !$acc update host(ZNORTHC_2D_IN)
+#endif
+ INB_REQNS = INB_REQNS + 1
+ CALL MPI_ISEND(ZNORTHC_2D_IN,SIZE(ZNORTHC_2D_IN) ,MNHREAL_MPI,NP_NORTH-1,1000+IS_NORTH,NMNH_COMM_WORLD,IREQNS(INB_REQNS),IERR)
+#ifdef MNH_GPUDIRECT
+ !$acc end host_data
+#endif
+ ENDIF
+ENDIF
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+IF ( INB_REQNS > 0 ) THEN
+ CALL MPI_WAITALL(INB_REQNS,IREQNS,MPI_STATUSES_IGNORE,IERR)
+END IF
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! Update halo N/S
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! Update halo N/S/W from buffer to PSRC
+
+IF (LY) THEN
+ IF (.NOT.GSOUTH) THEN
+#ifndef MNH_GPUDIRECT
+ !$acc update device(ZSOUTHC_2D_OUT) async(IS_SOUTH)
+#endif
+ !$acc kernels async(IS_SOUTH)
+ PSRC( 1:IIU , 1:IJB-1) = ZSOUTHC_2D_OUT( 1:IIU , 1:IJB-1 )
+ !$acc end kernels
+ ENDIF
+ IF (.NOT.GNORTH) THEN
+#ifndef MNH_GPUDIRECT
+ !$acc update device(ZNORTHC_2D_OUT) async(IS_NORTH)
+#endif
+ !$acc kernels async(IS_NORTH)
+ PSRC( 1:IIU , IJE+1:IJU) = ZNORTHC_2D_OUT ( 1:IIU , IJE+1:IJU )
+ !$acc end kernels
+ ENDIF
+ !$acc wait
+END IF
+
+!$acc end data
+
+END SUBROUTINE GET_2D_HALO_DDC
+!-------------------------------------------------------------------------------
! ########################################
SUBROUTINE GET_HALO2_DD(PSRC, TP_PSRC_HALO2_ll, HNAME)
! ########################################
--
GitLab