Skip to content
Snippets Groups Projects
Commit a364f222 authored by ESCOBAR MUNOZ Juan's avatar ESCOBAR MUNOZ Juan
Browse files

Juan 17/09/2021:get_halo.f90, add GET_2D_HALO_DDC for turb.f90

parent 127dd622
Branches
Tags
No related merge requests found
Hide whitespace changes
Inline Side-by-side
src/ZSOLVER/get_halo.f90
+ 626
− 2
View file @ a364f222
...@@ -114,6 +114,26 @@ INTERFACE ...@@ -114,6 +114,26 @@ INTERFACE
! !
END SUBROUTINE GET_HALO_DDC END SUBROUTINE GET_HALO_DDC
END INTERFACE 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 #endif
! !
INTERFACE INTERFACE
...@@ -217,6 +237,13 @@ MODULE MODD_HALO_D ...@@ -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_IN, ZSOUTH2_IN, ZWEST2_IN, ZEAST2_IN
REAL, SAVE , ALLOCATABLE, DIMENSION(:,:) :: ZNORTH2_OUT, ZSOUTH2_OUT, ZWEST2_OUT, ZEAST2_OUT 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. LOGICAL, SAVE :: GFIRST_GET_HALO_D = .TRUE.
...@@ -282,8 +309,36 @@ CONTAINS ...@@ -282,8 +309,36 @@ CONTAINS
ALLOCATE ( ZNORTH2_OUT ( IIU , IKU ) ) ALLOCATE ( ZNORTH2_OUT ( IIU , IKU ) )
ALLOCATE ( ZWEST2_OUT ( IJU , IKU ) ) ALLOCATE ( ZWEST2_OUT ( IJU , IKU ) )
ALLOCATE ( ZEAST2_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 IF (.NOT. GWEST ) THEN
NP_WEST = ( IP-1 -1 ) + 1 NP_WEST = ( IP-1 -1 ) + 1
ELSE ELSE
...@@ -918,6 +973,275 @@ END IF ...@@ -918,6 +973,275 @@ END IF
!$acc end data !$acc end data
END SUBROUTINE GET_HALO_DD 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) SUBROUTINE GET_HALO_DDC(PSRC, HDIR, HNAME)
...@@ -1219,6 +1543,306 @@ END IF ...@@ -1219,6 +1543,306 @@ END IF
END SUBROUTINE GET_HALO_DDC 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) SUBROUTINE GET_HALO2_DD(PSRC, TP_PSRC_HALO2_ll, HNAME)
! ######################################## ! ########################################
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment

Documentation | Mentions légales | CGU | Accessibilité : non conforme