From b246f66e2cb843f2630b55dba64ae2604ea6eafa Mon Sep 17 00:00:00 2001
From: ESCOBAR Juan <escj@nuwa>
Date: Mon, 9 Nov 2020 14:34:06 +0100
Subject: [PATCH] Juan 09/11/2020:get_halo.f90, version with GPU_DIRECT
---
src/MNH/get_halo.f90 | 765 +++++++++++++++++++++++++++++++++++--------
1 file changed, 632 insertions(+), 133 deletions(-)
diff --git a/src/MNH/get_halo.f90 b/src/MNH/get_halo.f90
index f3a9670ec..8b2522eef 100644
--- a/src/MNH/get_halo.f90
+++ b/src/MNH/get_halo.f90
@@ -16,6 +16,9 @@ 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
@@ -25,6 +28,7 @@ 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
@@ -36,6 +40,7 @@ END INTERFACE
#ifdef MNH_OPENACC
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
@@ -43,16 +48,40 @@ INTERFACE
!
END SUBROUTINE GET_HALO_D
END INTERFACE
-#endif
!
INTERFACE
-SUBROUTINE DEL_HALO2_ll(TPHALO2LIST)
-!
-USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
-TYPE(HALO2LIST_ll), POINTER :: TPHALO2LIST ! list of HALO2_lls
-!
-END SUBROUTINE DEL_HALO2_ll
+ 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
+#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
@@ -132,16 +161,412 @@ 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
+
+ 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
+
+ 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
+
+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
-LOGICAL, SAVE :: GFIRST_GET_HALO_D = .TRUE.
+ USE MODD_VAR_ll, ONLY : IP,NPROC,NP1,NP2
+
+
+ IMPLICIT NONE
+
+ IF (GFIRST_INIT_HALO_D) THEN
+ !
+ IHALO_1 = NHALO-1
+ !
+ 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)
+
+ 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)
+! #########################
+!
+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 GET_HALO_START_D(PSRC,INB_REQ,IREQ,HDIR)
+CALL GET_HALO_STOP_D(PSRC,INB_REQ,IREQ,HDIR)
+!
+END SUBROUTINE GET_HALO_D
+! #########################
+ SUBROUTINE GET_HALO_START_D(PSRC,KNB_REQ,KREQ,HDIR)
+! #########################
+!
+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
+!
+
+CALL INIT_HALO_D()
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!$acc data 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)
+ 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)
+!
+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)
+! #########################
+!
+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
+!
+
+CALL INIT_HALO_D()
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!$acc data 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)
+ 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
+!
+END SUBROUTINE GET_HALO_STOP_D
!-------------------------------------------------------------------------------
! ########################################
- SUBROUTINE GET_HALO_D(PSRC, HDIR, HNAME)
+ SUBROUTINE GET_HALO_DD(PSRC, HDIR, HNAME)
! ########################################
!
USE MODD_HALO_D
@@ -155,6 +580,11 @@ 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
!
IMPLICIT NONE
!
@@ -169,20 +599,21 @@ INTEGER, SAVE :: IIB,IJB ! Begining useful area in x,y,z directions
INTEGER, SAVE :: IIE,IJE ! End useful area in x,y,z directions
INTEGER,SAVE :: IIU,IJU,IKU
-INTEGER,SAVE :: IHALO_1
+
INTEGER,PARAMETER :: IS_WEST=1 , IS_EAST=2, IS_SOUTH=3, IS_NORTH=4
+INTEGER, SAVE :: IIBX,IJBX ! Extended Begining useful area in x,y,z directions
+INTEGER, SAVE :: IIEX,IJEX ! Extended End useful area in x,y,z directions
+
LOGICAL :: LX , LY
-!
-!LOGICAL, SAVE :: GFIRST_GET_HALO_D = .TRUE.
-!
+INTEGER :: INB_REQ , IREQ(8)
+INTEGER :: IERR
+
+if ( NPROC == 1 ) RETURN
!$acc data present ( PSRC )
-!JUANCHECK3D IF (GSMONOPROC) RETURN
-!
-!define _PW_NOINTERM
NULLIFY( TZ_PSRC_ll)
!
IF (GFIRST_GET_HALO_D ) THEN
@@ -195,34 +626,48 @@ IF (GFIRST_GET_HALO_D ) THEN
!
IHALO_1 = NHALO-1
!
-#ifndef _PW_NOINTERM
- 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 ) )
+!!$ IIBX= 1 ; IIEX= IIU ; IJBX= 1 ; IJEX= IJU
+ IIBX= IIB ; IIEX= IIE ; IJBX= IJB ; IJEX= IJE
+
+ ALLOCATE ( ZSOUTH_IN ( IIBX:IIEX , IJB:IJB+IHALO_1 , IKU ) )
+ ALLOCATE ( ZNORTH_IN ( IIBX:IIEX , IJE-IHALO_1:IJE , IKU ) )
+ ALLOCATE ( ZWEST_IN ( IIB:IIB+IHALO_1 , IJBX:IJEX , IKU ) )
+ ALLOCATE ( ZEAST_IN ( IIE-IHALO_1:IIE , IJBX:IJEX , 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 ) )
+ ALLOCATE ( ZSOUTH_OUT ( IIBX:IIEX , 1:IJB-1 , IKU ) )
+ ALLOCATE ( ZNORTH_OUT ( IIBX:IIEX , IJE+1:IJU , IKU ) )
+ ALLOCATE ( ZWEST_OUT ( 1:IIB-1 , IJBX:IJEX , IKU ) )
+ ALLOCATE ( ZEAST_OUT ( IIE+1:IIU , IJBX:IJEX , IKU ) )
!$acc enter data create (ZNORTH_OUT, ZSOUTH_OUT, ZWEST_OUT, ZEAST_OUT)
- CALL INIT_ON_HOST_AND_DEVICE(ZSOUTH_IN,-1e99,'GET_HALO_D::ZSOUTH_IN')
- CALL INIT_ON_HOST_AND_DEVICE(ZNORTH_IN,-1e99,'GET_HALO_D::ZNORTH_IN')
- CALL INIT_ON_HOST_AND_DEVICE(ZWEST_IN,-1e99,'GET_HALO_D::ZWEST_IN')
- CALL INIT_ON_HOST_AND_DEVICE(ZEAST_IN,-1e99,'GET_HALO_D::ZEAST_IN')
-
- CALL INIT_ON_HOST_AND_DEVICE(ZSOUTH_OUT,-1e99,'GET_HALO_D::ZSOUTH_OUT')
- CALL INIT_ON_HOST_AND_DEVICE(ZNORTH_OUT,-1e99,'GET_HALO_D::ZNORTH_OUT')
- CALL INIT_ON_HOST_AND_DEVICE(ZWEST_OUT,-1e99,'GET_HALO_D::ZWEST_OUT')
- CALL INIT_ON_HOST_AND_DEVICE(ZEAST_OUT,-1e99,'GET_HALO_D::ZEAST_OUT')
-#endif
-
+ 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_GET_HALO_D = .FALSE.
+
END IF
-
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
LX = .FALSE.
@@ -232,162 +677,216 @@ 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" )
+ !
+ ! 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
+
+#define MNH_GPUDIRECT
+!
+! 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
-!Copy the halo on the device PSRC to Zxxxx_IN and put it in the PSRC copy on the host
-#ifndef _PW_NOINTERM
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 , : )
+ ZWEST_IN ( IIB:IIB+IHALO_1 , IJBX:IJEX , : ) = PSRC( IIB:IIB+IHALO_1 , IJBX:IJEX , : )
!$acc end kernels
- !$acc update host(ZWEST_IN) async(IS_WEST)
- END IF
+ 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 , : )
+ ZEAST_IN ( IIE-IHALO_1:IIE , IJBX:IJEX , : ) = PSRC( IIE-IHALO_1:IIE , IJBX:IJEX , : )
!$acc end kernels
- !$acc update host(ZEAST_IN) async(IS_EAST)
- ENDIF
+ 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 , : )
+ ZSOUTH_IN ( IIBX:IIEX , IJB:IJB+IHALO_1 , : ) = PSRC( IIBX:IIEX , IJB:IJB+IHALO_1 , : )
!$acc end kernels
- !$acc update host(ZSOUTH_IN) async(IS_SOUTH)
- ENDIF
+ 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 , : )
+ ZNORTH_IN ( IIBX:IIEX , IJE-IHALO_1:IJE , : ) = PSRC( IIBX:IIEX , IJE-IHALO_1:IJE , : )
!$acc end kernels
- !$acc update host(ZNORTH_IN) async(IS_NORTH)
ENDIF
ENDIF
!$acc wait
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+! Send Zxxxx_IN buffer via MPI(Gpu_direct) or copy to host
+!
IF (LX) THEN
IF (.NOT. GWEST) THEN
- PSRC( IIB:IIB+IHALO_1 , IJB:IJE , : ) = ZWEST_IN ( IIB:IIB+IHALO_1 , IJB:IJE , : )
- ENDIF
- IF (.NOT.GEAST) THEN
- PSRC( IIE-IHALO_1:IIE , IJB:IJE , : ) = ZEAST_IN ( IIE-IHALO_1:IIE , IJB:IJE , : )
- ENDIF
-END IF
-IF (LY) THEN
- IF (.NOT.GSOUTH) THEN
- PSRC( IIB:IIE , IJB:IJB+IHALO_1 , : ) = ZSOUTH_IN ( IIB:IIE , IJB:IJB+IHALO_1 , : )
- ENDIF
- IF (.NOT.GNORTH) THEN
- PSRC( IIB:IIE , IJE-IHALO_1:IJE , : ) = ZNORTH_IN ( IIB:IIE , IJE-IHALO_1:IJE , : )
- ENDIF
-ENDIF
+#ifdef MNH_GPUDIRECT
+ !$acc host_data use_device(ZWEST_IN)
#else
-IF (LX) THEN
- IF (.NOT. GWEST) THEN
- !$acc update host(PSRC( IIB:IIB+IHALO_1 , IJB:IJE , : ))
- ENDIF
+ !$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
- !$acc update host(PSRC( IIE-IHALO_1:IIE , IJB:IJE , : ))
+#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
- !$acc update host(PSRC( IIB:IIE , IJB:IJB+IHALO_1 , : ))
+#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
- !$acc update host(PSRC( IIB:IIE , IJE-IHALO_1:IJE , : ))
- ENDIF
-ENDIF
+#ifdef MNH_GPUDIRECT
+ !$acc host_data use_device(ZNORTH_IN)
+#else
+ !$acc update host(ZNORTH_IN)
#endif
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-if ( present ( hname ) ) then
- yname = hname
-else
- yname = 'PSRC'
-end if
-
-IF (LX .OR. LY) THEN
- 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)
-ELSE
- !Necessary to allow comparisons/checks with standard GET_HALO
- CALL MPPDB_CHECK(PSRC,"UPDATE_HALO_ll::GET_HALO::"//trim( yname ))
+ 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
-!Copy the halo on the host PSRC to Zxxxx_OUT and put it in the PSRC copy on the device
-#ifndef _PW_NOINTERM
-IF (LX) THEN
- IF (.NOT.GWEST) THEN
- ZWEST_OUT( 1:IIB-1 , IJB:IJE , : ) = PSRC( 1:IIB-1 , IJB:IJE , : )
- ENDIF
- IF (.NOT.GEAST) THEN
- ZEAST_OUT( IIE+1:IIU , IJB:IJE , : ) = PSRC( IIE+1:IIU , IJB:IJE , : )
- ENDIF
-END IF
-IF (LY) THEN
- IF (.NOT.GSOUTH) THEN
- ZSOUTH_OUT ( IIB:IIE , 1:IJB-1 , : ) = PSRC( IIB:IIE , 1:IJB-1 , : )
- ENDIF
- IF (.NOT.GNORTH) THEN
- ZNORTH_OUT ( IIB:IIE , IJE+1:IJU , : ) = PSRC( IIB:IIE , IJE+1:IJU , : )
- 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 , : )
+ PSRC( 1:IIB-1 , IJBX:IJEX , : ) = ZWEST_OUT( 1:IIB-1 , IJBX:IJEX , : )
!$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 , : )
+ PSRC( IIE+1:IIU , IJBX:IJEX , : ) = ZEAST_OUT( IIE+1:IIU , IJBX:IJEX , : )
!$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 , : )
+ PSRC( IIBX:IIEX , 1:IJB-1 , : ) = ZSOUTH_OUT( IIBX:IIEX , 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 , : )
+ PSRC( IIBX:IIEX , IJE+1:IJU , : ) = ZNORTH_OUT ( IIBX:IIEX , IJE+1:IJU , : )
!$acc end kernels
ENDIF
END IF
!$acc wait
-#else
-IF (LX) THEN
- IF (.NOT.GWEST) THEN
- !$acc update device(PSRC( 1:IIB-1 , IJB:IJE , : ))
- ENDIF
- IF (.NOT.GEAST) THEN
- !$acc update device(PSRC( IIE+1:IIU , IJB:IJE , : ))
- ENDIF
-END IF
-IF (LY) THEN
- IF (.NOT.GSOUTH) THEN
- !$acc update device(PSRC( IIB:IIE , 1:IJB-1 , : ))
- ENDIF
- IF (.NOT.GNORTH) THEN
- !$acc update device(PSRC( IIB:IIE , IJE+1:IJU , : ))
- ENDIF
-END IF
-#endif
!$acc end data
-END SUBROUTINE GET_HALO_D
+END SUBROUTINE GET_HALO_DD
#endif
!-----------------------------------------------------------------------
!
--
GitLab